We all know the famous lunar lander - one of those games that once you start playing you cant stop. I felt like making something similar, but a bit more advanced, so this is my version -
Asteroid Lander.
This isnt complete, but it's too small to be in WIP, and always will be, lol. You cant even land yet, infact, all you can do is move around.
The idea is just like Lunar Lander - land on a given point on a landscape. This is exactly the same, instead the landscapes arent just flat and boring; they are asteroids!
Controls are:
Arrowkeys - Thrust
Button 1/2 - Change camera mode (1 - static, 2 - follow)
`------------------
` Asteroid Lander
`------------------
` Setup
` ------------------------------
` Setup Screen
SetupScreen()
` *** Functions ***
` ------------------------------
` Runtime Functions
` ------------------------------
` Main --
function Main()
` Start Main Loop
do
` Draw current world
DrawWorld( GetCurrentWorld() )
` Draw Player
DrawPlayer()
` Handle Player
HandlePlayer()
` Handle Camera
HandleCamera()
ink rgb( 255, 255, 255 ), 0
text 10, 100, str$( screen fps() )
` Refresh Screen
sync
cls
` Continue Main Loop
loop
endfunction
` Handle Camera --
function HandleCamera()
` Change mode
if keystate(2) then CallEvent( "Camera.Static" )
if keystate(3) then CallEvent( "Camera.Follow" )
` If Camera Mode = 2
if _CamMode = 2
` Position & rotate with player
_Camera.Pos.X = curvevalue( _Player.Pos.X, _Camera.Pos.X, 10.0 )
_Camera.Pos.Y = curvevalue( _Player.Pos.Y, _Camera.Pos.Y, 10.0 )
_Camera.Ang = curveangle( _Player.Ang + 180, _Camera.Ang, 20.0 )
endif
endfunction
` Handle Player --
function HandlePlayer()
` Control Player
ControlPlayer( UpKey(), DownKey(), Leftkey(), RightKey() )
` Handle Player Physics
PlayerPhysics()
endfunction
` Control Player --
function ControlPlayer( up as boolean, down as boolean, left as boolean, right as boolean )
` Call events
if up then CallEvent( "Player.Up" )
if down then CallEvent( "Player.Down" )
if left then CallEvent( "Player.Left" )
if right then CallEvent( "Player.Right" )
if (up <> 1) && (down <> 1) && (left <> 1) && (right <> 1) then CallEvent( "Player.Release" )
` in planet
local ip as boolean
for t = _Landscape( _World( GetCurrentWorld() ).Land ).TStart + 1 to ( _Landscape( _World( GetCurrentWorld() ).Land ).TStart + _Landscape( _World( GetCurrentWorld() ).Land ).TCount )
x2# = _Player.Pos.X
y2# = _Player.Pos.Y
x1# = _Landscape( _World( GetCurrentWorld() ).Land ).Pos.X
y1# = _Landscape( _World( GetCurrentWorld() ).Land ).Pos.Y
x3# = _LandTile( t - 1 ).Pos.X
y3# = _LandTile( t - 1 ).Pos.Y
x4# = _LandTile( t ).Pos.X
y4# = _LandTile( t ).Pos.Y
ip = IntersectLines( x1#, y#, x2#, y2#, x3#, y3#, x4#, y4# )
next t
text 10, 10, str$( ip )
endfunction
` Player Physics --
function PlayerPhysics()
` Distance from planet center
local Dist as float
Dist = sqrt( (_Player.Pos.X - ( _Landscape( _World( GetCurrentWorld() ).Land ).Pos.X ) ) ^ 2 + (_Player.Pos.Y - ( _Landscape( _World( GetCurrentWorld() ).Land ).Pos.Y ) ) ^ 2 )
` Weight
local Weight as float
if (Dist > 1)
Weight = (1 / Dist) * _Player.Mass * _World( GetCurrentWorld() ).Grav
else
Weight = _Player.Mass * _World( GetCurrentWorld() ).Grav
endif
` Get angle from center of planet
local Ang as float
Ang = atanfull( _Player.Pos.X - _Landscape( _World( GetCurrentWorld() ).Land ).Pos.X, _Player.Pos.Y - _Landscape( _World( GetCurrentWorld() ).Land ).Pos.Y )
` Rotate Player
_Player.Ang = Ang
` Get weight vector
local WVec as Vec2D
WVec.X = sin( Ang ) * Weight
WVec.Y = cos( Ang ) * Weight
` Get force vectors
_Player.FrcH.X = sin( Ang + 90 ) * _Player.FrcHV
_Player.FrcH.Y = cos( Ang + 90 ) * _Player.FrcHV
_Player.FrcV.X = sin( Ang ) * _Player.FrcVV
_Player.FrcV.Y = cos( Ang ) * _Player.FrcVV
` Resolve forces
_Player.Frc.X = _Player.FrcH.X + _Player.FrcV.X + WVec.X
_Player.Frc.Y = _Player.FrcH.Y + _Player.FrcV.Y + WVec.Y
` Calculate acceleration
_Player.Acc.X = _Player.Frc.X / _Player.Mass
_Player.Acc.Y = _Player.Frc.Y / _Player.Mass
` Calculate new velocity
_Player.Vel.X = _Player.Vel.X + _Player.Acc.X
_Player.Vel.Y = _Player.Vel.Y + _Player.Acc.Y
` Apply drag
_Player.Vel.X = _Player.Vel.X * _World( GetCurrentWorld() ).AirD
_Player.Vel.Y = _Player.Vel.Y * _World( GetCurrentWorld() ).AirD
` Calculate new position
_Player.Pos.X = _Player.Pos.X + _Player.Vel.X
_Player.Pos.Y = _Player.Pos.Y + _Player.Vel.Y
endfunction
` Event Receiver --
function CallEvent( Event as string )
` Select event
Select Event
` Up
case "Player.Up"
` Set Vertical Force to Thrust
_Player.FrcVV = _Player.Thrust
endcase
` Down
case "Player.Down"
` Set Vertical Force to -Thrust
_Player.FrcVV = -_Player.Thrust
endcase
` Left
case "Player.Left"
` Set Horizontal Force to Thrust
_Player.FrcHV = _Player.Thrust
endcase
` Right
case "Player.Right"
` Set Horizontal Force to -Thrust
_Player.FrcHV = -_Player.Thrust
endcase
` Release Controls
case "Player.Release"
` Crear Forces
_Player.FrcHV = _Player.FrcHV * 0.0
_Player.FrcVV = _Player.FrcVV * 0.0
endcase
` Static Camera
case "Camera.Static"
` Set new mode
_CamMode = 1
endcase
` Follow Camera
case "Camera.Follow"
` Set new mode
_CamMode = 2
endcase
`Unselect
EndSelect
endfunction
` Get Real Position --
function GetRealPosX( PosX as float, PosY as integer )
` Get position
PosX = PosX - _Camera.Pos.X + (Screen Width() / 2)
PosY = PosY - _Camera.Pos.Y + (Screen Height() / 2)
` Get angle between Position and Center of screen
local Ang as float
Ang = atanfull( PosX - (Screen Width() / 2), PosY - (Screen Height() / 2))
` Get real angle
local RAng as float
RAng = GetRealAng( Ang )
` Get distance from Position to center of screen
local Dist as float
Dist = sqrt( (PosX - (Screen Width() / 2)) ^ 2 + (PosY - (Screen Height() / 2)) ^ 2 )
` Get New position
local NewX as float
NewX = (Screen Width() / 2) + ( sin( RAng ) * Dist )
endfunction NewX
function GetRealPosY( PosX as integer, PosY as float )
` Get position
PosX = PosX - _Camera.Pos.X + (Screen Width() / 2)
PosY = PosY - _Camera.Pos.Y + (Screen Height() / 2)
` Get angle between Position and Center of screen
local Ang as float
Ang = atanfull( PosX - (Screen Width() / 2), PosY - (Screen Height() / 2))
` Get real angle
local RAng as float
RAng = GetRealAng( Ang )
` Get distance from Position to center of screen
local Dist as float
Dist = sqrt( (PosX - (Screen Width() / 2)) ^ 2 + (PosY - (Screen Height() / 2)) ^ 2 )
` Get New position
local NewY as float
NewY = (Screen Height() / 2) + ( cos( RAng ) * Dist )
endfunction NewY
function GetRealAng( Ang as float )
` New Angle = Ang - CameraAng
local NewA as float
NewA = Ang - _Camera.Ang
endfunction NewA
` Intersect Lines --
function IntersectLines( x1 as float, y1 as float, x2 as float, y2 as float, x3 as float, y3 as float, x4 as float, y4 as float )
` Get denominator
local Denominator as float
Denominator = ((y4 - y3)*(x2 - x1)) - ((x4 - x3)*(y2 - y1))
` Collision
local Collision as boolean
`If denominator = 0, then the lines are parallel
if Denominator <> 0
` Get numarator
numerator# = ((x4 - x3)*(y1 - y3)) - ((y4 - y3)*(x1 - x3))
uA# = numerator# / Denominator
numerator# = ((x2 - x1)*(y1 - y3)) - ((y2 - y1)*(x1 - x3))
uB# = numerator# / Denominator
`If uA and uB > 0 and < 1 then an intersection occured
if (uA# > 0) && (uA# < 1) && (uB# > 0) && (uB# < 1)
Collision = 1
else
Collision = 0
endif
else
Collision = 0
endif
endfunction Collision
` Drawing Functions
` ------------------------------
` Draw Player --
function DrawPlayer()
` Draw rotated square
ink rgb( 255, 255, 255 ), 0
RotateSquare( GetRealPosX( _Player.Pos.X, _Player.Pos.Y ), GetRealPosY( _Player.Pos.X, _Player.Pos.Y ), GetRealAng( _Player.Ang ), _Player.Size )
endfunction
` Draw World
function DrawWorld( World as integer )
` Draw sky
ink _World( World ).BackC, 0
box 0, 0, Screen Width(), Screen Height()
` Draw landscape
DrawLandscape( _World( World ).Land )
endfunction
` Draw Landscape --
function DrawLandscape( Land as integer )
` Set land colour
ink _World( GetCurrentWorld() ).LandC, 0
` Loop through tiles
for t = _Landscape( Land ).TStart + 1 to (_Landscape( Land ).TStart + _Landscape( Land ).TCount ) - 1
` Draw line from tile-1 to tile
line GetRealPosX( _LandTile( t - 1 ).Pos.X, _LandTile( t - 1 ).Pos.Y ), GetRealPosY( _LandTile( t - 1 ).Pos.X, _LandTile( t - 1 ).Pos.Y ), GetRealPosX( _LandTile( t ).Pos.X, _LandTile( t ).Pos.Y ), GetRealPosY( _LandTile( t ).Pos.X, _LandTile( t ).Pos.Y )
next t
` Draw final line (last tile to tile 1)
line GetRealPosX( _LandTile( (_Landscape( Land ).TStart + _Landscape( Land ).TCount ) - 1 ).Pos.X, _LandTile( (_Landscape( Land ).TStart + _Landscape( Land ).TCount ) - 1 ).Pos.Y ), GetRealPosY( _LandTile( (_Landscape( Land ).TStart + _Landscape( Land ).TCount ) - 1 ).Pos.X, _LandTile( (_Landscape( Land ).TStart + _Landscape( Land ).TCount ) - 1 ).Pos.Y ), GetRealPosX( _LandTile( _Landscape( Land ).TStart ).Pos.X, _LandTile( _Landscape( Land ).TStart ).Pos.Y ), GetRealPosY( _LandTile( _Landscape( Land ).TStart ).Pos.X, _LandTile( _Landscape( Land ).TStart ).Pos.Y )
` Grey
ink rgb( 128, 128, 128 ), 0
` Draw flat tiles
fflat = _Landscape( Land ).FStart
for f = _Landscape( Land ).FStart to _Landscape( Land ).FStart + _Landscape( Land ).FCount
` Get positions
x1# = ( _LandTile( fflat ).Pos.X - _Landscape( Land ).Pos.X ) * 1.01
y1# = ( _LandTile( fflat ).Pos.Y - _Landscape( Land ).Pos.Y ) * 1.01
x2# = ( _LandTile( fflat + 1).Pos.X - _Landscape( Land ).Pos.X ) * 1.01
y2# = ( _LandTile( fflat + 1 ).Pos.Y - _Landscape( Land ).Pos.Y ) * 1.01
` Draw line
line GetRealPosX( x1#, y1# ), GetRealPosY( x1#, y1# ), GetRealPosX( x2#, y2# ), GetRealPosY( x2#, y2# )
` Increase counter
inc fflat
if fflat > (_Landscape( Land ).TStart + _Landscape( Land ).TCount )
fflat = fflat - _Landscape( Land ).TCount
endif
next f
endfunction
` Rotate Square --
function RotateSquare( PosX as integer, PosY as integer, Ang as integer, Size as integer )
` Get distance to vertex
local distv as float
distv = sqrt( Size * 2 )
` Draw
line PosX + (sin( Ang + 45 ) * distv), PosY + (cos( Ang + 45 ) * distv), PosX + (sin( Ang + 135 ) * distv), PosY + (cos( Ang + 135 ) * distv)
line PosX + (sin( Ang + 135 ) * distv), PosY + (cos( Ang + 135 ) * distv), PosX + (sin( Ang + 225 ) * distv), PosY + (cos( Ang + 225 ) * distv)
line PosX + (sin( Ang + 225 ) * distv), PosY + (cos( Ang + 225 ) * distv), PosX + (sin( Ang + 315 ) * distv), PosY + (cos( Ang + 315 ) * distv)
line PosX + (sin( Ang + 315 ) * distv), PosY + (cos( Ang + 315 ) * distv), PosX + (sin( Ang + 45 ) * distv), PosY + (cos( Ang + 45 ) * distv)
endfunction
` Creation Functions
` ------------------------------
` Create a world
function CreateWorld( Gravity as float, AirDensity as float, BackC as dword, LandC as dword, Tiles as integer, Height as float, PosX as float, PosY as float, Diameter as integer, Smooth as integer, PlPosX as float, PlPosY as float, Flats as integer )
` World pointer
local World as integer
array insert at bottom _World()
World = array count( _World() )
` Create a landscape
_World( World ).Land = CreateLandscape( Tiles, Height, PosX, PosY, Diameter, Smooth, Flats )
` Set defaults
_World( World ).Grav = Gravity
_World( World ).AirD = AirDensity
_World( World ).BackC = BackC
_World( World ).LandC = LandC
_World( World ).PlPos.X = PlPosX
_World( World ).PlPos.Y = PlPosY
endfunction World
` Set current world --
function SetCurrentWorld( World )
` Set current world
_CurWorld = World
` Reposition Player
_Player.Pos.X = _World( World ).PlPos.X
_Player.Pos.Y = _World( World ).PlPos.Y
endfunction
` Get current world --
function GetCurrentWorld()
` World
local World as integer
World = _CurWorld
endfunction World
` Create landscape --
function CreateLandscape( Tiles as integer, Height as float, PosX as float, PosY as float, Diameter as integer, Smooth as integer, Flats as integer )
` Half diameter to radius
Diameter = Diameter / 2
` Land number
local Land as integer
` Create new landscape
array insert at bottom _Landscape()
Land = array count( _Landscape() )
` Set landscape data
_Landscape( Land ).TStart = array count( _LandTile() )
_Landscape( Land ).TCount = Tiles
_Landscape( Land ).Diameter = Diameter
_Landscape( Land ).RHeight = Height
_Landscape( Land ).Pos.X = PosX
_Landscape( Land ).Pos.Y = PosY
` Create new tiles
for t = 1 to Tiles
` Set new tile data
_LandTile( array count( _LandTile() ) ).Land = Land
_LandTile( array count( _LandTile() ) ).RPos = rnd( Height )
` Add new tile
array insert at bottom _LandTile()
next t
` Smooth
SmoothLandscape( Land, Smooth )
` Flatten some tiles
_Landscape( Land ).FCount = Flats
_Landscape( Land ).FStart = rnd( Tiles )
for f = _Landscape( Land ).FStart to _Landscape( Land ).FStart + Flats
if (f < array count( _LandTile() ))
FlattenTile( Land, f )
else
FlattenTile( Land, f - Tiles )
endif
next f
` Get Tile Positions
GetTilePositions( Land )
endfunction Land
` Smooth Landscape --
function SmoothLandscape( Land as integer, Level as integer )
` Count
for l = 1 to Level
` Loop through tiles
for t = _Landscape( Land ).TStart + 1 to (_Landscape( Land ).TStart + _Landscape( Land ).TCount ) - 1
` Set new height
_LandTile( t ).RPos = ( _LandTile( t - 1 ).RPos + _LandTile( t ).RPos + _LandTile( t + 1 ).RPos ) / 3
next t
next l
endfunction
` Get Tile Positions --
function GetTilePositions( Land as integer )
` Loop through tiles
for t = _Landscape( Land ).TStart to (_Landscape( Land ).TStart + _Landscape( Land ).TCount )
` Get positions
_LandTile( t ).Pos.X = _Landscape( Land ).Pos.X + ( sin( (360.0 / _Landscape( Land ).TCount) * t ) * (_Landscape( Land ).Diameter + _LandTile( t ).RPos) )
_LandTile( t ).Pos.Y = _Landscape( Land ).Pos.Y + ( cos( (360.0 / _Landscape( Land ).TCount) * t ) * (_Landscape( Land ).Diameter + _LandTile( t ).RPos) )
next t
endfunction
` Flatten tile
function FlattenTile( Land as integer, Tile as integer )
` Match tile height to previous tile
local Prev as integer
if Tile < 1 then Tile = _Landscape( Land ).TCount
Prev = Tile - 1
` Match height
_LandTile( _Landscape( Land ).TStart + Tile ).RPos = _LandTile( _Landscape( Land ).TStart + Prev ).RPos
endfunction
` Setup Functions
` ------------------------------
` Camera Setup --
function SetupCamera()
` Global camera
Global _Camera as _tCamera
` Camera mode (1 - static, 2 - follow )
Global _CamMode as integer
_CamMode = 1
endfunction
` Player Setup --
function SetupPlayer()
` Global Player
Global _Player as _tPlayer
` Set Player Defaults
_Player.Mass = 200
_Player.Thrust = 20
_Player.Fuel = 100
_Player.Size = 30
endfunction
` Landscape Setup --
function SetupLandscapes()
` Landscape tiles
Dim _LandTile(0) as _tLandTile
` Landscapes
Dim _Landscape(0) as _tLandscape
endfunction
` World Setup --
function SetupWorlds()
` Worlds
Dim _World(0) as _tWorld
` Current world pointer
Global _CurWorld
endfunction
` Game Setup --
function SetupGame()
` Setup Camera
SetupCamera()
` Setup Player
SetupPlayer()
` Setup Landscapes
SetupLandscapes()
` Setup Worlds
SetupWorlds()
` Create a world (temp)
size = 500
wrd = CreateWorld( -10, 0.995, rgb( 0, 0, 52 ), rgb( 255, 255, 0 ), 100, size / 10, 0, 0, size, 1, 0, - ((size / 2) + (size / 5)), 10 )
SetCurrentWorld( wrd )
` Call Main
Main()
endfunction
` Setup Screen --
function SetupScreen()
` Sync rate
sync on
sync rate 60
` Resolution
load dll "user32.dll", 1
` Get current screen display
ScrW = call dll(1, "GetSystemMetrics", 0)
ScrH = call dll(1, "GetSystemMetrics", 1)
` Set screen display
set display mode ScrW, ScrH, 32
delete dll 1
` Hide mouse
hide mouse
` Game Setup
SetupGame()
endfunction
` *** Structs ***
` ------------------------------
` 2D Vector
type Vec2D
X as float
Y as float
endtype
` Camera Struct
type _tCamera
Pos as Vec2D ` Position
Ang as float ` Angle
endtype
` Player Struct
type _tPlayer
Pos as Vec2D ` Position
Vel as Vec2D ` Velocity
Acc as Vec2D ` Acceleration
Mass as float ` Mass
Thrust as float ` Thrust
FrcVV as float ` Vertical Force Value
FrcHV as float ` Horizontal Force Value
FrcV as Vec2D ` Vertical Force Vector
FrcH as Vec2D ` Horizontal Force Vector
Frc as vec2D ` Resolved Force Vector
Ang as float ` Angle
Size as integer ` Size
Fuel as integer ` Fuel
endtype
` Landscape Struct
type _tLandscape
TStart as integer ` Pointer to first tile
TCount as integer ` Number of tiles
FStart as integer ` First flat tile
FCount as integer ` Flat tile count
RHeight as float ` Random height seed
Diameter as float ` Diameter of planet
Pos as Vec2D ` Position of planet
endtype
` Landscape tile struct
type _tLandTile
RPos as float ` Relative position
Pos as Vec2D ` Real position
Land as integer ` Parent landscape
endtype
` World Struct
type _tWorld
Grav as float ` Gravity
AirD as float ` Air Density (for drag)
Land as integer ` Landscape
PlPos as vec2D ` Player positions
BackC as dword ` Backdrop color
LandC as dword ` Land color
endtype
Before I get into checking for collision, I still have to make some sort of atmosphere thing. It's a bit annoying that you get air resistance out in space.
Physics are pretty realistic. They use simple Newtonian laws, so movement and acceleration works, and so does orbiting, but only if there is no air resistance, which is problematic at the moment.
If you wish to remove all air resistance, go to line 647, and change parameter 2 from 0.995 to 1.0
Enjoy
C&C please!
"It's like floating a boat on a liquid that I don't know, but I'm quite happy to drink it if I'm thirsty enough" - Me being a good programmer but sucking at computers
