summaryrefslogtreecommitdiffstats
path: root/src/server/farm.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/farm.scm')
-rw-r--r--src/server/farm.scm48
1 files changed, 46 insertions, 2 deletions
diff --git a/src/server/farm.scm b/src/server/farm.scm
index 7cc723e..53370d2 100644
--- a/src/server/farm.scm
+++ b/src/server/farm.scm
@@ -127,7 +127,8 @@
(mutex initform: (make-mutex 'player) accessor: player-mutex)
(harvesting initform: #f accessor: player-harvesting)
(hay-doubled initform: #f accessor: player-hay-doubled)
- (corn-doubled initform: #f accessor: player-corn-doubled)))
+ (corn-doubled initform: #f accessor: player-corn-doubled)
+ (ready-to-start initform: #f accessor: player-ready-to-start)))
(define-class <ai> (<player>)
((processing-turn initform: #f accessor: ai-processing-turn)))
@@ -564,11 +565,19 @@
#f))
(state . ,(symbol->string (game-state g)))
(turn . ,(game-turn g))
+ (name . ,(game-name g))
(settings . ((downPayment . ,(game-setting 'down-payment g))
(loanInterest . ,(game-setting 'loan-interest g))
(maxDebt . ,(game-setting 'max-debt g))
(auditThreshold . ,(game-setting 'audit-threshold g))
- (trade . ,(game-setting 'trade g))))))))
+ (startingOtbs . ,(game-setting 'starting-otbs g))
+ (startingCash . ,(game-setting 'starting-cash g))
+ (startingDebt . ,(game-setting 'starting-debt g))
+ (trade . ,(game-setting 'trade g))))
+ (readyToStart . ,(fold (lambda (p r)
+ (and (player-ready-to-start p) r))
+ #t
+ (game-players g)))))))
(define (buy-crop crop unnormalized-crop amount cash-value player game)
(let ((total-cost (* amount (alist-ref unnormalized-crop
@@ -1424,6 +1433,41 @@
(session-set! (sid) 'game-id #f)
(session-set! (sid) 'user-id #f)
(create-start-response "start-init"))
+ ((string=? type "ready-to-start")
+ (safe-set! (player-ready-to-start (*player*)) (not (player-ready-to-start (*player*))))
+ (message-players! (*game*) (*player*) '() type: "update")
+ (create-ws-response (*player*) "update" '()))
+ ((string=? type "kick-player")
+ (let ((kicked-player (find (lambda (p)
+ (equal? (player-name p) (alist-ref 'name msg)))
+ (game-players (*game*)))))
+ (safe-set! (game-colors (*game*))
+ (cons (player-color kicked-player) (game-colors (*game*))))
+ (safe-set! (game-otbs (*game*))
+ (append (game-otbs (*game*))
+ (player-otbs kicked-player)))
+ (safe-set! (game-players (*game*))
+ (filter (lambda (p)
+ (eq? p kicked-player))
+ (game-players (*game*))))
+ (db-remove-user-game (player-user-id kicked-player) (game-id (*game*))))
+ (message-players! (*game*) (*player*) '() type: "update")
+ (create-ws-response (*player*) "update" '()))
+ ((string=? type "leave-game")
+ (safe-set! (game-colors (*game*))
+ (cons (player-color (*player*)) (game-colors (*game*))))
+ (safe-set! (game-otbs (*game*))
+ (append (game-otbs (*game*))
+ (player-otbs (*player*))))
+ (safe-set! (game-players (*game*))
+ (filter (lambda (p)
+ (not (eq? p (*player*))))
+ (game-players (*game*))))
+ (when (not (null? (game-players (*game*))))
+ (safe-set! (game-current-player (*game*)) (car (game-players (*game*)))))
+ (db-remove-user-game (player-user-id (*player*)) (game-id (*game*)))
+ (message-players! (*game*) (*player*) '() type: "left-game")
+ (create-ws-response (*player*) "left-game" '()))
((string=? type "start-game")
(safe-set! (game-state (*game*)) 'pre-turn)
(db-update-game (game-id (*game*)) (symbol->string (game-state (*game*)))