Code: Select all
'* Initial date = 2018-01-12
'* Fbc = 1.04.0, 32-bit, linux-x86
'* Indent = tab
'This variation of tetris is a programming excercise, if you like playing teris,
'consider buying as officially licenced teris game from the original creator:
'Алексе́й Леони́дович Па́житнов: https://en.wikipedia.org/wiki/Alexey_Pajitnov
'Note: I made this program as one file to make it easier to post on the forum.
' The code can be easily converted to seperate .bas and .bi files, the
' comments show where to split the files. Declarations and constants to
' .bi files, the rest in the .bas files.
'Controls: Up, Down, Left, Rigt, Space, Escape
'Score: Number of lines cleared ^ 2 (1, 4, 9, 16)
const as integer SCREEN_W = 600
const as integer SCREEN_H = SCREEN_W
const as integer GRID_YDIM = 20
const as integer GRID_XDIM = 10
const as integer GRID_SIZE = SCREEN_H \ GRID_YDIM 'size of squares
const as integer GRID_XOFFS = (SCREEN_W - GRID_XDIM * GRID_SIZE) \ 2 'offset on screen
const as integer GRID_YOFFS = (SCREEN_H - GRID_YDIM * GRID_SIZE) \ 2 'offset on screen
'******************************* common.bas ************************************
const as ulong C_BLACK = &h00000000
const as ulong C_DARK_GRAY = &h00404040
const as ulong C_GRAY = &h00808080
const as ulong C_LIGHT_GRAY = &h00C0C0C0
const as ulong C_WHITE = &h00F0F0F0
function inRange(value as integer, min as integer, max as integer) as integer
if value >= min and value <= max then
return true
else
return false
end if
end function
type xy_int
dim as integer x, y
end type
const as ushort KEY_UP = &h48FF
const as ushort KEY_RI = &h4DFF
const as ushort KEY_DN = &h50FF
const as ushort KEY_LE = &h4BFF
const as ushort KEY_W = &h57
const as ushort KEY_A = &h41
const as ushort KEY_S = &h53
const as ushort KEY_D = &h44
const as ushort KEY_ENTER = &h0D
const as ushort KEY_ESC = &h1B
const as ushort KEY_TAB = &h09
const as ushort KEY_BACK = &h08
const as ushort KEY_SPACE = &h20
function waitKeyCode() as ushort
dim as string key = inkey()
while (key = "")
key = inkey()
sleep 1,1
wend
if (*cast(ubyte ptr, strptr(key)) = 255) then
return *cast(ushort ptr, strptr(key))
else
return *cast(ubyte ptr, strptr(key))
end if
end function
function pollKeyCode() as ushort
dim as string key = inkey()
if (key = "") then return 0
if (*cast(ubyte ptr, strptr(key)) = 255) then
return *cast(ushort ptr, strptr(key))
else
return *cast(ubyte ptr, strptr(key))
end if
end function
'******************************* timers.bas ************************************
type timer_type
private:
dim as double tEnd
dim as double tStart
dim as double tSpan
dim as integer active
public:
declare sub start(duration as double)
declare function ended() as integer
declare sub restart()
end type
sub timer_type.start(duration as double)
tStart = timer()
tSpan = duration
tEnd = tStart + tSpan
active = 1
end sub
function timer_type.ended() as integer
if active = 0 then return false
if timer() >= tEnd then
active = 0
return true
else
return false
end if
end function
'continue timer, add same delay ot original tStart
sub timer_type.restart()
tStart = tEnd
tEnd = tStart + tSpan
active = 1
end sub
'******************************* pieces.bas ************************************
const as integer NUM_PIECES = 7
const as integer NUM_ORIENT = 4
const as integer NUM_SQUARES = 4
const as integer PIECE_O = 0
const as integer PIECE_I = 1
const as integer PIECE_S = 2
const as integer PIECE_Z = 3
const as integer PIECE_L = 4
const as integer PIECE_J = 5
const as integer PIECE_T = 6
type pieces_type
'See: http://colinfahey.com/tetris/tetris.html (with y inverted)
private:
dim as integer piece_orientations(NUM_PIECES-1) = {1, 2, 2, 2, 4, 4, 4}
public:
dim as xy_int base_piece(NUM_PIECES-1, NUM_SQUARES-1) = _
{_
{(-1, 0), ( 0, 0), (-1, +1), ( 0, +1)}, _ 'O
{(-2, 0), (-1, 0), ( 0, 0), (+1, 0)}, _ 'I
{( 0, 0), (+1, 0), (-1, +1), ( 0, +1)}, _ 'S
{(-1, 0), ( 0, 0), ( 0, +1), (+1, +1)}, _ 'Z
{(-1, 0), ( 0, 0), (+1, 0), (-1, +1)}, _ 'L
{(-1, 0), ( 0, 0), (+1, 0), (+1, +1)}, _ 'J
{(-1, 0), ( 0, 0), (+1, 0), ( 0, +1)} _ 'T
}
dim as xy_int piece(NUM_PIECES-1, NUM_ORIENT-1, NUM_SQUARES-1)
'functions/subs
declare function rotatedSquare(orientation as integer, p as xy_int) as xy_int
declare sub init()
end type
'get grid position of 1 square for a specified rotation
function pieces_type.rotatedSquare(orientation as integer, p as xy_int) as xy_int
select case orientation
case 0: return type<xy_int>(+p.x, +p.y)
case 1: return type<xy_int>(-p.y, +p.x)
case 2: return type<xy_int>(-p.x, -p.y)
case 3: return type<xy_int>(+p.y, -p.x)
end select
end function
'Fill pieces array for all possibly orientations use base_pieces data
'Can be converted to constructor
sub pieces_type.init()
dim as integer iOrient, iPiece, iSquare, iOrientMod
for iPiece = 0 to NUM_PIECES-1
for iOrient = 0 to NUM_ORIENT-1
for iSquare = 0 to NUM_SQUARES-1
iOrientMod = iOrient mod piece_orientations(iPiece)
piece(iPiece, iOrient, iSquare) = _
rotatedSquare(iOrientMod, base_piece(iPiece, iSquare))
next
next
next
end sub
'******************************* piece.bas ************************************
type piece_type
public:
dim as xy_int p 'grid postion index
dim as integer id, rot
declare sub init(gridPos as xy_int, iPiece as integer, iOrient as integer)
end type
sub piece_type.init(gridPos as xy_int, iPiece as integer, iOrient as integer)
p.x = gridPos.x
p.y = gridPos.y
if iPiece = -1 then id = int(rnd * NUM_PIECES) else id = iPiece end if
if iOrient = -1 then rot = int(rnd * NUM_ORIENT) else rot = iOrient
end sub
'******************************* board.bas *************************************
const as integer BLOCK_INVALID = -1
const as integer BLOCK_FREE = 0
const as integer BLOCK_FIXED = 1
const as integer BLOCK_PIECE = 2
type board_type
private:
dim as integer grid(GRID_XDIM-1, GRID_YDIM-1)
public:
declare sub init()
declare function onBoard(xi as integer, yi as integer) as integer
declare sub set(xi as integer, yi as integer, blockType as integer)
declare function get_(xi as integer, yi as integer) as integer
declare function checkHorzLine(yiCheck as integer) as integer
declare sub moveHorzLine(yiSource as integer, yiTarget as integer)
'~ declare function checkVertLine(xiCheck as integer) as integer
'~ declare sub moveVertLine(xiSource as integer, xiTarget as integer)
end type
'make playfield, cross shape
'Can be converted to constructor
sub board_type.init()
'~ dim as integer xi, yi
'~ dim as integer margin1, margin2
'~ for xi = 0 to GRID_DIM-1
'~ for yi = 0 to GRID_DIM-1
'~ margin1 = GRID_HALF - 5
'~ margin2 = (GRID_DIM - 1) - (GRID_HALF - 5)
'~ if inRange(xi, margin1, margin2) or inRange(yi, margin1, margin2) then
'~ set(xi, yi, BLOCK_FREE)
'~ else
'~ set(xi, yi, BLOCK_FIXED)
'~ end if
'~ if inRange(xi, GRID_HALF-1, GRID_HALF) then
'~ if inRange(yi, GRID_HALF-1, GRID_HALF) then
'~ set(xi, yi, BLOCK_FIXED)
'~ end if
'~ end if
'~ next
'~ next
end sub
function board_type.onBoard(xi as integer, yi as integer) as integer
if not inRange(xi, 0, GRID_XDIM-1) then return false
if not inRange(yi, 0, GRID_YDIM-1) then return false
return true
end function
sub board_type.set(xi as integer, yi as integer, blockType as integer)
if onBoard(xi, yi) then grid(xi, yi) = blockType
end sub
function board_type.get_(xi as integer, yi as integer) as integer
if not onBoard(xi, yi) then
return BLOCK_INVALID
else
return grid(xi, yi)
end if
end function
function board_type.checkHorzLine(yiCheck as integer) as integer
dim as integer xi
for xi = 0 to GRID_XDIM-1
if get_(xi, yiCheck) = BLOCK_FREE then return false
next
return true 'complete line
end function
sub board_type.moveHorzLine(yiSource as integer, yiTarget as integer)
dim as integer xi
for xi = 0 to GRID_XDIM-1
set(xi, yiTarget, get_(xi, yiSource))
next
end sub
'~ function board_type.checkVertLine(xiCheck as integer) as integer
'~ dim as integer yi
'~ for yi = GRID_HALF-5 to GRID_HALF+4
'~ if get_(xiCheck, yi) = BLOCK_FREE then return false
'~ next
'~ return true 'complete line
'~ end function
'~ sub board_type.moveVertLine(xiSource as integer, xiTarget as integer)
'~ dim as integer yi
'~ for yi = GRID_HALF-5 to GRID_HALF+4
'~ set(xiTarget, yi, get_(xiSource, yi))
'~ next
'~ end sub
'******************************* game.bas **************************************
type game_type
private:
dim as pieces_type pieces
dim as board_type board
public:
declare sub init()
declare function piecePossible(piece as piece_type) as integer
declare sub showAllPieces()
declare sub drawBoard()
declare sub moveToBoard(piece as piece_type)
declare sub clearScreen()
declare sub drawPiece(piece as piece_type)
declare sub drawSquare(gridPos as xy_int, blockType as integer)
declare function removeLines() as integer
end type
sub game_type.init()
pieces.init()
board.init()
end sub
'check if piece is possible on board
function game_type.piecePossible(piece as piece_type) as integer
dim as integer xi, yi, iSquare
for iSquare = 0 to NUM_SQUARES-1
with piece
xi = .p.x + pieces.piece(.id, .rot, iSquare).x
yi = .p.y + pieces.piece(.id, .rot, iSquare).y
end with
if board.onBoard(xi, yi) = false then return false
if board.get_(xi, yi) <> BLOCK_FREE then return false
next
return true
end function
'draw all tretris pieces (for debugging only)
sub game_type.showAllPieces()
dim as integer iPiece, iOrient
dim as piece_type piece
for iPiece = 0 to NUM_PIECES-1
for iOrient = 0 to NUM_ORIENT-1
piece.init(type<xy_int>(5 + iPiece * 5, 5 + iOrient * 5), iPiece, iOrient)
piece.id = iPiece
piece.rot = iOrient
drawPiece(piece)
next
next
end sub
'plot field
sub game_type.drawBoard
dim as integer xi, yi
'line(0, 0)-(99, SCREEN_H-1), C_GRAY, bf
'line(SCREEN_W-1, 0)-(SCREEN_W-100, SCREEN_H-1), C_GRAY, bf
for xi = 0 to GRID_XDIM-1
for yi = 0 to GRID_YDIM-1
drawSquare(type<xy_int>(xi, yi), board.get_(xi, yi))
next
next
end sub
'copy piece to board
sub game_type.moveToBoard(piece as piece_type)
dim as integer xi, yi, iSquare
for iSquare = 0 to NUM_SQUARES-1
with piece
xi = .p.x + pieces.piece(.id, .rot, iSquare).x
yi = .p.y + pieces.piece(.id, .rot, iSquare).y
end with
board.set(xi, yi, BLOCK_PIECE)
next
end sub
sub game_type.clearScreen()
line(0, 0) - (SCREEN_W-1, SCREEN_H-1), C_BLACK, bf
end sub
'draw teris 1 piece
sub game_type.drawPiece(piece as piece_type)
dim as integer xi, yi, iSquare
for iSquare = 0 to NUM_SQUARES-1
with piece
xi = .p.x + pieces.piece(.id, .rot, iSquare).x
yi = .p.y + pieces.piece(.id, .rot, iSquare).y
end with
drawSquare(type<xy_int>(xi, yi), BLOCK_PIECE)
next
end sub
sub game_type.drawSquare(gridPos as xy_int, blockType as integer)
'ugly
dim as integer border, fill
if inRange(gridPos.x, 0, GRID_XDIM-1) and inRange(gridPos.y, 0, GRID_YDIM-1) then
select case blockType
case BLOCK_FREE
line(GRID_XOFFS + gridPos.x * GRID_SIZE, GRID_YOFFS + gridPos.y * GRID_SIZE)-_
step(GRID_SIZE-1, GRID_SIZE-1), C_DARK_GRAY, b
case BLOCK_FIXED
line(GRID_XOFFS + gridPos.x * GRID_SIZE, GRID_YOFFS + gridPos.y * GRID_SIZE)-_
step(GRID_SIZE-1, GRID_SIZE-1), C_DARK_GRAY, b
line(GRID_XOFFS + gridPos.x * GRID_SIZE + 1, GRID_YOFFS + gridPos.y * GRID_SIZE + 1)-_
step(GRID_SIZE-3, GRID_SIZE-3), C_GRAY, bf
case BLOCK_PIECE
line(GRID_XOFFS + gridPos.x * GRID_SIZE + 1, GRID_YOFFS + gridPos.y * GRID_SIZE + 1)-_
step(GRID_SIZE-3, GRID_SIZE-3), C_WHITE, bf
case else
'not good, unknown block type
end select
else
'not good, outside grid
end if
end sub
'check and move lines, return number of lines removed
function game_type.removeLines() as integer
dim as integer xi, yi1, yi2
dim as integer numLines = 0
for yi1 = GRID_YDIM-1 to 0 step -1
'check complete horizontal line
if board.checkHorzLine(yi1) then
for yi2 = yi1 to 1 step -1
board.moveHorzLine(yi2 - 1, yi2) 'source, target
next
numLines += 1
yi1 += 1 'recheck this line
end if
next
return numLines
end function
'******************************* main.bas **************************************
dim as game_type game
dim as timer_type gravTmr
dim as piece_type activePiece, movedPiece
dim as integer quit = 0
dim as ushort keyCode
dim as integer dropActive
dim as integer requestNewPiece = true
dim as integer score
screenres SCREEN_W, SCREEN_H, 32
randomize(timer())
game.init()
'game.showAllPieces()
'sleep 1000,1
game.drawBoard()
do
if requestNewPiece then
requestNewPiece = false
activePiece.init(type<xy_int>(GRID_XDIM\2, 0), -1, 0)
if not game.piecePossible(activePiece) then quit = 1
gravTmr.start(0.50)
end if
movedPiece = activePiece 'copy piece for location / orientation
keyCode = pollKeyCode()
if not dropActive then
select case keyCode
case KEY_LE
'if new position posible:
movedPiece.p.x -= 1
case KEY_RI
'if new position posible:
movedPiece.p.x += 1
case KEY_UP
'if new position posible:
movedPiece.rot = (movedPiece.rot + 1) mod NUM_ORIENT
case KEY_DN
'if new position posible:
movedPiece.rot = (movedPiece.rot + 3) mod NUM_ORIENT
case KEY_SPACE
'disable user piece control, drop faster
dropActive = true
gravTmr.start(0.02)
case KEY_ESC
quit = 1
case else
'...
end select
end if
'check move possible
if game.piecePossible(movedPiece) then
activePiece = movedPiece 'update position
else
movedPiece = activePiece 'reset move piece, for next step
end if
'piece drop by timer
if gravTmr.ended() then
movedPiece.p.y += 1
'check drop possible
if game.piecePossible(movedPiece) then
gravTmr.restart()
activePiece = movedPiece
else
'piece has been dropped onto something
game.moveToBoard(activePiece)
score += game.removeLines() ^ 2
requestNewPiece = true
dropActive = false
end if
end if
screenlock
game.clearScreen()
game.drawBoard()
game.drawPiece(activePiece)
locate 2, 2
print "Score:"; score
screenunlock
sleep 1,1
loop until quit = 1
locate 4, 2
print "Game ended, press any key."
waitKeyCode()