# PureBasic Forum

 It is currently Thu Oct 01, 2020 7:16 pm

 All times are UTC + 1 hour

 Page 1 of 1 [ 14 posts ]
 Print view Previous topic | Next topic
Author Message
 Post subject: My first gamePosted: Tue Oct 08, 2019 11:08 am
 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.

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
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()

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)
EndIf
EndIf

If KeyboardReleased(#PB_Key_Down)
KeyDownCounter = 0
RemoveWindowTimer(#WINDOW, #DROP_TIMER)
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

 Post subject: Re: My first gamePosted: Tue Oct 08, 2019 12:53 pm

Joined: Thu Jan 10, 2008 1:30 pm
Posts: 1296
Location: Germany, Glienicke
I think every game programmer started with Tetris, so congratulations on your first game.

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.

_________________

Top

 Post subject: Re: My first gamePosted: Tue Oct 08, 2019 12:58 pm
 Moderator

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

_________________

Top

 Post subject: Re: My first gamePosted: Tue Oct 08, 2019 1:00 pm
 Enthusiast

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

_________________
I apologize in advance for bad English

Top

 Post subject: Re: My first gamePosted: Tue Oct 08, 2019 1:25 pm
 Enthusiast

Joined: Sun Sep 11, 2016 2:17 pm
Posts: 727
Looks good
#PB_Screen_WaitSynchronization was already mentioned just make sure to account for different V-Sync intervals.

Top

 Post subject: Re: My first gamePosted: Tue Oct 08, 2019 3:18 pm

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

Code:
...
Repeat
Event = WindowEvent()

Select Event
If EventGadget() = 0
End
EndIf

Case #PB_Event_CloseWindow
End
EndSelect
Until Event = 0

FlipBuffers()
...

Important: not WaitWindowEvent()

Top

 Post subject: Re: My first gamePosted: Tue Oct 08, 2019 3:54 pm
 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
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()

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)
EndIf
EndIf

If KeyboardReleased(#PB_Key_Down)
KeyDownCounter = 0
RemoveWindowTimer(#WINDOW, #DROP_TIMER)
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

 Post subject: Re: My first gamePosted: Tue Oct 08, 2019 4:17 pm

Joined: Sun Sep 07, 2008 12:45 pm
Posts: 4936
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:

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

 Post subject: Re: My first gamePosted: Tue Oct 08, 2019 7:00 pm

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1780
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!

_________________
DE AA EB

Top

 Post subject: Re: My first gamePosted: Tue Oct 08, 2019 11:23 pm
 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
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()

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)
EndIf
EndIf
EndIf

If KeyboardReleased(#PB_Key_Down)
If Not Paused And Not StopGame And Not FirstTime
KeyDownCounter = 0
RemoveWindowTimer(#WINDOW, #DROP_TIMER)
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

 Post subject: Re: My first gamePosted: Wed Oct 09, 2019 6:54 am

Joined: Sun Sep 07, 2008 12:45 pm
Posts: 4936
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

 Post subject: Re: My first gamePosted: Wed Oct 09, 2019 8:15 am
 Enthusiast

Joined: Sun Apr 01, 2018 11:26 am
Posts: 106
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()

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)
EndIf
EndIf
EndIf

If KeyboardReleased(#PB_Key_Down)
If Not Paused And Not StopGame And Not FirstTime
KeyDownCounter = 0
RemoveWindowTimer(#WINDOW, #DROP_TIMER)
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

 Post subject: Re: My first gamePosted: Wed Oct 09, 2019 8:57 am

Joined: Sun Sep 07, 2008 12:45 pm
Posts: 4936
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

 Post subject: Re: My first gamePosted: Thu Oct 17, 2019 1:19 pm
 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

 Display posts from previous: All posts1 day7 days2 weeks1 month3 months6 months1 year Sort by AuthorPost timeSubject AscendingDescending
 Page 1 of 1 [ 14 posts ]

 All times are UTC + 1 hour

#### Who is online

Users browsing this forum: No registered users and 17 guests

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

Search for:
 Jump to:  Select a forum ------------------ PureBasic    Coding Questions    Game Programming    3D Programming    Assembly Programming    The PureBasic Editor    The PureBasic Form Designer    General Discussion    Feature Requests and Wishlists    Tricks 'n' Tips Bug Reports    Bugs - Windows    Bugs - Linux    Bugs - Mac OSX    Bugs - IDE    Bugs - Documentation OS Specific    AmigaOS    Linux    Windows    Mac OSX Miscellaneous    Announcement    Off Topic Showcase    Applications - Feedback and Discussion    PureFORM & JaPBe    TailBite