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