save image "pic3.bmp"

'lunar lander vga 640x480
 OPTION EXPLICIT
 OPTION BASE 1
 option autorun on
 'landscape data
 dim integer lx(43)=(0,5,9,13,3,18,25,30,48,53,57,47,32,11,5,9,57,89,108,149,170,220,262,300,320,400,447,493,510,545,572,600,638,605,590,577,560,513,495,470,457,500,639)
 dim integer ly(43)=(9,17,15,25,40,70,100,130,130,160,193,253,298,346,420,430,430,400,370,457,450,400,440,466,424,400,460,460,452,403,373,320,240,210,190,170,130,120,137,110,60,26,9)
 dim integer l,o,fno,fnc,spnum,k,spc
 dim lander_x,lander_y,last_lander_x,last_lander_y,gravity,inertia,antigravity,fuel
 lander_x=260:lander_y=10:gravity=0.0001:inertia=0:fuel=100
 '
 mode 1
 
 cls
 '
 sprites 'set up lander sprites
 text 170,180,"d         a         g         s         f" 'keys
 for l=1 to 6
   sprite WRITE l,l*80,200 'draw all sprites
 NEXT
 '
 text 210,120,"Press any key to start"
 do:loop until inkey$<> ""
 '
 FRAMEBUFFER CREATE F
 FRAMEBUFFER WRITE f
 cls RGB(black)
 Line GRAPH lx(),ly()'draw landscape
 '
 text 0,470,"FUEL"
 spnum=1
 '--------------------------------------
 do
   if fuel>0 then
     text 48,470,str$(fuel)," "
     k = asc(inkey$)
     if k then 'key presses
       spc=20 'set counts until no flame
       select case k
         Case 100 'd up
           spnum=2
           gravity=gravity-.005
           inc fuel,-.8
         Case 115 's left
           spnum=5
           inertia=inertia-0.005
           inc fuel,-.4
         Case 102 'f right
           spnum=6
           inertia=inertia+0.005
           inc fuel,-.4
         case 103  'g up/right
           spnum=4
           inertia=inertia+0.005
           gravity=gravity-.005
           inc fuel,-1.2
         case 97  'a up/left
           spnum=3
           inertia=inertia-0.005
           gravity=gravity-.005
           inc fuel,-1.2
       end select
     endif
   end if
'
   last_lander_x=lander_x:last_lander_y=lander_y
   lander_y=lander_y+gravity
   lander_x=lander_x+inertia
   gravity=gravity+.00015
   '
'has lander landed, check 2 pixels under each foot all lit
   if pixel(lander_x,lander_y+40)=rgb(white) then
    if pixel(lander_x+3,lander_y+40)=rgb(white) then
     if pixel(lander_x+23,lander_y+40)=rgb(white) then
      if pixel(lander_x+27,lander_y+40)=rgb(white) then text 240,150, "Landed": framebuffer COPY f,N:end'--------
      end if
     end if
    end if  
   end if
'
'has lander hit landscape, check pixels around it, any lit crashed
   o=pixel(lander_x,lander_y)+pixel(lander_x,lander_y+10)+pixel(lander_x,lander_y+20)+pixel(lander_x,lander_y+30)+pixel(lander_x,lander_y+40)+pixel(lander_x+29,lander_y)
   o=o+pixel(lander_x+29,lander_y+10)+pixel(lander_x+29,lander_y+20)+pixel(lander_x+29,lander_y+30)+pixel(lander_x+29,lander_y+40)+pixel(lander_x+7,lander_y)
   o=o+pixel(lander_x+14,lander_y)+pixel(lander_x+21,lander_y)+pixel(lander_x+7,lander_y+39)+pixel(lander_x+14,lander_y+39)+pixel(lander_x+21,lander_y+39)
   if o>0 then explode:end'--------
'
inc spc,-1:if spc<1 then spnum=1 'no flame if no nav key pressed
inc fnc: if fnc=10 then fnc=0:fno=not fno 'which lander for animation if spc>0
box last_lander_x,last_lander_y,30,39,,0,0 'erase lander
if fno=0 then
 sprite WRITE 1,lander_x,lander_y 'draw noflame lander
else
 sprite WRITE spnum,lander_x,lander_y  'draw flame lander if nav key pressed
end if
'
framebuffer COPY f,N
pause 10
loop
end
'
sub sprites
 ship
 sprite READ 1,86,88,28,39'no flame
'
 ship
 triangle 96,114,100,126,104,114,1'flame straight
 sprite READ 2,86,88,28,39
'
 ship
 triangle 96,114,100,126,104,114,1'flame straight
 triangle 107,107,113,110,107,112,1'right thrust
 sprite READ 3,86,88,28,39
'
 ship
 triangle 96,114,100,126,104,114,1'flame straight
 triangle 92,107,86,110,92,113,1'left thrust
 sprite READ 4,86,88,28,39
'
 ship
 triangle 107,107,113,110,107,112,1'right thrust
 sprite READ 5,86,88,28,39
'
 ship
 triangle 92,107,86,110,92,113,1'left thrust
 sprite READ 6,86,88,28,39
 cls
end sub
'
sub ship'draw ship
 cls
 circle 100,98,8
 box 92,106,16,8
 line 92,114,88,126
 line 107,114,111,126
 line 86,126,90,126
 line 109,126,113,126
end sub
'
sub explode
for o=1 to 24
 circle lander_x+15,lander_y+20,o,1,1,rgb(white)
 framebuffer COPY f,N
 pause 20
next
for o=1 to 24
 circle lander_x+15,lander_y+20,o,1,1,rgb(black)
 framebuffer COPY f,N
 pause 20
next
end sub