|
|
|
@ -68,6 +68,7 @@
|
|
|
|
|
|
|
|
|
|
(define-class <player> ()
|
|
|
|
|
((cash initform: 5000 accessor: player-cash)
|
|
|
|
|
(display-cash initform: 5000 accessor: player-display-cash)
|
|
|
|
|
(debt initform: 5000 accessor: player-debt)
|
|
|
|
|
(space initform: 0 accessor: player-space)
|
|
|
|
|
(previous-space initform: 0 accessor: player-previous-space)
|
|
|
|
@ -91,7 +92,8 @@
|
|
|
|
|
(last-updated initform: 0 accessor: player-last-updated)
|
|
|
|
|
(last-cash initform: 5000 accessor: player-last-cash)
|
|
|
|
|
(mailbox initform: (make-mailbox) accessor: player-mailbox)
|
|
|
|
|
(mutex initform: (make-mutex 'player) accessor: player-mutex)))
|
|
|
|
|
(mutex initform: (make-mutex 'player) accessor: player-mutex)
|
|
|
|
|
(harvesting initform: #f accessor: player-harvesting)))
|
|
|
|
|
|
|
|
|
|
(define-class <game> ()
|
|
|
|
|
((id initform: 0 accessor: game-id)
|
|
|
|
@ -235,6 +237,7 @@
|
|
|
|
|
(define (add-player-to-game game color name)
|
|
|
|
|
(let ((player (make <player>
|
|
|
|
|
'cash (game-setting 'starting-cash game)
|
|
|
|
|
'display-cash (game-setting 'starting-cash game)
|
|
|
|
|
'debt (game-setting 'starting-debt game)
|
|
|
|
|
'color color
|
|
|
|
|
'name name
|
|
|
|
@ -329,6 +332,7 @@
|
|
|
|
|
`((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)))
|
|
|
|
@ -395,6 +399,7 @@
|
|
|
|
|
(player-assets player)
|
|
|
|
|
(alist-update crop (+ (alist-ref crop assets) amount) assets))
|
|
|
|
|
(safe-set! (player-cash player) (- (player-cash player) cash-value))
|
|
|
|
|
(safe-set! (player-display-cash player) (player-cash player))
|
|
|
|
|
(safe-set! (player-debt player)
|
|
|
|
|
(+ (player-debt player) (- total-cost cash-value)))
|
|
|
|
|
(when (member unnormalized-crop ridges)
|
|
|
|
@ -409,7 +414,8 @@
|
|
|
|
|
(let ((game (session-ref (sid) 'game)))
|
|
|
|
|
(when collect-wages
|
|
|
|
|
(safe-set! (player-cash player)
|
|
|
|
|
(+ (player-cash player) 5000))
|
|
|
|
|
(+ (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)
|
|
|
|
@ -588,9 +594,11 @@
|
|
|
|
|
(loop (cdr ridges))))
|
|
|
|
|
(when (alist-ref 'money params)
|
|
|
|
|
(safe-set! (player-cash player)
|
|
|
|
|
(+ (player-cash player) (* (alist-ref 'money params) -1)))
|
|
|
|
|
(+ (player-cash player) (* (alist-ref 'money params) -1)))
|
|
|
|
|
(safe-set! (player-display-cash player) (player-cash player))
|
|
|
|
|
(safe-set! (player-cash originator)
|
|
|
|
|
(+ (player-cash originator) (alist-ref 'money params))))
|
|
|
|
|
(+ (player-cash originator) (alist-ref 'money params)))
|
|
|
|
|
(safe-set! (player-display-cash originator) (player-cash originator)))
|
|
|
|
|
(when (alist-ref 'cards params)
|
|
|
|
|
(for-each
|
|
|
|
|
(lambda (id)
|
|
|
|
@ -702,6 +710,12 @@
|
|
|
|
|
default
|
|
|
|
|
(- n (modulo n 1000)))))
|
|
|
|
|
|
|
|
|
|
(define (reconcile-display-cash player game)
|
|
|
|
|
(unless (player-harvesting player)
|
|
|
|
|
(for-each (lambda (player)
|
|
|
|
|
(safe-set! (player-display-cash player) (player-cash player)))
|
|
|
|
|
(game-players game))))
|
|
|
|
|
|
|
|
|
|
(define (process-message player game type msg)
|
|
|
|
|
(when game
|
|
|
|
|
(safe-set! (game-messages game) '())
|
|
|
|
@ -739,6 +753,7 @@
|
|
|
|
|
(if (or (null? (game-actions game))
|
|
|
|
|
(>= i 15))
|
|
|
|
|
(begin
|
|
|
|
|
(reconcile-display-cash player game)
|
|
|
|
|
(safe-set! (game-actions game) '())
|
|
|
|
|
(message-players! game player `((action . #f) (value . #f)))
|
|
|
|
|
(create-ws-response player "action" '((action . #f))))
|
|
|
|
@ -747,6 +762,7 @@
|
|
|
|
|
(value (alist-ref '?value action)))
|
|
|
|
|
(print action)
|
|
|
|
|
(cond ((eq? value 'otb)
|
|
|
|
|
(reconcile-display-cash player game)
|
|
|
|
|
(let ((otb (do-action action player)))
|
|
|
|
|
(safe-set! (game-actions game) (cdr (game-actions game)))
|
|
|
|
|
(if otb
|
|
|
|
@ -765,17 +781,21 @@
|
|
|
|
|
`((action . "info")
|
|
|
|
|
(value . ,(conc "Out of " *item-card-short* "'s."))))))))
|
|
|
|
|
((eq? name 'move)
|
|
|
|
|
(reconcile-display-cash player game)
|
|
|
|
|
(safe-set! (game-actions game) (cdr (game-actions game)))
|
|
|
|
|
(message-players! game player
|
|
|
|
|
`((action . "move") (value . ,value)))
|
|
|
|
|
(create-ws-response player "action"
|
|
|
|
|
`((action . "move") (value . ,value))))
|
|
|
|
|
((eq? name 'harvest)
|
|
|
|
|
(reconcile-display-cash player game)
|
|
|
|
|
(let ((res (do-action action player)))
|
|
|
|
|
(safe-set! (game-actions game) (cdr (game-actions game)))
|
|
|
|
|
(if (eq? res 'nothing)
|
|
|
|
|
(loop (+ i 1))
|
|
|
|
|
(begin
|
|
|
|
|
(safe-set! (player-harvesting player) (alist-ref (string->symbol (player-name player))
|
|
|
|
|
(alist-ref 'operatingExpenseValue res)))
|
|
|
|
|
(message-players!
|
|
|
|
|
game player
|
|
|
|
|
`((action . "harvest") (value . ,res)))
|
|
|
|
@ -784,6 +804,7 @@
|
|
|
|
|
`((action . "harvest")
|
|
|
|
|
(value . ,res)))))))
|
|
|
|
|
((or (eq? name 'money) (eq? name 'player-action))
|
|
|
|
|
(reconcile-display-cash player game)
|
|
|
|
|
;; all current player-actions have only a cash effect
|
|
|
|
|
(let ((previous-cash (player-cash player)))
|
|
|
|
|
(do-action action player)
|
|
|
|
@ -798,6 +819,7 @@
|
|
|
|
|
(message-players! game player res)
|
|
|
|
|
(create-ws-response player "action" res)))))
|
|
|
|
|
((eq? name 'end-game)
|
|
|
|
|
(reconcile-display-cash player game)
|
|
|
|
|
(if (null? (cdr (game-actions game)))
|
|
|
|
|
(begin
|
|
|
|
|
(value)
|
|
|
|
@ -812,6 +834,7 @@
|
|
|
|
|
(do-action action player)
|
|
|
|
|
(loop (+ i 1)))
|
|
|
|
|
((eq? value 'farmers-fate)
|
|
|
|
|
(reconcile-display-cash player game)
|
|
|
|
|
(let ((ff (do-action action player)))
|
|
|
|
|
(safe-set! (game-actions game)
|
|
|
|
|
(append (alist-ref 'actions ff)
|
|
|
|
@ -823,6 +846,7 @@
|
|
|
|
|
`((action . "farmers-fate")
|
|
|
|
|
(value . ,(alist-ref 'contents ff))))))
|
|
|
|
|
((eq? name 'ff-money)
|
|
|
|
|
(reconcile-display-cash player game)
|
|
|
|
|
(safe-set! (game-actions game) (cdr (game-actions game)))
|
|
|
|
|
(if (= (alist-ref 'amount value) 0)
|
|
|
|
|
(loop (+ i 1))
|
|
|
|
@ -832,6 +856,7 @@
|
|
|
|
|
(message-players! game player res)
|
|
|
|
|
(create-ws-response player "action" res))))
|
|
|
|
|
((eq? name 'ff-uncle-bert)
|
|
|
|
|
(reconcile-display-cash player game)
|
|
|
|
|
(safe-set! (game-actions game) (cdr (game-actions game)))
|
|
|
|
|
(message-players! game player
|
|
|
|
|
`((action . "ff-uncle-bert") (value . #f)))
|
|
|
|
@ -839,6 +864,7 @@
|
|
|
|
|
`((action . "ff-uncle-bert")
|
|
|
|
|
(value . #f))))
|
|
|
|
|
((eq? name 'info)
|
|
|
|
|
(reconcile-display-cash player game)
|
|
|
|
|
(safe-set! (game-actions game) (cdr (game-actions game)))
|
|
|
|
|
(message-players! game player
|
|
|
|
|
`((action . "info") (value . ,value)))
|
|
|
|
@ -846,6 +872,7 @@
|
|
|
|
|
`((action . "info")
|
|
|
|
|
(value . ,value))))
|
|
|
|
|
((eq? name 'goto)
|
|
|
|
|
(reconcile-display-cash player game)
|
|
|
|
|
(do-action action player)
|
|
|
|
|
(safe-set! (player-harvest-mult player) 1)
|
|
|
|
|
(safe-set! (game-actions game)
|
|
|
|
@ -859,12 +886,19 @@
|
|
|
|
|
`((action . "goto")
|
|
|
|
|
(value . ,resp)))))
|
|
|
|
|
((eq? name 'add-rule)
|
|
|
|
|
(reconcile-display-cash player game)
|
|
|
|
|
(do-action action player)
|
|
|
|
|
(safe-set! (game-actions game) (cdr (game-actions game)))
|
|
|
|
|
(loop (+ i 1)))
|
|
|
|
|
(else ;; TODO make error
|
|
|
|
|
(create-ws-response player "action" `((action . ,name)))))))))
|
|
|
|
|
((string=? type "skip")
|
|
|
|
|
(when (and (player-harvesting player) (string=? (alist-ref 'component msg) "harvest|income"))
|
|
|
|
|
;; player-harvesting will contain the operating expense amount
|
|
|
|
|
(safe-set! (player-display-cash player) (- (player-cash player) (player-harvesting player))))
|
|
|
|
|
(when (string=? (alist-ref 'component msg) "harvest|operating-expense")
|
|
|
|
|
(safe-set! (player-harvesting player) #f)
|
|
|
|
|
(reconcile-display-cash player game))
|
|
|
|
|
(message-players! game player `((component . ,(alist-ref 'component msg)))
|
|
|
|
|
type: "auto-skip")
|
|
|
|
|
(create-ws-response player "update" '()))
|
|
|
|
@ -896,6 +930,7 @@
|
|
|
|
|
(create-ws-response player "buy" `((error . ,bought-crop))))))
|
|
|
|
|
((string=? type "buy-uncle-bert")
|
|
|
|
|
(safe-set! (player-cash player) (- (player-cash player) 10000))
|
|
|
|
|
(safe-set! (player-display-cash player) (player-cash player))
|
|
|
|
|
(safe-set! (player-assets player)
|
|
|
|
|
(alist-update 'hay (+ (alist-ref 'hay (player-assets player)) 10)
|
|
|
|
|
(player-assets player)))
|
|
|
|
@ -911,8 +946,10 @@
|
|
|
|
|
(farming-round (+ amount (* amount (game-setting 'loan-interest game)))))
|
|
|
|
|
(game-setting 'max-debt game))
|
|
|
|
|
(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) (* amount 2))))
|
|
|
|
|
(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)
|
|
|
|
|
(farming-round
|
|
|
|
|
(+ amount (* amount (game-setting 'loan-interest game))))))))
|
|
|
|
@ -921,10 +958,12 @@
|
|
|
|
|
(push-message player "Not enough cash to repay loan."))
|
|
|
|
|
(else
|
|
|
|
|
(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))
|
|
|
|
|
(when (< (player-debt player) 0)
|
|
|
|
|
(safe-set! (player-cash player) (+ (player-cash player)
|
|
|
|
|
(abs (player-debt 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."))))
|
|
|
|
|
))
|
|
|
|
@ -968,6 +1007,8 @@
|
|
|
|
|
`(,(car row) . ,(list->vector (cdr row))))
|
|
|
|
|
*harvest-table*)))))
|
|
|
|
|
((string=? type "turn-ended")
|
|
|
|
|
(reconcile-display-cash player game)
|
|
|
|
|
(safe-set! (player-harvesting player) #f)
|
|
|
|
|
(if (>= (player-cash player) 0)
|
|
|
|
|
(begin (advance-turn game player)
|
|
|
|
|
(if (eq? (game-state game) 'finished)
|
|
|
|
@ -1211,7 +1252,7 @@
|
|
|
|
|
(round (/ (exact->inexact amount) num-equipment))))))
|
|
|
|
|
(for-each (lambda (player)
|
|
|
|
|
(safe-set! (player-cash player)
|
|
|
|
|
(+ (player-cash player) amount-per-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))))
|
|
|
|
@ -1229,14 +1270,12 @@
|
|
|
|
|
(define (make-player-pays-per-unit unit amount)
|
|
|
|
|
(lambda (player)
|
|
|
|
|
(let ((to-pay (* (player-asset (normalize-crop unit) player) amount)))
|
|
|
|
|
(push-message player (conc "You paid $" to-pay "!"))
|
|
|
|
|
(safe-set! (player-cash player)
|
|
|
|
|
(- (player-cash player) to-pay)))))
|
|
|
|
|
|
|
|
|
|
(define (make-player-gains-per-unit unit amount)
|
|
|
|
|
(lambda (player)
|
|
|
|
|
(let ((to-pay (* (player-asset (normalize-crop unit) player) amount)))
|
|
|
|
|
(push-message player (conc "You earned $" to-pay "!"))
|
|
|
|
|
(safe-set! (player-cash player)
|
|
|
|
|
(+ (player-cash player) to-pay)))))
|
|
|
|
|
|
|
|
|
@ -1244,7 +1283,6 @@
|
|
|
|
|
(lambda (player)
|
|
|
|
|
(let ((to-pay (farming-round-down
|
|
|
|
|
(inexact->exact (round (* (player-debt player) 0.1))))))
|
|
|
|
|
(push-message player (conc "You paid $" to-pay "!"))
|
|
|
|
|
(safe-set! (player-cash player)
|
|
|
|
|
(- (player-cash player) to-pay)))))
|
|
|
|
|
|
|
|
|
@ -1373,7 +1411,6 @@
|
|
|
|
|
(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 "!"))
|
|
|
|
|
(safe-set! (player-cash player)
|
|
|
|
|
(+ (player-cash player) to-earn)))))
|
|
|
|
|
#f)
|
|
|
|
@ -1500,7 +1537,6 @@
|
|
|
|
|
(define *operating-expenses-specs*
|
|
|
|
|
`((2 ,(lambda (player)
|
|
|
|
|
(let ((to-pay (* (player-acres player) 100)))
|
|
|
|
|
(push-message player (conc "You paid $" to-pay "!"))
|
|
|
|
|
(safe-set! (player-cash player)
|
|
|
|
|
(- (player-cash player) to-pay)))))
|
|
|
|
|
(2 ,(lambda (player)
|
|
|
|
@ -1519,7 +1555,6 @@
|
|
|
|
|
(2 ,(make-player-pays 500))
|
|
|
|
|
(1 ,(lambda (player)
|
|
|
|
|
(when (player-has-asset? 'cows player)
|
|
|
|
|
(push-message player "You paid $500!")
|
|
|
|
|
(safe-set! (player-cash player) (- (player-cash player) 500)))))
|
|
|
|
|
(1 ,(make-player-pays 1500))))
|
|
|
|
|
|
|
|
|
@ -1870,3 +1905,4 @@
|
|
|
|
|
;; trade notification keeps popping up
|
|
|
|
|
|
|
|
|
|
;; you can see how much money you make before you harvest
|
|
|
|
|
;; show harvest multiplier
|
|
|
|
|