It is currently Wed Jun 03, 2020 10:53 pm

View unanswered posts | View active topics


Board index » Showcase » Applications - Feedback and Discussion

All times are UTC + 1 hour




Post new topic Reply to topic  Page 1 of 1
  [ 14 posts ] 
  Print view Previous topic | Next topic 
Author Message
Martin Verlaan
 Post subject: My first game
PostPosted: Tue Oct 08, 2019 11:08 am 
Offline
Enthusiast
Enthusiast

Joined: Sun Apr 01, 2018 11:26 am
Posts: 106
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:
;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()
Top
 Profile  
Reply with quote  
STARGÅTE
 Post subject: Re: My first game
PostPosted: Tue Oct 08, 2019 12:53 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jan 10, 2008 1:30 pm
Posts: 1273
Location: Germany, Glienicke
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.

_________________
ImageImage

Top
 Profile  
Reply with quote  
RSBasic
 Post subject: Re: My first game
PostPosted: Tue Oct 08, 2019 12:58 pm 
Offline
Moderator
Moderator
User avatar

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 1112
Location: Gernsbach (Germany)
Your first game is great. Works fine. :)

_________________
ImageImageImageImage Image

Top
 Profile  
Reply with quote  
zxretrosoft
 Post subject: Re: My first game
PostPosted: Tue Oct 08, 2019 1:00 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed May 15, 2013 8:26 am
Posts: 165
Location: Czech Republic, Prague
Perfect work! Very nice! 8)

_________________
I apologize in advance for bad English

Top
 Profile  
Reply with quote  
Mijikai
 Post subject: Re: My first game
PostPosted: Tue Oct 08, 2019 1:25 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Sep 11, 2016 2:17 pm
Posts: 649
Looks good :)
#PB_Screen_WaitSynchronization was already mentioned just make sure to account for different V-Sync intervals.
Top
 Profile  
Reply with quote  
infratec
 Post subject: Re: My first game
PostPosted: Tue Oct 08, 2019 3:18 pm 
Offline
Addict
Addict

Joined: Sun Sep 07, 2008 12:45 pm
Posts: 4726
Location: Germany
You should follow the example for OpenWindowedScreen():

Code:
...
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() :!:
Top
 Profile  
Reply with quote  
Martin Verlaan
 Post subject: Re: My first game
PostPosted: Tue Oct 08, 2019 3:54 pm 
Offline
Enthusiast
Enthusiast

Joined: Sun Apr 01, 2018 11:26 am
Posts: 106
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:
;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()
Top
 Profile  
Reply with quote  
infratec
 Post subject: Re: My first game
PostPosted: Tue Oct 08, 2019 4:17 pm 
Offline
Addict
Addict

Joined: Sun Sep 07, 2008 12:45 pm
Posts: 4726
Location: Germany
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:
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.
Top
 Profile  
Reply with quote  
davido
 Post subject: Re: My first game
PostPosted: Tue Oct 08, 2019 7:00 pm 
Offline
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1760
Location: Uttoxeter, UK
@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

Top
 Profile  
Reply with quote  
Martin Verlaan
 Post subject: Re: My first game
PostPosted: Tue Oct 08, 2019 11:23 pm 
Offline
Enthusiast
Enthusiast

Joined: Sun Apr 01, 2018 11:26 am
Posts: 106
@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:
;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()
Top
 Profile  
Reply with quote  
infratec
 Post subject: Re: My first game
PostPosted: Wed Oct 09, 2019 6:54 am 
Offline
Addict
Addict

Joined: Sun Sep 07, 2008 12:45 pm
Posts: 4726
Location: Germany
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()
Top
 Profile  
Reply with quote  
Martin Verlaan
 Post subject: Re: My first game
PostPosted: Wed Oct 09, 2019 8:15 am 
Offline
Enthusiast
Enthusiast

Joined: Sun Apr 01, 2018 11:26 am
Posts: 106
: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:
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()
Top
 Profile  
Reply with quote  
infratec
 Post subject: Re: My first game
PostPosted: Wed Oct 09, 2019 8:57 am 
Offline
Addict
Addict

Joined: Sun Sep 07, 2008 12:45 pm
Posts: 4726
Location: Germany
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).
Top
 Profile  
Reply with quote  
FrankAllan
 Post subject: Re: My first game
PostPosted: Thu Oct 17, 2019 1:19 pm 
Offline
New User
New User

Joined: Thu Oct 17, 2019 12:52 pm
Posts: 2
Good try, I hope you will succeed. I am also a game developer, but still trying to make something good to publish in public.
Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  Page 1 of 1
  [ 14 posts ] 

Board index » Showcase » Applications - Feedback and Discussion

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 5 guests

You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye