10REM KINGDOM/Yellow River Kingdom
   12REM Program by Tom Hartley and Jerry Temple-Fry (NETHERHALL SCHOOL) and Richard G Warner
   13REM Version 5 - October 1981
   14REM For BBC Model A Microcomputer 16K Minimum
   40ON ERROR GOTO50
   50MODE 7
   60CLS:ON ERROR GOTO800
  100PROCVARIABLE:PROCTITLEPAGE
  110PROCINSTRUCTIONS
  200F=5000+RND(2000)
  210P=300+RND(100)
  220J=0:S=0
  300S=S+1:IF S=4 THEN S=1
  310J=J+1:Y=(J-1) DIV 3 +1
  320PROCNEWSEASON
  330FOR V=1 TO 3:FL(V)=0:NEXT
  340TD=0:TF=0:FD=0:FF=0:VF=0
  350PROCMAP:PROCDBL(S$(S)+" Season             Year "+STR$(Y),1,1)
  360IF RND(2)=1 THEN 380
  370PROCFLOOD:PROCATTACK:GOTO400
  380PROCATTACK:PROCFLOOD
  400PROCCALCULATE
  410PROCENDSEASON
  440IF P=0 OR F=0 THEN 500
  450IF J MOD 12 =0 THEN PROCRITUAL:IF Y%=0 THEN 500
  460IF P<200 AND RND(3)=1 THEN PROCADDTHIEVES
  470P=INT(P*1.045):GOTO300
  500VDU 26:CLS:PRINT TAB(0,9)
  510PRINT"Press the RETURN key to start again."'
  520PRINT"Press the ESCAPE key to leave the"'"program."
  530REPEAT UNTIL GET$=CHR$(13):GOTO200
  800IF ERR<>17 THEN REPORT:PRINT" in line ";ERL:END
  900VDU 26:CLS
  910END
 1000DEF PROCMAP
 1010VDU 26:CLS:PRINT''
 1020FOR I=3 TO 23
 1030PRINT Y$;W$;CHR$(&96);"55";Y$;TAB(27);R$
 1040NEXT
 1050FOR I=3 TO 21 STEP 2
 1060PRINT TAB(27,I);R$;" x ";TAB(27,I+1);R$;"x";CHR$(255);"~x  x"
 1070PRINT TAB(32,I+2);R$;"x";CHR$(255);"~x";
 1080NEXT
 1100FOR I=13 TO 15:PRINT TAB(30,I);"  "
 1110NEXT
 1120PRINT TAB(30,14);"THIEVES";TAB(31,13);"TT";TAB(31,15);"T";TAB(32,16);"T";TAB(32,17);"T"
 1200PRINT TAB(0,23);"   DYKE        VILLAGES      MOUNTAINS";
 1210FOR V=1 TO 3:PROCVDRAW(V):NEXT
 1299ENDPROC
 1500DEF PROCVDRAW(V)
 1510PRINT TAB(VX(V)-2,VY(V));V$;"^&";Y$TAB(VX(V)-2,VY(V)+1);V$;"&^";Y$
 1599ENDPROC
 2000DEF PROCINSTRUCTIONS
 2010PROCYELLOW:PRINT'''
 2020PRINT"The kingdom is three villages. It"'"is between the Yellow River and"'"the mountains."
 2030PRINT'"You have been chosen to take"'"all the important decisions. Your "'"poor predecessor was executed by"'"thieves who live in the nearby"'"mountains."
 2040PRINT'"These thieves live off the "'"villagers and often attack. The"'"rice stored in the villages must"'"be protected at all times."
 2090PROCSPACE
 2100CLS:PRINT''
 2110PRINT"The year consists of three long "'"seasons, Winter, Growing and"'"Harvest. Rice is planted every"'"Growing Season. You must decide"'"how much is planted."
 2120PRINT'"The river is likely to flood the"'"fields and the villages. The high"'"dyke between the river and the"'"fields must be kept up to prevent"'"a serious flood."
 2130PRINT'"The people live off the rice that"'"they have grown. It is a very poor"'"living. You must decide what the"'"people will work at each season"'"so that they prosper under your"'"leadership."
 2190PROCSPACE
 2199ENDPROC
 3000DEF PROCNEWSEASON
 3010PROCYELLOW:PRINT TAB(8,1);"Census Results"':IF J=1 THEN 3050
 3020PRINT"At the start of the ";S$(S);" Season"
 3030PRINT"of year ";Y;" of your reign this is"
 3040PRINT"the situation.":GOTO3100
 3050PRINT"You have inherited this situation"
 3060PRINT"from your unlucky predecessor. It"
 3070PRINT"is the start of the Winter Season."
 3100PRINT'"Allowing for births and deaths,"
 3110PRINT"the population is ";P;". "'
 3120PRINT"There are ";F;" baskets of rice"
 3130PRINT"in the village stores."
 3140PRINT'"How many people should:"
 3150PRINT" A) Defend the dyke......"
 3160PRINT" B) Work in the fields..."
 3170PRINT" C) Protect the villages."
 3200QU=14:A=0
 3210PRINT TAB(26,QU);:NI=FNNUMINP
 3220IF A+NI>P THEN PROCIMPOS:GOTO3210
 3230QU=QU+1:IF QU=16 THEN B=NI:GOTO3260
 3240A=NI:IF A<P THEN 3210
 3250B=0:PRINT TAB(26,QU);B:QU=16
 3260C=P-(A+B):PRINT TAB(26,QU);C
 3300IF S<>2 THEN 3390 
 3310PRINT'"How many baskets of rice will be"
 3320PRINT"planted in the fields....."
 3330PRINT TAB(26,19);:G=FNNUMINP
 3340IF G>F THEN PROCIMPOS:GOTO3330
 3350F=F-G
 3390PROCSPACE
 3399ENDPROC
 3500DEF PROCENDSEASON 
 3510PROCWAIT(1)
 3520IF F>0 THEN 3600
 3530CLS:PRINT TAB(3,7);"There was no food left.All of the"
 3540PRINT"   people have run off and joined up"
 3550PRINT"   with the thieves after ";J;" seasons"
 3560PRINT"   of your misrule":PROCSPACE:ENDPROC
 3600IF P>0 THEN 3700
 3610CLS:PRINT TAB(2,8);"There is no-one left! They have all"
 3620PRINT"  been killed off by your decisions "
 3630PRINT"  after only ";Y;" year";:IF Y<>1 THEN PRINT"s";
 3640PRINT".":PROCSPACE:ENDPROC
 3700F1=P/(FD+TD+ST+1):F2=F/(TF+FF+1):IF F2<F1 THEN F1=F2
 3720IF F2<2 THEN T$="Disastrous Losses!":GOTO3800
 3730IF F1<4 THEN T$="Worrying losses!":GOTO3800
 3740IF F1<8 THEN T$="You got off lightly!":GOTO3800
 3750IF F/P<4 THEN T$="Food supply is low.":GOTO3800
 3760IF F/P<2 THEN T$="Starvation Imminent!":GOTO3800
 3770IF ZA+ZF+ST>0 THEN T$="Nothing to worry about.":GOTO3800
 3780PROCDBL("             A quiet season           ",1,11)
 3790PROCWAIT(2):ENDPROC
 3800PROCYELLOW:PRINT TAB(3,2);"Village Leader's Report"
 3810PRINT'TAB(15-LEN(T$)/2);CHR$(&88);T$
 3820PRINT'"In the ";S$(S);" Season of year ";Y
 3830PRINT"of your reign, the kingdom has"
 3840PRINT"suffered these losses:"'
 3900PRINT"Deaths from floods..........";FD
 3910PRINT"Deaths from the attacks.....";TD
 3920PRINT"Deaths from starvation......";ST
 3930PRINT"Baskets of rice"'"lost during the floods......";FF
 3940PRINT"Baskets of rice"'"lost during the attacks.....";TF
 3950PRINT'"The village census follows."
 3990PROCSPACE
 3999ENDPROC
 4000DEF PROCADDTHIEVES
 4010PROCYELLOW:PRINT TAB(0,8)
 4020PRINT"Thieves have come out of the"
 4030PRINT"mountain to join you. They"
 4040PRINT"have decided that it will be"
 4050PRINT"easier to grow the rice than"
 4060PRINT"to steal it!":PROCSPACE
 4070P=P+50+RND(100)
 4099ENDPROC
 4500DEF PROCRITUAL
 4510PROCYELLOW:PRINT''
 4520PRINT"We have survived for ";Y;" years"
 4530PRINT"under your glorious control."
 4540PRINT"By an ancient custom we must"
 4550PRINT"offer you the chance to lay"
 4560PRINT"down this terrible burden and"
 4570PRINT"resume a normal life."
 4600PRINT'"In the time honoured fashion"
 4610PRINT"I will now ask the ritual"
 4620PRINT"question:"':PROCWAIT(5)
 4630PRINT"Are you prepared to accept"
 4640PRINT"the burden of decision again?"'
 4650PRINT"You need only answer Yes or No"
 4660PRINT"for the people will understand"'"your reasons."
 4670PRINT TAB(0,21);:PROCYESORNO:IF Y%<0 THEN 4670
 4699ENDPROC
 5000DEF PROCATTACK
 5010LOCAL X,Y,I
 5020ZA=0:R=RND(1):ON S GOTO5030,5040,5050
 5030IF R<.5 THEN ENDPROC ELSE 5060
 5040IF R<.2 THEN ENDPROC ELSE 5060
 5050IF R<.6 THEN ENDPROC ELSE 5060
 5060ZA=1
 5070IF VF=3 THEN ENDPROC
 5100V=RND(3):IF FL(V)=1 THEN 5100
 5110X=32:WX=VX(V):WY=VY(V)-1
 5120IF WY<17 THEN Y=13:D=-1 ELSE Y=17:D=1
 5130SY=Y
 5140PRINT TAB(X,Y);" ":IF Y=WY THEN 5160
 5150Y=Y+D:PRINT TAB(X,Y);"T":PROCWAIT(.05):GOTO5140
 5160X=X-1:PRINT TAB(X-1,Y);R$;"T":PROCWAIT(1-(X-WX)/5)
 5170PRINT TAB(X,Y);:IF X=29 THEN PRINT"x" ELSE PRINT" "
 5180IF X>WX THEN 5160
 5200FOR I=1 TO 99
 5210PRINT TAB(X,Y+1);CHR$(RND(94)+32):NEXT
 5220PROCVDRAW(V)
 5300X=X+1:IF X<27 THEN PRINT TAB(X-2,Y);" "
 5310IF X=31 THEN PRINT TAB(29,Y);"x"
 5320PRINT TAB(X-1,Y);R$;"T":PROCWAIT(.04)
 5330IF X<32 THEN 5300
 5340IF Y=SY THEN 5400
 5350PRINT TAB(X,Y);" ":Y=Y-D:PRINT TAB(X,Y);"T":PROCWAIT(.05):GOTO5340
 5400ON S GOTO 5410,5420,5430
 5410I=200+RND(70)-C:GOTO5440
 5420I=30+RND(200)-C:GOTO5440
 5430I=RND(400)-C
 5440I=INT(I):IF I<0 THEN I=0
 5450TD=INT(C*I/400):C=C-TD
 5460TF=INT(I*F/729+RND(2000-C)/10):IF TF<0 THEN TF=0
 5470IF TF>2000 THEN TF=1900+RND(200)
 5480F=F-TF
 5499ENDPROC
 5500DEF PROCFLOOD
 5510LOCAL X,Y
 5520ZF=0:ON S GOTO 5530,5540,5550
 5530FS=RND(330)/(A+1):GOTO5560
 5540FS=(RND(100)+60)/(A+1):GOTO5560
 5550ENDPROC
 5560IF FS<1 THEN ENDPROC
 5570X=6:ZF=1:Y=RND(8)+10:IF FS<2 THEN FS=RND(2) ELSE FS=RND(4)
 5600PRINT TAB(1,Y);W$;W$;W$;W$;W$;W$
 5610FOR K=1 TO FS*100
 5620ON RND(4) GOTO5630,5640,5650,5660
 5630IF X=25 THEN 5620 ELSE X=X+1:GOTO5700
 5640IF X=6 THEN 5620 ELSE X=X-1:GOTO5700
 5650IF Y=22 THEN 5620 ELSE Y=Y+1:GOTO5700
 5660IF Y=3 THEN 5620 ELSE Y=Y-1:GOTO5700
 5700V=1
 5720W1=VX(V)-X:W2=Y-VY(V)
 5730IF W2<>1 AND W2<>0 THEN 5760
 5740IF W1=0 OR W1=1 THEN FL(V)=1
 5750IF W1=-1 THEN 5780
 5760V=V+1:IF V<4 THEN 5720
 5770PRINT TAB(X,Y);W$
 5780NEXT K
 5790VF=FL(1)+FL(2)+FL(3)
 5800OP=A+B+C
 5810A=INT((A/10)*(10-FS))
 5820B=INT((B/10)*(10-FS))
 5830C=INT((C/6)*(6-VF))
 5840FF=INT(F*VF/6):F=F-FF 
 5850FD=OP-A-B-C
 5860IF S=2 THEN G=G*(20-FS)/20
 5870IF S=3 THEN G=G*(10-FS)/10
 5899ENDPROC
 6000DEF PROCCALCULATE
 6010IF B=0 THEN G=0:GOTO6100
 6020ON S GOTO 6100,6030,6050
 6030IF G>1000 THEN G=1000
 6040G=G*(B-10)/B:GOTO6100
 6050IF G<0 THEN 6100
 6060G=18*(11+RND(3))*(0.05-1/B)*G
 6070IF G<0 THEN 6100
 6080F=F+INT(G)
 6100ST=0:P=A+B+C:IF P=0 THEN 6299
 6110T=F/P:IF T>5 THEN T=4:GOTO6200
 6120IF T<2 THEN P=0:GOTO6299
 6130IF T>4 THEN T=3.5:GOTO6200
 6140ST=INT(P*(7-T)/7):T=3
 6200P=P-ST:F=INT(F-P*T-ST*T/2)
 6210IF F<0 THEN F=0
 6299ENDPROC
 7000DEF PROCVARIABLE
 7010DIM S$(3),VX(3),VY(3),FL(3)
 7020S$(1)="Winter":S$(2)="Growing":S$(3)="Harvest"
 7040W$=CHR$(255):Y$=CHR$(&93):R$=CHR$(&91):V$=CHR$(&92)
 7050VX(1)=13:VY(1)=8
 7060VX(2)=21:VY(2)=12
 7070VX(3)=22:VY(3)=18
 7099ENDPROC
 7100DEF PROCIMPOS
 7110PRINT TAB(4,20);CHR$(&88);CHR$(&82);"I M P O S S I B L E"
 7120PROCWAIT(2)
 7130PROCSPACE
 7140PRINT TAB(5,20);SPC(20);TAB(0,22);SPC(40)
 7199ENDPROC
 7200DEF PROCYELLOW
 7210LOCAL I
 7220CLS:FOR I=0 TO 24
 7230PRINT TAB(0,I);CHR$(&83);:NEXT
 7240PRINT TAB(0,0);
 7250VDU 28,3,24,39,0
 7299ENDPROC
 8000DEF PROCDBL(X$,X,Y)
 8010PRINT TAB(X-1,Y);CHR$(141);X$ 
 8020PRINT TAB(X-1,Y+1);CHR$(141);X$
 8099ENDPROC
 8100DEF PROCWAIT(X)
 8110LOCAL Z
 8120Z=TIME
 8130REPEAT UNTIL TIME-Z>X*100
 8199ENDPROC
 8200DEF PROCSPACE
 8220PRINT TAB(0,22);"Press the SPACE BAR to continue";:PROCKCL
 8240REPEAT UNTIL GET$=" "
 8299ENDPROC
 8300DEF PROCTITLEPAGE
 8310PROCMAP:PROCOFF:PROCWAIT(2):PRINT TAB(0,11);SPC(200)
 8315PROCDBL(Y$+"YELLOW RIVER",11,11):PROCDBL(Y$+"KINGDOM",13,14)
 8320I%=INKEY(500)
 8399ENDPROC
 8800DEF PROCKCL
 8810IF INKEY$(0)>"" THEN 8810
 8899ENDPROC
 8900DEF PROCOFF 
 8910VDU 23;8202;0;0;0;:ENDPROC
 8950DEF PROCON
 8960VDU 23;29194;0;0;0;:ENDPROC
 9000DEF PROCGPI(F2,ML):REM General Purpose Input Routine
 9010LOCAL B,B$ 
 9020A$=""
 9030PRINT STRING$(ML," ");STRING$(ML+1,CHR$(8));CHR$(&83);:PROCON:PROCKCL
 9040B$=GET$:B=ASC(B$):IF B=13 THEN 9190
 9050IF (B=127 OR B=8) AND A$="" THEN 9040
 9060IF (B=127 OR B=8) THEN A$=LEFT$(A$,LEN(A$)-1):PRINT B$;" ";B$;:GOTO9040
 9070IF LEN(A$)=ML OR B<32 OR B>126 THEN 9170
 9080IF F2=0 OR B=32 OR (B>=48 AND B<=57) THEN 9180
 9170VDU 7:GOTO9040
 9180PRINT B$;:A$=A$+B$:GOTO9040 
 9190PROCOFF
 9199ENDPROC 
 9200DEF PROCYESORNO
 9210LOCAL B$
 9220PROCGPI(0,3)
 9230B$=LEFT$(A$,1) 
 9240Y%=-1
 9250IF B$="Y" OR B$="y" THEN Y%=1 
 9260IF B$="N" OR B$="n" THEN Y%=0
 9299ENDPROC
 9300DEF FNNUMINP
 9310PROCGPI(1,6)
 9320=VAL(A$)