( Hamurabi, ein Text-Basiertes Strategie-Spiel in GNU Forth
  $Id: hamurabi.f,v 1.2 2024/09/14 14:59:53 oj14ozun Exp $
  https://wwwcip.cs.fau.de/~oj14ozun/src+etc/hamurabi.f

  Übersetzung von http://vintage-basic.net/bcg/hammurabi.bas, mit GNU
  Forth 0.7.3 getestet; starte mit "gforth -e start hamurabi.f".  Noch
  nicht ganz fertig, hat noch Fehler! )

VARIABLE YEAR		1 YEAR !
VARIABLE BUSHELS	2800 BUSHELS !
VARIABLE POPULATION	100 POPULATION !
VARIABLE ACERS		1000 ACERS !
VARIABLE YIELD		3 YIELD !
VARIABLE RATS		3 RATS !
VARIABLE TOTAL-DEATHS	0 TOTAL-DEATHS !
VARIABLE PERCENT-DEATHS	0 PERCENT-DEATHS !

: PERCENT ( N P -- P% OF N ) SWAP 100 * SWAP / ;
: @. @ . ;
: @+ ( N ADDR -- ) SWAP OVER @ + SWAP ! ;
: EVEN? 1 AND 0= ;
: .NOSPACE s>d 0 d.r ; ( SEE . )

( A CHEAP LINEAR-CONGRUENT RANDOM NUMBER GENERATOR )
VARIABLE RNG-STATE TIME&DATE * + * + *  RNG-STATE !
: NEXT-RANDOM
  RNG-STATE @
  1103515245 * 12345 + 1 31 LSHIFT MOD
  DUP RNG-STATE !
;
: RAND-RANGE ( N -- N ) NEXT-RANDOM SWAP MOD ;
: CHANCE ( -- C ) 10000 RAND-RANGE S>F 10000.E F/ ;
: CHANCE< ( P -- B ) S>F 100.E F/ CHANCE F< ;
: #1-6 5 RAND-RANGE 1 + ;	( GOSUB 800 IN HAMURABI.BAS )

\ FIXME: negative numbers are not read in correctly
: READ-NUMBER 0 0 PAD 80 ACCEPT PAD SWAP >NUMBER DROP DROP DROP ;

: INSUFFICIENT-BUSHELS
  ." HAMURABI:  THINK AGAIN.  YOU HAVE ONLY " CR
  BUSHELS @.
  ." BUSHELS OF GRAIN.  NOW THEN," CR
  FALSE
;

: INSUFFICIENT-ACERS
  ." HAMURABI:  THINK AGAIN.  YOU HAVE ONLY "
  ACERS @.
  ." ACERS.  NOW THEN," CR
  FALSE
;

: INSUFFICIENT-PEOPLE
  ." BUT YOU HAVE ONLY "
  POPULATION @.
  ." PEOPLE TO TEND THE FIELDS!  NOW THEN," CR
  FALSE
;

: RESIGN
  ." HAMURABI:  I CANNOT DO WHAT YOU WISH." CR
  ." GET YOURSELF ANOTHER STEWARD!!!!!" CR
  BYE
;

: READ-COUNT SPACE READ-NUMBER DUP 0< IF RESIGN THEN CR ;

: TAKE-STOCK ( INCREASE DEATHS -- N )
  ." HAMURABI:  I BEG TO REPORT TO YOU," CR
  ." IN YEAR " YEAR @ .NOSPACE ." , "
  2DUP . ." PEOPLE STARVED, "
  . ." CAME TO THE CITY, " CR

  POPULATION @ SWAP - + POPULATION !
  ." THE POPULATION IS NOW " POPULATION @. CR
  ." THE CITY NOW OWNS " ACERS @. ." ACERS" CR
  ." YOU HARVESTED " YIELD @. ." BUCHELS PER ACER." CR
  ." RATS ATE " RATS @. ." BUSHELS IN STORE" CR
  ." YOU NOW HAVE " BUSHELS @. ." BUSHELS IN STORE" CR

  10 RAND-RANGE 17 +
  ." LAND IS TRADING AT " DUP . SPACE ." BUSHELS PER ACER." CR
;

: BUY-LAND ( rate -- )
  BEGIN
    ." HOW MANY ACERS DO YOU WISH TO BUY?"
    READ-COUNT
    2DUP
    *
    BUSHELS @ <= IF
      DUP ACERS @+ OVER * NEGATE BUSHELS @+ TRUE
    ELSE 2DROP INSUFFICIENT-BUSHELS THEN
  UNTIL
;

: SELL-LAND ( rate -- )
  BEGIN
    ." HOW MANY ACERS DO YOU WISH TO SELL?"
    READ-COUNT DUP ACERS @ <= IF
      DUP NEGATE ACERS @+
      * BUSHELS @+
      TRUE
    ELSE 2DROP INSUFFICIENT-ACERS THEN
  UNTIL
