|
|
|
|
@ -54,6 +54,8 @@
|
|
|
|
|
(lambda ()
|
|
|
|
|
(SRV:send-reply (pre-post-order* sxml rules)))))))
|
|
|
|
|
|
|
|
|
|
(define *game* (make-parameter #f))
|
|
|
|
|
|
|
|
|
|
(define-syntax safe-set!
|
|
|
|
|
(ir-macro-transformer
|
|
|
|
|
(lambda (x i c)
|
|
|
|
|
@ -97,6 +99,9 @@
|
|
|
|
|
(hay-doubled initform: #f accessor: player-hay-doubled)
|
|
|
|
|
(corn-doubled initform: #f accessor: player-corn-doubled)))
|
|
|
|
|
|
|
|
|
|
(define-class <ai> (<player>)
|
|
|
|
|
((processing-turn initform: #f accessor: ai-processing-turn)))
|
|
|
|
|
|
|
|
|
|
(define-class <game> ()
|
|
|
|
|
((id initform: 0 accessor: game-id)
|
|
|
|
|
(players initform: '() accessor: game-players)
|
|
|
|
|
@ -319,6 +324,20 @@
|
|
|
|
|
(safe-set! (game-current-player game) player))
|
|
|
|
|
player))
|
|
|
|
|
|
|
|
|
|
(define (add-ai-to-game game color name)
|
|
|
|
|
(let ((player (make <ai>
|
|
|
|
|
'cash 10000
|
|
|
|
|
'display-cash (game-setting 'starting-cash game)
|
|
|
|
|
'debt (game-setting 'starting-debt game)
|
|
|
|
|
'color color
|
|
|
|
|
'name name
|
|
|
|
|
'state (if (= (length (game-players game)) 0)
|
|
|
|
|
'pre-turn 'turn-ended))))
|
|
|
|
|
(safe-set! (game-players game) (append (game-players game) (list player)))
|
|
|
|
|
(when (= (length (game-players game)) 1)
|
|
|
|
|
(safe-set! (game-current-player game) player))
|
|
|
|
|
player))
|
|
|
|
|
|
|
|
|
|
(define (all-players-finished game)
|
|
|
|
|
(null? (filter (lambda (p)
|
|
|
|
|
(not (player-finished p)))
|
|
|
|
|
@ -399,7 +418,7 @@
|
|
|
|
|
;; (print "</body></html>")))
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
(define (player->list p)
|
|
|
|
|
(define-method (player->list (p <player>))
|
|
|
|
|
`((player . ((assets . ,(player-assets p))
|
|
|
|
|
(ridges . ,(player-ridges p))
|
|
|
|
|
(cash . ,(player-cash p))
|
|
|
|
|
@ -414,7 +433,29 @@
|
|
|
|
|
(trade . ,(player-trade p))
|
|
|
|
|
(lastCash . ,(player-last-cash p))
|
|
|
|
|
(hayDoubled . ,(player-hay-doubled p))
|
|
|
|
|
(cornDoubled . ,(player-corn-doubled p))))))
|
|
|
|
|
(cornDoubled . ,(player-corn-doubled p))
|
|
|
|
|
(ai . #f)))))
|
|
|
|
|
|
|
|
|
|
(define-method (player->list (p <ai>))
|
|
|
|
|
`((player . ((assets . ,(player-assets p))
|
|
|
|
|
(ridges . ,(player-ridges p))
|
|
|
|
|
(cash . ,(player-cash p))
|
|
|
|
|
(displayCash . ,(player-display-cash p))
|
|
|
|
|
(debt . ,(player-debt p))
|
|
|
|
|
(space . ,(player-space p))
|
|
|
|
|
(state . ,(symbol->string (player-state p)))
|
|
|
|
|
(cards . ,(list->vector (append (player-farmers-fates p)
|
|
|
|
|
(player-otbs p))))
|
|
|
|
|
(color . ,(symbol->string (player-color p)))
|
|
|
|
|
(name . ,(player-name p))
|
|
|
|
|
(trade . ,(player-trade p))
|
|
|
|
|
(lastCash . ,(player-last-cash p))
|
|
|
|
|
(hayDoubled . ,(player-hay-doubled p))
|
|
|
|
|
(cornDoubled . ,(player-corn-doubled p))
|
|
|
|
|
(ai . #t)))))
|
|
|
|
|
|
|
|
|
|
(define-method (ai-player? (p <ai>)) #t)
|
|
|
|
|
(define-method (ai-player? (p <player>)) #f)
|
|
|
|
|
|
|
|
|
|
(define (game->list g player)
|
|
|
|
|
`((game . ((messages . ,(list->vector (reverse (game-messages g))))
|
|
|
|
|
@ -435,9 +476,6 @@
|
|
|
|
|
(auditThreshold . ,(game-setting 'audit-threshold g))
|
|
|
|
|
(trade . ,(game-setting 'trade g))))))))
|
|
|
|
|
|
|
|
|
|
(define (push-message player msg #!key (game (session-ref (sid) 'game)))
|
|
|
|
|
(void))
|
|
|
|
|
|
|
|
|
|
(define (buy-crop crop unnormalized-crop amount cash-value player game)
|
|
|
|
|
(let ((total-cost (* amount (alist-ref unnormalized-crop
|
|
|
|
|
'((hay . 2000) (grain . 2000)
|
|
|
|
|
@ -484,13 +522,11 @@
|
|
|
|
|
`((id . ,id) (rule . ,rule)))
|
|
|
|
|
|
|
|
|
|
(define (finish-year player #!optional (collect-wages #t))
|
|
|
|
|
(let ((game (session-ref (sid) 'game)))
|
|
|
|
|
(let ((game (*game*)))
|
|
|
|
|
(when collect-wages
|
|
|
|
|
(safe-set! (player-cash player)
|
|
|
|
|
(+ (player-cash player) 5000))
|
|
|
|
|
(safe-set! (player-display-cash player) (player-cash player))
|
|
|
|
|
(push-message player
|
|
|
|
|
(conc "You earned $5,000 from your city job!"))
|
|
|
|
|
(safe-set! (game-actions game)
|
|
|
|
|
(cons '((?action . info)
|
|
|
|
|
(?value . "You earned $5,000 from your city job!"))
|
|
|
|
|
@ -733,10 +769,7 @@
|
|
|
|
|
|
|
|
|
|
(define (call-audit game player)
|
|
|
|
|
(if (game-called-audit game)
|
|
|
|
|
(push-message player (conc (player-name (game-called-audit game))
|
|
|
|
|
" already called audit!"))
|
|
|
|
|
(begin (safe-set! (game-called-audit game) player)
|
|
|
|
|
(push-message player (conc (player-name player) " has called an audit!")))))
|
|
|
|
|
(begin (safe-set! (game-called-audit game) player))))
|
|
|
|
|
|
|
|
|
|
(define (player-net-worth player)
|
|
|
|
|
(+ (* (+ (player-asset 'hay player) (player-asset 'grain player)) 2000)
|
|
|
|
|
@ -764,7 +797,7 @@
|
|
|
|
|
(define (create-ws-response player event misc)
|
|
|
|
|
(append `((event . ,event) ,@misc)
|
|
|
|
|
(player->list player)
|
|
|
|
|
(game->list (session-ref (sid) 'game) player)))
|
|
|
|
|
(game->list (*game*) player)))
|
|
|
|
|
|
|
|
|
|
(define (create-start-response event)
|
|
|
|
|
`((event . ,event)
|
|
|
|
|
@ -824,7 +857,6 @@
|
|
|
|
|
(safe-set! (player-space player)
|
|
|
|
|
(+ (player-space player) num))
|
|
|
|
|
(safe-set! (player-state player) 'mid-turn)
|
|
|
|
|
(push-message player (conc "You rolled a " num))
|
|
|
|
|
(when (> (player-space player) 48)
|
|
|
|
|
(safe-set! (player-space player)
|
|
|
|
|
(- (player-space player) 49)))
|
|
|
|
|
@ -999,6 +1031,15 @@
|
|
|
|
|
(loop (+ i 1)))
|
|
|
|
|
(else ;; TODO make error
|
|
|
|
|
(create-ws-response player "action" `((action . ,name)))))))))
|
|
|
|
|
((and (string=? type "next-action")
|
|
|
|
|
(ai-player? (game-current-player game)))
|
|
|
|
|
(print "ai next action trigger")
|
|
|
|
|
(print (player-name (game-current-player game)))
|
|
|
|
|
(message-players! game player '() type: "ai-next-action")
|
|
|
|
|
(create-ws-response player "update" `()))
|
|
|
|
|
((string=? type "end-ai-turn")
|
|
|
|
|
(message-players! game player '() type: "end-ai-turn")
|
|
|
|
|
(create-ws-response player "update" `()))
|
|
|
|
|
((string=? type "skip")
|
|
|
|
|
(when (and (player-harvesting player) (string=? (alist-ref 'component msg) "harvest|income"))
|
|
|
|
|
;; player-harvesting will contain the operating expense amount
|
|
|
|
|
@ -1061,8 +1102,7 @@
|
|
|
|
|
(farming-round
|
|
|
|
|
(+ amount (* amount (game-setting 'loan-interest game))))))))
|
|
|
|
|
;; repaying loan
|
|
|
|
|
(cond ((> (abs amount) (player-cash player))
|
|
|
|
|
(push-message player "Not enough cash to repay loan."))
|
|
|
|
|
(cond ((> (abs amount) (player-cash player)))
|
|
|
|
|
(else
|
|
|
|
|
(safe-set! (player-cash player) (+ (player-cash player) amount))
|
|
|
|
|
(safe-set! (player-display-cash player) (player-cash player))
|
|
|
|
|
@ -1071,9 +1111,7 @@
|
|
|
|
|
(safe-set! (player-cash player) (+ (player-cash player)
|
|
|
|
|
(abs (player-debt player))))
|
|
|
|
|
(safe-set! (player-display-cash player) (player-cash player))
|
|
|
|
|
(safe-set! (player-debt player) 0))
|
|
|
|
|
(push-message player (conc "Loan of $" (abs amount) " repayed."))))
|
|
|
|
|
))
|
|
|
|
|
(safe-set! (player-debt player) 0))))))
|
|
|
|
|
(create-ws-response player "loan" '()))
|
|
|
|
|
((string=? type "trade")
|
|
|
|
|
(let ((res (propose-trade game player (alist-ref 'parameters msg))))
|
|
|
|
|
@ -1088,8 +1126,6 @@
|
|
|
|
|
(message-players! game player '() type: "update")
|
|
|
|
|
(create-ws-response player "trade-accepted" '()))
|
|
|
|
|
((string=? type "trade-deny")
|
|
|
|
|
(push-message player (conc (player-name player) " denied trade with "
|
|
|
|
|
(alist-ref 'originator (player-trade player)) "."))
|
|
|
|
|
(safe-set! (player-trade (find-player-by-name
|
|
|
|
|
game (alist-ref 'originator (player-trade player))))
|
|
|
|
|
'())
|
|
|
|
|
@ -1097,8 +1133,6 @@
|
|
|
|
|
(message-players! game player '() type: "update")
|
|
|
|
|
(create-ws-response player "trade-denied" '()))
|
|
|
|
|
((string=? type "trade-cancel")
|
|
|
|
|
(push-message player (conc (player-name player) " cancelled trade with "
|
|
|
|
|
(alist-ref 'player (player-trade player)) "."))
|
|
|
|
|
(safe-set! (player-trade (find-player-by-name
|
|
|
|
|
game (alist-ref 'player (player-trade player))))
|
|
|
|
|
'())
|
|
|
|
|
@ -1129,8 +1163,7 @@
|
|
|
|
|
(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" '()))))
|
|
|
|
|
(begin (create-ws-response player "update" '()))))
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;; start ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
((string=? type "main-init")
|
|
|
|
|
(create-start-response "start-init"))
|
|
|
|
|
@ -1156,11 +1189,15 @@
|
|
|
|
|
(trade . ,(or (alist-ref 'trade msg) #t)))))
|
|
|
|
|
(player (add-player-to-game game
|
|
|
|
|
color
|
|
|
|
|
(alist-ref 'playerName msg))))
|
|
|
|
|
(alist-ref 'playerName msg)))
|
|
|
|
|
(ai-player (add-ai-to-game game 'red "AI Player 1")))
|
|
|
|
|
(push! game (app-games *app*))
|
|
|
|
|
(session-set! (sid) 'player player)
|
|
|
|
|
(session-set! (sid) 'game game)
|
|
|
|
|
(*game* game)
|
|
|
|
|
(set-startup-otbs game player 2)
|
|
|
|
|
(set-startup-otbs game ai-player 2)
|
|
|
|
|
(thread-start! (make-ai-push-receiver game ai-player))
|
|
|
|
|
(create-start-response "new-game-started")))
|
|
|
|
|
((string=? type "join-game")
|
|
|
|
|
(let* ((name (alist-ref 'gameName msg))
|
|
|
|
|
@ -1177,6 +1214,7 @@
|
|
|
|
|
(safe-set! (game-colors game) (filter (cut neq? <> color) (game-colors game)))
|
|
|
|
|
(session-set! (sid) 'player player)
|
|
|
|
|
(session-set! (sid) 'game game)
|
|
|
|
|
(*game* game)
|
|
|
|
|
(set-startup-otbs game player 2)
|
|
|
|
|
(message-players! game player '() type: "update")
|
|
|
|
|
(create-start-response "new-game-started")))
|
|
|
|
|
@ -1190,9 +1228,63 @@
|
|
|
|
|
(game-players game))))
|
|
|
|
|
(session-set! (sid) 'player player)
|
|
|
|
|
(session-set! (sid) 'game game)
|
|
|
|
|
(*game* game)
|
|
|
|
|
(create-start-response "new-game-started")))
|
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
(define (process-ai-push-message player game msg)
|
|
|
|
|
(print (player-name player))
|
|
|
|
|
(print msg)
|
|
|
|
|
(case (string->symbol (alist-ref 'type msg))
|
|
|
|
|
((update)
|
|
|
|
|
(if (and (eq? (player-state player) 'pre-turn)
|
|
|
|
|
(not (ai-processing-turn player)))
|
|
|
|
|
(begin (set! (ai-processing-turn player) #t)
|
|
|
|
|
(let ((res (process-message player game "roll" '((type . "roll")))))
|
|
|
|
|
(print "rolled a " (alist-ref 'value res))
|
|
|
|
|
;; (process-message player game "next-action" '((type . "next-action")))
|
|
|
|
|
;; (let loop ((msg (process-message player game "next-action" '((type . "next-action")))))
|
|
|
|
|
;; (if (alist-ref 'action msg)
|
|
|
|
|
;; (loop (process-message player game "next-action" '((type . "next-action"))))
|
|
|
|
|
;; (print "done with actions")))
|
|
|
|
|
))))
|
|
|
|
|
((auto-skip)
|
|
|
|
|
(print "ai auto-skip")
|
|
|
|
|
;; (when (ai-processing-turn player)
|
|
|
|
|
;; (process-message player game "next-action" '((type . "next-action"))))
|
|
|
|
|
)
|
|
|
|
|
((ai-next-action)
|
|
|
|
|
(print "ai-next-action")
|
|
|
|
|
(when (ai-processing-turn player)
|
|
|
|
|
(let ((res (process-message player game "next-action" '((type . "next-action")))))
|
|
|
|
|
(display "res: ")
|
|
|
|
|
(write res)
|
|
|
|
|
(newline)
|
|
|
|
|
;; (print "res1: " (eq? (alist-ref 'event res) 'action))
|
|
|
|
|
;; (print "res2: " (not (alist-ref 'action res)))
|
|
|
|
|
;; (print "res3: " (and (eq? (alist-ref 'event res) 'action)
|
|
|
|
|
;; (not (alist-ref 'action res))))
|
|
|
|
|
;; (when (and (string=? (alist-ref 'event res) "action")
|
|
|
|
|
;; (not (alist-ref 'action res)))
|
|
|
|
|
;; (print "ending turn")
|
|
|
|
|
;; (thread-sleep! 0.5)
|
|
|
|
|
;; (set! (ai-processing-turn player) #f)
|
|
|
|
|
;; (process-message player game "turn-ended" '()))
|
|
|
|
|
)))
|
|
|
|
|
((end-ai-turn)
|
|
|
|
|
(when (ai-processing-turn player)
|
|
|
|
|
(print "ending turn")
|
|
|
|
|
(thread-sleep! 0.5)
|
|
|
|
|
(set! (ai-processing-turn player) #f)
|
|
|
|
|
(process-message player game "turn-ended" '())
|
|
|
|
|
))))
|
|
|
|
|
|
|
|
|
|
(define (make-ai-push-receiver game player)
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let loop ((msg (mailbox-receive! (player-mailbox player))))
|
|
|
|
|
(process-ai-push-message player game msg)
|
|
|
|
|
(loop (mailbox-receive! (player-mailbox player))))))
|
|
|
|
|
|
|
|
|
|
(define (websocket-page)
|
|
|
|
|
(sid (read-cookie (session-cookie-name)))
|
|
|
|
|
;; TODO some kind of error handling if (sid) #f
|
|
|
|
|
@ -1236,6 +1328,7 @@
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let ((game (session-ref (sid) 'game))
|
|
|
|
|
(player (session-ref (sid) 'player)))
|
|
|
|
|
(*game* game)
|
|
|
|
|
(let loop ((msg (mailbox-receive! (player-mailbox player))))
|
|
|
|
|
(print msg)
|
|
|
|
|
(when (not game)
|
|
|
|
|
@ -1368,17 +1461,14 @@
|
|
|
|
|
(safe-set! (player-cash player)
|
|
|
|
|
(+ (player-cash player) amount-per-player)))
|
|
|
|
|
(players-with equipment game)))))
|
|
|
|
|
(push-message player (conc "You paid $" amount "!"))
|
|
|
|
|
(safe-set! (player-cash player) (- (player-cash player) amount))))
|
|
|
|
|
|
|
|
|
|
(define (make-player-gains amount)
|
|
|
|
|
(lambda (player)
|
|
|
|
|
(push-message player (conc "You gained $" amount "!"))
|
|
|
|
|
(safe-set! (player-cash player) (+ (player-cash player) amount))))
|
|
|
|
|
|
|
|
|
|
(define (make-player-pays amount)
|
|
|
|
|
(lambda (player)
|
|
|
|
|
(push-message player (conc "You paid $" amount "!"))
|
|
|
|
|
(safe-set! (player-cash player) (- (player-cash player) amount))))
|
|
|
|
|
|
|
|
|
|
(define (make-player-pays-per-unit unit amount)
|
|
|
|
|
@ -1408,7 +1498,7 @@
|
|
|
|
|
|
|
|
|
|
(define (make-remove-farmers-fate-from-hand id)
|
|
|
|
|
(lambda (player)
|
|
|
|
|
(let ((game (session-ref (sid) 'game)))
|
|
|
|
|
(let ((game (*game*)))
|
|
|
|
|
(safe-set! (game-farmers-fates game)
|
|
|
|
|
(append (game-farmers-fates game)
|
|
|
|
|
(filter (lambda (x) (eq? (alist-ref 'internal-id x) id))
|
|
|
|
|
@ -1479,7 +1569,7 @@
|
|
|
|
|
(if (odd? roll)
|
|
|
|
|
((make-player-pays (* (player-acres p) 100)) p))))
|
|
|
|
|
(filter (lambda (x) (not (eq? x player)))
|
|
|
|
|
(game-players (session-ref (sid) 'game))))
|
|
|
|
|
(game-players (*game*))))
|
|
|
|
|
((make-player-gains-per-unit 'hay 500) player)))
|
|
|
|
|
#f)
|
|
|
|
|
(1 ,(lambda (player game)
|
|
|
|
|
@ -1539,7 +1629,7 @@
|
|
|
|
|
#f)
|
|
|
|
|
(2 ,(lambda (player game)
|
|
|
|
|
(with-ff-money-action (player game)
|
|
|
|
|
(equipment-payout 'tractor player 3000 (session-ref (sid) 'game))))
|
|
|
|
|
(equipment-payout 'tractor player 3000 (*game*))))
|
|
|
|
|
#f)
|
|
|
|
|
(1 ,(lambda (player game)
|
|
|
|
|
(if (player-has-asset? 'harvester player)
|
|
|
|
|
@ -1551,7 +1641,7 @@
|
|
|
|
|
(- (player-cash from-player) 2000))
|
|
|
|
|
(safe-set! (player-cash player)
|
|
|
|
|
(+ (player-cash player) 2000)))))
|
|
|
|
|
(game-players (session-ref (sid) 'game))))
|
|
|
|
|
(game-players (*game*))))
|
|
|
|
|
'()))
|
|
|
|
|
#f)
|
|
|
|
|
(1 ,(lambda (player game)
|
|
|
|
|
@ -1565,7 +1655,7 @@
|
|
|
|
|
(1 ,(lambda (player game)
|
|
|
|
|
(with-ff-money-action (player game)
|
|
|
|
|
(equipment-payout 'harvester player 2500
|
|
|
|
|
(session-ref (sid) 'game))))
|
|
|
|
|
(*game*))))
|
|
|
|
|
#f)
|
|
|
|
|
(1 ,(lambda (player game)
|
|
|
|
|
(push! (make-player-year-rule 6 `((?p cows harvest-mult 1.5) (?p cows)))
|
|
|
|
|
@ -1601,8 +1691,6 @@
|
|
|
|
|
(ridge-cows (cows-on-ridges player)))
|
|
|
|
|
(if (> cows ridge-cows)
|
|
|
|
|
(let ((slaughtered-cows (- cows ridge-cows)))
|
|
|
|
|
(push-message player (conc slaughtered-cows
|
|
|
|
|
" cows slaughtered on your farm."))
|
|
|
|
|
(safe-set! (player-assets player)
|
|
|
|
|
(alist-update 'cows (- (alist-ref 'cows (player-assets player)) (- cows ridge-cows))
|
|
|
|
|
(player-assets player)))
|
|
|
|
|
@ -1654,9 +1742,9 @@
|
|
|
|
|
(safe-set! (player-cash player)
|
|
|
|
|
(- (player-cash player) to-pay)))))
|
|
|
|
|
(2 ,(lambda (player)
|
|
|
|
|
(equipment-payout 'harvester player 2000 (session-ref (sid) 'game))))
|
|
|
|
|
(equipment-payout 'harvester player 2000 (*game*))))
|
|
|
|
|
(2 ,(lambda (player)
|
|
|
|
|
(equipment-payout 'tractor player 2000 (session-ref (sid) 'game))))
|
|
|
|
|
(equipment-payout 'tractor player 2000 (*game*))))
|
|
|
|
|
(1 ,(make-player-pays-per-unit 'cows 100))
|
|
|
|
|
(2 ,(make-player-pays 500))
|
|
|
|
|
(1 ,(make-player-pays 1500))
|
|
|
|
|
@ -1869,11 +1957,8 @@
|
|
|
|
|
|
|
|
|
|
(define (do-action action player)
|
|
|
|
|
(let ((a (alist-ref '?action action))
|
|
|
|
|
(game (session-ref (sid) 'game)))
|
|
|
|
|
(game (*game*)))
|
|
|
|
|
(cond ((eq? a 'money)
|
|
|
|
|
(let ((changed ((alist-ref '?value action) 0)))
|
|
|
|
|
(push-message player (conc "You " (if (>= changed 0) "earned" "paid") " $"
|
|
|
|
|
(abs changed) "!")))
|
|
|
|
|
(safe-set! (player-cash player)
|
|
|
|
|
((alist-ref '?value action) (player-cash player))))
|
|
|
|
|
((eq? a 'add-rule)
|
|
|
|
|
@ -1888,19 +1973,17 @@
|
|
|
|
|
(let ((month (alist-ref '?value action)))
|
|
|
|
|
(list-index (lambda (x) (eq? x month)) *months*))))
|
|
|
|
|
((and (eq? a 'draw) (eq? (alist-ref '?value action) 'otb))
|
|
|
|
|
(if (not (null? (game-otbs (session-ref (sid) 'game))))
|
|
|
|
|
(draw-otb player (session-ref (sid) 'game))
|
|
|
|
|
(if (not (null? (game-otbs game)))
|
|
|
|
|
(draw-otb player game)
|
|
|
|
|
#f))
|
|
|
|
|
((and (eq? a 'draw) (eq? (alist-ref '?value action) 'farmers-fate))
|
|
|
|
|
(let ((game (session-ref (sid) 'game)))
|
|
|
|
|
(receive (new-ff remaining-ffs) (split-at (game-farmers-fates game) 1)
|
|
|
|
|
(push-message player (conc "Farmers Fate: " (alist-ref 'text (car new-ff))))
|
|
|
|
|
(if (alist-ref 'hold-card (car new-ff))
|
|
|
|
|
(begin (push! (car new-ff) (player-farmers-fates player))
|
|
|
|
|
(safe-set! (game-farmers-fates game) remaining-ffs))
|
|
|
|
|
(safe-set! (game-farmers-fates game) (append remaining-ffs new-ff)))
|
|
|
|
|
`((actions . ,((alist-ref 'action (car new-ff)) player game))
|
|
|
|
|
(contents . ,(alist-ref 'contents (car new-ff)))))))
|
|
|
|
|
(receive (new-ff remaining-ffs) (split-at (game-farmers-fates game) 1)
|
|
|
|
|
(if (alist-ref 'hold-card (car new-ff))
|
|
|
|
|
(begin (push! (car new-ff) (player-farmers-fates player))
|
|
|
|
|
(safe-set! (game-farmers-fates game) remaining-ffs))
|
|
|
|
|
(safe-set! (game-farmers-fates game) (append remaining-ffs new-ff)))
|
|
|
|
|
`((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))
|
|
|
|
|
((eq? a 'harvest-mult)
|
|
|
|
|
@ -2050,3 +2133,21 @@
|
|
|
|
|
;; farm.scm:1129: print-call-chain <--
|
|
|
|
|
|
|
|
|
|
;; Error: (assv) bad argument type: ridge-cows
|
|
|
|
|
|
|
|
|
|
;; proposed trade to wrong player
|
|
|
|
|
;; accidentally clicking no for uncle bert
|
|
|
|
|
;; farmers fate 2nd week of january
|
|
|
|
|
;; error:
|
|
|
|
|
;; Call history:
|
|
|
|
|
|
|
|
|
|
;; farm.scm:129: alist-ref
|
|
|
|
|
;; farm.scm:1213: k7426
|
|
|
|
|
;; farm.scm:1213: g7430
|
|
|
|
|
;; farm.scm:1215: with-output-to-string
|
|
|
|
|
;; farm.scm:1217: print-call-chain <--
|
|
|
|
|
|
|
|
|
|
;; Error: (assv) bad argument type: #<coops instance of `<game>'>
|
|
|
|
|
|
|
|
|
|
;; auto-skip loop wtih harvest
|
|
|
|
|
|
|
|
|
|
;; when getting trade the name is wrong
|
|
|
|
|
|
