Initial support for saving and loading of app.

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