+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: Space Lander (/showthread.php?tid=846)
Space Lander - james2464 - 09-03-2022
Exploring moving/controlling an object etc...very fun project
No collisions yet, no sound. Control with w, a, d keys
Cheers
Code: (Select All)
'Lander
'james2464
'Sept 2 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 c0(100) As Long
c0(0) = _RGB(0, 0, 0)
c0(1) = _RGB(255, 255, 255, 60)
c0(2) = _RGB(255, 0, 0)
c0(3) = _RGB(150, 150, 255)
c0(4) = _RGB(0, 200, 50)
c0(5) = _RGB(100, 100, 100)
c0(6) = _RGB(50, 50, 50)
c0(7) = _RGB(255, 50, 50)
c0(8) = _RGB(125, 125, 200)
c0(9) = _RGB(0, 125, 255)
c0(10) = _RGB(255, 200, 125)
c0(11) = _RGB(20, 20, 20)
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 bnb(900) As BB
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
'upper random landscape
j = 0
jj = 0
k = scy / 6
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 > (scy / 5) Then
k = k - r
End If
If k < scy / 9 Then
k = k - r
End If
Line (j, 0)-(j, k), c0(6)
Loop Until j >= scx
'===== 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
'===== pad 1
Line (100, yy)-(200, scy - 80), c0(0), BF
Line (100, scy - 80)-(200, scy - 78), c0(4), BF
'===== pad 2
Line (280, yy)-(355, scy - 50), c0(0), BF
Line (280, scy - 50)-(355, scy - 48), c0(4), BF
'===== pad 3
Line (380 + (scx - 480) / 6, yy)-(430 + (scx - 480) / 6, scy - 90), c0(0), BF
Line (380 + (scx - 480) / 6, scy - 90)-(430 + (scx - 480) / 6, scy - 88), c0(4), BF
'===== pad 4
Line (scx - 120, yy)-(scx - 160, scy - 50), c0(0), BF
Line (scx - 120, scy - 50)-(scx - 160, scy - 48), c0(4), BF
'Sleep
'===== parameters
flow = 1
dv = .033 ' time delay value
pt = 2 ' point size aka circle size
fan = 30 ' fountain fan size
cc1 = 1 ' colour 1
cc2 = 4 ' colour 2
ls = 4 ' launch speed
Dim blive, maxb As Integer
blive = 1
maxb = 1
flip = 0
stx = scx - 140
sty = scy - 70
bnb(1).live = 1
bnb(1).colour = 3
bnb(1).x = stx
bnb(1).y = sty
j = 1
'======== main loop
Do
flag = 0
Do
'update screen
'erase ship
cc = 0
Line (bnb(j).x - 16, bnb(j).y - 15)-(bnb(j).x + 16, bnb(j).y + 19), c0(cc), BF
'find what's changed before drawing ship again
'what colour pixels are beneath the ship?
'if not black, then it has touched down or collided
c0(99) = Point(bnb(j).x, bnb(j).y + 20)
If c0(99) <> c0(0) Then
ccflag = 1 'contact
Else
ccflag = 0 'no contact
End If
gravityadd = .03
bnb(j).yv = bnb(j).yv + gravityadd
If ccflag = 0 Then 'if ship is flying
'=============== player input
If _KeyDown(119) Then
bnb(j).yv = bnb(j).yv - .2
fire = 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(97) Then
bnb(j).xv = bnb(j).xv - .1
fire = 2
End If
If bnb(j).xv < -5 Then bnb(j).xv = -5
If _KeyDown(100) Then
bnb(j).xv = bnb(j).xv + .1
fire = 3
End If
If bnb(j).xv > 5 Then bnb(j).xv = 5
cc = 3 'normal ship colour
'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
Line (bnb(j).x - 3, bnb(j).y - 15)-(bnb(j).x + 3, bnb(j).y - 14), c0(cc), BF
Line (bnb(j).x - 5, bnb(j).y - 13)-(bnb(j).x + 5, bnb(j).y - 11), c0(cc), BF
Line (bnb(j).x - 6, bnb(j).y - 10)-(bnb(j).x + 6, bnb(j).y + 4), c0(cc), BF
Line (bnb(j).x - 6, bnb(j).y - 12)-(bnb(j).x - 16, bnb(j).y + 19), c0(cc)
Line (bnb(j).x + 6, bnb(j).y - 12)-(bnb(j).x + 16, bnb(j).y + 19), c0(cc)
Line (bnb(j).x - 16, bnb(j).y + 19)-(bnb(j).x - 6, bnb(j).y + 4), c0(cc)
Line (bnb(j).x + 16, bnb(j).y + 19)-(bnb(j).x + 6, bnb(j).y + 4), c0(cc)
Line (bnb(j).x - 1, bnb(j).y + 5)-(bnb(j).x + 1, bnb(j).y + 5), c0(cc) 'engine
Line (bnb(j).x - 2, bnb(j).y + 6)-(bnb(j).x + 2, bnb(j).y + 6), c0(cc) 'engine
Line (bnb(j).x - 3, bnb(j).y + 7)-(bnb(j).x + 3, bnb(j).y + 7), c0(cc) 'engine
'ship exhaust
If fire = 1 Then
cc = 30
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
'PSet (bnb(j).x, bnb(j).y + 16), c0(33)
ElseIf fire = 2 Then
cc = 31
Line (bnb(j).x + 7, bnb(j).y - 5)-(bnb(j).x + 12, bnb(j).y - 4), c0(cc), BF
ElseIf fire = 3 Then
cc = 31
Line (bnb(j).x - 7, bnb(j).y - 5)-(bnb(j).x - 12, bnb(j).y - 4), c0(cc), BF
End If
fire = 0
Else 'ship is touching down
'=============== player input
If _KeyDown(119) Then
bnb(j).yv = bnb(j).yv - .2
fire = 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(97) Then bnb(j).xv = bnb(j).xv - .1
'If _KeyDown(100) Then bnb(j).xv = bnb(j).xv + .1
'If bnb(j).xv > 5 Then bnb(j).xv = 5
'If bnb(j).xv < -5 Then bnb(j).xv = -5
cc = 3 'ship landed alt colour
'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 'since y velocity can only be upward, go for it
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
Line (bnb(j).x - 3, bnb(j).y - 15)-(bnb(j).x + 3, bnb(j).y - 14), c0(cc), BF
Line (bnb(j).x - 5, bnb(j).y - 13)-(bnb(j).x + 5, bnb(j).y - 11), c0(cc), BF
Line (bnb(j).x - 6, bnb(j).y - 10)-(bnb(j).x + 6, bnb(j).y + 4), c0(cc), BF
Line (bnb(j).x - 6, bnb(j).y - 12)-(bnb(j).x - 16, bnb(j).y + 19), c0(cc)
Line (bnb(j).x + 6, bnb(j).y - 12)-(bnb(j).x + 16, bnb(j).y + 19), c0(cc)
Line (bnb(j).x - 16, bnb(j).y + 19)-(bnb(j).x - 6, bnb(j).y + 4), c0(cc)
Line (bnb(j).x + 16, bnb(j).y + 19)-(bnb(j).x + 6, bnb(j).y + 4), c0(cc)
Line (bnb(j).x - 1, bnb(j).y + 5)-(bnb(j).x + 1, bnb(j).y + 5), c0(cc) 'engine
Line (bnb(j).x - 2, bnb(j).y + 6)-(bnb(j).x + 2, bnb(j).y + 6), c0(cc) 'engine
Line (bnb(j).x - 3, bnb(j).y + 7)-(bnb(j).x + 3, bnb(j).y + 7), c0(cc) 'engine
'ship exhaust
If fire = 1 Then
cc = 30
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
'PSet (bnb(j).x, bnb(j).y + 16), c0(33)
End If
fire = 0
End If
blink = blink + 1
If blink < 25 Then
bk = 0
End If
If blink > 24 Then
bk = 2
End If
If blink > 50 Then blink = 0
If ccflag = 0 Then
Line (bnb(j).x - 1, bnb(j).y - 10)-(bnb(j).x + 1, bnb(j).y - 8), c0(bk), BF
Else
Line (bnb(j).x - 1, bnb(j).y - 10)-(bnb(j).x + 1, bnb(j).y - 8), c0(4), BF
End If
_Delay dv
Loop Until flag = 1
Loop
EndRE: Space Lander - bplus - 09-03-2022
I like your lander design.
Some advice about Background:
1. make the background and take a snapshot of it,
background_handle = _newimage(_width, _height, 32)
_putimage ,0, background_handle ' screen to snapshot
then in main loop
_putImage , background_handle, 0 'snapshot to screen
that way you don't have to worry about blanking out the last drawing of lander, you just overlay background and then draw lander in new place, way faster and more efficient.
2. Put more layers of background mountains in (or just do 1 layer), right now it looks like you are in a strange tunnel with only foreground and background.
3. On the ground you land on (or crash) add more Red or green or blue or (easier) just make one shade only different from the other color levels. Then for collision, check for that one color with POINT to see if lander feet are on level ground. BTW
_SOURCE background_handle
before you check POINT colors for "collision" with ground.
Here is some nice landscape layering:
Code: (Select All)
Screen _NewImage(640, 350, 32)
Dim k As _Unsigned Long
Color , _RGB32(30, 30, 60)
Do
Cls
DrawTerrain 100, 25, &HFF332211
DrawTerrain 150, 20, &HFF443322
DrawTerrain 200, 15, &HFF554433
DrawTerrain 250, 10, &HFF665544
DrawTerrain 300, 5, &HFF776655
Sleep 5
Loop Until _KeyDown(27)
Sub DrawTerrain (h, modN, c As _Unsigned Long) ' modN for ruggedness the higher the less smooth
For x = 0 To _Width
If x Mod modN = 0 Then ' adjust mod number for ruggedness the higher the number the more jagged
If h < 350 - modN And h > 50 + modN Then
dy = Rnd * 20 - 10
ElseIf h >= 350 - modN Then
dy = Rnd * -10
ElseIf h <= 50 + modN Then
dy = Rnd * 10
End If
End If
h = h + .1 * dy
Line (x, _Height)-(x, h), c
Next
End SubRE: Space Lander - james2464 - 09-04-2022
Thank you, I appreciate the advice.
The terrain code is great, wow. Great idea.
RE: Space Lander - james2464 - 09-04-2022
Is it possible to capture a snapshot of just a portion of the existing screen?
This is just a test to see if I understand _Newimage and _Putimage well enough. And since the following code doesn't work, I obviously don't .
Code: (Select All)
Dim snap&
snap& = _NewImage(100, 100, 32) 'create a small blank image 100x100
_PutImage (400, 400)-(500, 500), 0, snap& 'grab a section of the screen (source) and copy it to the small image (destination)
Sleep
Cls
_PutImage (100, 100), snap&, 0 'take the new image and place it onto the screen (should now be a black screen with this new image appearing)
Sleep
Cls
Sleep
_PutImage (200, 200), snap&, 0 'now the same small image should appear in a different place
SleepAnyway I looked it up but I haven't found any specific details on capturing a portion of the screen like this.
I should mention that this was pasted into the program where the screen already had been created. So this is meant to be getting a snapshot of the game screen and then placing that onto a black screen, just as a test.
RE: Space Lander - james2464 - 09-04-2022
Ignore the previous question, I got it.
I had the source and destination reversed, so it now works. Thanks to the Game Programming tutorial there was a new and good explanation of _Putimage
located here: https://qb64sourcecode.com/task15.html#COPYPASTE
RE: Space Lander - bplus - 09-04-2022
Here is quick demo for making background, making a sprite, sprite move with _Putimage, and sprite scale and tilt while moving with RotoZoom
Code: (Select All)
Screen _NewImage(600, 350, 32)
' =========================================== make background snapshot
Color , _RGB32(30, 30, 60)
snapBack& = _NewImage(_Width, _Height, 32)
Cls
DrawTerrain 100, 25, &HFF332211
DrawTerrain 150, 20, &HFF443322
DrawTerrain 200, 15, &HFF554433
DrawTerrain 250, 10, &HFF665544
DrawTerrain 300, 5, &HFF776655
_PutImage , 0, snapBack&
'check it
Cls
_PutImage , snapBack&, 0
Print "Press any for sprite drawn in middle of screen..."
Sleep
' ========================================== make a spaceship sprite
ship& = _NewImage(61, 31, 32) ' ship is 60 x 30 drawn in top left hand corner
' need black backgrounf for ship
Color , &HFF000000 '= balck background
Cls
drawShip 30, 15, &HFF00FF88
_PutImage , 0, ship&, (0, 0)-(61, 31) ' <<<< upper left corner of screen!!!
' make the background black of ship transparent
_ClearColor &HFF000000, ship&
'now check our ship by putting it into middle of screen
Cls 'still black
x = _Width / 2 - 30: y = _Height / 2 - 15 ' x, y upper left corner so center of image at center of screen
_PutImage (x, y), ship&, 0 ' ship to screen destiation (x, y)
Print " Press any to see sprint move across background"
Sleep
' move sprite over landscape
sx = 0 'from left edge to right and back
dx = 5
Do
sx = sx + dx
If sx > _Width - 60 Then
sx = _Width - 60: dx = -dx
ElseIf sx < 0 Then
sx = 0: dx = -dx
End If
_PutImage , snapBack&, 0 ' back to screen
_PutImage (sx, 175), ship&, 0 ' ship to screen at destination x, y
Locate 1, 1
Print "Press enter to see Rotozoom scale and tilt sprite..."
_Display 'no flicker
_Limit 20 ' max 20 loops a second
Loop Until _KeyDown(13)
sx = 0 'from left edge to right and back
tilt = 45: scale = 1.2
dx = 5
Do
sx = sx + dx
If sx > _Width - 60 Then
sx = _Width - 60: dx = -dx
scale = 2: tilt = 135
ElseIf sx < 0 Then
sx = 0: dx = -dx
scale = 1.2: tilt = 45
End If
_PutImage , snapBack&, 0 ' back to screen
'rotozoom workes from image center
RotoZoom sx + 30, 175 + 15, ship&, scale, tilt ' ship to screen at destination x, y
Locate 1, 1
Print "Press escape to quit..."
_Display 'no flicker
_Limit 20 ' max 20 loops a second
Loop Until _KeyDown(27)
Sub drawShip (x, y, colr As _Unsigned Long) 'shipType collisions same as circle x, y radius = 30
Static ls
Dim light As Long, r As Long, g As Long, b As Long
r = _Red32(colr): g = _Green32(colr): b = _Blue32(colr)
fellipse x, y, 6, 15, _RGB32(r, g - 120, b - 100)
fellipse x, y, 18, 11, _RGB32(r, g - 60, b - 50)
fellipse x, y, 30, 7, _RGB32(r, g, b)
For light = 0 To 5
fcirc x - 30 + 11 * light + ls, y, 1, _RGB32(ls * 50, ls * 50, ls * 50)
Next
ls = ls + 1
If ls > 5 Then ls = 0
End Sub
' ======== helper subs for drawShip that you can use for other things specially fcirc = fill_circle x, y, radius, color
Sub fellipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
If xr = 0 Or yr = 0 Then Exit Sub
Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
Dim x As Long, y As Long
w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
Line (CX - xr, CY)-(CX + xr, CY), C, BF
Do While y < yr
y = y + 1
x = Sqr((h2w2 - y * y * w2) \ h2)
Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
Loop
End Sub
Sub fcirc (x As Long, y As Long, R As Long, C As _Unsigned Long) 'vince version fill circle x, y, radius, color
Dim x0 As Long, y0 As Long, e As Long
x0 = R: y0 = 0: e = 0
Do While y0 < x0
If e <= 0 Then
y0 = y0 + 1
Line (x - x0, y + y0)-(x + x0, y + y0), C, BF
Line (x - x0, y - y0)-(x + x0, y - y0), C, BF
e = e + 2 * y0
Else
Line (x - y0, y - x0)-(x + y0, y - x0), C, BF
Line (x - y0, y + x0)-(x + y0, y + x0), C, BF
x0 = x0 - 1: e = e - 2 * x0
End If
Loop
Line (x - R, y)-(x + R, y), C, BF
End Sub
Sub DrawTerrain (h, modN, c As _Unsigned Long) ' modN for ruggedness the higher the less smooth
For x = 0 To _Width
If x Mod modN = 0 Then ' adjust mod number for ruggedness the higher the number the more jagged
If h < 350 - modN And h > 50 + modN Then
dy = Rnd * 20 - 10
ElseIf h >= 350 - modN Then
dy = Rnd * -10
ElseIf h <= 50 + modN Then
dy = Rnd * 10
End If
End If
h = h + .1 * dy
Line (x, _Height)-(x, h), c
Next
End Sub
Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Single, degreesRotation As Single)
Dim px(3) As Single, py(3) As Single, W&, H&, sinr!, cosr!, i&, x2&, y2&
W& = _Width(Image&): H& = _Height(Image&)
px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
sinr! = Sin(-degreesRotation / 57.2957795131): cosr! = Cos(-degreesRotation / 57.2957795131)
For i& = 0 To 3
x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
px(i&) = x2&: py(i&) = y2&
Next
_MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End SubRE: Space Lander - james2464 - 09-04-2022
Excellent demo, thank you!
RE: Space Lander - james2464 - 09-06-2022
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
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 SubRE: Space Lander - OldMoses - 09-06-2022
This is coming along really nice. Fun and challenging even without some of the ancillary game stuff.
RE: Space Lander - johnno56 - 09-07-2022
Nicely done. Return trip was a bit nerve racking... but fun...