Sorry your browser is not supported!

set display mode 1280, 1024, 32
sync on
sync rate 0
color backdrop 0
autocam off


set directional light 0, -1, -1, -1
set ambient light 10



make object box 100, 100, 1, 10
position object 100, 0, 0, 0


`Make the base
make object box 1, 2.5, 0.2, 2.5
make mesh from object 1, 1
delete object 1

`Make top
make object cone 1, 2
add limb 1, 1, 1
offset limb 1, 1, 0, -1.5, 0
scale limb 1, 0, 100, 150, 100

color object 1, 0xC05A00







make memblock 1, 12 + (32*32*4)
write memblock dword 1, 0, 32
write memblock dword 1, 4, 32
write memblock dword 1, 8, 32
for i = 12 to get memblock size(1)-1 step 4
   write memblock dword 1, i, 0x11FF7777
next i
make image from memblock 1, 1
delete memblock 1


make particles 1, 1, 1, 10
rotate particles 1, 0, 0, 180
set particle floor 1, 0
set particle life 1, 2
set particle gravity 1, -1



type ShipData
   x#
   y#
   sx#
   sy#
   ang#
   tang#
   thrust#
endtype

SD as ShipData
SD.x# = 0.0
SD.y# = 10.0
SD.ang# = 0.0
SD.tang# = 0.0
SD.thrust# = 0.0

position object 1, SD.x#, SD.y#, 0.0





