Meteor Dodge

Ghegs · Post by **Ghegs** » Apr 22, 2020 17:35

Dodge meteors that are cleverly disguised as rectangles. A quick score chaser game that takes about 20-30 seconds at most.

Arrow keys or joystick d-pad to move, the latter probably only works with Xbox 360 controllers. Maybe Xbox One as well?

10 points for each meteor that passes through the screen.
100 points for each frame you're within 10 pixels of any meteor.
Use shift/button 1 to slow your speed for more accurate control.

Code: Select all

'Meteor Dodge
'
'2020-04 by Ghegs

Const as Integer ScreenWidth=480, ScreenHeight=640
Const as Integer sc_esc=1, sc_up=72,sc_right=77,sc_down=80,sc_left=75, sc_shift=42
Const as Integer JoystickSlowButton = 1
Const as Integer PointsForMeteorPass = 10, PointsForSkinDancing = 100, SkinDanceDistance = -10

Dim Shared as Single DPadX, DPadY
Dim Shared as Integer JoystickID, JoystickButtons, JoystickResult

Type Rectangle
    x as Integer 'x position on screen
    y as Integer 'y position on screen
    c as Integer 'color
    size as Integer
    speed as Integer
    Declare Sub Draw
    Declare Sub Sparkle
End Type

Sub Rectangle.Draw
    Line (x,y)-Step(size,size),c,bf
End Sub

Sub Rectangle.Sparkle
    Line (x-7,y-7)-Step(2,2),c 'Upper left
    Line (x-7,y+size/2)-Step(2,0),c 'Middle left
    Line (x-7,y+size+5)-Step(2,-2),c 'Lower left
    Line (x+size+5,y-5)-Step(2,-2),c 'Upper right
    Line (x+size+5,y+size/2)-Step(2,0),c 'Middle right
    Line (x+size+5,y+size+3)-Step(2,2),c 'Lower right
End Sub

Declare Function DistanceCheck(Player as Rectangle, Enemy as Rectangle) As Integer
Declare Function InitializeMeteor() as Rectangle
Declare Function FindJoystick() as Integer 
Declare Sub AddToArray (Array() as Rectangle, NewEntry as Rectangle)
Declare Sub Title(Score as Integer = 0)
Declare Sub GameLoop()
Declare Sub GameOver(Score as Integer)

Function RNG (first As Double, last As Double) As Double
    Randomize
    Return Int (Rnd * (last - first) + first)
End Function

Function DistanceCheck (Player as Rectangle, Enemy as Rectangle) As Integer
    Dim Result as Integer
    Dim as Integer XDistance, XDistanceLeft, XDistanceRight, YDistance, YDistanceUp, YDistanceDown
    
    XDistanceLeft = Player.x + Player.size - Enemy.x
    XDistanceRight = Enemy.x + Enemy.Size - Player.x
    YDistanceUp = Player.y + Player.size - Enemy.y
    YDistanceDown = Enemy.y + Enemy.Size - Player.y
    
    If XDistanceLeft <= XDistanceRight Then XDistance = XDistanceLeft Else XDistance = XDistanceRight
    If YDistanceUp <= YDistanceDown Then YDistance = YDistanceUp Else YDistance = YDistanceDown
    If XDistance <= YDistance Then Result = XDistance Else Result = YDistance
    
    Return Result
End Function

Function InitializeMeteor() As Rectangle
    Dim as Integer MinSize = 5, MaxSize = 30
    Dim as Integer MinSpeed = 1, MaxSpeed = 10
    Dim NewMeteor As Rectangle
    NewMeteor.size = RNG(MinSize,MaxSize)
    NewMeteor.x = RNG(0,ScreenWidth-NewMeteor.size)
    NewMeteor.y = -1 - NewMeteor.size
    NewMeteor.c = RNG(1,15)
    NewMeteor.speed = RNG(MinSpeed,MaxSpeed)
    Return NewMeteor
End Function

Sub AddToArray (Array() as Rectangle, NewEntry as Rectangle)
    ReDim Preserve Array(UBound(Array)+1)
    Array(UBound(Array)) = NewEntry
End Sub

Function FindJoystick() as Integer
    Dim ID as Integer
    For ID = 0 to 15
        If GetJoystick(ID) = 0 Then Return ID
    Next ID
