More detailed.
parent
1416876084
commit
0ba1d36790
@ -1,16 +1,222 @@
|
||||
`(((jan1 money ?p ,(lambda (p) 'pay-10%)))
|
||||
((jan2 draw ?p otb))
|
||||
((jan3 money ?p ,(pays 500)) (?p cows))
|
||||
((jan4 add-rule ?p ((?p hay harvest-mult 2) (?p hay))))
|
||||
((jan4 on-year-end ?p (?p hay harvest-mult 1)))
|
||||
((jun1 harvest ?p hay) (?p hay))
|
||||
((jun1 harvest-mult ?p 0.5) (?p hay))
|
||||
|
||||
((?date harvest-mult ?p ?val) (?date harvest ?p ?crop) (?p ?crop harvest-mult ?val))
|
||||
|
||||
((tom cows))
|
||||
((tom wheat harvest-mult 0.5))
|
||||
((tom hay))
|
||||
((tom hay harvest-mult 2)))
|
||||
|
||||
'((jun1 ?action tom ?value))
|
||||
;; EXAMPLE
|
||||
|
||||
(prolog+meta
|
||||
;; Here are the rules
|
||||
`(((jan1 money ?p ,(lambda (p) 'pay-10%)))
|
||||
((jan2 draw ?p otb))
|
||||
((jan3 money ?p ,(pays 500)) (?p cows))
|
||||
((jan4 add-rule ?p ((?p hay harvest-mult 2) (?p hay))))
|
||||
((jan4 on-year-end ?p (?p hay harvest-mult 1)))
|
||||
((jun1 harvest ?p hay) (?p hay))
|
||||
((jun1 harvest-mult ?p 0.5) (?p hay))
|
||||
|
||||
;; a single rule to do harvest multipliers for any crop or player
|
||||
((?date harvest-mult ?p ?val) (?date harvest ?p ?crop) (?p ?crop harvest-mult ?val))
|
||||
|
||||
;; The current game state is inserted at the end
|
||||
((tom cows))
|
||||
((tom wheat harvest-mult 0.5))
|
||||
((tom hay))
|
||||
((tom hay harvest-mult 2)))
|
||||
|
||||
'((jun1 ?action tom ?value))) ;; this means match any rule from the
|
||||
;; list above that matches this
|
||||
|
||||
;; and that would return
|
||||
'((jun1 harvest tom hay)
|
||||
(jun1 harvest-mult 2 hay))
|
||||
;; so now I process those
|
||||
|
||||
|
||||
;; ACTUAL CODE
|
||||
|
||||
;; The action rules
|
||||
(define (get-actions player space)
|
||||
(let ((res '()))
|
||||
(let loop ((a
|
||||
(prolog+meta
|
||||
`(((dec4 money ?p ,(gains 1000)))
|
||||
((jan1 player-action ?p ,(make-semi-annual-interest-due)))
|
||||
((jan2 draw ?p otb))
|
||||
((jan3 money ?p ,(pays 500)) (?p cows))
|
||||
((jan4 add-rule ?p ((?p hay harvest-mult 2) (?p hay))))
|
||||
((jan4 on-year-end ?p (?p hay harvest-mult 1)))
|
||||
((feb1 money ?p ,(gains 1000)))
|
||||
((feb2 draw ?p farmers-fate))
|
||||
((feb3 goto ?p apr2))
|
||||
((feb4 draw ?p otb))
|
||||
((mar1 money ?p ,(pays 2000)))
|
||||
((mar2 money ?p ,(pays 500)))
|
||||
((mar3 goto ?p jan2))
|
||||
((mar4 money ?p ,(pays 2000) (?p fruit)))
|
||||
((apr1 draw ?p otb))
|
||||
((apr2 add-rule ?p (?p mult corn 2)))
|
||||
((apr3 money ?p ,(pays 500)))
|
||||
((apr4 money ?p ,(pays 1000)))
|
||||
((may1 money ?p ,(gains 500)))
|
||||
((may2 money ?p ,(pays 500)))
|
||||
((may3 money ?p ,(gains 1000)))
|
||||
((may3 harvest ?p hay) (?p hay))
|
||||
((may4 draw ?p otb))
|
||||
((may4 harvest ?p hay) (?p hay))
|
||||
((jun1 harvest ?p hay) (?p hay))
|
||||
((jun1 harvest-mult ?p 0.5) (?p hay))
|
||||
((jun2 money ?p ,(gains 500)))
|
||||
((jun2 harvest ?p hay) (?p hay))
|
||||
((jun3 harvest ?p fruit) (?p fruit))
|
||||
((jun3 harvest-mult ?p 0.5) (?p fruit))
|
||||
((jun4 harvest ?p fruit) (?p fruit))
|
||||
((jun4 draw ?p farmers-fate))
|
||||
((jul1 harvest ?p fruit) (?p fruit))
|
||||
((jul2 harvest ?p hay) (?p hay))
|
||||
((jul2 harvest-mult ?p 2) (?p hay))
|
||||
((jul3 harvest ?p hay) (?p hay))
|
||||
((jul3 draw ?p otb))
|
||||
((jul4 harvest ?p hay) (?p hay))
|
||||
((jul4 goto ?p sep4))
|
||||
((jul5 player-action ?p ,(make-player-gains-per-unit 'grain 50)))
|
||||
((jul5 harvest ?p wheat) (?p grain))
|
||||
((aug1 harvest ?p wheat) (?p grain))
|
||||
((aug1 goto ?p feb4))
|
||||
((aug1 player-action-post-harvest ?p ,finish-year))
|
||||
((aug2 harvest ?p wheat) (?p grain))
|
||||
((aug2 money ?p ,(gains 1000)) (?p harvester))
|
||||
((aug3 money ?p ,(gains 500)))
|
||||
((aug3 harvest ?p wheat) (?p grain))
|
||||
((aug4 harvest ?p wheat) (?p grain))
|
||||
;; TODO modify next line to not pay if grain was already
|
||||
;; harvested
|
||||
((aug4 player-action ?p ,(make-player-pays-per-unit 'grain 50)))
|
||||
((sep1 harvest ?p hay) (?p hay))
|
||||
((sep1 goto ?p nov3) (?p tractor))
|
||||
((sep2 harvest ?p hay) (?p hay))
|
||||
((sep2 draw ?p otb))
|
||||
((sep3 harvest ?p cows) (?p cows))
|
||||
((sep3 harvest-mult ?p 0.5) (?p cows))
|
||||
((sep4 harvest ?p cows) (?p cows))
|
||||
((sep4 money ?p ,(gains 500)))
|
||||
((sep5 harvest ?p cows) (?p cows))
|
||||
((sep5 money ?p ,(pays 2000)) (?p fruit))
|
||||
((oct1 money ?p ,(gains 500)))
|
||||
((oct1 harvest ?p cows) (?p cows))
|
||||
((oct2 draw ?p farmers-fate))
|
||||
((oct2 harvest ?p hay) (?p hay))
|
||||
((oct3 draw ?p otb))
|
||||
((oct3 harvest ?p hay) (?p hay))
|
||||
((oct4 draw ?p farmers-fate))
|
||||
((oct4 harvest ?p fruit) (?p fruit))
|
||||
((nov1 draw ?p otb))
|
||||
((nov1 harvest ?p fruit) (?p fruit))
|
||||
((nov2 money ?p ,(gains 500)))
|
||||
((nov2 harvest ?p fruit) (?p fruit))
|
||||
((nov3 money ?p ,(gains 1000)))
|
||||
((nov3 harvest ?p fruit) (?p fruit))
|
||||
((nov4 money ?p ,(pays 1000)) (?p fruit))
|
||||
((nov4 harvest ?p corn) (?p grain))
|
||||
((dec1 money ?p ,(gains 500)))
|
||||
((dec1 harvest ?p corn) (?p grain))
|
||||
((dec2 draw ?p farmers-fate))
|
||||
((dec2 harvest ?p corn) (?p grain))
|
||||
((dec3 money ?p ,(gains 1000)))
|
||||
|
||||
,@(player-year-rules player)
|
||||
|
||||
((?date harvest-mult ?p ?val) (?date harvest ?p ?crop) (?p ?crop harvest-mult ?val))
|
||||
|
||||
,@(player-crop-rule player 'cows)
|
||||
,@(player-crop-rule player 'fruit)
|
||||
,@(player-crop-rule player 'hay)
|
||||
,@(player-crop-rule player 'grain)
|
||||
,@(player-crop-rule player 'tractor)
|
||||
,@(player-crop-rule player 'harvester))
|
||||
`((,(list-ref *months* space) ?action tom ?value)))))
|
||||
(if a
|
||||
(begin (set! res (cons a res)) (loop (amb+)))
|
||||
res))))
|
||||
|
||||
;; The actual doing of an action
|
||||
(define (do-action action player)
|
||||
(let ((a (alist-ref '?action action)))
|
||||
(cond ((eq? a 'money)
|
||||
(let ((changed ((alist-ref '?value action) 0)))
|
||||
(push-message (conc "You " (if (>= changed 0) "earned" "paid") " $"
|
||||
(abs changed) "!")
|
||||
*game*))
|
||||
(set! (player-cash player)
|
||||
((alist-ref '?value action) (player-cash player))))
|
||||
((eq? a 'goto)
|
||||
(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))
|
||||
(when (not (null? *otbs*))
|
||||
(push-message "You drew an O.T.B.!" *game*)
|
||||
(receive (new-otb remaining-otbs) (split-at *otbs* 1)
|
||||
(set! (player-otbs *player*) (cons (car new-otb) (player-otbs *player*)))
|
||||
(set! *otbs* remaining-otbs))))
|
||||
((and (eq? a 'draw) (eq? (alist-ref '?value action) 'farmers-fate))
|
||||
(receive (new-ff remaining-ffs) (split-at *farmers-fates* 1)
|
||||
(push-message (alist-ref 'summary (car new-ff))
|
||||
*game*)
|
||||
(if (alist-ref 'hold-card (car new-ff))
|
||||
(begin (push! (car new-ff) (player-farmers-fates player))
|
||||
(set! *farmers-fates* remaining-ffs))
|
||||
(set! *farmers-fates* (append remaining-ffs new-ff)))
|
||||
((alist-ref 'action (car new-ff)) player)))
|
||||
((or (eq? a 'player-action) (eq? a 'player-action-post-harvest))
|
||||
((alist-ref '?value action) player))
|
||||
;; Do a harvest!
|
||||
((eq? a 'harvest)
|
||||
(let* ((crop (normalize-crop (alist-ref '?value action)))
|
||||
(harvest-amounts (get-harvest-amounts crop))
|
||||
(rolled (+ (random 6) 1))
|
||||
(income
|
||||
(farming-round
|
||||
;; add one to skip the divisor
|
||||
(* (list-ref harvest-amounts rolled)
|
||||
(/ (alist-ref crop (player-assets player)) (car harvest-amounts))))))
|
||||
(when (not (already-harvested? crop player))
|
||||
(push-message (conc crop " Harvest! You rolled a " rolled
|
||||
" and earned $" income "!")
|
||||
*game*)
|
||||
(set! (player-cash player)
|
||||
(+ (player-cash player) income))
|
||||
(let ((operating-expense (draw-operating-expense)))
|
||||
(push-message (alist-ref 'summary operating-expense) *game*)
|
||||
((alist-ref 'action operating-expense) player))))))))
|
||||
|
||||
;; skipping boring stuff
|
||||
|
||||
;; STARTING POINT
|
||||
;; get all the actions for a player, sort them, then do them.
|
||||
(define (do-all-actions player)
|
||||
(for-each
|
||||
(lambda (x)
|
||||
(do-action x player)
|
||||
(if (eq? (alist-ref '?action x) 'goto)
|
||||
(do-all-actions player)))
|
||||
(sort-actions (get-actions player (player-space player)))))
|
||||
|
||||
;; not pretty but works
|
||||
(define (sort-actions actions)
|
||||
(sort actions
|
||||
(lambda (x y)
|
||||
(let ((a (alist-ref '?action x)) (b (alist-ref '?action y))
|
||||
(av (alist-ref '?value x)) (bv (alist-ref '?value y)))
|
||||
(cond ((eq? av 'otb) #t)
|
||||
((eq? bv 'otb) #f)
|
||||
((eq? a 'money) #t)
|
||||
((eq? b 'money) #f)
|
||||
((eq? a 'player-action) #t)
|
||||
((eq? b 'player-action) #f)
|
||||
((eq? a 'harvest-mult) #t)
|
||||
((eq? b 'harvest-mult) #f)
|
||||
((eq? a 'harvest) #t)
|
||||
((eq? b 'harvest) #f)
|
||||
((eq? a 'player-action-post-harvest) #t)
|
||||
((eq? b 'player-action-post-harvest) #f)
|
||||
((eq? av 'farmers-fate) #t)
|
||||
((eq? bv 'farmers-fate) #f)
|
||||
((eq? a 'goto) #t)
|
||||
((eq? b 'goto) #f)
|
||||
(else #f))))))
|
||||
|
||||
Loading…
Reference in New Issue