tjhintz/farm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Bugfixes.

Browse Source
This commit is contained in:
Thomas Hintz
2020-04-27 18:34:56 -07:00
parent db47e5e6e9
commit fbc8706893
1 changed files with 39 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

57
src/server/farm.scm
View File

@@ -266,6 +266,9 @@
(assert (number? (game-id g)))
(assert (list? (game-players g)))
(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 (number? (player-cash p)))
(assert (number? (player-display-cash p)))
@@ -1353,6 +1356,9 @@
(safe-set! (player-display-cash player) (player-cash player))
(safe-set! (player-debt player) 0))))))
(create-ws-response player "loan" '()))
((string=? type "nothing")
(message-players! game player '() type: "update")
(create-ws-response player "update" '()))
((string=? type "trade")
(let ((res (propose-trade game player (alist-ref 'parameters msg))))
(if (eq? res #t)
@@ -1680,22 +1686,27 @@
((end-ai-turn)
(if (eq? (player-state player) 'pre-turn)
(process-ai-push-message player game '((type . "update"))) ;; restarting at AI player's turn
(when (ai-processing-turn player)
(when (< (player-cash player) 0)
(print "taking out loan")
(process-message player game "loan" `((amount . ,(/ (+ (abs (player-cash player))
(remainder (abs (player-cash player)) 1000))
1000)))))
(when (>= (player-cash player) 1000)
(print "repaying loan")
(process-message player game "loan" `((amount . ,(* (/ (- (player-cash player)
(remainder (player-cash player) 1000))
1000)
-1)))))
(print "ending turn")
;; (thread-sleep! 0.5)
(set! (ai-processing-turn player) #f)
(process-message player game "turn-ended" '())
(if (ai-processing-turn player)
(begin
(when (< (player-cash player) 0)
(print "taking out loan")
(process-message player game "loan" `((amount . ,(/ (+ (abs (player-cash player))
(remainder (abs (player-cash player)) 1000))
1000)))))
(when (>= (player-cash player) 1000)
(print "repaying loan")
(process-message player game "loan" `((amount . ,(* (/ (- (player-cash player)
(remainder (player-cash player) 1000))
1000)
-1)))))
(print "ending turn")
;; (thread-sleep! 0.5)
(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)
@@ -1703,7 +1714,13 @@
(*game* game)
(*player* 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))))))
(define (session-game)
@@ -1746,7 +1763,9 @@
(let* ((game (*game*))
(res (process-message (*player*)
game
(alist-ref 'type msg)
(alist-ref 'type (if (list? msg)
msg
'((type . "nothing"))))
msg)))
(when game
(safe-set! (game-last-updated game) (+ (game-last-updated game) 1))
@@ -2571,6 +2590,8 @@
;; bug on display for uncle berts farm
;; 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
;; at St (app.0f8d4f4543faaee5dff1.js:1377)
;; at app.0f8d4f4543faaee5dff1.js:1457