1 rem ***  bare metal lander  ***
2 rem  a demo game for basic64
3 rem  space = burn    a / d = steer    q = quit
4 rem  land on the green pad, slowly, and level.
5 rem  line 30: raise dl if the game runs too fast,
6 rem  lower it if it runs too slow.
10 cls
15 lasttimer=0
20 sw=gramaxx:sh=gramaxy
30 dl=250000
40 dim t(sw)
50 sd=12345
60 ss=int(sw/80):if ss<6 then ss=6
70 hw=int(sw*0.25)
100 rem --- sky: a pure vertical gradient, so erasing is exact ---
110 for y=0 to sh-1
120 f=y/(sh-1)
130 r=4+f*56:g=4+f*30:b=22+f*48
140 line (0,y)-(sw-1,y),r,g,b
150 next y
200 rem --- terrain: lehmer random walk (no rnd needed) ---
210 py=sh*0.72
220 for x=0 to sw-1
230 sd=(sd*75+74) mod 65537
240 py=py+(sd/65537-0.5)*7
250 if py>sh-14 then py=sh-14
260 if py<sh*0.5 then py=sh*0.5
270 t(x)=py
280 next x
290 rem --- flatten a landing pad ---
300 sd=(sd*75+74) mod 65537
310 px=int(sw*0.15+sd/65537*sw*0.6)
320 pw=int(sw/14)
330 ph=t(px)
340 for x=px to px+pw:t(x)=ph:next x
350 rem --- paint the ground ---
360 for x=0 to sw-1
370 r=64:g=58:b=72
380 if x<px then goto 410
390 if x>px+pw then goto 410
400 r=30:g=210:b=130
410 line (x,t(x))-(x,sh-1),r,g,b
420 next x
430 rem --- ship state ---
440 x=sw*0.12:y=sh*0.10
450 vx=0.55:vy=0
460 gv=0.011
470 fu=1000
480 fl=0:ofl=0
490 sx=x:sy=y:fd=0:cr=235:cg=235:cb=250:fr=255:fg=170:fb=40:gosub 2000
500 rem === main loop ===
510 ox=x:oy=y:ofl=fl
520 k$=inkey$
530 if k$="q" then goto 1600
540 fl=0
550 if k$=" " then fl=1
560 if k$="a" then vx=vx-0.10
570 if k$="d" then vx=vx+0.10
580 if fl=0 then goto 610
590 if fu<=0 then fl=0:goto 610
600 vy=vy-0.34:fu=fu-11
610 vy=vy+gv
620 x=x+vx:y=y+vy
630 if x<ss then x=ss:vx=0
640 if x>sw-1-ss then x=sw-1-ss:vx=0
650 if y<ss then y=ss:vy=0
660 rem --- erase the old ship in sky colour ---
670 f=oy/(sh-1):cr=4+f*56:cg=4+f*30:cb=22+f*48:fr=cr:fg=cg:fb=cb
680 sx=ox:sy=oy:fd=ofl:gosub 2000
690 rem --- ground contact? ---
700 gy=t(int(x))
710 if y+ss>=gy then goto 1000
720 rem --- draw the new ship ---
730 cr=235:cg=235:cb=250:fr=255:fg=170:fb=40
740 sx=x:sy=y:fd=fl:gosub 2000
750 rem --- gauges (filled with stacked lines) ---
755 for i=12 to 26
756 line (12,i)-(12+hw,i),18,18,26
757 next i
760 for i=34 to 48
761 line (12,i)-(12+hw,i),18,18,26
762 next i
765 lf=fu/1000:if lf<0 then lf=0
770 r=250-lf*220:g=40+lf*200:b=60
775 if lf<=0 then goto 800
780 for i=12 to 26
781 line (12,i)-(12+hw*lf,i),r,g,b
782 next i
800 av=vy:if av<0 then av=-av
805 lv=av/2.4:if lv>1 then lv=1
810 r=60:g=230:b=110
815 if av>1.2 then r=250:g=60:b=60
820 for i=34 to 48
821 line (12,i)-(12+hw*lv,i),r,g,b
822 next i
830 tk=12+hw*0.5
835 line (tk,32)-(tk,50),255,255,255
840 r=60:g=230:b=110
850 if av>1.2 then r=250:g=60:b=60
860 line (12,34)-(12+hw*lv,48),r,g,b
870 tk=12+hw*0.5
880 line (tk,32)-(tk,50),255,255,255
890 td=0.01:gosub 4000
900 goto 500
1000 rem === touchdown ===
1010 y=gy-ss
1020 av=vy:if av<0 then av=-av
1030 ah=vx:if ah<0 then ah=-ah
1040 ok=1
1050 if av>1.2 then ok=0
1060 if ah>0.55 then ok=0
1070 if int(x)<px then ok=0
1080 if int(x)>px+pw then ok=0
1090 if ok=0 then goto 1200
1100 rem --- landed ---
1110 for n=1 to 4
1120 cr=255:cg=215:cb=90:fr=cr:fg=cg:fb=cb:sx=x:sy=y:fd=0:gosub 2000
1130 td=0.06:gosub 3000
1140 f=y/(sh-1):cr=4+f*56:cg=4+f*30:cb=22+f*48:fr=cr:fg=cg:fb=cb:gosub 2000
1150 td=0.06:gosub 3000
1160 next n
1170 cr=255:cg=215:cb=90:fr=cr:fg=cg:fb=cb:gosub 2000
1180 locate 5,1:print "down safe. fuel remaining:";fu
1190 end
1200 rem --- crash ---
1210 for n=1 to 50
1220 rd=n*ss*0.4
1230 r=255:g=220-n*4:b=80-n*2
1240 if g<0 then g=0
1250 if b<0 then b=0
1260 for i=0 to 11
1270 aa=i*0.5236
1280 line (x,y)-(x+rd*cos(aa),y+rd*sin(aa)),r,g,b
1290 next i
1300 td=0.005:gosub 3000
1310 next n
1315 locate 5,1
1320 print "you are a new crater."
1330 end
1600 locate 5,1:print "flight aborted."
1610 end
2000 rem === draw lander at sx,sy in cr,cg,cb ===
2010 line (sx-ss,sy)-(sx,sy-ss),cr,cg,cb
2020 line (sx,sy-ss)-(sx+ss,sy),cr,cg,cb
2030 line (sx+ss,sy)-(sx-ss,sy),cr,cg,cb
2040 line (sx-ss,sy)-(sx-ss,sy+ss),cr,cg,cb
2050 line (sx+ss,sy)-(sx+ss,sy+ss),cr,cg,cb
2060 if fd=0 then goto 2090
2070 line (sx-ss/2,sy+ss)-(sx,sy+ss*2),fr,fg,fb
2080 line (sx+ss/2,sy+ss)-(sx,sy+ss*2),fr,fg,fb
2090 return
3000 tim=timer
3010 tim2=timer
3020 if tim2-tim<td then goto 3010
3030 return
4000 tim2=timer
4010 if tim2-lasttimer<td then goto 4000
4015 lasttimer=timer
4020 return
