home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol075 / id.frt < prev    next >
Encoding:
Text File  |  1984-04-29  |  12.1 KB  |  487 lines
  1. C---- PROGRAM ID  29/10/80
  2.       COMPILER(1)=100H
  3.       COMPILER(3)=26FFH
  4.  
  5.  
  6.       SUBROUTINE RANDOM(SEED)
  7.  
  8. C---- ROUTINE TO RETURN A 16-BIT RANDOM NUMBER GIVEN
  9. C     A SEED. USES THE ADDITIVE CONGRUENTIAL METHOD.
  10.  
  11.       INTEGER*2 SEED
  12.  
  13. C---- NEW NUMBER IS GENERATED FROM THE FORMULA:-
  14. C     NEW=SEED*(2**11+2**2+1)+33031Q
  15. C
  16. C---- THE ACTUAL CODE IS:-
  17. C     LHLD SEED ; MOV  C,L  ; MOV  B,H  ; MOV  H,L  ;
  18. C     MVI  L,0  ; DAD  H    ; DAD  B    ; DAD  H    ;
  19. C     DAD  H    ; DAD  B    ; LXI B,33031Q 
  20. C     DAD  B    ; SHLD SEED ;
  21.  
  22.       INLINE/2AH,ADDRESS(SEED),4DH,44H,65H,2EH,00H/
  23.       INLINE/29H,09H,29H,29H,09H,01H,19H,36H/
  24.       INLINE/09H,22H,ADDRESS(SEED)/
  25.  
  26.       RETURN
  27.       END
  28.  
  29.       INTEGER*2 FUNCTION RAND0
  30.       INTEGER*2 ISEED
  31. 100   CALL RANDOM(ISEED)
  32.       RAND0=ISEED.AND.0FFFH
  33.       RETURN
  34.       END
  35.  
  36.       INTEGER*2 FUNCTION MOD(I,J)
  37.       INTEGER*2 I,J
  38.       MOD=I-I/J*J
  39.       RETURN
  40.       END
  41.  
  42.       REAL*8 FUNCTION AMOD(A,B)
  43.       REAL*8 A,B,C
  44.       C=A
  45. 200   IF(C.LT.B)GO TO 100
  46.       C=C-B
  47.       GO TO 200
  48. 100   AMOD=C
  49.       RETURN
  50.       END
  51.  
  52.       INTEGER*1 KMERC,NX,IWA
  53.       INTEGER*1 INAME(16)
  54.  
  55.  
  56. 1     WRITE(1,1001)
  57. 1001  FORMAT(//' THIS IS THE KINGDOM OF ID'/
  58.      1 ' YOU HAVE BEEN CALLED BEFORE THE KING!'//
  59.      2 ' WHAT IS YOUR NAME?....')
  60.       READ(1)STRING(INAME,16)
  61.       ICN=INAME(1)+INAME(2)+INAME(3)
  62.       DO 999 I = 1,ICN
  63. 999   J=RAND0
  64.  
  65. C---- CONSTANTS USED IN THIS PROGRAM.
  66.  
  67.       LAZY=0
  68.       NOFEED=0
  69.       IAFFC=100
  70.       IWARN=0
  71.       IWA=.FALSE.
  72.       IWMAX=25
  73.       IWLIM=20
  74.       MERC=0
  75.       IMERC=80
  76.       IBTHS=0
  77.       IDTHS=0
  78.       PLANT=0.0
  79.       YIELD=5.0
  80.       WHEAT=5.001
  81.       IPUT=9
  82.       NBTHS=7
  83.       NDTHS=14
  84.       JMERC=11
  85.       LMERC=5
  86.       AMERC=0.3
  87.       KMERC=.FALSE.
  88.       PLAGE=0.7
  89.       RRATE=60.0
  90.       REATR=0.06
  91.       WEEVILS=0.4
  92.       RANRATE=0.13
  93.       STARVE=20.0
  94.       NSTRV=0
  95.       IPPLG=0
  96.       WEAT=0.0
  97.       IREAT=0
  98.       ACRAT=7.0
  99.       ACBUY=7.0
  100.       PLSTK=0.7
  101.       NMIN=21
  102.       IYR=1
  103.       GRAIN=5000.1
  104.       ACRES=1500.1
  105.       IPOP=100
  106.  
  107. C---- START OF PASS.
  108. C---- DOES THE VICTIM DESERVE TO CONTINUE?
  109.  
  110. 2       IF(IWARN-IWMAX)22,22,510
  111.  
  112. C---- GIVE ALL THE YEAR'S INPUT PARAMETERS.
  113. 22    FLOAT=IPOP
  114.       IAFFL=(ACRES+GRAIN/25.0)/17.0*100.0/FLOAT
  115.       IAFFC=IAFFL-IAFFC
  116.       WRITE(1,115)(INAME(I),I=1,16),IYR,IAFFL,IAFFC
  117. 115     FORMAT(//2X,16A1/' YEAR',I4,'    AFFLUENCE RATIO',
  118.      1  I5,'%    CHANGE',I5,'%')
  119.       IAFFC=IAFFL
  120.  
  121. C---- MAYBE THE USER NEEDS A WARNING.
  122.  
  123.       IF(IWA)GO TO 51
  124.       IF(IWARN-IWLIM)51,52,52
  125. 52      IWA=.TRUE.
  126.       WRITE(1,1002)
  127. 1002  FORMAT(' YOUR MANAGEMENT DISPLEASES THE KING.'/
  128.      1 ' YOU WILL BE IN BIG TROUBLE IF YOU DO NOT IMPROVE.')
  129. 51      IF(MERC)53,31,53
  130. 53      IPOPA=IBTHS*3/2
  131.       IBTHS=IBTHS+IPOPA
  132.       IPOP=IPOP+IPOPA
  133.       WRITE(1,1003)
  134. 1003  FORMAT(' THE MERCENARIES YOU HIRED RAPED THE WOMEN,'/
  135.      1 ' RESULTING IN AN ABNORMALLY HIGH BIRTH RATE.')
  136. 31      ICN=ACRES
  137.       WRITE(1,101)IPOP,ICN,GRAIN
  138. 101     FORMAT(' THE KINGDOM HAS',I5,' PEASANTS',I6,' ACRES AND',
  139.      1  F8.0,' BUSHELLS.')
  140.       IF(IYR-1)57,54,57
  141. 54      WRITE(1,123)
  142. 123     FORMAT(' YOU ARE HEREBY COMMANDED BY HIS MAJESTY,',
  143.      1 ' THE FINK, TO'/
  144.      2  ' IMPROVE THE KINGDOMS ASSETS.'/
  145.      3 ' GOOD LUCK (YOU WILL NEED IT) AND GOOD MANAGEMENT!'//)
  146. 57      IF(IYR-1)58,59,58
  147. 58      WRITE(1,122)IBTHS,IDTHS
  148. 122     FORMAT(' THERE WERE',I4,' BIRTHS &',I4,' NATURAL DEATHS.')
  149. 59      IF(NSTRV)61,61,60
  150. 60      WRITE(1,116)NSTRV
  151. 116     FORMAT(' STARVATION KILLED',I5,' PEASANTS.')
  152. 61      IF(IREAT)63,63,62
  153. 62      WRITE(1,114)IREAT
  154. 114     FORMAT(' THE RATS ATE',I5,' BUSHELLS.')
  155. 63      IF(WEAT)66,66,64
  156. 64      WRITE(1,111)WEAT
  157. 111     FORMAT(' THE WEEVILS RUINED',F7.0,' BUSHELLS.')
  158. 66      IF(IPPLG)68,68,67
  159. 67      WRITE(1,113)IPPLG
  160. 113     FORMAT(' THE PLAGUE & THE POX STRUCK',I4,' PEASANTS.')
  161. 68      IF(.NOT.KMERC)GO TO 26
  162.       WRITE(1,1004)
  163. 1004  FORMAT(' THE HUNS LOOTED & PLUNDERED BECAUSE'/
  164.      1 ' YOU DID NOT HIRE ENOUGH MERCENARIES!')
  165. 26      IF(PLANT-1.0)261,69,69
  166. 69      IF(YIELD-2.0)70,71,71
  167. 70      WRITE(1,1005)
  168. 1005  FORMAT(' A FAMINE HAS STRUCK! ')
  169. 71      WRITE(1,105)YIELD
  170. 105     FORMAT(' THE HARVEST YIELD WAS',F4.1,' BUSHELLS/ACRE.')
  171.  
  172. C---- SET UP PASS PARAMETERS.
  173.  
  174. 261     NSTRV=0
  175.       MERC=0
  176.       KMERC=.FALSE.
  177.       NX=.FALSE.
  178.       BUSH=1.0E6
  179.       WEAT=0.0
  180.       IREAT=0
  181.       IPPLG=0
  182.  
  183. C---- COMPUTE INITIAL BUY AND SELL RATES.
  184.  
  185.       NBUY=NMIN+MOD(RAND0,9)
  186.       NSELL=NBUY-1
  187.  
  188. C---- DOES THE FELLA WANNA BUY?
  189.  
  190. 3       WRITE(1,125)NBUY
  191. 125     FORMAT(' HOW MANY ACRES DO YOU WISH TO ',
  192.      1 'BUY AT',I3,' BUSHELLS/ACRE? ')
  193.       READ(1,ERR=3)ICN
  194.       CRES=ICN
  195.       IF(CRES)3,4,5
  196. 5     FLOAT=NBUY
  197.       IF(FLOAT*CRES-GRAIN)55,55,72
  198. 72      IWARN=IWARN+1
  199.       WRITE(1,104)
  200. 104     FORMAT(' THERE IS NOT ENOUGH GRAIN!')
  201.       GO TO 3
  202. 55      IF(ACRES-ACBUY*CRES)73,73,56
  203. 73      IF(NX)GO TO 56
  204.  
  205. C---- HE TRIED TO BUY TOO MUCH. UP HIS PRICE.
  206.  
  207.       WRITE(1,1006)
  208. 1006  FORMAT(' SPECULATION INCREASES THE LAND PRICE!')
  209.       IWARN=IWARN+1
  210.       NBUY=NBUY+1
  211.       NX=.TRUE.
  212.       GO TO 3
  213. 56      ACRES=ACRES+CRES
  214.       FLOAT=NBUY
  215.       GRAIN=GRAIN-FLOAT*CRES
  216.       GO TO 65
  217.  
  218. C---- DOES HE WANNA SELL?
  219.  
  220. 4      WRITE(1,118)NSELL
  221. 118     FORMAT(' HOW MANY ACRES DO YOU WISH TO SELL AT',
  222.      2 I3,' BUSHELLS/ACRE? ')
  223.       READ(1,ERR=4)ICN
  224.       CRES=ICN
  225.       IF(ICN)4,65,7
  226. 7       IF(ACRES-ACRAT*CRES)74,74,8
  227. 74      IF(NX)GO TO 8
  228.  
  229. C---- THIS IS WHAT HAPPENS IF YOU TRY TO SELL TOO MUCH.
  230.  
  231.       NX=.TRUE.
  232.       IWARN=IWARN+1
  233.       WRITE(1,1007)
  234. 1007  FORMAT(' EXCESSIVE SELLING OF LAND LOWERS THE PRICE!')
  235.       NSELL=NSELL-2
  236.       GO TO 4
  237. 8       IF(CRES-ACRES)88,88,75
  238. 75      IWARN=IWARN+1
  239.       WRITE(1,106)
  240. 106     FORMAT(' THE KINGDOM IS NOT THAT BIG!')
  241.       GO TO 4
  242. 88      ACRES=ACRES-CRES
  243.       FLOAT=NSELL
  244.       GRAIN=GRAIN+FLOAT*CRES
  245. 65      NPLN=(RAND0/7).AND.3
  246.  
  247. C---- SEND THE PEASANTS TO WORK PLANTING THE FIELDS.
  248.  
  249. 6     WRITE(1,1008)
  250. 1008  FORMAT(' HOW MANY ACRES DO YOU WISH TO PLANT? ')
  251.       READ(1,ERR=6)ICN
  252.       PLANT=ICN
  253.       IF(ICN)6,212,616
  254. 616     IF(PLANT-ACRES)10,10,76
  255. 76      IWARN=IWARN+1
  256.       WRITE(1,106)
  257.       GO TO 6
  258. 10      IF(PLANT-GRAIN)11,77,77
  259. 77      IWARN=IWARN+1
  260.       WRITE(1,104)
  261.       GO TO 6
  262. 11      IF(ICN-IPOP*(IPUT+NPLN))112,78,78
  263.  
  264. C---- THEY CAN ONLY DO SO MUCH WORK!
  265.  
  266. 78      WRITE(1,1009)
  267. 1009  FORMAT(' THAT IS OVERWORKING THE PEASANTS.')
  268.       IWARN=IWARN+1
  269.       GO TO 6
  270. 112     GRAIN=GRAIN-PLANT
  271.       IF(LAZY-4)212,79,79
  272. 79      LAZY=0
  273.  
  274. C---- LAZINESS CAN REDUCE THE AMOUNT SOWN.
  275.  
  276.       PLANT=PLANT*PLSTK
  277.       ICN=PLANT
  278.       WRITE(1,119)ICN
  279. 119     FORMAT(' THE LAZY PEASANTS ONLY PLANTED',I5,' ACRES.')
  280. 212     IF(RAND0-31000)12,211,211
  281.  
  282. C---- SOMETIMES THE FIELDS NEED A BOOST. NOT ENOUGH WILL BE BAD.
  283.  
  284. 211     IFERT=(RAND0.AND.3)+1
  285. 221   WRITE(1,120)IFERT
  286. 120     FORMAT(' HOW MANY BAGS OF FERTILIZER WILL WE BUY AT',I2,
  287.      1  ' BUSHELLS EACH? ')
  288.       READ(1,ERR=221)ICN
  289.       BUSH=ICN*IFERT
  290.       IF(BUSH-GRAIN)311,80,80
  291. 80      IWARN=IWARN+1
  292.       WRITE(1,104)
  293.       GO TO 211
  294. 311     GRAIN=GRAIN-BUSH
  295.  
  296. C---- FINALLY, THE PEASANTS MUST BE FED.
  297.  
  298. 12      WRITE(1,1010)
  299. 1010  FORMAT(' HOW MANY BUSHELLS DO YOU WISH TO USE AS FOOD? ')
  300.       READ(1,ERR=12)ICN
  301.       GIVEN=ICN
  302.       IF(ICN)12,13,13
  303. 13      IF(GIVEN-GRAIN)14,14,81
  304. 81      IWARN=IWARN+1
  305.       WRITE(1,104)
  306.       WRITE(1,1011)
  307. 1011  FORMAT(' THEY HAVE BEEN GIVEN ALL THAT REMAINS.')
  308.       GIVEN=GRAIN
  309. 14      GRAIN=GRAIN-GIVEN
  310.       FLOAT=RAND0.AND.0FFH
  311.       USER=37.5+AMOD(FLOAT,3.0)
  312.       IPOPA=GIVEN/USER
  313.       IF(IPOPA-IPOP-3)83,83,82
  314. 82      LAZY=LAZY+1
  315. 83    IF(IAFFC-110)15,84,84
  316. 84      IF(RAND0-26000)15,85,85
  317.  
  318. C---- OCCASIONALLY THE HUNS ATTACK OUR LITTLE PARADISE.
  319. C---- (ONLY IF IT IS WORTH WHILE.)
  320.  
  321. 85      WRITE(1,1012)
  322. 1012  FORMAT(' THE HUNS THREATEN THE KINGDOM!!!')
  323.       ICN=IMERC+MOD(NO.AND.0FFFH,7)
  324. 17      WRITE(1,121)ICN
  325. 121     FORMAT(' HOW MANY MERCENARIES WILL WE HIRE AT',I3,
  326.      1  ' BUSHELLS EACH? ')
  327.       READ(1,ERR=17)MERC
  328.       FLOAT=MERC*ICN
  329.       IF(FLOAT-GRAIN)16,16,86
  330. 86      IWARN=IWARN+1
  331.       WRITE(1,104)
  332.       GO TO 17
  333. 16      GRAIN=GRAIN-FLOAT
  334.       IF(IPOP-MERC*JMERC)15,87,87
  335.  
  336. C---- NOT ENOUGH MERCENARIES MEANS LOOT & PLUNDER.
  337.  
  338. 87      IWARN=IWARN+1
  339.       KMERC=.TRUE.
  340.       GRAIN=GRAIN*AMERC
  341.       IPOP=IPOP/LMERC+2
  342.  
  343. C---- FIND OUT WHAT THIS YEAR'S YIELD WILL BE.
  344.  
  345. 15    FLOAT=MOD(RAND0/7,4)
  346.       YIELD=WHEAT+FLOAT
  347.  
  348. C---- A FAMINE CAN STRIKE ONCE EVERY 15 YEARS.
  349.  
  350.       IF(IYR-5)151,89,89
  351. 89      IF(RAND0-30000)151,151,90
  352. 90      YIELD=1.00001
  353.  
  354. C---- OR WE MAY NOT HAVE ADEQUATELY FERTILIZED.
  355.  
  356. 151     IF(BUSH-PLANT/5.0)91,92,92
  357. 91      YIELD=YIELD/2.0
  358. 92      GRAIN=GRAIN+YIELD*PLANT
  359.  
  360. C---- HATCHED AND DISPATCHED SECTION.
  361.  
  362.  
  363. C---- BIRTHS AND NATURAL DEATHS ARE RELATED TO THE AMOUNT
  364. C---- OF GRAIN/PEASANT PROVIDED. STARVATION MAY KNOCK OUT
  365. C---- MORE IF THERE IS INADEQUATE GRAIN.
  366.  
  367.       IBTHS=IPOPA/(NBTHS+(RAND0.AND.7))+2
  368.       IDTHS=IPOPA/(NDTHS+(RAND0.AND.3))
  369.       NSTRV=IPOP-IPOPA
  370.       IF(NSTRV.LT.0)NSTRV=0
  371.       IF(NSTRV)19,19,93
  372. 93      NOFEED=NOFEED+1
  373.       IWARN=IWARN+1
  374.       FLOAT=IPOP
  375.       GLOAT=NSTRV
  376.       IF(FLOAT-STARVE*GLOAT)94,95,95
  377. 94      IWARN=IWARN+4
  378. 95      IPOP=IPOPA
  379. 19      IYR=IYR+1
  380.       IPOP=IPOP+IBTHS-IDTHS
  381.  
  382. C---- THE PLAGUE & THE POX WREAK HAVOC ON THE POPULATION.
  383.  
  384.       IF(RAND0-31000)20,96,96
  385. 96      IF(IPOP-25)20,97,97
  386. 97    FLOAT=IPOP
  387.       IPPLG=FLOAT*PLAGE
  388.       IPOP=IPOP-IPPLG
  389. 20      IF(RAND0-29000)21,98,98
  390.  
  391. C---- WHEN THE WEEVILS STRIKE, THEY REALLY STRIKE!
  392.  
  393. 98      WEAT=GRAIN*WEEVILS
  394.       GRAIN=GRAIN-WEAT
  395. 21    FLOAT=IPOP
  396.       IF(GRAIN/FLOAT-RRATE)23,99,99
  397. 99      IF(RAND0-27000)23,40,40
  398.  
  399. C---- TOO MUCH SPARE GRAIN. THE RATS GOT IN.
  400. C---- TOO BAD ABOUT THAT.
  401.  
  402. 40    REAT=GRAIN*REATR
  403.       IF(REAT.GT.32700.0)REAT=32700.0
  404.       GRAIN=GRAIN-REAT
  405.       IREAT=REAT
  406. 23      IF(RAND0-31000)32,41,41
  407.  
  408. C---- A CRISIS HITS THE PEOPLE! THE KING IS KIDNAPPED.
  409.  
  410. 41      WRITE(1,1013)
  411. 1013  FORMAT(' THE KING HAS BEEN KIDNAPPED!')
  412. 39      WRITE(1,1014)
  413. 1014  FORMAT(' HOW MANY BUSHELLS RANSOM WILL WE PAY?  ')
  414.       READ(1,ERR=39)ICN
  415.       RANSOM=ICN
  416.       IF(RANSOM-GRAIN)38,38,42
  417. 42      IWARN=IWARN+1
  418.       WRITE(1,104)
  419.       GO TO 39
  420. 38      IF(RANSOM-GRAIN*RANRATE)43,43,24
  421.  
  422. C---- NOT ENOUGH. SLIT HIS THROAT!
  423.  
  424. 43      WRITE(1,1015)
  425. 1015  FORMAT(' IT WAS NOT ENOUGH. THE KING IS NO MORE.')
  426.       GO TO 1
  427. 24      WRITE(1,1016)
  428. 1016  FORMAT(' THE KING HAS BEEN RELEASED.')
  429.       GRAIN=GRAIN-RANSOM
  430. 32      IF(NOFEED-4)2,44,44
  431.  
  432. C---- AN UPRISING MUST BE AVERTED. MORE FOOD IS THE WAY.
  433.  
  434. 44      WRITE(1,1017)
  435. 1017  FORMAT(' THE PEASANTS ARE THREATENING TO REVOLT IF YOU DONT'/
  436.      1 ' GIVE THEM MORE FOOD. HOW MUCH WILL YOU GIVE THEM? ')
  437. 35      READ(1,ERR=44)ICN
  438.       GRNT=ICN
  439.       NOFEED=0
  440.       FLOAT=IPOP*MOD(RAND0,5)
  441.       IF(GRNT-FLOAT)33,45,45
  442. 45      IF(GRNT-GRAIN)34,34,46
  443. 46      IWARN=IWARN+1
  444.       WRITE(1,104)
  445.       WRITE(1,1018)
  446. 1018  FORMAT(' HOW MUCH MORE WILL YOU GIVE THE PEASANTS? ')
  447.       GO TO 35
  448.  
  449. C---- THE RESULTS DEPEND ON THE MANAGER'S GENEROSITY.
  450.  
  451. 34      WRITE(1,1019)
  452. 1019  FORMAT(' THEY ACCEPTED YOUR OFFER.')
  453.       GRAIN=GRAIN-GRNT
  454.       GO TO 2
  455. 33      WRITE(1,1020)
  456. 1020  FORMAT(' YOUR MEASLY OFFER ANGERED THE PEASANTS,'/
  457.      1 ' SO THEY RAIDED THE GRAIN STORES.')
  458.       IWARN=IWARN+1
  459.       GRAIN=GRAIN/2.0
  460.       GO TO 2
  461.  
  462. C---- HERE ENDS ALL VICTIMS EVENTUALLY.
  463.  
  464. 510      WRITE(1,1021)(INAME(I),I=1,16)
  465. 1021  FORMAT(/1X,16A1/' YOUR MANAGEMENT WAS LOUSY.'/)
  466.       IWARN=(RAND0.AND.3)+1
  467.       GO TO (511,512,513,514),IWARN
  468. 511     WRITE(1,1022)
  469. 1022  FORMAT(' YOU HAVE FLED THE COUNTRY .')
  470.       GO TO 1030
  471. 512     WRITE(1,1023)
  472. 1023  FORMAT(' YOU HAVE BEEN HUNG!')
  473.       GO TO 1030
  474. 513     WRITE(1,1024)
  475. 1024  FORMAT(' YOU TOO ARE NOW A PEASANT.')
  476.       GO TO 1030
  477. 514     WRITE(1,1025)
  478. 1025  FORMAT(' YOU NOW RESIDE IN THE DUNGEONS.')
  479.       GO TO 1030
  480. 1030  WRITE(1,1031)
  481. 1031  FORMAT(///' ANOTHER SUCKER FOR THE FINK(YES OR NO)?....')
  482.       READ(1)STRING(INAME,1)
  483.       IF(INAME(1).EQ.'Y')GO TO 1
  484.       STOP
  485.       END
  486.  
  487.