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