Old school Hamurabi

Post Reply
Henko
Posts: 814
Joined: Tue Apr 09, 2013 12:23 pm
My devices: iPhone,iPad
Windows
Location: Groningen, Netherlands
Flag: Netherlands

Old school Hamurabi

Post by Henko »

Someone mentioned the early game of Hamurabi.
It triggered me to produce the game as i remember it. It is an old fashioned text based replica. I replaced the standard keyboard by a little numerical keypad, and designed my own simulation mechanisms.
Perhaps i will make a "modern" version with a graphical UI.


94C4D998-BDBF-407E-9AEB-9E3707A507D3.png
94C4D998-BDBF-407E-9AEB-9E3707A507D3.png (447.81 KiB) Viewed 4758 times

Code: Select all

' Old school Hamurabi, version 11-02-2019
'
' *** parameters
C=120    ' starting # of kids
V=300    ' starting # of adults
bo=0.04  ' starting value of birth rate
dco=0.01 ' starting value of mortuality of kids
dvo=0.02 ' starting value of mortuality of adults
S=100    ' starting value of acres of land
e=2      ' needed # of bushels food per person
m=3      ' needed # of adults per acre
z=2      ' needed # bushels seed per acre
q=13     ' basic # of bushels produced per acre 
k=30     ' cost of additional purchased acre
effo=1   ' starting value of production efficiency
SQ=100   ' starting stock of bushels
Zt=200   ' starting value of bushels of seed
b=bo ! dc=dco ! dv=dvo ! eff=effo
print "REMEMBER!"
print "one person needs about 2 bushels of food/year"
print "one acre of land needs about 3 adults to harvest"
print

do
  if yr<3 then init_numpad(570,70+340*yr,40,.8,.8,.8,1)
  yr+=1 ! print ! print "Year ";yr;" of your reign"
  Sf=min(S,V/m) ! Sf=min(Sf,Zt/z) ! dQ=int(eff*q*Sf)
  SQ+=dQ ! print dQ;" bushels have been produced"
  if rnd(1)<0.3 then
    gr=200+rnd(300) ! SQ=max(.1,SQ-gr)
    print "*** Grasshoppers ate";gr;"bushels!!! ***"
    end if
  stock() ! print "How many bushels food for the ";C+V;" people?"
  Et=numpad(0,SQ) ! SQ=max(.1,SQ-Et)
  stock() ! print "How many bushels as seed for new crops?"
  Zt=numpad(0,SQ) ! SQ=max(.1,SQ-Zt)
  stock() ! print "How many bushels for buying land at ";k;"/acre"
  Kt=numpad(0,SQ) ! SQ=max(.1,SQ-Kt) ! S+=Kt/k
  phi=Et/e/(C+V) ! phip=int(100*phi)
  b=0.6*b+0.4*phi*bo ! eff=0.9*eff+0.1*phi*effo
  dc=0.3*dc+0.7*dco/phi ! dv=0.4*dv+0.6*dvo/phi
  adr=int(1000*(dc*C+dv*V)/(C+V))/10
  aux=C
  C=int(C+b*V-(dc+0.05)*C) ! V=int(V+.05*aux-dv*V)
  if rnd(1)<.2 then
    f=10+rnd(20)
    print "*** The plague killed";f;"percent of the people!! ***"
    f/=100 ! C=int((1-f)*C) ! V=int((1-f)*V)
    end if
  print ! print "Results for year ";yr
  print "Population is now ";C;" kids & ";V;" adults"
  print "Average health of the people was ";phip;"%"
  print "Birth rate was ";int(1000*b)/10;"%"
  print "Average death rate was ";adr;"%"
  print "Production efficiency is ";int(100*eff);"%"
  print "You now own ";S;" acres of land"
  until forever
end

def stock() ! print "you have ";int(.SQ);" bushels left." ! end def

' numerical keypad
' 
' produce a simple keypad to quickly enter a number in an app
' upon entry, the keypad disappears
' initialize once, multiple use after
' left upper corner is placed at "xtop,ytop"
' "bs" is the button size (keypad becomes 4.3 times larger)
'
def init_numpad(xtop,ytop,bs,R,G,B,alpha)
name$="numpad" ! cn=10
page name$ set 
page name$ frame xtop,ytop,0,0
set buttons custom
if bs<20 then bs=20
sp=4 ! th=.5*bs+4 ! ww=4*bs+5*sp ! hh=th+4*bs+6*sp
fsize=.5*bs
draw font size fsize ! set buttons font size fsize
draw color 1,1,1 ! fill color .7,.7,.7
button "rec" title "" at 0,0 size ww,hh
button "res" title "" at 0,0 size ww,th+4
fill color R,G,B ! fill alpha alpha
button "0" title "0" at sp,th+3*bs+5*sp size bs,bs
for k=1 to 9
  x=(k-1)%3 ! y=2-floor((k-1)/3)
  button k title k at (x+1)*sp+x*bs,th+y*bs+(y+2)*sp size bs,bs
  next k
button "-" title "-" at 2*sp+bs,th+3*bs+5*sp size bs,bs
button "." title "." at 3*sp+2*bs,th+3*bs+5*sp size bs,bs
button "Cl" title "C" at 4*sp+3*bs,th+2*sp size bs,bs
button "del" title "<-" at 4*sp+3*bs,th+bs+3*sp size bs,bs
button "ok" title "ok" at 4*sp+3*bs,th+2*bs+4*sp size bs,2*bs+sp
page name$ hide
page name$ frame xtop,ytop,ww,hh
set buttons default ! set buttons font size 20
draw font size 20 ! draw color 0,0,0
end def

