|
lander
May 23, 2018 4:15:09 GMT
Post by bluatigro on May 23, 2018 4:15:09 GMT
this some homework i made for a groop of JB/LB entosiasts
i think the challence it gives is to easy for some gamers
the planet you land on likes like mars
'' bluatigro 20 may 2018 '' lander
WindowWidth = 800 WindowHeight = 600 global winx , winy , key$ , tijd , state , tel global fuel , lander.x , lander.y , lander.dy winx = WindowWidth winy = WindowHeight gosub [sprite] gosub [color] nomainwin call reset menu #m , "game" , "start game" , reset open "lander" for graphics as #m #m "trapclose [quit]" #m "when characterInput [key]" #m "setfocus" call sprite.clear 100 , 100 call sprite.line 30 , 10 , 10 , 90 , gray , 7 call sprite.line 70 , 10 , 90 , 90 , gray , 7 for i = 25 to 1 step -1 kl = mix( white , i / 25 , black ) call sprite.ellipse 50,i/3+20 , i*3,i*2 , kl , black next i call sprite.getbmp "lander_0" for i = 25 to 1 step -1 kl = mix( yellow , i / 25 , blue ) call sprite.ellipse 50,i/3+65 , i/1.5,i , kl , white next i call sprite.getbmp "lander_1" #m "addsprite lander lander_0 lander_1" #m "spritexy lander " ; lander.x ; " " ; lander.y call sprite.clear 10 , 100 for i = 0 to 100 call sprite.rectangle 0 , 100-i , 10 , 100 , cyan call sprite.getbmp "fuel" ; i anim$ = anim$ + " fuel" ; i next i #m "addsprite fuel" ; anim$ #m "spritexy fuel 50 50" #m "spritescale fuel 350" #m "goto 0 " ; winy * 2 / 3 #m "down" for i = -1 to 9 call sprite.clear 100 , 100 if i >=0 then call sprite.text 25 , 70 , str$( i ) , cyan , 50 end if call sprite.getbmp "tijd" ; i anim$ = anim$ + " tijd" ; i next i #m "addsprite tijd" ; anim$ #m "spritexy tijd " ; winx / 2 - 50 ; " 20" #m "fill 64 32 0" call setcolor red #m "boxfilled " ; winx ; " " ; winy #m "goto 0 " ; winy * 3 / 4 #m "down" #m "up" for i = 0 to 10 x1 = rnd.range( 0 , winx ) y1 = winy * 3 / 4 x2 = rnd.range( 0 , winy ) y2 = winy * 3 / 4 x3 = rnd.range( x1 , x2 ) y3 = rnd.range( winy * 3 / 4 _ , winy * 3 / 4 - abs( x1 - x2 ) ) clr = mix( red , rnd(0) , orange ) call sprite.triangle x1,y1,x2,y2,x3,y3,clr,0 next i #m "getbmp screen 0 0 " ; winx ; " " ; winy #m "background screen" timer 40 , [tijd] wait [tijd] tel = tel - 1 if tel < 0 then tel = -1 #m "spriteimage tijd tijd-1" ddy = .1 else #m "spriteimage tijd tijd" ; int( tel / 25 ) ddy = 0 end if #m "spriteimage fuel fuel" ; fuel #m "spriteimage lander lander_0" if key$ = " " and fuel > 0 then #m "spriteimage lander lander_1" fuel = fuel - 4 lander.dy = lander.dy - 1 end if key$ = "" lander.dy = lander.dy + ddy lander.y = lander.y + lander.dy if lander.y > winy * 3 / 4 then timer 0 if lander.dy > 5 then notice "GAME OVER : YOU CRASED !!" else notice "GAME OVER : you landed savely ." end if confirm "play again ?" ; yn$ if yn$ = "yes" then call reset timer 40 , [tijd] else close #m end end if end if #m "spritexy lander " ; lander.x _ ; " " ; int( lander.y ) #m "drawsprites" wait [key] key$ = right$( Inkey$ , 1 ) if key$ <> chr$( 27 ) then wait [quit] close #m end sub reset fuel = 100 lander.x = winx / 2 - 50 lander.y = winy / 4 lander.dy = 0 state = 0 tijd = 9 tel = 9 * 25 end sub function rnd.range( l , h ) rnd.range = rnd( 0 ) * ( h - l ) + l end function ''bluatigro 20 may 2018 ''sprite module
[sprite] global sprite.width , sprite.height return
sub sprite.clear w , h #m "fill white" #m "goto 0 " ; h #m "size 1" #m "down" #m "color black" #m "backcolor black" #m "boxfilled " ; w ; " " ; h * 2 #m "up" sprite.width = w sprite.height = h end sub
sub sprite.triangle x1 , y1 , x2 , y2 , x3 , y3 , clr , spr if y1 = y2 then y1 = y1 - 1e-10 if y2 = y3 then y3 = y3 + 1e-10 if y1 > y3 then h = y1 y1 = y3 y3 = h h = x1 x1 = x3 x3 = h end if if y1 > y2 then h = y1 y1 = y2 y2 = h h = x1 x1 = x2 x2 = h end if if y2 > y3 then h = y2 y2 = y3 y3 = h h = x2 x2 = x3 x3 = h end if
for i = y1 to y3 a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 ) if i < y2 then b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 ) else b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 ) end if if spr then #m "color black" #m "down" #m "line " ; a ; " " ; i _ ; " " ; b ; " " ; i #m "up" call setcolor clr #m "down" #m "line " ; a ; " " ; i + sprite.height _ ; " " ; b ; " " ; i + sprite.height #m "up" else call setcolor clr #m "down" #m "line " ; a ; " " ; i ; " " ; b ; " " ; i #m "up" end if next i end sub
sub sprite.rectangle x1,y1,x2,y2,clr #m "goto " ; x1 ; " " ; y1 #m "size 1" #m "color black" #m "backcolor black" #m "down" #m "boxfilled " ; x2 ; " " ; y2 #m "up" #m "goto " ; x1 ; " " ; y1 + sprite.height call setcolor clr #m "down" #m "boxfilled " ; x2 ; " " ; y2 + 60 #m "up" end sub
sub sprite.ellipse x,y,dx,dy,clr,bclr #m "goto " ; x ; " " ; y #m "down" call setcolor bclr #m "ellipsefilled " ; dx ; " " ; dy #m "up" #m "goto " ; x ; " " ; y + sprite.height #m "down" call setcolor clr #m "ellipsefilled " ; dx ; " " ; dy #m "up" end sub
sub sprite.pie x,y,dx,dy,a,b,clr$,bclr$,size #m "goto " ; x ; " " ; y #m "size " ; size #m "down" #m "color black" #m "backcolor black" #m "piefilled " ; dx ; " " ; dy _ ; " " ; a ; " " ; b #m "up" #m "goto " ; x ; " " ; y + sprite.height #m "down" #m "color " ; clr$ #m "backcolor " ; bclr$ #m "piefilled " ; dx ; " " ; dy _ ; " " ; a ; " " ; b #m "up" end sub
sub sprite.text x , y , text$ , clr , size #m "font " ; size ; " bold" #m "goto " ; x ; " " ; y #m "color black" #m "backcolor white" #m "down" #m "\" ; text$ #m "up" #m "goto " ; x ; " " ; y + sprite.height call setcolor clr #m "backcolor black" #m "down" #m "\" ; text$ #m "up" end sub
sub sprite.line x1,y1 , x2,y2 , clr , size #m "color black" #m "size " ; size #m "down" #m "line " ; x1 ; " " ; y1 _ ; " " ; x2 ; " " ; y2 #m "up" call setcolor clr #m "down" #m "line " ; x1 ; " " ; y1 + sprite.height _ ; " " ; x2 ; " " ; y2 + sprite.height #m "up" end sub
sub sprite.getbmp bmp$ #m "getbmp " ; bmp$ ; " 0 0 " _ ; sprite.width ; " " ; sprite.height * 2 end sub
''bluatigro 26 apr 2018 ''color module ''needs : ''math module
[color] global black , red , green , yellow global blue , magenta , cyan , white global pink , orange , gray , purple black = rgb( 0 , 0 , 0 ) red = rgb( 255 , 0 , 0 ) green = rgb( 0 , 255 , 0 ) yellow = rgb( 255 , 255 , 0 ) blue = rgb( 0 , 0 , 255 ) magenta = rgb( 255 , 0 , 255 ) cyan = rgb( 0 , 255 , 255 ) white = rgb( 255 , 255 , 255 ) pink = rgb( 255 , 127 , 127 ) orange = rgb( 255 , 127 , 0 ) gray = rgb( 127 , 127 , 127 ) purple = rgb( 127 , 0 , 127 ) return
sub setcolor kl r = int( kl and 255 ) g = int( kl / 256 ) and 255 b = int( kl / 256 / 256 ) and 255 print #m , "backcolor " ; r ;" "; g ; " "; b print #m , "color " ; r ; " " ; g ; " " ; b end sub
function rgb( r , g , b ) rgb = ( int( r ) and 255 ) _ + ( int( g ) and 255 ) * 256 _ + ( int( b ) and 255 ) * 256 * 256 end function
function rainbow( x ) r = sin( rad( x ) ) * 127 + 128 g = sin( rad( x - 120 ) ) * 127 + 128 b = sin( rad( x + 120 ) ) * 127 + 128 rainbow = rgb( r , g , b ) end function
function mix( kl1 , f , kl2 ) r1 = int( kl1 and 255 ) g1 = int( kl1 / 256 ) and 255 b1 = int( kl1 / 256 / 256 ) and 255 r2 = int( kl2 and 255 ) g2 = int( kl2 / 256 ) and 255 b2 = int( kl2 / 256 / 256 ) and 255 r = r1 + ( r2 - r1 ) * f g = g1 + ( g2 - g1 ) * f b = b1 + ( b2 - b1 ) * f mix = rgb( r , g , b ) end function
|
|
|
lander
May 23, 2018 7:56:10 GMT
Post by tsh73 on May 23, 2018 7:56:10 GMT
really nice.
|
|
|
lander
May 23, 2018 13:25:26 GMT
Post by B+ on May 23, 2018 13:25:26 GMT
Oh hey! very nice game.
Could throw an instruction in the title:
open "lander use spacebar for thrusters to control descent..." for graphics as #m
Also you could give points for landing safely with least amount of fuel used.
|
|
|
lander
May 23, 2018 14:02:22 GMT
Post by B+ on May 23, 2018 14:02:22 GMT
Oh hey! I just found the text version of this game in another Basic forum. It just needed one change to work in JB! 10 REM Lunar Lander 20 REM By Diomidis Spinellis 30 PRINT "You aboard the Lunar Lander about to leave the spacecraft." 60 GOSUB 4000 70 GOSUB 1000 80 GOSUB 2000 90 GOSUB 3000 100 H = H - V 110 V = ((V + G) * 10 - U * 2) / 10 120 F = F - U 130 IF H > 0 THEN 80 135 H = 0 140 GOSUB 2000 150 IF V > 5 THEN 200 160 PRINT "Congratulations! This was a very good landing." 170 GOSUB 5000 180 GOTO 10 200 PRINT "You have crashed." 210 GOTO 170 1000 REM Initialise 1010 V = 70 1020 F = 500 1030 H = 1000 1040 G = 2 1050 RETURN 2000 REM Print values 2010 PRINT " Meter readings" 2015 PRINT " --------------" 2020 PRINT "Fuel (gal):" 2030 PRINT F '2040 GOSUB 2100 + 100 * (H <> 0) ' fix this if H <> 0 then GOSUB 2200 else gosub 2100 2050 PRINT V 2060 PRINT "Height (m):" 2070 PRINT H 2080 RETURN 2100 PRINT "Landing velocity (m/sec):" 2110 RETURN 2200 PRINT "Velocity (m/sec):" 2210 RETURN 3000 REM User input 3005 IF F = 0 THEN 3070 3010 PRINT "How much fuel will you use?" 3020 INPUT U 3025 IF U < 0 THEN 3090 3030 IF U <= F THEN 3060 3040 PRINT "Sorry, you have not got that much fuel!" 3050 GOTO 3010 3060 RETURN 3070 U = 0 3080 RETURN 3090 PRINT "No cheating please! Fuel must be >= 0." 3100 GOTO 3010 4000 REM Detachment 4005 PRINT "Ready for detachment" 4007 PRINT "-- COUNTDOWN --" 4010 FOR I = 1 TO 11 4020 PRINT 11 - I 4025 GOSUB 4500 4030 NEXT I 4035 PRINT "You have left the spacecraft." 4037 PRINT "Try to land with velocity less than 5 m/sec." 4040 RETURN 4500 REM Delay 4510 FOR J = 1 TO 500 4520 NEXT J 4530 RETURN 5000 PRINT "Do you want to play again? (0 = no, 1 = yes)" 5010 INPUT Y 5020 IF Y = 0 THEN 5040 5030 RETURN 5040 PRINT "Have a nice day."
So a picture is what about 100 lines?
|
|
|
lander
May 23, 2018 14:06:14 GMT
Post by B+ on May 23, 2018 14:06:14 GMT
The Lander in the JB samples is merciless!!!
|
|
|
lander
May 23, 2018 21:04:54 GMT
Post by tsh73 on May 23, 2018 21:04:54 GMT
Ah, text-only turn-based vs. arcade "push-that-button-quick-or-we-gonna-crash" is really different game. Even if maths underneath are the same. Like text turn-based RPG and Diablo indeed. Probably small countdown in the beginning, like Bluatigro did, would help a bit.
|
|
|
lander
May 26, 2018 15:02:54 GMT
Post by Rod on May 26, 2018 15:02:54 GMT
I reworked Lander a while back for the example program update, Think it is in the compendium. It needs the thrust to be visible to give more feedback on what is happening. But it is a LOT more playable than the original.
'Lander.bas 'written by Carl Gundel 'carlg@world.std.com 'Needs at least Liberty BASIC v2.0 'This file is contributed to the public domain
'Use the left or right arrow keys to rotate left or right 'Use the up or down arrow to increase or decrease thrust
'You must make a VERY gentle and level landing 'on one of the flat areas!
'open game window
nomainwin WindowWidth = 800 WindowHeight = 600 UpperLeftX = int((DisplayWidth-WindowWidth)/2) UpperLeftY = int((DisplayHeight-WindowHeight)/2) dim terrain(WindowWidth) graphicbox #lander.fuel 10,10,10,500 open "Lunar Lander" for graphics_nsb as #lander #lander "when characterInput [control]" #lander "trapclose [quit]"
call makeSprites call setBackground #lander "spritexy lem 50 50" #lander.fuel "down ; fill yellow ; size 4 ; north ;color green"
[startGame] 'initialize #lander "setfocus" fuel = 250 altitude = 0 attitude = 0 longitude = 10 thrust = 0 call setHorizSpeed 8 call setVertSpeed 0 call gravityAccelerate timer 100, [timerTicked] startTime = time$("milliseconds") wait
[timerTicked] 'This is the main simulation routine!
frames = frames + 1 if altitude <= terrain(longitude+15) - 24 and fuel>0 then fuel=fuel-thrust call setAttitude attitude call applyThrust thrust, attitude call gravityAccelerate altitude = altitude + getVertSpeed() longitude = max(0, min(785, longitude + getHorizSpeed())) #lander "spritexy lem "; longitude; " "; altitude #lander "drawsprites" #lander.fuel "cls ;fill yellow ;place 4 500 ; go ";fuel*2 else timer 0 crash = landerCrashed(longitude, attitude,fuel) if crash then cause$="You crashed!"+chr$(13) if crash and 1 then cause$=cause$+"Not verticle"+chr$(13) if crash and 2 or crash and 4 then cause$=cause$+"Too fast"+chr$(13) if crash and 8 then cause$=cause$+"Missed the base"+chr$(13) if crash and 16 then cause$=cause$+"Out of fuel" notice cause$ else notice "Successful landing!" end if confirm "Try again?"; answer if answer then [startGame] else [quit] end if
wait
[quit] timer 0 close #lander
end
[control] key = asc(right$(Inkey$,1)) select case key case _VK_UP thrustInput=thrustInput+(thrustInput<9) if thrustInput then thrust = (thrustInput - 1) / 8 * 0.55 + 0.333
case _VK_DOWN thrustInput=thrustInput-(thrustInput>0) if thrustInput then thrust = (thrustInput - 1) / 8 * 0.55 + 0.333
case _VK_LEFT attitude = attitude - 22.5 if attitude < -0.01 then attitude = 337.5
case _VK_RIGHT attitude = attitude + 22.5 if attitude > 337.51 then attitude = 0 end select wait
function landerCrashed(xPosition, attitude,fuel)
if attitude<89 or attitude>91 then landerCrashed=landerCrashed+1 if getVertSpeed() > 4 then landerCrashed=landerCrashed+2 if getHorizSpeed() > 4 then landerCrashed=landerCrashed+4 if terrain(xPosition+7) <> terrain(xPosition+22) then landerCrashed=landerCrashed+8 if fuel<=0 then landerCrashed=landerCrashed+16 end function
sub makeSprites
open "lem" for graphics as #makeSprites #makeSprites "down" #makeSprites "place 0 31 ; backColor black ; boxfilled 640 73" for x = 0 to 15 y = 1 call drawLEM x, y, 270 + x * 22.5, 2, "black" y = 2 call drawLEM x, y, 270 + x * 22.5, 2, "darkgray" call drawLEM x, y, 270 + x * 22.5, 1, "lightgray" call getSprite x next x close #makeSprites #lander "addsprite lem lem0 lem1 lem2 lem3 lem4 lem5 lem6 lem7 lem8 lem9 lem10 lem11 lem12 lem13 lem14 lem15"
end sub
sub drawLEM xPosition, yPosition, uncorrectedAngle, penSize, color$ angle = uncorrectedAngle #makeSprites "north ; color "; color$; " ; up ; turn "; angle #makeSprites "place "; (xPosition)*30+15; " "; (yPosition-1)*30+15 #makeSprites "size "; penSize #makeSprites "up ; go 4 ; down ; circlefilled 8" #makeSprites "turn 75 ; go 4 ; turn 180 ; go 4" #makeSprites "turn 30 ; go 4 ; turn 180 ; go 4 ; turn 255" #makeSprites "up ; turn 160 ; go 8" #makeSprites "down ; go 4 ; turn 110" #makeSprites "go 8 ; turn 110 ; go 4" #makeSprites "place "; (xPosition)*30+15; " "; (yPosition-1)*30+15 #makeSprites "north ; up ; turn "; angle #makeSprites "go 4 ; turn 125 ; go 8 ; down ; turn 45 ; go 8" #makeSprites "place "; (xPosition)*30+15; " "; (yPosition-1)*30+15 #makeSprites "north ; up ; turn "; angle #makeSprites "go 4 ; turn 235 ; go 8 ; down ; turn -45 ; go 8"
end sub
sub setBackground #lander "down ; fill black" 'stars for s = 1 to 100 c=int(rnd(0)*100+156) #lander "color ";c;" ";c;" ";c #lander "size ";int(rnd(0)*4) #lander "set ";rnd(0)*800;" ";rnd(0)*600 next call drawTerrain #lander "getbmp stars 0 0 800 600" #lander "background stars" end sub
sub getSprite spritNum spriteX = spritNum * 30 #makeSprites "getbmp lem"; spritNum; " "; spriteX; " 1 30 60" end sub
sub setHorizSpeed xSpeed vars(0) = xSpeed end sub
sub setVertSpeed ySpeed vars(1) = ySpeed end sub
function getHorizSpeed() getHorizSpeed = vars(0) end function
function getVertSpeed() getVertSpeed = vars(1) end function
sub setAttitude degrees #lander "spriteimage lem lem"; int(degrees / 22.5) end sub
sub gravityAccelerate call setVertSpeed getVertSpeed() + 0.3'(6/18) end sub
sub applyThrust qtyFuel, angle angleXform = angle / 180 * 3.141592 call setHorizSpeed getHorizSpeed() - (qtyFuel/2) * cos(angleXform) call setVertSpeed getVertSpeed() - (qtyFuel/2) * sin(angleXform) end sub
sub drawTerrain
rate1 = rnd(1) / (rnd(1) * 10 + 5) rate2 = rnd(1) / (rnd(1) * 5 + 5) #lander "down ; size 1 ; color white"
for x = 0 to 799 step 1 if rnd(1) < 0.015 then gosub [makeLandingZone] holder1 = holder1+rate1 holder2 = holder2+rate2 holder3 = holder3+sin(holder2)/20 y = 400+int(sin(holder1)*50)+int(cos(holder2)*50)+int(cos(holder3)*15) terrain(x) = y c=rnd(0)*50+50 #lander "color ";c;" ";c;" ";c;" ; line ";x;" 600 ";x; " ";y next x goto [endSub]
[makeLandingZone]
width = int((rnd(1)*4+2)/3) for lz = x to min(799, x + 34 * width) terrain(lz) = y c=rnd(0)*50+50 #lander "color ";c;" ";c;" ";c;" ; line ";lz;" 600 ";lz; " ";y next lz #lander "color red ; line ";x;" ";y;" ";lz;" ";y x = lz return
[endSub]
end sub
|
|
|
lander
May 26, 2018 18:14:25 GMT
Post by B+ on May 26, 2018 18:14:25 GMT
Give us a chance! (Well at least, see the fuel gage and more landing spots.)
'Lander by Carl mod Rod mod B+.bas for JB v2 started 2018-05-26 'from Rod's mod of 'written by Carl Gundel 'carlg@world.std.com 'Needs at least Liberty BASIC v2.0 ???? 'This file is contributed to the public domain
'Use the left or right arrow keys to rotate left or right 'Use the up or down arrow to increase or decrease thrust
'You must make a VERY gentle and level landing 'on one of the flat areas!
'open game window
nomainwin WindowWidth = 800 WindowHeight = 600 UpperLeftX = int((DisplayWidth-WindowWidth)/2) UpperLeftY = int((DisplayHeight-WindowHeight)/2) dim terrain(WindowWidth) graphicbox #lander.fuel 10,10,10,500 open "Lunar Lander" for graphics_nsb as #lander #lander "when characterInput [control]" #lander "trapclose [quit]"
call makeSprites call setBackground #lander "spritexy lem 50 50" #lander.fuel "down ; fill red ; size 4 ; north ;color yellow"
[startGame] 'initialize #lander "setfocus" fuel = 250 altitude = 0 attitude = 0 longitude = 10 thrust = 0 call setHorizSpeed 8 call setVertSpeed 0 call gravityAccelerate timer 120, [timerTicked] startTime = time$("milliseconds") wait
[timerTicked] 'This is the main simulation routine!
frames = frames + 1 if altitude <= terrain(longitude+15) - 24 and fuel>0 then fuel=fuel-thrust call setAttitude attitude call applyThrust thrust, attitude call gravityAccelerate altitude = altitude + getVertSpeed() longitude = max(0, min(785, longitude + getHorizSpeed())) #lander "spritexy lem "; longitude; " "; altitude #lander "drawsprites" #lander.fuel "cls ;fill red ;place 4 500 ; go ";fuel*2 else timer 0 crash = landerCrashed(longitude, attitude,fuel) if crash then cause$="You crashed!"+chr$(13) if crash and 1 then cause$=cause$+"Not verticle"+chr$(13) if crash and 2 or crash and 4 then cause$=cause$+"Too fast"+chr$(13) if crash and 8 then cause$=cause$+"Missed the base"+chr$(13) if crash and 16 then cause$=cause$+"Out of fuel" notice cause$ else notice "Successful landing!" end if confirm "Try again?"; answer if answer then [startGame] else [quit] end if
wait
[quit] timer 0 close #lander
end
[control] key = asc(right$(Inkey$,1)) select case key case _VK_UP thrustInput=thrustInput+(thrustInput<9) if thrustInput then thrust = (thrustInput - 1) / 8 * 0.55 + 0.333
case _VK_DOWN thrustInput=thrustInput-(thrustInput>0) if thrustInput then thrust = (thrustInput - 1) / 8 * 0.55 + 0.333
case _VK_LEFT attitude = attitude - 22.5 if attitude < -0.01 then attitude = 337.5
case _VK_RIGHT attitude = attitude + 22.5 if attitude > 337.51 then attitude = 0 end select wait
function landerCrashed(xPosition, attitude,fuel)
if attitude<89 or attitude>91 then landerCrashed=landerCrashed+1 if getVertSpeed() > 4 then landerCrashed=landerCrashed+2 if getHorizSpeed() > 4 then landerCrashed=landerCrashed+4 if terrain(xPosition+7) <> terrain(xPosition+22) then landerCrashed=landerCrashed+8 if fuel<=0 then landerCrashed=landerCrashed+16 end function
sub makeSprites
open "lem" for graphics as #makeSprites #makeSprites "down" #makeSprites "place 0 31 ; backColor black ; boxfilled 640 73" for x = 0 to 15 y = 1 call drawLEM x, y, 270 + x * 22.5, 2, "black" y = 2 call drawLEM x, y, 270 + x * 22.5, 2, "darkgray" call drawLEM x, y, 270 + x * 22.5, 1, "lightgray" call getSprite x next x close #makeSprites #lander "addsprite lem lem0 lem1 lem2 lem3 lem4 lem5 lem6 lem7 lem8 lem9 lem10 lem11 lem12 lem13 lem14 lem15"
end sub
sub drawLEM xPosition, yPosition, uncorrectedAngle, penSize, color$ angle = uncorrectedAngle #makeSprites "north ; color "; color$; " ; up ; turn "; angle #makeSprites "place "; (xPosition)*30+15; " "; (yPosition-1)*30+15 #makeSprites "size "; penSize #makeSprites "up ; go 4 ; down ; circlefilled 8" #makeSprites "turn 75 ; go 4 ; turn 180 ; go 4" #makeSprites "turn 30 ; go 4 ; turn 180 ; go 4 ; turn 255" #makeSprites "up ; turn 160 ; go 8" #makeSprites "down ; go 4 ; turn 110" #makeSprites "go 8 ; turn 110 ; go 4" #makeSprites "place "; (xPosition)*30+15; " "; (yPosition-1)*30+15 #makeSprites "north ; up ; turn "; angle #makeSprites "go 4 ; turn 125 ; go 8 ; down ; turn 45 ; go 8" #makeSprites "place "; (xPosition)*30+15; " "; (yPosition-1)*30+15 #makeSprites "north ; up ; turn "; angle #makeSprites "go 4 ; turn 235 ; go 8 ; down ; turn -45 ; go 8"
end sub
sub setBackground #lander "down ; fill black" 'stars for s = 1 to 100 c=int(rnd(0)*100+156) #lander "color ";c;" ";c;" ";c #lander "size ";int(rnd(0)*4) #lander "set ";rnd(0)*800;" ";rnd(0)*600 next call drawTerrain #lander "getbmp stars 0 0 800 600" #lander "background stars" end sub
sub getSprite spritNum spriteX = spritNum * 30 #makeSprites "getbmp lem"; spritNum; " "; spriteX; " 1 30 60" end sub
sub setHorizSpeed xSpeed vars(0) = xSpeed end sub
sub setVertSpeed ySpeed vars(1) = ySpeed end sub
function getHorizSpeed() getHorizSpeed = vars(0) end function
function getVertSpeed() getVertSpeed = vars(1) end function
sub setAttitude degrees #lander "spriteimage lem lem"; int(degrees / 22.5) end sub
sub gravityAccelerate call setVertSpeed getVertSpeed() + 0.3'(6/18) end sub
sub applyThrust qtyFuel, angle angleXform = angle / 180 * 3.141592 call setHorizSpeed getHorizSpeed() - (qtyFuel/2) * cos(angleXform) call setVertSpeed getVertSpeed() - (qtyFuel/2) * sin(angleXform) end sub
sub drawTerrain
rate1 = rnd(1) / (rnd(1) * 10 + 5) rate2 = rnd(1) / (rnd(1) * 5 + 5) #lander "down ; size 1 ; color white"
for x = 0 to 799 step 1 if rnd(1) < 0.02 then gosub [makeLandingZone] holder1 = holder1+rate1 holder2 = holder2+rate2 holder3 = holder3+sin(holder2)/20 y = 400+int(sin(holder1)*50)+int(cos(holder2)*50)+int(cos(holder3)*15) terrain(x) = y c=rnd(0)*50+50 #lander "color ";c;" ";c;" ";c;" ; line ";x;" 600 ";x; " ";y next x goto [endSub]
[makeLandingZone]
width = int((rnd(1)*4+2)/2) for lz = x to min(799, x + 34 * width) terrain(lz) = y c=rnd(0)*50+50 #lander "color ";c;" ";c;" ";c;" ; line ";lz;" 600 ";lz; " ";y next lz #lander "size 4" #lander "color yellow ; line ";x;" ";y;" ";lz;" ";y #lander "size 1" x = lz return
[endSub]
end sub
|
|
|
lander
May 29, 2018 14:10:34 GMT
Post by tsh73 on May 29, 2018 14:10:34 GMT
more playable indeed. I wonder if having LEM as a sprite worths it - it's pretty simple so could be drawn pretty fast?
|
|
|
lander
May 29, 2018 14:37:52 GMT
Post by B+ on May 29, 2018 14:37:52 GMT
more playable indeed. I wonder if having LEM as a sprite worths it - it's pretty simple so could be drawn pretty fast? I think it is in samples as an example of making and using multiple sprites. In such examples, the simpler the better. I myself wonder if the thruster system could be made more responsive to the key presses; because when I get the lander oriented upright, and tap away at the up arrow to slow the thing down, it doesn't seem to respond in timely manner or it ends up floating off into space with gravity failing to to it's job. It's not right! and if real astronauts had to use that thing, the space program would soon be out of business. I hope it's not using the tangent function, when dx = 0 dy = 1 might zero out because dy/dx would be undefined? OK now I have a theory to check... append: nope no tangent function in sight. I don't know why a few global variables aren't used, why a separate sub has to be made to set a variable? This is silly! sub setHorizSpeed xSpeed vars(0) = xSpeed end sub
sub setVertSpeed ySpeed vars(1) = ySpeed end sub
function getHorizSpeed() getHorizSpeed = vars(0) end function
function getVertSpeed() getVertSpeed = vars(1) end function
|
|
|
lander
May 29, 2018 18:50:27 GMT
Post by B+ on May 29, 2018 18:50:27 GMT
OK I have rewired the control system and rewrote the physics of the Lander model. Here you can only thrust forward in direction ship is pointed with the up button, no reverse (down button). Speed is based on momentum. Acceleration changes momentum. Acceleration comes from main thruster or using side thrusters to reorient ship. That is when you burn fuel. I find the control more satisfactory: 'Lander mod 2.txt for JB v2 B+ 2018-05-29
'Lander by Carl mod Rod mod B+.bas for JB v2 started 2018-05-26 'from Rod's mod of 'written by Carl Gundel 'carlg@world.std.com 'Needs at least Liberty BASIC v2.0 ???? 'This file is contributed to the public domain
'Use the left or right arrow keys to rotate left or right 'Use the up or down arrow to increase or decrease thrust
'You must make a VERY gentle and level landing 'on one of the flat areas!
'open game window global xmax, ymax xmax = 800 ymax = 600
nomainwin WindowWidth = xmax + 8 WindowHeight = ymax + 32 UpperLeftX = int((DisplayWidth-WindowWidth)/2) UpperLeftY = int((DisplayHeight-WindowHeight)/2)
graphicbox #lander.fuel 10,10,10,500 open "Lunar Lander" for graphics_nsb as #lander #lander "when characterInput [control]" #lander "trapclose [quit]"
call makeSprites 'make landing scene and record surface heights of land in terrain() dim terrain(xmax) call setBackground #lander "spritexy lem 50 50" #lander.fuel "down ; fill red ; size 4 ; north ;color yellow"
global pi, d2r, fuel, vda, speed, vx, vy, dx, dy, dg, dat pi = acs(-1) 'this is your main constant pi that every Basic should have built-in d2r = pi/180 'this is conversion factor from an angle measured in degrees to one in radians ie degrees to radians
[startGame] 'initialize #lander "setfocus" fuel = 500 'this is the space vehicle's fuel
'vda is vehicle degree angle = orientation of the vehicle, mainly it's thrusters vda = 0 'the vehicle is traveling right across screen due East = 0 degrees = 0 Radians speed = 3 'this is the speed the vehicle is moving in the vda direction vx = 50 'this is current x position of vehicle 50 pixles from left side vy = 10 'this is current y position of vehicle 10 pixels down from top of screen
'd stands for delta with stands for change dx = change in x, dy = change in y 'dg is change due to gravity (vertical) 'dat is change of acceleration due to thrust dx = speed * cos(d2r * vda) 'this is the horizontal x change on screen due to speed and angle dy = speed * sin(d2r * vda) 'this is the vertical y change on screen due to speed and angle dg = .1 'this is the constant acceleration gravity applies to the vehicle dat = 2 'this is burst of acceleration a thrust or reverse thrust will apply to speed and angle timer 100, [timerTicked] 'update all of the above at each click of time wait
[timerTicked] 'This is the main simulation routine!
'vehicle falls faster and faster, because gravity effects the vertical speed dy = dy + dg 'speed up falling due to gravity acceleration
'new position = last postion plus the horizontal and vertical changes from momentum vx = vx + dx vy = vy + dy
if vx < 20 or vx > xmax - 10 or vy < -50 then notice "You have drifted off screen." : goto [reconfirm] end if
if vy <= terrain(vx + 15) - 24 and fuel > 0 then #lander "spriteimage lem lem"; int(vda / 22.5) #lander "spritexy lem "; vx; " "; vy #lander "drawsprites" #lander.fuel "cls ;fill red ;place 4 500 ; go ";fuel else crash$ = "" if vda <> 90 then crash$ = "Vehicle not upright. " if dy > 4 then crash$ = crash$ + "Came down too fast. " if dx > 4 then crash$ = crash$ + "Still moving hoizontally too fast. " if fuel <= 0 then crash$ = crash$ + "Ran out of fuel. " if terrain(vx + 7) <> terrain(vx + 22) then crash$ = crash$ + "Did not land on level site. " if crash$ <> "" then cause$ = "You crashed!" + chr$(13) + crash$ notice cause$ else notice "Successful landing!" end if goto [reconfirm] end if wait
[reconfirm] timer 0 confirm "Try again?"; answer if answer then [startGame]
[quit] timer 0 close #lander end
[control]
'Rocket Science 101: It only cost fuel to accelerate the rocket vehicle ' either with a thrust or with a turn of orientation
key = asc(right$(Inkey$, 1)) select case key case _VK_UP
'here is the vertical and horizontal change from a burst of fuel for thrust thrustx = dat * cos(d2r * vda + pi) thrusty = dat * sin(d2r * vda + pi)
'now change the horizontal and vertical momentums from the thrust dx = dx + thrustx dy = dy + thrusty
'update the position vx = vx + dx vy = vy + dy
'the thrust cost fuel fuel = fuel - 10
'case _VK_DOWN 'Rocket Science 101: You can't reverse thrust a rocket engine!
case _VK_LEFT vda = vda - 22.5 if vda < -0.01 then vda = 0 fuel = fuel - 10
case _VK_RIGHT vda = vda + 22.5 if vda > 337.51 then vda = 0 fuel = fuel - 10
end select wait
sub makeSprites
open "lem" for graphics as #makeSprites #makeSprites "down" #makeSprites "place 0 31 ; backColor black ; boxfilled 640 73" for x = 0 to 15 y = 1 call drawLEM x, y, 270 + x * 22.5, 2, "black" y = 2 call drawLEM x, y, 270 + x * 22.5, 2, "darkgray" call drawLEM x, y, 270 + x * 22.5, 1, "lightgray" call getSprite x next x close #makeSprites #lander "addsprite lem lem0 lem1 lem2 lem3 lem4 lem5 lem6 lem7 lem8 lem9 lem10 lem11 lem12 lem13 lem14 lem15"
end sub
sub drawLEM xPosition, yPosition, uncorrectedAngle, penSize, color$ angle = uncorrectedAngle #makeSprites "north ; color "; color$; " ; up ; turn "; angle #makeSprites "place "; (xPosition)*30+15; " "; (yPosition-1)*30+15 #makeSprites "size "; penSize #makeSprites "up ; go 4 ; down ; circlefilled 8" #makeSprites "turn 75 ; go 4 ; turn 180 ; go 4" #makeSprites "turn 30 ; go 4 ; turn 180 ; go 4 ; turn 255" #makeSprites "up ; turn 160 ; go 8" #makeSprites "down ; go 4 ; turn 110" #makeSprites "go 8 ; turn 110 ; go 4" #makeSprites "place "; (xPosition)*30+15; " "; (yPosition-1)*30+15 #makeSprites "north ; up ; turn "; angle #makeSprites "go 4 ; turn 125 ; go 8 ; down ; turn 45 ; go 8" #makeSprites "place "; (xPosition)*30+15; " "; (yPosition-1)*30+15 #makeSprites "north ; up ; turn "; angle #makeSprites "go 4 ; turn 235 ; go 8 ; down ; turn -45 ; go 8"
end sub
sub setBackground #lander "down ; fill black" 'stars for s = 1 to 100 c=int(rnd(0)*100+156) #lander "color ";c;" ";c;" ";c #lander "size ";int(rnd(0)*4) #lander "set ";rnd(0)*800;" ";rnd(0)*600 next call drawTerrain #lander "getbmp stars 0 0 800 600" #lander "background stars" end sub
sub getSprite spritNum spriteX = spritNum * 30 #makeSprites "getbmp lem"; spritNum; " "; spriteX; " 1 30 60" end sub
sub drawTerrain
rate1 = rnd(1) / (rnd(1) * 10 + 5) rate2 = rnd(1) / (rnd(1) * 5 + 5) #lander "down ; size 1 ; color white" for x = 0 to 799 step 1 if rnd(1) < 0.02 then gosub [makeLandingZone] holder1 = holder1+rate1 holder2 = holder2+rate2 holder3 = holder3+sin(holder2)/20 y = 400+int(sin(holder1)*50)+int(cos(holder2)*50)+int(cos(holder3)*15) terrain(x) = y c=rnd(0)*50+50 #lander "color ";c;" ";c;" ";c;" ; line ";x;" 600 ";x; " ";y next x goto [endSub]
[makeLandingZone]
width = int((rnd(1)*4+2)/2) for lz = x to min(799, x + 34 * width) terrain(lz) = y c=rnd(0)*50+50 #lander "color ";c;" ";c;" ";c;" ; line ";lz;" 600 ";lz; " ";y next lz #lander "size 2" #lander "color yellow ; line ";x;" ";y;" ";lz;" ";y #lander "size 1" x = lz return
[endSub]
end sub
Attachments:
|
|
|
lander
Jun 24, 2018 8:48:03 GMT
Post by bluatigro on Jun 24, 2018 8:48:03 GMT
update : left and right move added
use cursor keys to steer
'' bluatigro 20 may 2018 '' lander
WindowWidth = 800 WindowHeight = 600 global winx , winy , key$ , tijd , state , tel global fuel , lander.x , lander.y global lander.dx , lander.dy winx = WindowWidth winy = WindowHeight gosub [sprite] gosub [color] nomainwin call reset menu #m , "game" , "start game" , reset open "lander" for graphics as #m #m "trapclose [quit]" #m "when characterInput [key]" #m "setfocus" call sprite.clear 100 , 100 call sprite.line 30 , 10 , 10 , 90 , gray , 7 call sprite.line 70 , 10 , 90 , 90 , gray , 7 for i = 25 to 1 step -1 kl = mix( white , i / 25 , black ) call sprite.ellipse 50,i/3+20 , i*3,i*2 , kl , black next i call sprite.getbmp "lander_0" for i = 25 to 1 step -1 kl = mix( yellow , i / 25 , blue ) call sprite.ellipse 50,i/3+65 , i/1.5,i , kl , white next i call sprite.getbmp "lander_1" #m "addsprite lander lander_0 lander_1" #m "spritexy lander " ; lander.x ; " " ; lander.y call sprite.clear 10 , 100 for i = 0 to 100 call sprite.rectangle 0 , 100-i , 10 , 100 , cyan call sprite.getbmp "fuel" ; i anim$ = anim$ + " fuel" ; i next i #m "addsprite fuel" ; anim$ #m "spritexy fuel 50 50" #m "spritescale fuel 350" #m "goto 0 " ; winy * 2 / 3 #m "down" for i = -1 to 9 call sprite.clear 100 , 100 if i >= 0 then call sprite.text 25 , 70 , str$( i ) , cyan , 50 end if call sprite.getbmp "tijd" ; i anim$ = anim$ + " tijd" ; i next i #m "addsprite tijd" ; anim$ #m "spritexy tijd " ; winx / 2 - 50 ; " 20" #m "fill 64 32 0" call setcolor red #m "goto 0 " ; winy * 3 / 4 #m "down" #m "boxfilled " ; winx ; " " ; winy #m "up" call setcolor green #m "goto " ; winx / 2 - 50 _ ; " " ; winy * 3 / 4 #m "down" #m "boxfilled " ; winx / 2 + 150 _ ; " " ; winy - 100 #m "up" for i = 0 to 10 x1 = rnd.range( 0 , winx ) y1 = winy * 3 / 4 x2 = rnd.range( 0 , winy ) y2 = winy * 3 / 4 x3 = rnd.range( x1 , x2 ) y3 = rnd.range( winy * 3 / 4 _ , winy * 3 / 4 - abs( x1 - x2 ) ) clr = mix( red , rnd(0) , orange ) call sprite.triangle x1,y1,x2,y2,x3,y3,clr,0 next i #m "getbmp screen 0 0 " ; winx ; " " ; winy #m "background screen" timer 40 , [tijd] wait [tijd] tel = tel - 1 if tel < 0 then tel = -1 #m "spriteimage tijd tijd-1" ddy = .1 else #m "spriteimage tijd tijd" ; int( tel / 25 ) ddy = 0 end if #m "spriteimage fuel fuel" ; fuel #m "spriteimage lander lander_0" ddx = 0 select case key$ case chr$( _VK_LEFT ) ddx = -1 fuel = fuel - .3 case chr$( _VK_RIGHT ) ddx = 1 fuel = fuel - .3 case chr$( _VK_UP ) if fuel > 0 then #m "spriteimage lander lander_1" fuel = fuel - 4 ddy = ddy - 1 end if case else end select key$ = "" lander.dx = lander.dx + ddx lander.x = lander.x + lander.dx lander.dy = lander.dy + ddy lander.y = lander.y + lander.dy if lander.y > winy * 3 / 4 - 90 then timer 0 if lander.dy > 5 _ or lander.x < winx / 2 - 50 _ or lander.x > winx / 2 + 50 then notice "GAME OVER : YOU CRASED !!" else notice "GAME OVER : you landed savely ." end if confirm "play again ?" ; yn$ if yn$ = "yes" then call reset timer 40 , [tijd] else close #m end end if end if #m "spritexy lander " ; lander.x _ ; " " ; int( lander.y ) #m "drawsprites" wait [key] key$ = right$( Inkey$ , 1 ) if key$ <> chr$( 27 ) then wait [quit] close #m end sub reset fuel = 100 lander.x = rnd.range( 100 , winx - 100 ) lander.y = winy / 4 lander.dx = 0 lander.dy = 0 state = 0 tijd = 9 tel = 9 * 25 end sub function rnd.range( l , h ) rnd.range = rnd( 0 ) * ( h - l ) + l end function ''bluatigro 20 may 2018 ''sprite module
[sprite] global sprite.width , sprite.height return
sub sprite.clear w , h #m "fill white" #m "goto 0 " ; h #m "size 1" #m "down" #m "color black" #m "backcolor black" #m "boxfilled " ; w ; " " ; h * 2 #m "up" sprite.width = w sprite.height = h end sub
sub sprite.triangle x1 , y1 , x2 , y2 , x3 , y3 , clr , spr if y1 = y2 then y1 = y1 - 1e-10 if y2 = y3 then y3 = y3 + 1e-10 if y1 > y3 then h = y1 y1 = y3 y3 = h h = x1 x1 = x3 x3 = h end if if y1 > y2 then h = y1 y1 = y2 y2 = h h = x1 x1 = x2 x2 = h end if if y2 > y3 then h = y2 y2 = y3 y3 = h h = x2 x2 = x3 x3 = h end if
for i = y1 to y3 a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 ) if i < y2 then b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 ) else b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 ) end if if spr then #m "color black" #m "down" #m "line " ; a ; " " ; i _ ; " " ; b ; " " ; i #m "up" call setcolor clr #m "down" #m "line " ; a ; " " ; i + sprite.height _ ; " " ; b ; " " ; i + sprite.height #m "up" else call setcolor clr #m "down" #m "line " ; a ; " " ; i ; " " ; b ; " " ; i #m "up" end if next i end sub
sub sprite.rectangle x1,y1,x2,y2,clr #m "goto " ; x1 ; " " ; y1 #m "size 1" #m "color black" #m "backcolor black" #m "down" #m "boxfilled " ; x2 ; " " ; y2 #m "up" #m "goto " ; x1 ; " " ; y1 + sprite.height call setcolor clr #m "down" #m "boxfilled " ; x2 ; " " ; y2 + 60 #m "up" end sub
sub sprite.ellipse x,y,dx,dy,clr,bclr #m "goto " ; x ; " " ; y #m "down" call setcolor bclr #m "ellipsefilled " ; dx ; " " ; dy #m "up" #m "goto " ; x ; " " ; y + sprite.height #m "down" call setcolor clr #m "ellipsefilled " ; dx ; " " ; dy #m "up" end sub
sub sprite.pie x,y,dx,dy,a,b,clr$,bclr$,size #m "goto " ; x ; " " ; y #m "size " ; size #m "down" #m "color black" #m "backcolor black" #m "piefilled " ; dx ; " " ; dy _ ; " " ; a ; " " ; b #m "up" #m "goto " ; x ; " " ; y + sprite.height #m "down" #m "color " ; clr$ #m "backcolor " ; bclr$ #m "piefilled " ; dx ; " " ; dy _ ; " " ; a ; " " ; b #m "up" end sub
sub sprite.text x , y , text$ , clr , size #m "font " ; size ; " bold" #m "goto " ; x ; " " ; y #m "color black" #m "backcolor white" #m "down" #m "\" ; text$ #m "up" #m "goto " ; x ; " " ; y + sprite.height call setcolor clr #m "backcolor black" #m "down" #m "\" ; text$ #m "up" end sub
sub sprite.line x1,y1 , x2,y2 , clr , size #m "color black" #m "size " ; size #m "down" #m "line " ; x1 ; " " ; y1 _ ; " " ; x2 ; " " ; y2 #m "up" call setcolor clr #m "down" #m "line " ; x1 ; " " ; y1 + sprite.height _ ; " " ; x2 ; " " ; y2 + sprite.height #m "up" end sub
sub sprite.getbmp bmp$ #m "getbmp " ; bmp$ ; " 0 0 " _ ; sprite.width ; " " ; sprite.height * 2 end sub
''bluatigro 26 apr 2018 ''color module ''needs : ''math module
[color] global black , red , green , yellow global blue , magenta , cyan , white global pink , orange , gray , purple black = rgb( 0 , 0 , 0 ) red = rgb( 255 , 0 , 0 ) green = rgb( 0 , 255 , 0 ) yellow = rgb( 255 , 255 , 0 ) blue = rgb( 0 , 0 , 255 ) magenta = rgb( 255 , 0 , 255 ) cyan = rgb( 0 , 255 , 255 ) white = rgb( 255 , 255 , 255 ) pink = rgb( 255 , 127 , 127 ) orange = rgb( 255 , 127 , 0 ) gray = rgb( 127 , 127 , 127 ) purple = rgb( 127 , 0 , 127 ) return
sub setcolor kl r = int( kl and 255 ) g = int( kl / 256 ) and 255 b = int( kl / 256 / 256 ) and 255 print #m , "backcolor " ; r ;" "; g ; " "; b print #m , "color " ; r ; " " ; g ; " " ; b end sub
function rgb( r , g , b ) rgb = ( int( r ) and 255 ) _ + ( int( g ) and 255 ) * 256 _ + ( int( b ) and 255 ) * 256 * 256 end function
function rainbow( x ) r = sin( rad( x ) ) * 127 + 128 g = sin( rad( x - 120 ) ) * 127 + 128 b = sin( rad( x + 120 ) ) * 127 + 128 rainbow = rgb( r , g , b ) end function
function mix( kl1 , f , kl2 ) r1 = int( kl1 and 255 ) g1 = int( kl1 / 256 ) and 255 b1 = int( kl1 / 256 / 256 ) and 255 r2 = int( kl2 and 255 ) g2 = int( kl2 / 256 ) and 255 b2 = int( kl2 / 256 / 256 ) and 255 r = r1 + ( r2 - r1 ) * f g = g1 + ( g2 - g1 ) * f b = b1 + ( b2 - b1 ) * f mix = rgb( r , g , b ) end function
|
|
|
lander
Jun 24, 2018 21:07:11 GMT
Post by tsh73 on Jun 24, 2018 21:07:11 GMT
Very nice engine effect, gives great visual feedback. It probably needs something for left/right - there is no feedback about it. Very strange feeling having gravity turned ON by a timer (yes, and you can fly with no gravity until timer ends!)
|
|
|
lander
Jun 27, 2018 5:59:35 GMT
Post by bluatigro on Jun 27, 2018 5:59:35 GMT
update : removed fly while timer added 2 flames for right and left steering is only posible whit fuel
'' bluatigro 20 may 2018 '' lander
WindowWidth = 800 WindowHeight = 600 global winx , winy , key$ , tijd , state , tel global fuel , lander.x , lander.y global lander.dx , lander.dy winx = WindowWidth winy = WindowHeight gosub [sprite] gosub [color] nomainwin call reset menu #m , "game" , "start game" , reset open "lander" for graphics as #m #m "trapclose [quit]" #m "when characterInput [key]" #m "setfocus" call sprite.clear 100 , 100 call sprite.line 30 , 10 , 10 , 90 , gray , 7 call sprite.line 70 , 10 , 90 , 90 , gray , 7 for i = 25 to 1 step -1 kl = mix( white , i / 25 , black ) call sprite.ellipse 50,i/3+20 , i*3,i*2 , kl , black next i call sprite.getbmp "l_off" for i = 25 to 1 step -1 kl = mix( yellow , i / 25 , blue ) call sprite.ellipse 50,i/3+65 , i/1.5,i , kl , white next i call sprite.getbmp "l_on" call sprite.clear 10 , 100 for i = 0 to 100 call sprite.rectangle 0 , 100-i , 10 , 100 , cyan call sprite.getbmp "fuel" ; i anim$ = anim$ + " fuel" ; i next i call sprite.clear 100 , 100 call sprite.line 30 , 10 , 10 , 90 , gray , 7 call sprite.line 70 , 10 , 90 , 90 , gray , 7 for i = 25 to 1 step -1 kl = mix( white , i / 25 , black ) call sprite.ellipse 50 , i / 3 + 20 _ , i * 3 , i * 2 , kl , black next i for i = 25 to 1 step -1 kl = mix( yellow , i / 25 , blue ) call sprite.ellipse i / 3 + 50 , 70 _ , i , i / 2 , kl , white next i call sprite.getbmp "l_right" call sprite.clear 100 , 100 call sprite.line 30 , 10 , 10 , 90 , gray , 7 call sprite.line 70 , 10 , 90 , 90 , gray , 7 for i = 25 to 1 step -1 kl = mix( white , i / 25 , black ) call sprite.ellipse 50 , i / 3 + 20 _ , i * 3 , i * 2 , kl , black next i for i = 25 to 1 step -1 kl = mix( yellow , i / 25 , blue ) call sprite.ellipse 50 - i / 3 , 70 _ , i , i / 2 , kl , white next i call sprite.getbmp "l_left" #m "addsprite lander l_off l_on l_right l_left"
#m "addsprite fuel" ; anim$ #m "spritexy fuel 50 50" #m "spritescale fuel 350" #m "goto 0 " ; winy * 2 / 3 #m "down" for i = -1 to 9 call sprite.clear 100 , 100 if i >= 0 then call sprite.text 25 , 70 , str$( i ) , cyan , 50 end if call sprite.getbmp "tijd" ; i anim$ = anim$ + " tijd" ; i next i #m "addsprite tijd" ; anim$ #m "spritexy tijd " ; winx / 2 - 50 ; " 20" #m "fill 64 32 0" call setcolor red #m "goto 0 " ; winy * 3 / 4 #m "down" #m "boxfilled " ; winx ; " " ; winy #m "up" call setcolor green #m "goto " ; winx / 2 - 50 _ ; " " ; winy * 3 / 4 #m "down" #m "boxfilled " ; winx / 2 + 150 _ ; " " ; winy - 100 #m "up" for i = 0 to 10 x1 = rnd.range( 0 , winx ) y1 = winy * 3 / 4 x2 = rnd.range( 0 , winy ) y2 = winy * 3 / 4 x3 = rnd.range( x1 , x2 ) y3 = rnd.range( winy * 3 / 4 _ , winy * 3 / 4 - abs( x1 - x2 ) ) clr = mix( red , rnd(0) , orange ) call sprite.triangle x1,y1,x2,y2,x3,y3,clr,0 next i #m "getbmp screen 0 0 " ; winx ; " " ; winy #m "background screen" timer 40 , [tijd] wait [tijd] tel = tel - 1 if tel < 0 then tel = -1 #m "spriteimage tijd tijd-1" ddy = .1 else #m "spriteimage tijd tijd" ; int( tel / 25 ) ddy = 0 end if #m "spriteimage fuel fuel" ; fuel #m "spriteimage lander l_off" ddx = 0 if tel = -1 then select case key$ case chr$( _VK_LEFT ) if fuel > 0 then #m "spriteimage lander l_right" ddx = -1 fuel = fuel - .3 end if case chr$( _VK_RIGHT ) if fuel > 0 then #m "spriteimage lander l_left" ddx = 1 fuel = fuel - .3 end if case chr$( _VK_UP ) if fuel > 0 then #m "spriteimage lander l_on" fuel = fuel - 4 ddy = ddy - 1 end if case else end select end if key$ = "" lander.dx = lander.dx + ddx lander.x = lander.x + lander.dx lander.dy = lander.dy + ddy lander.y = lander.y + lander.dy if lander.y > winy * 3 / 4 - 90 then timer 0 if lander.dy > 5 _ or lander.x < winx / 2 - 50 _ or lander.x > winx / 2 + 50 then notice "GAME OVER : YOU CRASED !!" else notice "GAME OVER : you landed savely ." end if confirm "play again ?" ; yn$ if yn$ = "yes" then call reset timer 40 , [tijd] else close #m end end if end if #m "spritexy lander " ; lander.x _ ; " " ; int( lander.y ) #m "drawsprites" wait [key] key$ = right$( Inkey$ , 1 ) if key$ <> chr$( 27 ) then wait [quit] close #m end sub reset fuel = 100 lander.x = rnd.range( 100 , winx - 100 ) lander.y = winy / 4 lander.dx = 0 lander.dy = 0 state = 0 tijd = 9 tel = 9 * 25 end sub function rnd.range( l , h ) rnd.range = rnd( 0 ) * ( h - l ) + l end function ''bluatigro 20 may 2018 ''sprite module
[sprite] global sprite.width , sprite.height return
sub sprite.clear w , h #m "fill white" #m "goto 0 " ; h #m "size 1" #m "down" #m "color black" #m "backcolor black" #m "boxfilled " ; w ; " " ; h * 2 #m "up" sprite.width = w sprite.height = h end sub
sub sprite.triangle x1 , y1 , x2 , y2 , x3 , y3 , clr , spr if y1 = y2 then y1 = y1 - 1e-10 if y2 = y3 then y3 = y3 + 1e-10 if y1 > y3 then h = y1 y1 = y3 y3 = h h = x1 x1 = x3 x3 = h end if if y1 > y2 then h = y1 y1 = y2 y2 = h h = x1 x1 = x2 x2 = h end if if y2 > y3 then h = y2 y2 = y3 y3 = h h = x2 x2 = x3 x3 = h end if
for i = y1 to y3 a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 ) if i < y2 then b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 ) else b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 ) end if if spr then #m "color black" #m "down" #m "line " ; a ; " " ; i _ ; " " ; b ; " " ; i #m "up" call setcolor clr #m "down" #m "line " ; a ; " " ; i + sprite.height _ ; " " ; b ; " " ; i + sprite.height #m "up" else call setcolor clr #m "down" #m "line " ; a ; " " ; i ; " " ; b ; " " ; i #m "up" end if next i end sub
sub sprite.rectangle x1,y1,x2,y2,clr #m "goto " ; x1 ; " " ; y1 #m "size 1" #m "color black" #m "backcolor black" #m "down" #m "boxfilled " ; x2 ; " " ; y2 #m "up" #m "goto " ; x1 ; " " ; y1 + sprite.height call setcolor clr #m "down" #m "boxfilled " ; x2 ; " " ; y2 + 60 #m "up" end sub
sub sprite.ellipse x,y,dx,dy,clr,bclr #m "goto " ; x ; " " ; y #m "down" call setcolor bclr #m "ellipsefilled " ; dx ; " " ; dy #m "up" #m "goto " ; x ; " " ; y + sprite.height #m "down" call setcolor clr #m "ellipsefilled " ; dx ; " " ; dy #m "up" end sub
sub sprite.pie x,y,dx,dy,a,b,clr$,bclr$,size #m "goto " ; x ; " " ; y #m "size " ; size #m "down" #m "color black" #m "backcolor black" #m "piefilled " ; dx ; " " ; dy _ ; " " ; a ; " " ; b #m "up" #m "goto " ; x ; " " ; y + sprite.height #m "down" #m "color " ; clr$ #m "backcolor " ; bclr$ #m "piefilled " ; dx ; " " ; dy _ ; " " ; a ; " " ; b #m "up" end sub
sub sprite.text x , y , text$ , clr , size #m "font " ; size ; " bold" #m "goto " ; x ; " " ; y #m "color black" #m "backcolor white" #m "down" #m "\" ; text$ #m "up" #m "goto " ; x ; " " ; y + sprite.height call setcolor clr #m "backcolor black" #m "down" #m "\" ; text$ #m "up" end sub
sub sprite.line x1,y1 , x2,y2 , clr , size #m "color black" #m "size " ; size #m "down" #m "line " ; x1 ; " " ; y1 _ ; " " ; x2 ; " " ; y2 #m "up" call setcolor clr #m "down" #m "line " ; x1 ; " " ; y1 + sprite.height _ ; " " ; x2 ; " " ; y2 + sprite.height #m "up" end sub
sub sprite.getbmp bmp$ #m "getbmp " ; bmp$ ; " 0 0 " _ ; sprite.width ; " " ; sprite.height * 2 end sub
''bluatigro 26 apr 2018 ''color module ''needs : ''math module
[color] global black , red , green , yellow global blue , magenta , cyan , white global pink , orange , gray , purple black = rgb( 0 , 0 , 0 ) red = rgb( 255 , 0 , 0 ) green = rgb( 0 , 255 , 0 ) yellow = rgb( 255 , 255 , 0 ) blue = rgb( 0 , 0 , 255 ) magenta = rgb( 255 , 0 , 255 ) cyan = rgb( 0 , 255 , 255 ) white = rgb( 255 , 255 , 255 ) pink = rgb( 255 , 127 , 127 ) orange = rgb( 255 , 127 , 0 ) gray = rgb( 127 , 127 , 127 ) purple = rgb( 127 , 0 , 127 ) return
sub setcolor kl r = int( kl and 255 ) g = int( kl / 256 ) and 255 b = int( kl / 256 / 256 ) and 255 print #m , "backcolor " ; r ;" "; g ; " "; b print #m , "color " ; r ; " " ; g ; " " ; b end sub
function rgb( r , g , b ) rgb = ( int( r ) and 255 ) _ + ( int( g ) and 255 ) * 256 _ + ( int( b ) and 255 ) * 256 * 256 end function
function rainbow( x ) r = sin( rad( x ) ) * 127 + 128 g = sin( rad( x - 120 ) ) * 127 + 128 b = sin( rad( x + 120 ) ) * 127 + 128 rainbow = rgb( r , g , b ) end function
function mix( kl1 , f , kl2 ) r1 = int( kl1 and 255 ) g1 = int( kl1 / 256 ) and 255 b1 = int( kl1 / 256 / 256 ) and 255 r2 = int( kl2 and 255 ) g2 = int( kl2 / 256 ) and 255 b2 = int( kl2 / 256 / 256 ) and 255 r = r1 + ( r2 - r1 ) * f g = g1 + ( g2 - g1 ) * f b = b1 + ( b2 - b1 ) * f mix = rgb( r , g , b ) end function
|
|