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

Show IFS card buying errors and allow buying with emergency loan.

Browse Source
This commit is contained in:
Thomas Hintz
2020-03-31 08:06:48 -07:00
parent 89e67b3150
commit 93cc806eb2
8 changed files with 85 additions and 66 deletions
Download Patch File Download Diff File Expand all files Collapse all files

71
src/server/farm.scm
View File

@@ -375,28 +375,20 @@
(ridges '(ridge1 ridge2 ridge3 ridge4)))
(cond ((and (member unnormalized-crop ridges)
(not (ridge-available? game unnormalized-crop)))
(push-message player (conc "Ridge already leased."))
#f)
"Ridge already leased.")
((> (player-space player) 14)
(push-message player (conc "Crops may only be bought in winter."))
#f)
"Crops may only be bought in winter.")
((> cash-value (player-cash player))
(push-message player (conc "Could not buy " unnormalized-crop ". Not enough cash."))
#f)
(conc "Could not buy " unnormalized-crop ". Not enough cash."))
((< cash-value (* total-cost (game-setting 'down-payment game)))
(push-message player
(conc "Could not buy " unnormalized-crop ". Not enough down payment."))
#f)
((> (- total-cost cash-value) (- (game-setting 'max-debt game) (player-debt player)))
(push-message player
(conc "Could not buy " unnormalized-crop ". Not enough credit."))
#f)
(conc "Could not buy " unnormalized-crop ". Not enough down payment."))
((> (- total-cost cash-value) (max 0 (- (game-setting 'max-debt game) (player-debt player))))
(conc "Could not buy " unnormalized-crop ". Not enough credit."))
((and (eq? unnormalized-crop 'cows)
(= (- (player-asset 'cows player)
(fold + 0 (map cdr (player-ridges player))))
20))
(push-message player (conc "Could not buy " unnormalized-crop " because it would exceed maximum allowed on farm."))
#f)
(conc "Could not buy " unnormalized-crop " because it would exceed maximum allowed on farm."))
(else
(let ((assets (player-assets player)))
(safe-set!
@@ -408,7 +400,6 @@
(when (member unnormalized-crop ridges)
(safe-set! (player-ridges player)
(alist-update unnormalized-crop amount (player-ridges player))))
(push-message player (conc "You bought " amount " " crop "."))
#t)))))
(define (make-player-year-rule id rule)
@@ -880,26 +871,29 @@
((string=? type "buy")
(let* ((id (alist-ref 'id msg))
(otb (find (lambda (x) (= id (alist-ref 'id x)))
(player-otbs player))))
(when (buy-crop (normalize-crop
(string->symbol (alist-ref 'crop otb)))
(string->symbol (alist-ref 'crop otb))
(alist-ref 'amount otb)
(* (or (and (number? (alist-ref 'cash msg))
(alist-ref 'cash msg))
0)
1000)
player
game)
(safe-set! (game-otbs game)
(append (game-otbs game)
(filter (lambda (x) (= id (alist-ref 'id x)))
(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" '()))
(player-otbs player)))
(bought-crop (buy-crop (normalize-crop
(string->symbol (alist-ref 'crop otb)))
(string->symbol (alist-ref 'crop otb))
(alist-ref 'amount otb)
(* (or (and (number? (alist-ref 'cash msg))
(alist-ref 'cash msg))
0)
1000)
player
game)))
(if (eq? bought-crop #t)
(begin
(safe-set! (game-otbs game)
(append (game-otbs game)
(filter (lambda (x) (= id (alist-ref 'id x)))
(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" '()))
(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-assets player)
@@ -1873,7 +1867,6 @@
;; mark spaces
;; support trading farmers fates
;; test tractor/harvester a lot better
;; trade notification keeps popping up
;; you can see how much money you make before you harvest