From 29171875f484eb6ea80983a2e214af9a3ec4cbf0 Mon Sep 17 00:00:00 2001 From: Thomas Hintz Date: Sat, 28 Mar 2020 15:26:49 -0700 Subject: [PATCH] Adding safe-set!. --- src/server/farm.scm | 261 ++++++++++++++++++++++---------------------- 1 file changed, 133 insertions(+), 128 deletions(-) diff --git a/src/server/farm.scm b/src/server/farm.scm index 90ad452..35b638b 100644 --- a/src/server/farm.scm +++ b/src/server/farm.scm @@ -54,6 +54,18 @@ (lambda () (SRV:send-reply (pre-post-order* sxml rules))))))) +(define-syntax safe-set! + (ir-macro-transformer + (lambda (x i c) + (let ((mutex-symbol (string->symbol (string-append (car (string-split (symbol->string (caadr x)) "-")) "-mutex")))) + `(let* ((obj ,(second (second x))) + (res ,(third x)) + (mutex (,(i mutex-symbol) obj))) + (dynamic-wind + (lambda () (mutex-lock! mutex)) + (lambda () (set! (,(first (second x)) obj) res)) + (lambda () (mutex-unlock! mutex)))))))) + (define-class () ((cash initform: 5000 accessor: player-cash) (debt initform: 5000 accessor: player-debt) @@ -78,7 +90,8 @@ (trade initform: '() accessor: player-trade) (last-updated initform: 0 accessor: player-last-updated) (last-cash initform: 5000 accessor: player-last-cash) - (mailbox initform: (make-mailbox) accessor: player-mailbox))) + (mailbox initform: (make-mailbox) accessor: player-mailbox) + (mutex initform: (make-mutex 'player) accessor: player-mutex))) (define-class () ((id initform: 0 accessor: game-id) @@ -105,14 +118,16 @@ (starting-cash . 5000) (starting-debt . 5000) (trade . #t)) - accessor: game-settings))) + accessor: game-settings) + (mutex initform: (make-mutex 'game) accessor: game-mutex))) (define (game-setting setting game) (alist-ref setting (game-settings game))) (define-class () ((games initform: '() accessor: app-games) - (last-game-id initform: 0 accessor: last-game-id))) + (last-game-id initform: 0 accessor: app-last-game-id) + (mutex initform: (make-mutex 'app) accessor: app-mutex))) (define (player->sexp player) `((cash . ,(player-cash player)) @@ -155,8 +170,8 @@ (define *app* (make )) (define (next-game-id app) - (set! (last-game-id app) (+ (last-game-id app) 1)) - (- (last-game-id app) 1)) + (safe-set! (app-last-game-id app) (+ (app-last-game-id app) 1)) + (- (app-last-game-id app) 1)) (define sid (make-parameter #f)) (define session-cookie-name (make-parameter "awful-cookie")) @@ -214,7 +229,7 @@ (define (next-game-color game) (let ((color (car (game-colors game)))) - (set! (game-colors game) (cdr (game-colors game))) + (safe-set! (game-colors game) (cdr (game-colors game))) color)) (define (add-player-to-game game color name) @@ -225,9 +240,9 @@ 'name name 'state (if (= (length (game-players game)) 0) 'pre-turn 'turn-ended)))) - (set! (game-players game) (append (game-players game) (list player))) + (safe-set! (game-players game) (append (game-players game) (list player))) (when (= (length (game-players game)) 1) - (set! (game-current-player game) player)) + (safe-set! (game-current-player game) player)) player)) (define (all-players-finished game) @@ -248,12 +263,12 @@ (define (advance-turn game player) (if (all-players-finished game) - (set! (game-state game) 'finished) + (safe-set! (game-state game) 'finished) (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))))) + (safe-set! (player-state player) 'turn-ended) + (safe-set! (player-state next) 'pre-turn) + (safe-set! (game-current-player game) next) + (safe-set! (game-turn game) (+ (game-turn game) 1))))) (define (ridge-available? game ridge) (let loop ((players (game-players game))) @@ -268,8 +283,8 @@ (for-each (lambda (x) (receive (new-otb remaining-otbs) (split-at (game-otbs game) 1) - (set! (player-otbs player) (cons (car new-otb) (player-otbs player))) - (set! (game-otbs game) remaining-otbs))) + (safe-set! (player-otbs player) (cons (car new-otb) (player-otbs player))) + (safe-set! (game-otbs game) remaining-otbs))) (iota number))) (define (main-page) @@ -344,17 +359,7 @@ (trade . ,(game-setting 'trade g)))))))) (define (push-message player msg #!key (game (session-ref (sid) 'game))) - (if player - (set! (game-messages game) (cons `#(,(player-name player) - ,(game-turn game) - ,msg) - (game-messages game))) - ;; (set! (game-messages game) (cons (conc (player-name player) ": " msg) - ;; (game-messages game))) - (set! (game-messages game) (cons `#(#f ,(game-turn game) ,msg) - (game-messages game))) - ;; (set! (game-messages game) (cons msg (game-messages game))) - )) + (void)) (define (buy-crop crop unnormalized-crop amount cash-value player game) (let ((total-cost (* amount (alist-ref unnormalized-crop @@ -394,14 +399,14 @@ #f) (else (let ((assets (player-assets player))) - (set! + (safe-set! (player-assets player) (alist-update crop (+ (alist-ref crop assets) amount) assets)) - (set! (player-cash player) (- (player-cash player) cash-value)) - (set! (player-debt player) + (safe-set! (player-cash player) (- (player-cash player) cash-value)) + (safe-set! (player-debt player) (+ (player-debt player) (- total-cost cash-value))) (when (member unnormalized-crop ridges) - (set! (player-ridges player) + (safe-set! (player-ridges player) (alist-update unnormalized-crop amount (player-ridges player)))) (push-message player (conc "You bought " amount " " crop ".")) #t))))) @@ -412,33 +417,33 @@ (define (finish-year player #!optional (collect-wages #t)) (let ((game (session-ref (sid) 'game))) (when collect-wages - (set! (player-cash player) + (safe-set! (player-cash player) (+ (player-cash player) 5000)) (push-message player (conc "You earned $5,000 from your city job!")) - (set! (game-actions game) + (safe-set! (game-actions game) (cons '((?action . info) (?value . "You earned $5,000 from your city job!")) (game-actions game)))) (when (game-called-audit game) - (set! (game-actions game) + (safe-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) '()) + (safe-set! (player-finished player) #t)))))))) + (safe-set! (player-year-rules player) (player-next-year-rules player)) + (safe-set! (player-next-year-rules player) '()) (when (not (null? (player-farmers-fates player))) - (set! (game-farmers-fates game) + (safe-set! (game-farmers-fates game) (append (game-farmers-fates game) (player-farmers-fates player))) - (set! (player-farmers-fates player) '()) + (safe-set! (player-farmers-fates player) '()) ;; this is a really hacky way of getting F.F. calf weaning weights ;; to work for the second year. (when (not (null? (player-year-rules player))) - (set! (player-farmers-fates player) + (safe-set! (player-farmers-fates player) (list (find (lambda (c) (eq? (alist-ref 'internal-id c) 'cows-15)) (game-farmers-fates game)))) - (set! (game-farmers-fates game) + (safe-set! (game-farmers-fates game) (filter (lambda (c) (not (eq? (alist-ref 'internal-id c) 'cows-15))) (game-farmers-fates game))) (push! (make-player-year-rule @@ -527,12 +532,12 @@ (cdr x))) params))) (set! *trade-number* (+ *trade-number* 1)) - (set! (player-trade other-player) + (safe-set! (player-trade other-player) (append `((player . ,(player-name player)) (originator . ,(player-name player)) (trade-number . ,*trade-number*)) to-trade)) - (set! (player-trade player) + (safe-set! (player-trade player) (append `((player . ,(player-name other-player)) (originator . ,(player-name player)) (trade-number . ,*trade-number*)) @@ -561,11 +566,11 @@ (let ((assets (player-assets originator)) (other-assets (player-assets player)) (amount (alist-ref crop params))) - (set! + (safe-set! (player-assets originator) (alist-update crop (+ (alist-ref crop assets) amount) assets)) - (set! + (safe-set! (player-assets player) (alist-update crop (+ (alist-ref crop other-assets) (* amount -1)) other-assets))))) @@ -576,52 +581,52 @@ (when (alist-ref ridge params) (if (> (player-ridge player ridge) 0) (begin - (set! (player-ridges originator) + (safe-set! (player-ridges originator) (alist-update ridge (alist-ref ridge (player-ridges player)) (player-ridges originator))) - (set! (player-ridges player) + (safe-set! (player-ridges player) (alist-update ridge 0 (player-ridges player)))) (begin - (set! (player-ridges player) + (safe-set! (player-ridges player) (alist-update ridge (alist-ref ridge (player-ridges originator)) (player-ridges player))) - (set! (player-ridges originator) + (safe-set! (player-ridges originator) (alist-update ridge 0 (player-ridges originator))))))) (loop (cdr ridges)))) (when (alist-ref 'money params) - (set! (player-cash player) + (safe-set! (player-cash player) (+ (player-cash player) (* (alist-ref 'money params) -1))) - (set! (player-cash originator) + (safe-set! (player-cash originator) (+ (player-cash originator) (alist-ref 'money params)))) (when (alist-ref 'cards params) (for-each (lambda (id) (if (otb-by-id player id) (let ((otb (otb-by-id player id))) - (set! (player-otbs player) + (safe-set! (player-otbs player) (filter (lambda (x) (not (= id (alist-ref 'id x)))) (player-otbs player))) - (set! (player-otbs originator) + (safe-set! (player-otbs originator) (cons otb (player-otbs originator)))) (let ((otb (otb-by-id originator id))) - (set! (player-otbs originator) + (safe-set! (player-otbs originator) (filter (lambda (x) (not (= id (alist-ref 'id x)))) (player-otbs originator))) - (set! (player-otbs player) + (safe-set! (player-otbs player) (cons otb (player-otbs player)))))) cards)) - (set! (player-trade originator) '()) - (set! (player-trade player) '())) + (safe-set! (player-trade originator) '()) + (safe-set! (player-trade player) '())) #f))) (define (call-audit game player) (if (game-called-audit game) (push-message player (conc (player-name (game-called-audit game)) " already called audit!")) - (begin (set! (game-called-audit game) player) + (begin (safe-set! (game-called-audit game) player) (push-message player (conc (player-name player) " has called an audit!"))))) (define (player-net-worth player) @@ -693,28 +698,28 @@ (define (process-message player game type msg) (when game - (set! (game-messages game) '()) - (set! (player-last-cash player) (player-cash player))) + (safe-set! (game-messages game) '()) + (safe-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*)) - (set! (player-previous-space player) + (safe-set! (player-previous-space player) (player-space player)) - (set! (player-space player) + (safe-set! (player-space player) (+ (player-space player) num)) - (set! (player-state player) 'mid-turn) + (safe-set! (player-state player) 'mid-turn) (push-message player (conc "You rolled a " num)) (when (> (player-space player) 48) - (set! (player-space player) + (safe-set! (player-space player) (- (player-space player) 49))) (when (and (> (player-previous-space player) 40) (< (player-space player) 10)) (finish-year player)) - (set! (player-harvest-mult player) 1) + (safe-set! (player-harvest-mult player) 1) (let ((resp `((from . ,(player-previous-space player)) (to . ,(player-space player))))) - (set! (game-actions game) + (safe-set! (game-actions game) (append (game-actions game) `(((?action . move) (?value . ,resp))) (sort-actions (get-actions player (player-space player))))) @@ -728,7 +733,7 @@ (if (or (null? (game-actions game)) (>= i 15)) (begin - (set! (game-actions game) '()) + (safe-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))) @@ -737,7 +742,7 @@ (print action) (cond ((eq? value 'otb) (let ((otb (do-action action player))) - (set! (game-actions game) (cdr (game-actions game))) + (safe-set! (game-actions game) (cdr (game-actions game))) (if otb (begin (message-players! game player @@ -754,14 +759,14 @@ `((action . "info") (value . ,(conc "Out of " *item-card-short* "'s.")))))))) ((eq? name 'move) - (set! (game-actions game) (cdr (game-actions 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) (let ((res (do-action action player))) - (set! (game-actions game) (cdr (game-actions game))) + (safe-set! (game-actions game) (cdr (game-actions game))) (if (eq? res 'nothing) (loop (+ i 1)) (begin @@ -776,7 +781,7 @@ ;; all current player-actions have only a cash effect (let ((previous-cash (player-cash player))) (do-action action player) - (set! (game-actions game) + (safe-set! (game-actions game) (cdr (game-actions game))) (if (= (- (player-cash player) previous-cash) 0) (loop (+ i 1)) @@ -790,19 +795,19 @@ (if (null? (cdr (game-actions game))) (begin (value) - (set! (game-actions game) '())) - (set! (game-actions game) + (safe-set! (game-actions game) '())) + (safe-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))) + (safe-set! (game-actions game) (cdr (game-actions game))) (do-action action player) (loop (+ i 1))) ((eq? value 'farmers-fate) (let ((ff (do-action action player))) - (set! (game-actions game) + (safe-set! (game-actions game) (append (alist-ref 'actions ff) (cdr (game-actions game)))) (message-players! game player @@ -812,7 +817,7 @@ `((action . "farmers-fate") (value . ,(alist-ref 'contents ff)))))) ((eq? name 'ff-money) - (set! (game-actions game) (cdr (game-actions game))) + (safe-set! (game-actions game) (cdr (game-actions game))) (if (= (alist-ref 'amount value) 0) (loop (+ i 1)) (let ((res `((action . "money") @@ -821,14 +826,14 @@ (message-players! game player res) (create-ws-response player "action" res)))) ((eq? name 'ff-uncle-bert) - (set! (game-actions game) (cdr (game-actions game))) + (safe-set! (game-actions game) (cdr (game-actions game))) (message-players! game player `((action . "ff-uncle-bert") (value . #f))) (create-ws-response player "action" `((action . "ff-uncle-bert") (value . #f)))) ((eq? name 'info) - (set! (game-actions game) (cdr (game-actions game))) + (safe-set! (game-actions game) (cdr (game-actions game))) (message-players! game player `((action . "info") (value . ,value))) (create-ws-response player "action" @@ -836,8 +841,8 @@ (value . ,value)))) ((eq? name 'goto) (do-action action player) - (set! (player-harvest-mult player) 1) - (set! (game-actions game) + (safe-set! (player-harvest-mult player) 1) + (safe-set! (game-actions game) (append (sort-actions (get-actions player (player-space player))) (cdr (game-actions game)))) (let ((resp `((from . ,(player-previous-space player)) @@ -849,7 +854,7 @@ (value . ,resp))))) ((eq? name 'add-rule) (do-action action player) - (set! (game-actions game) (cdr (game-actions game))) + (safe-set! (game-actions game) (cdr (game-actions game))) (loop (+ i 1))) (else ;; TODO make error (create-ws-response player "action" `((action . ,name))))))))) @@ -871,18 +876,18 @@ 1000) player game) - (set! (game-otbs game) + (safe-set! (game-otbs game) (append (game-otbs game) (filter (lambda (x) (= id (alist-ref 'id x))) (player-otbs player)))) - (set! (player-otbs player) + (safe-set! (player-otbs player) (filter (lambda (x) (not (= id (alist-ref 'id x)))) (player-otbs player))))) (message-players! game player '() type: "update") (create-ws-response player "buy" '())) ((string=? type "buy-uncle-bert") - (set! (player-cash player) (- (player-cash player) 10000)) - (set! (player-assets player) + (safe-set! (player-cash player) (- (player-cash player) 10000)) + (safe-set! (player-assets player) (alist-update 'hay (+ (alist-ref 'hay (player-assets player)) 10) (player-assets player))) (message-players! game player '() type: "update") @@ -897,8 +902,8 @@ (farming-round (+ amount (* amount (game-setting 'loan-interest game))))) (game-setting 'max-debt game)) (push-message player "Exceeds max loan.") - (begin (set! (player-cash player) (+ (player-cash player) amount)) - (set! (player-debt player) (+ (player-debt player) + (begin (safe-set! (player-cash player) (+ (player-cash player) amount)) + (safe-set! (player-debt player) (+ (player-debt player) (farming-round (+ amount (* amount (game-setting 'loan-interest game)))))) (push-message player (conc "Loan of $" amount " taken out.")))) @@ -906,12 +911,12 @@ (cond ((> (abs amount) (player-cash player)) (push-message player "Not enough cash to repay loan.")) (else - (set! (player-cash player) (+ (player-cash player) amount)) - (set! (player-debt player) (+ (player-debt player) amount)) + (safe-set! (player-cash player) (+ (player-cash player) amount)) + (safe-set! (player-debt player) (+ (player-debt player) amount)) (when (< (player-debt player) 0) - (set! (player-cash player) (+ (player-cash player) + (safe-set! (player-cash player) (+ (player-cash player) (abs (player-debt player)))) - (set! (player-debt player) 0)) + (safe-set! (player-debt player) 0)) (push-message player (conc "Loan of $" (abs amount) " repayed.")))) )) (create-ws-response player "loan" '())) @@ -921,7 +926,7 @@ (begin (message-players! game player '() type: "update") (create-ws-response player "trade" '())) - (begin (set! (player-trade player) `((error . ,res))) + (begin (safe-set! (player-trade player) `((error . ,res))) (create-ws-response player "trade-error" `()))))) ((string=? type "trade-accept") (accept-trade game player) @@ -930,19 +935,19 @@ ((string=? type "trade-deny") (push-message player (conc (player-name player) " denied trade with " (alist-ref 'originator (player-trade player)) ".")) - (set! (player-trade (find-player-by-name + (safe-set! (player-trade (find-player-by-name game (alist-ref 'originator (player-trade player)))) '()) - (set! (player-trade player) '()) + (safe-set! (player-trade player) '()) (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)) ".")) - (set! (player-trade (find-player-by-name + (safe-set! (player-trade (find-player-by-name game (alist-ref 'player (player-trade player)))) '()) - (set! (player-trade player) '()) + (safe-set! (player-trade player) '()) (message-players! game player '() type: "update") (create-ws-response player "trade-cancelled" '())) ((string=? type "audit") @@ -1005,7 +1010,7 @@ (player (add-player-to-game game color (alist-ref 'playerName msg)))) - (set! (game-colors game) (filter (cut neq? <> color) (game-colors game))) + (safe-set! (game-colors game) (filter (cut neq? <> color) (game-colors game))) (session-set! (sid) 'player player) (session-set! (sid) 'game game) (set-startup-otbs game player 2) @@ -1055,8 +1060,8 @@ (alist-ref 'type msg) msg))) (when game - (set! (game-last-updated game) (+ (game-last-updated game) 1)) - (set! (player-last-updated player) (game-last-updated game))) + (safe-set! (game-last-updated game) (+ (game-last-updated game) 1)) + (safe-set! (player-last-updated player) (game-last-updated game))) res))))) (loop (read-json (receive-message))))))) @@ -1196,34 +1201,34 @@ (inexact->exact (round (/ (exact->inexact amount) num-equipment)))))) (for-each (lambda (player) - (set! (player-cash player) + (safe-set! (player-cash player) (+ (player-cash player) amount-per-player))) (players-with equipment game))))) (push-message player (conc "You paid $" amount "!")) - (set! (player-cash player) (- (player-cash player) amount)))) + (safe-set! (player-cash player) (- (player-cash player) amount)))) (define (make-player-gains amount) (lambda (player) (push-message player (conc "You gained $" amount "!")) - (set! (player-cash player) (+ (player-cash player) amount)))) + (safe-set! (player-cash player) (+ (player-cash player) amount)))) (define (make-player-pays amount) (lambda (player) (push-message player (conc "You paid $" amount "!")) - (set! (player-cash player) (- (player-cash player) amount)))) + (safe-set! (player-cash player) (- (player-cash player) amount)))) (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 "!")) - (set! (player-cash player) + (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 "!")) - (set! (player-cash player) + (safe-set! (player-cash player) (+ (player-cash player) to-pay))))) (define (make-semi-annual-interest-due) @@ -1231,7 +1236,7 @@ (let ((to-pay (farming-round-down (inexact->exact (round (* (player-debt player) 0.1)))))) (push-message player (conc "You paid $" to-pay "!")) - (set! (player-cash player) + (safe-set! (player-cash player) (- (player-cash player) to-pay))))) (define (cows-on-ridges player) @@ -1243,11 +1248,11 @@ (define (make-remove-farmers-fate-from-hand id) (lambda (player) (let ((game (session-ref (sid) 'game))) - (set! (game-farmers-fates game) + (safe-set! (game-farmers-fates game) (append (game-farmers-fates game) (filter (lambda (x) (eq? (alist-ref 'internal-id x) id)) (player-farmers-fates player))))) - (set! (player-farmers-fates player) + (safe-set! (player-farmers-fates player) (filter (lambda (x) (not (eq? (alist-ref 'internal-id x) id))) (player-farmers-fates player))))) @@ -1360,7 +1365,7 @@ (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) + (safe-set! (player-cash player) (+ (player-cash player) to-earn))))) #f) (2 ,(lambda (player game) @@ -1382,9 +1387,9 @@ (for-each (lambda (from-player) (when (not (eq? player from-player)) (when (not (player-has-asset? 'harvester from-player)) - (set! (player-cash from-player) + (safe-set! (player-cash from-player) (- (player-cash from-player) 2000)) - (set! (player-cash player) + (safe-set! (player-cash player) (+ (player-cash player) 2000))))) (game-players (session-ref (sid) 'game)))) '())) @@ -1438,7 +1443,7 @@ (let ((slaughtered-cows (- cows ridge-cows))) (push-message player (conc slaughtered-cows " cows slaughtered on your farm.")) - (set! (player-assets player) + (safe-set! (player-assets player) (alist-update 'cows (- (alist-ref 'cows (player-assets player)) (- cows ridge-cows)) (player-assets player))) `(((?action . info) @@ -1487,7 +1492,7 @@ `((2 ,(lambda (player) (let ((to-pay (* (player-acres player) 100))) (push-message player (conc "You paid $" to-pay "!")) - (set! (player-cash player) + (safe-set! (player-cash player) (- (player-cash player) to-pay))))) (2 ,(lambda (player) (equipment-payout 'harvester player 2000 (session-ref (sid) 'game)))) @@ -1506,7 +1511,7 @@ (1 ,(lambda (player) (when (player-has-asset? 'cows player) (push-message player "You paid $500!") - (set! (player-cash player) (- (player-cash player) 500))))) + (safe-set! (player-cash player) (- (player-cash player) 500))))) (1 ,(make-player-pays 1500)))) (define (setup-operating-expenses) @@ -1521,8 +1526,8 @@ (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) + (safe-set! (game-operating-expense-index game) 0) + (safe-set! (game-operating-expense-index game) (+ (game-operating-expense-index game) 1))) card)) @@ -1693,8 +1698,8 @@ (if (null? (game-otbs game)) #f (receive (new-otb remaining-otbs) (split-at (game-otbs game) 1) - (set! (player-otbs player) (cons (car new-otb) (player-otbs player))) - (set! (game-otbs game) remaining-otbs) + (safe-set! (player-otbs player) (cons (car new-otb) (player-otbs player))) + (safe-set! (game-otbs game) remaining-otbs) (car new-otb)))) (define (do-action action player) @@ -1704,17 +1709,17 @@ (let ((changed ((alist-ref '?value action) 0))) (push-message player (conc "You " (if (>= changed 0) "earned" "paid") " $" (abs changed) "!"))) - (set! (player-cash player) + (safe-set! (player-cash player) ((alist-ref '?value action) (player-cash player)))) ((eq? a 'add-rule) (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) + (safe-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) + (safe-set! (player-previous-space player) (player-space player)) + (safe-set! (player-space player) (let ((month (alist-ref '?value action))) (list-index (lambda (x) (eq? x month)) *months*)))) ((and (eq? a 'draw) (eq? (alist-ref '?value action) 'otb)) @@ -1727,14 +1732,14 @@ (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)) - (set! (game-farmers-fates game) remaining-ffs)) - (set! (game-farmers-fates game) (append remaining-ffs new-ff))) + (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) - (set! (player-harvest-mult player) + (safe-set! (player-harvest-mult player) (* (player-harvest-mult player) (alist-ref '?value action)))) ((eq? a 'harvest) (let* ((crop (normalize-crop (alist-ref '?value action))) @@ -1749,9 +1754,9 @@ (player-harvest-mult player))))) (if (not (already-harvested? (alist-ref '?value action) player)) (begin - (set! (player-cash player) + (safe-set! (player-cash player) (+ (player-cash player) income)) - (set! (player-harvest-mult player) 1) + (safe-set! (player-harvest-mult player) 1) (let ((operating-expense (draw-operating-expense game)) (previous-cash (player-cash player)) (other-previous-cash (map (lambda (p) @@ -1789,11 +1794,11 @@ (lambda (x) (do-action x player) (if (eq? (alist-ref '?action x) 'goto) - (begin (set! (player-harvest-mult player) 1) + (begin (safe-set! (player-harvest-mult player) 1) (do-all-actions player)))) (let ((r (sort-actions (get-actions player (player-space player))))) (set! *last-actions* r) - (set! (player-harvest-mult player) 1) + (safe-set! (player-harvest-mult player) 1) r))) (define (sort-actions actions)