' size of number is accepted between "minval" and "maxval"
' if both "minval" and "maxval" are zero, then no restrictions
' max number of tokens in the number is 10 (minus and dot included)
' works for option base 0 and 1
'
def numpad(minval,maxval)
page "numpad" set ! page "numpad" show
a$="" ! pflag=0 ! sflag=0 ! ob=1-option_base()
nump1:
if b_p("ok") then
  number=val(a$) ! a$="" ! button "res" text ""
  if minval<>0 or maxval<>0 then
    if number<minval or number>maxval then
      button "res" text "range error"
      pflag=0 ! a$="" ! pause 1
      button "res" text ""
      goto nump1
      end if
    end if
  page "numpad" hide ! page "" set
  return number
  end if
if b_p("Cl") then
  a$ = "" ! pflag=0 ! sflag=0 ! goto nump3
  end if
if b_p("del") and len(a$) then
  ll=len(a$) ! if substr$(a$,ll-ob,ll-ob)="." then pflag=0
  a$ = left$(a$,ll-1) ! sflag=0 ! goto nump3
  end if
if b_p("-") then
  a$ = "-" ! pflag=0 ! sflag=0 ! goto nump3
  end if
if b_p(".") and not pflag and not sflag then
  a$ &= "." ! pflag=1 ! goto nump3
  end if
for k=0 to 9
  t$=k
  if b_p(t$) and not sflag then
    a$ &= t$ ! goto nump3
    end if
  next k
goto nump1
nump3:
if len(a$)>10 then ! sflag=1 ! goto nump1 ! end if
button "res" text a$
goto nump1
end def

def b_p(a$) = button_pressed(a$)

User avatar
GeorgeMcGinn
Posts: 435
Joined: Sat Sep 10, 2016 6:37 am
My devices: IPad Pro 10.5in
IMac
Linux i386
Windows 7 & 10
Location: Venice, FL
Flag: United States of America
Contact:

Re: Old school Hamurabi (Vintage BASIC Versions)

Post by GeorgeMcGinn »

Interesting adaptation.

I was the one who mentioned it, and I have three vintage versions, all dating from the 60's to the 70's. Here they are. My next post is my version where I've made some changes and working on expanding the disasters. For example, one of the versions below will allow people to leave on their own (or maybe they were executed!)

Very few changes were made to each to allow them to work. INPUT statements and multi-line characters were changed.


Version 1 – The Creative Computing Magazine

Code: Select all

