Code: Select all
;SIMPLE TETRIS CLONE BY MARTIN VERLAAN
EnableExplicit
#WINDOW = 0
#SCREEN_WIDTH = 640
#SCREEN_HEIGHT = 480
#BLOCKSIZE = 24
#BOARD_CELLS_X = 10
#BOARD_CELLS_Y = 16
#GRID_WIDTH = (#BOARD_CELLS_X * #BLOCKSIZE) + #BLOCKSIZE
#GRID_HEIGHT = (#BOARD_CELLS_Y * #BLOCKSIZE) + #BLOCKSIZE
#PIECES = 6
#DROP_TIMER = 0
Global Dim Shapes.b(#PIECES, 3, 3, 3)
Global Dim ShapeColors.i(#PIECES)
Global Dim Board.i(#BOARD_CELLS_Y - 1, #BOARD_CELLS_X - 1)
Procedure DefineShapes()
Protected.i Shape, Rotation, Row, Col
Protected.b Num
For Shape = 0 To #PIECES
For Rotation = 0 To 3
For Row = 0 To 3
For Col = 0 To 3
Read.b Num
Shapes(Shape, Rotation, Row, Col) = Num
Next Col
Next Row
Next Rotation
Next Shape
ShapeColors(0) = #Cyan
ShapeColors(1) = #Magenta
ShapeColors(2) = RGB(255,165,0)
ShapeColors(3) = #Blue
ShapeColors(4) = #Red
ShapeColors(5) = #Green
ShapeColors(6) = #Yellow
DataSection
Data.b 0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0
Data.b 0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0
Data.b 0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0
Data.b 0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0
Data.b 0,0,0,0,1,1,1,0,0,1,0,0,0,0,0,0
Data.b 0,1,0,0,1,1,0,0,0,1,0,0,0,0,0,0
Data.b 0,1,0,0,1,1,1,0,0,0,0,0,0,0,0,0
Data.b 0,1,0,0,0,1,1,0,0,1,0,0,0,0,0,0
Data.b 0,0,0,0,1,1,1,0,1,0,0,0,0,0,0,0
Data.b 1,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0
Data.b 0,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0
Data.b 0,1,0,0,0,1,0,0,0,1,1,0,0,0,0,0
Data.b 1,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0
Data.b 0,1,1,0,0,1,0,0,0,1,0,0,0,0,0,0
Data.b 0,0,0,0,1,1,1,0,0,0,1,0,0,0,0,0
Data.b 0,1,0,0,0,1,0,0,1,1,0,0,0,0,0,0
Data.b 0,0,0,0,1,1,0,0,0,1,1,0,0,0,0,0
Data.b 0,0,1,0,0,1,1,0,0,1,0,0,0,0,0,0
Data.b 0,0,0,0,1,1,0,0,0,1,1,0,0,0,0,0
Data.b 0,0,1,0,0,1,1,0,0,1,0,0,0,0,0,0
Data.b 0,0,0,0,0,1,1,0,1,1,0,0,0,0,0,0
Data.b 0,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0
Data.b 0,0,0,0,0,1,1,0,1,1,0,0,0,0,0,0
Data.b 0,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0
Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
Data.b 0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
EndDataSection
EndProcedure
Procedure.b RowEmpty(Shape.i, Rotation.i, Row.i)
Protected.i X, Sum
Protected.b Empty = #False
For X = 0 To 3
Sum + Shapes(Shape, Rotation, Row, X)
Next X
If Sum = 0
Empty = #True
EndIf
ProcedureReturn Empty
EndProcedure
Procedure.b ColEmpty(Shape.i, Rotation.i, Col.i)
Protected.i Y, Sum
Protected Empty = #False
For Y = 0 To 3
Sum + Shapes(Shape, Rotation, Y, Col)
Next Y
If Sum = 0
Empty = #True
EndIf
ProcedureReturn Empty
EndProcedure
Procedure.i EmptyColsLeft(Shape.i, Rotation.i)
Protected.i Col, X
For Col = 0 To 3
If ColEmpty(Shape, Rotation, Col)
X + 1
Else
Break
EndIf
Next Col
ProcedureReturn X
EndProcedure
Procedure.i EmptyColsRight(Shape.i, Rotation.i)
Protected.i Col, X
For Col = 3 To 0 Step -1
If ColEmpty(Shape, Rotation, Col)
X + 1
Else
Break
EndIf
Next Col
ProcedureReturn X
EndProcedure
Procedure.i EmptyRowsTop(Shape.i, Rotation.i)
Protected.i Row, Y
For Row = 0 To 3
If RowEmpty(Shape, Rotation, Row)
Y + 1
Else
Break
EndIf
Next Row
ProcedureReturn Y
EndProcedure
Procedure.i EmptyRowsBottom(Shape.i, Rotation.i)
Protected.i Row, Y
For Row = 3 To 0 Step -1
If RowEmpty(Shape, Rotation, Row)
Y + 1
Else
Break
EndIf
Next Row
ProcedureReturn Y
EndProcedure
Procedure DrawBlock(Shape.i, Row.i, Col.i, CellY.i, CellX.i, Small.b, Color.i)
Protected.i xStart, yStart, X, Y, Size
If Small
xStart = ((#SCREEN_WIDTH - #GRID_WIDTH) / 2) + 390
yStart = (#SCREEN_HEIGHT - #GRID_HEIGHT) + 85
CellX = 0
CellY = 0
Size = 10
Else
xStart = 10 + ((#SCREEN_WIDTH - #GRID_WIDTH) / 2)
yStart = (#SCREEN_HEIGHT - #GRID_HEIGHT)
Size = #BLOCKSIZE
EndIf
X = xStart + (CellX * Size)
Y = yStart + (CellY * Size)
DrawingMode(#PB_2DDrawing_Default)
Box(X + (Col * Size), Y + (Row * Size), Size, Size, Color)
DrawingMode(#PB_2DDrawing_Outlined)
Box(X + (Col * Size), Y + (Row * Size), Size, Size, #Black)
EndProcedure
Procedure DrawShape(Shape.i, Rotation.i, CellY.i, CellX.i, Small.b = #False)
Protected.i Row, Col, Y
Protected.b EmptyRow = #True
For Row = 0 To 3
If Small
If Not EmptyRow
Y + 1
EndIf
Else
Y = Row
EndIf
EmptyRow = #True
For Col = 0 To 3
If Shapes(Shape, Rotation, Row, Col)
DrawBlock(Shape, Y, Col, CellY, CellX, Small, ShapeColors(Shape))
EmptyRow = #False
EndIf
Next Col
Next Row
EndProcedure
Procedure.b GameOver()
Protected.i Col
Protected.b StopGame = #False
For Col = 0 To #BOARD_CELLS_X - 1
If Board(0, Col) <> -1
StopGame = #True
EndIf
Next Col
ProcedureReturn StopGame
EndProcedure
Procedure DrawBoard(Score.i, Level.i, NextShape.i, FirstTime.b)
Protected.i X = (#SCREEN_WIDTH - #GRID_WIDTH) / 2
Protected.i Y = (#SCREEN_HEIGHT - #GRID_HEIGHT) - 10
Protected.i LineSize = 10
Protected.i LeftTextPos = X - 170
Protected.i Row, Col
DrawingMode(#PB_2DDrawing_Default)
Box(X, Y, #GRID_WIDTH - 4, #GRID_HEIGHT, RGB(105, 105, 105))
Box(LineSize + X, LineSize + Y, (#GRID_WIDTH - 4) - (LineSize * 2), (#GRID_HEIGHT - 4) - (LineSize * 2), #Black)
DrawText(X + 60, Y - 40, "TETRIS CLONE", #White, #Black)
DrawText(LeftTextPos, Y + 25, "CONTROL KEYS", #White, #Black)
DrawText(LeftTextPos, Y + 50, "New game: SPACE", #White, #Black)
DrawText(LeftTextPos, Y + 75, "Move left: " + Chr($25C1), #White, #Black)
DrawText(LeftTextPos, Y + 100, "Move right: " + Chr($25B7), #White, #Black)
DrawText(LeftTextPos, Y + 125, "Drop fast: " + Chr($25BD), #White, #Black)
DrawText(LeftTextPos, Y + 150, "Rotate: " + Chr($25B3), #White, #Black)
DrawText(LeftTextPos, Y + 175, "Pause / Resume: P", #White, #Black)
DrawText(LeftTextPos, Y + 200, "Exit: ESC", #White, #Black)
DrawText(X + 290, Y + 25, "Score: " + Str(Score), #White, #Black)
DrawText(X + 290, Y + 60, "Level: " + Str(Level), #White, #Black)
DrawText(X + 290, Y + 95, "Next piece: ", #White, #Black)
If Not FirstTime
DrawShape(NextShape, 0, 0, 0, #True)
EndIf
If GameOver()
For Row = 0 To 6
DrawText(X + 290, Y + 155 + (Row * 35), "GAME OVER", ShapeColors(Row), #Black)
Next row
EndIf
For Row = 0 To #BOARD_CELLS_Y - 1
For Col = 0 To #BOARD_CELLS_X - 1
If Board(Row, Col) <> -1
DrawBlock(Board(Row, Col), Row, Col, 0, 0, #False, ShapeColors(Board(Row, Col)))
Else
DrawBlock(Board(Row, Col), Row, Col, 0, 0, #False, #Gray)
EndIf
Next Col
Next Row
EndProcedure
Procedure.i ShapeCellsX(Shape.i, Rotation.i)
Protected.i Row, Col
Dim Sum.i(3)
For Row = 0 To 3
For Col = 0 To 3
Sum(Row) + Shapes(Shape, Rotation, Row, Col)
Next Col
Next Row
SortArray(Sum(), #PB_Sort_Descending)
ProcedureReturn Sum(0)
EndProcedure
Procedure StoreShapeInBoard(Shape.i, Rotation.i, CellY.i, CellX.i)
Protected.i Row, Col
For Row = 0 To 3
For Col = 0 To 3
If Shapes(Shape, Rotation, Row, Col)
Board(CellY + Row, CellX + Col) = Shape
EndIf
Next Col
Next Row
EndProcedure
Procedure.b MoveDownAllowed(Shape.i, Rotation.i, CellY.i, CellX.i)
Protected.i Col, Row
Protected MoveDown = #True
If CellY < #BOARD_CELLS_Y - (4 - EmptyRowsBottom(Shape, Rotation))
For Row = EmptyRowsTop(Shape, Rotation) To 3 - EmptyRowsBottom(Shape, Rotation)
For Col = EmptyColsLeft(Shape, Rotation) To 3 - EmptyColsRight(Shape, Rotation)
If Shapes(Shape, Rotation, Row, Col) And Board(Row + CellY + 1, Col + CellX) <> -1
MoveDown = #False
Break 2
EndIf
Next Col
Next Row
Else
MoveDown = #False
EndIf
ProcedureReturn MoveDown
EndProcedure
Procedure.b RemoveFullRow()
Protected.i Row, Col, Y, X
Protected.b FullRow
For Row = 0 To #BOARD_CELLS_Y - 1
FullRow = #True
For Col = 0 To #BOARD_CELLS_X - 1
If Board(Row, Col) = -1
FullRow = #False
Break
EndIf
Next Col
If FullRow
For Y = Row To 1 Step -1
For X = 0 To #BOARD_CELLS_X - 1
board(Y, X) = board(Y - 1, X)
Next X
Next Y
Break
EndIf
Next Row
ProcedureReturn FullRow
EndProcedure
Procedure.b MoveLeftAllowed(Shape.i, Rotation.i, CellY.i, CellX.i)
Protected.i Col, Row
Protected MoveLeft = #False
If CellX + EmptyColsLeft(Shape, Rotation) > 0
MoveLeft = #True
For Row = EmptyRowsTop(Shape, Rotation) To 3 - EmptyRowsBottom(Shape, Rotation)
For Col = EmptyColsLeft(Shape, Rotation) To 3 - EmptyColsRight(Shape, Rotation)
If Shapes(Shape, Rotation, Row, Col) And Board(CellY + Row, CellX + Col - 1) <> -1
MoveLeft = #False
Break 2
EndIf
Next Col
Next Row
EndIf
ProcedureReturn MoveLeft
EndProcedure
Procedure.b MoveRightAllowed(Shape.i, Rotation.i, CellY.i, CellX.i)
Protected.i Col, Row
Protected MoveRight = #False
If CellX < #BOARD_CELLS_X - (4 - EmptyColsRight(Shape, Rotation))
MoveRight = #True
For Row = EmptyRowsTop(Shape, Rotation) To 3 - EmptyRowsBottom(Shape, Rotation)
For Col = EmptyColsLeft(Shape, Rotation) To 3 - EmptyColsRight(Shape, Rotation)
If Shapes(Shape, Rotation, Row, Col) And Board(CellY + Row, CellX + Col + 1) <> -1
MoveRight = #False
Break 2
EndIf
Next Col
Next Row
EndIf
ProcedureReturn MoveRight
EndProcedure
Procedure MakeBoardEmpty()
Protected.i Row, Col
For Row = 0 To #BOARD_CELLS_Y - 1
For Col = 0 To #BOARD_CELLS_X - 1
Board(Row, Col) = -1
Next Col
Next Row
EndProcedure
Procedure Main()
Protected.i Event, Rotation, Row, Col, KeyDownCounter, CellY, CellX, Score, Shape, ClearedLines
Protected.i FallingSpeed = 1000
Protected.i NextShape = Random(#PIECES, 0)
Protected.i Level = 1
Protected.b Paused = #False
Protected.b MoveShapeDown = #False
Protected.b DropNewPiece = #True
Protected.b FirstTime = #True
If Not OpenWindow(#WINDOW, 216, 0, #SCREEN_WIDTH, #SCREEN_HEIGHT, "Tetris clone")
MessageRequester("Error", "Window cannot be opened")
End
EndIf
If Not InitSprite()
MessageRequester("Error", "Cannot initialize sprite environment")
End
EndIf
If Not OpenWindowedScreen(WindowID(#WINDOW), 0, 0, #SCREEN_WIDTH, #SCREEN_HEIGHT)
MessageRequester("Error", "Screen area cannot be opened")
End
EndIf
InitKeyboard()
MakeBoardEmpty()
DefineShapes()
AddWindowTimer(#WINDOW, #DROP_TIMER, FallingSpeed)
Repeat
Event = WaitWindowEvent()
ClearScreen(RGB(0, 0, 0))
If DropNewPiece
DropNewPiece = #False
Shape = NextShape
NextShape = Random(#PIECES, 0)
Rotation = 0
CellY = 0 - EmptyRowsTop(Shape, Rotation)
CellX = (#BOARD_CELLS_X / 2) - (ShapeCellsX(Shape, Rotation) / 2)
EndIf
If StartDrawing(ScreenOutput())
ExamineKeyboard()
If KeyboardReleased(#PB_Key_Space)
MakeBoardEmpty()
FirstTime = #False
DropNewPiece = #True
FallingSpeed = 1000
Level = 1
Score = 0
ClearedLines = 0
ElseIf KeyboardReleased(#PB_Key_P)
If Paused
Paused = #False
Else
Paused = #True
EndIf
EndIf
If Not Paused And Not GameOver() And Not FirstTime
If Event = #PB_Event_Timer And EventTimer() = #DROP_TIMER
MoveShapeDown = #True
EndIf
If KeyboardReleased(#PB_Key_Left)
If MoveLeftAllowed(Shape, Rotation, CellY, CellX)
CellX - 1
EndIf
ElseIf KeyboardReleased(#PB_Key_Right)
If MoveRightAllowed(Shape, Rotation, CellY, CellX)
CellX + 1
EndIf
ElseIf KeyboardReleased(#PB_Key_Up)
Rotation + 1
If Rotation > 3
Rotation = 0
EndIf
If CellX + EmptyColsLeft(Shape, Rotation) < 0
CellX = 0
EndIf
If CellX > #BOARD_CELLS_X - (4 - EmptyColsRight(Shape, Rotation))
CellX = #BOARD_CELLS_X - (4 - EmptyColsRight(Shape, Rotation))
EndIf
If CellY - EmptyRowsTop(Shape, Rotation) < 0
CellY = 0
EndIf
ElseIf KeyboardPushed(#PB_Key_Down)
KeyDownCounter + 1
If KeyDownCounter = 1
RemoveWindowTimer(#WINDOW, #DROP_TIMER)
AddWindowTimer(#WINDOW, #DROP_TIMER, 100)
EndIf
EndIf
If KeyboardReleased(#PB_Key_Down)
KeyDownCounter = 0
RemoveWindowTimer(#WINDOW, #DROP_TIMER)
AddWindowTimer(#WINDOW, #DROP_TIMER, FallingSpeed)
MoveShapeDown = #True
EndIf
If MoveShapeDown
MoveShapeDown = #False
If MoveDownAllowed(Shape, Rotation, CellY, CellX)
CellY + 1
Else
StoreShapeInBoard(Shape, Rotation, CellY, CellX)
DropNewPiece = #True
EndIf
EndIf
EndIf
If RemoveFullRow()
Score + 10 * Level
ClearedLines + 1
If ClearedLines = 10 * Level
Level + 1
ClearedLines = 0
FallingSpeed + 100
EndIf
EndIf
DrawBoard(Score, Level, NextShape, FirstTime)
If Not FirstTime
DrawShape(Shape, Rotation, CellY, CellX)
EndIf
StopDrawing()
FlipBuffers()
EndIf
Until KeyboardPushed(#PB_Key_Escape) Or Event = #PB_Event_CloseWindow
EndProcedure
Main()