End Function
JoystickID = FindJoystick()

Screenres ScreenWidth, ScreenHeight, 8

Sub Title(Score as Integer = 0)
    Static as Integer HighScore = 0    
    If Score > HighScore Then HighScore = Score
    
    Do
        GetJoystick(JoystickID, JoystickButtons, , , , , , , DPadX, DPadY)
           
        Screensync
        Screenlock
        CLS
        Draw string (ScreenWidth/3,20),"High score: " + Str(HighScore)
        Draw string (ScreenWidth/3,ScreenHeight/4),"Meteor Dodge"
        Draw string (ScreenWidth/4,ScreenHeight/1.5),"Arrows/D-Pad to move"
        Draw string Step (0,20),"Hold Shift/Button 1 to slow down"
        Draw string Step (0,20),"Press Shift/Button 1 to start or ESC to exit"
        Draw string (ScreenWidth/4,ScreenHeight-20),"2020-04 by Ghegs"
        Screenunlock
        
        Sleep 1,1
    
    Loop Until Multikey(sc_esc) = -1 Or Multikey(sc_shift) = -1 Or JoystickButtons = JoystickSlowButton
    
    If Multikey(sc_esc)=-1 Then 
        End
    ElseIf Multikey(sc_shift) = -1 Or JoystickButtons = JoystickSlowButton Then 
        GameLoop()
    Else
        End
    End If
End Sub

Sub GameLoop()
    Dim as Integer GameTimer = 0, Score = 0, PlayerNormalSpeed = 5, PlayerSlowSpeed = 2, MaxEnemiesOnScreen = 40, EnemyDistanceToPlayer = 0
    Dim as boolean Finish = False
    Dim as Rectangle Player, Meteor, EnemyArray()
    
    Player.size = 16
    Player.x = ScreenWidth/2
    Player.y = ScreenHeight - Player.size - 10
    Player.c = 15
    Player.speed = PlayerNormalSpeed
    
    Do
        'INPUT
        GetJoystick(JoystickID, JoystickButtons, , , , , , , DPadX, DPadY)
        If multikey(sc_esc)=-1 Then End
        If multikey(sc_shift)=-1 Or JoystickButtons = JoystickSlowButton Then Player.Speed = PlayerSlowSpeed Else Player.Speed = PlayerNormalSpeed
        If (multikey(sc_up)=-1 Or DPadY = -1) And Player.y > 0 Then Player.y -= Player.speed
        If (multikey(sc_right)=-1 Or DPadX = 1) And Player.x < ScreenWidth - Player.size Then Player.x += Player.speed
        If (multikey(sc_down)=-1 Or DPadY = 1) And Player.y < ScreenHeight - Player.size Then Player.y += Player.speed
        If (multikey(sc_left)=-1 Or DPadX = -1) And Player.x > 0 Then Player.x -= Player.speed
        
        'UPDATE
        GameTimer += 1
             
        'Update meteor locations, check if a meteor goes outside the screen, and check for collisions
        For Enemy As Integer = LBound(EnemyArray) To UBound(EnemyArray)
            'Location on screen
            EnemyArray(Enemy).y += EnemyArray(Enemy).speed
            
            'Respawn the meteor if it goes outside the screen and increase player's score
            If EnemyArray(Enemy).y > ScreenHeight Then 
                Score += PointsForMeteorPass
                EnemyArray(Enemy) = InitializeMeteor
            End If
            
            'Check the distance between player and the meteor
            EnemyDistanceToPlayer = DistanceCheck (Player, EnemyArray(Enemy))
            If EnemyDistanceToPlayer > 0 Then
                Finish = True
            ElseIf EnemyDistanceToPlayer <= 0 and EnemyDistanceToPlayer >= SkinDanceDistance Then
                Score += PointsForSkinDancing
                Player.Sparkle
            End If
            
        Next Enemy
        
        'Create a new enemy metor
        If Frac(GameTimer/10) = 0 And UBound(EnemyArray) < MaxEnemiesOnScreen Then AddToArray(EnemyArray(), InitializeMeteor)
        
        'Allow the creation of a new enemy meteor every second
        If Frac(GameTimer/60) = 0 Then
            MaxEnemiesOnScreen += 1
        End If
        
        'DRAW
        Screensync
        Screenlock
        CLS
        
        'Draw enemy meteors
        For Enemy As Integer = LBound(EnemyArray) To UBound(EnemyArray)
            EnemyArray(Enemy).Draw
        Next Enemy
    
        'Draw player
        Player.Draw
        
        'Draw score
        Draw string (5,5),"Score: " + Str(Score)
                
        Screenunlock
        Sleep 1,1

    Loop Until Finish = True
    GameOver(Score)