10 PRINT TAB(32);"HAMURABI"
20 PRINT TAB(15);"CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY"
30 PRINT
40 PRINT
50 PRINT
80 PRINT "TRY YOUR HAND AT GOVERNING ANCIENT SUMERIA"
90 PRINT "FOR A TEN-YEAR TERM OF OFFICE.":PRINT
95 D1=0!P1=0
100 Z=0!P=95!S=2800!H=3000!E=H-S
110 Y=3!A=H/Y!I=5!Q=1
210 D=0
215 PRINT!PRINT
216 PRINT "HAMURABI:  I BEG TO REPORT TO YOU,"!Z=Z+1
217 PRINT "IN YEAR";Z;",";D;"PEOPLE STARVED,";I;"CAME TO THE CITY,"
218 P=P+I
220 IF Q>0 THEN 230
225 P=INT(P/2)!PRINT "A HORRIBLE PLAGUE STRUCK!  HALF THE PEOPLE DIED."
230 PRINT "POPULATION IS NOW";P
235 PRINT "THE CITY NOW OWNS ";A;"ACRES."
240 PRINT "YOU HARVESTED";Y;"BUSHELS PER ACRE."
250 PRINT "THE RATS ATE";E;"BUSHELS."
260 PRINT "YOU NOW HAVE ";S;"BUSHELS IN STORE."!PRINT
270 IF Z=11 THEN 860
310 C=INT(10*RND(1))!Y=C+17
315 PRINT "LAND IS TRADING AT";Y;"BUSHELS PER ACRE."
320 INPUT "HOW MANY ACRES DO YOU WISH TO BUY":Q
321 IF Q<0 THEN 850
322 IF Y*Q<=S THEN 330
323 GOSUB 710
324 GOTO 320
330 IF Q=0 THEN 340
335 A=A+Q!S=S-Y*Q!C=0!GOTO 400
340 INPUT "HOW MANY ACRES DO YOU WISH TO SELL":Q
341 IF Q<0 THEN 850
342 IF Q<A THEN 350
343 GOSUB 720
344 GOTO 340
350 A=A-Q!S=S+Y*Q!C=0
400 PRINT
410 INPUT "HOW MANY BUSHELS DO YOU WISH TO FEED YOUR PEOPLE":Q
412 IF Q<0 THEN 850
418 REM *** TRYING TO USE MORE GRAIN THAN IS IN SILOS?
420 IF Q<=S THEN 430
421 GOSUB 710
422 GOTO 410
430 S=S-Q!C=1
435 PRINT
440 INPUT "HOW MANY ACRES DO YOU WISH TO PLANT WITH SEED":D
441 IF D=0 THEN 511
442 IF D<0 THEN 850
444 REM *** TRYING TO PLANT MORE ACRES THAN YOU OWN?
445 IF D<=A THEN 450
446 GOSUB 720
447 GOTO 440
449 REM *** ENOUGH GRAIN FOR SEED?
450 IF INT(D/2)<=S THEN 455
452 GOSUB 710
453 GOTO 440
454 REM *** ENOUGH PEOPLE TO TEND THE CROPS?
455 IF D<10*P THEN 510
460 PRINT "BUT YOU HAVE ONLY";P;"PEOPLE TO TEND THE FIELDS!  NOW THEN,"
470 GOTO 440
510 S=S-INT(D/2)
511 GOSUB 800
515 REM *** A BOUNTIFUL HARVEST!
520 Y=C!H=D*Y!E=0!GOSUB 800
521 IF INT(C/2)<>C/2 THEN 530
523 REM *** RATS ARE RUNNING WILD!!
525 E=INT(S/C)
530 S=S-E+H
531 GOSUB 800
532 REM *** LET'S HAVE SOME BABIES
533 I=INT(C*(20*A+S)/P/100+1)
539 REM *** HOW MANY PEOPLE HAD FULL TUMMIES?
540 C=INT(Q/20)
541 REM *** HORROS, A 15% CHANCE OF PLAGUE
542 Q=INT(10*(2*RND(1)-.3))
550 IF P<C THEN 210
551 REM *** STARVE ENOUGH FOR IMPEACHMENT?
552 D=P-C!IF D>.45*P THEN 560
553 P1=((Z-1)*P1+D*100/P)/Z
555 P=C!D1=D1+D!GOTO 215
560 PRINT!PRINT "YOU STARVED";D;"PEOPLE IN ONE YEAR!!!"
565 PRINT "DUE TO THIS EXTREME MISMANAGEMENT YOU HAVE NOT ONLY"
566 PRINT "BEEN IMPEACHED AND THROWN OUT OF OFFICE BUT YOU HAVE"
567 PRINT "ALSO BEEN DECLARED NATIONAL FINK!!!!"
568 GOTO 990
710 PRINT "HAMURABI:  THINK AGAIN.  YOU HAVE ONLY"
711 PRINT S;"BUSHELS OF GRAIN.  NOW THEN,"
712 RETURN
720 PRINT "HAMURABI:  THINK AGAIN.  YOU OWN ONLY";A;"ACRES.  NOW THEN,"
730 RETURN
800 C=INT(RND(1)*5)+1
801 RETURN
850 PRINT!PRINT "HAMURABI:  I CANNOT DO WHAT YOU WISH."
855 PRINT "GET YOURSELF ANOTHER STEWARD!!!!!"
857 GOTO 990
860 PRINT "IN YOUR 10-YEAR TERM OF OFFICE,";P1;"PERCENT OF THE"
861 PRINT "POPULATION STARVED PER YEAR ON THE AVERAGE, I.E. A TOTAL OF"
862 PRINT D1;"PEOPLE DIED!!"
865 L=A/P
870 PRINT "YOU STARTED WITH 10 ACRES PER PERSON AND ENDED WITH"
875 PRINT L;"ACRES PER PERSON."!PRINT
880 IF P1>33 THEN 565
885 IF L<7 THEN 565
890 IF P1>10 THEN 940
892 IF L<9 THEN 940
895 IF P1>3 THEN 960
896 IF L<10 THEN 960
900 PRINT "A FANTASTIC PERFORMANCE!!!  CHARLEMANGE, DISRAELI, AND"
905 PRINT "JEFFERSON COMBINED COULD NOT HAVE DONE BETTER!"
910 GOTO 990
940 PRINT "YOUR HEAVY-HANDED PERFORMANCE SMACKS OF NERO AND IVAN IV."
945 PRINT "THE PEOPLE (REMIANING) FIND YOU AN UNPLEASANT RULER, AND,"
950 PRINT "FRANKLY, HATE YOUR GUTS!!"
955 GOTO 990
960 PRINT "YOUR PERFORMANCE COULD HAVE BEEN SOMEWHAT BETTER, BUT"
965 PRINT "REALLY WASN'T TOO BAD AT ALL. ";INT(P*.8*RND(1));"PEOPLE"
970 PRINT "WOULD DEARLY LIKE TO SEE YOU ASSASSINATED BUT WE ALL HAVE OUR"
975 PRINT "TRIVIAL PROBLEMS."
990 PRINT: FOR N=1 TO 10!PRINT CHR$(7);!NEXT N
995 PRINT "SO LONG FOR NOW."!PRINT
999 END

Version 2 – GW-BASIC Version

Code: Select all

