extra/hamurabi/hamurabi.factor

   1 ! Copyright (C) 2010 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors combinators combinators.short-circuit
   5 continuations formatting fry io kernel math math.functions
   6 math.order math.parser ranges random sequences strings ;
   7
   8 IN: hamurabi
   9
  10 <PRIVATE
  11
  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 ;
  15
  16 : <game> ( -- game )
  17     game new
  18         0 >>year
  19         95 >>population
  20         5 >>births
  21         0 >>deaths
  22         2800 >>stores
  23         3000 >>harvest
  24         3 >>yield
  25         f >>plague
  26         0 >>cost
  27     dup births>> '[ _ + ] change-population
  28     dup population>> >>total-births
  29     dup deaths>> >>total-deaths
  30     dup [ harvest>> ] [ yield>> ] bi / >>acres
  31     dup [ harvest>> ] [ stores>> ] bi - >>eaten ;
  32
  33 : #acres-available ( game -- n )
  34     [ stores>> ] [ cost>> ] bi /i ;
  35
  36 : #acres-per-person ( game -- n )
  37     [ acres>> ] [ population>> ] bi / ;
  38
  39 : #harvested ( game -- n )
  40     [ planted>> ] [ yield>> ] bi * ;
  41
  42 : #eaten ( game -- n )
  43     dup rat-factor>> odd?
  44     [ [ stores>> ] [ rat-factor>> ] bi / ] [ drop 0 ] if ;
  45
  46 : #stored ( game -- n )
  47     [ harvest>> ] [ eaten>> ] bi - ;
  48
  49 : #percent-died ( game -- n )
  50     [ total-deaths>> ] [ total-births>> ] bi / 100 * ;
  51
  52 : #births ( game -- n )
  53     {
  54         [ acres>> 20 * ]
  55         [ stores>> + ]
  56         [ birth-factor>> * ]
  57         [ population>> / ]
  58     } cleave 100 /i 1 + ;
  59
  60 : #starved ( game -- n )
  61     [ population>> ] [ feed>> 20 /i ] bi [-] ;
  62
  63 : leave-fink ( -- )
  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 ;
  67
  68 : leave-starved ( game -- game )
  69     dup deaths>> "YOU STARVED %d PEOPLE IN ONE YEAR!!!\n" printf
  70     leave-fink "exit" throw ;
  71
  72 : leave-nero ( -- )
  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 ;
  76
  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 ;
  83
  84 : leave-best ( -- )
  85     "A FANTASTIC PERFORMANCE!!!  CHARLEMANGE, DISRAELI, AND" print
  86     "JEFFERSON COMBINED COULD NOT HAVE DONE BETTER!" print ;
  87
  88 : leave ( game -- )
  89     dup [ #percent-died ] [ #acres-per-person ] bi
  90     {
  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 ] }
  94         [ leave-best ]
  95     } cond 3drop ;
  96
  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
 101         "exit" throw
 102     ] when ;
 103
 104 : input ( prompt -- n/f )
 105     write flush readln string>number [ check-number ] keep ;
 106
 107 : bad-stores ( game -- )
 108     stores>>
 109     "HAMURABI:  THINK AGAIN. YOU HAVE ONLY" print
 110     "%d BUSHELS OF STORES. NOW THEN," printf nl ;
 111
 112 : bad-acres ( game -- )
 113     acres>>
 114     "HAMURABI:  THINK AGAIN. YOU ONLY OWN %d ACRES. NOW THEN,"
 115     printf nl ;
 116
 117 : bad-population ( game -- )
 118     population>>
 119     "BUT YOU HAVE ONLY %d PEOPLE TO TEND THE FIELDS. NOW THEN,"
 120     printf nl ;
 121
 122 : check-error ( game n error -- game n ? )
 123     {
 124         { "acres" [ over bad-acres t ] }
 125         { "stores" [ over bad-stores t ] }
 126         { "population" [ over bad-population t ] }
 127         [ drop f ]
 128     } case ;
 129
 130 : adjust-acres ( game n -- game )
 131     [ '[ _ + ] change-acres ]
 132     [ over cost>> * '[ _ - ] change-stores ] bi ;
 133
 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 ;
 138
 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 ;
 143
 144 : trade-land ( game -- game )
 145     dup cost>> "LAND IS TRADING AT %d BUSHELS PER ACRE.\n" printf
 146     buy-acres sell-acres ;
 147
 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
 153     ] if nl ;
 154
 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" ] }
 160         [ f ]
 161     } cond check-error [ drop plant-seeds ] [
 162         [ >>planted ] [ 2/ '[ _ - ] change-stores ] bi
 163     ] if nl ;
 164
 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
 169     dup plague>> [
 170         "A HORRIBLE PLAGUE STRUCK!  HALF THE PEOPLE DIED." print
 171     ] when
 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 ;
 177
 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 ;
 184
 185 : update-stores ( game -- game )
 186     dup #harvested >>harvest
 187     dup #eaten >>eaten
 188     dup #stored '[ _ + ] change-stores ;
 189
 190 : update-births ( game -- game )
 191     dup #births
 192     [ >>births ]
 193     [ '[ _ + ] change-total-births ]
 194     [ '[ _ + ] change-population ] tri ;
 195
 196 : update-deaths ( game -- game )
 197     dup #starved
 198     [ >>deaths ]
 199     [ '[ _ + ] change-total-deaths ]
 200     [ '[ _ - ] change-population ] tri ;
 201
 202 : check-plague ( game -- game )
 203     dup plague>> [ [ 2/ ] change-population ] when ;
 204
 205 : check-starvation ( game -- game )
 206     dup [ deaths>> ] [ population>> 0.45 * ] bi >
 207     [ leave-starved ] when ;
 208
 209 : year ( game -- game )
 210     [ 1 + ] change-year
 211     report-status
 212     update-randomness
 213     trade-land
 214     feed-people
 215     plant-seeds
 216     update-stores
 217     update-births
 218     update-deaths
 219     check-plague
 220     check-starvation ;
 221
 222 : spaces ( n -- )
 223     CHAR: \s <string> write ;
 224
 225 : welcome ( -- )
 226     32 spaces "HAMURABI" print
 227     15 spaces "CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY" print
 228     nl nl nl
 229     "TRY YOUR HAND AT GOVERNING ANCIENT SUMERIA" print
 230     "SUCCESSFULLY FOR A TEN-YEAR TERM OF OFFICE" print nl ;
 231
 232 : finish ( game -- )
 233     dup #percent-died
 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 ;
 240
 241 PRIVATE>
 242
 243 ! FIXME: "exit" throw is used to break early, perhaps use bool?
 244
 245 : hamurabi ( -- )
 246     welcome <game> [
 247         10 [ year ] times finish
 248     ] [ 2drop ] recover ;
 249
 250 MAIN: hamurabi