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

Initial support for saving and loading of app.

Browse Source
This commit is contained in:
Thomas Hintz
2020-04-03 16:26:42 -07:00
parent 3601b6776c
commit ee4e05868c
1 changed files with 76 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

80
src/server/farm.scm
View File

@@ -139,18 +139,87 @@
(space . ,(player-space player))
(previous-space . ,(player-previous-space player))
(state . ,(player-state player))
(finished . ,(player-finished player))
(assets . ,(player-assets player))
(ridges . ,(player-ridges player))
(harvest-mult . ,(player-harvest-mult player))
(player-otbs . ,(player-otbs player))
(otbs . ,(player-otbs player))
(farmers-fates . ,(map (cut alist-ref 'id <>) (player-farmers-fates player)))
(year-rules . ,(player-year-rules player))
(year-rules . ,(player-year-rules player)) ;; TODO check if all are serializable
(next-year-rules . ,(player-next-year-rules player))
(color . ,(player-color player))
(name . ,(player-name player))
(trade . ())
(last-updated . 0)
(last-cash . ,(player-cash player))))
(last-cash . ,(player-cash player))
(hay-doubled . ,(player-hay-doubled player))
(corn-doubled . ,(player-corn-doubled player))))
(define (game->sexp g)
`((id . ,(game-id g))
(players . ,(map player->sexp (game-players g)))
(otbs . ,(game-otbs g))
(used-otbs . ,(game-used-otbs g))
(farmers-fates . ,(map (cut alist-ref 'id <>) (game-farmers-fates g)))
(operating-expenses . ,(map (cut alist-ref 'id <>) (game-operating-expenses g)))
(operating-expense-index . ,(game-operating-expense-index g))
(colors . ,(game-colors g))
(last-updated . ,(game-last-updated g))
(called-audit . ,(if (game-called-audit g)
(player-name (game-called-audit g))
#f)) ;; reify player
(state . ,(game-state g))
(name . ,(game-name g))
(turn . ,(game-turn g))
(current-player . ,(player-name (game-current-player g))) ;; reify player
(settings . ,(game-settings g))))
(define (sexp->game x)
(let ((players (map sexp->player
(alist-ref 'players x))))
(apply make <game>
'players players
'farmers-fates (let ((ffs (alist-ref 'farmers-fates x)))
(list-copy
(filter (lambda (card)
(member (alist-ref 'id card) ffs))
*farmers-fates-cards*)))
'operating-expenses (let ((oes (alist-ref 'operating-expenses x)))
(list-copy
(filter (lambda (card)
(member (alist-ref 'id card) oes))
*operating-expense-cards*)))
'called-audit (if (alist-ref 'called-audit x)
(find (lambda (p)
(string=? (player-name p) (alist-ref 'called-audit x)))
players)
#f)
'current-player (find (lambda (p)
(string=? (player-name p) (alist-ref 'current-player x)))
players)
(fold (lambda (k r) (cons k (cons (alist-ref k x) r)))
'()
'(id otbs used-otbs operating-expense-index colors
last-updated state name turn settings)))))
(define (app->sexp a)
`((games . ,(map game->sexp (app-games a)))
(last-game-id . ,(app-last-game-id a))))
(define (sexp->app x)
(make <app>
'games (map sexp->game (alist-ref 'games x))
'last-game-id (alist-ref 'last-game-id x)))
(define (save-app)
(with-output-to-file "/home/tjhintz/app.scm"
(lambda ()
(write (app->sexp *app*)))))
(define (load-app)
(with-input-from-file "/home/tjhintz/app.scm"
(lambda ()
(set! *app* (sexp->app (read))))))
(define (sexp->player x)
(apply make <player>
@@ -163,7 +232,7 @@
'()
'(cash debt space previous-space state assets ridges
harvest-mult otbs
year-rules next-year-rules
year-rules next-year-rules hay-doubled corn-doubled
color name trade last-updated last-cash))))
(define (shuffle l)
@@ -1599,6 +1668,9 @@
(define (setup-operating-expenses)
(shuffle (operating-expenses-spec-list->operating-expenses-cards
*operating-expenses-specs* *oe-text*)))
(define *operating-expense-cards*
(operating-expenses-spec-list->operating-expenses-cards
*operating-expenses-specs* *oe-text*))
(define *total-operating-expenses*
(length (operating-expenses-spec-list->operating-expenses-cards