My first game

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
Martin Verlaan
Enthusiast
Enthusiast
Posts: 121
Joined: Sun Apr 01, 2018 11:26 am

My first game

Post by Martin Verlaan »

I made so many applications in my life (so far, this is the second in PureBasic), but I never programmed a game! I was looking for a new challenge so I decided to create a simple Tetris clone. It took me a few days to finish, but I am pretty happy with the result. Don't expect fancy graphics and sound effects, I just made this to learn the basics of game programming.

Image

Code: Select all

;SIMPLE TETRIS CLONE BY MARTIN VERLAAN

EnableExplicit

#WINDOW = 0
#SCREEN_WIDTH = 640
#SCREEN_HEIGHT = 480
#BLOCKSIZE = 24
#BOARD_CELLS_X = 10
#BOARD_CELLS_Y = 16
#GRID_WIDTH = (#BOARD_CELLS_X * #BLOCKSIZE) + #BLOCKSIZE
#GRID_HEIGHT = (#BOARD_CELLS_Y * #BLOCKSIZE) + #BLOCKSIZE
#PIECES = 6
#DROP_TIMER = 0

Global Dim Shapes.b(#PIECES, 3, 3, 3)
Global Dim ShapeColors.i(#PIECES)
Global Dim Board.i(#BOARD_CELLS_Y - 1, #BOARD_CELLS_X - 1)

Procedure DefineShapes()
  Protected.i Shape, Rotation, Row, Col
  Protected.b Num
  
  For Shape = 0 To #PIECES
    For Rotation = 0 To 3
      For Row = 0 To 3
        For Col = 0 To 3
          Read.b Num
          Shapes(Shape, Rotation, Row, Col) = Num   
        Next Col
      Next Row
    Next Rotation
  Next Shape
  
  ShapeColors(0) = #Cyan 
  ShapeColors(1) = #Magenta
  ShapeColors(2) = RGB(255,165,0)
  ShapeColors(3) = #Blue
  ShapeColors(4) = #Red
  ShapeColors(5) = #Green
  ShapeColors(6) = #Yellow
  
  DataSection
    Data.b 0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0
    Data.b 0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0   
    Data.b 0,0,0,0,1,1,1,0,0,1,0,0,0,0,0,0
    Data.b 0,1,0,0,1,1,0,0,0,1,0,0,0,0,0,0
    Data.b 0,1,0,0,1,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,1,0,0,1,0,0,0,0,0,0
    Data.b 0,0,0,0,1,1,1,0,1,0,0,0,0,0,0,0
    Data.b 1,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0
    Data.b 0,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,0,0,0,1,1,0,0,0,0,0
    Data.b 1,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,1,0,0,1,0,0,0,1,0,0,0,0,0,0
    Data.b 0,0,0,0,1,1,1,0,0,0,1,0,0,0,0,0
    Data.b 0,1,0,0,0,1,0,0,1,1,0,0,0,0,0,0
    Data.b 0,0,0,0,1,1,0,0,0,1,1,0,0,0,0,0
    Data.b 0,0,1,0,0,1,1,0,0,1,0,0,0,0,0,0
    Data.b 0,0,0,0,1,1,0,0,0,1,1,0,0,0,0,0
    Data.b 0,0,1,0,0,1,1,0,0,1,0,0,0,0,0,0
    Data.b 0,0,0,0,0,1,1,0,1,1,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0
    Data.b 0,0,0,0,0,1,1,0,1,1,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0
    Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
  EndDataSection
EndProcedure

Procedure.b RowEmpty(Shape.i, Rotation.i, Row.i)
  Protected.i X, Sum
  Protected.b Empty = #False
  
  For X = 0 To 3
    Sum + Shapes(Shape, Rotation, Row, X) 
  Next X
  
  If Sum = 0
    Empty = #True
  EndIf
  
  ProcedureReturn Empty 
EndProcedure

Procedure.b ColEmpty(Shape.i, Rotation.i, Col.i)
  Protected.i Y, Sum
  Protected Empty = #False
  
  For Y = 0 To 3
    Sum + Shapes(Shape, Rotation, Y, Col) 
  Next Y
  
  If Sum = 0
    Empty = #True
  EndIf
  
  ProcedureReturn Empty 
EndProcedure

Procedure.i EmptyColsLeft(Shape.i, Rotation.i)
  Protected.i Col, X
  
  For Col = 0 To 3
    If ColEmpty(Shape, Rotation, Col)
      X + 1
    Else
      Break
    EndIf
  Next Col 
  
  ProcedureReturn X
EndProcedure

Procedure.i EmptyColsRight(Shape.i, Rotation.i)
  Protected.i Col, X 
  
  For Col = 3 To 0 Step -1
    If ColEmpty(Shape, Rotation, Col)
      X + 1  
    Else 
      Break
    EndIf
  Next Col 
  
  ProcedureReturn X
EndProcedure

Procedure.i EmptyRowsTop(Shape.i, Rotation.i)
  Protected.i Row, Y
  
  For Row = 0 To 3
    If RowEmpty(Shape, Rotation, Row)
      Y + 1
    Else
      Break
    EndIf
  Next Row 
  
  ProcedureReturn Y
EndProcedure

Procedure.i EmptyRowsBottom(Shape.i, Rotation.i)
  Protected.i Row, Y
  
  For Row = 3 To 0 Step -1
    If RowEmpty(Shape, Rotation, Row)
      Y + 1 
    Else
      Break 
    EndIf
  Next Row 
  
  ProcedureReturn Y
EndProcedure

Procedure DrawBlock(Shape.i, Row.i, Col.i, CellY.i, CellX.i, Small.b, Color.i)  
  Protected.i xStart, yStart, X, Y, Size
  
  If Small
    xStart = ((#SCREEN_WIDTH - #GRID_WIDTH) / 2) + 390
    yStart = (#SCREEN_HEIGHT - #GRID_HEIGHT) + 85
    CellX = 0
    CellY = 0
    Size = 10
  Else 
    xStart = 10 + ((#SCREEN_WIDTH - #GRID_WIDTH) / 2)
    yStart = (#SCREEN_HEIGHT - #GRID_HEIGHT)   
    Size = #BLOCKSIZE
  EndIf
  
  X = xStart + (CellX * Size)
  Y = yStart + (CellY * Size)  
 
  DrawingMode(#PB_2DDrawing_Default)
  Box(X + (Col * Size), Y + (Row * Size), Size, Size, Color)
  DrawingMode(#PB_2DDrawing_Outlined)
  Box(X + (Col * Size), Y + (Row * Size), Size, Size, #Black)
EndProcedure

Procedure DrawShape(Shape.i, Rotation.i, CellY.i, CellX.i, Small.b = #False)
  Protected.i Row, Col, Y
  Protected.b EmptyRow = #True
  
  For Row = 0 To 3
    If Small
      If Not EmptyRow 
        Y + 1
      EndIf
    Else 
      Y = Row
    EndIf
    
    EmptyRow = #True
    
    For Col = 0 To 3      
      If Shapes(Shape, Rotation, Row, Col)
        DrawBlock(Shape, Y, Col, CellY, CellX, Small, ShapeColors(Shape))
        EmptyRow = #False
      EndIf
    Next Col
  Next Row  
EndProcedure

Procedure.b GameOver()
  Protected.i Col
  Protected.b StopGame = #False
  
  For Col = 0 To #BOARD_CELLS_X - 1
    If Board(0, Col) <> -1
      StopGame = #True  
    EndIf
  Next Col
  
  ProcedureReturn StopGame
EndProcedure
Procedure DrawBoard(Score.i, Level.i, NextShape.i, FirstTime.b)
  Protected.i X = (#SCREEN_WIDTH - #GRID_WIDTH) / 2
  Protected.i Y = (#SCREEN_HEIGHT - #GRID_HEIGHT) - 10
  Protected.i LineSize = 10
  Protected.i LeftTextPos = X - 170 
  Protected.i Row, Col

  DrawingMode(#PB_2DDrawing_Default)
  
  Box(X, Y, #GRID_WIDTH - 4, #GRID_HEIGHT, RGB(105, 105, 105))          
  Box(LineSize + X, LineSize + Y, (#GRID_WIDTH - 4) - (LineSize * 2), (#GRID_HEIGHT - 4) - (LineSize * 2), #Black)  
  
  DrawText(X + 60, Y - 40, "TETRIS CLONE", #White, #Black)   
  DrawText(LeftTextPos, Y + 25, "CONTROL KEYS", #White, #Black)
  DrawText(LeftTextPos, Y + 50, "New game: SPACE", #White, #Black)  
  DrawText(LeftTextPos, Y + 75, "Move left: " + Chr($25C1), #White, #Black)
  DrawText(LeftTextPos, Y + 100, "Move right: " + Chr($25B7), #White, #Black)
  DrawText(LeftTextPos, Y + 125, "Drop fast: " + Chr($25BD), #White, #Black)  
  DrawText(LeftTextPos, Y + 150, "Rotate: " + Chr($25B3), #White, #Black)    
  DrawText(LeftTextPos, Y + 175, "Pause / Resume: P", #White, #Black)  
  DrawText(LeftTextPos, Y + 200, "Exit: ESC", #White, #Black)    
  DrawText(X + 290, Y + 25, "Score: " + Str(Score), #White, #Black)
  DrawText(X + 290, Y + 60, "Level: " + Str(Level), #White, #Black) 
  DrawText(X + 290, Y + 95, "Next piece: ", #White, #Black)   
  
  If Not FirstTime
    DrawShape(NextShape, 0, 0, 0, #True)   
  EndIf
  
  If GameOver()
    For Row = 0 To 6
      DrawText(X + 290, Y + 155 + (Row * 35), "GAME OVER", ShapeColors(Row), #Black)  
    Next row
  EndIf
  
  For Row = 0 To #BOARD_CELLS_Y - 1
    For Col = 0 To #BOARD_CELLS_X	- 1
      If Board(Row, Col) <> -1
        DrawBlock(Board(Row, Col), Row, Col, 0, 0, #False, ShapeColors(Board(Row, Col)))
      Else
        DrawBlock(Board(Row, Col), Row, Col, 0, 0, #False, #Gray)
      EndIf
	  Next Col 
 	Next Row     
EndProcedure

Procedure.i ShapeCellsX(Shape.i, Rotation.i)
  Protected.i Row, Col
  
  Dim Sum.i(3)
  
  For Row = 0 To 3
    For Col = 0 To 3  
      Sum(Row) + Shapes(Shape, Rotation, Row, Col) 
    Next Col
  Next Row
  
  SortArray(Sum(), #PB_Sort_Descending)

  ProcedureReturn Sum(0)
EndProcedure

Procedure StoreShapeInBoard(Shape.i, Rotation.i, CellY.i, CellX.i)
  Protected.i Row, Col
  
  For Row = 0 To 3
    For Col = 0 To 3	
      If Shapes(Shape, Rotation, Row, Col)
        Board(CellY + Row, CellX + Col) = Shape
      EndIf
    Next Col
  Next Row  
EndProcedure

Procedure.b MoveDownAllowed(Shape.i, Rotation.i, CellY.i, CellX.i) 
  Protected.i Col, Row
  Protected MoveDown = #True
  
  If CellY < #BOARD_CELLS_Y - (4 - EmptyRowsBottom(Shape, Rotation))   
    For Row = EmptyRowsTop(Shape, Rotation) To 3 - EmptyRowsBottom(Shape, Rotation)
      For Col = EmptyColsLeft(Shape, Rotation) To 3 - EmptyColsRight(Shape, Rotation)
        If Shapes(Shape, Rotation, Row, Col) And Board(Row + CellY + 1, Col + CellX) <> -1          
          MoveDown = #False
          Break 2    
        EndIf
      Next Col    
    Next Row
  Else
    MoveDown = #False
  EndIf
  
  ProcedureReturn MoveDown
EndProcedure

Procedure.b RemoveFullRow()
  Protected.i Row, Col, Y, X
  Protected.b FullRow  
  
  For Row = 0 To #BOARD_CELLS_Y - 1
    FullRow = #True
    
    For Col = 0 To #BOARD_CELLS_X - 1
       If Board(Row, Col) = -1 
         FullRow = #False 
         Break
       EndIf       
    Next Col
    
    If FullRow
      For Y = Row To 1 Step -1
        For X = 0 To #BOARD_CELLS_X - 1
          board(Y, X) = board(Y - 1, X)
        Next X
      Next Y
      
      Break
    EndIf
  Next Row   
  
  ProcedureReturn FullRow
EndProcedure

Procedure.b MoveLeftAllowed(Shape.i, Rotation.i, CellY.i, CellX.i) 
  Protected.i Col, Row
  Protected MoveLeft = #False
  
  If CellX + EmptyColsLeft(Shape, Rotation) > 0 
    MoveLeft = #True
 
    For Row = EmptyRowsTop(Shape, Rotation) To 3 - EmptyRowsBottom(Shape, Rotation)
      For Col = EmptyColsLeft(Shape, Rotation) To 3 - EmptyColsRight(Shape, Rotation)
        If Shapes(Shape, Rotation, Row, Col) And Board(CellY + Row, CellX + Col - 1) <> -1          
          MoveLeft = #False
          Break 2    
        EndIf
      Next Col    
    Next Row
  EndIf
  
  ProcedureReturn MoveLeft
EndProcedure

Procedure.b MoveRightAllowed(Shape.i, Rotation.i, CellY.i, CellX.i) 
  Protected.i Col, Row
  Protected MoveRight = #False
  
  If CellX < #BOARD_CELLS_X - (4 - EmptyColsRight(Shape, Rotation))
    MoveRight = #True
 
    For Row = EmptyRowsTop(Shape, Rotation) To 3 - EmptyRowsBottom(Shape, Rotation)
      For Col = EmptyColsLeft(Shape, Rotation) To 3 - EmptyColsRight(Shape, Rotation)
        If Shapes(Shape, Rotation, Row, Col) And Board(CellY + Row, CellX + Col + 1) <> -1          
          MoveRight = #False
          Break 2    
        EndIf
      Next Col    
    Next Row
  EndIf
  
  ProcedureReturn MoveRight
EndProcedure

Procedure MakeBoardEmpty()
  Protected.i Row, Col
  
  For Row = 0 To #BOARD_CELLS_Y - 1
    For Col = 0 To #BOARD_CELLS_X	- 1
      Board(Row, Col) = -1
	  Next Col
	Next Row    
EndProcedure

Procedure Main()    
  Protected.i Event, Rotation, Row, Col, KeyDownCounter, CellY, CellX, Score, Shape, ClearedLines  
  Protected.i FallingSpeed = 1000
  Protected.i NextShape = Random(#PIECES, 0)  
  Protected.i Level = 1
  Protected.b Paused = #False  
  Protected.b MoveShapeDown = #False
  Protected.b DropNewPiece = #True
  Protected.b FirstTime = #True
  
  If Not OpenWindow(#WINDOW, 216, 0, #SCREEN_WIDTH, #SCREEN_HEIGHT, "Tetris clone") 
    MessageRequester("Error", "Window cannot be opened")
    End
  EndIf
  
  If Not InitSprite()
    MessageRequester("Error", "Cannot initialize sprite environment")
    End    
  EndIf
  
  If Not OpenWindowedScreen(WindowID(#WINDOW), 0, 0, #SCREEN_WIDTH, #SCREEN_HEIGHT)  
    MessageRequester("Error", "Screen area cannot be opened")
    End
  EndIf

  InitKeyboard() 
  MakeBoardEmpty()   
  DefineShapes()
  
  AddWindowTimer(#WINDOW, #DROP_TIMER, FallingSpeed)
  
  Repeat 
    Event = WaitWindowEvent()
    
    ClearScreen(RGB(0, 0, 0))
    
    If DropNewPiece
      DropNewPiece = #False           
      Shape = NextShape
      NextShape = Random(#PIECES, 0)
      Rotation = 0         
      CellY = 0 - EmptyRowsTop(Shape, Rotation)
      CellX = (#BOARD_CELLS_X / 2) - (ShapeCellsX(Shape, Rotation) / 2)   
    EndIf
           
    If StartDrawing(ScreenOutput())          
      ExamineKeyboard()
      
      If KeyboardReleased(#PB_Key_Space)
        MakeBoardEmpty()        
        FirstTime = #False
        DropNewPiece = #True 
        FallingSpeed = 1000
        Level = 1
        Score = 0            
        ClearedLines = 0   
      ElseIf KeyboardReleased(#PB_Key_P)     
        If Paused 
          Paused = #False
        Else 
          Paused = #True
        EndIf
      EndIf
      
      If Not Paused And Not GameOver() And Not FirstTime
        If Event = #PB_Event_Timer And EventTimer() = #DROP_TIMER 
          MoveShapeDown = #True          
        EndIf    
        
        If KeyboardReleased(#PB_Key_Left)          
          If MoveLeftAllowed(Shape, Rotation, CellY, CellX)
            CellX - 1
          EndIf           
        ElseIf KeyboardReleased(#PB_Key_Right) 
          If MoveRightAllowed(Shape, Rotation, CellY, CellX)
            CellX + 1
          EndIf 
        ElseIf KeyboardReleased(#PB_Key_Up) 
          Rotation + 1            
          If Rotation > 3
            Rotation = 0
          EndIf         
            
          If CellX + EmptyColsLeft(Shape, Rotation) < 0
            CellX = 0
          EndIf

          If CellX > #BOARD_CELLS_X - (4 - EmptyColsRight(Shape, Rotation))
            CellX = #BOARD_CELLS_X - (4 - EmptyColsRight(Shape, Rotation))
          EndIf
              
          If CellY - EmptyRowsTop(Shape, Rotation) < 0
            CellY = 0
          EndIf                      
        ElseIf KeyboardPushed(#PB_Key_Down) 
          KeyDownCounter + 1
          
          If KeyDownCounter = 1
            RemoveWindowTimer(#WINDOW, #DROP_TIMER)
            AddWindowTimer(#WINDOW, #DROP_TIMER, 100)
          EndIf              
        EndIf               
        
        If KeyboardReleased(#PB_Key_Down) 
          KeyDownCounter = 0
          RemoveWindowTimer(#WINDOW, #DROP_TIMER)
          AddWindowTimer(#WINDOW, #DROP_TIMER, FallingSpeed)              
          MoveShapeDown = #True
        EndIf             
        
        If MoveShapeDown                        
          MoveShapeDown = #False

          If MoveDownAllowed(Shape, Rotation, CellY, CellX)
            CellY + 1
          Else
            StoreShapeInBoard(Shape, Rotation, CellY, CellX)              
            DropNewPiece = #True       
          EndIf
        EndIf     
      EndIf             
                         
      If RemoveFullRow() 
        Score + 10 * Level 
        ClearedLines + 1
        
        If ClearedLines = 10 * Level
          Level + 1
          ClearedLines = 0
          FallingSpeed + 100 
        EndIf
      EndIf
      
      DrawBoard(Score, Level, NextShape, FirstTime)
      
      If Not FirstTime 
        DrawShape(Shape, Rotation, CellY, CellX)           
      EndIf
      
      StopDrawing()  
      FlipBuffers() 
    EndIf      
  Until KeyboardPushed(#PB_Key_Escape) Or Event = #PB_Event_CloseWindow 
EndProcedure

Main()
User avatar
STARGÅTE
Addict
Addict
Posts: 2067
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:

Re: My first game

Post by STARGÅTE »

I think every game programmer started with Tetris, so congratulations on your first game. :D

Here are some notes to your code:
  • In DefineShapes() you read the data section with "Read", but you never initialize the start adress. It is safer if you add a label on top of your data and use "Restore ?Label" before reading in the For-loop.
  • It is not a good idea to mearge event-loop and graphic-loop.
    Due to FlipBuffers() on the windowed screen with #PB_Screen_WaitSynchronization (default) your main loop is limited to 60 frames/events per second but you probable generate more events per second. You can see the problem, if you press DOWN, the stone falls only some lines and than the game is freezing, because the timer event can't registrate.
    It is better to call the screen update (StartDrawing()-StopDrawing()-FlipBuffers()) only if you trigger your timer-event (or no event with a time out) and not on all events.
  • In some For-loop you wrote something like:
    "For Row = EmptyRowsTop(Shape, Rotation) To 3 - EmptyRowsBottom(Shape, Rotation)"
    Please keep in mind that in pure basic the To-statement is called in every single iteration, which means "3 - EmptyRowsBottom(Shape, Rotation)" is called multiple times. In a lager game, and a very time consuming function, this can make trouble. It is better to pre-calculate this expression before the loop.
There is also one bug, if you rotate a long stone shortly before ground level stones from horizontal to vertical. Then the stone rotates into the other stones.
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: My first game

Post by RSBasic »

Your first game is great. Works fine. :)
Image
Image
User avatar
zxretrosoft
Enthusiast
Enthusiast
Posts: 169
Joined: Wed May 15, 2013 8:26 am
Location: Czech Republic, Prague
Contact:

Re: My first game

Post by zxretrosoft »

Perfect work! Very nice! 8)
I apologize in advance for bad English
https://zxretrosoft.cz/
User avatar
Mijikai
Addict
Addict
Posts: 1360
Joined: Sun Sep 11, 2016 2:17 pm

Re: My first game

Post by Mijikai »

Looks good :)
#PB_Screen_WaitSynchronization was already mentioned just make sure to account for different V-Sync intervals.
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: My first game

Post by infratec »

You should follow the example for OpenWindowedScreen():

Code: Select all

...
Repeat
      Event = WindowEvent()
      
      Select Event 
        Case #PB_Event_Gadget
          If EventGadget() = 0
            End
          EndIf
        
        Case #PB_Event_CloseWindow
          End 
      EndSelect
    Until Event = 0
  
    FlipBuffers() 
...
Important: not WaitWindowEvent() :!:
Martin Verlaan
Enthusiast
Enthusiast
Posts: 121
Joined: Sun Apr 01, 2018 11:26 am

Re: My first game

Post by Martin Verlaan »

Many thanks to all for the feedback, highly appreciated! I made an improved version. Bug is fixed and all suggestions are done in the code. Don't hestitate to let me know if i am still doing something wrong or when something can be done better.

Code: Select all

;SIMPLE TETRIS CLONE BY MARTIN VERLAAN
; Version 1.1

EnableExplicit

#WINDOW = 0
#SCREEN_WIDTH = 640
#SCREEN_HEIGHT = 480
#BLOCKSIZE = 24
#BOARD_CELLS_X = 10
#BOARD_CELLS_Y = 16
#GRID_WIDTH = (#BOARD_CELLS_X * #BLOCKSIZE) + #BLOCKSIZE
#GRID_HEIGHT = (#BOARD_CELLS_Y * #BLOCKSIZE) + #BLOCKSIZE
#PIECES = 6
#DROP_TIMER = 0

Global Dim Shapes.b(#PIECES, 3, 3, 3)
Global Dim ShapeColors.i(#PIECES)
Global Dim Board.i(#BOARD_CELLS_Y - 1, #BOARD_CELLS_X - 1)

Procedure DefineShapes()
  Protected.i Shape, Rotation, Row, Col
  Protected.b Num
  
  Restore TetrisShapes
  For Shape = 0 To #PIECES
    For Rotation = 0 To 3
      For Row = 0 To 3
        For Col = 0 To 3
          Read.b Num
          Shapes(Shape, Rotation, Row, Col) = Num   
        Next Col
      Next Row
    Next Rotation
  Next Shape
  
  ShapeColors(0) = #Cyan 
  ShapeColors(1) = #Magenta
  ShapeColors(2) = RGB(255,165,0)
  ShapeColors(3) = #Blue
  ShapeColors(4) = #Red
  ShapeColors(5) = #Green
  ShapeColors(6) = #Yellow
  
  DataSection
    TetrisShapes:  
    Data.b 0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0
    Data.b 0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0   
    Data.b 0,0,0,0,1,1,1,0,0,1,0,0,0,0,0,0
    Data.b 0,1,0,0,1,1,0,0,0,1,0,0,0,0,0,0
    Data.b 0,1,0,0,1,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,1,0,0,1,0,0,0,0,0,0
    Data.b 0,0,0,0,1,1,1,0,1,0,0,0,0,0,0,0
    Data.b 1,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0
    Data.b 0,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,0,0,0,1,1,0,0,0,0,0
    Data.b 1,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,1,0,0,1,0,0,0,1,0,0,0,0,0,0
    Data.b 0,0,0,0,1,1,1,0,0,0,1,0,0,0,0,0
    Data.b 0,1,0,0,0,1,0,0,1,1,0,0,0,0,0,0
    Data.b 0,0,0,0,1,1,0,0,0,1,1,0,0,0,0,0
    Data.b 0,0,1,0,0,1,1,0,0,1,0,0,0,0,0,0
    Data.b 0,0,0,0,1,1,0,0,0,1,1,0,0,0,0,0
    Data.b 0,0,1,0,0,1,1,0,0,1,0,0,0,0,0,0
    Data.b 0,0,0,0,0,1,1,0,1,1,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0
    Data.b 0,0,0,0,0,1,1,0,1,1,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0
    Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
  EndDataSection
EndProcedure

Procedure.b RowEmpty(Shape.i, Rotation.i, Row.i)
  Protected.i X, Sum
  Protected.b Empty = #False
  
  For X = 0 To 3
    Sum + Shapes(Shape, Rotation, Row, X) 
  Next X
  
  If Sum = 0
    Empty = #True
  EndIf
  
  ProcedureReturn Empty 
EndProcedure

Procedure.b ColEmpty(Shape.i, Rotation.i, Col.i)
  Protected.i Y, Sum
  Protected Empty = #False
  
  For Y = 0 To 3
    Sum + Shapes(Shape, Rotation, Y, Col) 
  Next Y
  
  If Sum = 0
    Empty = #True
  EndIf
  
  ProcedureReturn Empty 
EndProcedure

Procedure.i EmptyColsLeft(Shape.i, Rotation.i)
  Protected.i Col, X
  
  For Col = 0 To 3
    If ColEmpty(Shape, Rotation, Col)
      X + 1
    Else
      Break
    EndIf
  Next Col 
  
  ProcedureReturn X
EndProcedure

Procedure.i EmptyColsRight(Shape.i, Rotation.i)
  Protected.i Col, X 
  
  For Col = 3 To 0 Step -1
    If ColEmpty(Shape, Rotation, Col)
      X + 1  
    Else 
      Break
    EndIf
  Next Col 
  
  ProcedureReturn X
EndProcedure

Procedure.i EmptyRowsTop(Shape.i, Rotation.i)
  Protected.i Row, Y
  
  For Row = 0 To 3
    If RowEmpty(Shape, Rotation, Row)
      Y + 1
    Else
      Break
    EndIf
  Next Row 
  
  ProcedureReturn Y
EndProcedure

Procedure.i EmptyRowsBottom(Shape.i, Rotation.i)
  Protected.i Row, Y
  
  For Row = 3 To 0 Step -1
    If RowEmpty(Shape, Rotation, Row)
      Y + 1 
    Else
      Break 
    EndIf
  Next Row 
  
  ProcedureReturn Y
EndProcedure

Procedure DrawBlock(Shape.i, Row.i, Col.i, CellY.i, CellX.i, Small.b, Color.i)  
  Protected.i xStart, yStart, X, Y, Size
  
  If Small
    xStart = ((#SCREEN_WIDTH - #GRID_WIDTH) / 2) + 390
    yStart = (#SCREEN_HEIGHT - #GRID_HEIGHT) + 85
    CellX = 0
    CellY = 0
    Size = 10
  Else 
    xStart = 10 + ((#SCREEN_WIDTH - #GRID_WIDTH) / 2)
    yStart = (#SCREEN_HEIGHT - #GRID_HEIGHT)   
    Size = #BLOCKSIZE
  EndIf
  
  X = xStart + (CellX * Size)
  Y = yStart + (CellY * Size)  
 
  DrawingMode(#PB_2DDrawing_Default)
  Box(X + (Col * Size), Y + (Row * Size), Size, Size, Color)
  DrawingMode(#PB_2DDrawing_Outlined)
  Box(X + (Col * Size), Y + (Row * Size), Size, Size, #Black)
EndProcedure

Procedure DrawShape(Shape.i, Rotation.i, CellY.i, CellX.i, Small.b = #False)
  Protected.i Row, Col, Y
  Protected.b EmptyRow = #True
  
  For Row = 0 To 3
    If Small
      If Not EmptyRow 
        Y + 1
      EndIf
    Else 
      Y = Row
    EndIf
    
    EmptyRow = #True
    
    For Col = 0 To 3      
      If Shapes(Shape, Rotation, Row, Col)
        DrawBlock(Shape, Y, Col, CellY, CellX, Small, ShapeColors(Shape))
        EmptyRow = #False
      EndIf
    Next Col
  Next Row  
EndProcedure

Procedure.b GameOver()
  Protected.i Col
  Protected.b StopGame = #False
  
  For Col = 0 To #BOARD_CELLS_X - 1
    If Board(0, Col) <> -1
      StopGame = #True  
    EndIf
  Next Col
  
  ProcedureReturn StopGame
EndProcedure
Procedure DrawBoard(Score.i, Level.i, NextShape.i, FirstTime.b)
  Protected.i X = (#SCREEN_WIDTH - #GRID_WIDTH) / 2
  Protected.i Y = (#SCREEN_HEIGHT - #GRID_HEIGHT) - 10
  Protected.i LineSize = 10
  Protected.i LeftTextPos = X - 170 
  Protected.i Row, Col

  DrawingMode(#PB_2DDrawing_Default)
  
  Box(X, Y, #GRID_WIDTH - 4, #GRID_HEIGHT, RGB(105, 105, 105))          
  Box(LineSize + X, LineSize + Y, (#GRID_WIDTH - 4) - (LineSize * 2), (#GRID_HEIGHT - 4) - (LineSize * 2), #Black)  
  
  DrawText(X + 60, Y - 40, "TETRIS CLONE", #White, #Black)   
  DrawText(LeftTextPos, Y + 25, "CONTROL KEYS", #White, #Black)
  DrawText(LeftTextPos, Y + 50, "New game: SPACE", #White, #Black)  
  DrawText(LeftTextPos, Y + 75, "Move left: " + Chr($25C1), #White, #Black)
  DrawText(LeftTextPos, Y + 100, "Move right: " + Chr($25B7), #White, #Black)
  DrawText(LeftTextPos, Y + 125, "Drop fast: " + Chr($25BD), #White, #Black)  
  DrawText(LeftTextPos, Y + 150, "Rotate: " + Chr($25B3), #White, #Black)    
  DrawText(LeftTextPos, Y + 175, "Pause / Resume: P", #White, #Black)  
  DrawText(LeftTextPos, Y + 200, "Exit: ESC", #White, #Black)    
  DrawText(X + 290, Y + 25, "Score: " + Str(Score), #White, #Black)
  DrawText(X + 290, Y + 60, "Level: " + Str(Level), #White, #Black) 
  DrawText(X + 290, Y + 95, "Next piece: ", #White, #Black)   
  
  If Not FirstTime
    DrawShape(NextShape, 0, 0, 0, #True)   
  EndIf
  
  If GameOver()
    For Row = 0 To 6
      DrawText(X + 290, Y + 155 + (Row * 35), "GAME OVER", ShapeColors(Row), #Black)  
    Next row
  EndIf
  
  For Row = 0 To #BOARD_CELLS_Y - 1
    For Col = 0 To #BOARD_CELLS_X	- 1
      If Board(Row, Col) <> -1
        DrawBlock(Board(Row, Col), Row, Col, 0, 0, #False, ShapeColors(Board(Row, Col)))
      Else
        DrawBlock(Board(Row, Col), Row, Col, 0, 0, #False, #Gray)
      EndIf
	  Next Col 
 	Next Row     
EndProcedure

Procedure.i ShapeCellsX(Shape.i, Rotation.i)
  Protected.i Row, Col
  
  Dim Sum.i(3)
  
  For Row = 0 To 3
    For Col = 0 To 3  
      Sum(Row) + Shapes(Shape, Rotation, Row, Col) 
    Next Col
  Next Row
  
  SortArray(Sum(), #PB_Sort_Descending)

  ProcedureReturn Sum(0)
EndProcedure

Procedure StoreShapeInBoard(Shape.i, Rotation.i, CellY.i, CellX.i)
  Protected.i Row, Col
  
  For Row = 0 To 3
    For Col = 0 To 3	
      If Shapes(Shape, Rotation, Row, Col)
        Board(CellY + Row, CellX + Col) = Shape
      EndIf
    Next Col
  Next Row  
EndProcedure

Procedure.b RemoveFullRow()
  Protected.i Row, Col, Y, X
  Protected.b FullRow  
  
  For Row = 0 To #BOARD_CELLS_Y - 1
    FullRow = #True
    
    For Col = 0 To #BOARD_CELLS_X - 1
       If Board(Row, Col) = -1 
         FullRow = #False 
         Break
       EndIf       
    Next Col
    
    If FullRow
      For Y = Row To 1 Step -1
        For X = 0 To #BOARD_CELLS_X - 1
          board(Y, X) = board(Y - 1, X)
        Next X
      Next Y
      
      Break
    EndIf
  Next Row   
  
  ProcedureReturn FullRow
EndProcedure

Procedure.b MoveDownAllowed(Shape.i, Rotation.i, CellY.i, CellX.i, EmptyColsLft.i, EmptyColsRght.i, EmptyRowsTp.i, EmptyRowsBttm.i) 
  Protected.i Col, Row
  Protected.b MoveDown = #True
  
  If CellY < #BOARD_CELLS_Y - (4 - EmptyRowsBttm)
    For Row = EmptyRowsTp To 3 - EmptyRowsBttm
      For Col = EmptyColsLft To 3 - EmptyColsRght
        If Shapes(Shape, Rotation, Row, Col) And Board(Row + CellY + 1, Col + CellX) <> -1          
          MoveDown = #False
          Break 2    
        EndIf
      Next Col    
    Next Row
  Else
    MoveDown = #False
  EndIf
  
  ProcedureReturn MoveDown
EndProcedure

Procedure.b MoveLeftAllowed(Shape.i, Rotation.i, CellY.i, CellX.i, EmptyColsLft.i, EmptyColsRght.i, EmptyRowsTp.i, EmptyRowsBttm.i) 
  Protected.i Col, Row
  Protected.b MoveLeft = #False
  
  If CellX + EmptyColsLft > 0 
    MoveLeft = #True
 
    For Row = EmptyRowsTp To 3 - EmptyRowsBttm
      For Col = EmptyColsLft To 3 - EmptyColsRght
        If Shapes(Shape, Rotation, Row, Col) And Board(CellY + Row, CellX + Col - 1) <> -1          
          MoveLeft = #False
          Break 2    
        EndIf
      Next Col    
    Next Row
  EndIf
  
  ProcedureReturn MoveLeft
EndProcedure

Procedure.b MoveRightAllowed(Shape.i, Rotation.i, CellY.i, CellX.i, EmptyColsLft.i, EmptyColsRght.i, EmptyRowsTp.i, EmptyRowsBttm.i) 
  Protected.i Col, Row
  Protected MoveRight = #False
  
  If CellX < #BOARD_CELLS_X - (4 - EmptyColsRght)
    MoveRight = #True
 
    For Row = EmptyRowsTp To 3 - EmptyRowsBttm
      For Col = EmptyColsLft To 3 - EmptyColsRght
        If Shapes(Shape, Rotation, Row, Col) And Board(CellY + Row, CellX + Col + 1) <> -1          
          MoveRight = #False
          Break 2    
        EndIf
      Next Col    
    Next Row
  EndIf
  
  ProcedureReturn MoveRight
EndProcedure

Procedure MakeBoardEmpty()
  Protected.i Row, Col
  
  For Row = 0 To #BOARD_CELLS_Y - 1
    For Col = 0 To #BOARD_CELLS_X	- 1
      Board(Row, Col) = -1
	  Next Col
	Next Row    
EndProcedure

Procedure Main()    
  Protected.i Event, Rotation, Row, Col, KeyDownCounter, CellY, CellX, Score, Shape, ClearedLines 
  Protected.i EmptyColsLft, EmptyColsRght, EmptyRowsTp, EmptyRowsBttm
  Protected.i FallingSpeed = 1000
  Protected.i NextShape = Random(#PIECES, 0)  
  Protected.i Level = 1
  Protected.b Paused = #False  
  Protected.b MoveShapeDown = #False
  Protected.b DropNewPiece = #True
  Protected.b FirstTime = #True
  
  If Not OpenWindow(#WINDOW, 216, 0, #SCREEN_WIDTH, #SCREEN_HEIGHT, "Tetris clone") 
    MessageRequester("Error", "Window cannot be opened")
    End
  EndIf
  
  If Not InitSprite()
    MessageRequester("Error", "Cannot initialize sprite environment")
    End    
  EndIf
  
  If Not OpenWindowedScreen(WindowID(#WINDOW), 0, 0, #SCREEN_WIDTH, #SCREEN_HEIGHT)  
    MessageRequester("Error", "Screen area cannot be opened")
    End
  EndIf

  InitKeyboard() 
  MakeBoardEmpty()   
  DefineShapes()
  
  AddWindowTimer(#WINDOW, #DROP_TIMER, FallingSpeed)
  
  Repeat 
    Event = WindowEvent()
                
    ExamineKeyboard()
    
    If KeyboardReleased(#PB_Key_Space)
      MakeBoardEmpty()        
      FirstTime = #False
      DropNewPiece = #True 
      FallingSpeed = 1000
      Level = 1
      Score = 0            
      ClearedLines = 0   
    ElseIf KeyboardReleased(#PB_Key_P)     
      If Paused 
        Paused = #False
      Else 
        Paused = #True
      EndIf
    EndIf
    
    If Not Paused And Not GameOver() And Not FirstTime
      If Event = #PB_Event_Timer And EventTimer() = #DROP_TIMER 
        MoveShapeDown = #True          
      EndIf    
      
      If KeyboardReleased(#PB_Key_Left)          
        If MoveLeftAllowed(Shape, Rotation, CellY, CellX, EmptyColsLft, EmptyColsRght, EmptyRowsTp, EmptyRowsBttm)
          CellX - 1
        EndIf           
      ElseIf KeyboardReleased(#PB_Key_Right) 
        If MoveRightAllowed(Shape, Rotation, CellY, CellX, EmptyColsLft, EmptyColsRght, EmptyRowsTp, EmptyRowsBttm)
          CellX + 1
        EndIf 
      ElseIf KeyboardReleased(#PB_Key_Up) 
        Rotation + 1            
        If Rotation > 3
          Rotation = 0
        EndIf         
        
        EmptyColsLft = EmptyColsLeft(Shape, Rotation)
        EmptyColsRght = EmptyColsRight(Shape, Rotation)
        EmptyRowsTp = EmptyRowsTop(Shape, Rotation)
        EmptyRowsBttm = EmptyRowsBottom(Shape, Rotation)            
          
        If CellX + EmptyColsLft < 0
          CellX = 0
        EndIf

        If CellX > #BOARD_CELLS_X - 4 - EmptyColsRght
          CellX = #BOARD_CELLS_X - 4 - EmptyColsRght
        EndIf
            
        If CellY - EmptyRowsTp < 0
          CellY = 0
        EndIf                     
        
        
        If CellY > #BOARD_CELLS_Y - (4 - EmptyRowsBttm)
          CellY = #BOARD_CELLS_Y - (4 - EmptyRowsBttm)
        EndIf
      ElseIf KeyboardPushed(#PB_Key_Down) 
        KeyDownCounter + 1
        
        If KeyDownCounter = 1
          RemoveWindowTimer(#WINDOW, #DROP_TIMER)
          AddWindowTimer(#WINDOW, #DROP_TIMER, 100)
        EndIf              
      EndIf               
      
      If KeyboardReleased(#PB_Key_Down) 
        KeyDownCounter = 0
        RemoveWindowTimer(#WINDOW, #DROP_TIMER)
        AddWindowTimer(#WINDOW, #DROP_TIMER, FallingSpeed)              
        MoveShapeDown = #True
      EndIf             
      
      If MoveShapeDown                        
        MoveShapeDown = #False

        If MoveDownAllowed(Shape, Rotation, CellY, CellX, EmptyColsLft, EmptyColsRght, EmptyRowsTp, EmptyRowsBttm)
          CellY + 1
        Else
          StoreShapeInBoard(Shape, Rotation, CellY, CellX)              
          DropNewPiece = #True       
        EndIf
      EndIf     
    EndIf             
                       
    If RemoveFullRow() 
      Score + (10 * Level)
      ClearedLines + 1
      
      If ClearedLines = 10 * Level
        Level + 1
        ClearedLines = 0
        FallingSpeed + 100 
      EndIf
    EndIf
    
    If DropNewPiece 
      DropNewPiece = #False           
      Shape = NextShape
      NextShape = Random(#PIECES, 0)
      Rotation = 0         
      CellY = 0 - EmptyRowsTop(Shape, Rotation)
      CellX = (#BOARD_CELLS_X / 2) - (ShapeCellsX(Shape, Rotation) / 2)   
      EmptyColsLft = EmptyColsLeft(Shape, Rotation)
      EmptyColsRght = EmptyColsRight(Shape, Rotation)
      EmptyRowsTp = EmptyRowsTop(Shape, Rotation)
      EmptyRowsBttm = EmptyRowsBottom(Shape, Rotation)      
    EndIf    
      
    ClearScreen(RGB(0, 0, 0))    
           
    If StartDrawing(ScreenOutput())      
      DrawBoard(Score, Level, NextShape, FirstTime)
      
      If Not FirstTime 
        DrawShape(Shape, Rotation, CellY, CellX)           
      EndIf
      
      StopDrawing()  
      FlipBuffers()       
    EndIf      
    
    Delay(10) 
  Until KeyboardPushed(#PB_Key_Escape) Or Event = #PB_Event_CloseWindow 
EndProcedure

Main()
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: My first game

Post by infratec »

Still not correct.

It is a window arround.
This window produces a lot of Events.
At the moment you only fetch one Event per loop.
So your Eventqueue stucks.

You need (as shown in the example) an own loop to catch all current events.

Code: Select all

AddWindowTimer(#WINDOW, #DROP_TIMER, FallingSpeed)
 
Repeat
  Repeat
    Event = WindowEvent()
    
    Select Event
      Case #PB_Event_Timer
        If Not Paused
          If EventTimer() = #DROP_TIMER 
            MoveShapeDown = #True         
          EndIf
        EndIf
        
      Case #PB_Event_CloseWindow
        Exit = #True
        
    EndSelect
    
  Until Event = 0
  
  
  ....
  
  
  Until KeyboardReleased(#PB_Key_Escape) Or Exit
Also use KeyboardReleased() else an unhandled keyboard release is send to the OS which maybe influence the now active window.
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: My first game

Post by davido »

@Martin Verlaan,

Very nice.
Thank you.

Did you intend that it would work on the Mac?
It works fine on my Mac! :D
DE AA EB
Martin Verlaan
Enthusiast
Enthusiast
Posts: 121
Joined: Sun Apr 01, 2018 11:26 am

Re: My first game

Post by Martin Verlaan »

@davido: Happy to hear it also works on the Mac. I am using Linux Mint, so it works with Linux. And Windows too I assume (if DirectX is installed).

@infratec: I think I understand it better now, thanks to your example. Made some changes in Main() again. Hopefully I did it right this time. If Event loop and video rendering is done correctly, I will maybe extend the game with sound, effects and better score. Although I am also eager for a new challenge: creating a Boulderdash clone... :)

Code: Select all

;SIMPLE TETRIS CLONE (VERSION 1.2) BY MARTIN VERLAAN

EnableExplicit

#WINDOW = 0
#SCREEN_WIDTH = 640
#SCREEN_HEIGHT = 480
#BLOCKSIZE = 24
#BOARD_CELLS_X = 10
#BOARD_CELLS_Y = 16
#GRID_WIDTH = (#BOARD_CELLS_X * #BLOCKSIZE) + #BLOCKSIZE
#GRID_HEIGHT = (#BOARD_CELLS_Y * #BLOCKSIZE) + #BLOCKSIZE
#PIECES = 6
#DROP_TIMER = 0

Global Dim Shapes.b(#PIECES, 3, 3, 3)
Global Dim ShapeColors.i(#PIECES)
Global Dim Board.i(#BOARD_CELLS_Y - 1, #BOARD_CELLS_X - 1)

Procedure DefineShapes()
  Protected.i Shape, Rotation, Row, Col
  Protected.b Num
  
  Restore TetrisShapes
  For Shape = 0 To #PIECES
    For Rotation = 0 To 3
      For Row = 0 To 3
        For Col = 0 To 3
          Read.b Num
          Shapes(Shape, Rotation, Row, Col) = Num   
        Next Col
      Next Row
    Next Rotation
  Next Shape
  
  ShapeColors(0) = #Cyan 
  ShapeColors(1) = #Magenta
  ShapeColors(2) = RGB(255,165,0)
  ShapeColors(3) = #Blue
  ShapeColors(4) = #Red
  ShapeColors(5) = #Green
  ShapeColors(6) = #Yellow
  
  DataSection
    TetrisShapes:  
    Data.b 0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0
    Data.b 0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0   
    Data.b 0,0,0,0,1,1,1,0,0,1,0,0,0,0,0,0
    Data.b 0,1,0,0,1,1,0,0,0,1,0,0,0,0,0,0
    Data.b 0,1,0,0,1,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,1,0,0,1,0,0,0,0,0,0
    Data.b 0,0,0,0,1,1,1,0,1,0,0,0,0,0,0,0
    Data.b 1,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0
    Data.b 0,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,0,0,0,1,1,0,0,0,0,0
    Data.b 1,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,1,0,0,1,0,0,0,1,0,0,0,0,0,0
    Data.b 0,0,0,0,1,1,1,0,0,0,1,0,0,0,0,0
    Data.b 0,1,0,0,0,1,0,0,1,1,0,0,0,0,0,0
    Data.b 0,0,0,0,1,1,0,0,0,1,1,0,0,0,0,0
    Data.b 0,0,1,0,0,1,1,0,0,1,0,0,0,0,0,0
    Data.b 0,0,0,0,1,1,0,0,0,1,1,0,0,0,0,0
    Data.b 0,0,1,0,0,1,1,0,0,1,0,0,0,0,0,0
    Data.b 0,0,0,0,0,1,1,0,1,1,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0
    Data.b 0,0,0,0,0,1,1,0,1,1,0,0,0,0,0,0
    Data.b 0,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0
    Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
    Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
  EndDataSection
EndProcedure

Procedure.b RowEmpty(Shape.i, Rotation.i, Row.i)
  Protected.i X, Sum
  Protected.b Empty = #False
  
  For X = 0 To 3
    Sum + Shapes(Shape, Rotation, Row, X) 
  Next X
  
  If Sum = 0
    Empty = #True
  EndIf
  
  ProcedureReturn Empty 
EndProcedure

Procedure.b ColEmpty(Shape.i, Rotation.i, Col.i)
  Protected.i Y, Sum
  Protected Empty = #False
  
  For Y = 0 To 3
    Sum + Shapes(Shape, Rotation, Y, Col) 
  Next Y
  
  If Sum = 0
    Empty = #True
  EndIf
  
  ProcedureReturn Empty 
EndProcedure

Procedure.i EmptyColsLeft(Shape.i, Rotation.i)
  Protected.i Col, X
  
  For Col = 0 To 3
    If ColEmpty(Shape, Rotation, Col)
      X + 1
    Else
      Break
    EndIf
  Next Col 
  
  ProcedureReturn X
EndProcedure

Procedure.i EmptyColsRight(Shape.i, Rotation.i)
  Protected.i Col, X 
  
  For Col = 3 To 0 Step -1
    If ColEmpty(Shape, Rotation, Col)
      X + 1  
    Else 
      Break
    EndIf
  Next Col 
  
  ProcedureReturn X
EndProcedure

Procedure.i EmptyRowsTop(Shape.i, Rotation.i)
  Protected.i Row, Y
  
  For Row = 0 To 3
    If RowEmpty(Shape, Rotation, Row)
      Y + 1
    Else
      Break
    EndIf
  Next Row 
  
  ProcedureReturn Y
EndProcedure

Procedure.i EmptyRowsBottom(Shape.i, Rotation.i)
  Protected.i Row, Y
  
  For Row = 3 To 0 Step -1
    If RowEmpty(Shape, Rotation, Row)
      Y + 1 
    Else
      Break 
    EndIf
  Next Row 
  
  ProcedureReturn Y
EndProcedure

Procedure DrawBlock(Shape.i, Row.i, Col.i, CellY.i, CellX.i, Small.b, Color.i)  
  Protected.i xStart, yStart, X, Y, Size
  
  If Small
    xStart = ((#SCREEN_WIDTH - #GRID_WIDTH) / 2) + 390
    yStart = (#SCREEN_HEIGHT - #GRID_HEIGHT) + 85
    CellX = 0
    CellY = 0
    Size = 10
  Else 
    xStart = 10 + ((#SCREEN_WIDTH - #GRID_WIDTH) / 2)
    yStart = (#SCREEN_HEIGHT - #GRID_HEIGHT)   
    Size = #BLOCKSIZE
  EndIf
  
  X = xStart + (CellX * Size)
  Y = yStart + (CellY * Size)  
 
  DrawingMode(#PB_2DDrawing_Default)
  Box(X + (Col * Size), Y + (Row * Size), Size, Size, Color)
  DrawingMode(#PB_2DDrawing_Outlined)
  Box(X + (Col * Size), Y + (Row * Size), Size, Size, #Black)
EndProcedure

Procedure DrawShape(Shape.i, Rotation.i, CellY.i, CellX.i, Small.b = #False)
  Protected.i Row, Col, Y
  Protected.b EmptyRow = #True
  
  For Row = 0 To 3
    If Small
      If Not EmptyRow 
        Y + 1
      EndIf
    Else 
      Y = Row
    EndIf
    
    EmptyRow = #True
    
    For Col = 0 To 3      
      If Shapes(Shape, Rotation, Row, Col)
        DrawBlock(Shape, Y, Col, CellY, CellX, Small, ShapeColors(Shape))
        EmptyRow = #False
      EndIf
    Next Col
  Next Row  
EndProcedure

Procedure.b GameOver()
  Protected.i Col
  Protected.b StopGame = #False
  
  For Col = 0 To #BOARD_CELLS_X - 1
    If Board(0, Col) <> -1
      StopGame = #True  
    EndIf
  Next Col
  
  ProcedureReturn StopGame
EndProcedure

Procedure DrawBoard(Score.i, Level.i, NextShape.i, FirstTime.b, StopGame.b)
  Protected.i X = (#SCREEN_WIDTH - #GRID_WIDTH) / 2
  Protected.i Y = (#SCREEN_HEIGHT - #GRID_HEIGHT) - 10
  Protected.i LineSize = 10
  Protected.i LeftTextPos = X - 170 
  Protected.i Row, Col

  DrawingMode(#PB_2DDrawing_Default)
  
  Box(X, Y, #GRID_WIDTH - 4, #GRID_HEIGHT, RGB(105, 105, 105))          
  Box(LineSize + X, LineSize + Y, (#GRID_WIDTH - 4) - (LineSize * 2), (#GRID_HEIGHT - 4) - (LineSize * 2), #Black)  
  
  DrawText(X + 30, Y - 40, "SIMPLE TETRIS CLONE", #White, #Black)   
  DrawText(LeftTextPos, Y + 25, "CONTROL KEYS", #White, #Black)
  DrawText(LeftTextPos, Y + 50, "New game: SPACE", #White, #Black)  
  DrawText(LeftTextPos, Y + 75, "Move left: " + Chr($25C1), #White, #Black)
  DrawText(LeftTextPos, Y + 100, "Move right: " + Chr($25B7), #White, #Black)
  DrawText(LeftTextPos, Y + 125, "Drop fast: " + Chr($25BD), #White, #Black)  
  DrawText(LeftTextPos, Y + 150, "Rotate: " + Chr($25B3), #White, #Black)    
  DrawText(LeftTextPos, Y + 175, "Pause / Resume: P", #White, #Black)  
  DrawText(LeftTextPos, Y + 200, "Exit: ESC", #White, #Black)    
  DrawText(X + 290, Y + 25, "Score: " + Str(Score), #White, #Black)
  DrawText(X + 290, Y + 60, "Level: " + Str(Level), #White, #Black) 
  DrawText(X + 290, Y + 95, "Next piece: ", #White, #Black)   
  
  If Not FirstTime
    DrawShape(NextShape, 0, 0, 0, #True)   
  EndIf
  
  If StopGame
    For Row = 0 To 6
      DrawText(X + 290, Y + 155 + (Row * 35), "GAME OVER", ShapeColors(Row), #Black)  
    Next row
  EndIf
  
  For Row = 0 To #BOARD_CELLS_Y - 1
    For Col = 0 To #BOARD_CELLS_X	- 1
      If Board(Row, Col) <> -1
        DrawBlock(Board(Row, Col), Row, Col, 0, 0, #False, ShapeColors(Board(Row, Col)))
      Else
        DrawBlock(Board(Row, Col), Row, Col, 0, 0, #False, #Gray)
      EndIf
	  Next Col 
 	Next Row     
EndProcedure

Procedure.i ShapeCellsX(Shape.i, Rotation.i)
  Protected.i Row, Col
  
  Dim Sum.i(3)
  
  For Row = 0 To 3
    For Col = 0 To 3  
      Sum(Row) + Shapes(Shape, Rotation, Row, Col) 
    Next Col
  Next Row
  
  SortArray(Sum(), #PB_Sort_Descending)

  ProcedureReturn Sum(0)
EndProcedure

Procedure StoreShapeInBoard(Shape.i, Rotation.i, CellY.i, CellX.i)
  Protected.i Row, Col
  
  For Row = 0 To 3
    For Col = 0 To 3	
      If Shapes(Shape, Rotation, Row, Col)
        Board(CellY + Row, CellX + Col) = Shape
      EndIf
    Next Col
  Next Row  
EndProcedure

Procedure.b RemoveFullRow()
  Protected.i Row, Col, Y, X
  Protected.b FullRow  
  
  For Row = 0 To #BOARD_CELLS_Y - 1
    FullRow = #True
    
    For Col = 0 To #BOARD_CELLS_X - 1
       If Board(Row, Col) = -1 
         FullRow = #False 
         Break
       EndIf       
    Next Col
    
    If FullRow
      For Y = Row To 1 Step -1
        For X = 0 To #BOARD_CELLS_X - 1
          board(Y, X) = board(Y - 1, X)
        Next X
      Next Y
      
      Break
    EndIf
  Next Row   
  
  ProcedureReturn FullRow
EndProcedure

Procedure.b MoveDownAllowed(Shape.i, Rotation.i, CellY.i, CellX.i, EmptyColsLft.i, EmptyColsRght.i, EmptyRowsTp.i, EmptyRowsBttm.i) 
  Protected.i Col, Row
  Protected.b MoveDown = #True
  
  If CellY < #BOARD_CELLS_Y - (4 - EmptyRowsBttm)
    For Row = EmptyRowsTp To 3 - EmptyRowsBttm
      For Col = EmptyColsLft To 3 - EmptyColsRght
        If Shapes(Shape, Rotation, Row, Col) And Board(Row + CellY + 1, Col + CellX) <> -1          
          MoveDown = #False
          Break 2    
        EndIf
      Next Col    
    Next Row
  Else
    MoveDown = #False
  EndIf
  
  ProcedureReturn MoveDown
EndProcedure

Procedure.b MoveLeftAllowed(Shape.i, Rotation.i, CellY.i, CellX.i, EmptyColsLft.i, EmptyColsRght.i, EmptyRowsTp.i, EmptyRowsBttm.i) 
  Protected.i Col, Row
  Protected.b MoveLeft = #False
  
  If CellX + EmptyColsLft > 0 
    MoveLeft = #True
 
    For Row = EmptyRowsTp To 3 - EmptyRowsBttm
      For Col = EmptyColsLft To 3 - EmptyColsRght
        If Shapes(Shape, Rotation, Row, Col) And Board(CellY + Row, CellX + Col - 1) <> -1          
          MoveLeft = #False
          Break 2    
        EndIf
      Next Col    
    Next Row
  EndIf
  
  ProcedureReturn MoveLeft
EndProcedure

Procedure.b MoveRightAllowed(Shape.i, Rotation.i, CellY.i, CellX.i, EmptyColsLft.i, EmptyColsRght.i, EmptyRowsTp.i, EmptyRowsBttm.i) 
  Protected.i Col, Row
  Protected MoveRight = #False
  
  If CellX < #BOARD_CELLS_X - (4 - EmptyColsRght)
    MoveRight = #True
 
    For Row = EmptyRowsTp To 3 - EmptyRowsBttm
      For Col = EmptyColsLft To 3 - EmptyColsRght
        If Shapes(Shape, Rotation, Row, Col) And Board(CellY + Row, CellX + Col + 1) <> -1          
          MoveRight = #False
          Break 2    
        EndIf
      Next Col    
    Next Row
  EndIf
  
  ProcedureReturn MoveRight
EndProcedure

Procedure MakeBoardEmpty()
  Protected.i Row, Col
  
  For Row = 0 To #BOARD_CELLS_Y - 1
    For Col = 0 To #BOARD_CELLS_X - 1
      Board(Row, Col) = -1
	  Next Col
	Next Row    
EndProcedure

Procedure Main()    
  Protected.i Event, Rotation, Row, Col, KeyDownCounter, CellY, CellX, Score, Shape, ClearedLines 
  Protected.i EmptyColsLft, EmptyColsRght, EmptyRowsTp, EmptyRowsBttm
  Protected.i FallingSpeed = 1000
  Protected.i NextShape = Random(#PIECES, 0)  
  Protected.i Level = 1
  Protected.b Paused = #False  
  Protected.b MoveShapeDown = #False
  Protected.b DropNewPiece = #True
  Protected.b FirstTime = #True
  Protected.b StopGame = #False

  If Not OpenWindow(#WINDOW, 216, 0, #SCREEN_WIDTH, #SCREEN_HEIGHT, "Simple Tetris Clone v1.2 by Martin Verlaan") 
    MessageRequester("Error", "Window cannot be opened")
    End
  EndIf
  
  If Not InitSprite()
    MessageRequester("Error", "Cannot initialize sprite environment")
    End    
  EndIf
  
  If Not OpenWindowedScreen(WindowID(#WINDOW), 0, 0, #SCREEN_WIDTH, #SCREEN_HEIGHT)  
    MessageRequester("Error", "Screen area cannot be opened")
    End
  EndIf

  InitKeyboard() 
  MakeBoardEmpty()   
  DefineShapes()
  
  AddWindowTimer(#WINDOW, #DROP_TIMER, FallingSpeed)
  
  Repeat 
    Repeat        
     
      Event = WindowEvent()
      
      Select Event
        Case #PB_Event_Timer 
          If Not Paused And Not StopGame And Not FirstTime
            If EventTimer() = #DROP_TIMER 
              MoveShapeDown = #True          
            EndIf            
          EndIf
        Case #PB_Event_CloseWindow 
          End
      EndSelect  
      
      ExamineKeyboard()
      
      If KeyboardReleased(#PB_Key_Escape)
        End
      ElseIf KeyboardReleased(#PB_Key_Space)
        MakeBoardEmpty()        
        FirstTime = #False
        DropNewPiece = #True 
        FallingSpeed = 1000
        Level = 1
        Score = 0            
        ClearedLines = 0  
        Paused = #False
      ElseIf KeyboardReleased(#PB_Key_P)     
        If Paused 
          Paused = #False
        Else 
          Paused = #True
        EndIf
      ElseIf KeyboardReleased(#PB_Key_Left)
        If Not Paused And Not StopGame And Not FirstTime
          If MoveLeftAllowed(Shape, Rotation, CellY, CellX, EmptyColsLft, EmptyColsRght, EmptyRowsTp, EmptyRowsBttm)
            CellX - 1
          EndIf 
        EndIf
      ElseIf KeyboardReleased(#PB_Key_Right) 
        If Not Paused And Not StopGame And Not FirstTime
          If MoveRightAllowed(Shape, Rotation, CellY, CellX, EmptyColsLft, EmptyColsRght, EmptyRowsTp, EmptyRowsBttm)
            CellX + 1
          EndIf 
        EndIf
      ElseIf KeyboardReleased(#PB_Key_Up) 
        If Not Paused And Not StopGame And Not FirstTime
          Rotation + 1            
          If Rotation > 3
            Rotation = 0
          EndIf         
          
          EmptyColsLft = EmptyColsLeft(Shape, Rotation)
          EmptyColsRght = EmptyColsRight(Shape, Rotation)
          EmptyRowsTp = EmptyRowsTop(Shape, Rotation)
          EmptyRowsBttm = EmptyRowsBottom(Shape, Rotation)            
            
          If CellX + EmptyColsLft < 0
            CellX = 0
          EndIf
  
          If CellX > #BOARD_CELLS_X - 4 - EmptyColsRght
            CellX = #BOARD_CELLS_X - 4 - EmptyColsRght
          EndIf
              
          If CellY - EmptyRowsTp < 0
            CellY = 0
          EndIf                             
          
          If CellY > #BOARD_CELLS_Y - (4 - EmptyRowsBttm)
            CellY = #BOARD_CELLS_Y - (4 - EmptyRowsBttm)
          EndIf
        EndIf
      ElseIf KeyboardPushed(#PB_Key_Down)
        If Not Paused And Not StopGame And Not FirstTime
          KeyDownCounter + 1
          
          If KeyDownCounter = 1
            RemoveWindowTimer(#WINDOW, #DROP_TIMER)
            AddWindowTimer(#WINDOW, #DROP_TIMER, 100)
          EndIf   
        EndIf
      EndIf
      
      If KeyboardReleased(#PB_Key_Down) 
        If Not Paused And Not StopGame And Not FirstTime
          KeyDownCounter = 0
          RemoveWindowTimer(#WINDOW, #DROP_TIMER)
          AddWindowTimer(#WINDOW, #DROP_TIMER, FallingSpeed)              
          MoveShapeDown = #True
        EndIf             
      EndIf
      
      If Not Paused And Not StopGame And Not FirstTime
        If MoveShapeDown                        
          MoveShapeDown = #False
  
          If MoveDownAllowed(Shape, Rotation, CellY, CellX, EmptyColsLft, EmptyColsRght, EmptyRowsTp, EmptyRowsBttm)
            CellY + 1
          Else
            StoreShapeInBoard(Shape, Rotation, CellY, CellX)              
            DropNewPiece = #True       
          EndIf
        EndIf     
                                     
        If RemoveFullRow() 
          Score + (10 * Level)
          ClearedLines + 1
          
          If ClearedLines = 10 * Level
            Level + 1
            ClearedLines = 0
            FallingSpeed + 100 
          EndIf
        EndIf
    
        If DropNewPiece 
          DropNewPiece = #False           
          Shape = NextShape
          NextShape = Random(#PIECES, 0)
          Rotation = 0         
          CellY = 0 - EmptyRowsTop(Shape, Rotation)
          CellX = (#BOARD_CELLS_X / 2) - (ShapeCellsX(Shape, Rotation) / 2)   
          EmptyColsLft = EmptyColsLeft(Shape, Rotation)
          EmptyColsRght = EmptyColsRight(Shape, Rotation)
          EmptyRowsTp = EmptyRowsTop(Shape, Rotation)
          EmptyRowsBttm = EmptyRowsBottom(Shape, Rotation)      
        EndIf    
      EndIf    
      
      ClearScreen(RGB(0, 0, 0))    
             
      If StartDrawing(ScreenOutput())      
        DrawBoard(Score, Level, NextShape, FirstTime, StopGame)
        
        If Not FirstTime 
          DrawShape(Shape, Rotation, CellY, CellX)           
        EndIf
        
        StopDrawing()  
        FlipBuffers()       
      EndIf      
        
      StopGame = GameOver()
      
      Delay(10) 
    Until Event = 0
  ForEver
EndProcedure

Main()
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: My first game

Post by infratec »

Still not right.

You have first handle (or not) all events from the window before you do anything with the screen stuff.

The event loop in my example was clear (or not).
At the moment you still read only one event per outer loop.

Look also at the help example of OpenWindowedScreen()
Martin Verlaan
Enthusiast
Enthusiast
Posts: 121
Joined: Sun Apr 01, 2018 11:26 am

Re: My first game

Post by Martin Verlaan »

:oops: Thanks for your help. I moved Until Event = 0 to the line under EndSelect.Must be good now, right? Or should I put Until Event = 0 under the if KeyboardReleased statements (these are also events)?

Code: Select all

Procedure Main()    
  Protected.i Event, Rotation, Row, Col, KeyDownCounter, CellY, CellX, Score, Shape, ClearedLines 
  Protected.i EmptyColsLft, EmptyColsRght, EmptyRowsTp, EmptyRowsBttm
  Protected.i FallingSpeed = 1000
  Protected.i NextShape = Random(#PIECES, 0)  
  Protected.i Level = 1
  Protected.b Paused = #False  
  Protected.b MoveShapeDown = #False
  Protected.b DropNewPiece = #True
  Protected.b FirstTime = #True
  Protected.b StopGame = #False

  If Not OpenWindow(#WINDOW, 216, 0, #SCREEN_WIDTH, #SCREEN_HEIGHT, "Simple Tetris Clone v1.2 by Martin Verlaan") 
    MessageRequester("Error", "Window cannot be opened")
    End
  EndIf
  
  If Not InitSprite()
    MessageRequester("Error", "Cannot initialize sprite environment")
    End    
  EndIf
  
  If Not OpenWindowedScreen(WindowID(#WINDOW), 0, 0, #SCREEN_WIDTH, #SCREEN_HEIGHT)  
    MessageRequester("Error", "Screen area cannot be opened")
    End
  EndIf

  InitKeyboard() 
  MakeBoardEmpty()   
  DefineShapes()
  
  AddWindowTimer(#WINDOW, #DROP_TIMER, FallingSpeed)
  
  Repeat 
    Repeat        
     
      Event = WindowEvent()
      
      Select Event
        Case #PB_Event_Timer 
          If Not Paused And Not StopGame And Not FirstTime
            If EventTimer() = #DROP_TIMER 
              MoveShapeDown = #True          
            EndIf            
          EndIf
        Case #PB_Event_CloseWindow 
          End
      EndSelect  
    Until Event = 0      
    
    ExamineKeyboard()
    
    If KeyboardReleased(#PB_Key_Escape)
      End
    ElseIf KeyboardReleased(#PB_Key_Space)
      MakeBoardEmpty()        
      FirstTime = #False
      DropNewPiece = #True 
      FallingSpeed = 1000
      Level = 1
      Score = 0            
      ClearedLines = 0  
      Paused = #False
    ElseIf KeyboardReleased(#PB_Key_P)     
      If Paused 
        Paused = #False
      Else 
        Paused = #True
      EndIf
    ElseIf KeyboardReleased(#PB_Key_Left)
      If Not Paused And Not StopGame And Not FirstTime
        If MoveLeftAllowed(Shape, Rotation, CellY, CellX, EmptyColsLft, EmptyColsRght, EmptyRowsTp, EmptyRowsBttm)
          CellX - 1
        EndIf 
      EndIf
    ElseIf KeyboardReleased(#PB_Key_Right) 
      If Not Paused And Not StopGame And Not FirstTime
        If MoveRightAllowed(Shape, Rotation, CellY, CellX, EmptyColsLft, EmptyColsRght, EmptyRowsTp, EmptyRowsBttm)
          CellX + 1
        EndIf 
      EndIf
    ElseIf KeyboardReleased(#PB_Key_Up) 
      If Not Paused And Not StopGame And Not FirstTime
        Rotation + 1            
        If Rotation > 3
          Rotation = 0
        EndIf         
        
        EmptyColsLft = EmptyColsLeft(Shape, Rotation)
        EmptyColsRght = EmptyColsRight(Shape, Rotation)
        EmptyRowsTp = EmptyRowsTop(Shape, Rotation)
        EmptyRowsBttm = EmptyRowsBottom(Shape, Rotation)            
          
        If CellX + EmptyColsLft < 0
          CellX = 0
        EndIf

        If CellX > #BOARD_CELLS_X - 4 - EmptyColsRght
          CellX = #BOARD_CELLS_X - 4 - EmptyColsRght
        EndIf
            
        If CellY - EmptyRowsTp < 0
          CellY = 0
        EndIf                             
        
        If CellY > #BOARD_CELLS_Y - (4 - EmptyRowsBttm)
          CellY = #BOARD_CELLS_Y - (4 - EmptyRowsBttm)
        EndIf
      EndIf
    ElseIf KeyboardPushed(#PB_Key_Down)
      If Not Paused And Not StopGame And Not FirstTime
        KeyDownCounter + 1
        
        If KeyDownCounter = 1
          RemoveWindowTimer(#WINDOW, #DROP_TIMER)
          AddWindowTimer(#WINDOW, #DROP_TIMER, 100)
        EndIf   
      EndIf
    EndIf
    
    If KeyboardReleased(#PB_Key_Down) 
      If Not Paused And Not StopGame And Not FirstTime
        KeyDownCounter = 0
        RemoveWindowTimer(#WINDOW, #DROP_TIMER)
        AddWindowTimer(#WINDOW, #DROP_TIMER, FallingSpeed)              
        MoveShapeDown = #True
      EndIf             
    EndIf
    
    If Not Paused And Not StopGame And Not FirstTime
      If MoveShapeDown                        
        MoveShapeDown = #False

        If MoveDownAllowed(Shape, Rotation, CellY, CellX, EmptyColsLft, EmptyColsRght, EmptyRowsTp, EmptyRowsBttm)
          CellY + 1
        Else
          StoreShapeInBoard(Shape, Rotation, CellY, CellX)              
          DropNewPiece = #True       
        EndIf
      EndIf     
                                   
      If RemoveFullRow() 
        Score + (10 * Level)
        ClearedLines + 1
        
        If ClearedLines = 10 * Level
          Level + 1
          ClearedLines = 0
          FallingSpeed + 100 
        EndIf
      EndIf
  
      If DropNewPiece 
        DropNewPiece = #False           
        Shape = NextShape
        NextShape = Random(#PIECES, 0)
        Rotation = 0         
        CellY = 0 - EmptyRowsTop(Shape, Rotation)
        CellX = (#BOARD_CELLS_X / 2) - (ShapeCellsX(Shape, Rotation) / 2)   
        EmptyColsLft = EmptyColsLeft(Shape, Rotation)
        EmptyColsRght = EmptyColsRight(Shape, Rotation)
        EmptyRowsTp = EmptyRowsTop(Shape, Rotation)
        EmptyRowsBttm = EmptyRowsBottom(Shape, Rotation)      
      EndIf    
    EndIf    
    
    ClearScreen(RGB(0, 0, 0))    
           
    If StartDrawing(ScreenOutput())      
      DrawBoard(Score, Level, NextShape, FirstTime, StopGame)
      
      If Not FirstTime 
        DrawShape(Shape, Rotation, CellY, CellX)           
      EndIf
      
      StopDrawing()  
      FlipBuffers()       
    EndIf      
      
    StopGame = GameOver()
    
    Delay(10) 
  ForEver
EndProcedure
 
infratec wrote:Still not right.

You have first handle (or not) all events from the window before you do anything with the screen stuff.

The event loop in my example was clear (or not).
At the moment you still read only one event per outer loop.

Look also at the help example of OpenWindowedScreen()
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: My first game

Post by infratec »

That's right now.

These events are only the windows events and not something from the screen stuff.
They have nothing todo with the keyboard stuff, which you are query (so no events).
FrankAllan
New User
New User
Posts: 2
Joined: Thu Oct 17, 2019 12:52 pm

Re: My first game

Post by FrankAllan »

Good try, I hope you will succeed. I am also a game developer, but still trying to make something good to publish in public.
Post Reply