100 PRINT "YOU ARE THE RULER OF THE ANCIENT KINGDOM OF SUMERIA."
101 PRINT "YOUR PEOPLE CALL YOU 'HAMURABI THE WISE'. YOUR TASK IS"
102 PRINT "TO DEVELOP A STABLE ECONOMY BY THE WISE MANAGEMENT OF"
103 PRINT "YOUR RESOURCES. YOU WILL BE BESET FROM TIME TO TIME"
104 PRINT "BY NATURAL EVENTS. THE ONLY HELP I CAN GIVE YOU IS THE "
105 PRINT "FACT THAT IT TAKES 2 BUSHELS OF GRAIN AS SEED TO PLANT"
106 PRINT "AN ACRE. MAY YOU JUDGE WELL, ALKNOWING HAMURABI."
107 PRINT "***********HAMURABI IS HERE***********"
108 RANDOMIZE TIMER
110 P=95
111 S=2800
112 H=3000
113 E=H-S
114 Y=3
115 A=H/Y
116 I=5
117 Q=1
210 D=0
215 PRINT
217 PRINT "LAST YEAR ";D;" PEOPLE STARVED, ";I;" CAME TO THE CITY"
218 P=P+I
227 IF Q>0 THEN GOTO 230
228 P=INT(P/2)
229 PRINT "HALF DIED OF THE PLAGUE"
230 PRINT "POPULATION IS NOW ";P
232 PRINT "CITY OWNS ";A;" ACRES, ";Y;" BUSHELS HARVESTED PER ACRE"
250 PRINT "RATS DESTROYED ";E;" BUSHELS. ";S;" BUSHELS IN STORE"
260 PRINT "DO YOU WISH TO ABDICATE?"
270 INPUT "DO YOU WISH TO ABDICATE?":B$
275 B$=CAPSTR$(B$)
280 IF B$="NO" OR B$="N" THEN 310
285 IF B$<>"YES" OR B$<>"Y" THEN 260
290 STOP
310 C=INT(10*RND)
311 Y=C+17
312 PRINT "LAND COST ";Y;" BUSHELS PER ACRE"
320 PRINT "BUY LAND";
321 INPUT "BUY LAND?":Q
322 IF Y*Q<S THEN GOTO 330
323 GOSUB 710
324 GOTO 320
330 IF Q=0 THEN GOTO 340
331 A=A+Q
332 S=S-Y*Q
333 C=0
334 GOTO 410
340 PRINT "SELL LAND?"
341 INPUT Q
342 IF Q<A THEN 350
343 GOSUB 710
344 GOTO 340
350 A=A-Q
351 S=S+Y*Q
352 C=0
410 PRINT "BUSHELS FOR FOOD"
411 INPUT Q
420 IF Q<=S THEN GOTO 430
421 GOSUB 710
422 GOTO 410
430 S=S-Q
431 C=1
440 PRINT "ACRES TO PLANT"
441 INPUT "ACRES TO PLANT?":D
450 IF D<A THEN GOTO 455
451 IF INT(D/2)<S THEN GOTO 455
452 GOSUB 710
453 GOTO 440
455 IF D>=10*P THEN GOTO 452
510 S=S-INT(D/2)
511 GOSUB 800
512 Y=C
513 H=D*Y
520 E=0
521 GOSUB 800
522 IF INT(C/2)<>C/2 THEN GOTO 530
523 E=INT(S/C)
530 S=S-E+H
531 GOSUB 800
532 I=INT(C*(20*A+S)/P/100+1)
540 C=INT(Q/20)
541 Q=INT(10*(2*RND-1))
550 IF P<C THEN GOTO 210
551 D=P-C
552 P=C
553 GOTO 215
710 PRINT "THINK AGAIN, YOU HAVE "
711    PRINT A;" ACRES, ";P;" PEOPLE, ";S;" BUSHELS"
712    RETURN
800 C=INT(RND*5)+1
801      RETURN
900 END

Version 3 – IMSAI 4K Version

Code: Select all

10 REM ORIGINAL HAMURABI IN IMSAI 4K BASIC
20 REM FROM REVISION REWRITTEN 12/11/77
310 PRINT "HAMURABI - ";
320 PRINT "WHERE YOU GOVERN THE ";
321 PRINT "ANCIENT KINGDOM OF SUMERIA."
330 PRINT "THE OBJECT IS TO FIGURE ";
331 PRINT "OUT HOW THE GAME WORKS!!"
340 PRINT "(IF YOU WANT TO QUIT, ";
341 PRINT "SELL ALL YOUR LAND.)"
400 A1=100
410 A2=5
420 A3=0
430 B1=2800
440 B2=200
450 B3=3
460 B4=3000
470 C1=1000
480 J=1
1010 PRINT
1020 PRINT "HAMURABI, I BEG TO REPORT ";
1021 PRINT "THAT LAST YEAR "
1040 PRINT A3;"PEOPLE STARVED AND ";A2;
1041 PRINT "PEOPLE CAME TO THE CITY."
1050 IF J>0 THEN 1100
1060 A1=A1-INT(A1/2)
1070 PRINT "THE PLAGUE KILLED ";
1071 PRINT "HALF THE PEOPLE."
1100 PRINT "THE POPULATION IS NOW ";A1
1120 PRINT "WE HARVESTED ";B4;"BUSHELS ";
1121 PRINT "AT ";B3;"BUSHELS PER ACRE."
1130 PRINT "RATS DESTROYED ";
1131 PRINT B2;" BUSHELS LEAVING ";B1;
1140 PRINT "BUSHELS IN"
1141 PRINT "THE STOREHOUSES."
1160 PRINT "THE CITY OWNS ";C1;
1161 PRINT "ACRES OF LAND."
1170 C2=17+INT(6*RND(1))
1180 PRINT "LAND IS WORTH ";C2;"BUSHELS ";
1181 PRINT "PER ACRE."
1210 PRINT "HAMURABI . . ."
1310 PRINT
1320 PRINT "BUY HOW MANY ACRES";
1330 INPUT I
1335 PRINT
1340 I=INT(ABS(I))
1350 IF I=0 THEN 1510
1360 J=I*C2
1370 IF J<=B1 THEN 1400
1380 GOSUB 9000
1390 GOTO 1310
1400 B1=B1-J
1410 C1=C1+I
1510 PRINT "SELL HOW MANY ACRES";
1520 INPUT I
1525 PRINT
1530 I=(ABS(I))
1540 IF I=0 THEN 1710
1550 IF I<C1 THEN 1600
1560 IF I=C1 THEN END
1570 GOSUB 9000
1580 GOTO 1510
1600 C1=C1-I
1610 B1=B1+C2*I
1710 PRINT "HOW MANY BUSHELS SHALL ";
1711 PRINT "WE DISTRIBUTE AS FOOD? ";
1720 INPUT I
1725 PRINT
1730 I=INT(ABS(I))
1740 IF I<=B1 THEN 1770
1750 GOSUB 9000
1760 GOTO 1710
1770 B1=B1-I
1780 A3=A1-INT(I/20)
1790 A2=0
1800 IF A3>=0 THEN 1910
1810 A2=-A3/2
1820 A3=0
1910 PRINT "HOW MANY ACRES SHALL ";
1911 PRINT "WE PLANT? ";
1920 INPUT I
1925 PRINT
1930 I=INT(ABS(I))
1935 IF I > C1 THEN 1960
1940 J=INT(I/2)
1950 IF J <= B1 THEN 1980
1960 GOSUB 9000
1970 GOTO 1910
1980 IF I>10*A1 THEN 1960
1990 B1=B1-J
2010 B3=INT(5*RND(1))+1
2020 B4=B3*I
2030 B2=INT((B1+B4)*0.07*RND(1))
2040 B1=B1-B2+B4
2050 J=INT(10*RND(1))
2060 A2=INT(A2+(5-B3)*B1/600+1)
2070 IF A2<= 50 THEN 2100
2080 A2=50
2100 A1=A1+A2-A3
2110 GOTO 1010
9000 REM***ERROR ROUTINE
9010 PRINT "HAMURABI, THINK AGAIN - ";
9011 PRINT "YOU ONLY HAVE "
9020 PRINT A1;"PEOPLE,";C1;"ACRES, AND ";
9030 PRINT B1;"BUSHELS IN STOREHOUSES."
9040 RETURN
George McGinn
Computer Scientist/Cosmologist/Writer/Photographer
Member: IEEE, IEEE Computer Society
IEEE Sensors Council & IoT Technical Community
American Association for the Advancement of Science (AAAS)

