Updated: Still no explosions but it's starting to be a playable game. Thanks for the advice, makes learning much quicker thanks to this forum.
I tried attaching the sound file (.ogg) but it says not allowed. I guess I'll save that for later when this is finished.
Cheers
Edit: control with arrow keys
I tried attaching the sound file (.ogg) but it says not allowed. I guess I'll save that for later when this is finished.
Cheers
Edit: control with arrow keys
Code: (Select All)
'Space Lander
'james2464
'Sept 2022
Dim scx, scy As Integer
'screen size
scx = 1100 ' 640 min --- 1600 max made for 1100
scy = 600 ' 480 min --- 700 max made for 600
Screen _NewImage(scx, scy, 32)
Randomize Timer
Const PI = 3.141592654#
Dim thrust&
thrust& = _SndOpen("thrustsnd.ogg")
Dim snap&, bgsnap&
snap& = _NewImage(60, 60, 32)
bgsnap& = _NewImage(scx + 1, scy + 1, 32)
Dim Shared c0(100) As Long
c0(0) = _RGB(0, 0, 0)
c0(1) = _RGBA(255, 255, 255, 150)
c0(2) = _RGB(255, 0, 0)
c0(3) = _RGB(150, 150, 255)
c0(4) = _RGB(0, 200, 50)
c0(5) = _RGB(105, 100, 95)
c0(6) = _RGB(55, 50, 45)
c0(7) = _RGB(255, 50, 50)
c0(8) = _RGB(125, 125, 200)
c0(9) = _RGB(50, 150, 255)
c0(10) = _RGB(255, 200, 125)
c0(11) = _RGB(23, 20, 17)
c0(12) = _RGBA(6, 3, 0, 100) 'terrain texture
c0(14) = _RGBA(255, 255, 255, 50)
c0(15) = _RGBA(255, 255, 255, 250)
c0(20) = _RGB(120, 120, 170) 'ship
c0(21) = _RGB(150, 150, 200) 'ship
c0(22) = _RGB(170, 170, 220) 'ship
c0(23) = _RGB(180, 180, 230) 'ship
c0(30) = _RGBA32(255, 255, 150, 160) 'ship exhaust
c0(31) = _RGBA32(255, 255, 150, 80) 'ship exhaust
c0(32) = _RGBA32(255, 255, 150, 40) 'ship exhaust
c0(33) = _RGBA32(255, 255, 150, 20) 'ship exhaust
c0(34) = _RGBA32(255, 220, 0, 200) 'ship exhaust
c0(35) = _RGBA32(255, 220, 0, 100) 'ship exhaust
c0(36) = _RGBA32(255, 220, 0, 70) 'ship exhaust
c0(37) = _RGBA32(255, 220, 0, 40) 'ship exhaust
c0(38) = _RGBA32(255, 220, 0, 10) 'ship exhaust
c0(39) = _RGBA32(255, 220, 0, 0) 'ship exhaust
Dim xx, yy
xx = scx / 2
yy = scy / 2
Type BB
live As Integer
x As Single
y As Single
xv As Single
yv As Single
age As Integer
rad As Integer
spd As Single
colour As Integer
End Type
Dim Shared bnb(900) As BB
Type landingpad
x1 As Single
y1 As Single
x2 As Single
y2 As Single
colour As Integer
count As Integer
End Type
Dim Shared pad(100) As landingpad
Dim Shared j
Cls
Locate 20, 40
Print "Land carefully on each pad. Return to the starting pad to complete."
Sleep
Do
Cls
'lower random landscape
j = 0
jj = 0
k = 170
Do
j = j + 1
jj = jj + 1
If jj > 8 Then
r = Int(Rnd * 5) - 2
jj = 0
End If
k = k + r
If k > 220 Then
k = k - r
End If
If k < 120 Then
k = k - r
End If
Line (j, scy - k)-(j, scy), c0(6)
Loop Until j >= scx
'add texture to terrain
For tt = 1 To 2
For tx = 1 To scx
For ty = 1 To scy
ttt = Int(Rnd * 18)
If ttt > 16 Then
c0(99) = Point(tx, ty)
If c0(99) <> c0(0) Then
Line (tx, ty)-(tx + 2, ty + 2), c0(12), BF
End If
End If
Next ty
Next tx
Next tt
'===== ground
Line (0, scy - 20)-(scx, scy), c0(5), BF
'===== right wall
Line (scx - 40, 0)-(scx, scy - 20), c0(5), BF
'===== left wall
Line (0, 0)-(40, scy - 20), c0(5), BF
'initialize pads
pad(1).x1 = scx / 10
pad(1).x2 = pad(1).x1 + 100
pad(1).y1 = scy - 80
pad(1).y2 = pad(1).y1 + 2
pad(1).colour = 5
pad(1).count = 0
pad(2).x1 = scx / 3 + 50
pad(2).x2 = pad(2).x1 + 75
pad(2).y1 = scy - 50
pad(2).y2 = pad(2).y1 + 2
pad(2).colour = 5
pad(2).count = 0
pad(3).x1 = scx / 2 + 50
pad(3).x2 = pad(3).x1 + 50
pad(3).y1 = scy - 90
pad(3).y2 = pad(3).y1 + 2
pad(3).colour = 5
pad(3).count = 0
pad(4).x1 = scx - 120
pad(4).x2 = pad(4).x1 + 40
pad(4).y1 = scy - 50
pad(4).y2 = pad(4).y1 + 2
pad(4).colour = 5
pad(4).count = 0
'===== pad 1
Line (pad(1).x1, yy)-(pad(1).x2, pad(1).y1), c0(0), BF
'===== pad 2
Line (pad(2).x1, yy)-(pad(2).x2, pad(2).y1), c0(0), BF
'===== pad 3
Line (pad(3).x1, yy)-(pad(3).x2, pad(3).y1), c0(0), BF
'===== pad 4
Line (pad(4).x1, yy)-(pad(4).x2, pad(4).y1), c0(0), BF
'add stars
For tt = 1 To 2
For tx = 1 To scx
For ty = 1 To scy
ttt = Int(Rnd * 1999)
If ttt > 1994 Then
c0(99) = Point(tx, ty)
If c0(99) = c0(0) Then
PSet (tx, ty), c0(14)
If ttt > 1997 Then
PSet (tx, ty), c0(1)
End If
xl = Int(Rnd * 100)
If xl > 98 Then
PSet (tx, ty), c0(15)
PSet (tx + 1, ty), c0(1)
PSet (tx, ty - 1), c0(1)
PSet (tx - 1, ty), c0(1)
PSet (tx, ty + 1), c0(1)
End If
End If
End If
Next ty
Next tx
Next tt
'===== pad 1
Line (pad(1).x1, pad(1).y1)-(pad(1).x2, pad(1).y2), c0(pad(1).colour), BF
'===== pad 2
Line (pad(2).x1, pad(2).y1)-(pad(2).x2, pad(2).y2), c0(pad(2).colour), BF
'===== pad 3
Line (pad(3).x1, pad(3).y1)-(pad(3).x2, pad(3).y2), c0(pad(3).colour), BF
'===== pad 4
Line (pad(4).x1, pad(4).y1)-(pad(4).x2, pad(4).y2), c0(pad(4).colour), BF
'===== parameters
dv = .027 ' time delay value
stx = pad(4).x1 + 20 'starting pos x
sty = pad(4).y1 - 20 'starting pos y
bnb(1).live = 1
bnb(1).colour = 3
bnb(1).x = stx
bnb(1).y = sty
j = 1
'game objective - to land safely on all 4 pads, the last one must be pad 4
'ship starts at pad 4
'======== main loop
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1)
flag = 0
Do
_Limit 30
'check for stray sounds
silence = 0
If _KeyDown(18432) Then silence = silence + 1
If _KeyDown(19200) Then silence = silence + 1
If _KeyDown(19712) Then silence = silence + 1
If silence = 0 Then 'there should be no thrust sound
If _SndPlaying(thrust&) Then _SndStop (thrust&)
End If
'update screen
keyfire1 = 0
keyfire2 = 0
keyfire3 = 0
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 'replace screen with background only (no ship)
'find what's changed before drawing ship again
'what colour pixels are beneath the ship?
'need to rule out the sky somehow, so this can't interfere with the ship
skpttot = 0
c0(99) = Point(bnb(j).x - 16, bnb(j).y + 20)
red% = _Red32(c0(99))
grn% = _Green32(c0(99))
blu% = _Blue32(c0(99))
If red% = grn% And red% = blu% Then
skptl = 0
Else
skptl = 1
End If
c0(99) = Point(bnb(j).x + 16, bnb(j).y + 20)
red% = _Red32(c0(99))
grn% = _Green32(c0(99))
blu% = _Blue32(c0(99))
If red% = grn% And red% = blu% Then
skptr = 0
Else
skptr = 1
End If
skpttot = skptl + skptr
If skpttot > 0 Then
ccflag = 1 'contact
If bnb(j).yv > .5 Then ccflag = 2 ' was landing too hard?
Else
ccflag = 0 'no contact
End If
gravityadd = .025
bnb(j).yv = bnb(j).yv + gravityadd
If ccflag = 0 Then 'if ship is flying
'=============== player input
If _KeyDown(18432) Then
If Not _SndPlaying(thrust&) Then _SndLoop thrust&
bnb(j).yv = bnb(j).yv - .05
keyfire1 = 1
End If
If bnb(j).yv > 10 Then bnb(j).yv = 10
If bnb(j).yv < -10 Then bnb(j).yv = -10
If _KeyDown(19200) Then
If Not _SndPlaying(thrust&) Then _SndLoop thrust&
bnb(j).xv = bnb(j).xv - .03
keyfire2 = 1
End If
If bnb(j).xv < -5 Then bnb(j).xv = -5
If _KeyDown(19712) Then
If Not _SndPlaying(thrust&) Then _SndLoop thrust&
bnb(j).xv = bnb(j).xv + .03
keyfire3 = 1
End If
If bnb(j).xv > 5 Then bnb(j).xv = 5
'if ship is not landed anywhere
bnb(j).x = bnb(j).x + bnb(j).xv
bnb(j).y = bnb(j).y + bnb(j).yv
If bnb(j).x < 50 Then bnb(j).x = 50
If bnb(j).x > scx - 50 Then bnb(j).x = scx - 50
If bnb(j).y < 10 Then bnb(j).y = 10
If bnb(j).y > scy - 30 Then bnb(j).y = scy - 30
'ship
drawship j, c0, bnb
If keyfire1 = 1 Then
fire1 j, c0, bnb
End If
If keyfire2 = 1 Then
fire2 j, c0, bnb
End If
If keyfire3 = 1 Then
fire3 j, c0, bnb
End If
Else 'ship is touching down
'check to see if on a pad
px = bnb(j).x: py = bnb(j).y
pc = pad(1).count + pad(2).count + pad(3).count
For t = 1 To 4
If px > pad(t).x1 + 16 And px < pad(t).x2 - 16 And pad(t).count = 0 Then
If t < 4 Then
pad(t).count = 1
If ccflag = 1 Then
Line (pad(t).x1, pad(t).y1)-(pad(t).x2, pad(t).y2), c0(4), BF
eraseship j, c0, bnb
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1)
Else
Line (pad(t).x1, pad(t).y1)-(pad(t).x2, pad(t).y2), c0(2), BF
eraseship j, c0, bnb
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1)
End If
Else
If pc = 3 Then
pad(t).count = 1
If ccflag = 1 Then
Line (pad(t).x1, pad(t).y1)-(pad(t).x2, pad(t).y2), c0(4), BF
eraseship j, c0, bnb
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1)
Else
Line (pad(t).x1, pad(t).y1)-(pad(t).x2, pad(t).y2), c0(2), BF
eraseship j, c0, bnb
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1)
End If
End If
End If
End If
Next t
If pad(4).count = 1 Then
flag = 1
End If
'=============== player input
If _KeyDown(18432) Then
If Not _SndPlaying(thrust&) Then _SndLoop thrust&
bnb(j).yv = bnb(j).yv - .05
keyfire1 = 1
End If
If bnb(j).yv > 10 Then bnb(j).yv = 10
If bnb(j).yv < -10 Then bnb(j).yv = -10
'if ship is landed
bnb(j).xv = bnb(j).xv * .6 'cancel out most of existing x velocity
If bnb(j).yv > 0 Then bnb(j).yv = 0 'cancel y velocity if heading down
bnb(j).x = bnb(j).x + bnb(j).xv
bnb(j).y = bnb(j).y + bnb(j).yv
If bnb(j).x < 50 Then bnb(j).x = 50
If bnb(j).x > scx - 50 Then bnb(j).x = scx - 50
If bnb(j).y < 10 Then bnb(j).y = 10
If bnb(j).y > scy - 30 Then bnb(j).y = scy - 30
'ship
drawship j, c0, bnb
If keyfire1 = 1 Then
fire1 j, c0, bnb
End If
End If
blink = blink + 1
If blink < 25 Then
bk = 0
End If
If blink > 24 Then
bk = 9
End If
If blink > 50 Then blink = 0
If ccflag = 0 Then
Line (bnb(j).x - 1, bnb(j).y - 8)-(bnb(j).x + 1, bnb(j).y - 6), c0(bk), BF
Else
Line (bnb(j).x - 1, bnb(j).y - 8)-(bnb(j).x + 1, bnb(j).y - 6), c0(4), BF
End If
Line (45, 4)-(229, 188), c0(9), BF
_PutImage (0, 0), 0, snap&, (bnb(j).x - 30, bnb(j).y - 20)-(bnb(j).x + 30, bnb(j).y + 40)
_PutImage (47, 6)-(227, 186), snap&, 0
_Delay dv
_Display
Loop Until flag = 1
_Delay 4.0
Cls
Loop
End
Sub eraseship (j, c0, bnb)
Line (bnb(j).x - 16, bnb(j).y - 15)-(bnb(j).x + 16, bnb(j).y + 19), c0(0), BF
End Sub
Sub drawship (j, c0, bnb)
Line (bnb(j).x - 3, bnb(j).y - 14)-(bnb(j).x + 3, bnb(j).y - 13), c0(22), BF
Line (bnb(j).x - 5, bnb(j).y - 12)-(bnb(j).x + 5, bnb(j).y - 11), c0(21), BF
Line (bnb(j).x - 6, bnb(j).y - 10)-(bnb(j).x + 6, bnb(j).y + 4), c0(20), BF
Line (bnb(j).x - 6, bnb(j).y - 10)-(bnb(j).x - 16, bnb(j).y + 19), c0(20) 'long struts
Line (bnb(j).x + 6, bnb(j).y - 10)-(bnb(j).x + 16, bnb(j).y + 19), c0(20) 'long struts
Line (bnb(j).x - 16, bnb(j).y + 19)-(bnb(j).x - 6, bnb(j).y + 2), c0(20) 'short struts
Line (bnb(j).x + 16, bnb(j).y + 19)-(bnb(j).x + 6, bnb(j).y + 2), c0(20) 'short struts
Line (bnb(j).x - 1, bnb(j).y + 5)-(bnb(j).x + 1, bnb(j).y + 5), c0(20) 'engine
Line (bnb(j).x - 2, bnb(j).y + 6)-(bnb(j).x + 2, bnb(j).y + 6), c0(20) 'engine
Line (bnb(j).x - 3, bnb(j).y + 7)-(bnb(j).x + 3, bnb(j).y + 7), c0(20) 'engine
'highlights
Line (bnb(j).x - 6, bnb(j).y - 10)-(bnb(j).x - 6, bnb(j).y + 4), c0(20), BF
Line (bnb(j).x + 6, bnb(j).y - 10)-(bnb(j).x + 6, bnb(j).y + 4), c0(20), BF
Line (bnb(j).x - 5, bnb(j).y - 10)-(bnb(j).x - 4, bnb(j).y + 4), c0(21), BF
Line (bnb(j).x + 5, bnb(j).y - 10)-(bnb(j).x + 4, bnb(j).y + 4), c0(21), BF
Line (bnb(j).x - 3, bnb(j).y - 10)-(bnb(j).x - 2, bnb(j).y + 4), c0(22), BF
Line (bnb(j).x + 3, bnb(j).y - 10)-(bnb(j).x + 2, bnb(j).y + 4), c0(22), BF
Line (bnb(j).x + 1, bnb(j).y - 10)-(bnb(j).x - 1, bnb(j).y + 4), c0(23), BF
End Sub
Sub fire1 (j, c0, bnb)
Line (bnb(j).x - 2, bnb(j).y + 8)-(bnb(j).x + 2, bnb(j).y + 9), c0(30), BF
Line (bnb(j).x - 2, bnb(j).y + 10)-(bnb(j).x + 2, bnb(j).y + 10), c0(31), BF
Line (bnb(j).x - 2, bnb(j).y + 11)-(bnb(j).x + 2, bnb(j).y + 12), c0(32), BF
Line (bnb(j).x - 2, bnb(j).y + 13)-(bnb(j).x + 2, bnb(j).y + 15), c0(33), BF
End Sub
Sub fire2 (j, c0, bnb)
Line (bnb(j).x + 7, bnb(j).y - 5)-(bnb(j).x + 12, bnb(j).y - 4), c0(31), BF
End Sub
Sub fire3 (j, c0, bnb)
Line (bnb(j).x - 7, bnb(j).y - 5)-(bnb(j).x - 12, bnb(j).y - 4), c0(31), BF
End Sub