REM Project: Coding Challenges
REM Created: 13/12/2005 12:32:16
REM
REM ***** Main Source File *****
REM
 
`**Lunar Lander**
Sync on : Sync rate 60
Set Display Mode 1024,768,16 : Hide Mouse
set text to normal : set text size 12
 
`Loading Message
start:
ink rgb(255,255,255),0
text 10,10,"Loading..."
sync
 
`World
Setup_World(0.01)
create bitmap 1,screen width(),screen height() : set current bitmap 1
dim HMap(20) : land=rnd(14)+2
for l=1 to 20
if l=land then HMap(l)=HMap(l-1)
if l<>land
random:
HMap(l)=rnd(160)+440
if HMap(l)=HMap(l-1) then goto random
endif
if l=1
ink rgb(255,193,9),0
line 0,440,l*64,HMap(l)
else
line (l-1)*64,HMap(l-1),l*64,HMap(l)
endif
next l
Get Image 10,0,0,bitmap width(1),bitmap height(1)
create bitmap 2,screen width(),screen height() : set current bitmap 2
for y=1 to 500
paste image 10,0,y,1
next y
get image 1,0,0,bitmap width(2),bitmap height(2) : delete image 10
set current bitmap 1 : delete bitmap 2
set current bitmap 0 : delete bitmap 1
 
`Player
Setup_Ship(0.1,0.01,5,5)
x#=screen width()/2-(sizex(1)/2)
y#=sizey(1)
xfrc#=0.0 : yfrc#=0.0
 
`Messages
dim mess$(1)
mess$(0)="You Crashed!"
mess$(1)="Nice Landing!"
set text size 30 : set text to bold
ending=0
ink rgb(0,128,255),0
 
`HUD Vector
hud=Make Vector2(1)
 
`**Main Loop**
Do
Cls
 
`Store old positions
oldx#=x#-velx# : oldy#=y#-vely#
 
`Control Keys
   If upkey()=1 then up=1 else up=0
   if downkey()=1 then down=1 else down=0
   if rightkey()=1 then right=1 else right=0
   if leftkey()=1 then left=1 else left=0
 
`Physics
if up=1 then yfrc#=weight(1)-thrust(1)
if down=1 then yfrc#=thrust(1)+weight(1)
if left=1 then xfrc#=-thrust(1)
if right=1 then xfrc#=thrust(1)
if up=0 and down=0 then yfrc#=weight(1)
if left=0 and right=0 then xfrc#=0.0
XAcc#=XFrc#/Mass(1) : YAcc#=yfrc#/Mass(1)
XVel#=XVel#+XAcc# : YVel#=YVel#+YAcc#
X#=X#+XVel# : Y#=Y#+YVel#
 
`Update
If X#<-sizex(1) then X#=Screen Width()
If X#>Screen Width()+sizex(1) then X#=-sizex(1)
If Y#<0 then Y#=0
 
`Draw lander
ink rgb(0,128,255),0
Box x#-sizex(1),y#-sizey(1),x#+sizex(1),y#+sizey(1)
line x#+sizex(1),y#+sizey(1),x#+(sizex(1)*1.5),y#+(sizey(1)*2) : line x#+sizex(1)-1,y#+sizey(1),x#+(sizex(1)*1.5)-1,y#+(sizey(1)*2)
line x#-(sizex(1)*1.5),y#+(sizey(1)*2),x#-sizex(1),y#+sizey(1)-1 : line x#-(sizex(1)*1.5)+1,y#+(sizey(1)*2),x#-sizex(1)+1,y#+sizey(1)-1
 
`Draw Land
Paste image 1,0,0,1
 
`Detect land
if yvel#>1.0 then lspd=0 else lspd=1
below1=point(x#-(sizex(1)+2),y#+(sizey(1)*2)+1)
below2=point(x#,y#+((sizey(1)*2)+1))
below3=point(x#+(sizex(1)+2),y#+(sizey(1)*2)+1)
if below1>0 or below2>0 or below3>0 then coll=1 else coll=0
if below1>0 and below2>0 and below3>0 then land=1 else land=0
if below1>0 then x#=oldx# : y#=oldy# : xfrc#=xfrc#*0.0 : yfrc#=yfrc#*0.0
if coll=1
   if land=0 or lspd=0
      landable=0
   endif
   if land=1 and lspd=1
      landable=1
   endif
endif
 
`Show message
if coll=1
   center text screen width()/2,screen height()/2,mess$(landable)
   inc ending : if ending>60 then cls : goto start
endif
 
`fire
ink rgb(255,255,0),0
if up=1
   line x#-(sizex(1)/2),y#+(sizey(1)),x#,y#+(sizey(1)*2)
   line x#+(sizex(1)/2),y#+(sizey(1)),x#,y#+(sizey(1)*2)
endif
 
`HUD
ink rgb(255,0,0),0
set text size 10 : set text to normal
circle inx#,iny#,length vector2(1)
circle inx#,iny#,5
xvec#=xvel#*20 : yvec#=yvel#*20
set vector2 1, xvec#, yvec#
line inx#,iny#,inx#+x vector2(1),iny#+y vector2(1) : circle inx#+x vector2(1),iny#+y vector2(1),5
speed#=length vector2(1)
center text inx#,iny#+length vector2(1)+5,"Speed: "+str$(int(speed#))
if speed#>100 then inx#=speed# : iny#=speed#
if speed#<100 then inx#=100 : iny#=100
ink rgb(0,0,255),0
if xvel#<0 and yvel#<0
   line_box(inx#-speed#,iny#-speed#,inx#,iny#)
endif
if xvel#>0 and yvel#<0
   line_box(inx#+speed#,iny#-speed#,inx#,iny#)
endif
if xvel#<0 and yvel#>0
   line_box(inx#-speed#,iny#+speed#,inx#,iny#)
endif
if xvel#>0 and yvel#>0
   line_box(inx#+speed#,iny#+speed#,inx#,iny#)
endif
 
`**End Loop**
Sync
Loop
 
 
`**Functions**
Function Setup_World(grav as float)
Dim Grav(1) as float : Grav(1)=grav
Endfunction
 
Function Setup_Ship(mass as float,thrust as float,sizex,sizey)
dim mass(1) as float : dim thrust(1) as float : dim weight(1) as float : dim sizex(1) : dim sizey(1)
mass(1)=mass : thrust(1)=thrust : weight(1)=mass(1)*grav(1) : sizex(1)=sizex : sizey(1)=sizey
endfunction
 
Function Line_Box(x1,y1,x2,y2)
line x1,y1,x2,y1 : line x1,y2,x2,y2
line x1,y1,x1,y2 : line x2,y1,x2,y2
endfunction