AstroLander (YouTube video)
Post by David Williams on May 9th, 2016, 07:15am
I like this slightly different take on the old lander-type game:
https://www.youtube.com/watch?v=FURYjCw45vw
A BB4W version of this 'mini-game' would be a fun little project, I reckon.
I'm tempted to give it a go myself, but what with time constraints...
(Of course, if I took on this project, those lines would have to be anti-aliased - no chunky lines!)
David.
--
Re: AstroLander (YouTube video)
Post by DDRM on May 15th, 2016, 4:30pm
Hi David (and everyone else),
OK, I took the bait. Here is a basic implementation of something like that.
I understand the original was controlled by a joystick:I've implemented it using a mouse. Move the mouse left or right to turn the angle of the lander, and press the left button to fire the engine.
Despite your comments about anti-aliased lines, I've deliberately gone for a retro look and feel, except for using Windows message boxes (they're too easy to ignore!). Of course, retro messages would be quite possible, too. Actually, it might be good, because Windows puts the message box not centred on the BB4W window, so I find my mouse gradually creeping left and down, out of the window.
At the moment there is only one difficulty, though it would be easy to add more (my reading suggests that it's essentially just a case of increasing gravity and thrust, effectively making everything happen faster).
I've only built 4 levels: How about everyone build one (it's fairly straightforward), and we'll have a mega game, instead of a mini one!
I haven't really tidied or annotated the code - it's still in development. If there's any demand for that I will.
Best wishes,
D
Code:
MODE 8
xres%=@vdu%!208
yres%=@vdu%!212
numpoints%=3
DIM ss(numpoints%-1,1)
FOR x%=0 TO numpoints%-1
READ ss(x%,0),ss(x%,1)
NEXT x%
DATA 10,0,0,30,-10,0
a=PI/2
vx=0
vy=0
px=xres%
py=yres%
t=0
g=9.8
m=10000
f=10000
level%=1
score%=0
lives%=3
COLOUR 11
REPEAT
CASE level% OF
WHEN 1:PROCLevel1
WHEN 2:PROCLevel2
WHEN 3:PROCLevel3
WHEN 4:PROCLevel4
ENDCASE
donelevel%=FALSE
*REFRESH OFF
MOUSE OFF
MOUSE TO 640,512
MOUSE mix%,miy%,mz%
Contact%=FALSE
REPEAT
MOUSE mx%,my%,mz%
IF INKEY(-10) THEN t=5 ELSE t=0
f-=t
IF f<t THEN f=0:t=0
IF t THEN SOUND &11,-15,32,1
IF Contact% THEN PROCTest
a=(mix%-mx%)*PI/640
vy+=t*COS(a)*100/(m+f)-g/1000
vx-=t*SIN(a)*100/(m+f)
px+=vx
py+=vy
IF px<-10 THEN px+=2*xres%
IF px>2*xres%+10 THEN px-=2*xres%
a=(mix%-mx%)*PI/640
PROCDrawSpaceship(px,py,a,t)
PRINT TAB(65,0),"Score: "+STR$(score%)
PRINT TAB(65,1),"Lives: "+STR$(lives%)
PRINT TAB(65,2),"Level: "+STR$(level%)
PRINT TAB(65,3),"Fuel: "+STR$(f)
*REFRESH
WAIT 1
IF Contact% THEN PROCTest ELSE PROCDrawSpaceship(px,py,a,t)
UNTIL donelevel%
UNTIL level%=5 OR lives%=0
*REFRESH ON
SYS "MessageBox", @hwnd%, "Your final score was "+STR$(score%), "Lander", 0
END
:
DEFPROCDrawSpaceship(px,py,a,t)
LOCAL ss2(),rm(),x%,tx,ty
DIM ss2(numpoints%-1,1),rm(1,1)
ss2()=ss()
REM PROCLevel1
GCOL 3,15
MOVE px,py
FOR x%=0 TO numpoints%-1
tx=px+ss2(x%,0)*COS(a)-ss2(x%,1)*SIN(a)
ty=py+ss2(x%,0)*SIN(a)+ss2(x%,1)*COS(a)
IF POINT(tx,ty)<>0 THEN Contact%=POINT(tx,ty)
DRAW tx,ty
NEXT x%
DRAW px,py
IF t THEN
GCOL 3,1
DRAW px+10*SIN(a),py-10*COS(a)
ENDIF
ENDPROC
:
DEFPROCTest
LOCAL sc%
CASE Contact% OF
WHEN 7:
REM Crash!
SYS "MessageBox", @hwnd%, "Oops! You crashed!", "Lander (didn't)", 0
lives%-=1
donelevel%=TRUE
WHEN 2:
REM On landing pad!
IF ABS(vx)<1 AND ABS(vy)<1 AND ABS(a)<0.5 THEN
sc%=f+(targetw%/2-ABS(px-targetx%))*100+(5000-3000*ABS(vy))+(5000-5000*ABS(a))
SYS "MessageBox", @hwnd%, "Congratulations, you landed successfully!"+CHR$(13)+CHR$(10)+"You scored "+STR$(sc%), "Lander", 0
score%+=sc%
level%+=1
donelevel%=TRUE
ELSE
SYS "MessageBox", @hwnd%, "Oops! You crashed!", "Lander (didn't)", 0
lives%-=1
donelevel%=TRUE
ENDIF
ENDCASE
ENDPROC
:
DEFPROCLevel1
LOCAL x,y
CLS
GCOL 0,7
MOVE 0,20
DRAW 300,50
DRAW 400,100
DRAW 600,40
DRAW 800,40
DRAW 900,100
DRAW 1000,80
DRAW 1050,120
DRAW 1100,60
DRAW 1280,80
PLOT 141,10,10
GCOL 0,2
targetx%=700
targetw%=160
RECTANGLE FILL targetx%-targetw%/2,32,160,8
px=100
py=2*yres%-100
vx=0
vy=0
f=5000
ENDPROC
:
DEFPROCLevel2
LOCAL x,y
CLS
GCOL 0,7
MOVE 0,200
DRAW 300,350
DRAW 400,200
DRAW 550,700
DRAW 600,600
DRAW 620,40
DRAW 820,40
DRAW 900,650
DRAW 1000,400
DRAW 1050,120
DRAW 1100,260
DRAW 1280,380
PLOT 141,10,10
GCOL 0,2
targetx%=700
targetw%=120
RECTANGLE FILL targetx%-targetw%/2,32,160,8
px=100
py=2*yres%-100
vx=0
vy=0
f=5000
ENDPROC
:
DEFPROCLevel3
LOCAL x,y
CLS
GCOL 0,7
MOVE 0,100
DRAW 200,250
DRAW 300,400
DRAW 550,700
DRAW 700,600
DRAW 650,500
DRAW 450,200
DRAW 500,100
DRAW 520,40
DRAW 720,40
DRAW 900,500
DRAW 800,700
DRAW 900,750
DRAW 1050,520
DRAW 1100,360
DRAW 1280,380
PLOT 141,10,10
GCOL 0,2
targetx%=600
targetw%=120
RECTANGLE FILL targetx%-targetw%/2,32,160,8
px=100
py=2*yres%-100
vx=0
vy=0
f=5000
ENDPROC
:
DEFPROCLevel4
LOCAL x,y
CLS
GCOL 0,7
CIRCLE FILL 300,600,300
CIRCLE FILL 900,400,300
GCOL 0,0
CIRCLE FILL 300,600,200
CIRCLE FILL 900,400,200
RECTANGLE FILL 400,650,250,100
RECTANGLE FILL 800,550,100,300
GCOL 0,2
targetx%=950
targetw%=160
RECTANGLE FILL targetx%-targetw%/2,300,targetw%,8
px=300
py=600
vx=0
vy=0
f=5000
ENDPROC
Re: AstroLander (YouTube video)
Post by David Williams on May 15th, 2016, 9:51pm
Thanks for "taking the bait", David!
It's very playable, and I completed all 4 levels. 
Yes, my mention of antialiased lines came about because I thought it would be nice to put my antialiasing line drawing routine to some use (although RTR's MMX-powered effort is probably at least twice as fast). Alternatively, I could use BB4W's 'native' graphics commands in conjunction with GfxLib's supersampling routine to achieve antialiased lines. In any case, it's all largely academic due to lack of time.
David.
--
Re: AstroLander (YouTube video)
Post by DDRM on May 22nd, 2016, 3:00pm
Hi Folks,
OK, here is a version which is cleaned up and reasonably heavily annotated.
There are now 7 levels, the last of which is quite difficult - I usually finish it with 0 fuel! My current best score is 113,969.
I've added a custom "messagebox" routine to stop the mouse gradually creeping right across your desk - but you still have to be careful. I suggest NOT having the playing window over another window, which will pop in front (almost certainly causing you to crash!) if you accidentally click over it.
Because of all that annotation it now doesn't fit in one post, so the game is here and the levels are in the next post. Simply stick them on the end.
Best wishes,
D
Code:
MODE 8
xRes%=@vdu%!208 :REM Window width in pixels. There are 2 BB4W graphics units per pixel, so as a coordinate it represents the centre of the window
yRes%=@vdu%!212
numPoints%=3 :REM Number of points in the lander - could draw a fancier lander if you wanted to
DIM sS(numPoints%-1,1)
FOR x%=0 TO numPoints%-1
READ sS(x%,0),sS(x%,1)
NEXT x%
DATA 10,0,0,30,-10,0 :REM Coordinates for the drawing of the lander
g=9.8 :REM Acceleration due to gravity
m=10000 :REM Mass of basic lander (fuel added to affect acceleration)
Level%=1 :REM Starting level.If you are developing a new level, set this to your level number,to save having to fly through the earlier ones!
maxLevel%=7
Score%=0
Lives%=3
COLOUR 11 :REM Set text colour to yellow for showing score etc: Won't crash lander!
REPEAT
REM Choose and draw the level. Also sets initial position, velocity and fuel level, as well as landing pad size and position
CASE Level% OF
WHEN 1:PROCLevel1
WHEN 2:PROCCrevasse
WHEN 3:PROCLevel3
WHEN 4:PROCRings
WHEN 5:PROCTunnel1
WHEN 6:PROCTunnel2
WHEN 7:PROCMaze
ENDCASE
doneLevel%=FALSE
*REFRESH OFF
MOUSE OFF :REM Hides mouse pointer, to make it less distracting - but risk you'll click outside the window, hide it, and crash!
MOUSE TO xRes%,yRes% :REM Centres the mouse on the window. Moving it left or right will tilt the lander
Contact%=FALSE :REM We haven't hit anything (yet)
REPEAT
MOUSE mx%,my%,mz%
IF INKEY(-10) THEN t=5 ELSE t=0 :REM Thrust (engine on if left mouse button pressed)
F-=t :REM Use up some fuel
IF F<t THEN F=0:t=0 :REM If we've run out, we can't run the engine...
IF t THEN SOUND &11,-15,32,1 :REM Make a sound to indicate that engine is on
IF Contact% THEN PROCTest :REM Check whether we had hit anything last time lander was drawn, and if so, what
Angle=(xRes%-mx%)*PI/640 :REM Calculate angle of lander, depending on where the mouse is relative to the centre of the window
vY+=t*COS(Angle)*100/(m+F)-g/1000 :REM Adjust vertical velocity according to gravity and thrust
vX-=t*SIN(Angle)*100/(m+F) :REM Adjust horizontal velocity according to thrust
pX+=vX :REM Adjust coordinates of the lander according to velocity vectors
pY+=vY
IF pX<-10 THEN pX+=2*xRes% :REM Wrap window - you can fly off the edge horizontally and appear on the other side!
IF pX>2*xRes%+10 THEN pX-=2*xRes%
PROCDrawSpaceship(pX,pY,Angle,t) :REM Draw the lander in its (new) position
PRINT TAB(65,0),"Score: "+STR$(Score%)
PRINT TAB(65,1),"Lives: "+STR$(Lives%)
PRINT TAB(65,2),"Level: "+STR$(Level%)
PRINT TAB(65,3),"Fuel: "+STR$(F)+" "
*REFRESH
WAIT 2
PROCDrawSpaceship(pX,pY,Angle,t) :REM *UN*-draw the lander (by XOR plotting it over itself). Since REFRESH is off, we never see this,but it clears things before the new plot
UNTIL doneLevel% :REM Landed or crashed!
UNTIL Level%=maxLevel%+1 OR Lives%=0
*REFRESH ON
*MOUSE ON
PROCMessage("Your final score was "+STR$(Score%),"Lander")
REM SYS "MessageBox", @hwnd%, "Your final score was "+STR$(Score%), "Lander", 0
QUIT
:
DEFPROCDrawSpaceship(px,py,a,t)
LOCAL x%,tx%,ty%
GCOL 3,15 :REM Note the use of XOR plotting mode (3) - if we redraw with the same parameters it rubs out the lander!
MOVE px,py :REM Move to defining point of the lander (centre bottom)
FOR x%=0 TO numPoints%-1
tx%=px+sS(x%,0)*COS(a)-sS(x%,1)*SIN(a) :REM Calculate coordinates of each point, bearing in mind offset and angle
ty%=py+sS(x%,0)*SIN(a)+sS(x%,1)*COS(a)
IF POINT(tx%,ty%)<>0 THEN Contact%=POINT(tx%,ty%) :REM Test if any of the vertices coincide with the scenery.... at least, grey or green bits of it
DRAW tx%,ty%
NEXT x%
DRAW px,py :REM Close shape (could fill it, I guess, if you wanted to!)
IF t THEN
REM Engine is on: draw a red rocket flare!
GCOL 3,1
DRAW px+10*SIN(a),py-10*COS(a)
ENDIF
ENDPROC
:
DEFPROCTest
LOCAL sc%
REM Note that this only has an effect if the colour hit was 7 or 2 - so you could draw stars (or text) in other colours, and they wouldn't crash the lander
CASE Contact% OF
WHEN 7:
REM Crash! We've hit the landscape
PROCMessage("Oops! You crashed!","Lander (didn't)")
REM SYS "MessageBox", @hwnd%, "Oops! You crashed!", "Lander (didn't)", 0
Lives%-=1
doneLevel%=TRUE
WHEN 2:
REM On landing pad!
IF ABS(vX)<1 AND ABS(vY)<1 AND ABS(Angle)<0.5 THEN
REM Not going too fast, or tipped over too much
sc%=F+(TargetW%/2-ABS(pX-TargetX%))*100+(5000-3000*ABS(vY))+(5000-5000*ABS(Angle))
PROCMessage("Congratulations! "+"You scored "+STR$(sc%),"Lander")
REM SYS "MessageBox", @hwnd%, "Congratulations!"+CHR$(13)+CHR$(10)+"You scored "+STR$(sc%), "Lander", 0
Score%+=sc%
Level%+=1
doneLevel%=TRUE
ELSE
REM We WERE going too fast, or tipped over too much
PROCMessage("Oops! You crashed!","Lander (didn't)")
REM SYS "MessageBox", @hwnd%, "Oops! You crashed!", "Lander (didn't)", 0
Lives%-=1
doneLevel%=TRUE
ENDIF
ENDCASE
Contact%=FALSE
ENDPROC
:
DEFPROCMessage(m$,h$)
LOCAL x%,y%,z%,done%
done%=FALSE
GCOL 0,0
RECTANGLE FILL xRes%/2,yRes%/2,xRes%,yRes%
GCOL 0,15
RECTANGLE xRes%/2,yRes%/2,xRes%,yRes%
VDU 5
GCOL 0,3
MOVE xRes%/2+5,yRes%*3/2-5
PRINT h$
MOVE xRes%-@vdu%!216*LEN(m$),yRes%+@vdu%!220
PRINT m$
MOVE xRes%-2*@vdu%!216,yRes%/2+2*@vdu%!220+25
PRINT "OK"
GCOL 0,15
RECTANGLE xRes%-2*@vdu%!216-10,yRes%/2+20,4*(@vdu%!216)+20,2*@vdu%!220+30
*REFRESH ON
MOUSE ON
REPEAT
MOUSE x%,y%,z%
WAIT 1
IF z%>0 THEN IF x%>xRes%-2*@vdu%!216-10 AND x%<xRes%+2*@vdu%!216+10 AND y%>yRes%/2+20 AND y%<yRes%/2+2*@vdu%!220+50 THEN done%=TRUE
UNTIL done%
REPEAT MOUSE x%,y%,z% UNTIL z%=0
VDU 4
MOUSE OFF
*REFRESH OFF
ENDPROC
:
Re: AstroLander (YouTube video)
Post by DDRM on May 22nd, 2016, 3:01pm
...and here are the levels.
D
Code:
REM Here are the definitions for the different levels. Basically you need to define a landscape where Colour 7 defines things you can't hit
REM and Colour 2 defines the landing area(s). I've assumed that open space is black, but it doesn't need to be
REM - though you'll need to be careful with the flood fills if you draw in different colours!
REM I've used some different approaches to drawing the landscape - see what you like.
DEFPROCLevel1
CLS
GCOL 0,7 :REM Absolute colour plotted - use colour 7 (grey by default, but you could change that if you wanted a moon made of green cheese...)
MOVE 0,20
DRAW 300,50
DRAW 400,100
DRAW 600,40
DRAW 800,40
DRAW 900,100
DRAW 1000,80
DRAW 1050,120
DRAW 1100,60
DRAW 1280,80
PLOT 141,10,10 :REM Flood fill
GCOL 0,2 :REM Change to colour 2 to indicate landing pad - again you could reprogram colour 2 if you wanted to (for example, if you made colour 7 into green...)
TargetX%=700 :REM Define target location and width - needed elsewhere to calculate score, which depends on how close you are to the centre
TargetW%=160
RECTANGLE FILL TargetX%-TargetW%/2,32,160,8
pX=100 :REM Set initial coordinates of the lander, and its velocity vectors
pY=2*yRes%-100
vX=0
vY=0
F=5000 :REM Fuel load -affects performance (heavy landers accelerate slower), or you could use it to make it more difficult!
ENDPROC
:
DEFPROCCrevasse
CLS
GCOL 0,7
MOVE 0,200
DRAW 300,350
DRAW 400,200
DRAW 550,700
DRAW 600,600
DRAW 620,40
DRAW 820,40
DRAW 900,650
DRAW 1000,400
DRAW 1050,120
DRAW 1100,260
DRAW 1280,380
PLOT 141,10,10
GCOL 0,2
TargetX%=700
TargetW%=120
RECTANGLE FILL TargetX%-TargetW%/2,32,160,8
pX=100
pY=2*yRes%-100
vX=0
vY=0
F=5000
ENDPROC
:
DEFPROCLevel3
CLS
GCOL 0,7
MOVE 0,100
DRAW 200,250
DRAW 300,400
DRAW 550,700
DRAW 700,600
DRAW 650,500
DRAW 450,200
DRAW 500,100
DRAW 520,40
DRAW 720,40
DRAW 900,500
DRAW 800,700
DRAW 900,750
DRAW 1050,520
DRAW 1100,360
DRAW 1280,380
PLOT 141,10,10
GCOL 0,2
TargetX%=600
TargetW%=120
RECTANGLE FILL TargetX%-TargetW%/2,32,160,8
pX=100
pY=2*yRes%-100
vX=0
vY=0
F=5000
ENDPROC
:
DEFPROCRings
CLS
GCOL 0,7
CIRCLE FILL 300,600,300
CIRCLE FILL 900,400,300
GCOL 0,0
CIRCLE FILL 300,600,200
CIRCLE FILL 900,400,200
RECTANGLE FILL 400,650,250,100
RECTANGLE FILL 800,550,100,300
GCOL 0,2
TargetX%=950
TargetW%=160
RECTANGLE FILL TargetX%-TargetW%/2,300,TargetW%,8
pX=300
pY=600
vX=0
vY=0
F=5000
ENDPROC
:
DEFPROCTunnel1
LOCAL x%,y%,a%
LOCAL DATA :REM Store the existing data pointer, so we can move it here
RESTORE +1 :REM Start reading data from the next line
DATA 0,600,200,650,800,620,850,600,800,500,650,450,150,300,50,100,120,50,420,40,600,50
DATA 900,40,1100,40,1150,80,1100,160,880,180,280,200,300,230,550,250,950,420,1280,920
CLS
GCOL 0,7
READ x%,y%
MOVE x%,y%
REM Rather than a whole string of draw commands, read and plot them in a loop
FOR a%=1 TO 20
READ x%,y%
DRAW x%,y%
NEXT a%
RESTORE DATA :REM Put the old data pointer back in place
PLOT 141,10,10
GCOL 0,2
TargetX%=1000
TargetW%=120
RECTANGLE FILL TargetX%-TargetW%/2,32,160,8
pX=100
pY=2*yRes%-100
vX=0
vY=0
F=5000
ENDPROC
:
DEFPROCTunnel2
LOCAL x%,y%,a%
LOCAL DATA :REM Store the existing data pointer, so we can move it here
RESTORE +1 :REM Start reading data from the next line
DATA 0,200,100,50,200,20,450,70,800,100,1200,150,1250,400,1200,900,1100,950,650,700,350,500,700,450,950,450
DATA 980,540,600,560,1000,740,1050,700,950,360,480,280,280,200,300,500,550,750,850,920,900,1024
CLS
GCOL 0,7
READ x%,y%
MOVE x%,y%
REM Rather than a whole string of draw commands, read and plot them in a loop
FOR a%=1 TO 23
READ x%,y%
DRAW x%,y%
NEXT a%
RESTORE DATA :REM Put the old data pointer back in place
PLOT 141,10,10
GCOL 0,2
TargetX%=840
TargetW%=120
RECTANGLE FILL TargetX%-TargetW%/2,450,TargetW%,8
pX=100
pY=2*yRes%-100
vX=0
vY=0
F=5000
ENDPROC
:
DEFPROCMaze
LOCAL x%,y%,r%
x%=500
y%=500
r%=500
CLS
GCOL 0,7
CIRCLE FILL x%,y%,r%
GCOL 0,0
CIRCLE FILL x%,y%,r%-50
GCOL 0,7
CIRCLE FILL x%,y%,r%-150
GCOL 0,0
CIRCLE FILL x%,y%,r%-200
GCOL 0,7
CIRCLE FILL x%,y%,r%-300
GCOL 0,0
CIRCLE FILL x%,y%,r%-350
RECTANGLE FILL x%+130,y%-50,80,50
RECTANGLE FILL x%-295,y%,-60,50
RECTANGLE FILL x%+430,y%+50,80,50
TargetX%=1150
TargetW%=120
GCOL 0,2
RECTANGLE FILL TargetX%-TargetW%/2,250,TargetW%,8
pX=x%
pY=y%
vX=0
vY=0
F=5000
ENDPROC
Re: AstroLander (YouTube video)
Post by David Williams on May 23rd, 2016, 08:11am
Some quick-fire suggestions:
* Turn off the flashing cursor
* Prevent the program window from being resized (an inadverent resizing of the window cost me a life!)
* Check for window focus; if your program hasn't got focus then go into a CPU-friendly spin loop/waiting state (admittedly my 'Asteroids' doesn't check for focus during the game).
I'll have a go at cracking all 7 levels later today.
David.
--
Re: AstroLander (YouTube video)
Post by Joe68 on Nov 6th, 2016, 6:22pm
Hi All.
Just saw this post despite it being several months old.
I was big fan of 'Lunar Lander' (shows my age!) and really enjoyed this game.
Here's another level, tack it on to the existing program, don't forget to alter maxLevel% to 8 and add 'WHEN 8 PROCLevel8' to the CASE Level% OF conditional.
Code:
defprocLevel8
local x%,y%
local data
restore +1
data 0,850,20,840,15,32,490,142,1024,28,1230,234,308,416,312,452,1112,356,1054,506
data 856,634,334,586,180,712,832,862,972,862,1000,894,840,966,346,888,112,718,190,530
data 896,554,906,448,152,520,82,418,498,216,1000,220,1010,112,490,206,136,160,64,134
data 100,834,428,1023
data -1,-1
cls
gcol 0,7
read x%,y%
move x%,y%
repeat
read x%,y%
if x%=-1 exit repeat
draw x%,y%
until false
restore data
plot 141,10,10
gcol 0,2
TargetX%=892
TargetW%=120
rectangle fill TargetX%-TargetW%/2,854,TargetW%,8
pX=100
pY=2*yRes%-100
vX=0
vY=0
F=8000
endproc
The level is very tricky, it took me several dozen tries to complete it.
If anyone is interested I have a slightly modified version of the program which uses keyboard input and includes rotational inertia to make life a little more difficult.
All the best.
Joe.
Re: AstroLander (YouTube video)
Post by DDRM on Nov 6th, 2016, 8:37pm
Tricky is right! I've only managed to get about half way so far... 
Thanks for putting it together.
Just a note for the unwary: you've used lower case keywords. If you want to add it to my code, you probably need to load mine, change to lower case keywords,and then add your section, and make the required changes to the CASE etc. - and then change back to upper case keywords if that's what you prefer (as I do).
I'd certainly be interested to see your modified version.
Best wishes,
D
Re: AstroLander (YouTube video)
Post by David Williams on Nov 6th, 2016, 9:06pm
Yes, tricky is the word! I got about 60 to 70% of the way on my first go (which was encouraging), but then I ran out of fuel (which was deflating).
David.
--
Re: AstroLander (YouTube video)
Post by Joe68 on Nov 12th, 2016, 11:13am
Hi All.
I hope you are enjoying Level8. It can be done!
Here is my slightly modified version of the program, this time in uppercase keywords (apologies for previous, I tend to program in lowercase even though I know this is not good form).
Levels are in following post.
Code: REM * AstroLander
REM original program by DDRM
REM mods by Joe68
VERSION$="2c"
MODE 8
OFF
*FONT Consolas,10
REM Window sizes in pixels.
REM There are 2 BB4W graphics units/pixel,
REM so as a coordinate it represents the centre of the window
xRes%=@vdu%!208
yRes%=@vdu%!212
REM line thickness=t
REM t=2
REM vdu 23,23,t|
REM Number of points in the lander - could draw a fancier lander if you wanted to
numPoints%=3
DIM sS(numPoints%-1,1)
FOR i=0 TO numPoints%-1
READ sS(i,0),sS(i,1)
NEXT i
DATA 10,0,0,30,-10,0 :rem Coordinates for the drawing of the lander
REM set up a structure for ship parameters
DIM ship{loc{x,y,a},vel{x,y,a},thrust,fuel,mass,lives}
g=9.8 :REM Acceleration due to gravity
ship.mass=10000:REM Mass of lander (fuel added to affect acceleration)
REM Starting level.
REM If you are developing a new level, set this to your level number,
REM to save having to fly through the earlier ones!
Level%=1
maxLevel%=8
Score%=0
ship.lives=3
COLOUR 3 :REM Set text colour to yellow: won't crash lander!
ENVELOPE 1,2,2,-2,2,30,20,50,127,-1,0,-2,124,0:REM dead
ENVELOPE 2,1,0,0,0,0,0,0,127,-1,-2,-2,100,0 :REM landed
REM * Game Loop
REPEAT
REM Choose and draw the level.
REM Also sets initial position, velocity and fuel level,
REM as well as landing pad size and position
CASE Level% OF
WHEN 1 PROCLevel1
WHEN 2 PROCCrevasse
WHEN 3 PROCLevel3
WHEN 4 PROCRings
WHEN 5 PROCTunnel1
WHEN 6 PROCTunnel2
WHEN 7 PROCMaze
WHEN 8 PROCLevel8
ENDCASE
doneLevel%=FALSE
*REFRESH OFF
Contact%=FALSE:REM We haven't hit anything (yet)
ship.loc.a=0 :REM initial angle
ship.vel.a=0 :REM initial rate of rotation
REPEAT
*FX 21,0
IF INKEY(-105) THEN ship.thrust=5 ELSE ship.thrust=0 :REM Thrust (engine on if '/' key pressed)
IF INKEY(-98) THEN ship.vel.a+=0.001 :REM Rotate left if 'Z' pressed
IF INKEY(-67) THEN ship.vel.a-=0.001 :REM Rotate right if 'X' pressed
ship.fuel-=ship.thrust :REM Use up some fuel
IF ship.fuel<ship.thrust THEN ship.fuel=0:ship.thrust=0:REM If we've run out, we can't run the engine...
IF ship.thrust THEN SOUND &10,-5,80,1 :REM thruster running sound
IF Contact% THEN PROCTest :REM Check whether we had hit anything last time lander was drawn, and if so, what
ship.loc.a+=ship.vel.a
ship.vel.y+=ship.thrust*COS(ship.loc.a)*100/(ship.mass+ship.fuel)-g/1000 :REM Adjust vertical velocity according to gravity and thrust
ship.vel.x-=ship.thrust*SIN(ship.loc.a)*100/(ship.mass+ship.fuel) :REM Adjust horizontal velocity according to thrust
ship.loc.x+=ship.vel.x :REM Adjust coordinates of the lander according to velocity vectors
ship.loc.y+=ship.vel.y
IF ship.loc.x<-10 THEN ship.loc.x+=2*xRes%:REM Wrap window - you can fly off the edge horizontally and appear on the other side!
IF ship.loc.x>2*xRes%+10 THEN ship.loc.x-=2*xRes%
PROCDrawShip(ship.loc.x,ship.loc.y,ship.loc.a,ship.thrust) :REM Draw the lander in its (new) position
PROCDashboard
*REFRESH
WAIT 2
REM *UN*-draw the lander (by XOR plotting it over itself).
REM Since REFRESH is off, we never see this, but it clears things
REM before the new plot
PROCDrawShip(ship.loc.x,ship.loc.y,ship.loc.a,ship.thrust)
UNTIL doneLevel%:REM Landed or crashed!
UNTIL Level%=maxLevel%+1 OR ship.lives=0
*REFRESH ON
*MOUSE ON
PROCMessage("Your final score was "+STR$(Score%),"Lander")
QUIT
DEFPROCDrawShip(px,py,a,t)
LOCAL x,tx%,ty%
GCOL 3,15 :REM Note the use of XOR plotting mode (3) - if we redraw with the same parameters it rubs out the lander!
MOVE px,py :REM Move to defining point of the lander (centre bottom)
FOR x=0 TO numPoints%-1
tx%=px+sS(x,0)*COS(a)-sS(x,1)*SIN(a) :REM Calculate coordinates of each point, bearing in mind offset and angle
ty%=py+sS(x,0)*SIN(a)+sS(x,1)*COS(a)
IF POINT(tx%,ty%)<>0 THEN Contact%=POINT(tx%,ty%):REM Test if any of the vertices coincide with the scenery.... at least, grey or green bits of it
DRAW tx%,ty%
NEXT x
DRAW px,py :REM Close shape (could fill it, I guess, if you wanted to!)
IF ship.thrust THEN
REM Engine is on: draw a red rocket flare!
GCOL 3,1
DRAW px+10*SIN(a),py-10*COS(a)
ENDIF
ENDPROC
DEFPROCTest
LOCAL sc%
REM Note that this only has an effect if the colour hit was 7 or 2 - so you could draw stars (or text) in other colours, and they wouldn't crash the lander
CASE Contact% OF
WHEN 7:
REM Crash! We've hit the landscape
SOUND 0,1,128,10
PROCMessage("Oops! "+"Hit the landscape!","Lander")
ship.lives-=1
doneLevel%=TRUE
WHEN 2:
REM On landing pad!
IF ABS(ship.vel.x)<1 AND ABS(ship.vel.y)<1 AND ABS(ship.loc.a)<0.5 THEN
REM Not going too fast, or tipped over too much
sc%=ship.fuel+(padW/2-ABS(ship.loc.x-padX))*100+(5000-3000*ABS(ship.vel.y))+(5000-5000*ABS(ship.loc.a))
SOUND 2,2,128,2
PROCMessage("Congratulations! "+"You scored "+STR$(sc%),"Lander")
Score%+=sc%
Level%+=1
doneLevel%=TRUE
ELSE
REM We WERE going too fast, or tipped over too much
SOUND 0,1,128,10
PROCMessage("Crikey! "+"Too hard a landing!","Lander")
ship.lives-=1
doneLevel%=TRUE
ENDIF
ENDCASE
Contact%=FALSE
ENDPROC
DEFPROCDashboard
PRINT TAB(10,0),"Lives: "+STR$(ship.lives)
PRINT TAB(10,1),"Level: "+STR$(Level%)
PRINT TAB(40,0),"Score: "+STR$(Score%)
PRINT TAB(40,1),"Fuel : "+STR$(ship.fuel)+" "
PRINT TAB(70,0),"Xvel : "+STR$(ABSINT(ship.vel.x*10))+" "
PRINT TAB(70,1),"Yvel : "+STR$(ABSINT(ship.vel.y*10))+" "
ENDPROC
DEFPROCMessage(m$,h$)
LOCAL x%,y%,z&,done%
done%=FALSE
GCOL 0,0
RECTANGLE FILL xRes%/2,yRes%/2,xRes%,yRes%
GCOL 0,15
RECTANGLE xRes%/2,yRes%/2,xRes%,yRes%
VDU 5
GCOL 0,3
MOVE xRes%/2+5,yRes%*3/2-5
PRINT h$
MOVE xRes%-@vdu%!216*LEN(m$),yRes%+@vdu%!220
PRINT m$
MOVE xRes%-2*@vdu%!216,yRes%/2+2*@vdu%!220+25
PRINT "OK"
GCOL 0,15
RECTANGLE xRes%-2*@vdu%!216-10,yRes%/2+20,4*(@vdu%!216)+20,2*@vdu%!220+30
*REFRESH ON
MOUSE ON
REPEAT
MOUSE x%,y%,z&
WAIT 1
IF z&>0 THEN IF x%>xRes%-2*@vdu%!216-10 AND x%<xRes%+2*@vdu%!216+10 AND y%>yRes%/2+20 AND y%<yRes%/2+2*@vdu%!220+50 THEN done%=TRUE
UNTIL done%
REPEAT MOUSE x%,y%,z& UNTIL z&=0
VDU 4
MOUSE OFF
*REFRESH OFF
ENDPROC
Cheers.
Joe.
Re: AstroLander (YouTube video)
Post by Joe68 on Nov 12th, 2016, 11:16am
And here are the levels...
If I can come up with more I will post as and when.
Code: (Levels)
REM Here are the definitions for the different levels. Basically you need to set up
REM a landscape where Colour 7 defines things you must not hit and Colour 2 defines
REM the landing area(s). I've assumed that open space is black, but it doesn't need
REM to be - though you'll need to be careful with the flood fills if you draw in
REM different colours!
REM I've used some different approaches to drawing the landscape - see what you like.
DEFPROCLevel1
LOCAL x,y
LOCAL DATA :REM Store the existing data pointer, so we can move it here
RESTORE +1 :REM Start reading data from the next line
DATA 0,20,300,50,400,100,600,40,800,40,900,100,1000,80,1050,120,1100,60,1280,80
DATA -1,-1
CLS
REM Absolute colour plotted - use colour 7 (grey by default, but you could change
REM that if you wanted a moon made of green cheese...)
GCOL 0,7
READ x,y
MOVE x,y
REM Rather than a whole string of draw commands, read and plot them in a loop
REPEAT
READ x,y
IF x=-1 EXIT REPEAT
DRAW x,y
UNTIL FALSE
RESTORE DATA :REM Put the old data pointer back in place
PLOT 141,10,10 :REM Flood fill
REM Change to colour 2 to indicate landing pad - again you could reprogram
REM colour 2 if you wanted to (for example, if you made colour 7 into green...)
GCOL 0,2
REM Define pad location and width - needed elsewhere to calculate score,
REM which depends on how close you are to the centre
padX=700
padW=160
RECTANGLE FILL padX-padW/2,32,160,8
REM Set initial coordinates of the lander, and its velocity vectors
ship.loc.x=100
ship.loc.y=2*yRes%-100
ship.vel.x=0
ship.vel.y=0
REM Fuel load - affects performance (heavy landers accelerate slower),
REM or you could use it to make it more difficult!
ship.fuel=5000
ENDPROC
DEFPROCCrevasse
LOCAL x,y
LOCAL DATA
RESTORE +1
DATA 0,200,300,350,400,200,550,700,600,600,620,40,820,40,900,650,1000,400,1050,120
DATA 1100,260,1280,380
DATA -1,-1
CLS
GCOL 0,7
READ x,y
MOVE x,y
REPEAT
READ x,y
IF x=-1 EXIT REPEAT
DRAW x,y
UNTIL FALSE
RESTORE DATA
PLOT 141,10,10
GCOL 0,2
padX=700
padW=120
RECTANGLE FILL padX-padW/2,32,160,8
ship.loc.x=100
ship.loc.y=2*yRes%-100
ship.vel.x=0
ship.vel.y=0
ship.fuel=5000
ENDPROC
DEFPROCLevel3
LOCAL x,y
LOCAL DATA
RESTORE +1
DATA 0,100,200,250,300,400,550,700,700,600,650,500,450,200,500,100,520,40,720,40
DATA 900,500,800,700,900,750,1050,520,1100,360,1280,380
DATA -1,-1
CLS
GCOL 0,7
READ x,y
MOVE x,y
REPEAT
READ x,y
IF x=-1 EXIT REPEAT
DRAW x,y
UNTIL FALSE
RESTORE DATA
PLOT 141,10,10
GCOL 0,2
padX=600
padW=120
RECTANGLE FILL padX-padW/2,32,160,8
ship.loc.x=100
ship.loc.y=2*yRes%-100
ship.vel.x=0
ship.vel.y=0
ship.fuel=5000
ENDPROC
DEFPROCRings
CLS
GCOL 0,7
CIRCLE FILL 300,600,300
CIRCLE FILL 900,400,300
GCOL 0,0
CIRCLE FILL 300,600,200
CIRCLE FILL 900,400,200
RECTANGLE FILL 400,650,250,100
RECTANGLE FILL 800,550,100,300
GCOL 0,2
padX=950
padW=160
RECTANGLE FILL padX-padW/2,300,padW,8
ship.loc.x=300
ship.loc.y=600
ship.vel.x=0
ship.vel.y=0
ship.fuel=5000
ENDPROC
DEFPROCTunnel1
LOCAL x,y
LOCAL DATA :REM Store the existing data pointer, so we can move it here
RESTORE +1 :REM Start reading data from the next line
DATA 0,600,200,650,800,620,850,600,800,500,650,450,150,300,50,100,120,50,420,40,600,50
DATA 900,40,1100,40,1150,80,1100,160,880,180,280,200,300,230,550,250,950,420,1280,920
DATA -1,-1
CLS
GCOL 0,7
READ x,y
MOVE x,y
REM Rather than a whole string of draw commands, read and plot them in a loop
REPEAT
READ x,y
IF x=-1 EXIT REPEAT
DRAW x,y
UNTIL FALSE
RESTORE DATA :REM Put the old data pointer back in place
PLOT 141,10,10
GCOL 0,2
padX=1000
padW=120
RECTANGLE FILL padX-padW/2,32,160,8
ship.loc.x=100
ship.loc.y=2*yRes%-100
ship.vel.x=0
ship.vel.y=0
ship.fuel=5000
ENDPROC
DEFPROCTunnel2
LOCAL x,y
LOCAL DATA
RESTORE +1
DATA 0,200,100,50,200,20,450,70,800,100,1200,150,1250,400,1200,900,1100,950,650,700
DATA 350,500,700,450,950,450,980,540,600,560,1000,740,1050,700,950,360,480,280,280,200
DATA 300,500,550,750,850,920,900,1024
DATA -1,-1
CLS
GCOL 0,7
READ x,y
MOVE x,y
REPEAT
READ x,y
IF x=-1 EXIT REPEAT
DRAW x,y
UNTIL FALSE
RESTORE DATA
PLOT 141,10,10
GCOL 0,2
padX=840
padW=120
RECTANGLE FILL padX-padW/2,450,padW,8
ship.loc.x=100
ship.loc.y=2*yRes%-100
ship.vel.x=0
ship.vel.y=0
ship.fuel=5000
ENDPROC
DEFPROCMaze
LOCAL x,y,r
x=500
y=500
r=500
CLS
GCOL 0,7
CIRCLE FILL x,y,r
GCOL 0,0
CIRCLE FILL x,y,r-50
GCOL 0,7
CIRCLE FILL x,y,r-150
GCOL 0,0
CIRCLE FILL x,y,r-200
GCOL 0,7
CIRCLE FILL x,y,r-300
GCOL 0,0
CIRCLE FILL x,y,r-350
RECTANGLE FILL x+130,y-50,80,50
RECTANGLE FILL x-295,y,-60,50
RECTANGLE FILL x+430,y+50,80,50
padX=1150
padW=120
GCOL 0,2
RECTANGLE FILL padX-padW/2,250,padW,8
ship.loc.x=x
ship.loc.y=y
ship.vel.x=0
ship.vel.y=0
ship.fuel=5000
ENDPROC
DEFPROCLevel8
LOCAL x,y
LOCAL DATA
RESTORE +1
DATA 0,850,20,840,15,32,490,142,1024,28,1230,234,308,416,312,452,1112,356,1054,506
DATA 856,634,334,586,180,712,832,862,972,862,1000,894,840,966,346,888,112,718,190,530
DATA 896,554,906,448,152,520,82,418,498,216,1000,220,1010,112,490,206,136,160,64,134
DATA 100,834,428,1023
DATA -1,-1
CLS
GCOL 0,7
READ x,y
MOVE x,y
REPEAT
READ x,y
IF x=-1 EXIT REPEAT
DRAW x,y
UNTIL FALSE
RESTORE DATA
PLOT 141,10,10
GCOL 0,2
padX=892
padW=120
RECTANGLE FILL padX-padW/2,854,padW,8
ship.loc.x=100
ship.loc.y=2*yRes%-100
ship.vel.x=0
ship.vel.y=0
ship.fuel=8000
ENDPROC
All the best,
Joe.
Re: AstroLander (YouTube video)
Post by Joe68 on Nov 12th, 2016, 11:22am
Oops! I should tell you the keyboard controls!
'Z' = rotate left
'X' = rotate right
'/' = thrust
Re: AstroLander (YouTube video)
Post by Joe68 on Nov 13th, 2016, 09:44am
And here's Level9 - even harder than Level8!
Code: DEFPROCLevel9
LOCAL x,y
LOCAL DATA
RESTORE +1
DATA 0,800,204,640,90,568,170,334,260,452,318,112,376,72,520,566,798,568,528,326
DATA 716,74,774,302,896,276,1024,108,1176,510,854,766,418,688,560,800,780,850,1100,700
DATA 1200,700,1240,800,800,900,300,816,380,620,772,690,1060,516,1010,232,900,350,728,366
DATA 698,216,606,324,894,578,784,640,472,608,344,356,288,550,196,534,274,608,228,1024
DATA -1,-1
CLS
GCOL 0,7
READ x,y
MOVE x,y
p=1
REPEAT
READ x,y
IF x=-1 THEN EXIT REPEAT
DRAW x,y
p+=1
REM print tab(0,0)p,x,y
REM g=get
UNTIL FALSE
RESTORE DATA
PLOT 141,10,10
GCOL 0,2
padX=1150
padW=100
RECTANGLE FILL padX-padW/2,692,padW,8
ship.loc.x=100
ship.loc.y=2*yRes%-100
ship.vel.x=0
ship.vel.y=0
ship.fuel=9000
ENDPROC
Have fun!