User avatar
GeorgeMcGinn
Posts: 435
Joined: Sat Sep 10, 2016 6:37 am
My devices: IPad Pro 10.5in
IMac
Linux i386
Windows 7 & 10
Location: Venice, FL
Flag: United States of America
Contact:

Re: New school Hamurabi

Post by GeorgeMcGinn »

Here I have changed the game so that it's more modular, I have expanded the variable names so they are understandable, and it should me easy to upgrade.

Planned upgrades are:
  • More natural and human disasters (like storms, people leaving and dying, insect pestilence before harvest, etc)
    Graphical User Interface showing real-time updates to figures before you commit them
Also, I like the additions that Henko put in, such as splitting the population between kids and adults. I may add men and women, and it may be sexist today, but back then parents with children, the women spent less time harvesting and more time raising children. This added to the game can affect how many acres can be both planted and harvested, so planning needs to be done accordingly.

And that is just the start of the features and functions that will turn this game into a top of the line strategy and planning game.

Code: Select all

/*
Program: Hamurabi – v1.10
Written by George McGinn – March 8, 2018.
Updated by George McGinn - October 19, 2018

HAMMURABI (Or Hamurabi) is a game that requires resource and population management, and was the game that launched other strategy games such as Civilization and Sim City. Written originally in 1967 in DEC's FOCAL language, this version is a merge of the Altair's 4K BASIC and the game update written by David Ahl. 

In Version 2 I plan to expand the game to include more natural disasters and methods to attempt mitigating, in advance, these damages, except for the plague. Whether or not mitigating rats is sucessful, the plague may have contaminated the shipment while in storage, out of the control of Hammarabi's efforts. Unlike the damage caused by rats after the harvest, natural disasters will reduce the production capabilites prior to the harvest, such as making less acres availabe for growing to stunting the growth by reducing the number of barrels per acre.


Screen Input:
Written by George McGinn – March, 2018
This is a very basic screen input that uses a graphical user interface for both input and output display.

UPDATES AND NOTES ON IMPROVEMENTS
—————————————————————————————————

v1.00 - March 8, 2018 (George McGinn)
        Initial program based on the game written in 1973 (BASIC version. Originally written in 
        FOCAL in 1968). Future updates will add a GUI so that the game takes on some compleity 
        while maintaining the Hamurabi game play.
        ——————————————————————————————————————————
v1.01 - October 19, 2018 (George McGinn)
        Fixed the RND generator calculation pertaining to damage due to rats in techBASIC.
        SmartBASIC, the random generator works differently depending on which CLASS you
        use. Also renamed all the variables to names that make sense (back in 1963 BASIC 
        could only handle variables with either a single character or a character and number).
        
        NOTE: Now thinking about adding pestilent damage as insects do damages crops far
        worse that rats do. Rats cause more damage if grain is shipped and causes plagues.
        Review the game to possibly add an increase to the chance of a plague based on how
        much damage rats cause.
        ——————————————————————————————————————————
v1.10 - October 19, 2018 (George McGinn)
        Added a separate routine to take in pestilent damage (all inclusive) damaging
        crops before they are harvested. This is accomplished by reducing the number of
        acres planted before calculating the harvest and damage caused by rats.
        ——————————————————————————————————————————
        
        
ABOUT HAMRURABI
---------------
Hamurabi is a text-based strategy video game centered on resource management in which the player, identified in the text as the ancient Babylonian King Hammurabi, enters numbers in response to questions posed by the game. The resources that the player must manage are people, land, and bushels of grain. These are managed over the course of ten rounds, each of which represents a year. Each person can farm a set amount of land, which produces grain. Grain, in turn, can be used to feed people, who otherwise die the following round, or planted for the following year's crop. The player may also buy or sell land to their neighbors each turn in exchange for grain. Each round begins with an adviser stating "Hamurabi: I beg to report to you" the current status of the city, including the prior year's harvest and change in population, followed by a series of questions as to how many bushels of grain to spend on land, seeds, and feeding the people.

The game's variations are driven by random numbers: the price of land is randomly decided each round from between 17 to 26 bushels per acre, the amount of bushels generated each round is randomly decided, random amounts of bushels are eaten by rats, and new people come to the city each year in random amounts. Each year also presents the possibility of a plague reducing the population by half. The game ends after ten rounds, or earlier if the entire population of the city dies or at least 45 percent of the people starve in a single round.

The end-game appraisal, added in the 1973 version of the game, compares the player to historical rulers—such as "Your heavy-handed performance smacks of Nero and Ivan IV."

The main draw of this game is that you must learn how to play it while playing it. Unless you wrote the code or have it available, so much of it is randomized that even using the code as a guide, the results are unpredictable.

King Hammurabi's was born in 1810 bc, and his reign lasted 42 years from 1792 BC til his death in 1750 BC at the age of 60. He is well known as the first ruler to codify laws for his kingdom. however, the Code of Hammurabi is not the earliest surviving law code; it is predated by the Code of Ur-Nammu, the Laws of Eshnunna, and the Code of Lipit-Ishtar. Nonetheless, the Code of Hammurabi shows marked differences from these earlier law codes and ultimately proved more influential. For more information, see: https://en.m.wikipedia.org/wiki/Hammurabi


PSALM WRITTEN IN THE WORDS OF HAMMURABI AFTER HIS DEATH:
————————————————————————————————————————————————————————
I am the king, the brace that grasps wrongdoers, that makes people of one mind,
I am the great dragon among kings, who throws their counsel in disarray,
I am the net that is stretched over the enemy,
I am the fear-inspiring, who, when lifting his fierce eyes, gives the disobedient the death sentence,
I am the great net that covers evil intent,
I am the young lion, who breaks nets and scepters,
I am the battle net that catches him who offends me,
I am Hammurabi, the king of justice.

*/