;

: FEED-PEOPLE ( -- N )
  BEGIN
    ." HOW MANY BUSHELS DO YOU WISH TO FEED YOUR PEOPLE?"
    READ-COUNT DUP
    DUP BUSHELS @ <= IF
      NEGATE BUSHELS @+
      TRUE
    ELSE DROP INSUFFICIENT-BUSHELS THEN
  UNTIL
;

: PLANT-SEED ( -- N )
  BEGIN
    ." HOW MANY ACRES DO YOU WISH TO PLANT WITH SEED?"
    READ-COUNT DUP		( a copy for later )
    DUP ACERS @ <= IF
      DUP 2/ BUSHELS @ <= IF
	DUP POPULATION @ 10 * <= IF
	  2/ NEGATE BUSHELS @+
	  TRUE
	ELSE DROP INSUFFICIENT-PEOPLE THEN
      ELSE DROP INSUFFICIENT-BUSHELS THEN
    ELSE DROP INSUFFICIENT-ACERS THEN
  UNTIL
;

: HARVEST ( -- N )
  YIELD @ #1-6 *
  #1-6 DUP EVEN? IF		( RATS ARE RUNNING WILD!! )
    BUSHELS @ /
  ELSE
    0
  THEN
  BUSHELS @ SWAP - + BUSHELS !
;

: MULTIPLY ( PEOPLE-FED -- INCREASE DEATHS )
  ACERS @ 20 *
  BUSHELS @ +
  #1-6 *
  POPULATION @ /
  100 /
  1 +
  SWAP
  15 CHANCE< IF
    POPULATION @ 2/
  ELSE
    0
  THEN
;

: IMPEACH!
  ." YOU STARVED " . ." PEOPLE IN ONE YEAR!!!" CR
  ." DUE TO THIS EXTREME MISMANAGEMENT YOU HAVE NOT ONLY" CR
  ." BEEN IMPEACHED AND THROWN OUT OF OFFICE BUT YOU HAVE" CR
  ." ALSO BEEN DECLARED NATIONAL FINK!!!!" CR
  BYE
;

: IMPEACH? ( DEATHS -- )
  DUP POPULATION @ 45 PERCENT > IF
    IMPEACH!
  ELSE
    \ FIXME: Die Berechnung von PERCENT-DEATHS stimmt nicht.
    YEAR 1- PERCENT-DEATHS @ * + 100 * POPULATION @ / YEAR @ /
    PERCENT-DEATHS !
    DUP TOTAL-DEATHS @+
  THEN
;

: JUDGE
  CR
  ." IN YOUR 10-YEAR TERM OF OFFICE, " PERCENT-DEATHS @. ." OF THE" CR
  ." POPULATION STARVED PER YEAR ON THE AVERAGE, I.E. A TOTAL OF" CR
  TOTAL-DEATHS @. ." PEOPLE DIED!!" CR
  ." YOU STARTED WITH 10 ACRES PER PERSON AND ENDED WITH" SPACE
  ACERS @ S>F POPULATION @ S>F F/ DUP F.
  ." ACRES PER PERSON." CR

  PERCENT-DEATHS @ 33 > DUP 7E F< OR IF
    IMPEACH!
  ELSE
    PERCENT-DEATHS @ 10 > DUP 9E F< OR IF
      ." YOUR HEAVY-HANDED PERFORMANCE SMACKS OF NERO AND IVAN IV." CR
      ." THE PEOPLE (REMAINING) FIND YOU AN UNPLEASANT RULER, AND," CR
      ." FRANKLY, HATE YOUR GUTS!!" CR
    ELSE
      PERCENT-DEATHS @ 3 > DUP 10E F< OR IF
	." YOUR PERFOMANCE COULD HAVE BEEN SOMEWAHT BETTER, BUT" CR
	." REALLY WASN'T TOO BAD AT ALL.  "
	POPULATION @ 80 PERCENT RAND-RANGE .
	." PEOPLE" CR
	." DEARLY LIKE TO SEE YOU ASSASSINATED BUT WE ALL HAVE OUR" CR
	." TRIVIAL PROBLEMS" CR
      ELSE
	." A FANTASTIC PERFORMANCE!!!  CHAREMANGE, DISRAELI, AND " CR
	." JEFFERSON COMBINED COULD NOT HAVE DONE BETTER!" CR
      THEN
    THEN
  THEN
;

: START
  ." TRY YOUR HAND AT GOVERNING ANCIENT SUMERIA" CR
  ." FOR A TEN-YEAR TERM OF OFFICE" CR
  0 0
  10 0 DO
    CR
    I 1+ YEAR !
    TAKE-STOCK
    ( interactive part )
    BUY-LAND
    SELL-LAND
    FEED-PEOPLE
    PLANT-SEED
    ( as time goes by )
    HARVEST
    MULTIPLY
    IMPEACH?
  LOOP 2DROP
  JUDGE
;