diff --git a/extra/hamurabi/authors.txt b/extra/hamurabi/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/hamurabi/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/hamurabi/hamurabi.factor b/extra/hamurabi/hamurabi.factor new file mode 100644 index 0000000000..d0d7291d99 --- /dev/null +++ b/extra/hamurabi/hamurabi.factor @@ -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 + + ( -- 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 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 [ + 10 [ year ] times finish + ] [ 2drop ] recover ; + +MAIN: hamurabi + diff --git a/extra/hamurabi/summary.txt b/extra/hamurabi/summary.txt new file mode 100644 index 0000000000..8bc7b6df60 --- /dev/null +++ b/extra/hamurabi/summary.txt @@ -0,0 +1 @@ +Port of the HAMURABI.BAS game