GRAPHICS
OPTION ANGLE DEGREES
OPTION BASE 1
'*** SET TOOLBAR OFF
OPTION KEYBOARD ON
GET SCREEN SIZE sw,sh

GRAPHICS CLEAR .4,.4,.4

SET ORIENTATION LANDSCAPE
GET SCREEN SIZE W,H
RANDOMIZE TIMER

dev$=DEVICE_TYPE$()
iostest=1                  '*** set to 1 to test other iOS devices on iPad
IF iostest THEN
   dev$="" 
   W=667!H=375             '*** to test iPhone 6
ENDIF

'*** Needed to provide compatability with other modules (from other programmers)
sw=W!sh=H                         '*** sw,sh is Screen Width, Height

'*** scale factor for other iOS devices
ratw=W/1024!rath=H/768!vadj=0!hadj=20!cr$=CHR$(10)
.rw=ratw!.rh=rath

IF dev$="iPad" THEN
   hm=4                    '*** horizontal margin
   vm=100                  '*** vertical margin
   heightshift=0!titleshift=0!tvshift=0!bvshift=30
ELSE
   hm=4*ratw               '*** horizontal margin
   vm=130*rath-20          '*** vertical margin
   heightshift=20!titleshift=25!tvshift=10!bvshift=10
ENDIF


REM *** For the About Box: https://en.m.wikipedia.org/wiki/Hammurabi
PRINT TAB(32);"HAMURABI"
PRINT
PRINT "You are the ruler of the ancient kingdom of Sumeria."
PRINT "Your people call you 'Hamurabi the Wise'." 
PRINT
PRINT "Your task is for the next 10 years is to develop"
PRINT "a stable economy by the wise management of your"
PRINT "resources. You will be beset from time to time"
PRINT "by natural events."
PRINT
PRINT "The only help I can give you is the fact that it"
PRINT "takes 1 bushel of grain as seed to plant two acres."
PRINT
PRINT "May you judge well, alknowing Hamurabi!"
PRINT
PRINT "***********HAMURABI IS HERE***********"
PRINT

HamurabiInit:
    STARVED=0                      '*** D=0
    PEOPLE_DIED=0                  '*** D1=0 
    PCT_STARVED=0                  '*** P1=0
    YEAR=0                         '*** Z=0
    POPULATION=95                  '*** P=95
    BUSHELS=2800                   '*** S=2800
    HARVESTED=3000                 '*** H=3000
    RATS_ATE=HARVESTED-BUSHELS     '*** E=H-S
    PESTILENCE=0                   '*** NEW FIELD
    PRICE=3                        '*** Y=3
    ACRES=HARVESTED/PRICE          '*** A=H/Y
    IMMIGRATED=5                   '*** I=5
    C=1                            '*** C=1  VARIABLE USED FOR ALL RANDOM NUMBER GENERATORS       
    
PlayGame:
    PRINT
    PRINT
    
    PRINT "HAMURABI, I beg to report to you"!
    PRINT
    YEAR=YEAR+1 
    PRINT "In year "&YEAR&", "&STARVED&" People starved, "&IMMIGRATED&" Came into the city."
    POPULATION=POPULATION+IMMIGRATED

CheckForPlague:
'*** check for plague and if found, reduce population by 1/2. (15% chance of plague) 
'    PI=INT(10*(2*RND(1)-.3))    REM *** Random generator for TechBASIC
    PI=RND(100)*.10
'***    PRINT "(DEBUG): PLAGUE INDICATOR ="&"##.##":PI
    PRINT 
    IF PI>=8.5 AND YEAR>1 THEN
       PLAGUE=INT(POPULATION/2)!POPULATION=PLAGUE
       PRINT "A horrible plague struck! Half the people died."
       PRINT "Half ("&PLAGUE&") died of the plague."
    END IF    

