C---- PROGRAM ID  29/10/80
     COMPILER(1)=100H
     COMPILER(3)=26FFH


     SUBROUTINE RANDOM(SEED)

C---- ROUTINE TO RETURN A 16-BIT RANDOM NUMBER GIVEN
C     A SEED. USES THE ADDITIVE CONGRUENTIAL METHOD.

     INTEGER*2 SEED

C---- NEW NUMBER IS GENERATED FROM THE FORMULA:-
C     NEW=SEED*(2**11+2**2+1)+33031Q
C
C---- THE ACTUAL CODE IS:-
C     LHLD SEED ; MOV  C,L  ; MOV  B,H  ; MOV  H,L  ;
C     MVI  L,0  ; DAD  H    ; DAD  B    ; DAD  H    ;
C     DAD  H    ; DAD  B    ; LXI B,33031Q
C     DAD  B    ; SHLD SEED ;

     INLINE/2AH,ADDRESS(SEED),4DH,44H,65H,2EH,00H/
     INLINE/29H,09H,29H,29H,09H,01H,19H,36H/
     INLINE/09H,22H,ADDRESS(SEED)/

     RETURN
     END

     INTEGER*2 FUNCTION RAND0
     INTEGER*2 ISEED
100   CALL RANDOM(ISEED)
     RAND0=ISEED.AND.0FFFH
     RETURN
     END

     INTEGER*2 FUNCTION MOD(I,J)
     INTEGER*2 I,J
     MOD=I-I/J*J
     RETURN
     END

     REAL*8 FUNCTION AMOD(A,B)
     REAL*8 A,B,C
     C=A
200   IF(C.LT.B)GO TO 100
     C=C-B
     GO TO 200
100   AMOD=C
     RETURN
     END

     INTEGER*1 KMERC,NX,IWA
     INTEGER*1 INAME(16)


1     WRITE(1,1001)
1001  FORMAT(//' THIS IS THE KINGDOM OF ID'/
    1 ' YOU HAVE BEEN CALLED BEFORE THE KING!'//
    2 ' WHAT IS YOUR NAME?....')
     READ(1)STRING(INAME,16)
     ICN=INAME(1)+INAME(2)+INAME(3)
     DO 999 I = 1,ICN
999   J=RAND0

C---- CONSTANTS USED IN THIS PROGRAM.

     LAZY=0
     NOFEED=0
     IAFFC=100
     IWARN=0
     IWA=.FALSE.
     IWMAX=25
     IWLIM=20
     MERC=0
     IMERC=80
     IBTHS=0
     IDTHS=0
     PLANT=0.0
     YIELD=5.0
     WHEAT=5.001
     IPUT=9
     NBTHS=7
     NDTHS=14
     JMERC=11
     LMERC=5
     AMERC=0.3
     KMERC=.FALSE.
     PLAGE=0.7
     RRATE=60.0
     REATR=0.06
     WEEVILS=0.4
     RANRATE=0.13
     STARVE=20.0
     NSTRV=0
     IPPLG=0
     WEAT=0.0
     IREAT=0
     ACRAT=7.0
     ACBUY=7.0
     PLSTK=0.7
     NMIN=21
     IYR=1
     GRAIN=5000.1
     ACRES=1500.1
     IPOP=100

C---- START OF PASS.
C---- DOES THE VICTIM DESERVE TO CONTINUE?

2       IF(IWARN-IWMAX)22,22,510

C---- GIVE ALL THE YEAR'S INPUT PARAMETERS.
22    FLOAT=IPOP
     IAFFL=(ACRES+GRAIN/25.0)/17.0*100.0/FLOAT
     IAFFC=IAFFL-IAFFC
     WRITE(1,115)(INAME(I),I=1,16),IYR,IAFFL,IAFFC
115     FORMAT(//2X,16A1/' YEAR',I4,'    AFFLUENCE RATIO',
    1  I5,'%    CHANGE',I5,'%')
     IAFFC=IAFFL

