Hamurabi, based on The Sumerian Game (1964), is a management simulation in which the player governs the ancient city-state of Sumeria. This program is a port of the BASIC version of the same name that was first printed in David H. Ahl’s BASIC Computer Games:
The city initially has 1,000 acres, 100 people and 3,000 bushels of grain in storage.
You may buy and sell land with your neighboring city-states for bushels of grain -- the price will vary between 17 and 26 bushels per acre. You also must use grain to feed your people and as seed to plant the next year’s crop.
[…] You also have the unexpected to contend with such as a plague, rats destroying stored grain, and variable harvests.
In comparison with the BASIC version, the FORTRAN port has nearly twice as many lines, due to the structured implementation that relies on functions and subroutines instead of line jumps.
The game implements the following functions and subroutines:
RESULT = FEED(ISTOR)
INTEGER
).RESULT = PLANT(IACRE, IPOPU, ISTOR)
INTEGER
).CALL FINK()
CALL NOACRE(IACRE)
CALL NOBUSH(ISTOR)
CALL PLAY()
CALL RESIGN()
CALL REVIEW(IACRE, IPOPU, IPERC, IDEAD)
CALL TRADE(IACRE, ISTOR, IPRIC)
CALL QUIT()
Another three procedures are called that are not part of the ANSI FORTRAN 77 language standard:
RESULT = TIME()
INTEGER
). Required for the
initialisation of the pseudo-random number generator.RESULT = RAND(I)
REAL
).CALL SRAND(ISEED)
INTEGER
).Most modern compilers provide these through extensions. You may have to modify the procedure calls depending on the FORTRAN compiler used.
Save the program as file hamurabi.f
inside an arbitrary
directory.
C ******************************************************************
C
C HAMURABI
C
C CONVERTED FROM THE ORIGINAL FOCAL PROGRAM AND MODIFIED FOR
C EDUSYSTEM 70 BY DAVID H. AHL, DIGITAL. MODIFIED FOR 8K MICROSOFT
C BASIC BY PETER TURNBULL. CONVERTED TO FORTRAN 77 BY PHILIPP ENGEL.
C
C ******************************************************************
PROGRAM HAMURA
EXTERNAL PLAY
C
C INITIALISE PSEUDO-RANDOM NUMBER GENERATOR, OUTPUT THE HEADER, AND
C START A NEW GAME.
C
CALL SRAND(TIME())
PRINT 100
CALL PLAY()
100 FORMAT (31X,' HAMURABI',/,
&26X,' CREATIVE COMPUTING',/,24X,' MORRISTOWN, NEW JERSEY',/,/,
&' TRY YOUR HAND AT GOVERNING ANCIENT SUMERIA',/,
&' FOR A TEN-YEAR TERM OF OFFICE.')
END
C ******************************************************************
INTEGER FUNCTION FEED(ISTOR)
C
C ASKS PLAYER HOW MANY BUSHELS TO FEED TO THE PEOPLE.
C
EXTERNAL NOBUSH, RESIGN
INTEGER ISTOR
INTEGER ISTAT
10 CONTINUE
PRINT 100
READ (*, 200, IOSTAT=ISTAT) FEED
IF (ISTAT .NE. 0 .OR. FEED .LT. 0) CALL RESIGN()
IF (FEED .GT. ISTOR) THEN
CALL NOBUSH(ISTOR)
GOTO 10
END IF
ISTOR = ISTOR - FEED
100 FORMAT (' HOW MANY BUSHELS DO YOU WISH TO FEED YOUR PEOPLE?')
200 FORMAT (I6)
END
C ******************************************************************
INTEGER FUNCTION PLANT(IACRE, IPOPU, ISTOR)
C
C LET THE FARMING BEGIN.
C
EXTERNAL NOACRE, NOBUSH, RESIGN
INTEGER IACRE, IPOPU, ISTOR
INTEGER ISTAT
10 CONTINUE
PRINT 100
READ (*, 300, IOSTAT=ISTAT) PLANT
IF (ISTAT .NE. 0) GOTO 10
IF (PLANT .EQ. 0) RETURN
IF (PLANT .LT. 0) CALL RESIGN()
C
C TRYING TO PLANT MORE ACRES THAN THE PLAYER OWNS?
C
IF (PLANT .GT. IACRE) THEN
CALL NOACRE(IACRE)
GOTO 10
END IF
C
C ENOUGH GRAIN FOR SEED?
C
IF (INT(PLANT / 2.0) .GT. ISTOR) THEN
CALL NOBUSH(ISTOR)
GOTO 10
END IF
C
C ENOUGH PEOPLE TO TEND THE CROPS?
C
IF (PLANT .GE. 10 * IPOPU) THEN
PRINT 200, IPOPU
GOTO 10
END IF
ISTOR = ISTOR - INT(PLANT / 2.0)
100 FORMAT (' HOW MANY ACRES DO YOU WISH TO PLANT WITH SEED?')
200 FORMAT (' BUT YOU HAVE ONLY ',I3,' PEOPLE TO TEND THE FIELD!',
&' NOW THEN,')
300 FORMAT (I6)
END
C ******************************************************************
SUBROUTINE FINK()
C
C PLAYER HAS BEEN IMPEACHED.
C
EXTERNAL QUIT
PRINT 100
CALL QUIT()
100 FORMAT (' DUE TO THIS EXTREME MISMANAGEMENT YOU HAVE NOT ONLY',
&/,' BEEN IMPEACHED AND THROWN OUT OF OFFICE BUT YOU HAVE',
&/,' ALSO BEEN DECLARED NATIONAL FINK!!')
END
C ******************************************************************
SUBROUTINE NOACRE(IACRE)
C
C NOT ENOUGH ACRES.
C
INTEGER IACRE
PRINT 100, IACRE
100 FORMAT (' HAMURABI: THINK AGAIN. YOU OWN ONLY ',I4,' ACRES.',
&' NOW THEN,')
END
C ******************************************************************
SUBROUTINE NOBUSH(ISTOR)
C
C NOT ENOUGH BUSHELS OF GRAIN.
C
INTEGER ISTOR
PRINT 100, ISTOR
100 FORMAT (' HAMURABI: THINK AGAIN. YOU HAVE ONLY ',I4,
&' BUSHELS OF GRAIN. NOW THEN,')
END
C ******************************************************************
SUBROUTINE PLAY()
C
C THE GAME STARTS HERE.
C
EXTERNAL REVIEW, FINK
INTEGER FEED, PLANT
INTEGER IFEED, IPLAN, IQUOT, IRAND
INTEGER IPOPU, IHARV, ISTOR, IYIEL, IRATS, IACRE, IIMMI, IPLAG,
& IDEAD, IPERC, IPRIC, ISTAR, IYEAR
COMMON /GLOBAL/ IPOPU, IHARV, ISTOR, IYIEL, IRATS, IACRE, IIMMI,
& IPLAG, IDEAD, IPERC, IPRIC, ISTAR, IYEAR
C
C INITIALISE THE GAME STATE.
C
IRATS = IHARV - ISTOR
IACRE = IHARV / IYIEL
C
C THE MAIN LOOP.
C
10 CONTINUE
IYEAR = IYEAR + 1
IPOPU = IPOPU + IIMMI
PRINT 100, IYEAR, ISTAR, IIMMI
C
C A PLAGUE STRIKES! HALF THE POPULATION DIED.
C
IF (IPLAG .LE. 0) THEN
IPOPU = IPOPU / 2
PRINT 200
END IF
PRINT 300, IPOPU, IACRE, IYIEL, IRATS, ISTOR
C
C MAX. NUMBER OF ROUNDS REACHED: REVIEW PERFORMANCE AND QUIT.
C
IF (IYEAR .EQ. 11) CALL REVIEW(IACRE, IPOPU, IPERC, IDEAD)
C
C ROLL NEW PRICE PER ACRE.
C
IPRIC = INT(10 * RAND(0)) + 17
C
C ASK THE PLAYER TO BUY/SELL LAND.
C
PRINT 400, IPRIC
CALL TRADE(IACRE, ISTOR, IPRIC)
IFEED = FEED(ISTOR)
IPLAN = PLANT(IACRE, IPOPU, ISTOR)
C
C A BOUNTIFUL HARVEST!
C
IYIEL = 1 + INT(RAND(0) * 5)
IHARV = IPLAN * IYIEL
IRATS = 0
C
C RATS ARE RUNNING WILD.
C
IF (INT(IYIEL / 2.0) .EQ. IYIEL / 2) THEN
IRAND = 1 + INT(RAND(0) * 5)
IRATS = ISTOR / IRAND
END IF
ISTOR = ISTOR - IRATS + IHARV
C
C LET'S HAVE SOME BABIES. (ACTUALLY, IT'S IMMIGRATION.)
C
IRAND = 1 + INT(RAND(0) * 5)
IIMMI = INT(IRAND * (20 * IACRE + ISTOR) / IPOPU / 100 + 1)
C
C HORRORS, A 15% CHANCE OF PLAGUE.
C
IPLAG = INT(10 * (2 * RAND(0) - 0.3))
IQUOT = IFEED / 20
C
C EITHER A NEW YEAR, OR IMPEACHMENT IF TOO MANY PEOPLE STARVED.
C
IF (IPOPU .LT. IQUOT) THEN
ISTAR = 0
ELSE
ISTAR = IPOPU - IQUOT
IF (ISTAR .GT. 0.45 * IPOPU) THEN
PRINT 500, ISTAR
CALL FINK()
END IF
IPERC = ((IYEAR - 1) * IPERC + ISTAR * 100 / IPOPU) / IYEAR
IPOPU = IQUOT
IDEAD = IDEAD + ISTAR
END IF
GOTO 10
100 FORMAT (/,' HAMURABI: I BEG TO REPORT TO YOU,',/,/,
&11X,'IN YEAR ',I2,', ',I2,' PEOPLE STARVED, ',I2,
&' CAME TO THE CITY.')
200 FORMAT (/,11X,'A HORRIBLE PLAGUE STRUCK! HALF THE PEOPLE DIED.',/)
300 FORMAT (11X,'POPULATION IS NOW ',I3,'.',/,
&11X,'THE CITY NOW OWNS ',I4,' ACRES.',/,
&11X,'YOU HARVESTED ',I4,' BUSHELS PER ACRE.',/,
&11X,'THE RATS ATE ',I4,' BUSHELS.',/,
&11X,'YOU NOW HAVE ',I4,' BUSHELS IN STORE.',/)
400 FORMAT (' LAND IS TRADING AT ',I2,' BUSHELS PER ACRE.')
500 FORMAT (/,' YOU STARVED ',I2,' PEOPLE IN ONE YEAR!!')
END
C ******************************************************************
SUBROUTINE RESIGN()
C
C THE STEWARD HAS ENOUGH.
C
EXTERNAL QUIT
PRINT 100
CALL QUIT()
100 FORMAT (' HAMURABI: I CANNOT DO WHAT YOU WISH.',
&' GET YOURSELF ANOTHER STEWARD!!')
END
C ******************************************************************
SUBROUTINE REVIEW(IACRE, IPOPU, IPERC, IDEAD)
C
C OUTPUTS RESULTS.
C
EXTERNAL FINK, QUIT
REAL RAND
INTEGER IACRE, IPOPU, IPERC, IDEAD
INTEGER ILAND
ILAND = IACRE / IPOPU
PRINT 100, IPERC, IDEAD, ILAND
IF (IPERC .GT. 33 .OR. ILAND .LT. 7) CALL FINK()
IF (IPERC .GT. 10 .OR. ILAND .LT. 9) THEN
PRINT 200
ELSE IF (IPERC .GT. 3 .OR. ILAND .LT. 10) THEN
PRINT 300, INT(IPOPU * 0.8 * RAND(0))
ELSE
PRINT 400
END IF
CALL QUIT()
100 FORMAT (' IN YOUR 10-YEAR TERM OF OFFICE, ',I2,
&' PERCENT OF THE',/,' POPULATION STARVED PER YEAR ON THE',
&' AVERAGE, I.E. A TOTAL OF',/,1X,I2,' PEOPLE DIED!!',/,
&' YOU STARTED WITH 10 ACRES PER PERSON AND ENDED WITH',/,
&1X,I2,' ACRES PER PERSON.')
200 FORMAT (' YOUR HEAVY-HANDED PERFORMANCE SMACKS OF NERO AND',
&' IVAN IV.',/,' THE PEOPLE (REMAINING) FIND YOU AN UNPLEASANT',
&' RULER, AND,',/,' FRANKLY, HATE YOUR GUTS!!')
300 FORMAT (' YOUR PERFORMANCE COULD HAVE BEEN SOMEWHAT BETTER,',
&' BUT',/,' REALLY WASN''T TOO BAD AT ALL. ',I2,' PEOPLE',/,
&' WOULD DEARLY LIKE TO SEE YOU ASSASSINATED BUT WE ALL HAVE OUR',
&/,' TRIVIAL PROBLEMS.')
400 FORMAT (' A FANTASTIC PERFORMANCE!! CHARLEMANGE, DISRAELI, AND',
&/,' JEFFERSON COMBINED COULD NOT HAVE DONE BETTER!')
END
C ******************************************************************
SUBROUTINE TRADE(IACRE, ISTOR, IPRIC)
C
C LETS THE PLAYER BUY/SELL ACRES.
C
EXTERNAL NOACRE, NOBUSH, RESIGN
INTEGER IACRE, ISTOR, IPRIC
INTEGER IAMOU, ISTAT
C
C ASK TO BUY ACRES.
C
10 CONTINUE
PRINT 100
READ (*, 300, IOSTAT=ISTAT) IAMOU
IF (ISTAT .NE. 0 .OR. IAMOU .LT. 0) CALL RESIGN()
IF (IPRIC * IAMOU .GT. ISTOR) THEN
CALL NOBUSH(ISTOR)
GOTO 10
END IF
IF (IAMOU .GT. 0) THEN
IACRE = IACRE + IAMOU
ISTOR = ISTOR - IPRIC * IAMOU
RETURN
END IF
C
C IF NO ACRES BOUGHT, ASK HOW MANY TO SELL.
C
20 CONTINUE
PRINT 200
READ (*, 300, IOSTAT=ISTAT) IAMOU
IF (ISTAT .NE. 0 .OR. IAMOU .LT. 0) CALL RESIGN()
IF (IAMOU .GE. IACRE) THEN
CALL NOACRE(IACRE)
GOTO 20
END IF
IF (IAMOU .GT. 0) THEN
IACRE = IACRE - IAMOU
ISTOR = ISTOR + IPRIC * IAMOU
RETURN
END IF
100 FORMAT (' HOW MANY ACRES DO YOU WISH TO BUY?')
200 FORMAT (' HOW MANY ACRES DO YOU WISH TO SELL?')
300 FORMAT (I6)
END
C ******************************************************************
SUBROUTINE QUIT()
C
C PRINTS LAST MESSAGE AND EXITS.
C
PRINT 100
STOP
100 FORMAT (/,' SO LONG FOR NOW.')
END
C ******************************************************************
BLOCK DATA
C
C COMMON VARIABLES:
C
C IPOPU - SIZE OF THE POPULATION.
C IHARV - BUSHELS HARVESTED IN ONE YEAR.
C ISTOR - NUMBER OF BUSHELS STORED.
C IYIEL - YIELD OF ACRES.
C IRATS - BUSHELS EATEN BY RATS.
C IACRE - ACRES OWNED BY PLAYER.
C IIMMI - IMMIGRATION PER YEAR.
C IPLAG - FLAG FOR HORRIBLE PLAGUE.
C IDEAD - NUMBER OF PEOPLE WHO DIED.
C IPERC - PERCENTAGE OF PEOPLE WHO DIED.
C IPRIC - PRICE PER ACRE.
C ISTAR - NUMBER OF PEOPLE STARVED TO DEATH IN ONE YEAR.
C IYEAR - THE CURRENT YEAR.
C
COMMON /GLOBAL/
&IPOPU, IHARV, ISTOR, IYIEL, IRATS, IACRE, IIMMI, IPLAG, IDEAD,
&IPERC, IPRIC, ISTAR, IYEAR
DATA
&IPOPU, IHARV, ISTOR, IYIEL, IRATS, IACRE, IIMMI, IPLAG, IDEAD,
&IPERC, IPRIC, ISTAR, IYEAR /95,3000,2800,3,0,0,5,1,0,0,0,0,0/
END
UNIX | Flang/F18 | $ flang -o hamurabi hamurabi.f |
---|---|---|
GNU Fortran | $ gfortran -o hamurabi hamurabi.f | |
Intel Fortran Compiler | $ ifort -o hamurabi hamurabi.f | |
Win32 | Digital/Compaq Visual Fortran | > fl32.exe hamurabi.f /Fe=hamurabi.exe |