Display_Population:
    PRINT "Our Population is now "&POPULATION
    PRINT "The city owns "&ACRES&" acres, "
    PRINT "You havested "&PRICE&" bushels per acre"
    PRINT "Rats destroyed "&RATS_ATE&" bushels. "
    PRINT "You have "&BUSHELS&" bushels in storage."    
    PRINT
    IF YEAR=11 THEN GOTO PlayEvaluation
    C=INT(10*RND(1))
    PRICE=C+17
    PRINT "Land is trading at ";PRICE;" bushels per acre."

BuyLand:
    INPUT "How much land (in acres) do you wish to buy? ":ACRES_BUY
    PRINT "How much land (in acres) do you wish to buy? ";ACRES_BUY
    IF ACRES_BUY<0 THEN GOTO FedUp
    IF PRICE*ACRES_BUY<=BUSHELS THEN
       IF ACRES_BUY=0 THEN GOTO SellLand
       ACRES=ACRES+ACRES_BUY
       BUSHELS=BUSHELS-PRICE*ACRES_BUY
       C=0
       PRINT
       GOTO FeedPopulation
    END IF   
    GOSUB NotEnoughGrain
    GOTO BuyLand

SellLand:
    INPUT "How many acres of land do you wish to sell? ":ACRES_SELL
    PRINT "How many acres of land do you wish to sell? ";ACRES_SELL
    IF ACRES_SELL<0 THEN GOTO FedUp
    IF ACRES_SELL<ACRES THEN 
       ACRES=ACRES-ACRES_SELL
       BUSHELS=BUSHELS+PRICE*ACRES_SELL
       C=0
       GOTO FeedPopulation
    END IF   
    GOSUB NotEnoughAcres
    GOTO SellLand

FeedPopulation:
    INPUT "How many bushels do you wish to set aside for food? ":BUSHELS_FEED
    PRINT "How many bushels do you wish to set aside for food? ";BUSHELS_FEED
    IF BUSHELS_FEED<0 THEN GOTO FedUp
    IF BUSHELS_FEED=0 THEN
       GOSUB NotEnoughGrain
       GOTO FeedPopulation
    END IF   
REM *** TRYING TO USE MORE GRAIN THAN IS IN SILOS?
    IF BUSHELS_FEED<=BUSHELS THEN
       BUSHELS=BUSHELS-BUSHELS_FEED
       C=1
       PRINT
       GOTO AcresToPlant
    END IF
    GOSUB NotEnoughGrain
    GOTO FeedPopulation

AcresToPlant:
    INPUT "How many acres do you wish to plant? ":ACRES_PLANTED
    PRINT "How many acres do you wish to plant? ";ACRES_PLANTED
    
REM *** TRYING TO PLANT MORE ACRES THAN YOU OWN?
    IF ACRES_PLANTED=0 THEN GOTO HarvestCrops
    IF ACRES_PLANTED<0 THEN GOTO FedUp
    
REM *** ENOUGH GRAIN FOR SEED (TWO BUSHELS PER ACRE)?
    IF ACRES_PLANTED<=ACRES THEN
       IF INT(ACRES_PLANTED/2)<=BUSHELS THEN
       
REM *** ENOUGH PEOPLE TO TEND THE CROPS?       
          IF ACRES_PLANTED<10*POPULATION THEN 
             BUSHELS=BUSHELS-INT(ACRES_PLANTED/2)
             GOTO HarvestCrops
          ELSE   
             PRINT "But you only have ";POPULATION;" people to tend the fields!, Now then, "
             GOTO AcresToPlant
          END IF   
       ELSE
          GOSUB NotEnoughGrain
          GOTO AcresToPlant
       END IF   
    END IF
    GOSUB NotEnoughAcres
    GOTO AcresToPlant

HarvestCrops:
REM *** A BOUNTIFUL HARVEST!
    GOSUB Randomizer
    PRICE=C
    HARVESTED=ACRES_PLANTED*PRICE
    RATS_ATE=0
    GOSUB Randomizer
    IF INT(C/2)<>C/2 THEN GOTO PopulationControl
    
REM *** RATS ARE RUNNING WILD!!
    RATS_ATE=INT(BUSHELS/C)

PopulationControl:
    BUSHELS=BUSHELS-RATS_ATE+HARVESTED
    GOSUB Randomizer
REM *** LET'S HAVE SOME BABIES
    IMMIGRATED=INT(C*(20*ACRES+BUSHELS)/POPULATION/100+1)
REM *** HOW MANY PEOPLE HAD FULL TUMMIES?
    C=INT(BUSHELS_FEED/20)
REM *** HORROS, A 15% CHANCE OF PLAGUE
'    PI=INT(10*(2*RND(1)-.3))
    PI=RND(10)
    IF POPULATION<C THEN
       STARVED=0
       GOTO PlayGame
    END IF
REM *** STARVED ENOUGH FOR IMPEACHMENT?
    STARVED=POPULATION-C
    IF STARVED>.45*POPULATION THEN GOTO StarvedMSG
    PCT_STARVED=((YEAR-1)*PCT_STARVED+STARVED*100/POPULATION)/YEAR
    POPULATION=C
    PEOPLE_DIED=PEOPLE_DIED+STARVED       '*** D1=D1+D
    GOTO PlayGame

StarvedMSG:
    PRINT
    PRINT "You starved "&STARVED&" people in this year!!!"