C---- MAYBE THE USER NEEDS A WARNING.

     IF(IWA)GO TO 51
     IF(IWARN-IWLIM)51,52,52
52      IWA=.TRUE.
     WRITE(1,1002)
1002  FORMAT(' YOUR MANAGEMENT DISPLEASES THE KING.'/
    1 ' YOU WILL BE IN BIG TROUBLE IF YOU DO NOT IMPROVE.')
51      IF(MERC)53,31,53
53      IPOPA=IBTHS*3/2
     IBTHS=IBTHS+IPOPA
     IPOP=IPOP+IPOPA
     WRITE(1,1003)
1003  FORMAT(' THE MERCENARIES YOU HIRED RAPED THE WOMEN,'/
    1 ' RESULTING IN AN ABNORMALLY HIGH BIRTH RATE.')
31      ICN=ACRES
     WRITE(1,101)IPOP,ICN,GRAIN
101     FORMAT(' THE KINGDOM HAS',I5,' PEASANTS',I6,' ACRES AND',
    1  F8.0,' BUSHELLS.')
     IF(IYR-1)57,54,57
54      WRITE(1,123)
123     FORMAT(' YOU ARE HEREBY COMMANDED BY HIS MAJESTY,',
    1 ' THE FINK, TO'/
    2  ' IMPROVE THE KINGDOMS ASSETS.'/
    3 ' GOOD LUCK (YOU WILL NEED IT) AND GOOD MANAGEMENT!'//)
57      IF(IYR-1)58,59,58
58      WRITE(1,122)IBTHS,IDTHS
122     FORMAT(' THERE WERE',I4,' BIRTHS &',I4,' NATURAL DEATHS.')
59      IF(NSTRV)61,61,60
60      WRITE(1,116)NSTRV
116     FORMAT(' STARVATION KILLED',I5,' PEASANTS.')
61      IF(IREAT)63,63,62
62      WRITE(1,114)IREAT
114     FORMAT(' THE RATS ATE',I5,' BUSHELLS.')
63      IF(WEAT)66,66,64
64      WRITE(1,111)WEAT
111     FORMAT(' THE WEEVILS RUINED',F7.0,' BUSHELLS.')
66      IF(IPPLG)68,68,67
67      WRITE(1,113)IPPLG
113     FORMAT(' THE PLAGUE & THE POX STRUCK',I4,' PEASANTS.')
68      IF(.NOT.KMERC)GO TO 26
     WRITE(1,1004)
1004  FORMAT(' THE HUNS LOOTED & PLUNDERED BECAUSE'/
    1 ' YOU DID NOT HIRE ENOUGH MERCENARIES!')
26      IF(PLANT-1.0)261,69,69
69      IF(YIELD-2.0)70,71,71
70      WRITE(1,1005)
1005  FORMAT(' A FAMINE HAS STRUCK! ')
71      WRITE(1,105)YIELD
105     FORMAT(' THE HARVEST YIELD WAS',F4.1,' BUSHELLS/ACRE.')

C---- SET UP PASS PARAMETERS.

261     NSTRV=0
     MERC=0
     KMERC=.FALSE.
     NX=.FALSE.
     BUSH=1.0E6
     WEAT=0.0
     IREAT=0
     IPPLG=0

C---- COMPUTE INITIAL BUY AND SELL RATES.

     NBUY=NMIN+MOD(RAND0,9)
     NSELL=NBUY-1

C---- DOES THE FELLA WANNA BUY?

3       WRITE(1,125)NBUY
125     FORMAT(' HOW MANY ACRES DO YOU WISH TO ',
    1 'BUY AT',I3,' BUSHELLS/ACRE? ')
     READ(1,ERR=3)ICN
     CRES=ICN
     IF(CRES)3,4,5
5     FLOAT=NBUY
     IF(FLOAT*CRES-GRAIN)55,55,72
72      IWARN=IWARN+1
     WRITE(1,104)
104     FORMAT(' THERE IS NOT ENOUGH GRAIN!')
     GO TO 3
55      IF(ACRES-ACBUY*CRES)73,73,56
73      IF(NX)GO TO 56

C---- HE TRIED TO BUY TOO MUCH. UP HIS PRICE.

     WRITE(1,1006)
1006  FORMAT(' SPECULATION INCREASES THE LAND PRICE!')
     IWARN=IWARN+1
     NBUY=NBUY+1
     NX=.TRUE.
     GO TO 3
56      ACRES=ACRES+CRES
     FLOAT=NBUY
     GRAIN=GRAIN-FLOAT*CRES
     GO TO 65

C---- DOES HE WANNA SELL?

4      WRITE(1,118)NSELL
118     FORMAT(' HOW MANY ACRES DO YOU WISH TO SELL AT',
    2 I3,' BUSHELLS/ACRE? ')
     READ(1,ERR=4)ICN
     CRES=ICN
     IF(ICN)4,65,7
7       IF(ACRES-ACRAT*CRES)74,74,8
74      IF(NX)GO TO 8

C---- THIS IS WHAT HAPPENS IF YOU TRY TO SELL TOO MUCH.

     NX=.TRUE.
     IWARN=IWARN+1
     WRITE(1,1007)
1007  FORMAT(' EXCESSIVE SELLING OF LAND LOWERS THE PRICE!')
     NSELL=NSELL-2
     GO TO 4
8       IF(CRES-ACRES)88,88,75
75      IWARN=IWARN+1
     WRITE(1,106)
106     FORMAT(' THE KINGDOM IS NOT THAT BIG!')
     GO TO 4
88      ACRES=ACRES-CRES
     FLOAT=NSELL
     GRAIN=GRAIN+FLOAT*CRES
65      NPLN=(RAND0/7).AND.3

C---- SEND THE PEASANTS TO WORK PLANTING THE FIELDS.

6     WRITE(1,1008)
1008  FORMAT(' HOW MANY ACRES DO YOU WISH TO PLANT? ')
     READ(1,ERR=6)ICN
     PLANT=ICN
     IF(ICN)6,212,616
616     IF(PLANT-ACRES)10,10,76
76      IWARN=IWARN+1
     WRITE(1,106)
     GO TO 6
10      IF(PLANT-GRAIN)11,77,77
77      IWARN=IWARN+1
     WRITE(1,104)
     GO TO 6
11      IF(ICN-IPOP*(IPUT+NPLN))112,78,78

C---- THEY CAN ONLY DO SO MUCH WORK!

78      WRITE(1,1009)
1009  FORMAT(' THAT IS OVERWORKING THE PEASANTS.')
     IWARN=IWARN+1
     GO TO 6
112     GRAIN=GRAIN-PLANT
     IF(LAZY-4)212,79,79
79      LAZY=0

C---- LAZINESS CAN REDUCE THE AMOUNT SOWN.

     PLANT=PLANT*PLSTK
     ICN=PLANT
     WRITE(1,119)ICN
119     FORMAT(' THE LAZY PEASANTS ONLY PLANTED',I5,' ACRES.')
212     IF(RAND0-31000)12,211,211

C---- SOMETIMES THE FIELDS NEED A BOOST. NOT ENOUGH WILL BE BAD.

211     IFERT=(RAND0.AND.3)+1
221   WRITE(1,120)IFERT
120     FORMAT(' HOW MANY BAGS OF FERTILIZER WILL WE BUY AT',I2,
    1  ' BUSHELLS EACH? ')
     READ(1,ERR=221)ICN
     BUSH=ICN*IFERT
     IF(BUSH-GRAIN)311,80,80
80      IWARN=IWARN+1
     WRITE(1,104)
     GO TO 211
311     GRAIN=GRAIN-BUSH

C---- FINALLY, THE PEASANTS MUST BE FED.

12      WRITE(1,1010)
1010  FORMAT(' HOW MANY BUSHELLS DO YOU WISH TO USE AS FOOD? ')
     READ(1,ERR=12)ICN
     GIVEN=ICN
     IF(ICN)12,13,13
13      IF(GIVEN-GRAIN)14,14,81
81      IWARN=IWARN+1
     WRITE(1,104)
     WRITE(1,1011)
1011  FORMAT(' THEY HAVE BEEN GIVEN ALL THAT REMAINS.')
     GIVEN=GRAIN
14      GRAIN=GRAIN-GIVEN
     FLOAT=RAND0.AND.0FFH
     USER=37.5+AMOD(FLOAT,3.0)
     IPOPA=GIVEN/USER
     IF(IPOPA-IPOP-3)83,83,82
82      LAZY=LAZY+1
83    IF(IAFFC-110)15,84,84
84      IF(RAND0-26000)15,85,85

C---- OCCASIONALLY THE HUNS ATTACK OUR LITTLE PARADISE.
C---- (ONLY IF IT IS WORTH WHILE.)

85      WRITE(1,1012)
1012  FORMAT(' THE HUNS THREATEN THE KINGDOM!!!')
     ICN=IMERC+MOD(NO.AND.0FFFH,7)
17      WRITE(1,121)ICN
121     FORMAT(' HOW MANY MERCENARIES WILL WE HIRE AT',I3,
    1  ' BUSHELLS EACH? ')
     READ(1,ERR=17)MERC
     FLOAT=MERC*ICN
     IF(FLOAT-GRAIN)16,16,86
86      IWARN=IWARN+1
     WRITE(1,104)
     GO TO 17
16      GRAIN=GRAIN-FLOAT
     IF(IPOP-MERC*JMERC)15,87,87

C---- NOT ENOUGH MERCENARIES MEANS LOOT & PLUNDER.

87      IWARN=IWARN+1
     KMERC=.TRUE.
     GRAIN=GRAIN*AMERC
     IPOP=IPOP/LMERC+2

C---- FIND OUT WHAT THIS YEAR'S YIELD WILL BE.

15    FLOAT=MOD(RAND0/7,4)
     YIELD=WHEAT+FLOAT

C---- A FAMINE CAN STRIKE ONCE EVERY 15 YEARS.

     IF(IYR-5)151,89,89
89      IF(RAND0-30000)151,151,90
90      YIELD=1.00001

C---- OR WE MAY NOT HAVE ADEQUATELY FERTILIZED.

151     IF(BUSH-PLANT/5.0)91,92,92
91      YIELD=YIELD/2.0
92      GRAIN=GRAIN+YIELD*PLANT

C---- HATCHED AND DISPATCHED SECTION.


C---- BIRTHS AND NATURAL DEATHS ARE RELATED TO THE AMOUNT
C---- OF GRAIN/PEASANT PROVIDED. STARVATION MAY KNOCK OUT
C---- MORE IF THERE IS INADEQUATE GRAIN.

     IBTHS=IPOPA/(NBTHS+(RAND0.AND.7))+2
     IDTHS=IPOPA/(NDTHS+(RAND0.AND.3))
     NSTRV=IPOP-IPOPA
     IF(NSTRV.LT.0)NSTRV=0
     IF(NSTRV)19,19,93
93      NOFEED=NOFEED+1
     IWARN=IWARN+1
     FLOAT=IPOP
     GLOAT=NSTRV
     IF(FLOAT-STARVE*GLOAT)94,95,95
94      IWARN=IWARN+4
95      IPOP=IPOPA
19      IYR=IYR+1
     IPOP=IPOP+IBTHS-IDTHS

C---- THE PLAGUE & THE POX WREAK HAVOC ON THE POPULATION.

     IF(RAND0-31000)20,96,96
96      IF(IPOP-25)20,97,97
97    FLOAT=IPOP
     IPPLG=FLOAT*PLAGE
     IPOP=IPOP-IPPLG
20      IF(RAND0-29000)21,98,98

C---- WHEN THE WEEVILS STRIKE, THEY REALLY STRIKE!

98      WEAT=GRAIN*WEEVILS
     GRAIN=GRAIN-WEAT
21    FLOAT=IPOP
     IF(GRAIN/FLOAT-RRATE)23,99,99
99      IF(RAND0-27000)23,40,40

C---- TOO MUCH SPARE GRAIN. THE RATS GOT IN.
C---- TOO BAD ABOUT THAT.

40    REAT=GRAIN*REATR
     IF(REAT.GT.32700.0)REAT=32700.0
     GRAIN=GRAIN-REAT
     IREAT=REAT
23      IF(RAND0-31000)32,41,41

C---- A CRISIS HITS THE PEOPLE! THE KING IS KIDNAPPED.

41      WRITE(1,1013)
1013  FORMAT(' THE KING HAS BEEN KIDNAPPED!')
39      WRITE(1,1014)
1014  FORMAT(' HOW MANY BUSHELLS RANSOM WILL WE PAY?  ')
     READ(1,ERR=39)ICN
     RANSOM=ICN
     IF(RANSOM-GRAIN)38,38,42
42      IWARN=IWARN+1
     WRITE(1,104)
     GO TO 39
38      IF(RANSOM-GRAIN*RANRATE)43,43,24

C---- NOT ENOUGH. SLIT HIS THROAT!

43      WRITE(1,1015)
1015  FORMAT(' IT WAS NOT ENOUGH. THE KING IS NO MORE.')
     GO TO 1
24      WRITE(1,1016)
1016  FORMAT(' THE KING HAS BEEN RELEASED.')
     GRAIN=GRAIN-RANSOM
32      IF(NOFEED-4)2,44,44

C---- AN UPRISING MUST BE AVERTED. MORE FOOD IS THE WAY.

44      WRITE(1,1017)
1017  FORMAT(' THE PEASANTS ARE THREATENING TO REVOLT IF YOU DONT'/
    1 ' GIVE THEM MORE FOOD. HOW MUCH WILL YOU GIVE THEM? ')
35      READ(1,ERR=44)ICN
     GRNT=ICN
     NOFEED=0
     FLOAT=IPOP*MOD(RAND0,5)
     IF(GRNT-FLOAT)33,45,45
45      IF(GRNT-GRAIN)34,34,46
46      IWARN=IWARN+1
     WRITE(1,104)
     WRITE(1,1018)
1018  FORMAT(' HOW MUCH MORE WILL YOU GIVE THE PEASANTS? ')
     GO TO 35

C---- THE RESULTS DEPEND ON THE MANAGER'S GENEROSITY.

34      WRITE(1,1019)
1019  FORMAT(' THEY ACCEPTED YOUR OFFER.')
     GRAIN=GRAIN-GRNT
     GO TO 2
33      WRITE(1,1020)
1020  FORMAT(' YOUR MEASLY OFFER ANGERED THE PEASANTS,'/
    1 ' SO THEY RAIDED THE GRAIN STORES.')
     IWARN=IWARN+1
     GRAIN=GRAIN/2.0
     GO TO 2

C---- HERE ENDS ALL VICTIMS EVENTUALLY.

510      WRITE(1,1021)(INAME(I),I=1,16)
1021  FORMAT(/1X,16A1/' YOUR MANAGEMENT WAS LOUSY.'/)
     IWARN=(RAND0.AND.3)+1
     GO TO (511,512,513,514),IWARN
511     WRITE(1,1022)
1022  FORMAT(' YOU HAVE FLED THE COUNTRY .')
     GO TO 1030
512     WRITE(1,1023)
1023  FORMAT(' YOU HAVE BEEN HUNG!')
     GO TO 1030
513     WRITE(1,1024)
1024  FORMAT(' YOU TOO ARE NOW A PEASANT.')
     GO TO 1030
514     WRITE(1,1025)
1025  FORMAT(' YOU NOW RESIDE IN THE DUNGEONS.')
     GO TO 1030
1030  WRITE(1,1031)
1031  FORMAT(///' ANOTHER SUCKER FOR THE FINK(YES OR NO)?....')
     READ(1)STRING(INAME,1)
     IF(INAME(1).EQ.'Y')GO TO 1
     STOP
     END

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.