|
|
|
@ -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
|
|
|
|
|