ExtremeMismangement:
    PRINT "Due to extreme mismanagement you have been impeached and thrown out of office." 
    PRINT "You have failed to honor your promise or lacked courage or commitment."
    PRINT "The people have declared you a National Fink!!!!" 
    GOTO endProg

NotEnoughGrain:
    PRINT " HAMURABI: Think again. You have only"
    PRINT BUSHELS&" bushels of grain. Now then,"
    RETURN

NotEnoughAcres:
    PRINT "HAMURABI: Think again. You own only "&ACRES&" acres. Now Then,"
    RETURN

Randomizer:
    C=INT(RND(1)*5)+1
    RETURN

FedUp:
    PRINT
    PRINT "HAMURABI: I cannot do what you wish."
    PRINT "Get yourself another steward!!!!!"
    GOTO endProg

PlayEvaluation:    
    PRINT "In your 10-year term of office,"&"##.##":PCT_STARVED;
    PRINT " percent of the"
    PRINT "population starved per year on average, i.e. a total of"
    PRINT PEOPLE_DIED&" people died!!"
    PRINT

DeterminePlay:    
    LAND_PER_PERSON=ACRES/POPULATION
    PRINT "You started with 10 acres per person and ended with"
    PRINT LAND_PER_PERSON&" arces per person."
    PRINT
    IF PCT_STARVED>33      THEN GOTO ExtremeMismangement
    IF LAND_PER_PERSON<7   THEN GOTO ExtremeMismangement
    IF PCT_STARVED>10      THEN GOTO HeavyHanded
    IF LAND_PER_PERSON<9   THEN GOTO HeavyHanded
    IF PCT_STARVED>3       THEN GOTO MediocurePlay
    IF LAND_PER_PERSON<10  THEN GOTO MediocurePlay
    PRINT "A fantastic performance! Charlemange, Disraeli, and"
    PRINT "Jefferson combined could not have done better!"
    GOTO endProg

HeavyHanded:
    PRINT "Your heavy-handed performance smacks of Nero and Ivan IV."
    PRINT "The remaining people find you an unpleasant ruler, and,"
    PRINT "frankly, hate your guts!!"
    GOTO endProg

MediocurePlay:
    PRINT "Your performance could have been somewhat better, but"
    PRINT "really wasn't too bad at all. "&INT(POPULATION*.8*RND(1))&" people"
    PRINT "would dearly like to see you assassinated but we all have our"
    PRINT "trivial problems."

endProg:
    PRINT
    FOR N=1 TO 10
       PRINT CHR$(7);
    NEXT N
    PRINT "So long, for now."
    PRINT
    END
George McGinn
Computer Scientist/Cosmologist/Writer/Photographer
Member: IEEE, IEEE Computer Society
IEEE Sensors Council & IoT Technical Community
American Association for the Advancement of Science (AAAS)

Henko
Posts: 814
Joined: Tue Apr 09, 2013 12:23 pm
My devices: iPhone,iPad
Windows
Location: Groningen, Netherlands
Flag: Netherlands

Re: Old school Hamurabi

Post by Henko »

Hi George,
I noticed your playable version of Hamurabi not earlier than today and gave it a try immediately.
There may be some logic problems in the code, or i must be a stupid Hamurabi player. Anyhow, i cannot survive the first year.

Here's what happened:
After entering zeros for buying and selling land, and 300 bushels for food, the question is "how much acres to plant?"
Entering 1000 is answered by " you only have 100 people"
Any other answer under 1000 leads to massive starvation and impeachment.

Another strange thing: if you try to feed the people with 0 bushels, the reaction is "you only have 2800 bushels". Entering 1 bushel gives the correct reaction: massive starvation etc.

Do i overlook someting?

User avatar
GeorgeMcGinn
Posts: 435
Joined: Sat Sep 10, 2016 6:37 am
My devices: IPad Pro 10.5in
IMac
Linux i386
Windows 7 & 10
Location: Venice, FL
Flag: United States of America
Contact:

Re: Old school Hamurabi

Post by GeorgeMcGinn »

EDITED: 7:05pm local time

When the game was originally written, the article stated you had to learn to play the game by playing it.

I'll provide you one hint. You need 20 bushels per person to feed them. So for 100 people, you need 2000 bushels (100 * 20). In the second year, if you get 19 more people, you have 119 and now need 2380 bushels to feed them (119*20), and so on.

Also, take advantage of low priced land. Part of the score rates you on having at least 10 acres of land per person.

Rest you need to figure out yourself. But the randomness of the game (such as harvests) is from all the original versions.

George

UPDATE: like the original game, it does not let you plant 1000 acres with 1000. That is it bug in the original game as well. Try 1000-1, or plant 999 acres. You'll live longer. I do it know if that was intentional on the game developers part, or a bug David Ahl introduced.

Henko wrote:
Sun Feb 17, 2019 8:04 am
Hi George,
I noticed your playable version of Hamurabi not earlier than today and gave it a try immediately.
There may be some logic problems in the code, or i must be a stupid Hamurabi player. Anyhow, i cannot survive the first year.

Here's what happened:
After entering zeros for buying and selling land, and 300 bushels for food, the question is "how much acres to plant?"
Entering 1000 is answered by " you only have 100 people"
Any other answer under 1000 leads to massive starvation and impeachment.

Another strange thing: if you try to feed the people with 0 bushels, the reaction is "you only have 2800 bushels". Entering 1 bushel gives the correct reaction: massive starvation etc.

Do i overlook someting?
George McGinn
Computer Scientist/Cosmologist/Writer/Photographer
Member: IEEE, IEEE Computer Society
IEEE Sensors Council & IoT Technical Community
American Association for the Advancement of Science (AAAS)

Post Reply