|
|
|
@ -129,7 +129,13 @@
|
|
|
|
|
(harvesting initform: #f accessor: player-harvesting)
|
|
|
|
|
(hay-doubled initform: #f accessor: player-hay-doubled)
|
|
|
|
|
(corn-doubled initform: #f accessor: player-corn-doubled)
|
|
|
|
|
(ready-to-start initform: #f accessor: player-ready-to-start)))
|
|
|
|
|
(ready-to-start initform: #f accessor: player-ready-to-start)
|
|
|
|
|
(stats initform:
|
|
|
|
|
'((pro . 0)
|
|
|
|
|
(back . 0)
|
|
|
|
|
(tax-person . 0)
|
|
|
|
|
(emergency . 0))
|
|
|
|
|
accessor: player-stats)))
|
|
|
|
|
|
|
|
|
|
(define-class <ai> (<player>)
|
|
|
|
|
((processing-turn initform: #f accessor: ai-processing-turn)))
|
|
|
|
@ -193,7 +199,8 @@
|
|
|
|
|
(last-updated . 0)
|
|
|
|
|
(last-cash . ,(player-cash player))
|
|
|
|
|
(hay-doubled . ,(player-hay-doubled player))
|
|
|
|
|
(corn-doubled . ,(player-corn-doubled player))))
|
|
|
|
|
(corn-doubled . ,(player-corn-doubled player))
|
|
|
|
|
(stats . ,(player-stats player))))
|
|
|
|
|
|
|
|
|
|
(define (game->sexp g)
|
|
|
|
|
`((id . ,(game-id g))
|
|
|
|
@ -319,7 +326,7 @@
|
|
|
|
|
'(cash debt space previous-space state assets ridges
|
|
|
|
|
harvest-mult otbs user-id revealed-cards
|
|
|
|
|
year-rules next-year-rules hay-doubled corn-doubled
|
|
|
|
|
color name trade last-updated last-cash)))))
|
|
|
|
|
color name trade last-updated last-cash stats)))))
|
|
|
|
|
(when (not (player-revealed-cards p))
|
|
|
|
|
(safe-set! (player-revealed-cards p) '()))
|
|
|
|
|
p))
|
|
|
|
@ -918,7 +925,27 @@
|
|
|
|
|
(lambda (p1 p2)
|
|
|
|
|
(> (player-net-worth p1)
|
|
|
|
|
(player-net-worth p2))))
|
|
|
|
|
(iota (length (game-players game)) 1)))))
|
|
|
|
|
(iota (length (game-players game)) 1))))
|
|
|
|
|
(stats . ((pro . ,(let ((p (car (sort (game-players game)
|
|
|
|
|
(lambda (p1 p2)
|
|
|
|
|
(> (alist-ref 'pro (player-stats p1))
|
|
|
|
|
(alist-ref 'pro (player-stats p2))))))))
|
|
|
|
|
(conc "Most suns aligned: " (player-name p) " (" (alist-ref 'pro (player-stats p)) ")")))
|
|
|
|
|
(back . ,(let ((p (car (sort (game-players game)
|
|
|
|
|
(lambda (p1 p2)
|
|
|
|
|
(> (alist-ref 'back (player-stats p1))
|
|
|
|
|
(alist-ref 'back (player-stats p2))))))))
|
|
|
|
|
(conc "Most licences expired: " (player-name p) " (" (alist-ref 'back (player-stats p)) ")")))
|
|
|
|
|
(taxPerson . ,(let ((p (car (sort (game-players game)
|
|
|
|
|
(lambda (p1 p2)
|
|
|
|
|
(> (alist-ref 'tax-person (player-stats p1))
|
|
|
|
|
(alist-ref 'tax-person (player-stats p2))))))))
|
|
|
|
|
(conc "Needs a tax person: " (player-name p) " (" (alist-ref 'tax-person (player-stats p)) ")")))
|
|
|
|
|
(emergency . ,(let ((p (car (sort (game-players game)
|
|
|
|
|
(lambda (p1 p2)
|
|
|
|
|
(> (alist-ref 'emergency (player-stats p1))
|
|
|
|
|
(alist-ref 'emergency (player-stats p2))))))))
|
|
|
|
|
(conc "Living on the edge: " (player-name p) " (" (alist-ref 'emergency (player-stats p)) ")"))))))
|
|
|
|
|
type: "end-of-game"))
|
|
|
|
|
|
|
|
|
|
(define (create-ws-response player event misc)
|
|
|
|
@ -1271,9 +1298,12 @@
|
|
|
|
|
(if (> (+ (player-debt player)
|
|
|
|
|
(farming-round (+ amount (* amount (game-setting 'loan-interest game)))))
|
|
|
|
|
(game-setting 'max-debt game))
|
|
|
|
|
(begin (safe-set! (player-cash player) (+ (player-cash player) amount))
|
|
|
|
|
;; emergency loan
|
|
|
|
|
(begin ((make-player-stat 'emergency amount) player)
|
|
|
|
|
(safe-set! (player-cash player) (+ (player-cash player) amount))
|
|
|
|
|
(safe-set! (player-display-cash player) (player-cash player))
|
|
|
|
|
(safe-set! (player-debt player) (+ (player-debt player) (* amount 2))))
|
|
|
|
|
;; regular loan
|
|
|
|
|
(begin (safe-set! (player-cash player) (+ (player-cash player) amount))
|
|
|
|
|
(safe-set! (player-display-cash player) (player-cash player))
|
|
|
|
|
(safe-set! (player-debt player) (+ (player-debt player)
|
|
|
|
@ -1930,6 +1960,7 @@
|
|
|
|
|
'()))
|
|
|
|
|
#f)
|
|
|
|
|
(1 ,(lambda (player game)
|
|
|
|
|
((make-player-stat 'tax-person 1) player)
|
|
|
|
|
(push! (make-player-year-rule 5 '((?p ?any harvest-mult 0) (?p ?crop)))
|
|
|
|
|
(player-year-rules player))
|
|
|
|
|
'())
|
|
|
|
@ -2078,7 +2109,11 @@
|
|
|
|
|
(when (not (already-harvested? 'wheat player))
|
|
|
|
|
((make-player-pays-per-unit 'grain 50) player)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define (make-player-stat stat amount)
|
|
|
|
|
(lambda (p)
|
|
|
|
|
(safe-set! (player-stats p)
|
|
|
|
|
(alist-update stat (+ (alist-ref stat (player-stats p)) amount)
|
|
|
|
|
(player-stats p)))))
|
|
|
|
|
|
|
|
|
|
(define (get-actions player space)
|
|
|
|
|
(let ((res '()))
|
|
|
|
@ -2097,6 +2132,7 @@
|
|
|
|
|
((mar1 money ?p ,(pays 2000)))
|
|
|
|
|
((mar2 money ?p ,(pays 500)))
|
|
|
|
|
((mar3 goto ?p jan2))
|
|
|
|
|
((mar3 player-action ?p ,(make-player-stat 'back 1)))
|
|
|
|
|
((mar4 money ?p ,(pays 2000)) (?p fruit))
|
|
|
|
|
((apr1 draw ?p otb))
|
|
|
|
|
((apr2 add-rule ?p ,(make-player-year-rule
|
|
|
|
@ -2130,6 +2166,7 @@
|
|
|
|
|
((jul5 harvest ?p wheat) (?p grain))
|
|
|
|
|
((aug1 harvest ?p wheat) (?p grain))
|
|
|
|
|
((aug1 goto ?p feb4))
|
|
|
|
|
((aug1 player-action ?p ,(make-player-stat 'pro 1)))
|
|
|
|
|
((aug1 player-action-post-harvest ?p ,finish-year))
|
|
|
|
|
((aug2 harvest ?p wheat) (?p grain))
|
|
|
|
|
((aug2 money ?p ,(gains 1000)) (?p harvester))
|
|
|
|
@ -2400,4 +2437,3 @@
|
|
|
|
|
;; TODO
|
|
|
|
|
;; make sure two players can't have the same name
|
|
|
|
|
;; "your turn to roll" showing up on mobile when on action screen
|
|
|
|
|
;; trade cards better
|
|
|
|
|