position camera 0, 10, 50
point camera 0, 10, 0
frameTime# = 1.0
startTime = timer()
do
   frameTime# = (frameTime# * 0.2) + ((timer() - startTime) * 0.8)
   startTime = timer()
   text 0, 0, "FPS: " + str$(screen fps())
   text 0, 10, "x: " + str$(SD.x#)
   text 0, 20, "y: " + str$(SD.y#)

   if leftkey()
      dec SD.tang#, frameTime# * 0.090
   else
      if rightkey()
         inc SD.tang#, frameTime# * 0.090
      endif
   endif



   if spacekey()
      SD.thrust# = curvevalue(5.0, SD.thrust#, 200.0 / frameTime#)
   else
      SD.thrust# = curvevalue(0.0, SD.thrust#, 200.0 / frameTime#)
   endif


   SD.ang# = curvevalue(SD.tang#, SD.ang#, 100.0 / frameTime#)

   inc SD.sx#, -sin(SD.ang#) * SD.thrust# * frameTime# * 0.005
   inc SD.sy#, (cos(SD.ang#) * SD.thrust# * frameTime# * 0.005) - (frameTime# * 0.0098)

   if SD.y# <= 2.5 AND SD.sy# < 0 then SD.sy# = 0 : SD.y# = 2.5

   inc SD.x#, SD.sx# * frameTime# * 0.001
   inc SD.y#, SD.sy# * frameTime# * 0.001
   position object 1, SD.x#, SD.y#, 0

   screenX# = object screen x(1)
   if screenX# < 0              then SD.x# = -SD.x#
   if screenX# > screen width() then SD.x# = -SD.x#





   rotate object 1, 0, 0, SD.ang#
   set particle speed 1, frameTime# * 0.0002
   set particle velocity 1, SD.thrust#
   position particles 1, SD.x#, SD.y#, 0
   position particle emissions 1,  0.0, 1.5, 0.0
   rotate particles 1, 0, 0, 180 + SD.ang#
   sync
loop

set display mode 1280, 1024, 32
sync on
sync rate 0
color backdrop 0
autocam off
randomize timer()


set directional light 0, -1, -1, -1
set ambient light 10



make object box 100, 100, 1, 10
position object 100, 0, 0, 0


`Make the base
make object box 1, 2.5, 0.2, 2.5
make mesh from object 1, 1
delete object 1

`Make top
make object cone 1, 2
add limb 1, 1, 1
offset limb 1, 1, 0, -1.5, 0
scale limb 1, 0, 100, 150, 100
`Make it cone coloured
color object 1, 0xC05A00




`Tractor beam
make object triangle 20, 0, 0, 0,     0, 0, 0,    0, 1, 0
set object wireframe 20, 1
set object emissive 20, 0xFF0000
position object 20, 0, 10, 0
hide object 20




















make memblock 1, 12 + (32*32*4)
write memblock dword 1, 0, 32
write memblock dword 1, 4, 32
write memblock dword 1, 8, 32
for i = 12 to get memblock size(1)-1 step 4
   write memblock dword 1, i, 0x11FF7777
next i
make image from memblock 1, 1
delete memblock 1


make particles 1, 1, 1, 10
rotate particles 1, 0, 0, 180
set particle floor 1, 0
set particle life 1, 2
set particle gravity 1, -1



type RogueCone
   x#
   y#
   sx#
   sy#
   ang#
   tang#
   thrust#
endtype


`RCs(1) is the player, 2+ are rogue cones
Dim RCs(5) as RogueCone
for i = 1 to array count(RCs())
   if i = 1
      RCs(1).x# = 0.0
      RCs(1).y# = 10.0
   else
      RCs(i).x# = rnd(50) - 25
      RCs(i).y# = 2.5
      instance object i, 1
`      color object i, 0x0000FF
   endif

   RCs(i).sx# = 0
   RCs(i).sy# = 0
   RCs(i).ang# = 0
   RCs(i).tang# = 0
   RCs(i).thrust# = 0


   position object i, RCs(i).x#, RCs(i).y#, 0.0
next i










null = make vector2(1)

position camera 0, 10, 50
point camera 0, 10, 0
frameTime# = 1.0
startTime = timer()
do
   frameTime# = (frameTime# * 0.2) + ((timer() - startTime) * 0.8)
   startTime = timer()
   text 0, 0, "FPS: " + str$(screen fps())
   text 0, 10, "x: " + str$(RCs(1).x#)
   text 0, 20, "y: " + str$(RCs(1).y#)


   `This is for the tractor beam
   if shiftkey()
      if object visible(20)

      else
         show object 20

         len# = 2000000.0
         id = 2
         for i = 2 to array count(RCs())
            set vector2 1, RCs(1).x# - object position x(i), object position y(i) - RCs(1).y#
            templen# = length vector2(1)
            if templen# < len# then id = i : len# = templen#
         next i
      endif

      set vector2 1, RCs(1).x# - object position x(id), object position y(id) - RCs(1).y#

      position object 20, RCs(1).x#, RCs(1).y#, 0
      rotate object 20, 0, 0, atanfull(x vector2(1), y vector2(1))
      scale object 20, 100, 100 * length vector2(1), 100
   else
      hide object 20
   endif








   `This is for rotating your craft
   if leftkey()
      dec RCs(1).tang#, frameTime# * 0.090
   else
      if rightkey()
         inc RCs(1).tang#, frameTime# * 0.090
      endif
   endif



   `This for thrust
   if spacekey()
      RCs(1).thrust# = curvevalue(5.0, RCs(1).thrust#, 100.0 / frameTime#)
   else
      RCs(1).thrust# = curvevalue(0.0, RCs(1).thrust#, 100.0 / frameTime#)
   endif




   `Smooth the rotation
   RCs(1).ang# = curvevalue(RCs(1).tang#, RCs(1).ang#, 100.0 / frameTime#)



   `Change speed based on thrust, angle and frame time
   inc RCs(1).sx#, -sin(RCs(1).ang#) * RCs(1).thrust# * frameTime# * 0.005
   inc RCs(1).sy#,  cos(RCs(1).ang#) * RCs(1).thrust# * frameTime# * 0.005

   `If the tractor beam is on, pull the craft that way
   if object visible(20)
      inc RCs(1).sx#, x vector2(1) * frameTime# * -0.001
      inc RCs(1).sy#, y vector2(1) * frameTime# * 0.001

      inc RCs(id).sx#, x vector2(1) * frameTime# * 0.001
      inc RCs(id).sy#, y vector2(1) * frameTime# * -0.001
   endif







   `This is gloabl for all cones
   for i = 1 to array count(RCs())
      `Check if "landed"
      if RCs(i).y# <= 2.5
         if RCs(i).sy# <= 0
            `Stop moving down
            RCs(i).sy# = 0
            `Set at land height
            RCs(i).y# = 2.5
         endif
         `Decelerate X
         RCs(i).sx# = curvevalue(0, RCs(i).sx#, 1000.0 / frameTime#)
      else
         inc RCs(i).sy#, frameTime# * -0.0098
      endif


      `Move craft
      inc RCs(i).x#, RCs(i).sx# * frameTime# * 0.001
      inc RCs(i).y#, RCs(i).sy# * frameTime# * 0.001
      position object i, RCs(i).x#, RCs(i).y#, 0


      `If off screen, swap sides
      screenX# = object screen x(i)
      if screenX# < 0
         RCs(i).x# = -RCs(i).x#
      else
         if screenX# > screen width() then RCs(i).x# = -RCs(i).x#
      endif
   next i






   `Do some object rotation and particle faffing...
   rotate object 1, 0, 0, RCs(1).ang#
   set particle speed 1, frameTime# * 0.0002
   set particle velocity 1, RCs(1).thrust#
   position particles 1, RCs(1).x#, RCs(1).y#, 0
   position particle emissions 1,  0.0, 1.5, 0.0
   rotate particles 1, 0, 0, 180 + RCs(1).ang#
   sync
loop

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
sync
text 10,10,"Loading..."
sync

`World
Setup_World(0.03,0.98)
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(2,0.2,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

`**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)

`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)+1),y#+sizey(1)+1)
below2=point(x#,y#+(sizey(1)+1))
below3=point(x#+(sizex(1)+1),y#+sizey(1)+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

`**End Loop**
Sync
Loop


`**Functions**
Function Setup_World(grav as float, drag as float)
Dim Grav(1) as float : Grav(1)=grav
Dim Drag(1) as float : Drag(1)=drag
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

sync on : sync rate 0 : hide mouse
set display mode 1024,768,32 : autocam off

randomize timer()

global Cam=1
make camera Cam
set current camera Cam
set camera range Cam,0.01,200

make object cube Cam,1
set object cull Cam,1

cls

global Space=2
for i=0 to 5000
   Grey = rnd(180)
   ink rgb(Grey,Grey,Grey),0
   dot rnd(256),rnd(256)
next i
get image 1,0,0,256,256
make object cube Space,200
texture object Space,1
set object cull Space,0
set object ambient Space,0
set object light Space,0

global Moon=3
ink rgb(160,160,160),0
box 0,0,255,255
ink rgb(90,90,90),0
for i=0 to (rnd(4)+10)
   Radius = (rnd(10)+10)
   circle (rnd((255)-Radius*2)+Radius),(rnd((255)-Radius*2)+Radius),Radius
next i
get image 2,0,0,255,255
make object sphere Moon,50,24,24
texture object Moon,2
set object collision to polygons Moon

global Player=4
make object box Player,5,1.5,5
make object sphere 6,5,4,6
scale object 6,100,70,100
make mesh from object 1,6
delete object 6
add limb Player,1,1
delete mesh 1
offset limb Player,1,0,1.5,0
make object cylinder 6,3
scale object 6,15,100,15
make mesh from object 1,6
delete object 6
add limb Player,2,1
add limb Player,3,1
add limb Player,4,1
add limb Player,5,1
delete mesh 1
offset limb Player,2,2.5,-1.5,2.5
offset limb Player,3,2.5,-1.5,-2.5
offset limb Player,4,-2.5,-1.5,2.5
offset limb Player,5,-2.5,-1.5,-2.5
make object cone 6,2
make mesh from object 1,6
delete object 6
add limb Player,6,1
delete mesh 1
offset limb Player,6,0,-1.5,0
color object Player,rgb(255,200,0)
set object cull Player,0
scale object Player,40,60,40
xrotate object Player,270
fix object pivot Player
position object Player,0,0,-55

set ambient light 0
make light Cam
set light range Cam,600

global Plrdist# = 0.0
global PlrZ#=-30.0
global Touchdown=0
global Gravity#=0.0

position object Cam,0,0,-80
point object Cam,0,0,0

#constant RepositionSpace : point object Space,object position x(Cam),object position y(Cam),object position z(Cam)
#constant RepositionMoon : point object Moon,object position x(Cam),object position y(Cam),object position z(Cam)

do
   Plrdist# = intersect object(Moon,0,0,object position z(Player),0,0,0)

   if spacekey()=1 then Gravity# = curvevalue(-0.75,Gravity#,10) : Touchdown=0
   if spacekey()=0 and Plrdist# > abs(object size z(Player)/2) then Gravity# = curvevalue(0.75,Gravity#,10)

   if Plrdist# <= abs(object size z(Player)/2) then Gravity# = 0.0 : PlrZ#=-(25+abs(object size z(Player)/2)) : Touchdown=1

   if rightkey()=1 and Touchdown=0 then point object Cam,0,0,0 : move object left Cam,0.5
   if leftkey()=1 and Touchdown=0 then point object Cam,0,0,0 : move object right Cam,0.5
   if upkey()=1 and Touchdown=0 then point object Cam,0,0,0 : move object down Cam,0.5
   if downkey()=1 and Touchdown=0 then point object Cam,0,0,0 : move object up Cam,0.5

   if Touchdown=0 then inc PlrZ#,Gravity#

   position object Player,0,0,PlrZ#
   position camera Cam,object position x(Cam),object position y(Cam),object position z(Cam)
   set camera to object orientation Cam,Cam
   position light Cam,camera position x(Cam),camera position y(Cam),camera position z(Cam)
   point light Cam,0,0,0

   RepositionSpace : RepositionMoon

   sync
loop

set display mode 1280, 1024, 32
sync on
sync rate 0
color backdrop 0
autocam off
randomize timer()


set directional light 0, -1, -1, -1
set ambient light 10



make object box 100, 150, 1, 10
position object 100, 0, 0, 0


`Make the base
make object box 1, 2.5, 0.2, 2.5
make mesh from object 1, 1
delete object 1

`Make top
make object cone 1, 2
add limb 1, 1, 1
offset limb 1, 1, 0, -1.5, 0
scale limb 1, 0, 100, 150, 100
`Make it cone coloured
color object 1, 0xC05A00




`Tractor beam
make object triangle 20, 0, 0, 0,     0, 0, 0,    0, 1, 0
set object wireframe 20, 1
set object emissive 20, 0xFF0000
position object 20, 0, 10, 0
hide object 20




















make memblock 1, 12 + (32*32*4)
write memblock dword 1, 0, 32
write memblock dword 1, 4, 32
write memblock dword 1, 8, 32
for i = 12 to get memblock size(1)-1 step 4
   write memblock dword 1, i, 0x11FF7777
next i
make image from memblock 1, 1
delete memblock 1


make particles 1, 1, 1, 10
rotate particles 1, 0, 0, 180
set particle floor 1, 0
set particle life 1, 2
set particle gravity 1, -1



type RogueCone
   x#
   y#
   sx#
   sy#
   ang#
   tang#
   thrust#
endtype


`RCs(1) is the player, 2+ are rogue cones
Dim RCs(5) as RogueCone
for i = 1 to array count(RCs())
   if i = 1
      RCs(1).x# = 0.0
      RCs(1).y# = 10.0
   else
      RCs(i).x# = rnd(50) - 25
      RCs(i).y# = 2.5
      instance object i, 1
`      color object i, 0x0000FF
   endif

   RCs(i).sx# = 0
   RCs(i).sy# = 0
   RCs(i).ang# = 0
   RCs(i).tang# = 0
   RCs(i).thrust# = 0


   position object i, RCs(i).x#, RCs(i).y#, 0.0
next i









`Position the camera
cameraX# = 0.0


`Temp vector for the tractor beam
null = make vector2(1)


frameTime# = 1.0
startTime = timer()
do
   frameTime# = (frameTime# * 0.2) + ((timer() - startTime) * 0.8)
   startTime = timer()
   text 0, 0, "FPS: " + str$(screen fps())
   text 0, 10, "x: " + str$(RCs(1).x#)
   text 0, 20, "y: " + str$(RCs(1).y#)


   `Sort out the camera
   cameraX# = curvevalue(RCs(1).x#,   cameraX#,   2000.0 / frameTime#)
   position camera cameraX#, 10, 50
   point camera    cameraX#, 10, 0




   `This is for the tractor beam
   if shiftkey()
      if object visible(20)

      else
         show object 20

         len# = 2000000.0
         id = 2
         for i = 2 to array count(RCs())
            set vector2 1, RCs(1).x# - object position x(i), object position y(i) - RCs(1).y#
            templen# = length vector2(1)
            if templen# < len# then id = i : len# = templen#
         next i
      endif

      set vector2 1, RCs(1).x# - object position x(id), object position y(id) - RCs(1).y#

      position object 20, RCs(1).x#, RCs(1).y#, 0
      rotate object 20, 0, 0, atanfull(x vector2(1), y vector2(1))
      scale object 20, 100, 100 * length vector2(1), 100
   else
      hide object 20
   endif








   `This is for rotating your craft
   if leftkey()
      dec RCs(1).tang#, frameTime# * 0.090
   else
      if rightkey()
         inc RCs(1).tang#, frameTime# * 0.090
      endif
   endif



   `This for thrust
   if spacekey()
      RCs(1).thrust# = curvevalue(5.0, RCs(1).thrust#, 100.0 / frameTime#)
   else
      RCs(1).thrust# = curvevalue(0.0, RCs(1).thrust#, 100.0 / frameTime#)
   endif




   `Smooth the rotation
   RCs(1).ang# = curvevalue(RCs(1).tang#, RCs(1).ang#, 100.0 / frameTime#)



   `Change speed based on thrust, angle and frame time
   inc RCs(1).sx#, -sin(RCs(1).ang#) * RCs(1).thrust# * frameTime# * 0.005
   inc RCs(1).sy#,  cos(RCs(1).ang#) * RCs(1).thrust# * frameTime# * 0.005

   `If the tractor beam is on, pull the craft that way
   if object visible(20)
      inc RCs(1).sx#, x vector2(1) * frameTime# * -0.001
      inc RCs(1).sy#, y vector2(1) * frameTime# * 0.001

      inc RCs(id).sx#, x vector2(1) * frameTime# * 0.001
      inc RCs(id).sy#, y vector2(1) * frameTime# * -0.001
   endif







   `This is gloabl for all cones
   for i = 1 to array count(RCs())
      `Check if "landed"
      if RCs(i).y# <= 2.5
         if RCs(i).sy# <= 0
            `Stop moving down
            RCs(i).sy# = 0
            `Set at land height
            RCs(i).y# = 2.5
         endif
         `Decelerate X
         RCs(i).sx# = curvevalue(0, RCs(i).sx#, 1000.0 / frameTime#)
      else
         inc RCs(i).sy#, frameTime# * -0.0098
      endif


      `Move craft
      inc RCs(i).x#, RCs(i).sx# * frameTime# * 0.001
      inc RCs(i).y#, RCs(i).sy# * frameTime# * 0.001
      position object i, RCs(i).x#, RCs(i).y#, 0


      `If off screen, swap sides
      `screenX# = object screen x(i)
      `if screenX# < 0
      `   RCs(i).x# = -RCs(i).x#
      `else
      `   if screenX# > screen width() then RCs(i).x# = -RCs(i).x#
      `endif
   next i






   `Do some object rotation and particle faffing...
   rotate object 1, 0, 0, RCs(1).ang#
   set particle speed 1, frameTime# * 0.0002
   set particle velocity 1, RCs(1).thrust#
   position particles 1, RCs(1).x#, RCs(1).y#, 0
   position particle emissions 1,  0.0, 1.5, 0.0
   rotate particles 1, 0, 0, 180 + RCs(1).ang#
   sync
loop

sync on : sync rate 0 : hide mouse
set display mode 1024,768,32 : autocam off

randomize timer()

global Cam=1
make camera Cam
set current camera Cam
set camera range Cam,0.01,200

make object cube Cam,1
set object cull Cam,1

global Person=2
make camera Person
xrotate camera Person,270
set camera range Person,0.0001,200

cls

global Space=2
for i=0 to 5000
   Grey = rnd(180)
   ink rgb(Grey,Grey,Grey),0
   dot rnd(256),rnd(256)
next i
get image 1,0,0,256,256
make object cube Space,200
texture object Space,1
set object cull Space,0
set object ambient Space,0
set object light Space,0

global Moon=3
ink rgb(160,160,160),0
box 0,0,255,255
ink rgb(90,90,90),0
for i=0 to (rnd(10)+10)
   Radius = (rnd(10)+10)
   circle (rnd((255)-Radius*2)+Radius),(rnd((255)-Radius*2)+Radius),Radius
next i
for i=0 to 2000
   dot rnd(255),rnd(255)
next i
get image 2,0,0,255,255
make object sphere Moon,50,24,24
texture object Moon,2
set object collision to polygons Moon

global Player=4
make object box Player,5,1.5,5
make object sphere 6,5,4,6
scale object 6,100,70,100
make mesh from object 1,6
delete object 6
add limb Player,1,1
delete mesh 1
offset limb Player,1,0,1.5,0
make object cylinder 6,3
scale object 6,15,100,15
make mesh from object 1,6
delete object 6
add limb Player,2,1
add limb Player,3,1
add limb Player,4,1
add limb Player,5,1
delete mesh 1
offset limb Player,2,2.4,-1.5,2.4
offset limb Player,3,2.4,-1.5,-2.4
offset limb Player,4,-2.4,-1.5,2.4
offset limb Player,5,-2.4,-1.5,-2.4
make object cone 6,2
make mesh from object 1,6
delete object 6
add limb Player,6,1
delete mesh 1
offset limb Player,6,0,-1.5,0
color object Player,rgb(255,200,0)
scale object Player,40,60,40
xrotate object Player,270
fix object pivot Player
position object Player,0,0,-55

set ambient light 0
make light Cam
set light range Cam,600

global Plrdist# = 0.0
global PlrZ#=-30.0
global Touchdown=0
global Gravity#=0.0

position object Cam,0,0,-80
point object Cam,0,0,0

ink rgb(0,255,0),0

#constant RepositionSpace : point object Space,object position x(Cam),object position y(Cam),object position z(Cam)
#constant RepositionMoon : point object Moon,object position x(Cam),object position y(Cam),object position z(Cam)

do
   Plrdist# = intersect object(Moon,0,0,object position z(Player),0,0,0)

   if spacekey()=1 then Gravity# = curvevalue(-0.75,Gravity#,15) : Touchdown=0
   if spacekey()=0 and Plrdist# > abs(object size z(Player)/2) then Gravity# = curvevalue(0.75,Gravity#,20)

   if Plrdist# <= abs(object size z(Player)/2) then Gravity# = 0.0 : PlrZ#=-(25+abs(object size z(Player)/2)) : Touchdown=1

   if rightkey()=1 and Touchdown=0 then point object Cam,0,0,0 : move object left Cam,0.5
   if leftkey()=1 and Touchdown=0 then point object Cam,0,0,0 : move object right Cam,0.5
   if upkey()=1 and Touchdown=0 then point object Cam,0,0,0 : move object down Cam,0.5
   if downkey()=1 and Touchdown=0 then point object Cam,0,0,0 : move object up Cam,0.5

   if Touchdown=0 then inc PlrZ#,Gravity#

   position object Player,0,0,PlrZ#
   position camera Cam,object position x(Cam),object position y(Cam),object position z(Cam)
   set camera to object orientation Cam,Cam
   position light Cam,camera position x(Cam),camera position y(Cam),camera position z(Cam)
   point light Cam,0,0,0

   position camera Person,0,0,limb position z(Player,6)
   zrotate camera Person,camera angle z(Person)+0.5
   set camera view Person,512-97,0,512+97,120
   center text 512,5,"MODULE CAMERA"

   RepositionSpace : RepositionMoon

   sync
loop

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

GAME_START:
set display mode 1280, 1024, 32
sync on
sync rate 0
backdrop on
color backdrop 0
autocam off
randomize timer()


set directional light 0, -1, -1, -1
set ambient light 10



make object box 100, 150, 1, 10
position object 100, 0, 0, 0


`Make the base
make object box 1, 2.5, 0.2, 2.5
make mesh from object 1, 1
delete object 1

`Make top
make object cone 1, 2
add limb 1, 1, 1
offset limb 1, 1, 0, -1.5, 0
scale limb 1, 0, 100, 150, 100




`Tractor beam
make object triangle 20, 0, 0, 0,     0, 0, 0,    0, 1, 0
set object wireframe 20, 1
set object emissive 20, 0xFF0000
position object 20, 0, 10, 0
hide object 20

















type RogueCone
   x#
   y#
   sx#
   sy#
   ang#
   tang#
   thrust#
   alive as boolean
endtype


`RCs(1) is the player, 2+ are rogue cones
Dim RCs(7) as RogueCone
for i = 1 to array count(RCs())
   if i = 1
      RCs(1).x# = 0.0
      RCs(1).y# = 10.0
      color object i, 0x005AC0
   else
      RCs(i).x# = ((i * 40.0 ) / array count(RCs())) - 26
      RCs(i).y# = 2.5
      clone object i, 1
      color object i, 0xFFC05A00
      RCs(i).alive = 1
   endif

   RCs(i).sx# = 0
   RCs(i).sy# = 0
   RCs(i).ang# = 0
   RCs(i).tang# = 0
   RCs(i).thrust# = 0


   position object i, RCs(i).x#, RCs(i).y#, 0.0
next i









`Position the camera
cameraX# = 0.0
cameraY# = 20.0
#constant CAMERA_SPEED 250.0
#constant CAMERA_MIN_HEIGHT 20.0

`Temp vector for the tractor beam
null = make vector2(1)


frameTime# = 1.0
startTime = timer()
do
   frameTime# = (frameTime# * 0.2) + ((timer() - startTime) * 0.8)
   startTime = timer()
   text 0, 0, "FPS: " + str$(screen fps())
`   text 0, 10, "x: " + str$(RCs(1).x#)
`   text 0, 20, "y: " + str$(RCs(1).y#)


   `Sort out the camera
   cameraX# = curvevalue(RCs(1).x#,   cameraX#,   CAMERA_SPEED / frameTime#)
   if RCs(1).y# > CAMERA_MIN_HEIGHT
      cameraY# = curvevalue(RCs(1).y#,   cameraY#,   CAMERA_SPEED / frameTime#)
   else
      cameraY# = curvevalue(CAMERA_MIN_HEIGHT,   cameraY#,   CAMERA_SPEED / frameTime#)
   endif
   position camera cameraX#, cameraY#, 50
   point camera    cameraX#, (cameraY# + CAMERA_MIN_HEIGHT) * 0.5, 0




   `This is for the tractor beam
   if shiftkey()
      `Ok, we're tractor beaming - lets see what state we're in...
      if object visible(20) = 0
         `Its not visible, so we're initiating it. This means showing it and finding the closest one
         show object 20

         len# = 8388608
         id = 2
         for i = 2 to array count(RCs())
            `Check this one is alive...
            if RCs(i).alive
               set vector2 1, RCs(1).x# - object position x(i), object position y(i) - RCs(1).y#
               templen# = length vector2(1)
               if templen# < len# then id = i : len# = templen#
            endif
         next i
      endif

      `Get the closest one's vector
      set vector2 1, RCs(1).x# - object position x(id), object position y(id) - RCs(1).y#

      `Position, rotate and scale the beam
      position object 20, RCs(1).x#, RCs(1).y#, 0
      rotate object 20, 0, 0, atanfull(x vector2(1), y vector2(1))
      scale object 20, 100, 100 * length vector2(1), 100
   else
      hide object 20
   endif








   `This is for rotating your craft
   if leftkey()
      dec RCs(1).tang#, frameTime# * 0.180
   else
      if rightkey()
         inc RCs(1).tang#, frameTime# * 0.180
      endif
   endif





   `This for thrust
   if spacekey()
      RCs(1).thrust# = curvevalue(10.0, RCs(1).thrust#, 50.0 / frameTime#)
   else
      RCs(1).thrust# = curvevalue(0.0, RCs(1).thrust#, 50.0 / frameTime#)
   endif





   `Smooth the rotation
   RCs(1).ang# = curvevalue(RCs(1).tang#, RCs(1).ang#, 100.0 / frameTime#)



   `Change speed based on thrust, angle and frame time
   inc RCs(1).sx#, -sin(RCs(1).ang#) * RCs(1).thrust# * frameTime# * 0.005
   inc RCs(1).sy#,  cos(RCs(1).ang#) * RCs(1).thrust# * frameTime# * 0.005

   `If the tractor beam is on, pull the craft that way
   if object visible(20)
      multiply vector2 1, 2.0

      inc RCs(1).sx#, x vector2(1) * frameTime# * -0.001
      inc RCs(1).sy#, y vector2(1) * frameTime# * 0.001

      inc RCs(id).sx#, x vector2(1) * frameTime# * 0.001
      inc RCs(id).sy#, y vector2(1) * frameTime# * -0.001
   endif







   `This is gloabl for all cones
   for i = 1 to array count(RCs())
      `text 0, (i+3) * 10, "(sx, sy) : " + str$(RCs(i).sx#) + ", " + str$(RCs(i).sy#)
      `Check if "landed"
      if RCs(i).y# <= 2.5
         if RCs(i).sy# <= 0
            if RCs(i).sy# < -19.6
               `Hit the ground too fast... Kill the cone!!
               if i > 1
                  RCs(i).alive = 0
                  RCs(i).sy# = 0.0
                  RCs(i).y# = 2.5
                  color object i, 0x99000000
                  set object transparency i, 3
               else
                  goto PLAYER_DIED :` I dont normally use GOTO's but this is the end of the game and should cause no issues
               endif
            else
               if RCs(i).sy# < -1.0
                  `Make it bounce a bit...
                  RCs(i).sy# = RCs(i).sy# * (-0.5)
               else
                  `Did not hit the ground quick enough to warrant a bounce...
                  RCs(i).sy# = 0

                  `Set at land height
                  RCs(i).y# = 2.5

                  `Decelerate X
                  RCs(i).sx# = curvevalue(0, RCs(i).sx#, 1000.0 / frameTime#)
               endif
               `End of speed check
            endif
            `End of 'if hit the ground too quick' check
         endif
         `End of 'If going down' check
      else
         `Normal flight gravity
         inc RCs(i).sy#, frameTime# * -0.0098
      endif


      `Move craft
      inc RCs(i).x#, RCs(i).sx# * frameTime# * 0.001
      inc RCs(i).y#, RCs(i).sy# * frameTime# * 0.001
      position object i, RCs(i).x#, RCs(i).y#, 0

      `Rotate cones
      if i = 1
         rotate object 1, 0, 0, RCs(1).ang#
      else
         if i = id
            rotate object i, 0, 0, atanfull(-x vector2(1), -y vector2(1))
         endif
      endif
   next i

   sync
loop





PLAYER_DIED:
make memblock 1, 12 + (screen width() * screen height() * 4)
write memblock dword 1, 0, 1
write memblock dword 1, 4, 1
write memblock dword 1, 8, 32
a = 0
write memblock dword 1, 12, a << 24

make image from memblock 10000, 1
sprite 1, 0, 0, 10000
size sprite 1, screen width(), screen height()

s = timer()
FADE_TIME = 1000
while returnkey() = 0
   `paste image 10000, 0, 0, 1

   if timer() - s < FADE_TIME
      a = ((timer() - s) * 128) / FADE_TIME
      write memblock dword 1, 12, a << 24

      make image from memblock 10000, 1
   else
      msg$ = "You died!!! Press enter to start again or escape to quit"
      text (screen width() - text width(msg$)) * 0.5, (screen height() - text height(msg$)) * 0.5, msg$
   endif

   sync
endwhile

delete memblock 1

for i = 1 to 10000
   if object exist(i) then delete object i
   if image exist(i) then delete image i
next i

flush video memory
goto GAME_START

   `Project: Lander DBPro Challenge
`Coded By: Mike Horton aKa "Skrawl"
`Date Started: 03/02/06
`Date Completed: 03/07/06

sync on:sync rate 0:set display mode 1024,768,16:hide mouse:set window off `Setup Basic Screen Settings
randomize timer()

`VARIABLES!!!
global pX#=510.0                                    `Ship X Position
global pY#=100.0                                    `Ship Y Position
global pT#=0.0                                      `Ship Thrust (Thrust>0 = UP | Thrust<0 = Down)
global pS#=0.0                                      `Ship Strafe (Strafe>0 = Right | Strafe<0 = Left)
global pLives=3                                     `Player Lives - DER!
global level=1                                      `Current Level
global gravity#=0.0                                 `Planet Gravity = Changes Descent And Climb Rate
global fuel=500                                     `Ship Fuel

type linetype                                      `Type For Each Line Segment Of Ground
   p1 as float                                     `X Position 1
   p2 as float                                     `Y Position 1
   p3 as float                                     `X Position 2
   p4 as float                                     `Y Position 2
endtype

type trail
   tX as float
   tY as float
   life as integer
endtype

global dim ground(10) as linetype                `Create Array Of Line Segments To Define Ground
global dim vapor(5) as trail

for n=1 to 5 step 1
   vapor(n-1).life=0
next n

createGround()                                     `Fill In The Array For Ground

gameHelp()

`Main Game Start
do
   drawShip(pX#,pY#)                               `Draw The Ship
   drawGround()                                   `Draw Ground For Current Level
   drawHUD()
   cycleTrail()
   if scancode()=0 or fuel=0                       `If No Keypress
       if pT#>(-3-gravity#) then dec pT#,.1        `If thrust going up, decrement it to start gravity descent
       if pS#>0 then dec pS#,.1                    `If Strafe > 0 decrement Strafe back to 0
       if ps#<0 then inc ps#,.1                    `If Strafe < 0 increment Strafe back to 0
       if ps#=0 then ps#=0                         `If Strafe = 0 then keep it that way, had some wierd strafing without this code
   endif
   pY#=(pY#-pT#)+gravity#                          `Assign Ship Y Coord by subtracting Thrust and adding Gravity
   pX#=(pX#+pS#)                                   `Assign Ship X Coord by adding Strafe
   if pX#<0 then pX#=1024
   if pX#>1024 then pX#=0
   if pY#<=-200
      center text 512,300,"You Left Orbit, Chicken"
      sync
      wait key
      restartLvl()
   endif
   if pY#<0 then center text 512,384,"Warning!, Leaving Orbit"
   if upkey()=1 and fuel>0
         if pT#<5 then inc pT#,.1                  `Increase Thrust
         dec fuel,1                                `Decrease Fuel
         newTrail()
   endif
   if leftkey()=1 and pS#>-5 then dec pS#,.1       `Strafe Left
   if rightkey()=1 and pS#<5 then inc pS#,.1       `Strafe Right
   if getCollision(pX#,pY#+10)               `Check Collision
      if pT#<=-1.0
         restartLvl()
      else
         advanceLvl()
      endif
   endif
   sync
   cls 0
loop
`End Main Loop

function gameHelp()
   set text font "Arial"
   set text size 30
   sync
   ink rgb(0,255,0),0
   center text 512,250,"Lander Remix"
   set text size 20
   ink rgb(200,0,200),0
   center text 512,300,"Welcome To Lander Remix"
   center text 512,320,"Coded By Mike Horton"
   center text 512,340,"Features Unlimited Levels With Increasing Difficulty"
   center text 512,360,"Controls:"
   center text 512,380,"Up - Increase Thrust"
   center text 512,400,"Left/Right - Strafe Ship Left And Right"
   center text 512,420,"Rules:"
   center text 512,440,"Attempt To Land On The Planets Surface"
   center text 512,460,"You May Land Anywhere, But The Flat Spots Are Easier."
   center text 512,480,"Your Fuel Will Decrease As You Thrust"
   center text 512,500,"When You Run Out Of Fuel You Will Crash"
   center text 512,520,"The Planets Gravity Effects How Hard It Is To Climb"
   center text 512,540,"And How Quickly You Go Down"
   center text 512,560,"That Sums It Up, Enjoy!"
   sync
   wait key
endfunction

function newTrail()
   for n=1 to 5 step 1
      if vapor(n-1).life=0
         vapor(n-1).tX=pX#
         vapor(n-1).tY=pY#+20
         vapor(n-1).life=10
         n=5
      endif
   next n
endfunction

function cycleTrail()
   for n=1 to 5 step 1
      if vapor(n-1).life>0
         dec vapor(n-1).life,1
         ink rgb(100,100,100),0
         circle vapor(n-1).tX,vapor(n-1).tY,2
      endif
   next n
endfunction

function createGround()
   ground(0).p1=0
   ground(0).p2=600
   for n=1 to 10 step 1
         temp = rnd(200) + ground(n-1).p1
         do
            change= rnd(300)
               if change<100
                  temp2=ground(n-1).p2-rnd(200)
               endif
               if change>=100 and change <200
                  temp2=ground(n-1).p2
               endif
               if change>=200 and change<=300
                  temp2=ground(n-1).p2+rnd(200)
               endif
               if temp2>=400 and temp2<=650  then exit
         loop
            if n<10
               ground(n-1).p3=temp
               ground(n-1).p4=temp2
            else
               ground(n-1).p3=1024
               ground(n-1).p4=600
            endif
            if n<10
               ground(n).p1=temp
               ground(n).p2=temp2
            endif
   next n
endfunction

function drawShip(x1 as float,y1 as float)
   ink rgb(255,255,255),0
   line x1,y1,(x1-5),(y1+15)
   line (x1-5),(y1+15),(x1+5),(y1+15)
   line (x1+5),(y1+15),x1,y1
endfunction

function drawGround()
   for n=0 to 9
      line ground(n).p1,ground(n).p2,ground(n).p3,ground(n).p4
   next n
endfunction

function getCollision(x1 as float,y1 as float)
   for n=0 to 9 step 1                                         `Step Through Every Line Segment In The Ground Array
      for t#=0.0 to 100.0 step 1.0                             `Used In Getting Each Point Along The Line
         lX#=t#/100                                            `Get Percent
         lX#=lX#*ground(n).p3                          `Get Point At Percent Value Of Line X Coord
         lX#=lX#+ground(n).p1                          `Add First Point To Ensure We're On The Line
         if lX# >= (ground(n).p3) then lX#=ground(n).p3 `Safeguard To Ensure We Dont Go Off The Line
         if (ground(n).p4) = (ground(n).p2) then lY#=ground(n).p4 `If Line Y Coord Doesn't Change, Point Doesn't Either
         if (ground(n).p4) <> (ground(n).p2)   `If Line Y Coord Changes Go Here
            lY#=t#/100                                         `Get Percent
            if (ground(n).p4) > (ground(n).p2) `If Line Y Coords Go Down Do This
               lY#=lY#*ground(n).p4                    `Get Point At Percent Value Of Line Y Coord
               lY#=lY#+ground(n).p2                    `Add First Point To Ensure We're On The Line
               if lY# >= (ground(n).p4) then lY#=ground(n).p4 `Safeguard To Ensure We Don't Go Off The Line
            endif
            if (ground(n).p2) > (ground(n).p4) `If Line Y Coords Go Up Do This
               lY#=lY#*ground(n).p2                    `Get Point At Percent Value Of Line Y Coord
               lY#=ground(n).p2-lY#                    `Subtract First Point From Percent Value To Stay On The Line
               if lY# <= (ground(n).p4) then lY#=ground(n).p4 `Safeguard To Ensure We Don't Go Off The Line
            endif
         endif
         if (x1<=(lX#+5) and x1>=(lX#-5)) and (y1<=(lY#+5) and y1>=(lY#-5)) `See If Collision Has Occured
            exitfunction 1                                                 `Send Out That Collision Has Happened
         endif
      next t#              `Increment T
   next n                  `Goto Next Line Segment
endfunction 0

function restartLvl()
      pLives=pLives-1
      pX#=510.0
      pY#=100.0
      pT#=0.0
      pS#=0.0
      fuel=500
      if pLives>=1
         ink rgb(255,0,0),0
         center text 512,384,"You Crashed!!"
      else
         ink rgb(255,0,0),0
         center text 512,380,"You Lose!"
         center text 512,400,"Press Escape To Run Away, Anything Else To Try Again"
         pX#=510.0
         pY#=100.0
         pT#=0.0
         pS#=0.0
         pLives=3
         level=1
         gravity#=0.0
         fuel=500
      endif
      sync
      wait key
endfunction

function advanceLvl()
   pX#=510.0
   pY#=100.0
   pT#=0.0
   pS#=0.0
   fuel=500
   level=level+1
   if gravity#<2
      inc gravity#,.1
   endif
   ink rgb(0,255,0),0
   center text 512,384,"You Landed!"
   createGround()
   sync
   wait key
endfunction

function drawHUD()
   ink rgb(255,255,0),0
   line 0,720,1024,720
   ink rgb(0,0,255),0
   text 10,740,"Lives: "+str$(pLives)
   text 100,740,"Level: "+str$(level)
   text 200,740,"Current Gravity: +"+str$(gravity#*100)+"%"
   if fuel<=200 then ink rgb(255,0,0),0
   text 400,740,"Fuel: "+str$(fuel)
   if fuel<=200 then text 500,740,"LOW FUEL!"
   if pT#<-1.5
      ink rgb(255,0,0),0
      text 600,740,"SLOW DESCENT!"
   endif
   ink rgb(0,255,0),0
   text 900,740,"Lander Remix"
endfunction

   `Project: Lander DBPro Challenge
`Coded By: Mike Horton aKa "Skrawl"
`Date Started: 03/02/06
`Date Completed: 03/07/06

sync on:sync rate 60:set display mode 1024,768,16:hide mouse:set window off `Setup Basic Screen Settings
randomize timer() `Use System Clock To Get Random Seed, Ensures A Different Game Every Time

`VARIABLES!!!
global pX#=510.0                                    `Ship X Position
global pY#=100.0                                    `Ship Y Position
global pT#=0.0                                      `Ship Thrust (Thrust>0 = UP | Thrust<0 = Down)
global pS#=0.0                                      `Ship Strafe (Strafe>0 = Right | Strafe<0 = Left)
global pLives=3                                     `Player Lives - DER!
global level=1                                      `Current Level
global gravity#=0.0                                 `Planet Gravity = Changes Descent And Climb Rate
global winds#=0.0                                   `Planet Solar Winds = Causes Random Side Movement
global fuel=500                                     `Ship Fuel

global red=128                                      `Logo Color Changer
global green=128
global blue=128

global uX#=0.0
global uY#=300.0
global uO=0

type linetype                                      `Type For Each Line Segment Of Ground
   p1 as float                                     `X Position 1
   p2 as float                                     `Y Position 1
   p3 as float                                     `X Position 2
   p4 as float                                     `Y Position 2
endtype

type trail                                         `Type For Smoke Circle
   tX as float                                     `x Coord
   tY as float                                     `Y Coord
   life as integer                                 `Life Of "Particle"
   size as float                                   `Size of "Particle"
endtype

global dim ground(10) as linetype                `Create Array Of Line Segments To Define Ground
global dim vapor(30) as trail                      `Create Array Of Smoke Trail Circles

for n=1 to 30 step 1                               `Fill In Smoke Array With Starter Variables
   vapor(n-1).life=0
   vapor(n-1).size=3
next n

createGround()                                     `Fill In The Array For Ground

gameHelp()                                         `Display Begining Help Screen

`Main Game Start
do
   if uO=0                                         `If We Dont Draw The UFO
      wee=rnd(50000)                               `Get New Random
   endif
   drawShip(pX#,pY#)                               `Draw The Ship
   if wee<=10 or uO=1                              `If We Draw The UFO Or wee=rnd(50000)<=10
      drawUFO()                                    `Update The UFO
   endif
   drawGround()                                   `Draw Ground For Current Level
   drawHUD()                                       `Draw Our Game HUD
   cycleTrail()                                    `Cycle Through Out Smoke Trail And Update As Necessary
   wind=rnd(1000)                                  `Lets See If We Get Some Wind
   if wind<=100                                    `Blow The Ship From Side To Side!
      inc PS#,rnd(winds#*2)-(winds#)
   endif
   if scancode()=0 or fuel=0                       `If No Keypress
       if pT#>(-3-gravity#) then dec pT#,.1        `If thrust going up, decrement it to start gravity descent
       if pS#>0 then dec pS#,.1                    `If Strafe > 0 decrement Strafe back to 0
       if pS#<0 then inc pS#,.1                    `If Strafe < 0 increment Strafe back to 0
       if ps#=0 then ps#=0                         `If Strafe = 0 then keep it that way, had some wierd strafing without this code
   endif
   pY#=(pY#-pT#)+gravity#                          `Assign Ship Y Coord by subtracting Thrust and adding Gravity
   pX#=(pX#+pS#)                                   `Assign Ship X Coord by adding Strafe
   if pX#<0 then pX#=1024                          `If Ship Goes Of Screen Right, Bring It Back On Screen Left
   if pX#>1024 then pX#=0                          `If Ship Goes Of Screen Left, Bring It Back On Screen Right
   if pY#<=-200                                    `If Ship Goes Too Far Off The Top Of The Screen
      ink rgb(255,0,0),0
      center text 512,300,"You Left Orbit, Chicken"   `Let Them Know What They Did Wrong And How They Should Feel About It
      sync
      wait key
      restartLvl()                                    `Restart The Level And Make Them Feel Even Worse
   endif
   if pY#<0                                           `If Ship Leaves The Top Of The Screen
      ink rgb(255,0,0),0
      center text 512,384,"Warning!, Leaving Orbit"   `Let The Player Know Whats About To Happen
   endif
   if upkey()=1 and fuel>0                         `If Player Is Pushing The Up Arrow Key And The Ships Got Gas
         if pT#<5 then inc pT#,.1                  `Increase Thrust
         dec fuel,1                                `Decrease Fuel
         newTrail()                                `Create A New Smoke Trail
   endif
   if leftkey()=1 and pS#>-5 then dec pS#,.1       `Strafe Left
   if rightkey()=1 and pS#<5 then inc pS#,.1       `Strafe Right
   if getCollision(pX#,pY#+10)               `Check Collision
      tmp#=abs(pS#)                          `Get The Absolute Value Of Strafe, For Some Reason A Negative Number Here Was Annoying
      if pT#<=-1.0 or tmp#>=1.0              `See If The Ship is Moving Too Fast In Any Direction
            restartLvl()                     `If It Is, Kill The Ship And Start The Level Over
      else                                   `If Not
         advanceLvl()                        `Send That Player To The Next Level
      endif
   endif
   sync
   cls 0
loop
`End Main Loop

function gameHelp()
   set text font "Arial"
   set text size 30
   sync
   ink rgb(0,255,0),0
   center text 512,250,"Lander Remix"
   set text size 20
   ink rgb(200,0,200),0
   center text 512,300,"Welcome To Lander Remix"
   center text 512,320,"Coded By Mike Horton"
   center text 512,340,"Features Unlimited Levels With Increasing Difficulty"
   center text 512,360,"Controls:"
   center text 512,380,"Up - Increase Thrust"
   center text 512,400,"Left/Right - Strafe Ship Left And Right"
   center text 512,420,"Rules:"
   center text 512,440,"Attempt To Land On The Planets Surface"
   center text 512,460,"You May Land Anywhere, But The Flat Spots Are Easier."
   center text 512,480,"Your Fuel Will Decrease As You Thrust"
   center text 512,500,"When You Run Out Of Fuel You Will Crash"
   center text 512,520,"The Planets Gravity Effects How Hard It Is To Climb"
   center text 512,540,"And How Quickly You Go Down"
   center text 512,560,"Solar Winds In The Atmoshphere Will Move Your Ship"
   center text 512,580,"From Side To Side, Making Landing Even Tougher"
   center text 512,600,"That Sums It Up, Enjoy!"
   sync
   wait key
endfunction

function newTrail()
   for n=1 to 30 step 1
      if vapor(n-1).life=0          `If Place In Array Is Empty (If The Smoke Circle Isn't Already On Screen)
         vapor(n-1).tX=pX#          `Grab The Smoke X Coord From The Ship
         vapor(n-1).tY=pY#+20       `Grab The Smoke Y Coord From The Ship and Move It Down Some
         vapor(n-1).life=25         `Give The Smoke Some Life (How Many Cycles It Will Stay On Screen)
         vapor(n-1).size=3          `And Set It's Starting Size
         n=30
      endif
   next n
endfunction

function cycleTrail()
   for n=1 to 30 step 1
      if vapor(n-1).life>0          `If The Smoke Hasn't Died Yet
         dec vapor(n-1).life,1      `Take A Life Away
         inc vapor(n-1).tY,3        `Move The Smoke Down
         inc vapor(n-1).size,.1     `Make It A Little Bigger
         ink rgb(vapor(n-1).life*8,vapor(n-1).life*8,vapor(n-1).life*8),0 `Make It A Little Darker
         circle vapor(n-1).tX,vapor(n-1).tY,vapor(n-1).size       `Draw That Puppy
      endif
   next n
endfunction

function createGround()
   ground(0).p1=0                                        `Set The First X Coord Of The First Line
   ground(0).p2=600                                      `Set The First Y Coord Of The First Line
   for n=1 to 10 step 1
         temp = rnd(200) + ground(n-1).p1                `Get Second X Coord
         do
            change= rnd(300)                             `Get Decision Variable
               if change<100                             `If Decision<100
                  temp2=ground(n-1).p2-rnd(200)          `Get Second Y Coord Above First One
               endif
               if change>=100 and change <200            `If Decision>=100 and Decision<200
                  temp2=ground(n-1).p2                   `Get Second Y Coord At The First One Making A Straight Line
               endif
               if change>=200 and change<=300            `If Decision>=200 and change <=300
                  temp2=ground(n-1).p2+rnd(200)          `Get Second Y Coord Below First One
               endif
               if temp2>=400 and temp2<=650  then exit   `If Second Y Coord Is Within Exceptable Range, Then Kick Us Out Of The Loop
         loop
            if n<10                                      `If We Aren't On Our Last Line
               ground(n-1).p3=temp                       `Set Line's Second X Coord
               ground(n-1).p4=temp2                      `Set Line's Second Y Coord
            else                                         `If We Are On The Last Line
               ground(n-1).p3=1024                       `Set Line's Second X Coord
               ground(n-1).p4=600                        `Set Line's Second Y Coord
            endif
            if n<10                                      `If We Aren't On Our Last Line
               ground(n).p1=temp                         `Set Next Lines First X Coord
               ground(n).p2=temp2                        `Set Next Lines First Y Coord
            endif
   next n
endfunction

function drawShip(x1 as float,y1 as float)
   ink rgb(255,255,255),0
   line x1,y1,(x1-5),(y1+15)
   line (x1-5),(y1+15),(x1+5),(y1+15)
   line (x1+5),(y1+15),x1,y1
endfunction

function drawUFO()
   if uO=0
      uY#=rnd(400)
      uX#=0.0
      uO=1
   endif
   inc uX#,1
   if uX#=1024 then uO=0
   ink rgb(255,255,255),0
   ellipse uX#,uY#,15,8
   line uX#-15,uY#-1,uX#+15,uY#-1
   line uX#-15,uY#+1,uX#+15,uY#+1
   for n=-15 to 15 step 3
      ink rgb(rnd(255),rnd(255),rnd(255)),0
      circle uX#+n,uY#,1
   next n

endfunction

function drawGround()
   ink rgb(255,255,255),0
   for n=0 to 9
      line ground(n).p1,ground(n).p2,ground(n).p3,ground(n).p4
   next n
endfunction

function getCollision(x1 as float,y1 as float)
   for n=0 to 9 step 1                                         `Step Through Every Line Segment In The Ground Array
      for t#=0.0 to 100.0 step 1.0                             `Used In Getting Each Point Along The Line
         lX#=t#/100                                            `Get Percent
         lX#=lX#*ground(n).p3                          `Get Point At Percent Value Of Line X Coord
         lX#=lX#+ground(n).p1                          `Add First Point To Ensure We're On The Line
         if lX# >= (ground(n).p3) then lX#=ground(n).p3 `Safeguard To Ensure We Dont Go Off The Line
         if (ground(n).p4) = (ground(n).p2) then lY#=ground(n).p4 `If Line Y Coord Doesn't Change, Point Doesn't Either
         if (ground(n).p4) <> (ground(n).p2)   `If Line Y Coord Changes Go Here
            lY#=t#/100                                         `Get Percent
            if (ground(n).p4) > (ground(n).p2) `If Line Y Coords Go Down Do This
               lY#=lY#*ground(n).p4                    `Get Point At Percent Value Of Line Y Coord
               lY#=lY#+ground(n).p2                    `Add First Point To Ensure We're On The Line
               if lY# >= (ground(n).p4) then lY#=ground(n).p4 `Safeguard To Ensure We Don't Go Off The Line
            endif
            if (ground(n).p2) > (ground(n).p4) `If Line Y Coords Go Up Do This
               lY#=lY#*ground(n).p2                    `Get Point At Percent Value Of Line Y Coord
               lY#=ground(n).p2-lY#                    `Subtract First Point From Percent Value To Stay On The Line
               if lY# <= (ground(n).p4) then lY#=ground(n).p4 `Safeguard To Ensure We Don't Go Off The Line
            endif
         endif
         if (x1<=(lX#+5) and x1>=(lX#-5)) and (y1<=(lY#+5) and y1>=(lY#-5)) `See If Collision Has Occured
            exitfunction 1                                                 `Send Out That Collision Has Happened
         endif
      next t#              `Increment T
   next n                  `Goto Next Line Segment
endfunction 0

function restartLvl()
      pLives=pLives-1
      pX#=510.0
      pY#=100.0
      pT#=0.0
      pS#=0.0
      fuel=500
      if pLives>=1
         ink rgb(255,0,0),0
         center text 512,384,"You Crashed!!"
      else
         ink rgb(255,0,0),0
         center text 512,380,"You Lose!"
         center text 512,400,"Press Escape To Run Away, Anything Else To Try Again"
         pX#=510.0
         pY#=100.0
         pT#=0.0
         pS#=0.0
         pLives=3
         level=1
         gravity#=0.0
         winds#=0.0
         fuel=500
      endif
      sync
      wait key
endfunction

function advanceLvl()
   pX#=510.0
   pY#=100.0
   pT#=0.0
   pS#=0.0
   fuel=500
   level=level+1
   if gravity#<2
      inc gravity#,.1
   endif
   if level=20
      gravity#=0.0
   endif
   if level>=20 and winds#<1
      inc winds#,.1
   endif
   ink rgb(0,255,0),0
   center text 512,384,"You Landed!"
   createGround()
   sync
   wait key
endfunction

function drawHUD()
   ink rgb(0,0,255),0
   text 10,740,"Lives: "+str$(pLives)
   text 100,740,"Level: "+str$(level)
   gTemp=gravity#*100
   text 200,740,"Gravity: +"+str$(gTemp)
   wTemp=winds#*100
   text 300,740,"Winds: "+str$(wTemp)
   text 400,740,"Fuel: "+str$(fuel)
   if fuel<=200
      ink rgb(255,0,0),0
      text 500,740,"LOW FUEL!"
   endif
   if pT#<-1.5
      ink rgb(255,0,0),0
      text 600,740,"SLOW!"
   endif
   inc red,rnd(20)-10
   inc green,rnd(20)-10
   inc blue,rnd(20)-10
   if red<0 then red=0
   if red>255 then red=255
   if blue<0 then blue=0
   if blue>255 then blue=255
   if green<0 then green=0
   if green>255 then green=255
   ink rgb(red,green,blue),0
   line 0,700,1024,700
   line 0,710,1024,710
   line 700,710,700,767
   line 700,767,885,767
   line 700,710,885,710
   line 750,767,750,755
   line 750,755,720,755
   line 720,755,720,710
   line 740,755,740,740
   line 760,767,760,710
   line 730,730,750,730
   line 770,767,770,750
   line 780,710,780,727
   line 790,710,790,767
   line 810,767,820,760
   line 820,760,820,717
   line 820,717,810,710
   line 810,730,810,740
   line 850,767,850,710
   line 850,750,840,750
   line 850,730,840,730
   line 885,767,885,710
   line 870,767,865,750
   line 860,730,870,730
   set text to bold
   ink rgb(255,0,0),0
   text 890,750,"R E M I X"
   set text to normal
endfunction

Rem Project: bearings
Rem Created: 10/03/2006 09:21:27

Rem ***** Main Source File *****

sync on
autocam off
color backdrop 0
position camera 0,0,-50

gosub values
gosub make_planets
gosub make_ship


starttime=timer()
do

time=timer()-starttime
dt=time-oldtime
oldtime=time

gosub controls
gosub collision
gosub physics
sync
loop

values:


angvel#=0.1
thrustvalue#=5
mass#=5000000 `mass of ship
gravconst#=.1

return

make_planets:
numberofplanets=5
dim planet(numberofplanets)
dim planetmass#(numberofplanets)
for n=1 to numberofplanets
planet(n)=free_object()
make object sphere planet(n),rnd(10)+2,20,20
planetmass#(n)=object size x(planet(n))^3
position object planet(n),rnd(40)-20,rnd(40)-20,0
next n
return

make_ship:
ship=free_object()
make object cone ship,1
gosub positionship
return

controls:

if upkey()=1 then thrust#=thrustvalue# else thrust#=0
if leftkey()=1 then dec angle#,angvel#*dt
if rightkey()=1 then inc angle#,angvel#*dt

return

physics:

totalgravx#=0
totalgravy#=0

for n=1 to numberofplanets
  dist#=sqrt((abs(object position x(ship)-object position x(planet(n)))^2)+(abs(object position y(ship)-object position y(planet(n)))^2))
  bearing#=atanfull(-object position x(planet(n))+object position x(ship),-object position y(planet(n))+object position y(ship))
  gravx#=gravityflag*(gravconst#*planetmass#(n)/(dist#^2))*sin(bearing#)
  gravy#=gravityflag*(gravconst#*planetmass#(n)/(dist#^2))*cos(bearing#)
  inc totalgravx#,gravx#
  inc totalgravy#,gravy#
next n

zrotate object ship,-angle#

thrusty#=thrust#*cos(angle#)
thrustx#=thrust#*sin(angle#)

forcey#=thrusty#-totalgravy#
forcex#=thrustx#-totalgravx#

accelerationx#=forcex#/mass#
accelerationy#=forcey#/mass#

inc velocityx#,accelerationx#*dt
inc velocityy#,accelerationy#*dt
inc x#,velocityx#*dt
inc y#,velocityy#*dt
position object ship,x#,y#,0

return

positionship:

x#=rnd(40)-20
y#=rnd(40)-20
z#=0

return

collision:
checkagain:
for n=1 to numberofplanets
collisiondist#=intersect object(planet(n),object position x(ship),object position y(ship),object position z(ship),object position x(planet(n)),object position y(planet(n)),object position z(planet(n)))
if collisiondistance<0
  gosub positionship
  goto checkagain
endif
if collisiondist#=0 then collisiondist#=1000
if collisiondist#<object size x(ship)/2
  gravityflag=0
  velocityx#=0
  velocityy#=0
  goto getoutofloop
else
  gravityflag=1
endif
next n

getoutofloop:

return

function free_object()
repeat
inc n
until object exist(n)=0
endfunction n

gameratemultiplier#=targetfps/screen fps()

gameratemultiplier#=(timer()-time)/targetlatency
time=timer()

Sync On:Sync Rate 0:Autocam Off

#Constant VelMomentum 1
#Constant SpinMomentum 2
#Constant ShipPos 3


Null=Make Vector3(VelMomentum)
Null=Make Vector3(SpinMomentum)
Null=Make Vector3(ShipPos)

Global LastTime as Dword
Global CycleTime as DWord
Global TimeFactor as Float
Global Grav as Float
Global Fric as Float

Grav=-16
Fric=.998

Make_Ship(1)
Position Object 1,0,50,80
Set_Vector_To_Object( ShipPos ,1)
Do
   `Apply spin momentum
   Rotate Object 1, OAX (1) + VX (SpinMomentum), OAY (1) + VY (SpinMomentum), OAZ (1) + VZ (SpinMomentum)

   `Control Ship
   Roll_Object_Left(1, ka * TimeFactor * 0.8 ) : Move Object Up 1, ka * TimeFactor * 20.0
   Set Vector3 SpinMomentum , VX (SpinMomentum), VY (SpinMomentum), VZ (SpinMomentum)+ ka * TimeFactor * 0.8
   Roll_Object_Right(1, kd * TimeFactor * 0.8 ) : Move Object Up 1, kd * TimeFactor * 20.0
   Set Vector3 SpinMomentum , VX (SpinMomentum), VY (SpinMomentum), VZ (SpinMomentum)- kd * TimeFactor * 0.8
   Pitch_Object_Up(1, ko * TimeFactor * 0.8) : Move Object Up 1, ko * TimeFactor * 20.0
   Set Vector3 SpinMomentum , VX (SpinMomentum)- ko * TimeFactor * 0.8, VY (SpinMomentum), VZ (SpinMomentum)
   Pitch_Object_Down(1, km * TimeFactor * 0.8) : Move Object Up 1, km * TimeFactor * 20.0
   Set Vector3 SpinMomentum , VX (SpinMomentum)+ km * TimeFactor * 0.8, VY (SpinMomentum), VZ (SpinMomentum)

   `Apply Gravity
   Position Object 1, OPX (1), OPY (1) + Grav * TimeFactor , OPZ (1)

   `Apply Momentum
   x#= VX (VelMomentum): y#= VY (VelMomentum) : z# = VZ (VelMomentum)
   Position Object 1, OPX (1) + x#*TimeFactor, OPY (1) + y#*TimeFactor, OPZ (1) + z#*TimeFactor

   `Update Momentum
   mx#= VX (VelMomentum) + ( OPX (1) - VX (ShipPos))*TimeFactor*Fric
   my#= VY (VelMomentum) + ( OPY (1) - VY (ShipPos))*TimeFactor*Fric
   mz#= VZ (VelMomentum) + ( OPZ (1) - VZ (ShipPos))*TimeFactor*Fric
   Set Vector3 VelMomentum , mx# , my# , mz#
   Set_Vector_To_Object( ShipPos ,1)

   Update_Cycle_Time
   Set Cursor 0,0
   Print TimeFactor
   PRint mx#
   PRint my#
   PRint mz#
   Sync
Loop



Function Set_Vector_To_Object(Vector,obj)
   Set Vector3 Vector, OPX (obj), OPY (obj), OPZ (obj)
Endfunction


Function Make_Ship(obj)
   Make Object Cylinder obj,1
   Make Mesh From Object 1,obj
   Delete Object obj
   Make Object Sphere obj,4.5

   Add Limb obj,1,1
   Scale Limb obj,1,100,300,100
   Rotate Limb obj,1,90,0,0
   Offset Limb obj,1,0,0,3.5

   Add Limb obj,2,1
   Scale Limb obj,2,100,300,100
   Rotate Limb obj,2,90,0,0
   Offset Limb obj,2,0,0,-3.5

   Add Limb obj,3,1
   Scale Limb obj,3,100,300,100
   Rotate Limb obj,3,0,0,90
   Offset Limb obj,3,-3.5,0,0

   Add Limb obj,4,1
   Scale Limb obj,4,100,300,100
   Rotate Limb obj,4,0,0,90
   Offset Limb obj,4,3.5,0,0

   For i = 0 to 4
      Add Limb obj,5+i,1
      Scale Limb obj,5+i,100,400,100
      x#=Sin(i*90.0)*4.5:z#=Cos(i*90.0)*4.5
      Offset Limb obj,5+i,x#,-1.5,z#
   Next i
   Set Object Cull obj,0
Endfunction



Function Roll_Object_Right(obj,ang#)
   Rotate Object obj, OAX (obj), OAY (obj), OAZ (obj)-ang#
Endfunction

Function Roll_Object_Left(obj,ang#)
   Rotate Object obj, OAX (obj), OAY (obj), OAZ (obj)+ang#
Endfunction

Function Turn_Object_Right(obj,ang#)
   Rotate Object obj, OAX (obj), OAY (obj)-ang#, OAZ (obj)
Endfunction

Function Turn_Object_Left(obj,ang#)
   Rotate Object obj, OAX (obj), OAY (obj)+ang#, OAZ (obj)
Endfunction

Function Pitch_Object_Down(obj,ang#)
   Rotate Object obj, OAX (obj)+ang#, OAY (obj), OAZ (obj)
Endfunction

Function Pitch_Object_Up(obj,ang#)
   Rotate Object obj, OAX (obj)-ang#, OAY (obj), OAZ (obj)
Endfunction

#Constant Update_Cycle_Time :CycleTime=Timer()-LastTime:LastTime=Timer():TimeFactor=CycleTime/1000.0:If TimeFactor>.99:TimeFactor=.99:Endif:

`keystate abreviations
#Constant k1 keystate(2)
#Constant k2 keystate(3)
#Constant k3 keystate(4)
#Constant k4 keystate(5)
#Constant k5 keystate(6)
#Constant k6 keystate(7)
#Constant k7 keystate(8)
#Constant k8 keystate(9)
#Constant k9 keystate(10)
#Constant k0 keystate(11)
#Constant ka keystate(30)
#Constant kb keystate(48)
#Constant kc keystate(46)
#Constant kd keystate(32)
#Constant ke keystate(18)
#Constant kf keystate(33)
#Constant kg keystate(34)
#Constant kh keystate(35)
#Constant ki keystate(23)
#Constant kj keystate(36)
#Constant kk keystate(37)
#Constant kl keystate(38)
#Constant km keystate(50)
#Constant kn keystate(49)
#Constant ko keystate(24)
#Constant kp keystate(25)
#Constant kq keystate(16)
#Constant kr keystate(19)
#Constant ks keystate(31)
#Constant kt keystate(20)
#Constant ku keystate(22)
#Constant kv keystate(47)
#Constant kw keystate(17)
#Constant kx keystate(45)
#Constant ky keystate(21)
#Constant kz keystate(44)


#Constant OAX Object Angle X
#Constant OAY Object Angle Y
#Constant OAZ Object Angle Z

#Constant OPX Object Position X
#Constant OPY Object Position Y
#Constant OPZ Object Position Z

#Constant VX X Vector3
#Constant VY Y Vector3
#Constant VZ Z Vector3

Sync On:Sync Rate 0:Autocam Off

#Constant VelMomentum 1
#Constant SpinMomentum 2
#Constant ShipPos 3


Null=Make Vector3(VelMomentum)
Null=Make Vector3(SpinMomentum)
Null=Make Vector3(ShipPos)

Global LastTime as Dword
Global CycleTime as DWord
Global TimeFactor as Float
Global Grav as Float
Global Fric as Float
Global Thrust as Float

Grav=-10
Fric=.998

Make_Ship(1)
Position Object 1,0,50,80
Set_Vector_To_Object( ShipPos ,1)
Do

   `Control Ship
   Thrust = ( ka + kd + ko + km) * TimeFactor * 15.0
   `Right Thruster
   Set Vector3 SpinMomentum , VX (SpinMomentum), VY (SpinMomentum), VZ (SpinMomentum)- ka * TimeFactor * 10.0
   if ka Then Fire_Particle(1,8)
   `Left Thruster
   Set Vector3 SpinMomentum , VX (SpinMomentum), VY (SpinMomentum), VZ (SpinMomentum)+ kd * TimeFactor * 10.0
   if kd Then Fire_Particle(1,6)
   `Close Thruster
   Set Vector3 SpinMomentum , VX (SpinMomentum)- ko * TimeFactor * 10.0, VY (SpinMomentum), VZ (SpinMomentum)
   if ko Then Fire_Particle(1,7)
   `Far Thruster
   Set Vector3 SpinMomentum , VX (SpinMomentum)+ km * TimeFactor * 10.0, VY (SpinMomentum), VZ (SpinMomentum)
   if km Then Fire_Particle(1,5)

   `Apply spin momentum
   Rotate Object 1, OAX (1) + VX (SpinMomentum) * TimeFactor , OAY (1) + VY (SpinMomentum)* TimeFactor , OAZ (1) + VZ (SpinMomentum)* TimeFactor
   `Apply Thrust
   Move Object Up 1,Thrust

   `Apply Gravity
   Position Object 1, OPX (1), OPY (1) + Grav * TimeFactor , OPZ (1)

   `Apply Momentum
   x#= VX (VelMomentum): y#= VY (VelMomentum) : z# = VZ (VelMomentum)
   Position Object 1, OPX (1) + x#*TimeFactor, OPY (1) + y#*TimeFactor, OPZ (1) + z#*TimeFactor

   `Update Momentum
   mx#= VX (VelMomentum) + ( OPX (1) - VX (ShipPos))*TimeFactor*Fric
   my#= VY (VelMomentum) + ( OPY (1) - VY (ShipPos))*TimeFactor*Fric
   mz#= VZ (VelMomentum) + ( OPZ (1) - VZ (ShipPos))*TimeFactor*Fric
   Set Vector3 VelMomentum , mx# , my# , mz#
   Set_Vector_To_Object( ShipPos ,1)

   Move_Particles()

   Update_Cycle_Time
   Set Cursor 0,0
   Print TimeFactor
   PRint mx#
   PRint my#
   PRint mz#
   Sync
Loop



Function Set_Vector_To_Object(Vector,obj)
   Set Vector3 Vector, OPX (obj), OPY (obj), OPZ (obj)
Endfunction


Function Make_Ship(obj)
   Make Object Cylinder obj,1
   Make Mesh From Object 1,obj
   Delete Object obj
   Make Object Sphere obj,4.5

   Add Limb obj,1,1
   Scale Limb obj,1,100,300,100
   Rotate Limb obj,1,90,0,0
   Offset Limb obj,1,0,0,3.5

   Add Limb obj,2,1
   Scale Limb obj,2,100,300,100
   Rotate Limb obj,2,90,0,0
   Offset Limb obj,2,0,0,-3.5

   Add Limb obj,3,1
   Scale Limb obj,3,100,300,100
   Rotate Limb obj,3,0,0,90
   Offset Limb obj,3,-3.5,0,0

   Add Limb obj,4,1
   Scale Limb obj,4,100,300,100
   Rotate Limb obj,4,0,0,90
   Offset Limb obj,4,3.5,0,0

   For i = 0 to 3
      Add Limb obj,5+i,1
      Scale Limb obj,5+i,100,400,100
      x#=Sin(i*90.0)*4.5:z#=Cos(i*90.0)*4.5
      Offset Limb obj,5+i,x#,-1.5,z#
   Next i
   Set Object Cull obj,0
Endfunction



Function Roll_Object_Right(obj,ang#)
   Rotate Object obj, OAX (obj), OAY (obj), OAZ (obj)-ang#
Endfunction

Function Roll_Object_Left(obj,ang#)
   Rotate Object obj, OAX (obj), OAY (obj), OAZ (obj)+ang#
Endfunction

Function Turn_Object_Right(obj,ang#)
   Rotate Object obj, OAX (obj), OAY (obj)-ang#, OAZ (obj)
Endfunction

Function Turn_Object_Left(obj,ang#)
   Rotate Object obj, OAX (obj), OAY (obj)+ang#, OAZ (obj)
Endfunction

Function Pitch_Object_Down(obj,ang#)
   Rotate Object obj, OAX (obj)+ang#, OAY (obj), OAZ (obj)
Endfunction

Function Pitch_Object_Up(obj,ang#)
   Rotate Object obj, OAX (obj)-ang#, OAY (obj), OAZ (obj)
Endfunction




Function Fire_Particle(Obj,Limb)
   P=Free_Particle()
   If P=0 Then Exitfunction
   Position Object P,Limb Position X(obj,limb) + (rand * 2.0 - 1.0),Limb Position Y(obj,limb) - 2.0,Limb Position Z(obj,limb) + (rand * 2.0 - 1.0)
   Rotate Object P,Limb Direction X(obj,limb)+90,Limb Direction Y(obj,limb),Limb Direction Z(obj,limb)
Endfunction

#Constant Move_Particles Move_Particles()
Function Move_Particles()
   For i = 1000 to 2000
      If Object Exist(i)
         If Object Visible(i)
            Move Object i,.1
            Roll Object Right i,2
            Offset Limb i,0,0,Limb Offset Y(i,0)-.01,0
            if i = 1000
               Print Limb Offset Y(i,0)
            Endif
            If Limb Offset y(i,0)<-.5
               Hide Object i
               Offset Limb i,0,0,0,0
            Endif
         Endif
      Endif
   Next i
Endfunction

#Constant Free_Particle Free_Particle()
Function Free_Particle()
   Flag=0
   For i = 1000 to 2000
      If Object Exist(i)=0
         Make_Particle(i)
         Flag=1
         Exit
      Else
         If Object Visible(i)=0
            Show Object i
            Flag=1
            Exit
         Endif
      Endif
   Next i
   i=Flag*i
Endfunction i

Function Make_Particle(P)
   Make Object Triangle P, -.5,1,0, 0,0,0, 0.2,1,0.2
   If Image Exist(1000)=0
      Box 0,0,64,64,RGB(128,0,0),RGB(128,128,0),RGB(255,128,0),RGB(211,224,254)
      For i = 1 to 200
         Dot Rnd(64),Rnd(64),Rgb(255,0,0)
      Next i
      Get Image 1000,0,0,64,64,0
   Endif
   Texture Object P,1000
   Set Object Cull P,0
   Ghost Object On P
   Set Object Emissive P,Rgb(255,100,100)
Endfunction

#Constant Update_Cycle_Time :CycleTime=Timer()-LastTime:LastTime=Timer():TimeFactor=CycleTime/1000.0:If TimeFactor>.99:TimeFactor=.99:Endif:
#Constant rand Rnd(10000.0)/10000.0

`keystate abreviations
#Constant k1 keystate(2)
#Constant k2 keystate(3)
#Constant k3 keystate(4)
#Constant k4 keystate(5)
#Constant k5 keystate(6)
#Constant k6 keystate(7)
#Constant k7 keystate(8)
#Constant k8 keystate(9)
#Constant k9 keystate(10)
#Constant k0 keystate(11)
#Constant ka keystate(30)
#Constant kb keystate(48)
#Constant kc keystate(46)
#Constant kd keystate(32)
#Constant ke keystate(18)
#Constant kf keystate(33)
#Constant kg keystate(34)
#Constant kh keystate(35)
#Constant ki keystate(23)
#Constant kj keystate(36)
#Constant kk keystate(37)
#Constant kl keystate(38)
#Constant km keystate(50)
#Constant kn keystate(49)
#Constant ko keystate(24)
#Constant kp keystate(25)
#Constant kq keystate(16)
#Constant kr keystate(19)
#Constant ks keystate(31)
#Constant kt keystate(20)
#Constant ku keystate(22)
#Constant kv keystate(47)
#Constant kw keystate(17)
#Constant kx keystate(45)
#Constant ky keystate(21)
#Constant kz keystate(44)


#Constant OAX Object Angle X
#Constant OAY Object Angle Y
#Constant OAZ Object Angle Z

#Constant OPX Object Position X
#Constant OPY Object Position Y
#Constant OPZ Object Position Z

#Constant VX X Vector3
#Constant VY Y Vector3
#Constant VZ Z Vector3

GAME_START:
set display mode 1280, 1024, 32
sync on
sync rate 0
backdrop on
color backdrop 0
autocam off
randomize timer()
hide mouse


set directional light 0, -1, -1, -1
set ambient light 10



make object box 100, 150, 1, 10
position object 100, 0, 0, 0


`Make the base
make object box 1, 2.5, 0.2, 2.5
make mesh from object 1, 1
delete object 1

`Make top
make object cone 1, 2
add limb 1, 1, 1
offset limb 1, 1, 0, -1.5, 0
scale limb 1, 0, 100, 150, 100




`Tractor beam
make object triangle 20, 0, 0, 0,     0, 0, 0,    0, 1, 0
set object wireframe 20, 1
set object emissive 20, 0xFF0000
position object 20, 0, 10, 0
hide object 20

















type RogueCone
   x#
   y#
   sx#
   sy#
   ang#
   tang#
   thrust#
   alive as boolean
endtype


`RCs(1) is the player, 2+ are rogue cones
Dim RCs(7) as RogueCone
for i = 1 to array count(RCs())
   if i = 1
      RCs(1).x# = 0.0
      RCs(1).y# = 10.0
      color object i, 0x005AC0
   else
      RCs(i).x# = ((i * 40.0 ) / array count(RCs())) - 26
      RCs(i).y# = 2.5
      clone object i, 1
      color object i, 0xFFC05A00
   endif

   RCs(i).sx# = 0
   RCs(i).sy# = 0
   RCs(i).ang# = 0
   RCs(i).tang# = 0
   RCs(i).thrust# = 0
   RCs(i).alive = 1


   position object i, RCs(i).x#, RCs(i).y#, 0.0
next i








`Create the tunnel to heaven
make memblock 1, 12 + (128*128*4)
write memblock dword 1, 0, 128
write memblock dword 1, 4, 128
write memblock dword 1, 8, 32
c as dword : c = 0xFF3F9BFF
c2 as dword
a as dword
for y = 0 to 127
   a = abs(sin(y * (180.0 / 127.0))) * 128
   c2 = ((a << 24) || 0x00FFFFFF) && c
   for x = 0 to 127
      write memblock dword 1, 12 + ((y * 128) + x) * 4, c2
   next x
next y
make image from memblock 1, 1
delete memblock 1
make object cylinder 101, 5
scale object 101, 100, 10000, 100
position object 101, 20.0, 249.0, 0.0
texture object 101, 1
set object transparency 101, 3
scale object texture 101, 1.0, 50.0













`Position the camera
cameraX# = 0.0
cameraY# = 20.0
#constant CAMERA_SPEED 250.0
#constant CAMERA_MIN_HEIGHT 20.0

`Temp vector for the tractor beam
null = make vector2(1)


frameTime# = 1.0
startTime = timer()
do
   frameTime# = (frameTime# * 0.2) + ((timer() - startTime) * 0.8)
   startTime = timer()
   text 0, 0, "FPS: " + str$(screen fps())
   text 0, 10, "MC: " + str$(mouseclick())

   scroll object texture 101, 0.0, frameTime# * 0.003

   `Sort out the camera
   cameraX# = curvevalue(RCs(1).x#,   cameraX#,   CAMERA_SPEED / frameTime#)
   if RCs(1).y# > CAMERA_MIN_HEIGHT
      cameraY# = curvevalue(RCs(1).y#,   cameraY#,   CAMERA_SPEED / frameTime#)
   else
      cameraY# = curvevalue(CAMERA_MIN_HEIGHT,   cameraY#,   CAMERA_SPEED / frameTime#)
   endif
   position camera cameraX#, cameraY#, 50
   point camera    cameraX#, (cameraY# + CAMERA_MIN_HEIGHT) * 0.5, 0




   `This is for the tractor beam
   if mouseclick() && 2    :`Right click
      `Ok, we're tractor beaming - lets see what state we're in...
      if object visible(20) = 0
         `Its not visible, so we're initiating it. This means showing it and finding the closest one
         show object 20

         len# = 8388608 :`Floats have 23 bit precision on the integer... I think...
         id = 2
         for i = 2 to array count(RCs())
            `Check this one is alive...
            if RCs(i).alive
               set vector2 1, RCs(1).x# - object position x(i), object position y(i) - RCs(1).y#
               templen# = length vector2(1)
               if templen# < len# then id = i : len# = templen#
            endif
         next i

         `Too long - hide the tractor beam... cant make a proper lock :-)
         if len# > 10 then hide object 20
      endif

      if object visible(20)
         `Get the closest one's vector
         set vector2 1, RCs(1).x# - object position x(id), object position y(id) - RCs(1).y#

         `Check the tractor beam is not under too much pressure. Give 20% more length once locked... so 10 to lock, 12 max to keep
         len# = length vector2(1)
         if len# > 12 then hide object 20

         `Position, rotate and scale the beam
         position object 20, RCs(1).x#, RCs(1).y#, 0
         rotate object 20, 0, 0, atanfull(x vector2(1), y vector2(1))
         scale object 20, 100, 100 * length vector2(1), 100

         `Color the tractor beam between green and red
         c = len# * 255.0 / 12.0
         set object emissive 20, rgb(c, 255-c, 0)
      endif
   else
      hide object 20
   endif


   `Mouse control
   `Turning
   inc RCs(1).tang#, mousemovex() * frameTime# * 0.1
   `Thrust
   if mouseclick() && 1    :`Left Click
      RCs(1).thrust# = curvevalue(8.0, RCs(1).thrust#, 50.0 / frameTime#)
   else
      RCs(1).thrust# = curvevalue(0.0, RCs(1).thrust#, 50.0 / frameTime#)
   endif




   `Smooth the rotation
   RCs(1).ang# = curvevalue(RCs(1).tang#, RCs(1).ang#, 100.0 / frameTime#)



   `Change speed based on thrust, angle and frame time
   inc RCs(1).sx#, -sin(RCs(1).ang#) * RCs(1).thrust# * frameTime# * 0.005
   inc RCs(1).sy#,  cos(RCs(1).ang#) * RCs(1).thrust# * frameTime# * 0.005

   `If the tractor beam is on, pull the craft that way
   if object visible(20)
      multiply vector2 1, 2.0

      inc RCs(1).sx#, x vector2(1) * frameTime# * -0.001
      inc RCs(1).sy#, y vector2(1) * frameTime# * 0.001

      inc RCs(id).sx#, x vector2(1) * frameTime# * 0.001
      inc RCs(id).sy#, y vector2(1) * frameTime# * -0.001
   endif







   `This is gloabl for all cones
   for i = 1 to array count(RCs())
      `Check if "landed"
      if RCs(i).y# < 2.5
         if RCs(i).sy# <= 0
            if RCs(i).sy# < -19.6
               `Cone "i" hit the ground too quick. Make dead, stop moing (vertically) and change color. Also detach tractor beam if linked to it.
               RCs(i).alive = 0
               RCs(i).sy# = 0.0
               RCs(i).y# = 2.5
               color object i, 0x99000000
               set object transparency i, 3

               if i = id then hide object 20
            else
               if RCs(i).sy# < -1.0
                  `Make it bounce a bit...
                  RCs(i).sy# = RCs(i).sy# * (-0.5)
               else
                  `Did not hit the ground quick enough to warrant a bounce...
                  RCs(i).sy# = 0

                  `Set at land height
                  RCs(i).y# = 2.5

                  `Decelerate X
                  RCs(i).sx# = curvevalue(0, RCs(i).sx#, 1000.0 / frameTime#)
               endif
               `End of speed check
            endif
            `End of 'if hit the ground too quick' check
         endif
         `End of 'If going down' check
      else
         if i > 1
            `AI - we need to see if we're in the tunnel to heaven
            if object collision(i, 101)
               `FLY MY LOVELY - FLY!!!
               inc RCs(i).sy#, frameTime# * 0.098
            else
               `Normal flight gravity - human player
               inc RCs(i).sy#, frameTime# * -0.0098
            endif
         else
            `Normal flight gravity - human player
            inc RCs(i).sy#, frameTime# * -0.0098
         endif
         `Normal flight gravity
         inc RCs(i).sy#, frameTime# * -0.0098
      endif


      `Move craft
      inc RCs(i).x#, RCs(i).sx# * frameTime# * 0.001
      inc RCs(i).y#, RCs(i).sy# * frameTime# * 0.001
      position object i, RCs(i).x#, RCs(i).y#, 0

      `Rotate cones
      if i = 1
         rotate object 1, 0, 0, RCs(1).ang#
      else
         if i = id
            `If the current cone is the one being tractored AND the tractor beam is visible...
            if object visible(20) then rotate object i, 0, 0, atanfull(-x vector2(1), -y vector2(1))
         endif
      endif
   next i

   sync
   if RCs(1).alive = 0 then exit
loop





`Player Died section
make memblock 1, 12 + (screen width() * screen height() * 4)
write memblock dword 1, 0, 1
write memblock dword 1, 4, 1
write memblock dword 1, 8, 32
a = 0
write memblock dword 1, 12, a << 24

make image from memblock 10000, 1
sprite 1, 0, 0, 10000
size sprite 1, screen width(), screen height()

s = timer()
FADE_TIME = 1000
while returnkey() = 0
   `paste image 10000, 0, 0, 1

   if timer() - s < FADE_TIME
      a = ((timer() - s) * 128) / FADE_TIME
      write memblock dword 1, 12, a << 24

      make image from memblock 10000, 1
   else
      msg$ = "You died!!! Press enter to start again or escape to quit"
      text (screen width() - text width(msg$)) * 0.5, (screen height() - text height(msg$)) * 0.5, msg$
   endif

   sync
endwhile

delete memblock 1

for i = 1 to 10000
   if object exist(i) then delete object i
   if image exist(i) then delete image i
next i

`flush video memory
goto GAME_START