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

More detailed.

Browse Source
master
Thomas Hintz 5 years ago
parent 1416876084
commit 0ba1d36790
1 changed files with 222 additions and 16 deletions
Show Stats Download Patch File Download Diff File

210
farmpl.scm
Unescape Escape View File

@ -1,4 +1,8 @@
`(((jan1 money ?p ,(lambda (p) 'pay-10%)))
;; 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))))
@ -6,11 +10,213 @@
((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))
'((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))))))

Write Preview
Loading…
Cancel
Save