10 DEFine PROCedure start:LOCal cnt,cl:cl=0:cnt=0:ar$='STELLARIS':WINDOW 306,156,103,27:PAPER 0
20 CLS:OVER 1:INK 7:AT 10,0:PRINT 'Press <ESC> for this menu while orbiting/travelling'\\'Select Option using <SPACE>, then <ENTER>':INK 7:STRIP 0:PRINT \'Load unfinished game'\'Save unfinished game'\'New game':OVER 0:BLOCK 10,30,149,120,4:c=0:INK 7
30 REPeat o
40 cnt=cnt+1:cl=cl+PI/10:AT 1,cnt*4+3:OVER 1:CSIZE 3,1:INK cl*2:PRINT ar$(cnt):CIRCLE 65,60,5,4,cl*4:INK 7:CSIZE  0,0:OVER 0:IF cnt>8 THEN cnt=0
50 IF cl>PI*3 THEN cl=0
60 IF KEYROW(1)=64 THEN c=c*(c<3)+1:BLOCK 10,30,149,120,4:PAUSE 10:AT c+11,25:PRINT CHR$(188):OVER 0:INK 7
70 IF KEYROW(1)=1 AND c>0 THEN CLS:EXIT o
80 END REPeat o
90 SELect ON c
100 =1:AT c+11,20:INPUT 'Enter filename:'!f$:loa:kc 1:ka 2:itt:msh
110 =2:AT c+11,20:INPUT 'Enter filename:'!f$:sav:start
120 =3:PRINT \\,'Mission begins in 20 seconds...':kc 1:kb 50:ka 2:suv:itt:msh
130 END SELect 
140 END DEFine 
150 DEFine PROCedure loa:OPEN #6,'mdv1_'&f$:INPUT #6,aaa,bbb,acc,axis,ayis,x,y,victory,fuel,p,q,att,rev,liv:FOR i=1 TO 32:INPUT #6,za(i),zb(i),zc(i),zd(i),ze(i),zf(i),zg(i),zh(i),zi(i),zj(i),zk(i),zl(i),zm(i),zn(i),zo(i),zp(i):END FOR i
160 FOR j=2 TO 19:FOR i=2 TO 19:INPUT #6,astre(j,i):END FOR i:END FOR j:CLOSE #6:CLS:END DEFine 
170 DEFine PROCedure sav:DELETE 'mdv1_'&f$:OPEN_NEW #6,'mdv1_'&f$:PRINT #6,aaa\bbb\acc\axis\ayis\x\y\victory\fuel\p\q\att\rev\liv:FOR i=1 TO 32:PRINT #6,za(i)\zb(i)\zc(i)\zd(i)\ze(i)\zf(i)\zg(i)\zh(i)\zi(i)\zj(i)\zk(i)\zl(i)\zm(i)\zn(i)\zo(i)\zp(i):END FOR i
180 FOR j=2 TO 19:FOR i=2 TO 19:PRINT #6,astre(j,i):END FOR i:END FOR j:CLOSE #6:CLS:END DEFine 
190 DEFine PROCedure suv
200 aaa=0:bbb=0:acc=1:axis=8:ayis=8:x=1200:y=900:b1=0:b2=0:OVER 0:OPEN #5,scr_296x40a106x140:victory=0:fuel=1000:p=0:q=0:att=0:rev=0:liv=5
210 RESTORE :var=4:z=32:DIM astre(20,20),astre$(50,20),za(z),zb(z),zc(z),zd(z),ze(z),zf(z),zg(z),zh(z),zi(z),zj(z),zk(z),zl(z+4),zm(z),zn(z),zo(z),zp(z)
220 FOR astr=1 TO 50
230 sss=RND(2 TO 19):ttt=RND(2 TO 19):astre(sss,ttt)=astr:READ astre$(astr):IF astr<33 THEN zo(astr)=sss:zp(astr)=ttt
240 END FOR astr
250 FOR i=1 TO 32:za(i)=0:zb(i)=0:zc(i)=0:zd(i)=0:ze(i)=0:zf(i)=0:zg(i)=1:zh(i)=1:zi(i)=10:zj(i)=RND(100 TO 300):zk(i)=RND(1000 TO 3000):zl(i)=0:zm(i)=RND(5 TO 35):zn(i)=RND(0 TO 300)-150:END FOR i
260 END DEFine 
270 CLEAR:im=0:suv:start
280 adr$='BZQLNMZ7FKZCRCZKDCQHUD'
290 DATA 'Antares','Imperia','Betelgeuse','Sirius','Altair','Polaris','Proxima Centauri','Alpha Centauri','Castor','Pollux','Procyion','Capella','Adelbaran','Dubhe','Rigel','Regulus'
300 DATA 'Cluren','Stella Terriytorei','Andromedae','Arcturus','Cassiopeiae','Mu Hydrae','X. Cygni','Tau CrB','Alpha herculis','Mu Cephei','Alpha Orionis','Alcor','Beta Persei'
310 DATA 'Lambda tauri','Delta Librae','EARTH','M7','M1321','M12','M557','M21319','M3','M763','M19256','Pleiades','Great','Omega','Horse','Chronos,','Alluvien','Oneris','Anomrac','Cloud','Serena'
320 DEFine PROCedure itt:INK 7:FILL 0:WINDOW 512,256,0,0:PAPER 0:BORDER 6,4:CLS:RESTORE 330
330 DATA 150,150,106,30,150,150,256,30,300,55,106,30,300,55,106,125,60,150,26,30,60,150,420,30,207,60,305,186,60,20,26,80,60,20,420,80,205,60,0,186,93,66,209,189,100,20,10,0,100,20,400,0,100,20,206,0
340 FOR i=7 TO 20
350 OPEN #i,scr_:READ a,b,c,d:WINDOW #i,a,b,c,d:PAPER #i,0:INK #i,7:CLS #i:IF i>10 THEN BORDER #i,3,4
360 END FOR i
370 zl(2)=2:FOR ac=2 TO 19
380 FOR dc=2 TO 19
390 IF astre(ac,dc)>0 THEN BLOCK #17,4,3,(ac-1)*4,(dc-1)*3,7
400 IF astre(ac,dc)<33 AND astre(ac,dc)>0 THEN IF zl(astre(ac,dc))=2 THEN BLOCK #17,4,3,(ac-1)*4,(dc-1)*3,2
410 END FOR dc
420 END FOR ac
430 am=astre(axis,ayis):WINDOW 306,156,103,27:BORDER 3,2:BORDER #11,3,2:BORDER #12,3,2:PAPER 0:CLS:FOR po=1 TO 50:POINT RND(180),RND(100):END FOR po
440 FOR i=-16 TO 16 STEP 2:BLOCK #18,2,2,43+i*2,10,4:BLOCK #19,2,2,43+i*2,10,4:END FOR i:BLOCK #18,2,3,43,9,2:BLOCK #19,2,3,43,9,2:CURSOR #18,0,4:CURSOR #19,0,4:INK #18,2:INK #19,2:PRINT #18,CHR$(189):PRINT #19,CHR$(190):CURSOR #19,82,4:PRINT #19,CHR$(191)
450 CURSOR #20,0,2:PRINT #20,'FUEL:':BLOCK #20,52,12,32,1,4:BLOCK #20,50,10,33,2,2:INK #13,7:INK #16,4:STRIP #13,2:BLOCK #18,2,7,43,1,2:BLOCK #19,2,7,43,1,2:g0=0:g1=0:g2=0:g3=0:g4=0:g5=0:g6=0:time=DATE:ka 0:BEEP:END DEFine 
460 DEFine PROCedure msh
470 REPeat oooo
480 key_row:m:enemy
490 IF am=0 OR am>32 THEN BLOCK #17,4,3,(axis-1)*4,(ayis-1)*3,7*(am>0):ELSE BLOCK #17,4,3,(axis-1)*4,(ayis-1)*3,7-5*(zl(am)=2)
500 ayis=INT((y-50)/100):axis=INT((x+75)/150):am=astre(axis,ayis):BLOCK #17,4,3,(axis-1)*4,(ayis-1)*3,4
510 IF am>0 THEN system
520 END REPeat oooo
530 END DEFine 
540 DEFine PROCedure system
550 REPeat ooo
560 plot_star:key_row:enemy:IF ayis<>INT((y-50)/100) OR axis<>INT((x+75)/150) THEN EXIT ooo
570 IF q>25 AND p>30 THEN approach:IF warp THEN RETurn 
580 clear_star:IF am<41 THEN m
590 END REPeat ooo
600 IF am>40 THEN RECOL 0,1,0,3,0,5,6,7:ELSE clear_star
610 END DEFine 
620 DEFine PROCedure approach
630 star_name:clear_star:warp=0:IF am<41 THEN m
640 REPeat oo
650 plot_star:key_row:enemy:IF NOT(q>25 AND p>30) THEN EXIT oo
660 SELect ON am
670 =33 TO 40:IF q>35 AND p>60 THEN write 'NO ESCAPE. SURVIVAL CHANCES NILL. COMPUTER OUT':CLS:INK 7:FOR j=1 TO 2:ql=1:FOR i=1 TO 31:CIRCLE i+i,100-i-i,ql:ql=ql*1.15:END FOR i:INK 0:END FOR j:warp=1:EXIT oo
680 =41 TO 50:IF q>35 AND p>60 THEN write 'Entering time warp':RECOL 6,1,6,3,6,5,0,7:RECOL 6,1,2,3,4,5,0,7:warp=1:EXIT oo
690 =REMAINDER :IF KEYROW(1)=64 THEN orbit
700 END SELect 
710 clear_star:IF am<41 THEN m
720 END REPeat oo
730 IF NOT warp THEN write 'End of Approach':CLS #12:RETurn 
740 x=RND(150 TO 2850):y=RND(200 TO 1900):ka 2:CLS:FOR po=1 TO 50:POINT RND(180),RND(100):END FOR po:ka 0
750 END DEFine 
760 DEFine PROCedure m:qw1=-ABS(aaa)-2:we=ABS(bbb)+2:PAN #7,qw1:PAN #8,-qw1:SCROLL #9,-we:SCROLL #10,we:INK 7:FOR po=1 TO we-qw1:POINT RND(40 TO 110),RND(20 TO 80):END FOR po:END DEFine 
770 DEFine PROCedure enemy:IF att>33 THEN att=0
780 zb(2)=(DATE-time)*10:zc(2)=(DATE-time)*12:zd(2)=(DATE-time)*100:za(2)=(DATE-time)*20:ze(2)=(DATE-time)*40:IF INT(DATE/23)=DATE/23 THEN offence
790 END DEFine 
800 DEFine PROCedure key_row:BEEP
810 IF KEYROW(1)=8 THEN start
820 IF fuel<2 THEN RETurn 
830 k=KEYROW(1)
840 IF k&&2 THEN IF aaa>-15 THEN aaa=aaa-2:kc 0:xspeed
850 IF k&&16 THEN IF aaa<15 THEN aaa=aaa+2:kc 0:xspeed
860 IF k&&4 THEN IF bbb>-15 THEN bbb=bbb-2:kc 0:yspeed
870 IF k&&128 THEN IF bbb<15 THEN bbb=bbb+2:kc 0:yspeed
880 IF x+aaa>=150 AND x+aaa<=3000 AND y+bbb>=150 AND y+bbb<=2100 THEN x=x+aaa:y=y+bbb:ELSE write 'Warning! Approaching Galactical Fringe!'
890 END DEFine 
900 DEFine PROCedure xspeed:BLOCK #18,10,7,39+aaa+aaa,1,0:BLOCK #18,2,7,43+aaa+aaa,1,2:fuel=fuel-2:BLOCK #20,50,10,33,2,0:BLOCK #20,fuel/20,10,33,2,2:END DEFine 
910 DEFine PROCedure yspeed:BLOCK #19,10,7,39+bbb+bbb,1,0:BLOCK #19,2,7,43+bbb+bbb,1,2:fuel=fuel-2:BLOCK #20,50,10,33,2,0:BLOCK #20,fuel/20,10,33,2,2:END DEFine 
920 DEFine PROCedure plot_star
930 b1=75-x+axis*150:b2=y-50-ayis*100:p=75-ABS(b1-75):q=50-ABS(b2-50)
940 SELect ON am
950 =1 TO 11:FILL 1:INK 211:CIRCLE b1,b2,5E-3*p*q:INK 50:ARC b1,b2+5E-3*p*q TO b1,b2-5E-3*p*q,2:FILL 0
960 =20 TO 26:BEEP 0,1,19,69,81,43,52,8:OVER -1:FILL 1:INK 2:CIRCLE b1,b2,2E-3*p*q:FILL 0:INK 50:FOR i=1 TO 3:CIRCLE b1,b2,2E-3*p*q+1:END FOR i:OVER 0
970 =33 TO 40:BEEP 0,1,19,69,81,43,32,0:INK 2:FOR i=1 TO 7:CIRCLE b1+i*(75-b1)/20,b2+i*(50-b2)/20,7E-3*p*q-i:END FOR i
980 =27 TO 32:INK 2:FILL 1:qq=.2*(50-b2):CIRCLE b1,b2,5E-3*p*q:FILL 0:INK 0:FILL 1:CIRCLE b1+(75-b1)/3,b2+qq,2E-3*p*q:FILL 0:INK 2:CIRCLE b1+(75-b1)/3,b2+qq,2E-3*p*q
990 =12 TO 19:re=5E-3*p*q:INK 2:ARC b1-re*.9,b2-re*.9 TO b1+re*.9,b2+re*.9,-1.5:INK 241:FILL 1:CIRCLE b1,b2,re:INK 2:FILL 0:ARC b1-re*.9,b2-re*.9 TO b1+re*.9,b2+re*.9,1.5
1000 =41 TO 50:FOR i=1 TO 3:INK RND(2 TO 4):FILL RND(3):CIRCLE RND(150),RND(100),RND(3):FILL 0:INK 7:POINT RND(150),RND(100):END FOR i
1010 END SELect :END DEFine 
1020 DEFine PROCedure clear_star:SELect ON am
1030 =1 TO 11:FILL 1:INK 0:CIRCLE b1,b2,5E-3*p*q+1:FILL 0
1040 =20 TO 26:FILL 0:INK 0:FOR i=3 TO 0 STEP -.3:CIRCLE b1,b2,2E-3*p*q+i:END FOR i:FILL 1:CIRCLE b1,b2,10:FILL 0
1050 =33 TO 40:INK 0:FOR i=7 TO 1 STEP -1:CIRCLE b1+i*(75-b1)/20,b2+i*(50-b2)/20,7E-3*p*q-i:END FOR i
1060 =27 TO 32:INK 0:FILL 1:CIRCLE b1,b2,5E-3*p*q:FILL 0:FILL 1:CIRCLE b1+(75-b1)/3,b2+qq,2E-3*p*q+10:FILL 0
1070 =12 TO 19:INK 0:FILL 1:CIRCLE b1,b2,9E-3*p*q:FILL 0
1080 =41 TO 50:FOR i=1 TO 3:INK RND(2 TO 4):FILL RND(3):CIRCLE RND(150),RND(100),RND(3):FILL 0:INK 7:POINT RND(150),RND(100):END FOR i
1090 END SELect :END DEFine 
1100 DEFine PROCedure star_name:SELect ON am
1110 =1 TO 11:message '','Approaching '&astre$(am)
1120 =20 TO 26:message '','Approaching Cosmic PULSAR system '&astre$(am)
1130 =33 TO 40:message 'WARNING!','Approaching BLACK HOLE '&astre$(am)
1140 =27 TO 32:message '','Approaching Binary Star System '&astre$(am)
1150 =12 TO 19:message '','Approaching '&astre$(am)
1160 =41 TO 50:message '','Entering '&astre$(am)&' Nebula'
1170 END SELect :END DEFine 
1180 DEFine PROCedure message(special$,msg$)
1190 RECOL #13,0,1,0,3,4,5,6,7:SCROLL #13,-10:AT #13,4,0:PRINT #13,special$&msg$:IF am<33 THEN CLS #12:INK #12,4:PRINT #12,\\\\'TO ENTER'\' ORBIT:'\\\'(space)':INK #12,2:FILL #12,1:CIRCLE #12,12,52,5:BLOCK #12,11,3,18,68,7
1200 END DEFine 
1210 DEFine PROCedure enter_orbit
1220 ka 2:FOR i=1 TO 150:END FOR i:RESTORE 1270:FILL 1:INK 4:r=-3.1:in=4:tp=xxp*xxq
1230 OPEN #4,scr_:WINDOW #4,2.3E-2*tp,1.6E-2*tp,108+2*(b1-5E-3*tp),29+1.5*(100-b2-5E-3*tp)
1240 IF am>11 AND am<20 THEN FILL 0:CLS:FOR i=1 TO 10:INK 50:CIRCLE b1,b2,6.5E-3*tp+i/3+2,2,.5:CIRCLE b1,b2,6.5E-3*tp+(i/7+13)*3,2,.5:CIRCLE b1,b2,6.5E-3*tp+(i/5+7)*3,2,.5:END FOR i:INK 0
1250 CIRCLE b1,b2,5E-3*tp:FILL 0:FILL 1
1260 IF am>26 AND am<33 THEN CIRCLE b1+(75-b1)/3,b2+qq,3E-3*tp:FILL 0:FILL 1
1270 DATA -3.1,-3,-2.8,-2.4,-2,-1.3,-.5,.5,1.3,2,2.4,2.8,3,3.1
1280 FOR pq=1 TO 14
1290 READ qp1:INK in:ARC b1,b2+5E-3*tp TO b1,b2-5E-3*tp,qp1:in=in-2+4*(in=2)
1300 END FOR pq
1310 FILL 0:FILL 1
1320 RESTORE 1260
1330 FOR pq=1 TO 14
1340 READ qp1:INK in:SELect ON am=27 TO 32:ARC b1+(75-b1)/3,b2+qq+3E-3*tp TO b1+(75-b1)/3,b2+qq+3E-3*tp,qp1:in=in-2+4*(in=2)
1350 END FOR pq
1360 FILL 0:IF am<11 THEN FOR i=1 TO 24:FILL 1:INK 6:CIRCLE RND(b1-30 TO b1+30),RND(b2-30 TO b2+30),RND(2)/2:FILL 0:END FOR i:INK 0
1370 FILL 0:write 'NOW IN ORBIT':CLS #12:FILL #12,1:INK #12,4:PRINT #12,'TO LAND'\' PRESS'\\\\'TO LEAVE'\'ORBIT'\\\\'FOR INFO'\' PRESS':OVER #12,1:INK #12,2:CIRCLE #12,12,10,5:INK #12,7:CURSOR #12,20,25:PRINT #12,'L':CURSOR #12,20,75:PRINT #12,'B':CURSOR #12,20,125:PRINT #12,'I':OVER #12,0:ka 0:BEEP
1380 END DEFine 
1390 DEFine PROCedure orbit
1400 FOR i=18 TO 20:RECOL #i,0,1,4,3,6,5,6,7:END FOR i:kc 1:xxp=p:xxq=q
1410 write 'ATTENTION -- PROCEEDING TO ORBIT':enter_orbit
1420 REPeat o
1430 RECOL #4,0,1,4,3,2,5,6,7:enemy:IF INT(DATE/5)*5=DATE THEN INK 7:POINT RND(0 TO 150),RND(1 TO 100)
1440 IF KEYROW(2)=16 THEN EXIT o
1450 IF KEYROW(1)=8 THEN start
1460 IF KEYROW(4)=1 THEN land:enter_orbit
1470 IF KEYROW(5)=4 THEN intel:enter_orbit
1480 END REPeat o
1490 CLS #4:write 'LEAVING ORBIT':FOR i=18 TO 20:RECOL #i,0,1,2,3,2,5,4,7:END FOR i:CLS #12:p=xxp:q=xxq
1500 ka 2:CLS:FOR po=1 TO 50:POINT RND(180),RND(100):END FOR po:plot_star:ka 0
1510 END DEFine 
1520 DEFine PROCedure land:LOCal a,b,c,d,e,mass,fuels,v,i,s,f,h,dec:ka 2:write 'Landing...':CLS #12:FILL #12,1:INK #12,4:PRINT #12,\\\'TO FIRE'\\'BOOSTERS'\\' PRESS':INK #12,2:OVER #12,1:CIRCLE #12,12,32,5:INK #12,7:CURSOR #12,20,92:PRINT #12,CHR$(190):STRIP #12,0
1530 CLS:s=0:RESTORE 1540:WINDOW #4,20,7,225,48:OPEN #3,scr_20x120a225x30:FOR i=1 TO 20:INK RND(2 TO 7):POINT RND(118 TO 132)/2,RND(168 TO 176)/2:END FOR i:INK 4
1540 DATA 14,2,99,51,7,12,4,100,50,7,8,1,102,49,4,8,2,102,54,4,3,2,101,56,4,3,2,108,56,4,6,1,103,48,4,2,5,105,43,7
1550 FOR i=1 TO 8:READ a,b,c,d,e:BLOCK a,b,c+20,d-40,e:END FOR i:FILL 1:INK 241:CIRCLE 75,-310,330:FILL 0:INK 4:OVER 0:STRIP 2
1560 fuel=fuel-25:fuels=250:acc=zm(am):mass=8000+fuels*10:v=0:s=0:d=500:f=20000:h=48:PAPER #2,0:dec=0:PRINT \'ALTITUDE (km)'\\\\\'!!!WARNING!!!'\'MAX.  LANDING'\'VELOCITY '!acc:AT 1,34:PRINT 'VELOCITY (km/h)':AT 9,34:PRINT 'FUEL (kg)':ka 0
1570 REPeat down
1580 v=v+acc-dec:s=v+.5*(acc-dec):d=d-s:dec=0:AT 3,0:INK 7:PRINT ' '!INT(d)!' ':AT 3,40::PRINT ' '!INT(v)!' ':AT 11,40:PRINT ' '!fuels!' '
1590 IF d<=5 AND v<=acc THEN d=-1:v=0:write 'LANDED SAFELY.':CLS #12:king
1600 IF d<5 AND v>acc THEN INK 7:FOR i=1 TO 25 STEP 2:CIRCLE 60,20,i:END FOR i:write 'CRASHED':lives:CLS:RETurn 
1610 IF d>600 THEN write 'RETURNING TO ORBIT':ka 2:CLS:FILL 1:INK 4:CIRCLE 75,50,90:FILL 0:ka 0:kc 1:INK 0:FOR i=90 TO 15 STEP -.5:CIRCLE 75,50,i:END FOR i:INK 4:CLS:RETurn 
1620 SCROLL #3,s/5:h=h+s/5:WINDOW #4,20,7,225,h:ti=DATE
1630 REPeat fuell
1640 IF DATE>ti+1 THEN EXIT fuell
1650 IF fuels>0 AND KEYROW(1)=4 THEN BEEP 3000,18,0,0,0,0,26,0:fuels=fuels-1:mass=mass-1:dec=dec+(f/mass):RECOL #4,0,1,4,3,6,5,2,7
1660 END REPeat fuell
1670 END REPeat down
1680 END DEFine 
1690 DEFine PROCedure king
1700 IF zl(am)<>2 THEN zl(am)=1:INK 7:de=0:fs=0:CLS:troops=50:ht=0:main:RETurn 
1710 write 'Your landing party was captured':write 'by enemy Space Guards.':kb 10:lives:CLS:END DEFine 
1720 DEFine PROCedure main
1730 REPeat loppp
1740 season$='WINTER':eat=1.3:wt=1.5:feed:enemy:results:IF d>=0 THEN RETurn 
1750 season$='SPRING':eat=1.2:wt=1.7:feed:pd=fs*zi(am)*zh(am):IF pd>sd THEN pd=sd
1760 enemy:results:IF d>=0 THEN RETurn 
1770 season$='SUMMER':eat=1.1:wt=1.8:feed:enemy:IF d>=0 THEN RETurn 
1780 a=fs*zi(am)*zh(am):IF a<pd THEN write 'Grain lost through neglect: '&(pd-a)&'Ton':pd=INT(a)
1790 enemy:results:IF d>=0 THEN RETurn 
1800 season$='AUTUMN':eat=1.2:wt=1.6:feed:enemy:IF d>=0 THEN RETurn 
1810 ht=(pd*fs*zi(am)*zh(am)^.5)^.6:zk(am)=zk(am)+ht:results:IF d>=0 THEN RETurn 
1820 END REPeat loppp
1830 END DEFine 
1840 DEFine PROCedure feed:ka 2:f9:AT 10,0:PRINT 'Continue'\'Leave planet'\'Transfer/Attack'\'Trade with Federation':BLOCK 10,40,142,100,4:c=0
1850 INK #11,4:CLS #11:PRINT #11,\'TO MOVE'\' ARROW:'\\\\'(SPACE).'\\'   TO'\' SELECT'\\\\'(ENTER).':INK #11,2:FILL #11,1:CIRCLE #11,12,70,5:CIRCLE #11,12,20,5:INK #11,7:CURSOR #11,17,110:OVER #11,1:PRINT #11,'cr':BLOCK #11,12,3,17,42,7:INK 7:ka 0
1860 REPeat lopes
1870 IF KEYROW(1)=64 THEN c=c*(c<4)+1:AT c+9,24:BLOCK 10,40,142,100,4:OVER 1:INK 0:PRINT CHR$(188):OVER 0::PAUSE 100:INK 7
1880 IF KEYROW(1)=1 THEN EXIT lopes
1890 END REPeat lopes
1900 SELect ON c
1910 =2:d=700:CLS #16:RETurn 
1920 =3:transfer:CLS:f9
1930 =4:trade:CLS:f9
1940 END SELect 
1950 AT 10,0:PRINT FILL$(' ',200):STRIP 2:AT 14,0:PRINT 'How much grain is to be distributed?';:fd=chinky$(zk(am)):zk(am)=zk(am)-fd
1960 STRIP 2:SCROLL #5,-10:AT 14,0:PRINT 'How much grain is to be planted?';:sd=chinky$(zk(am))
1970 zk(am)=zk(am)-sd:STRIP 2:SCROLL #5,-10:AT 14,0:PRINT 'How many people to work in the fields?';:fs=chinky$(zj(am))
1980 STRIP 2:SCROLL #5,-10:AT 14,0:PRINT 'How many people to Planetary Brigade?';:zd(am)=chinky$(zj(am)-fs)
1990 STRIP 2:SCROLL #5,-10:AT 14,0:PRINT 'How many people to work in Industry?';:ws=chinky$(zj(am)-fs-zd(am))
2000 STRIP 2:SCROLL #5,-10:AT 14,0:PRINT 'Intelligence ("y" for yes)?':IF INKEY$(-1)=='Y' THEN SCROLL #5,-10:AT 14,0:PRINT 'Cost is'!nm$(zf(am)/20);'. Accepted?':STRIP 0:IF INKEY$(-1)=='Y' THEN zf(am)=zf(am)*.95:rev=1:intel:rev=0
2010 a=(zj(am)-fs)*eat+fs*wt:IF fd>a THEN zi(am)=zi(am)+1:IF zi(am)<9 THEN zi(am)=9
2020 IF fd<a THEN de=ABS(INT((zj(am)-fd/eat)/3)):zi(am)=zi(am)-1:zj(am)=zj(am)-de:IF zi(am)>10 THEN zi(am)=10
2030 bi=INT(zj(am)*RND(1 TO 5)/30):zj(am)=zj(am)+bi:END DEFine 
2040 DEFine PROCedure results:IF d>=0 THEN RETurn 
2050 pr=ws*zi(am)^2.7*SQRT(zg(am)):zg(am)=zg(am)-.1:zh(am)=zh(am)-.1:zf(am)=zf(am)+pr
2060 IF zg(am)<.1 THEN zg(am)=.1
2070 IF zh(am)<.1 THEN zh(am)=.1
2080 CLS:ka 2:BLOCK 120,70,10,15,2:OVER 1:AT 2,2:PRINT 'Deaths:'!de:AT 3,2:PRINT 'Births:'!bi:OVER -1:AT 4,2:PRINT 'change:'!bi-de:de=0:bi=0:OVER 1
2090 AT 5,2:PRINT 'Morale:'!:IF zi(am)<10 THEN a$='low':IF zi(am)<7 THEN a$='very low'
2100 IF zi(am)>=10 THEN a$='high':IF zi(am)>12 THEN a$='very high':IF zi(am)>13 THEN rp=RND(2):IF NOT rp THEN write 'Lured by high incentives.':write 'more natives join in.':zj(am)=zj(am)+INT(zj(am)*zi(am)/100)
2110 PRINT a$:AT 6,2:OVER -1:PRINT 'Grain:'!nm$(ht-sd-fd)\'  GDP:'!nm$(pr):fd=0:sd=0:ht=0:OVER 1
2120 IF zj(am)<1 THEN write 'You have reduced this race':write 'to a pityless end.':write 'There is nothing more for you':write 'to do on this planet.'
2130 IF zi(am)<6 THEN write 'VIOLENT RIOTS, SEVERAL TROOPS  KILLED':troops=troops-RND(30):IF troops<1 THEN write 'You have been expelled':write 'from this system':zl(am)=0:lives:d=700
2140 END DEFine 
2150 DEFine FuNction chinky$(lim):LOCal a$
2160 STRIP 0:AT 14,38:PRINT '           ':STRIP 4:AT 14,38:INPUT a$:IF a$='' THEN GO TO 2160
2170 IF CODE(a$)<48 OR CODE(a$)>57 THEN GO TO 2160
2180 IF a$>lim THEN GO TO 2160
2190 RECOL #5,0,1,0,3,0,5,6,7:RETurn a$:END DEFine 
2200 DEFine PROCedure trade:LOCal u1,u2,q7,buy:ka 2:CLS #12:u1=0:u2=0:buy=0:CLS:c=0:BLOCK 15,80,141,30,2
2210 STRIP 2:PRINT 'FEDERAL TRADE BOARD RATES'\'(Millions IG$/Tons Grain':STRIP 4:PRINT 'COMMODITY:',,'   QUANTITY:':STRIP 0:PRINT 'Laser:',,'     1'\'Satellite:','    25'\'Interceptor:','    10'\'Starship:','    50'\'Industrial Tech:   0.5'\'Agricultural Tech: 0.3'\'Grain',,' 0.001'\'Fuel:',,'   0.1':ka 0
2220 REPeat loppo
2230 IF KEYROW(1)=64 THEN c=c*(c<8)+1:OVER 1:BLOCK 15,80,141,30,2:AT c+2,24:INK 0:PRINT CHR$(188):OVER 0:kb 0:INK 7
2240 IF KEYROW(1)=1 AND c>0 THEN inputter:acq:EXIT loppo
2250 END REPeat loppo
2260 CLS #5:AT 14,0:STRIP 2:PRINT 'Any further queries ("y" for yes)?':STRIP 0:OVER #16,0:INK #16,7:AT #16,1,0:PRINT #16,FILL$(' ',64):AT #16,1,0:PRINT #16,' Assets:       '!nm$(zf(am))\' Grain:        '!nm$(zk(am)):IF INKEY$(-1)=='Y' THEN trade
2270 END DEFine 
2280 DEFine PROCedure acq
2290 IF CODE(q7$)>47 AND CODE(q7$)<58 THEN q7=q7$:ELSE q7=0
2300 SELect ON c
2310 =8:u1=100:u2=100:pay:fuel=fuel+q7*buy
2320 =1:u1=1E6:u2=1000:pay:ze(am)=ze(am)+q7*buy
2330 =2:u1=2.5E7:u2=25000:pay:zc(am)=zc(am)+q7*buy
2340 =3:u1=1E7:u2=10000:pay:za(am)=za(am)+q7*buy
2350 =4:u1=5E7:u2=50000:pay:zb(am)=zb(am)+q7*buy
2360 =5:u1=500000:u2=500:pay:zg(am)=zg(am)+q7*buy
2370 =6:u1=300000:u2=300:pay:zh(am)=zh(am)+q7*buy
2380 =7:u1=1000:u2=1:pay:zk(am)=zk(am)+q7*buy
2390 END SELect 
2400 IF fuel>1000 THEN fuel=1000
2410 END DEFine 
2420 DEFine PROCedure pay:LOCal cq:CLS #5:BLOCK 206,10,0,110,2:OVER 1:AT 11,0:PRINT 'Cost is:'!nm$(q7*u1)!'/'!nm$(q7*u2):OVER 0
2430 AT 12,16:PRINT 'INTERGALAX $'\,,'GRAIN'\'NO PAYMENT':BLOCK 10,30,196,120,4:cq=0:AT 12,0:PRINT 'Payment by:'
2440 REPeat lap
2450 IF KEYROW(1)=64 THEN cq=cq*(cq<3)+1:AT cq+11,33:BLOCK 10,30,196,120,4:INK 0:OVER 1:PRINT CHR$(188):OVER 0:INK 7
2460 IF KEYROW(1)=1 AND cq>0 THEN kb 1:EXIT lap
2470 END REPeat lap
2480 SELect ON cq
2490 =3:buy=0:RETurn 
2500 =1:IF zf(am)>=u1*q7 THEN buy=1:zf(am)=zf(am)-u1*q7
2510 =2:IF zk(am)>=u2*q7 THEN buy=1:zk(am)=zk(am)-u2*q7
2520 END SELect 
2530 IF buy=0 THEN STRIP 4:AT 13,35:INK 0:PRINT 'NO FUNDS.':STRIP 0:INK 7:kb 1
2540 END DEFine 
2550 DEFine PROCedure attack:LOCal d0,d2,d3,d4,d6,d8,la
2560 d4=ze(ad):d3=zc(ad):d0=za(ad):d2=zd(ad):d8=zi(ad)/10:d6=SQRT(zg(ad))
2570 a1=a1-SQRT(d3)*d6:IF a1<0 THEN a1=0
2580 d3=d3-a0/5/d6:IF d3<0 THEN d3=0
2590 a1=a1-d0*d6*d8/10:la=a0:a0=a0-d0*d6*d8-d4*d6/3:d0=d0-la/d6/d8
2600 IF a1>0 THEN zk(ad)=zk(ad)/a1:zf(ad)=zf(ad)/a1:d4=d4-(a1-INT(a2/10))*3/d6
2610 IF a2<0 THEN a2=0
2620 IF d2<0 THEN d2=0
2630 IF d0<0 THEN d0=0
2640 IF a0<0 THEN a0=0
2650 IF d4<0 THEN d4=0
2660 IF a1<0 THEN a1=0
2670 IF d3<0 THEN d3=0
2680 IF a2>d2*d8*2 OR zk(ad)<zj(ad) AND zf(ad)<zj(ad)*100 THEN zj(ad)=zj(ad)-zd(ad)/2:za(ad)=a0:zb(ad)=a1:zd(ad)=a2:victory=1
2690 IF victory=0 THEN zj(ad)=zj(ad)-d3/3:zc(ad)=d3:zd(ad)=d2:ze(ad)=d4:za(ad)=d0
2695 IF zj(ad)<0 THEN zj(ad)=0
2700 END DEFine 
2710 DEFine PROCedure transfer:LOCal c$,e,c,q1,d,pos,dn,or,na:ka 2:na=1:c$='w':pos=0:CLS:INK 7:write 'F1 to escape'
2720 c=0:e=0:FOR i=1 TO 4:AT i,pos*26:PRINT astre$(i) TO 20+pos*26:END FOR i:BLOCK 16,40,117+pos*155,10,4:STRIP 4:AT 0,0:INK 0:PRINT 'TRANSFER FROM:',,'  TO DESTINATION:       ':STRIP 0:INK 0:ka 0
2730 REPeat luck
2740 IF KEYROW(0)=2 THEN CLS:write '':RETurn 
2750 IF KEYROW(1)=64 THEN c=c+1:IF c<5 THEN AT c,20+pos*26:BLOCK 16,40,117+pos*155,10,4:OVER 1:INK 0:PRINT CHR$(188):OVER 0:INK 7
2760 IF e>24 AND c=5:GO TO 2720
2770 IF c=5 THEN INK 7:c=1:e=e+4:FOR i=e+1 TO e+4:AT i-e,pos*26:PRINT astre$(i) TO 20+pos*26:END FOR i:AT c,20+pos*26:BLOCK 16,40,117+pos*155,10,4:OVER 1:INK 0:PRINT CHR$(188):OVER 0:INK 7
2780 IF KEYROW(1)=1 AND c>0 AND pos=0 THEN or=e+c:IF zl(or)=1 THEN pos=pos+1:GO TO 2720
2790 IF e=(am-1) DIV 4 THEN AT am-e,pos*26:STRIP 2:PRINT astre$(am):STRIP 0
2800 IF KEYROW(1)=1 AND c>0 AND pos=1 THEN dn=e+c:EXIT luck
2810 FOR i=1 TO 4:IF zl(e+i)=1 THEN AT i,pos*26:STRIP 40:INK 7:PRINT astre$(e+i):STRIP 0:END FOR i
2820 END REPeat luck
2830 IF zl(dn)=1 THEN tra
2840 IF zl(dn)<>1 THEN atd
2850 END DEFine 
2860 DEFine PROCedure tra:ka 2
2870 a$=FILL$(' ',37):AT 7,0:PRINT a$;za(or)\a$;zb(or)\a$;zd(or)\a$;zc(or)\a$;ze(or)\a$;zf(or)\a$;zj(or)\a$;zk(or):OVER -1:BLOCK 68,79,220,70,4:OVER 0
2880 AT 7,0:PRINT 'INTERCEPTORS'\'SHIPS'\'SOLDIERS'\'SATELLITES'\'LASERS'\'ASSETS'\'MANPOWER'\'GRAIN':AT 6,0:STRIP 4:INK 0:PRINT 'CATEGORY:','QUANTITY:','     AVAILABLE: ':INK 7:STRIP 0:BLOCK 10,79,82,70,4:dt=0:lbl=79:ka 0
2890 FOR lock=1 TO 8:src:END FOR lock
2900 END DEFine 
2910 DEFine PROCedure src:BLOCK 10,lbl,82,70,4:AT lock+6,14:OVER 1:INK 0:PRINT CHR$(188)!;:OVER 0:INK 7:INPUT dt$:er=1
2920 IF CODE(dt$)>47 AND CODE(dt$)<58 THEN dt=dt$:ELSE AT lock+6,16:PRINT '0     (Default)':dt=0
2930 SELect ON lock
2940 =1:IF za(or)>=dt THEN za(or)=za(or)-dt:za(dn)=za(dn)+dt:er=0:a0=dt
2950 =2:IF zb(or)>=dt THEN zb(or)=zb(or)-dt:zb(dn)=zb(dn)+dt:er=0:a1=dt
2960 =4:IF zc(or)>=dt THEN zc(or)=zc(or)-dt:zc(dn)=zc(dn)+dt:er=0
2970 =3:IF zd(or)>=dt THEN zd(or)=zd(or)-dt:zd(dn)=zd(dn)+dt:er=0:a2=dt
2980 =5:IF ze(or)>=dt THEN ze(or)=ze(or)-dt:ze(dn)=ze(dn)+dt:er=0
2990 =6:IF zf(or)>=dt THEN zf(or)=zf(or)-dt:zf(dn)=zf(dn)+dt:er=0
3000 =7:IF zj(or)>=dt THEN zj(or)=zj(or)-dt:zj(dn)=zj(dn)+dt:er=0
3010 =8:IF zk(or)>=dt THEN zk(or)=zk(or)-dt:zk(dn)=zk(dn)+dt:er=0
3020 END SELect 
3030 IF er THEN AT lock+6,16:STRIP 2:PRINT 'ERROR:'!:STRIP 4:INK 0:PRINT 'NO TRANSFER':PAUSE:AT lock+6,16:STRIP 0:PRINT FILL$(' ',20):lock=lock-1
3040 END DEFine 
3050 DEFine PROCedure offence:att=att+1:IF zl(att)<>2 THEN wa=RND(za(2)/20000)*1000:wb=RND(zb(2)/20000)*1000:wd=RND(zd(z)/20000)*1000:a0=wa:a1=wb:a2=wd:za(2)=za(2)-wa:zb(2)=zb(2)-wb:zd(2)=zd(2)-wd:ad=att:PRINT #16,'System '&astre$(ad)\'Under attack':attack
3060 FOR i=1 TO 32
3070 IF zl(i)=2 THEN za(i)=za(i)+za(2)/60:zb(i)=zb(i)+zb(2)/60:zc(i)=zc(i)+zc(2)/60:zd(i)=zd(i)+zd(2)/60:ze(i)=ze(i)+ze(2)/60:za(2)=za(2)*59/60:zb(2)=zb(2)*59/60:zc(2)=zc(2)*59/60:zd(2)=zd(2)*59/60:ze(2)=ze(2)*59/60
3080 END FOR i
3090 IF NOT victory THEN RETurn 
3100 zl(ad)=2:BLOCK #17,4,3,(zo(ad)-1)*4,(zp(ad)-1)*3,2:victory=0:PRINT #16,'System'!astre$(ad)\'Has surrendered.'
3110 IF zl(32)=2 THEN write 'You have failed your mission.':kb:STOP
3120 END DEFine 
3130 DEFine PROCedure write(m$):RECOL #13,0,1,0,3,4,5,6,7:SCROLL #13,-10:STRIP #13,2:AT #13,4,0:PRINT #13,m$:END DEFine 
3140 DEFine PROCedure f9
3150 AT 0,0:STRIP 2:INK 7:OVER 0:PRINT season$!'SEASON':STRIP 0
3160 BLOCK 150,86,144,7,4:AT 1,24:OVER -1:PRINT ' Population:'!nm$(zj(am))\,,,' Assets: '!nm$(zf(am))\,,,' Grain:  '!nm$(zk(am))\\,,,' Satellites:'!nm$(zc(am))\,,,' Aircraft:  '!nm$(za(am))\,,,' Lasers:    '!nm$(ze(am))\,,,' Mega Ships '!nm$(zb(am)):OVER 0
3170 PAPER #16,2:INK #16,7:CLS #16:OVER #16,1:PRINT #16,' Population:   '!nm$(zj(am))\' Assets:       '!nm$(zf(am))\' Grain:        '!nm$(zk(am))\' Modernity:    '!zg(am)\' Farming Tech.:'!zh(am):INK #16,4
3180 END DEFine 
3190 DEFine PROCedure intel:LOCal c,e:CLS:IF rev=0 THEN or=am:STRIP 4:INK 0::PRINT !astre$(am)!:STRIP 0:INK 7:GO TO 3300
3200 STRIP 2:AT 8,0:PRINT 'Neutral':STRIP 4:INK 2:PRINT 'Allied ':STRIP 6:INK 0:PRINT 'Enemy  ':STRIP 0
3210 c=0:e=0:FOR i=1 TO 4:AT i,0:INK (zl(i)+1)*2:PRINT astre$(i) TO 20:END FOR i:BLOCK 16,40,119,10,4:STRIP 4:INK 0:AT 0,0:PRINT 'DATA ON:','      ':INK 7:STRIP 0
3220 REPeat luck
3230 IF KEYROW(0)=2 THEN CLS:write '':RETurn 
3240 IF KEYROW(1)=64 THEN c=c+1:IF c<5 THEN AT c,20:BLOCK 10,40,119,10,4:OVER 1:INK 0:PRINT CHR$(188):INK 7:OVER 0
3250 IF e>24 AND c=5 THEN GO TO 3210
3260 IF c=5 THEN c=1:e=e+4:FOR i=e+1 TO e+4:INK (zl(i)+1)*2:AT i-e,0:PRINT astre$(i) TO 20:END FOR i:AT c,20:BLOCK 10,40,119,10,4:OVER 1:INK 0:PRINT CHR$(188):INK 7:OVER 0
3270 IF KEYROW(1)=1 AND c>0 THEN or=e+c:EXIT luck
3280 IF e=(am-1) DIV 4 THEN AT am-e,0:STRIP 40:INK 4:PRINT astre$(am):STRIP 0:AT am-e,0:PRINT astre$(am)
3290 END REPeat luck
3300 ka 2:AT 3,16:INK 2:PRINT 'Interceptors:',nm$(za(or))\,,'Ships:',,nm$(zb(or))\,,'Satellites:',nm$(zc(or))\,,'Troops:',,nm$(zd(or))\,,'Lasers:',,nm$(ze(or))\,,'Assets:',,nm$(zf(or))\,,'Morale:',,zi(or)\,,'Population:',nm$(zj(or))\,,'Grain:',,nm$(zk(or))\,,'Position:',zo(or)!zp(or)\,,'Gravity:',zm(or)/10;'g'
3310 a=zl(or):IF a=1 THEN d$='ALLIED'
3320 IF a=2 THEN d$='ENEMY'
3330 IF a=0 THEN d$='NEUTRAL'
3340 AT 2,16:INK 4:PRINT 'Status:'!d$:INK 7:OVER -1:BLOCK 200,128,90,16,2:OVER 0:ka 0:kb:CLS:END DEFine 
3350 DEFine PROCedure lives:liv=liv-1
3360 IF liv<1 THEN FOR i=1 TO 5:write 'No more lives':END FOR i:STOP
3370 write liv&' lives left':END DEFine 
3380 DEFine PROCedure atd:a$=FILL$(' ',37):AT 7,0:PRINT a$;za(or)\a$;zb(or)\a$;zd(or):OVER -1:BLOCK 68,29,220,70,4:OVER 0
3390 AT 7,0:PRINT 'INTERCEPTORS'\'SHIPS'\'SOLDIERS':AT 6,0:STRIP 4:INK 0:PRINT 'CATEGORY:','QUANTITY','     AVAILABLE  ':INK 7:STRIP 0:BLOCK 10,29,82,70,4:dt=0:lbl=29
3400 FOR lock=1 TO 3:src:END FOR lock
3410 ad=dn:write 'NOW ATTACKING '&astre$(ad):CLS:attack
3420 IF NOT victory THEN write 'Attack failed':RETurn 
3430 zl(dn)=1:BLOCK #17,4,3,(zo(dn)-1)*4,(zp(dn)-1)*3,7:victory=0:write 'System '&astre$(dn):write 'Has surrendered'
3440 IF zl(2)=1 THEN CLS:PRINT 'IMPERIA Has finally been toppeled. Congratulations':PAUSE:STOP
3450 END DEFine 
3460 DEFine PROCedure ka(a):POKE 98403,a:END DEFine 
3470 DEFine PROCedure kb(b):PAUSE 50:PAUSE b:END DEFine 
3480 DEFine PROCedure kc(c):IF c=1 THEN BEEP 0,18,0,0,0,0,25,0
3490 IF c=0 THEN BEEP 30000,1,19,69,81,43,29,0
3500 END DEFine 
3510 DEFine PROCedure inputter
3520 AT c+2,27:INPUT q7$:IF q7$='' THEN GO TO 3520
3530 END DEFine 
3540 DEFine FuNction nm$(u):LOCal v$:v$=u:IF ABS(u)>=1000 AND ABS(u)<1E6 THEN v$=INT(u)
3550 IF ABS(u)>=1E6 THEN v$=u/1E6:v$=v$(1 TO 4)&' million'
3560 IF u<1000 THEN v$=INT(u)
3570 IF ABS(u)>=1E9 THEN v$=u/1E9:v$=v$(1 TO 4)&' billion'
3580 IF ABS(u)>=1E12 THEN v$=u/1E12:v$=v$(1 TO 4)&' trillion'
3590 IF ABS(u)>=1E15 THEN v$=u/1E15:v$=v$(1 TO 4)&' quadrillion'
3600 RETurn v$:END DEFine 
3610 OPEN_IN #6,mdv1_stell:CLS:CLS #2:DIM line$(400):nl$=CHR$(10)
3620 FOR i=1 TO 10000:FOR j=1 TO 400:a$=INKEY$(#6,-1):line$(j)=a$:IF a$<>nl$ THEN NEXT j:ELSE AT #2,0,0:PRINT #2,i!j!" ":IF "ka" INSTR line$(1 TO j) THEN PRINT line$(1 TO 30):NEXT i:ELSE NEXT i
