Fixing player year rules to be serializiable.

src/server/farm.scm

@@ -567,14 +567,14 @@
                   (game-farmers-fates game)))
         (push! (make-player-year-rule
                 0
-                `((?p cows player-action-post-harvest
+                '((?p cows player-action-post-harvest
-                      ,(make-remove-farmers-fate-from-hand 'cows-15))
+                      (remove-farmers-fate-from-hand cows-15))
                   (?p cows)))
                (player-year-rules player))
         (push! (make-player-year-rule
                 1
                 `((?d player-action ?p
-                      ,(make-remove-farmers-fate-after 'cows-15 40))))
+                      (remove-farmers-fate-after cows-15 40))))
                (player-year-rules player))))))
 
 (define (find-player-by-name game name)
@@ -1508,21 +1508,23 @@
         0
         '(ridge1 ridge2 ridge3 ridge4)))
 
-(define (make-remove-farmers-fate-from-hand id)
+(define (remove-farmers-fate-from-hand player id)
-  (lambda (player)
+  (let ((game (*game*)))
-    (let ((game (*game*)))
+    (safe-set! (game-farmers-fates game)
-      (safe-set! (game-farmers-fates game)
+               (append (game-farmers-fates game)
-        (append (game-farmers-fates game)
+                       (filter (lambda (x) (eq? (alist-ref 'internal-id x) id))
-                (filter (lambda (x) (eq? (alist-ref 'internal-id x) id))
+                               (player-farmers-fates player)))))
-                        (player-farmers-fates player)))))
+  (safe-set! (player-farmers-fates player)
-    (safe-set! (player-farmers-fates player)
+             (filter (lambda (x) (not (eq? (alist-ref 'internal-id x) id)))
-      (filter (lambda (x) (not (eq? (alist-ref 'internal-id x) id)))
+                     (player-farmers-fates player))))
-              (player-farmers-fates player)))))
+
-
+(define (remove-farmers-fate-after p id space)
-(define (make-remove-farmers-fate-after id space)
+  (when (>= (player-space p) space)
-  (lambda (p)
+    (remove-farmers-fate-from-hand p id)))
-    (when (>= (player-space p) space)
+
-      ((make-remove-farmers-fate-from-hand id) p))))
+(define *action-map*
+  `((remove-farmers-fate-from-hand . ,remove-farmers-fate-from-hand)
+    (remove-farmers-fate-after . ,remove-farmers-fate-after)))
 
 (define (farmers-fate-spec->farmers-fate-card spec id)
   `((contents . ,(sxml->html* (list-ref spec 0)))
@@ -1594,13 +1596,13 @@
           (push! (make-player-year-rule
                   3
                   `((?p wheat player-action-post-harvest
-                        ,(make-remove-farmers-fate-from-hand 'windy-spring))
+                        (remove-farmers-fate-from-hand windy-spring))
                     (?p grain)))
                  (player-year-rules player))
           (push! (make-player-year-rule
                   4
                   `((?d player-action ?p
-                        ,(make-remove-farmers-fate-after 'windy-spring 34))))
+                        (remove-farmers-fate-after windy-spring 34))))
                  (player-year-rules player))
           '())
        #t
@@ -1687,13 +1689,13 @@
             (push! (make-player-year-rule
                     8
                     `((?p cherries player-action-post-harvest
-                          ,(make-remove-farmers-fate-from-hand 'cherries-05))
+                          (remove-farmers-fate-from-hand cherries-05))
                       (?p fruit)))
                    (player-year-rules player)))
           (push! (make-player-year-rule
                   8
                   `((?d player-action ?p
-                        ,(make-remove-farmers-fate-after 'cherries-05 26))))
+                        (make-remove-farmers-fate-after cherries-05 26))))
                  (player-year-rules player))
           '())
        #t
@@ -1997,7 +1999,10 @@
              `((actions . ,((alist-ref 'action (car new-ff)) player game))
                (contents . ,(alist-ref 'contents (car new-ff))))))
           ((or (eq? a 'player-action) (eq? a 'player-action-post-harvest))
-           ((alist-ref '?value action) player))
+           (let ((value (alist-ref '?value action)))
+             (if (procedure? value)
+                 (value player)
+                 (apply (alist-ref (car value) *action-map*) player (cdr value)))))
           ((eq? a 'harvest-mult)
            (safe-set! (player-harvest-mult player)
              (* (player-harvest-mult player) (alist-ref '?value action))))