Birthdays!

src/server/farm.scm

@@ -106,7 +106,8 @@
    (finished initform: #f accessor: player-finished)
    (assets initform:
            '((hay . 10) (grain . 10) (fruit . 0) (cows . 0)
-             (harvester . 0) (tractor . 0))
+             (harvester . 0) (tractor . 0)
+             (birthday . 0))
            accessor: player-assets)
    (ridges initform:
            '((ridge1 . 0) (ridge2 . 0) (ridge3 . 0) (ridge4 . 0))
@@ -1939,7 +1940,7 @@
 (define (gains amount) (lambda (n) (+ n amount)))
 
 (define (player-crop-rule player crop)
-  (if (> (alist-ref crop (player-assets player)) 0) `(((tom ,crop))) '()))
+  (if (> (alist-ref crop (player-assets player) eqv? 0) 0) `(((tom ,crop))) '()))
 
 (define (aug4-action player)
   (when (not (already-harvested? 'wheat player))
@@ -1969,6 +1970,7 @@
      ((apr2 add-rule ?p ,(make-player-year-rule
                           10 '((?p corn harvest-mult 2) (?p grain)))))
      ((apr2 player-action ?p ,(lambda (p) (safe-set! (player-corn-doubled p) #t))))
+     ((apr2 money ?p ,(gains 5000)) (?p birthday))
      ((apr3 money ?p ,(pays 500)))
      ((apr4 money ?p ,(pays 1000)))
      ((may1 money ?p ,(gains 500)))
@@ -2045,7 +2047,8 @@
      ,@(player-crop-rule player 'hay)
      ,@(player-crop-rule player 'grain)
      ,@(player-crop-rule player 'tractor)
-     ,@(player-crop-rule player 'harvester))
+     ,@(player-crop-rule player 'harvester)
+     ,@(player-crop-rule player 'birthday))
    `((,(list-ref *months* space) ?action tom ?value)))))
       (if a
           (begin (set! res (cons a res)) (loop (amb+)))
@@ -2238,6 +2241,15 @@
 (define (gp i)
   (list-ref (game-players (first-game)) i))
 
+(define (gn name)
+  (find (lambda (p) (equal? (player-name p) name))
+        (game-players (first-game))))
+
+(define (gnb name)
+  (let ((player (gn name)))
+    (safe-set! (player-assets player)
+               (alist-update 'birthday 1 (player-assets player)))))
+
 (cond-expand
   (geiser
    '())