hamurabi: adding HAMURABI.BAS game.
John Benediktsson
parent
33cae784fb
commit
0364eae439
|
|
@ -0,0 +1 @@
|
|||
John Benediktsson
|
||||
|
|
@ -0,0 +1,251 @@
|
|||
! Copyright (C) 2010 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: accessors combinators combinators.short-circuit
|
||||
continuations formatting fry io kernel math math.functions
|
||||
math.order math.parser math.ranges random sequences strings ;
|
||||
|
||||
IN: hamurabi
|
||||
|
||||
<PRIVATE
|
||||
|
||||
TUPLE: game year population births deaths stores harvest yield
|
||||
plague acres eaten cost feed planted birth-factor rat-factor
|
||||
total-births total-deaths ;
|
||||
|
||||
: <game> ( -- game )
|
||||
game new
|
||||
0 >>year
|
||||
95 >>population
|
||||
5 >>births
|
||||
0 >>deaths
|
||||
2800 >>stores
|
||||
3000 >>harvest
|
||||
3 >>yield
|
||||
f >>plague
|
||||
0 >>cost
|
||||
dup births>> >>total-births
|
||||
dup deaths>> >>total-deaths
|
||||
dup births>> '[ _ + ] change-population
|
||||
dup [ harvest>> ] [ yield>> ] bi / >>acres
|
||||
dup [ harvest>> ] [ stores>> ] bi - >>eaten ;
|
||||
|
||||
: #acres-available ( game -- n )
|
||||
[ stores>> ] [ cost>> ] bi /i ;
|
||||
|
||||
: #acres-per-person ( game -- n )
|
||||
[ acres>> ] [ population>> ] bi / ;
|
||||
|
||||
: #harvested ( game -- n )
|
||||
[ planted>> ] [ yield>> ] bi * ;
|
||||
|
||||
: #eaten ( game -- n )
|
||||
dup rat-factor>> odd?
|
||||
[ [ stores>> ] [ rat-factor>> ] bi / ] [ drop 0 ] if ;
|
||||
|
||||
: #stored ( game -- n )
|
||||
[ harvest>> ] [ eaten>> ] bi - ;
|
||||
|
||||
: #percent-died ( game -- n )
|
||||
[ total-deaths>> 100 * ] [ total-births>> ] [ year>> ] tri / / ;
|
||||
|
||||
: #births ( game -- n )
|
||||
{
|
||||
[ acres>> 20 * ]
|
||||
[ stores>> + ]
|
||||
[ birth-factor>> * ]
|
||||
[ population>> / ]
|
||||
} cleave 100 /i 1 + ;
|
||||
|
||||
: #starved ( game -- n )
|
||||
[ population>> ] [ feed>> 20 /i ] bi - 0 max ;
|
||||
|
||||
: leave-fink ( -- )
|
||||
"DUE TO THIS EXTREME MISMANAGEMENT YOU HAVE NOT ONLY" print
|
||||
"BEEN IMPEACHED AND THROWN OUT OF OFFICE BUT YOU HAVE" print
|
||||
"ALSO BEEN DECLARED 'NATIONAL FINK' !!" print ;
|
||||
|
||||
: leave-starved ( game -- game )
|
||||
dup deaths>> "YOU STARVED %d PEOPLE IN ONE YEAR!!!\n" printf
|
||||
leave-fink "exit" throw ;
|
||||
|
||||
: leave-nero ( -- )
|
||||
"YOUR HEAVY-HANDED PERFORMANCE SMACKS OF NERO AND IVAN IV." print
|
||||
"THE PEOPLE (REMAINING) FIND YOU AN UNPLEASANT RULER, AND" print
|
||||
"FRANKLY, HATE YOUR GUTS!" print ;
|
||||
|
||||
: leave-not-too-bad ( game -- game )
|
||||
"YOUR PERFORMANCE COULD HAVE BEEN SOMEWHAT BETTER, BUT" print
|
||||
"REALLY WASN'T TOO BAD AT ALL." print
|
||||
dup population>> 4/5 * floor [0,b] random
|
||||
"%d PEOPLE WOULD DEARLY LIKE TO SEE YOU ASSASSINATED\n" printf
|
||||
"BUT WE ALL HAVE OUR TRIVIAL PROBLEMS" print ;
|
||||
|
||||
: leave-best ( -- )
|
||||
"A FANTASTIC PERFORMANCE!!! CHARLEMANGE, DISRAELI, AND" print
|
||||
"JEFFERSON COMBINED COULD NOT HAVE DONE BETTER!" print ;
|
||||
|
||||
: leave ( game -- )
|
||||
dup [ #percent-died ] [ #acres-per-person ] bi
|
||||
{
|
||||
{ [ 2dup [ 33 > ] [ 7 < ] bi* or ] [ leave-fink ] }
|
||||
{ [ 2dup [ 10 > ] [ 9 < ] bi* or ] [ leave-nero ] }
|
||||
{ [ 2dup [ 3 > ] [ 10 < ] bi* or ] [ leave-not-too-bad ] }
|
||||
[ leave-best ]
|
||||
} cond 3drop ;
|
||||
|
||||
: check-number ( n -- )
|
||||
{ [ f eq? ] [ 0 < ] [ fixnum? not ] } 1|| [
|
||||
"HAMURABI: I CANNOT DO WHAT YOU WISH." print
|
||||
"GET YOURSELF ANOTHER STEWARD!!!!!" print
|
||||
"exit" throw
|
||||
] when ;
|
||||
|
||||
: input ( prompt -- n/f )
|
||||
write flush readln string>number [ check-number ] keep ;
|
||||
|
||||
: bad-stores ( game -- )
|
||||
stores>>
|
||||
"HAMURABI: THINK AGAIN. YOU HAVE ONLY" print
|
||||
"%d BUSHELS OF STORES. NOW THEN," printf nl ;
|
||||
|
||||
: bad-acres ( game -- )
|
||||
acres>>
|
||||
"HAMURABI: THINK AGAIN. YOU ONLY OWN %d ACRES. NOW THEN,"
|
||||
printf nl ;
|
||||
|
||||
: bad-population ( game -- )
|
||||
population>>
|
||||
"BUT YOU HAVE ONLY %d PEOPLE TO TEND THE FIELDS. NOW THEN,"
|
||||
printf nl ;
|
||||
|
||||
: check-error ( game n error -- game n ? )
|
||||
{
|
||||
{ "acres" [ over bad-acres t ] }
|
||||
{ "stores" [ over bad-stores t ] }
|
||||
{ "population" [ over bad-population t ] }
|
||||
[ drop f ]
|
||||
} case ;
|
||||
|
||||
: adjust-acres ( game n -- game )
|
||||
[ '[ _ + ] change-acres ]
|
||||
[ over cost>> * '[ _ - ] change-stores ] bi ;
|
||||
|
||||
: buy-acres ( game -- game )
|
||||
"HOW MANY ACRES DO YOU WISH TO BUY? " input
|
||||
over #acres-available dupd > "stores" and check-error
|
||||
[ drop buy-acres ] [ adjust-acres ] if ;
|
||||
|
||||
: sell-acres ( game -- game )
|
||||
"HOW MANY ACRES DO YOU WISH TO SELL? " input
|
||||
over acres>> dupd >= "acres" and check-error
|
||||
[ drop sell-acres ] [ neg adjust-acres ] if nl ;
|
||||
|
||||
: trade-land ( game -- game )
|
||||
dup cost>> "LAND IS TRADING AT %d BUSHELS PER ACRE.\n" printf
|
||||
buy-acres sell-acres ;
|
||||
|
||||
: feed-people ( game -- game )
|
||||
"HOW MANY BUSHELS DO YOU WISH TO FEED YOUR PEOPLE? " input
|
||||
over stores>> dupd > "stores" and check-error
|
||||
[ drop feed-people ] [
|
||||
[ >>feed ] [ '[ _ - ] change-stores ] bi
|
||||
] if nl ;
|
||||
|
||||
: plant-seeds ( game -- game )
|
||||
"HOW MANY ACRES DO YOU WISH TO PLANT WITH SEED? " input {
|
||||
{ [ over acres>> dupd > ] [ "acres" ] }
|
||||
{ [ over stores>> 2 * dupd > ] [ "stores" ] }
|
||||
{ [ over population>> 10 * dupd > ] [ "population" ] }
|
||||
[ f ]
|
||||
} cond check-error [ drop plant-seeds ] [
|
||||
[ >>planted ] [ 2/ '[ _ - ] change-stores ] bi
|
||||
] if nl ;
|
||||
|
||||
: report-status ( game -- game )
|
||||
"HAMURABI: I BEG TO REPORT TO YOU," print
|
||||
dup [ year>> ] [ deaths>> ] [ births>> ] tri
|
||||
"IN YEAR %d, %d PEOPLE STARVED, %d CAME TO THE CITY\n" printf
|
||||
dup plague>> [
|
||||
"A HORRIBLE PLAGUE STRUCK! HALF THE PEOPLE DIED." print
|
||||
] when
|
||||
dup population>> "POPULATION IS NOW %d.\n" printf
|
||||
dup acres>> "THE CITY NOW OWNS %d ACRES.\n" printf
|
||||
dup yield>> "YOU HARVESTED %d BUSHELS PER ACRE.\n" printf
|
||||
dup eaten>> "RATS ATE %d BUSHELS.\n" printf
|
||||
dup stores>> "YOU NOW HAVE %d BUSHELS IN STORE.\n\n" printf ;
|
||||
|
||||
: update-randomness ( game -- game )
|
||||
17 26 [a,b] random >>cost
|
||||
5 [1,b] random >>yield
|
||||
5 [1,b] random >>birth-factor
|
||||
5 [1,b] random >>rat-factor
|
||||
100 random 15 < >>plague ;
|
||||
|
||||
: update-stores ( game -- game )
|
||||
dup #harvested >>harvest
|
||||
dup #eaten >>eaten
|
||||
dup #stored '[ _ + ] change-stores ;
|
||||
|
||||
: update-births ( game -- game )
|
||||
dup #births
|
||||
[ >>births ]
|
||||
[ '[ _ + ] change-total-births ]
|
||||
[ '[ _ + ] change-population ] tri ;
|
||||
|
||||
: update-deaths ( game -- game )
|
||||
dup #starved
|
||||
[ >>deaths ]
|
||||
[ '[ _ + ] change-total-deaths ]
|
||||
[ '[ _ - ] change-population ] tri ;
|
||||
|
||||
: check-plague ( game -- game )
|
||||
dup plague>> [ [ 2/ ] change-population ] when ;
|
||||
|
||||
: check-starvation ( game -- game )
|
||||
dup [ deaths>> ] [ population>> 0.45 * ] bi >
|
||||
[ leave-starved ] when ;
|
||||
|
||||
: year ( game -- game )
|
||||
[ 1 + ] change-year
|
||||
report-status
|
||||
update-randomness
|
||||
trade-land
|
||||
feed-people
|
||||
plant-seeds
|
||||
update-stores
|
||||
update-births
|
||||
update-deaths
|
||||
check-plague
|
||||
check-starvation ;
|
||||
|
||||
: spaces ( n -- )
|
||||
CHAR: \s <string> write ;
|
||||
|
||||
: welcome ( -- )
|
||||
32 spaces "HAMURABI" print
|
||||
15 spaces "CREATIVE COMPUTING MORRISTOWN, NEW JERSEY" print
|
||||
nl nl nl
|
||||
"TRY YOUR HAND AT GOVERNING ANCIENT SUMERIA" print
|
||||
"SUCCESSFULLY FOR A TEN-YEAR TERM OF OFFICE" print nl ;
|
||||
|
||||
: finish ( game -- )
|
||||
dup #percent-died
|
||||
"IN YOUR 10-YEAR TERM OF OFFICE, %d PERCENT OF THE\n" printf
|
||||
"POPULATION STARVED PER YEAR ON AVERAGE, I.E., A TOTAL OF" print
|
||||
dup total-deaths>> "%d PEOPLE DIED!!\n" printf
|
||||
"YOU STARTED WITH 10 ACRES PER PERSON AND ENDED WITH" print
|
||||
dup #acres-per-person "%d ACRES PER PERSON\n" printf
|
||||
nl leave nl "SO LONG FOR NOW." print ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
! FIXME: "exit" throw is used to break early, perhaps use bool?
|
||||
|
||||
: hamurabi ( -- )
|
||||
welcome <game> [
|
||||
10 [ year ] times finish
|
||||
] [ 2drop ] recover ;
|
||||
|
||||
MAIN: hamurabi
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
Port of the HAMURABI.BAS game
|
||||
Loading…
Reference in New Issue