|
|
|
@ -266,6 +266,9 @@
|
|
|
|
(assert (number? (game-id g)))
|
|
|
|
(assert (number? (game-id g)))
|
|
|
|
(assert (list? (game-players g)))
|
|
|
|
(assert (list? (game-players g)))
|
|
|
|
(for-each (lambda (p)
|
|
|
|
(for-each (lambda (p)
|
|
|
|
|
|
|
|
(when (not (= (player-cash p) (player-display-cash p)))
|
|
|
|
|
|
|
|
(print "display cash out-of-sync")
|
|
|
|
|
|
|
|
(safe-set! (player-display-cash p) (player-cash p)))
|
|
|
|
(assert (instance-of? p <player>))
|
|
|
|
(assert (instance-of? p <player>))
|
|
|
|
(assert (number? (player-cash p)))
|
|
|
|
(assert (number? (player-cash p)))
|
|
|
|
(assert (number? (player-display-cash p)))
|
|
|
|
(assert (number? (player-display-cash p)))
|
|
|
|
@ -1353,6 +1356,9 @@
|
|
|
|
(safe-set! (player-display-cash player) (player-cash player))
|
|
|
|
(safe-set! (player-display-cash player) (player-cash player))
|
|
|
|
(safe-set! (player-debt player) 0))))))
|
|
|
|
(safe-set! (player-debt player) 0))))))
|
|
|
|
(create-ws-response player "loan" '()))
|
|
|
|
(create-ws-response player "loan" '()))
|
|
|
|
|
|
|
|
((string=? type "nothing")
|
|
|
|
|
|
|
|
(message-players! game player '() type: "update")
|
|
|
|
|
|
|
|
(create-ws-response player "update" '()))
|
|
|
|
((string=? type "trade")
|
|
|
|
((string=? type "trade")
|
|
|
|
(let ((res (propose-trade game player (alist-ref 'parameters msg))))
|
|
|
|
(let ((res (propose-trade game player (alist-ref 'parameters msg))))
|
|
|
|
(if (eq? res #t)
|
|
|
|
(if (eq? res #t)
|
|
|
|
@ -1680,22 +1686,27 @@
|
|
|
|
((end-ai-turn)
|
|
|
|
((end-ai-turn)
|
|
|
|
(if (eq? (player-state player) 'pre-turn)
|
|
|
|
(if (eq? (player-state player) 'pre-turn)
|
|
|
|
(process-ai-push-message player game '((type . "update"))) ;; restarting at AI player's turn
|
|
|
|
(process-ai-push-message player game '((type . "update"))) ;; restarting at AI player's turn
|
|
|
|
(when (ai-processing-turn player)
|
|
|
|
(if (ai-processing-turn player)
|
|
|
|
(when (< (player-cash player) 0)
|
|
|
|
(begin
|
|
|
|
(print "taking out loan")
|
|
|
|
(when (< (player-cash player) 0)
|
|
|
|
(process-message player game "loan" `((amount . ,(/ (+ (abs (player-cash player))
|
|
|
|
(print "taking out loan")
|
|
|
|
(remainder (abs (player-cash player)) 1000))
|
|
|
|
(process-message player game "loan" `((amount . ,(/ (+ (abs (player-cash player))
|
|
|
|
1000)))))
|
|
|
|
(remainder (abs (player-cash player)) 1000))
|
|
|
|
(when (>= (player-cash player) 1000)
|
|
|
|
1000)))))
|
|
|
|
(print "repaying loan")
|
|
|
|
(when (>= (player-cash player) 1000)
|
|
|
|
(process-message player game "loan" `((amount . ,(* (/ (- (player-cash player)
|
|
|
|
(print "repaying loan")
|
|
|
|
(remainder (player-cash player) 1000))
|
|
|
|
(process-message player game "loan" `((amount . ,(* (/ (- (player-cash player)
|
|
|
|
1000)
|
|
|
|
(remainder (player-cash player) 1000))
|
|
|
|
-1)))))
|
|
|
|
1000)
|
|
|
|
(print "ending turn")
|
|
|
|
-1)))))
|
|
|
|
;; (thread-sleep! 0.5)
|
|
|
|
(print "ending turn")
|
|
|
|
(set! (ai-processing-turn player) #f)
|
|
|
|
;; (thread-sleep! 0.5)
|
|
|
|
(process-message player game "turn-ended" '())
|
|
|
|
(set! (ai-processing-turn player) #f)
|
|
|
|
|
|
|
|
(process-message player game "turn-ended" '()))
|
|
|
|
|
|
|
|
;; this could happen if we restart the game in the middle of a turn
|
|
|
|
|
|
|
|
;; so lets just force the next turn
|
|
|
|
|
|
|
|
;; TODO this might get hit for every AI player?
|
|
|
|
|
|
|
|
(process-message player game "turn-ended" '())
|
|
|
|
)))))
|
|
|
|
)))))
|
|
|
|
|
|
|
|
|
|
|
|
(define (make-ai-push-receiver game player)
|
|
|
|
(define (make-ai-push-receiver game player)
|
|
|
|
@ -1703,7 +1714,13 @@
|
|
|
|
(*game* game)
|
|
|
|
(*game* game)
|
|
|
|
(*player* player)
|
|
|
|
(*player* player)
|
|
|
|
(let loop ((msg (mailbox-receive! (player-mailbox player))))
|
|
|
|
(let loop ((msg (mailbox-receive! (player-mailbox player))))
|
|
|
|
(process-ai-push-message player game msg)
|
|
|
|
(handle-exceptions
|
|
|
|
|
|
|
|
exn
|
|
|
|
|
|
|
|
(begin (log-error exn)
|
|
|
|
|
|
|
|
(print (conc "Server error: " (with-output-to-string
|
|
|
|
|
|
|
|
(lambda ()
|
|
|
|
|
|
|
|
(print-error-message exn))))))
|
|
|
|
|
|
|
|
(process-ai-push-message player game msg))
|
|
|
|
(loop (mailbox-receive! (player-mailbox player))))))
|
|
|
|
(loop (mailbox-receive! (player-mailbox player))))))
|
|
|
|
|
|
|
|
|
|
|
|
(define (session-game)
|
|
|
|
(define (session-game)
|
|
|
|
@ -1746,7 +1763,9 @@
|
|
|
|
(let* ((game (*game*))
|
|
|
|
(let* ((game (*game*))
|
|
|
|
(res (process-message (*player*)
|
|
|
|
(res (process-message (*player*)
|
|
|
|
game
|
|
|
|
game
|
|
|
|
(alist-ref 'type msg)
|
|
|
|
(alist-ref 'type (if (list? msg)
|
|
|
|
|
|
|
|
msg
|
|
|
|
|
|
|
|
'((type . "nothing"))))
|
|
|
|
msg)))
|
|
|
|
msg)))
|
|
|
|
(when game
|
|
|
|
(when game
|
|
|
|
(safe-set! (game-last-updated game) (+ (game-last-updated game) 1))
|
|
|
|
(safe-set! (game-last-updated game) (+ (game-last-updated game) 1))
|
|
|
|
@ -2571,6 +2590,8 @@
|
|
|
|
;; bug on display for uncle berts farm
|
|
|
|
;; bug on display for uncle berts farm
|
|
|
|
;; Error: (mailbox-send!) bad argument type - not a mailbox: "redhead91
|
|
|
|
;; Error: (mailbox-send!) bad argument type - not a mailbox: "redhead91
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; farmers luck can cause display cash to be out of sync
|
|
|
|
|
|
|
|
|
|
|
|
;; Uncaught TypeError: Cannot read property 'toFixed' of undefined
|
|
|
|
;; Uncaught TypeError: Cannot read property 'toFixed' of undefined
|
|
|
|
;; at St (app.0f8d4f4543faaee5dff1.js:1377)
|
|
|
|
;; at St (app.0f8d4f4543faaee5dff1.js:1377)
|
|
|
|
;; at app.0f8d4f4543faaee5dff1.js:1457
|
|
|
|
;; at app.0f8d4f4543faaee5dff1.js:1457
|
|
|
|
|