End Sub

Sub GameOver(Score as Integer)
    Sleep 1500,1
    
    Screensync
    Screenlock
    CLS
    
    Draw string (ScreenWidth/2.9,ScreenHeight/2/2),"Game Over!"
    Draw string Step(0,240),"Final Score: " + Str(Score)
    
    Screenunlock
    GetKey
    Sleep 5000
    Title (Score)
End Sub

Title()

End

badidea · Post by **badidea** » Apr 22, 2020 18:34

Nice! Did you try my Meteorite shooter?

Ghegs · Post by **Ghegs** » Apr 22, 2020 18:46

I gave it a quick go, but since I don't play games using mouse (I get arm/shoulder aches easily from it nowadays) I didn't play it much beyond the initial look, I'm sorry to say.

UEZ · Post by **UEZ** » Apr 23, 2020 7:36

@Ghegs: nice. I missed something which I've added. ^^

Code: Select all

'Meteor Dodge
'
'2020-04 by Ghegs

Const as Integer ScreenWidth=480, ScreenHeight=640
Const as Integer sc_esc=1, sc_up=72,sc_right=77,sc_down=80,sc_left=75, sc_shift=42
Const as Integer JoystickSlowButton = 1
Const as Integer PointsForMeteorPass = 10, PointsForSkinDancing = 100, SkinDanceDistance = -10
Const As Ushort stars = 1000

Dim Shared as Single DPadX, DPadY
Dim Shared as Integer JoystickID, JoystickButtons, JoystickResult
Type vec2
	As Single x, y, vx, vy
	As Ubyte col
End Type

Dim Shared As vec2 BgStars(stars - 1)
Randomize Timer, 2

For i As Ushort = 0 To stars - 1
	BgStars(i).x = Rnd() * ScreenWidth
	BgStars(i).y = Rnd() * ScreenHeight
	BgStars(i).vy = 1 + Rnd() * 5
	BgStars(i).col = &h10 + Rnd() * (&hFF - &h10)
Next

Type Rectangle
    x as Integer 'x position on screen
    y as Integer 'y position on screen
    c as Integer 'color
    size as Integer
    speed as Integer
    Declare Sub Draw
    Declare Sub Sparkle
End Type

Sub BgStarsAnim()
	For i As Ushort = 0 To stars - 1
		Line (BgStars(i).x, BgStars(i).y)-(BgStars(i).x, BgStars(i).y), Rgb(BgStars(i).col, BgStars(i).col, BgStars(i).col)
		BgStars(i).y += BgStars(i).vy
		If BgStars(i).y > ScreenHeight Then 
			BgStars(i).y = 0
			BgStars(i).vy = 0.5 + Rnd() * 5
		End If
	Next
End Sub

Sub Rectangle.Draw
    Line (x,y)-Step(size,size),c,bf
End Sub

Sub Rectangle.Sparkle
    Line (x-7,y-7)-Step(2,2),c 'Upper left
    Line (x-7,y+size/2)-Step(2,0),c 'Middle left
    Line (x-7,y+size+5)-Step(2,-2),c 'Lower left
    Line (x+size+5,y-5)-Step(2,-2),c 'Upper right
    Line (x+size+5,y+size/2)-Step(2,0),c 'Middle right
    Line (x+size+5,y+size+3)-Step(2,2),c 'Lower right
End Sub

Declare Function DistanceCheck(Player as Rectangle, Enemy as Rectangle) As Integer
Declare Function InitializeMeteor() as Rectangle
Declare Function FindJoystick() as Integer
Declare Sub AddToArray (Array() as Rectangle, NewEntry as Rectangle)
Declare Sub Title(Score as Integer = 0)
Declare Sub GameLoop()
Declare Sub GameOver(Score as Integer)

