diff --git a/src/server/farm.scm b/src/server/farm.scm index f2aae85..0f68b71 100644 --- a/src/server/farm.scm +++ b/src/server/farm.scm @@ -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 + '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 + '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 @@ -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