Many updates.

src/server/farm.scm

@@ -60,6 +60,7 @@
    (space initform: 0 accessor: player-space)
    (previous-space initform: 0 accessor: player-previous-space)
    (state initform: 'turn-ended accessor: player-state)
+   (finished initform: #f accessor: player-finished)
    (assets initform:
            '((hay . 10) (grain . 10) (fruit . 0) (cows . 0)
              (harvester . 0) (tractor . 0))
@@ -94,6 +95,7 @@
    (state initform: 'playing accessor: game-state)
    (name initform: "game" accessor: game-name)
    (turn initform: 1 accessor: game-turn)
+   (current-player initform: #f accessor: game-current-player)
    (actions initform: '() accessor: game-actions)
    (settings initform:
              '((down-payment . 0.2)
@@ -101,7 +103,8 @@
                (max-debt . 50000)
                (audit-threshold . 250000)
                (starting-cash . 5000)
-               (starting-debt . 5000))
+               (starting-debt . 5000)
+               (trade . #t))
              accessor: game-settings)))
 
 (define (game-setting setting game)
@@ -223,37 +226,34 @@
                   'state (if (= (length (game-players game)) 0)
                              'pre-turn 'turn-ended))))
     (set! (game-players game) (append (game-players game) (list player)))
+    (when (= (length (game-players game)) 1)
+      (set! (game-current-player game) player))
     player))
 
 (define (all-players-finished game)
   (null? (filter (lambda (p)
-                   (not (eq? (player-state p) 'finished-game)))
+                   (not (player-finished p)))
                  (game-players game))))
 
-(define (next-player game player)
-  (let ((tail (cdr (filter (lambda (p)
-                             (not (eq? (player-state p) 'finished-game)))
-                           (find-tail (cut eq? <> player) (game-players game))))))
-    (if (null? tail)
-        (car (game-players game))
-        (car tail))))
+(define (next-player game)
+  (let ((tail (filter (lambda (p)
+                        (not (player-finished p)))
+                      (find-tail (cut eq? <> (game-current-player game))
+                                 (game-players game)))))
+    (if (or (null? tail) (null? (cdr tail)))
+        (car (filter (lambda (p)
+                       (not (player-finished p)))
+                     (game-players game)))
+        (car (cdr tail)))))
 
 (define (advance-turn game player)
   (if (all-players-finished game)
       (set! (game-state game) 'finished)
-      (begin (set! (player-state player) 'turn-ended)
-             (set! (player-state (next-player game player)) 'pre-turn)
-             (set! (game-turn game) (+ (game-turn game) 1)))))
-
-(define (current-players-turn game)
-  (let loop ((players (game-players game)))
-    (cond ((null? players) ;; game finished use player 0 as a dummy player
-           (car (game-players game)))
-          ((or (eq? (player-state (car players)) 'turn-ended)
-               (eq? (player-state (car players)) 'finished-game))
-           (loop (cdr players)))
-          (else
-           (car players)))))
+      (let ((next (next-player game)))
+        (set! (player-state player) 'turn-ended)
+        (set! (player-state next) 'pre-turn)
+        (set! (game-current-player game) next)
+        (set! (game-turn game) (+ (game-turn game) 1)))))
 
 (define (ridge-available? game ridge)
   (let loop ((players (game-players game)))
@@ -326,7 +326,7 @@
 
 (define (game->list g player)
   `((game . ((messages . ,(list->vector (reverse (game-messages g))))
-             (currentPlayer . ,(player-name (current-players-turn g)))
+             (currentPlayer . ,(player-name (game-current-player g)))
              (otherPlayers
               . ,(list->vector
                   (map
@@ -340,7 +340,8 @@
              (settings . ((downPayment . ,(game-setting 'down-payment g))
                           (loanInterest . ,(game-setting 'loan-interest g))
                           (maxDebt . ,(game-setting 'max-debt g))
-                          (auditThreshold . ,(game-setting 'audit-threshold g))))))))
+                          (auditThreshold . ,(game-setting 'audit-threshold g))
+                          (trade . ,(game-setting 'trade g))))))))
 
 (define (push-message player msg #!key (game (session-ref (sid) 'game)))
   (if player
@@ -405,6 +406,9 @@
              (push-message player (conc "You bought " amount " " crop "."))
              #t)))))
 
+(define (make-player-year-rule id rule)
+  `((id . ,id) (rule . ,rule)))
+
 (define (finish-year player #!optional (collect-wages #t))
   (let ((game (session-ref (sid) 'game)))
     (when collect-wages
@@ -417,10 +421,11 @@
                 (?value . "You earned $5,000 from your city job!"))
               (game-actions game))))
     (when (game-called-audit game)
-      (set! (player-state player) 'finished-game)
-      (advance-turn game player)
-      ;; advance turn resets state back to turn ended
-      (set! (player-state player) 'finished-game))
+      (set! (game-actions game)
+        (append (game-actions game)
+                `(((?action . end-game)
+                   (?value . ,(lambda ()
+                                (set! (player-finished player) #t))))))))
     (set! (player-year-rules player) (player-next-year-rules player))
     (set! (player-next-year-rules player) '())
     (when (not (null? (player-farmers-fates player)))
@@ -436,12 +441,16 @@
         (set! (game-farmers-fates game)
           (filter (lambda (c) (not (eq? (alist-ref 'internal-id c) 'cows-15)))
                   (game-farmers-fates game)))
-        (push! `((?p cows player-action-post-harvest
-                     ,(make-remove-farmers-fate-from-hand 'cows-15))
-                 (?p cows))
+        (push! (make-player-year-rule
+                0
+                `((?p cows player-action-post-harvest
+                      ,(make-remove-farmers-fate-from-hand 'cows-15))
+                  (?p cows)))
                (player-year-rules player))
-        (push! `((?d player-action ?p
-                     ,(make-remove-farmers-fate-after 'cows-15 40)))
+        (push! (make-player-year-rule
+                1
+                `((?d player-action ?p
+                      ,(make-remove-farmers-fate-after 'cows-15 40))))
                (player-year-rules player))))))
 
 (define (find-player-by-name game name)
@@ -489,50 +498,47 @@
                               '()
                               cards)))
     (cond (basics
-           (push-message player (conc "You don't have enough " basics " to trade!"))
-           #f)
+           (conc "You don't have enough " basics " to trade!"))
           (other-basics
-           (push-message player (conc (player-name other-player)
-                                      " doesn't have enough " other-basics " to trade!"))
-           #f)
+           (conc (player-name other-player)
+                 " doesn't have enough " other-basics " to trade!"))
           (ridges
-           (push-message player (conc ridges " ridge not available to trade!"))
-           #f)
+           (conc ridges " ridge not available to trade!"))
           ((< (+ (player-cash player) (alist-ref 'money params eqv? 0)) 0)
-           (push-message player "You don't have enough cash to trade!")
-           #f)
+           "You don't have enough cash to trade!")
           ((< (+ (player-cash other-player) (* (alist-ref 'money params eqv? 0) -1)) 0)
-           (push-message player (conc (player-name other-player)
-                                      " doesn't have enough cash to trade!"))
-           #f)
+           (conc (player-name other-player)
+                 " doesn't have enough cash to trade!"))
           ((not (null? missing-cards))
-           (push-message player (conc "Nobody has cards: "
-                                      (string-intersperse
-                                       (map number->string missing-cards)
-                                       ", ") "."))
-           #f)
+           (conc "Nobody has cards: "
+                 (string-intersperse
+                  (map number->string missing-cards)
+                  ", ") "."))
           (else
            other-player))))
 
+(define *trade-number* 0)
+
 (define (propose-trade game player params)
   (let ((other-player (validate-trade game player params)))
-    (if other-player
+    (if (not (string? other-player))
         (let ((to-trade (filter (lambda (x) (and (not (equal? (cdr x) 0))
                                                  (not (equal? (cdr x) ""))
                                                  (cdr x)))
                                 params)))
-          (push-message player
-                        (conc "Trade proposed to " (player-name other-player) "!"))
+          (set! *trade-number* (+ *trade-number* 1))
           (set! (player-trade other-player)
             (append `((player . ,(player-name player))
-                      (originator . ,(player-name player)))
+                      (originator . ,(player-name player))
+                      (trade-number . ,*trade-number*))
                     to-trade))
           (set! (player-trade player)
             (append `((player . ,(player-name other-player))
-                      (originator . ,(player-name player)))
+                      (originator . ,(player-name player))
+                      (trade-number . ,*trade-number*))
                     to-trade))
           #t)
-        #f)))
+        other-player)))
 
 (define (otb-by-id player id)
   (find (lambda (card)
@@ -689,6 +695,7 @@
   (when game
     (set! (game-messages game) '())
     (set! (player-last-cash player) (player-cash player)))
+  (print "message type: " type)
   (cond ((string=? type "roll")
          (let ((num (+ (random 6) 1)))
            (when *next-roll* (set! num *next-roll*))
@@ -704,8 +711,6 @@
            (when (and (> (player-previous-space player) 40)
                       (< (player-space player) 10))
              (finish-year player))
-           (when (eq? (game-state game) 'finished)
-             (do-end-of-game game)) ;; TODO check
            (set! (player-harvest-mult player) 1)
            (let ((resp `((from . ,(player-previous-space player))
                          (to . ,(player-space player)))))
@@ -719,9 +724,11 @@
              (create-ws-response player "action" `((action . "roll") (value . ,resp))))))
         ((and (string=? type "next-action")
               (not (eq? (player-state player) 'turn-ended)))
-         (let loop ()
-           (if (null? (game-actions game))
+         (let loop ((i 0))
+           (if (or (null? (game-actions game))
+                   (>= i 15))
                (begin
+                 (set! (game-actions game) '())
                  (message-players! game player `((action . #f) (value . #f)))
                  (create-ws-response player "action" '((action . #f))))
                (let* ((action (car (game-actions game)))
@@ -756,7 +763,7 @@
                         (let ((res (do-action action player)))
                           (set! (game-actions game) (cdr (game-actions game)))
                           (if (eq? res 'nothing)
-                              (loop)
+                              (loop (+ i 1))
                               (begin
                                 (message-players!
                                  game player
@@ -772,21 +779,27 @@
                           (set! (game-actions game)
                             (cdr (game-actions game)))
                           (if (= (- (player-cash player) previous-cash) 0)
-                              (loop)
-                              (begin
-                                (message-players! game player
-                                                  `((action . "money")
-                                                    (value . ,(- (player-cash player)
-                                                                 previous-cash))))
-                                (create-ws-response player "action"
-                                                    `((action . "money")
-                                                      (value . ,(- (player-cash player)
-                                                                   previous-cash))))))))
+                              (loop (+ i 1))
+                              (let ((res `((action . "money")
+                                           (value . ((amount . ,(- (player-cash player)
+                                                                   previous-cash))
+                                                     (player . ,(player-name player)))))))
+                                (message-players! game player res)
+                                (create-ws-response player "action" res)))))
+                       ((eq? name 'end-game)
+                        (if (null? (cdr (game-actions game)))
+                            (begin
+                              (value)
+                              (set! (game-actions game) '()))
+                            (set! (game-actions game)
+                              (append (cdr (game-actions game))
+                                      (list (car (game-actions game))))))
+                        (loop (+ i 1)))
                        ((or (eq? name 'harvest-mult)
                             (eq? name 'player-action-post-harvest))
                         (set! (game-actions game) (cdr (game-actions game)))
                         (do-action action player)
-                        (loop))
+                        (loop (+ i 1)))
                        ((eq? value 'farmers-fate)
                         (let ((ff (do-action action player)))
                           (set! (game-actions game)
@@ -800,14 +813,13 @@
                                                 (value . ,(alist-ref 'contents ff))))))
                        ((eq? name 'ff-money)
                         (set! (game-actions game) (cdr (game-actions game)))
-                        (if (= value 0)
-                            (loop)
-                            (begin
-                              (message-players! game player
-                                                `((action . "money") (value . ,value)))
-                              (create-ws-response player "action"
-                                                  `((action . "money")
-                                                    (value . ,value))))))
+                        (if (= (alist-ref 'amount value) 0)
+                            (loop (+ i 1))
+                            (let ((res `((action . "money")
+                                         (value . ((amount . ,(alist-ref 'amount value))
+                                                   (player . ,(alist-ref 'name value)))))))
+                              (message-players! game player res)
+                              (create-ws-response player "action" res))))
                        ((eq? name 'ff-uncle-bert)
                         (set! (game-actions game) (cdr (game-actions game)))
                         (message-players! game player
@@ -838,7 +850,7 @@
                        ((eq? name 'add-rule)
                         (do-action action player)
                         (set! (game-actions game) (cdr (game-actions game)))
-                        (loop))
+                        (loop (+ i 1)))
                        (else ;; TODO make error
                         (create-ws-response player "action" `((action . ,name)))))))))
         ((string=? type "skip")
@@ -904,9 +916,13 @@
                ))
          (create-ws-response player "loan" '()))
         ((string=? type "trade")
-         (propose-trade game player (alist-ref 'parameters msg))
-         (message-players! game player '() type: "update")
-         (create-ws-response player "trade" '()))
+         (let ((res (propose-trade game player (alist-ref 'parameters msg))))
+           (if (eq? res #t)
+               (begin
+                 (message-players! game player '() type: "update")
+                 (create-ws-response player "trade" '()))
+               (begin (set! (player-trade player) `((error . ,res)))
+                      (create-ws-response player "trade-error" `())))))
         ((string=? type "trade-accept")
          (accept-trade game player)
          (message-players! game player '() type: "update")
@@ -934,11 +950,15 @@
          (message-players! game player '() type: "update")
          (create-ws-response player "called-audit" '()))
         ((string=? type "init")
-         (create-ws-response player "init" '()))
+         (create-ws-response player "init" `((harvestTable . ,(map (lambda (row)
+                                                                     `(,(car row) . ,(list->vector (cdr row))))
+                                                                   *harvest-table*)))))
         ((string=? type "turn-ended")
          (if (>= (player-cash player) 0)
              (begin (advance-turn game player)
-                    (message-players! game player '() type: "update")
+                    (if (eq? (game-state game) 'finished)
+                        (do-end-of-game game)
+                        (message-players! game player '() type: "update"))
                     (create-ws-response player "update" '()))
              (begin (push-message player "Cannot end a turn with negative cash!")
                     (create-ws-response player "update" '()))))
@@ -953,17 +973,18 @@
                             'id (next-game-id *app*)
                             'otbs (setup-otbs)
                             'operating-expenses (setup-operating-expenses)
-                            'farmers-fates (setup-farmers-fates)
+                            'farmers-fates (setup-farmers-fates #t)
                             'settings
-                            `((down-payment . ,(->pct (alist-ref 'downPayment msg) 0.2))
-                              (loan-interest . ,(->pct (alist-ref 'loanInterest msg) 0.2))
+                            `((down-payment . ,(->pct (alist-ref 'downPayment msg) 0))
+                              (loan-interest . ,(->pct (alist-ref 'loanInterest msg) 0))
                               (max-debt . ,(->i (alist-ref 'maxDebt msg) 50000))
                               (audit-threshold . ,(->i (alist-ref 'auditThreshold msg)
                                                        250000))
                               (starting-cash . ,(->i (alist-ref 'startingCash msg)
-                                                     5000))
+                                                     0))
                               (starting-debt . ,(->i (alist-ref 'startingDebt msg)
-                                                     5000)))))
+                                                     0))
+                              (trade . ,(or (alist-ref 'trade msg) #t)))))
                 (player (add-player-to-game game
                                             color
                                             (alist-ref 'playerName msg))))
@@ -973,11 +994,14 @@
            (set-startup-otbs game player 2)
            (create-start-response "new-game-started")))
         ((string=? type "join-game")
-         (let* ((color (string->symbol (alist-ref 'checkedColor msg)))
-                (name (alist-ref 'gameName msg))
+         (let* ((name (alist-ref 'gameName msg))
                 (id (alist-ref 'gameId msg))
                 (game (find (lambda (g) (= (game-id g) id))
                             (app-games *app*)))
+                (color-raw (string->symbol (alist-ref 'checkedColor msg)))
+                (color (if (not (member color-raw (game-colors game)))
+                           (car (game-colors game))
+                           color-raw))
                 (player (add-player-to-game game
                                             color
                                             (alist-ref 'playerName msg))))
@@ -1156,7 +1180,7 @@
 
 (define (players-with asset game)
   (filter (lambda (player)
-            (player-has-asset? 'harvester player))
+            (player-has-asset? asset player))
           (game-players game)))
 
 (define (player-asset-binary-count asset game)
@@ -1256,88 +1280,105 @@
                        (iota (list-ref spec 0))))
                 farmers-fates ff-texts)))
 
+(define (ff-money-response amount player-name)
+  `((?action . ff-money)
+    (?value . ((amount . ,amount)
+               (name . ,player-name)))))
+
 (define-syntax with-ff-money-action
-  (syntax-rules (?action ff-money ?value)
-    ((_ (player) body ...)
-     (let ((previous-cash (player-cash player)))
+  (syntax-rules ()
+    ((_ (player game) body ...)
+     (let ((previous-cash (map (lambda (p)
+                                 (cons p (player-cash p))) (game-players game))))
        body ...
-       `(((?action . ff-money)
-          (?value . ,(- (player-cash player) previous-cash))))))))
+       `(,(ff-money-response (- (player-cash player)
+                                (cdr (find (lambda (x) (eq? (car x) player)) previous-cash)))
+                             (player-name player))
+         ,@(map (lambda (x)
+                  (ff-money-response (- (player-cash (car x)) (cdr x))
+                                     (player-name (car x))))
+                (filter (lambda (x)
+                          (and (not (eq? (car x) player))
+                               (not (= (- (player-cash (car x))
+                                          (cdr x))
+                                       0))))
+                        previous-cash))
+         )))))
 
 (define *farmers-fates-specs*
-  ;; xxx multiplayer interaction
-  `((1 ,(lambda (player)
-          (for-each (lambda (p)
-                      (let ((roll (+ (random 6) 1)))
-                        (if (odd? roll)
-                            (push-message p (conc "You rolled a " roll " and escaped!"))
-                            (begin (push-message p (conc "You rolled a " roll " and were hit!"))
-                                   ((make-player-pays (* (player-acres p) 100)) p)))))
-                    (filter (lambda (x) (not (eq? x player)))
-                            (game-players (session-ref (sid) 'game))))
-          (with-ff-money-action (player)
-                                ((make-player-gains-per-unit 'hay 500) player)))
+  `((1 ,(lambda (player game)
+          (with-ff-money-action (player game)
+            (for-each (lambda (p)
+                        (let ((roll (+ (random 6) 1)))
+                          (if (odd? roll)
+                              ((make-player-pays (* (player-acres p) 100)) p))))
+                                          (filter (lambda (x) (not (eq? x player)))
+                                                  (game-players (session-ref (sid) 'game))))
+            ((make-player-gains-per-unit 'hay 500) player)))
        #f)
-    (1 ,(lambda (player)
-          (with-ff-money-action (player)
+    (1 ,(lambda (player game)
+          (with-ff-money-action (player game)
                                 ((make-player-gains-per-unit 'grain 100) player)))
        #f)
-    (1 ,(lambda (player)
-          (push! '((?p wheat harvest-mult 0.5) (?p grain)) (player-year-rules player))
-          (push! `((?p wheat player-action-post-harvest
-                       ,(make-remove-farmers-fate-from-hand 'windy-spring))
-                   (?p grain))
+    (1 ,(lambda (player game)
+          (push! (make-player-year-rule 2 '((?p wheat harvest-mult 0.5) (?p grain)))
                  (player-year-rules player))
-          (push! `((?d player-action ?p
-                       ,(make-remove-farmers-fate-after 'windy-spring 34)))
+          (push! (make-player-year-rule
+                  3
+                  `((?p wheat player-action-post-harvest
+                        ,(make-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))))
                  (player-year-rules player))
           '())
        #t
        windy-spring)
-    (1 ,(lambda (player)
+    (1 ,(lambda (player game)
           (if (player-has-asset? 'cows player)
-              (with-ff-money-action (player) ((make-player-gains 2000) player))
+              (with-ff-money-action (player game) ((make-player-gains 2000) player))
               '()))
        #f)
-    (1 ,(lambda (player)
-          (with-ff-money-action (player)
+    (1 ,(lambda (player game)
+          (with-ff-money-action (player game)
                                 ((make-player-gains-per-unit 'hay 100) player)))
        #f)
-    (1 ,(lambda (player)
-          (with-ff-money-action (player) ((make-player-gains 1000) player)))
+    (1 ,(lambda (player game)
+          (with-ff-money-action (player game) ((make-player-gains 1000) player)))
        #f)
-    (1 ,(lambda (player)
-          (with-ff-money-action (player) ((make-player-pays 7000) player)))
+    (1 ,(lambda (player game)
+          (with-ff-money-action (player game) ((make-player-pays 7000) player)))
        #f)
-    (1 ,(lambda (player)
-          (with-ff-money-action (player)
+    (1 ,(lambda (player game)
+          (with-ff-money-action (player game)
                                 ((make-player-pays-per-unit 'fruit 500) player)))
        #f)
-    (1 ,(lambda (player)
-          (with-ff-money-action (player)
+    (1 ,(lambda (player game)
+          (with-ff-money-action (player game)
                                 (let ((to-earn (* (player-acres player) 100)))
                                   (push-message player (conc "You earned $" to-earn "!"))
                                   (set! (player-cash player)
                                     (+ (player-cash player) to-earn)))))
        #f)
-    (2 ,(lambda (player)
+    (2 ,(lambda (player game)
           `(((?action . player-action)
              (?value . ,(lambda (player) (finish-year player #f))))
             ((?action . goto) (?value . jan2))))
        #f)
-    (1 ,(lambda (player)
-          (with-ff-money-action (player)
+    (1 ,(lambda (player game)
+          (with-ff-money-action (player game)
                                 ((make-player-pays-per-unit 'fruit 300) player)))
        #f)
-    ;; xxx multiplayer interaction
-    (2 ,(lambda (player)
-          (with-ff-money-action (player)
+    (2 ,(lambda (player game)
+          (with-ff-money-action (player game)
                                 (equipment-payout 'tractor player 3000 (session-ref (sid) 'game))))
        #f)
-    ;; xxx multiplayer interaction
-    (1 ,(lambda (player)
+    (1 ,(lambda (player game)
           (if (player-has-asset? 'harvester player)
-              (with-ff-money-action (player)
+              (with-ff-money-action (player game)
                                     (for-each (lambda (from-player)
                                                 (when (not (eq? player from-player))
                                                   (when (not (player-has-asset? 'harvester from-player))
@@ -1348,42 +1389,49 @@
                                               (game-players (session-ref (sid) 'game))))
               '()))
        #f)
-    (1 ,(lambda (player)
-          (push! '((?p ?any harvest-mult 0) (?p ?crop)) (player-year-rules player))
+    (1 ,(lambda (player game)
+          (push! (make-player-year-rule 5 '((?p ?any harvest-mult 0) (?p ?crop)))
+                 (player-year-rules player))
           '())
        #t)
-    (1 ,(lambda (player)
+    (1 ,(lambda (player game)
           `(((?action . ff-uncle-bert) (?value . #f))))
        #f)
-    ;; xxx multiplayer interaction
-    (1 ,(lambda (player)
-          (with-ff-money-action (player)
+    (1 ,(lambda (player game)
+          (with-ff-money-action (player game)
                                 (equipment-payout 'harvester player 2500
                                                   (session-ref (sid) 'game))))
        #f)
-    (1 ,(lambda (player)
-          (push! `((?p cows harvest-mult 1.5) (?p cows)) (player-year-rules player))
-          (push! `((?p cows harvest-mult 1.5) (?p cows)) (player-next-year-rules player))
+    (1 ,(lambda (player game)
+          (push! (make-player-year-rule 6 `((?p cows harvest-mult 1.5) (?p cows)))
+                 (player-year-rules player))
+          (push! (make-player-year-rule 7 `((?p cows harvest-mult 1.5) (?p cows)))
+                 (player-next-year-rules player))
           '())
        #t
        cows-15)
-    (1 ,(lambda (player)
-          (with-ff-money-action (player) ((make-player-gains 2000) player)))
+    (1 ,(lambda (player game)
+          (with-ff-money-action (player game) ((make-player-gains 2000) player)))
        #f)
-    (1 ,(lambda (player)
+    (1 ,(lambda (player game)
           (when (< (player-space player) 26)
-            (push! '((?p cherries harvest-mult 0.5) (?p fruit)) (player-year-rules player))
-            (push! `((?p cherries player-action-post-harvest
-                         ,(make-remove-farmers-fate-from-hand 'cherries-05))
-                     (?p fruit))
+            (push! (make-player-year-rule 7 '((?p cherries harvest-mult 0.5) (?p fruit)))
+                   (player-year-rules player))
+            (push! (make-player-year-rule
+                    8
+                    `((?p cherries player-action-post-harvest
+                          ,(make-remove-farmers-fate-from-hand 'cherries-05))
+                      (?p fruit)))
                    (player-year-rules player)))
-          (push! `((?d player-action ?p
-                       ,(make-remove-farmers-fate-after 'cherries-05 26)))
+          (push! (make-player-year-rule
+                  8
+                  `((?d player-action ?p
+                        ,(make-remove-farmers-fate-after 'cherries-05 26))))
                  (player-year-rules player))
           '())
        #t
        cherries-05)
-    (1 ,(lambda (player)
+    (1 ,(lambda (player game)
           (let ((cows (player-asset 'cows player))
                 (ridge-cows (cows-on-ridges player)))
             (if (> cows ridge-cows)
@@ -1398,16 +1446,19 @@
                                       " cows slaughtered on your farm.")))))
                 '())))
        #f)
-    (1 ,(lambda (player)
-          (with-ff-money-action (player)
+    (1 ,(lambda (player game)
+          (with-ff-money-action (player game)
                                 ((make-player-pays-per-unit 'fruit 1000) player)))
        #f)
-    (1 ,(lambda (player)
-          (with-ff-money-action (player) ((make-semi-annual-interest-due) player)))
+    (1 ,(lambda (player game)
+          (with-ff-money-action (player game) ((make-semi-annual-interest-due) player)))
        #f)))
 
-(define (setup-farmers-fates)
-  (shuffle (farmers-fate-spec-list->farmers-fate-cards *farmers-fates-specs* *ff-text*)))
+(define (setup-farmers-fates shuffle?)
+  (let ((cards (farmers-fate-spec-list->farmers-fate-cards *farmers-fates-specs* *ff-text*)))
+    (if shuffle?
+        (shuffle cards)
+        cards)))
 (define *farmers-fates-cards*
   (farmers-fate-spec-list->farmers-fate-cards *farmers-fates-specs* *ff-text*))
 ;; (define *farmers-fates* (setup-farmers-fates))
@@ -1466,10 +1517,9 @@
   (length (operating-expenses-spec-list->operating-expenses-cards
            *operating-expenses-specs* *oe-text*)))
 
-(define (draw-operating-expense)
-  (let* ((game (session-ref (sid) 'game))
-         (card (list-ref (game-operating-expenses game)
-                         (game-operating-expense-index game))))
+(define (draw-operating-expense game)
+  (let ((card (list-ref (game-operating-expenses game)
+                        (game-operating-expense-index game))))
     (if (= (+ (game-operating-expense-index game) 1) *total-operating-expenses*)
         (set! (game-operating-expense-index game) 0)
         (set! (game-operating-expense-index game)
@@ -1497,7 +1547,7 @@
      ((jan1 player-action ?p ,(make-semi-annual-interest-due)))
      ((jan2 draw ?p otb))
      ((jan3 money ?p ,(pays 500)) (?p cows))
-     ((jan4 add-rule ?p ((?p hay harvest-mult 2) (?p hay))))
+     ((jan4 add-rule ?p ,(make-player-year-rule 9 '((?p hay harvest-mult 2) (?p hay)))))
      ((feb1 money ?p ,(gains 1000)))
      ((feb2 draw ?p farmers-fate))
      ((feb3 goto ?p apr2))
@@ -1507,7 +1557,8 @@
      ((mar3 goto ?p jan2))
      ((mar4 money ?p ,(pays 2000)) (?p fruit))
      ((apr1 draw ?p otb))
-     ((apr2 add-rule ?p ((?p corn harvest-mult 2) (?p grain))))
+     ((apr2 add-rule ?p ,(make-player-year-rule
+                          10 '((?p corn harvest-mult 2) (?p grain)))))
      ((apr3 money ?p ,(pays 500)))
      ((apr4 money ?p ,(pays 1000)))
      ((may1 money ?p ,(gains 500)))
@@ -1574,7 +1625,7 @@
      ((dec2 harvest ?p corn) (?p grain))
      ((dec3 money ?p ,(gains 1000)))
 
-     ,@(player-year-rules player)
+     ,@(map (lambda (x) (alist-ref 'rule x)) (player-year-rules player))
 
      ((?date harvest-mult ?p ?val) (?date harvest ?p ?crop) (?p ?crop harvest-mult ?val))
      ((?date player-action-post-harvest ?p ?val) (?date harvest ?p ?crop) (?p ?crop player-action-post-harvest ?val))
@@ -1647,7 +1698,8 @@
         (car new-otb))))
 
 (define (do-action action player)
-  (let ((a (alist-ref '?action action)))
+  (let ((a (alist-ref '?action action))
+        (game (session-ref (sid) 'game)))
     (cond ((eq? a 'money)
            (let ((changed ((alist-ref '?value action) 0)))
             (push-message player (conc "You " (if (>= changed 0) "earned" "paid") " $"
@@ -1655,10 +1707,11 @@
            (set! (player-cash player)
              ((alist-ref '?value action) (player-cash player))))
           ((eq? a 'add-rule)
-           (set! (player-year-rules player)
-             (cons (alist-ref '?value action) (player-year-rules player)))
-           ;; TODO handle being added multiple times
-           )
+           (when (not (member (alist-ref 'id (alist-ref '?value action))
+                              (map (lambda (x) (alist-ref 'id x))
+                                   (player-year-rules player))))
+             (set! (player-year-rules player)
+               (cons (alist-ref '?value action) (player-year-rules player)))))
           ((eq? a 'goto)
            (set! (player-previous-space player) (player-space player))
            (set! (player-space player)
@@ -1676,7 +1729,7 @@
                    (begin (push! (car new-ff) (player-farmers-fates player))
                           (set! (game-farmers-fates game) remaining-ffs))
                    (set! (game-farmers-fates game) (append remaining-ffs new-ff)))
-               `((actions . ,((alist-ref 'action (car new-ff)) player))
+               `((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))
@@ -1696,22 +1749,36 @@
                        (player-harvest-mult player)))))
              (if (not (already-harvested? (alist-ref '?value action) player))
                  (begin
-                   (push-message player (conc crop " Harvest! You rolled a " rolled
-                                              " and earned $" income "!"))
-                   (when (not (= (player-harvest-mult player) 1))
-                     (push-message player (conc "Harvest multiplied by " (player-harvest-mult player) "!")))
                    (set! (player-cash player)
                      (+ (player-cash player) income))
                    (set! (player-harvest-mult player) 1)
-                   (let ((operating-expense (draw-operating-expense))
-                         (previous-cash (player-cash player)))
+                   (let ((operating-expense (draw-operating-expense game))
+                         (previous-cash (player-cash player))
+                         (other-previous-cash (map (lambda (p)
+                                                     (cons p (player-cash p)))
+                                                   (filter
+                                                    (lambda (p)
+                                                      (not (string=? (player-name p)
+                                                                     (player-name player))))
+                                                    (game-players game)))))
                      ((alist-ref 'action operating-expense) player)
-                     (push-message player (alist-ref 'summary operating-expense))
                      `((rolled . ,rolled)
                        (income . ,income)
                        (operatingExpense . ,(alist-ref 'contents operating-expense))
-                       (operatingExpenseValue . ,(- (player-cash player)
-                                                    previous-cash))
+                       (operatingExpenseValue . ((,(string->symbol (player-name player))
+                                                   . ,(- (player-cash player)
+                                                         previous-cash))
+                                                  ,@(map (lambda (p/c)
+                                                           (let ((p (car p/c)))
+                                                             `(,(string->symbol (player-name p))
+                                                               . ,(- (player-cash p)
+                                                                     (cdr p/c)))))
+                                                         (filter
+                                                          (lambda (p/c)
+                                                            (not (= 0
+                                                                    (- (player-cash (car p/c))
+                                                                       (cdr p/c)))))
+                                                          other-previous-cash))))
                        (crop . ,(symbol->string (alist-ref '?value action)))
                        (acres . ,acres))))
                  'nothing))))))
@@ -1754,6 +1821,12 @@
                   ((eq? b 'goto) #f)
                   (else #f))))))
 
+(define (first-game)
+  (car (app-games *app*)))
+
+(define (gp i)
+  (list-ref (game-players (first-game)) i))
+
 (cond-expand
   (geiser
    '())
@@ -1762,11 +1835,34 @@
    (repl))
   (compiling ;; production
    (run-awful)
-   (thread-join! *server-thread*)))
+   (repl)
+   ;; (thread-join! *server-thread*)
+   ))
 
 ;; TODO
-;; make game finished display results.
 ;; make sure two players can't have the same name
 ;; info actions should look better
 ;; you can get $50 from harvest
-;; bug: new websocket messages should not reset IFS card selection
+;; moving bug 5 from oct 2 saw by player 2
+;;  from harvest moon rolled 5
+;; finished
+;; infinite loop ((?action . end-game) (?value . #<procedure (a10302)>))
+
+;; interface.js:172 Uncaught TypeError: Cannot read property 'toFixed' of undefined
+;;     at formatMoney (interface.js:172)
+;;     at interface.js:248
+;;     at Object.dispatch (redux.js:222)
+;;     at interface.js:94
+;;     at bk (react-dom.production.min.js:224)
+;;     at WebSocket.handleMessage (interface.js:46)
+
+;; auto-skip loop
+;; harvester / tractor don't say total price
+
+;; trade screen: person who porposed trade is wrong
+;; mark spaces
+
+;; decling trade doesn't work
+;; support trading farmers fates
+;; repay loan box 1 more than max can repay
+;; test tractor/harvester a lot better