Function RNG (first As Double, last As Double) As Double
    Randomize
    Return Int (Rnd * (last - first) + first)
End Function

Function DistanceCheck (Player as Rectangle, Enemy as Rectangle) As Integer
    Dim Result as Integer
    Dim as Integer XDistance, XDistanceLeft, XDistanceRight, YDistance, YDistanceUp, YDistanceDown
   
    XDistanceLeft = Player.x + Player.size - Enemy.x
    XDistanceRight = Enemy.x + Enemy.Size - Player.x
    YDistanceUp = Player.y + Player.size - Enemy.y
    YDistanceDown = Enemy.y + Enemy.Size - Player.y
   
    If XDistanceLeft <= XDistanceRight Then XDistance = XDistanceLeft Else XDistance = XDistanceRight
    If YDistanceUp <= YDistanceDown Then YDistance = YDistanceUp Else YDistance = YDistanceDown
    If XDistance <= YDistance Then Result = XDistance Else Result = YDistance
   
    Return Result
End Function

Function InitializeMeteor() As Rectangle
    Dim as Integer MinSize = 5, MaxSize = 30
    Dim as Integer MinSpeed = 1, MaxSpeed = 10
    Dim NewMeteor As Rectangle
    NewMeteor.size = RNG(MinSize,MaxSize)
    NewMeteor.x = RNG(0,ScreenWidth-NewMeteor.size)
    NewMeteor.y = -1 - NewMeteor.size
    NewMeteor.c = Rnd() * &hFFFFFF
    NewMeteor.speed = RNG(MinSpeed,MaxSpeed)
    Return NewMeteor
End Function

Sub AddToArray (Array() as Rectangle, NewEntry as Rectangle)
    ReDim Preserve Array(UBound(Array)+1)
    Array(UBound(Array)) = NewEntry
End Sub

Function FindJoystick() as Integer
    Dim ID as Integer
    For ID = 0 to 15
        If GetJoystick(ID) = 0 Then Return ID
    Next ID
End Function
JoystickID = FindJoystick()

Screenres ScreenWidth, ScreenHeight, 32

Sub Title(Score as Integer = 0)
    Static as Integer HighScore = 0   
    If Score > HighScore Then HighScore = Score
	
	Dim As Ushort FPS = 0, FPSc = 0
	Dim As Single t = Timer
    Do
		
        GetJoystick(JoystickID, JoystickButtons, , , , , , , DPadX, DPadY)
           
        Screensync
        Screenlock
        Cls
		BgStarsAnim()
        Draw string (ScreenWidth/3,20),"High score: " + Str(HighScore)
        Draw string (ScreenWidth/3,ScreenHeight/4),"Meteor Dodge"
        Draw string (ScreenWidth/4,ScreenHeight/1.5),"Arrows/D-Pad to move"
        Draw string Step (0,20),"Hold Shift/Button 1 to slow down"
        Draw string Step (0,20),"Press Shift/Button 1 to start or ESC to exit"
        Draw string (ScreenWidth/4,ScreenHeight-20),"2020-04 by Ghegs"
		Draw String (ScreenWidth - 28, 5), Str(FPS), &hF0F0F0
		
        Screenunlock
		
		FPSc += 1
		
		If Timer - t > 0.99 Then
			t = Timer
			FPS = FPSc
			FPSc = 0
		End If
       
        'Sleep 1,1
   
    Loop Until Multikey(sc_esc) = -1 Or Multikey(sc_shift) = -1 Or JoystickButtons = JoystickSlowButton
   
    If Multikey(sc_esc)=-1 Then
        End
    ElseIf Multikey(sc_shift) = -1 Or JoystickButtons = JoystickSlowButton Then
        GameLoop()
    Else
        End
    End If
End Sub

