tjhintz/farm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Adding game IDs and New/Join Game navigation.

Browse Source
This commit is contained in:
Thomas Hintz
2020-02-07 10:37:21 -08:00
parent 5e8be6e416
commit dd38ed5615
4 changed files with 64 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
src/server/farm.scm
View File

@@ -79,7 +79,8 @@
(last-ui-action initform: #f accessor: player-last-ui-action)))
(define-class <game> ()
((players initform: '() accessor: game-players)
((id initform: 0 accessor: game-id)
(players initform: '() accessor: game-players)
(messages initform: '() accessor: game-messages)
(otbs initform: '() accessor: game-otbs)
(used-otbs initform: '() accessor: game-used-otbs)
@@ -97,7 +98,8 @@
(last-ui-action initform: #f accessor: game-last-ui-action)))
(define-class <app> ()
((games initform: '() accessor: app-games)))
((games initform: '() accessor: app-games)
(last-game-id initform: 0 accessor: last-game-id)))
(define (player->sexp player)
`((cash . ,(player-cash player))
@@ -139,6 +141,10 @@
(define *app* (make <app>))
(define (next-game-id app)
(set! (last-game-id app) (+ (last-game-id app) 1))
(- (last-game-id app) 1))
(define sid (make-parameter #f))
(define session-cookie-name (make-parameter "awful-cookie"))
(define session-cookie-setter (make-parameter
@@ -624,6 +630,7 @@
(games . ((games . ,(list->vector
(map (lambda (game)
`((name . ,(game-name game))
(id . ,(game-id game))
(colors . ,(list->vector
(map symbol->string (game-colors game))))
(players . ,(list->vector
@@ -868,6 +875,7 @@
(game (make <game> 'colors (filter (cut neq? <> color)
'(green red blue yellow black))
'name (alist-ref 'gameName msg)
'id (next-game-id *app*)
'otbs (setup-otbs)
'operating-expenses (setup-operating-expenses)
'farmers-fates (setup-farmers-fates)))
@@ -882,7 +890,8 @@
((string=? type "join-game")
(let* ((color (string->symbol (alist-ref 'checkedColor msg)))
(name (alist-ref 'gameName msg))
(game (find (lambda (g) (string=? (game-name g) name))
(id (alist-ref 'gameId msg))
(game (find (lambda (g) (= (game-id g) id))
(app-games *app*)))
(player (add-player-to-game game
color
@@ -895,7 +904,8 @@
((string=? type "join-as-existing")
(let* ((name (alist-ref 'gameName msg))
(pname (alist-ref 'playerName msg))
(game (find (lambda (g) (string=? (game-name g) name))
(id (alist-ref 'gameId msg))
(game (find (lambda (g) (= (game-id g) id))
(app-games *app*)))
(player (find (lambda (p) (string=? (player-name p) pname))
(game-players game))))
@@ -1024,14 +1034,14 @@
;; (define *otbs* (setup-otbs))
(define *awful-thread* #f)
(define (run-awful) ; for emacs interactive development
(set! *awful-thread*
(define (run-awful) ; for interactive development
(set! *server-thread*
(make-thread
(lambda ()
(start-server)
;; (awful-start (lambda () (void)) port: 8080)
)))
(thread-start! *awful-thread*))
(thread-start! *server-thread*))
(define (strip-tags sxml #!key (para-space #f))
(apply
@@ -1684,4 +1694,5 @@
;; bug: loans is buggy when negative cash
;; bug: dice shows no value when landing on christmas vacation
;; hide Join Game when no games to join
;; livestock bonus card causes "you gained $0" to show every turn
;; livestock bonus card (or anytime holding a card?) causes "you
;; gained $0" to show every turn