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

Visual card trading.

Browse Source
This commit is contained in:
Thomas Hintz
2020-04-25 13:00:36 -07:00
parent c34fc7dcbe
commit bea133bee4
5 changed files with 267 additions and 263 deletions
Download Patch File Download Diff File Expand all files Collapse all files

43
src/server/farm.scm
View File

@@ -115,6 +115,7 @@
(harvest-mult initform: 1 accessor: player-harvest-mult)
(otbs initform: '() accessor: player-otbs)
(farmers-fates initform: '() accessor: player-farmers-fates)
(revealed-cards initform: '() accessor: player-revealed-cards)
(year-rules initform: '() accessor: player-year-rules)
(next-year-rules initform: '() accessor: player-next-year-rules)
(color initform: #f accessor: player-color)
@@ -182,7 +183,8 @@
(harvest-mult . ,(player-harvest-mult player))
(otbs . ,(player-otbs player))
(farmers-fates . ,(map (cut alist-ref 'id <>) (player-farmers-fates player)))
(year-rules . ,(player-year-rules player)) ;; TODO check if all are serializable
(revealed-cards . ,(player-revealed-cards player))
(year-rules . ,(player-year-rules player))
(next-year-rules . ,(player-next-year-rules player))
(color . ,(player-color player))
(name . ,(player-name player))
@@ -306,18 +308,21 @@
(set! *app* (sexp->app (read))))))
(define (sexp->player x)
(apply make <player>
'farmers-fates (let ((ffs (alist-ref 'farmers-fates x)))
(list-copy
(filter (lambda (card)
(member (alist-ref 'id card) ffs))
*farmers-fates-cards*)))
(fold (lambda (k r) (cons k (cons (alist-ref k x) r)))
'()
'(cash debt space previous-space state assets ridges
harvest-mult otbs user-id
year-rules next-year-rules hay-doubled corn-doubled
color name trade last-updated last-cash))))
(let ((p (apply make <player>
'farmers-fates (let ((ffs (alist-ref 'farmers-fates x)))
(list-copy
(filter (lambda (card)
(member (alist-ref 'id card) ffs))
*farmers-fates-cards*)))
(fold (lambda (k r) (cons k (cons (alist-ref k x) r)))
'()
'(cash debt space previous-space state assets ridges
harvest-mult otbs user-id revealed-cards
year-rules next-year-rules hay-doubled corn-doubled
color name trade last-updated last-cash)))))
(when (not (player-revealed-cards p))
(safe-set! (player-revealed-cards p) '()))
p))
(define (shuffle l)
(map cdr
@@ -521,6 +526,7 @@
(state . ,(symbol->string (player-state p)))
(cards . ,(list->vector (append (player-farmers-fates p)
(player-otbs p))))
(revealedCards . ,(list->vector (player-revealed-cards p)))
(color . ,(symbol->string (player-color p)))
(name . ,(player-name p))
(user-id . ,(player-user-id p))
@@ -1334,6 +1340,16 @@
(message-players! game player '() type: "update"))
(create-ws-response player "update" '()))
(begin (create-ws-response player "update" '()))))
((string=? type "toggle-reveal-for-trading")
(let ((id (alist-ref 'id msg)))
(if (member id (player-revealed-cards player))
(safe-set! (player-revealed-cards player)
(filter (lambda (cid) (not (eqv? cid id)))
(player-revealed-cards player)))
(safe-set! (player-revealed-cards player)
(cons id (player-revealed-cards player)))))
(message-players! game player '() type: "update")
(create-ws-response player "update" '()))
;;;;;;;;;;;;;;;;;;;;; start ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((string=? type "main-init")
(create-start-response "start-init"))
@@ -2384,3 +2400,4 @@
;; TODO
;; make sure two players can't have the same name
;; "your turn to roll" showing up on mobile when on action screen
;; trade cards better