Sub GameLoop()
    Dim as Integer GameTimer = 0, Score = 0, PlayerNormalSpeed = 5, PlayerSlowSpeed = 2, MaxEnemiesOnScreen = 40, EnemyDistanceToPlayer = 0
    Dim as boolean Finish = False
    Dim as Rectangle Player, Meteor, EnemyArray()
   
    Player.size = 16
    Player.x = ScreenWidth/2
    Player.y = ScreenHeight - Player.size - 10
    Player.c = &hFFFFFF
    Player.speed = PlayerNormalSpeed
   
    Dim As Ushort FPS = 0, FPSc = 0
	Dim As Single t = Timer
    Do
        'INPUT
        GetJoystick(JoystickID, JoystickButtons, , , , , , , DPadX, DPadY)
        If multikey(sc_esc)=-1 Then End
        If multikey(sc_shift)=-1 Or JoystickButtons = JoystickSlowButton Then Player.Speed = PlayerSlowSpeed Else Player.Speed = PlayerNormalSpeed
        If (multikey(sc_up)=-1 Or DPadY = -1) And Player.y > 0 Then Player.y -= Player.speed
        If (multikey(sc_right)=-1 Or DPadX = 1) And Player.x < ScreenWidth - Player.size Then Player.x += Player.speed
        If (multikey(sc_down)=-1 Or DPadY = 1) And Player.y < ScreenHeight - Player.size Then Player.y += Player.speed
        If (multikey(sc_left)=-1 Or DPadX = -1) And Player.x > 0 Then Player.x -= Player.speed
       
        'UPDATE
        GameTimer += 1
             
        'Update meteor locations, check if a meteor goes outside the screen, and check for collisions
        For Enemy As Integer = LBound(EnemyArray) To UBound(EnemyArray)
            'Location on screen
            EnemyArray(Enemy).y += EnemyArray(Enemy).speed
           
            'Respawn the meteor if it goes outside the screen and increase player's score
            If EnemyArray(Enemy).y > ScreenHeight Then
                Score += PointsForMeteorPass
                EnemyArray(Enemy) = InitializeMeteor
            End If
           
            'Check the distance between player and the meteor
            EnemyDistanceToPlayer = DistanceCheck (Player, EnemyArray(Enemy))
            If EnemyDistanceToPlayer > 0 Then
                Finish = True
            ElseIf EnemyDistanceToPlayer <= 0 and EnemyDistanceToPlayer >= SkinDanceDistance Then
                Score += PointsForSkinDancing
                Player.Sparkle
            End If
           
        Next Enemy
       
        'Create a new enemy metor
        If Frac(GameTimer/10) = 0 And UBound(EnemyArray) < MaxEnemiesOnScreen Then AddToArray(EnemyArray(), InitializeMeteor)
       
        'Allow the creation of a new enemy meteor every second
        If Frac(GameTimer/60) = 0 Then
            MaxEnemiesOnScreen += 1
        End If
       
        'DRAW
        Screensync
        Screenlock
        CLS
		
		BgStarsAnim()
        'Draw enemy meteors
        For Enemy As Integer = LBound(EnemyArray) To UBound(EnemyArray)
            EnemyArray(Enemy).Draw
        Next Enemy
   
        'Draw player
        Player.Draw
       
        'Draw score
        Draw string (5,5),"Score: " + Str(Score)
        
		Draw String (ScreenWidth - 28, 5), Str(FPS), &hF0F0F0
		
        Screenunlock
		
		FPSc += 1
		
		If Timer - t > 0.99 Then
			t = Timer
			FPS = FPSc
			FPSc = 0
		End If
        'Sleep 1,1

    Loop Until Finish = True
    GameOver(Score)
End Sub

Sub GameOver(Score as Integer)
    Sleep 1500,1
   
    Screensync
    Screenlock
    Cls
	
	BgStarsAnim()
    Draw string (ScreenWidth/2.9,ScreenHeight/2/2),"Game Over!"
    Draw string Step(0,240),"Final Score: " + Str(Score)
   
    Screenunlock
    GetKey
    Sleep 5000
    Title (Score)
End Sub

Title()

End

;-)

Ghegs · Post by **Ghegs** » Apr 23, 2020 14:57

It does look nice, but it might distract from the actual hazards. When the game generates the smallest rectangle with a dark color it's already a bit hard to see.

I was planning on making something like that for another game I was planning, so I'll keep that in mind. :)

Meteor Dodge

Meteor Dodge

Re: Meteor Dodge

Re: Meteor Dodge

Re: Meteor Dodge

Re: Meteor Dodge