1 ! Copyright (C) 2010 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors combinators combinators.short-circuit
5 continuations formatting fry io kernel math math.functions
6 math.order math.parser math.ranges random sequences strings ;
12 TUPLE: game year population births deaths stores harvest yield
13 plague acres eaten cost feed planted birth-factor rat-factor
14 total-births total-deaths ;
27 dup births>> >>total-births
28 dup deaths>> >>total-deaths
29 dup births>> '[ _ + ] change-population
30 dup [ harvest>> ] [ yield>> ] bi / >>acres
31 dup [ harvest>> ] [ stores>> ] bi - >>eaten ;
33 : #acres-available ( game -- n )
34 [ stores>> ] [ cost>> ] bi /i ;
36 : #acres-per-person ( game -- n )
37 [ acres>> ] [ population>> ] bi / ;
39 : #harvested ( game -- n )
40 [ planted>> ] [ yield>> ] bi * ;
42 : #eaten ( game -- n )
44 [ [ stores>> ] [ rat-factor>> ] bi / ] [ drop 0 ] if ;
46 : #stored ( game -- n )
47 [ harvest>> ] [ eaten>> ] bi - ;
49 : #percent-died ( game -- n )
50 [ total-deaths>> 100 * ] [ total-births>> ] [ year>> ] tri / / ;
52 : #births ( game -- n )
60 : #starved ( game -- n )
61 [ population>> ] [ feed>> 20 /i ] bi [-] ;
64 "DUE TO THIS EXTREME MISMANAGEMENT YOU HAVE NOT ONLY" print
65 "BEEN IMPEACHED AND THROWN OUT OF OFFICE BUT YOU HAVE" print
66 "ALSO BEEN DECLARED 'NATIONAL FINK' !!" print ;
68 : leave-starved ( game -- game )
69 dup deaths>> "YOU STARVED %d PEOPLE IN ONE YEAR!!!\n" printf
70 leave-fink "exit" throw ;
73 "YOUR HEAVY-HANDED PERFORMANCE SMACKS OF NERO AND IVAN IV." print
74 "THE PEOPLE (REMAINING) FIND YOU AN UNPLEASANT RULER, AND" print
75 "FRANKLY, HATE YOUR GUTS!" print ;
77 : leave-not-too-bad ( game -- game )
78 "YOUR PERFORMANCE COULD HAVE BEEN SOMEWHAT BETTER, BUT" print
79 "REALLY WASN'T TOO BAD AT ALL." print
80 dup population>> 4/5 * floor [0,b] random
81 "%d PEOPLE WOULD DEARLY LIKE TO SEE YOU ASSASSINATED\n" printf
82 "BUT WE ALL HAVE OUR TRIVIAL PROBLEMS" print ;
85 "A FANTASTIC PERFORMANCE!!! CHARLEMANGE, DISRAELI, AND" print
86 "JEFFERSON COMBINED COULD NOT HAVE DONE BETTER!" print ;
89 dup [ #percent-died ] [ #acres-per-person ] bi
91 { [ 2dup [ 33 > ] [ 7 < ] bi* or ] [ leave-fink ] }
92 { [ 2dup [ 10 > ] [ 9 < ] bi* or ] [ leave-nero ] }
93 { [ 2dup [ 3 > ] [ 10 < ] bi* or ] [ leave-not-too-bad ] }
97 : check-number ( n -- )
98 { [ f eq? ] [ 0 < ] [ fixnum? not ] } 1|| [
99 "HAMURABI: I CANNOT DO WHAT YOU WISH." print
100 "GET YOURSELF ANOTHER STEWARD!!!!!" print
104 : input ( prompt -- n/f )
105 write flush readln string>number [ check-number ] keep ;
107 : bad-stores ( game -- )
109 "HAMURABI: THINK AGAIN. YOU HAVE ONLY" print
110 "%d BUSHELS OF STORES. NOW THEN," printf nl ;
112 : bad-acres ( game -- )
114 "HAMURABI: THINK AGAIN. YOU ONLY OWN %d ACRES. NOW THEN,"
117 : bad-population ( game -- )
119 "BUT YOU HAVE ONLY %d PEOPLE TO TEND THE FIELDS. NOW THEN,"
122 : check-error ( game n error -- game n ? )
124 { "acres" [ over bad-acres t ] }
125 { "stores" [ over bad-stores t ] }
126 { "population" [ over bad-population t ] }
130 : adjust-acres ( game n -- game )
131 [ '[ _ + ] change-acres ]
132 [ over cost>> * '[ _ - ] change-stores ] bi ;
134 : buy-acres ( game -- game )
135 "HOW MANY ACRES DO YOU WISH TO BUY? " input
136 over #acres-available dupd > "stores" and check-error
137 [ drop buy-acres ] [ adjust-acres ] if ;
139 : sell-acres ( game -- game )
140 "HOW MANY ACRES DO YOU WISH TO SELL? " input
141 over acres>> dupd >= "acres" and check-error
142 [ drop sell-acres ] [ neg adjust-acres ] if nl ;
144 : trade-land ( game -- game )
145 dup cost>> "LAND IS TRADING AT %d BUSHELS PER ACRE.\n" printf
146 buy-acres sell-acres ;
148 : feed-people ( game -- game )
149 "HOW MANY BUSHELS DO YOU WISH TO FEED YOUR PEOPLE? " input
150 over stores>> dupd > "stores" and check-error
151 [ drop feed-people ] [
152 [ >>feed ] [ '[ _ - ] change-stores ] bi
155 : plant-seeds ( game -- game )
156 "HOW MANY ACRES DO YOU WISH TO PLANT WITH SEED? " input {
157 { [ over acres>> dupd > ] [ "acres" ] }
158 { [ over stores>> 2 * dupd > ] [ "stores" ] }
159 { [ over population>> 10 * dupd > ] [ "population" ] }
161 } cond check-error [ drop plant-seeds ] [
162 [ >>planted ] [ 2/ '[ _ - ] change-stores ] bi
165 : report-status ( game -- game )
166 "HAMURABI: I BEG TO REPORT TO YOU," print
167 dup [ year>> ] [ deaths>> ] [ births>> ] tri
168 "IN YEAR %d, %d PEOPLE STARVED, %d CAME TO THE CITY\n" printf
170 "A HORRIBLE PLAGUE STRUCK! HALF THE PEOPLE DIED." print
172 dup population>> "POPULATION IS NOW %d.\n" printf
173 dup acres>> "THE CITY NOW OWNS %d ACRES.\n" printf
174 dup yield>> "YOU HARVESTED %d BUSHELS PER ACRE.\n" printf
175 dup eaten>> "RATS ATE %d BUSHELS.\n" printf
176 dup stores>> "YOU NOW HAVE %d BUSHELS IN STORE.\n\n" printf ;
178 : update-randomness ( game -- game )
179 17 26 [a,b] random >>cost
180 5 [1,b] random >>yield
181 5 [1,b] random >>birth-factor
182 5 [1,b] random >>rat-factor
183 100 random 15 < >>plague ;
185 : update-stores ( game -- game )
186 dup #harvested >>harvest
188 dup #stored '[ _ + ] change-stores ;
190 : update-births ( game -- game )
193 [ '[ _ + ] change-total-births ]
194 [ '[ _ + ] change-population ] tri ;
196 : update-deaths ( game -- game )
199 [ '[ _ + ] change-total-deaths ]
200 [ '[ _ - ] change-population ] tri ;
202 : check-plague ( game -- game )
203 dup plague>> [ [ 2/ ] change-population ] when ;
205 : check-starvation ( game -- game )
206 dup [ deaths>> ] [ population>> 0.45 * ] bi >
207 [ leave-starved ] when ;
209 : year ( game -- game )
223 CHAR: \s <string> write ;
226 32 spaces "HAMURABI" print
227 15 spaces "CREATIVE COMPUTING MORRISTOWN, NEW JERSEY" print
229 "TRY YOUR HAND AT GOVERNING ANCIENT SUMERIA" print
230 "SUCCESSFULLY FOR A TEN-YEAR TERM OF OFFICE" print nl ;
234 "IN YOUR 10-YEAR TERM OF OFFICE, %d PERCENT OF THE\n" printf
235 "POPULATION STARVED PER YEAR ON AVERAGE, I.E., A TOTAL OF" print
236 dup total-deaths>> "%d PEOPLE DIED!!\n" printf
237 "YOU STARTED WITH 10 ACRES PER PERSON AND ENDED WITH" print
238 dup #acres-per-person "%d ACRES PER PERSON\n" printf
239 nl leave nl "SO LONG FOR NOW." print ;
243 ! FIXME: "exit" throw is used to break early, perhaps use bool?
247 10 [ year ] times finish
248 ] [ 2drop ] recover ;