Small update (2018-08-02): 'Mario' added, looking like a pink pizza and not interacting properly yet with the Tetris blocks.
Small update (2018-08-06): Collision with 'frozen' overhead blocks + jumping needs key re-trigger. Currently with too happy with class structure.
Status (2018-09-01): Kind of stuck on the collision detection. It fails on longer sleep times. Need to improve the collision detection or decouple the screen update and render update loops. Currently distracted by other projects...
Edit: 'final version' (still some small bugs):
https://nr100.home.xs4all.nl/badidea/fr ... -04-29.zip
Code: Select all
'* Initial date = 2018-07-14
'* Fbc = 1.05.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
'Controls:
' Up, Down, Left, Right, Space, Escape
'Score:
' Number of lines cleared ^ 2 (1, 4, 9, 16)
'Steps:
' Remove play block control
' Drop pieces at random positions and orientations: Game class, get min/mix x/y piece
' Show piece red if placement not possible
' Add smooth block movement? speed (grid/s)
' Add wait next piece timer/delay
' Add 'Mario'
' Add block jump (by static and falling pieces)
' Add 'death by tetris'
' Add action: touch/poke (trigger piece drop)
' Add action: push (move block)
' Add action: axe (destroy)
' Add actions costs
' Add player animations
' Nice font
' Add sounds
' Add menu (with highscore)
'To do:
' Change class structure
' make board & pieces member of main, give address of instances to game class
' use multikey() instead of inkey()?
' check use of integer and boolean
' 1 function for check, mark, remove lines?
' Wallkick, hidden lines
' Bonus point + message for clear field
' Next piece indicator
' Nicer collors
' Pause button + Screen change (darker)
const as integer SCREEN_W = 800
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
#include "fbgfx.bi"
'============================ inc/common.bi (begin) ============================
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
const as ulong C_RED = &h00F04040
const as ulong C_YELLOW = &h00F0F000
'clockwise like in pieces class
const as integer DIR_DN = 0
const as integer DIR_LE = 1
const as integer DIR_UP = 2
const as integer DIR_RI = 3
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
type xy_sgl
dim as single x, y
end type
sub xyPrint (x as integer, y as integer, text as string)
locate y, x: print text;
end sub
function max(v1 as integer, v2 as integer) as integer
return iif(v1 > v2, v1, v2)
end function
function min(v1 as integer, v2 as integer) as integer
return iif(v1 < v2, v1, v2)
end function
function rndBetween(vMin as integer, vMax as integer) as integer
return int(rnd * (vMax - vMin + 1)) + vMin
end function
operator + (v1 as xy_int, v2 as xy_int) as xy_int
return type(v1.x + v2.x, v1.y + v2.y)
end operator
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 = &h77
const as ushort KEY_A = &h61
const as ushort KEY_S = &h73
const as ushort KEY_D = &h64
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
return getkey() 'getkey is weird
end function
function pollKeyCode() as ushort
dim as string key = inkey()
if (key = "") then return 0
if (key[0] = 255) then
return *cast(ushort ptr, strptr(key))
'return (key[1] shl 8) or key[0]
else
return key[0]
end if
end function
'============================== inc/common.bi (end) ============================
'============================ inc/timers.bi (begin) ============================
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 inactive() as boolean
declare function ended() as boolean
declare sub restart()
end type
sub timer_type.start(duration as double)
tStart = timer()
tSpan = duration
tEnd = tStart + tSpan
active = 1
end sub
'does NOT update the timer status
function timer_type.inactive() as boolean
if active = 0 then return true
end function
function timer_type.ended() as boolean
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
'============================== inc/timers.bi (end) ============================
'============================ inc/pieces.bi (begin) ============================
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 mbb_type 'https://en.wikipedia.org/wiki/Minimum_bounding_box
dim as integer xMin, xMax, yMin, yMax
end type
type pieces_type
'See: http://colinfahey.com/tetris/tetris.html (with y inverted)
private:
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)
dim as integer piece_orientations(NUM_PIECES-1) = {1, 2, 2, 2, 4, 4, 4}
'dim as integer piece_orientations(NUM_PIECES-1) = {4, 4, 4, 4, 4, 4, 4}
dim as ulong colour(NUM_PIECES-1) = {&h00FFFF00, &h0000FFFF, _
&h0000FF00, &h00FF0000, &h00FFAA00, &h000000FF, &h009900FF}
public:
dim as mbb_type mbb(NUM_PIECES-1, NUM_SQUARES-1)
'functions/subs
declare function rotatedSquare(orientation as integer, p as xy_int) as xy_int
declare sub init()
declare function getSquarePos(iPiece as integer, iOrient as integer, _
iSquare as integer) as xy_int
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(+p.x, +p.y)
case 1: return type(-p.y, +p.x)
case 2: return type(-p.x, -p.y)
case 3: return type(+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
dim as integer xMin, xMax, yMin, yMax
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
xMin = +9999: xMax = -9999: yMin = +9999: yMax = -9999
for iSquare = 0 to NUM_SQUARES-1
xMax = max(piece(iPiece, iOrient, iSquare).x, xMax)
xMin = min(piece(iPiece, iOrient, iSquare).x, xMin)
yMax = max(piece(iPiece, iOrient, iSquare).y, yMax)
yMin = min(piece(iPiece, iOrient, iSquare).y, yMin)
next
mbb(iPiece, iOrient).xMax = xMax
mbb(iPiece, iOrient).xMin = xMin
mbb(iPiece, iOrient).yMax = yMax
mbb(iPiece, iOrient).yMin = yMin
next
next
end sub
function pieces_type.getSquarePos(iPiece as integer, iOrient as integer, _
iSquare as integer) as xy_int
return piece(iPiece, iOrient, iSquare)
end function
'============================== inc/pieces.bi (end) ============================
'============================= inc/board.bi (begin) ============================
const as integer BLOCK_INVALID = -1
const as integer BLOCK_FREE = 0
const as integer BLOCK_FIXED = 1
const as integer BLOCK_PIECE = 2
const as integer BLOCK_MARKED = 3
type board_type
private:
dim as integer grid(GRID_XDIM-1, GRID_YDIM-1)
public:
declare sub init()
declare function onBoard(p as xy_int) as integer
declare sub set(p as xy_int, blockType as integer)
declare function get_(p as xy_int) as integer
declare function checkHorzLine(yiCheck as integer) as integer
declare sub markHorzLine(yiMark as integer)
declare sub moveHorzLines(yiRemove as integer)
end type
'make playfield, cross shape
'Can be converted to constructor
sub board_type.init()
'nothing to do, all BLOCK_FREE
end sub
function board_type.onBoard(p as xy_int) as integer
if not inRange(p.x, 0, GRID_XDIM-1) then return false
if not inRange(p.y, 0, GRID_YDIM-1) then return false
return true
end function
sub board_type.set(p as xy_int, blockType as integer)
if onBoard(p) then grid(p.x, p.y) = blockType
end sub
function board_type.get_(p as xy_int) as integer
if not onBoard(p) then
return BLOCK_INVALID
else
return grid(p.x, p.y)
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_(type(xi, yiCheck)) = BLOCK_FREE then return false
next
return true 'complete line
end function
sub board_type.moveHorzLines(yiRemove as integer)
dim as integer xi, yi
for yi = yiRemove to 1 step -1
for xi = 0 to GRID_XDIM-1
set(type(xi, yi), get_(type(xi, yi - 1)))
next
next
end sub
sub board_type.markHorzLine(yiMark as integer)
dim as integer xi
for xi = 0 to GRID_XDIM-1
set(type(xi, yiMark), BLOCK_MARKED)
next
end sub
'============================== inc/board.bi (end) =============================
'============================= inc/piece.bi (begin) ============================
'very stupid class, does not know anything about the shape of a piece
'(knows NUM_PIECES, NUM_ORIENT)
'piece shape info is in 'pieces' class, contained by 'game' class
type piece_type
dim as xy_sgl p 'grid postion index
dim as integer id, rot
dim as integer blockType
public:
declare sub init(gridPos as xy_int, iPiece as integer, iOrient as integer) 'ALMOST OBSOLETE
declare function getPosInt() as xy_int
declare sub disable()
declare sub mark()
end type
sub piece_type.init(gridPos as xy_int, iPiece as integer, iOrient as integer) 'ALMOST OBSOLETE
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
blockType = BLOCK_PIECE
end sub
function piece_type.getPosInt() as xy_int
return type<xy_int>(int(p.x), int(p.y))
end function
sub piece_type.disable()
id = -1
end sub
sub piece_type.mark()
blockType = BLOCK_MARKED
end sub
'============================== inc/piece.bi (end) =============================
'============================== inc/game.bi (begin) ============================
'================================ bmp.bi (begin) ===============================
#include once "file.bi"
'============================== common.bi (begin) ==============================
'================================ common.bi (end) ==============================
union rgba_union
value as ulong
type
b as ubyte
g as ubyte
r as ubyte
a as ubyte
end type
end union
function createPixel(r as ubyte, g as ubyte, b as ubyte) as rgba_union
dim as rgba_union pixel
pixel.r = r
pixel.g = g
pixel.b = b
return pixel
end function
type bitmap_header field = 1
bfType as ushort
bfsize as ulong
bfReserved1 as ushort
bfReserved2 as ushort
bfOffBits as ulong
biSize as ulong
biWidth as ulong
biHeight as ulong
biPlanes as ushort
biBitCount as ushort
biCompression as ulong
biSizeImage as ulong
biXPelsPerMeter as ulong
biYPelsPerMeter as ulong
biClrUsed as ulong
biClrImportant as ulong
end type
type image_type
dim as any ptr pFbImg
dim as xy_int size, half
declare sub create(sizeInit as xy_int, colorInit as ulong)
declare function createFromBmp(fileName as string) as integer
declare sub destroy()
declare destructor()
end type
sub image_type.create(sizeInit as xy_int, colorInit as ulong)
pFbImg = imagecreate(sizeInit.x, sizeInit.y, colorInit)
size = sizeInit
half.x = size.x \ 2
half.y = size.y \ 2
'center = 0
'method = 0
end sub
function image_type.createFromBmp(fileName as string) as integer
dim as bitmap_header bmp_header
dim as xy_int bmpSize
if fileExists(filename) then
open fileName for binary as #1
get #1, , bmp_header
close #1
bmpSize.x = bmp_header.biWidth
bmpSize.y = bmp_header.biHeight
create(bmpSize, &hff000000)
bload fileName, pFbImg
print "Bitmap loaded: " & filename
else
print "File not found: " & filename
sleep 1000
return -1
end if
return 0
end function
sub image_type.destroy()
if (pFbImg <> 0) then
imagedestroy(pFbImg)
pFbImg = 0
end if
end sub
destructor image_type()
destroy()
end destructor
'===============================================================================
type area_type
dim as integer x1, y1
dim as integer x2, y2
end type
function imageGrayInt(pFbImg as any ptr, area as area_type, intOffs as integer) as integer
dim as integer w, h, bypp, pitch
dim as integer xi, yi, intensity
dim as any ptr pPixels
dim as rgba_union ptr pRow
if imageinfo(pFbImg, w, h, bypp, pitch, pPixels) <> 0 then return -1
if bypp <> 4 then return -2 'only 32-bit images
if pPixels = 0 then return -3
if area.x1 < 0 or area.x1 >= w then return -4
if area.y1 < 0 or area.y1 >= h then return -5
if area.x2 < 0 or area.x2 >= w then return -6
if area.y2 < 0 or area.y2 >= h then return -7
for yi = area.y1 to area.y2
pRow = pPixels + yi * pitch
for xi = area.x1 to area.x2
intensity = cint(0.3 * pRow[xi].r + 0.5 * pRow[xi].g + 0.2 * pRow[xi].b) + intOffs
if intensity < 0 then intensity = 0
if intensity > 255 then intensity = 255
pRow[xi].r = intensity
pRow[xi].g = intensity
pRow[xi].b = intensity
next
next
return 0
end function
'================================= bmp.bi (end) ================================
'#include "multiput.bi"
type game_type
private:
dim as pieces_type pieces
dim as board_type board
dim as image_type bgImg
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 sub drawSquareFree(gridPos as xy_sgl, blockType as integer)
declare function checkLines() as integer
declare function removeLines() as integer
declare function newPiece() as piece_type
declare function getGridPos(scrnPos as xy_sgl) as xy_int
declare function getScrnPosX(gridPosX as integer) as integer
declare function getScrnPosY(gridPosY as integer) as integer
declare function getBoard(gridPos as xy_int) as integer
end type
sub game_type.init()
pieces.init()
board.init()
if bgImg.createFromBmp("res/Basil-cathedral-morning_800.bmp") = 0 then
imageGrayInt(bgImg.pFbImg, type(000, 0, 199, (bgImg.size.y-1)), +20)
imageGrayInt(bgImg.pFbImg, type((bgImg.size.x-1)-199, 0, (bgImg.size.x-1)-000, (bgImg.size.y-1)), +20)
imageGrayInt(bgImg.pFbImg, type(200, 0, (bgImg.size.x-1)-200, (bgImg.size.y-1)), -50)
end if
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
dim as xy_int squarePos
if inRange(piece.id, 0, NUM_PIECES-1) then
for iSquare = 0 to NUM_SQUARES-1
squarePos = pieces.getSquarePos(piece.id, piece.rot, iSquare)
'if board.onBoard(piece.getPosInt() + squarePos) = false then return false 'not needed? !!!
if board.get_(piece.getPosInt() + squarePos) <> BLOCK_FREE then return false
next
else
return false
end if
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
'multiput(0, SCREEN_W\2, SCREEN_H\2, bgImg.pPixData, 1, 1, 0, false)
if bgImg.pFbImg <> 0 then
put (0, 0), bgImg.pFbImg, pset
end if
for xi = 0 to GRID_XDIM-1
for yi = 0 to GRID_YDIM-1
drawSquare(type(xi, yi), board.get_(type(xi, yi)))
next
next
end sub
'copy piece to board
sub game_type.moveToBoard(piece as piece_type)
dim as integer iSquare
dim as xy_int squarePos
if inRange(piece.id, 0, NUM_PIECES-1) then
for iSquare = 0 to NUM_SQUARES-1
squarePos = pieces.getSquarePos(piece.id, piece.rot, iSquare)
board.set(piece.getPosInt() + squarePos, BLOCK_PIECE)
next
end if
end sub
sub game_type.clearScreen()
line(0, 0) - (SCREEN_W-1, SCREEN_H-1), C_BLACK, bf
end sub
'draw teris 1 piece, multiple squares
sub game_type.drawPiece(piece as piece_type)
dim as single x, y
dim as integer iSquare
dim as xy_int squarePos
if inRange(piece.id, 0, NUM_PIECES-1) then
for iSquare = 0 to NUM_SQUARES-1
squarePos = pieces.getSquarePos(piece.id, piece.rot, iSquare)
'drawSquare(piece.p + squarePos, BLOCK_PIECE)
x = piece.p.x + squarePos.x
y = piece.p.y + squarePos.y
drawSquareFree(type<xy_sgl>(x,y), piece.blockType)
next
end if
end sub
sub game_type.drawSquare(gridPos as xy_int, blockType as integer)
dim as integer x, y
if inRange(gridPos.x, 0, GRID_XDIM-1) and inRange(gridPos.y, 0, GRID_YDIM-1) then
x = GRID_XOFFS + gridPos.x * GRID_SIZE
y = GRID_YOFFS + gridPos.y * GRID_SIZE
'draw square border
line(x, y)-step(GRID_SIZE-1, GRID_SIZE-1), C_DARK_GRAY, b
select case blockType
case BLOCK_FREE
case BLOCK_FIXED
case BLOCK_PIECE
line(x + 1, y + 1)-step(GRID_SIZE-3, GRID_SIZE-3), C_YELLOW, bf
case BLOCK_MARKED
line(x + 1, y + 1)-step(GRID_SIZE-3, GRID_SIZE-3), C_RED, bf
case else
'not good, unknown block type
end select
else
'not good, outside grid
end if
end sub
sub game_type.drawSquareFree(gridPos as xy_sgl, blockType as integer)
dim as integer x, y, colour
colour = iif(blockType = BLOCK_PIECE, C_YELLOW, C_RED)
'if blockType = BLOCK_PIECE then
x = GRID_XOFFS + int(gridPos.x * GRID_SIZE) 'fix?
y = GRID_YOFFS + int(gridPos.y * GRID_SIZE) 'fix?
'draw square border
line(x, y)-step(GRID_SIZE-1, GRID_SIZE-1), C_DARK_GRAY, b
line(x + 1, y + 1)-step(GRID_SIZE-3, GRID_SIZE-3), colour, bf
'end if
end sub
'find and mark complete lines
function game_type.checkLines() as integer
dim as integer yi, xi
dim as integer numLines = 0
'from center to top
for yi = GRID_YDIM-1 to 0 step -1
if board.checkHorzLine(yi) then
numLines += 1
board.markHorzLine(yi)
end if
next
return numLines
end function
'check and move lines, return number of lines removed
function game_type.removeLines() as integer
dim as integer xi, yi
dim as integer numLines = 0
for yi = GRID_YDIM-1 to 0 step -1
'check complete horizontal line
if board.checkHorzLine(yi) then
board.moveHorzLines(yi)
numLines += 1
yi += 1 'recheck this line
end if
next
return numLines
end function
'new ramdom piece at random orientation and x-position
function game_type.newPiece() as piece_type
dim as piece_type piece
with piece
.id = int(rnd * NUM_PIECES)
.rot = int(rnd * NUM_ORIENT)
.p.x = rndBetween(0 - pieces.mbb(.id, .rot).xMin, (GRID_XDIM-1) - pieces.mbb(.id, .rot).xMax)
.p.y = -pieces.mbb(.id, .rot).yMin
.blockType = BLOCK_PIECE
end with
return piece
end function
function game_type.getGridPos(scrnPos as xy_sgl) as xy_int
dim as xy_int gridPos
gridPos.x = (scrnPos.x - GRID_XOFFS) \ GRID_SIZE
gridPos.y = (scrnPos.y - GRID_YOFFS) \ GRID_SIZE
return gridPos
end function
function game_type.getScrnPosX(gridPosX as integer) as integer
return GRID_XOFFS + gridPosX * GRID_SIZE
end function
function game_type.getScrnPosY(gridPosY as integer) as integer
return GRID_YOFFS + gridPosY * GRID_SIZE
end function
function game_type.getBoard(gridPos as xy_int) as integer
return board.get_(gridPos)
end function
'============================== inc/game.bi (end) ==============================
'============================ inc/player.bi (begin) ============================
enum
ST_STANDING
ST_WALKING
ST_JUMPING
'ST_DIYING
'ST_DEAD
ST_NONE
end enum
dim as string states(ST_NONE) = {"STANDING", "WALKING", "JUMPING", "NONE"}
type player_type
dim as xy_sgl p '[pixels]
dim as integer r 'radius [pixels]
dim as xy_sgl a '[pixels/s^2]
dim as xy_sgl v '[pixels/s]
dim as integer state
declare sub draw()
end type
sub player_type.draw()
circle(int(p.x + 0.5), int(p.y + 0.5)),r-1, &h00ff0088,,,,f
circle(int(p.x + 0.5), int(p.y + 0.5)),r, C_DARK_GRAY
end sub
'============================== inc/player.bi (end) ============================
'******************************* main.bas **************************************
enum pieceStateEnum
PIECE_DELAY
PIECE_NEW
PIECE_FALLING
PIECE_WAIT_CLEAR
end enum
dim as game_type game
dim as timer_type clearTmr, pieceWaitTmr
dim as piece_type activePiece, movedPiece
dim as integer quit = 0
dim as ushort keyCode
dim as integer score, lineCount
dim as pieceStateEnum pieceState = PIECE_NEW
dim as integer fastDrop = 0
dim as player_type player
player.p = type(SCREEN_W / 2, SCREEN_H - 100.0)
player.r = 17
player.state = ST_JUMPING
dim as xy_int gridPos
screenres SCREEN_W, SCREEN_H, 32
randomize(timer())
game.init()
'game.showAllPieces()
'sleep 1000,1
game.drawBoard()
dim as single vDrop, vDropInitial = 4.0 'tiles/s
dim as double tNow = timer, tPrev = tNow, dt = 0.0
const as single GRAVITY = 3000 '[pixels/s^2]
const as single MAX_SPEED = 250 '[pixels/s]
const as single JUMP_SPEED = 800 '[pixels/s]
const as single ACCEL_GROUND = 2000 '[pixels/s]
dim as integer jump = 0
do
with player
.a.x = 0.0
'.state = ST_STANDING
if multikey(FB.SC_LEFT) then
.a.x = -ACCEL_GROUND
if .state <> ST_JUMPING then .state = ST_WALKING 'maybe
end if
if multikey(FB.SC_RIGHT) then
.a.x = +ACCEL_GROUND
if .state <> ST_JUMPING then.state = ST_WALKING 'maybe
end if
if multikey(FB.SC_UP) then
if jump = 0 then jump = 1 'trigger jump
else
jump = 0 'reset, allow new jump
end if
'no forced accelleration (friction)
if abs(.a.x) < 1.0 then
if .v.x > 0 then .a.x = -ACCEL_GROUND
if .v.x < 0 then .a.x = +ACCEL_GROUND
.v.x += .a.x * dt
'check direction of friction
if (.v.x * .a.x) > 0 then .v.x = 0' : .state = ST_STANDING '?
else
.v.x += .a.x * dt
end if
'limit speed
if .v.x > MAX_SPEED then .v.x = MAX_SPEED
if .v.x < -MAX_SPEED then .v.x = -MAX_SPEED
'update x-position
.p.x += .v.x * dt
gridPos = game.getGridPos(.p)
'check right
if game.getBoard((type(gridPos.x + 1, gridPos.y))) <> BLOCK_FREE then
if (.p.x + .r) > game.getScrnPosX(gridPos.x + 1) then
'correct position & speed
.p.x = game.getScrnPosX(gridPos.x + 1) - .r
.v.x = 0
'.state = ST_STANDING
end if
end if
'check left
if game.getBoard((type(gridPos.x - 1, gridPos.y))) <> BLOCK_FREE then
if (.p.x - .r) < game.getScrnPosX(gridPos.x) then
'correct position & speed
.p.x = game.getScrnPosX(gridPos.x) + .r
.v.x = 0
'.state = ST_STANDING
end if
end if
'jump if not in air
if (.state <> ST_JUMPING) then
if jump = 1 then
jump = 2 'block new jump until key release
.v.y = -JUMP_SPEED
.state = ST_JUMPING
end if
end if
'update y-velocity and y-position
.v.y += GRAVITY * dt '[m/s] = [m/s^2] * [s]
.p.y += .v.y * dt '[m] = [m/s] * [s]
'check below
if game.getBoard((type(gridPos.x, gridPos.y + 1))) <> BLOCK_FREE then
if (.p.y + .r) > game.getScrnPosY(gridPos.y + 1) then
'correct position & speed & state
.p.y = game.getScrnPosY(gridPos.y + 1) - .r
.v.y = 0
if (.state = ST_JUMPING) then .state = ST_STANDING
end if
end if
'check above
if game.getBoard((type(gridPos.x, gridPos.y - 1))) <> BLOCK_FREE then
'top of player < top of current grid block top ?
if (.p.y - .r) < game.getScrnPosY(gridPos.y) then
'correct position & speed & state
.p.y = game.getScrnPosY(gridPos.y) + .r
.v.y = 0
'if (.state = ST_JUMPING) then .state = ST_STANDING
end if
end if
end with
keyCode = pollKeyCode()
select case keyCode
case KEY_SPACE
if fastDrop = 0 then
fastDrop = 1
vDrop *= 10
end if
case KEY_ESC
quit = 1
case else
end select
select case pieceState
case PIECE_NEW
activePiece = game.newPiece()
vDrop = vDropInitial
fastDrop = 0
if not game.piecePossible(activePiece) then
activePiece.mark() 'display in different colour
quit = 2
end if
pieceState = PIECE_DELAY
pieceWaitTmr.start(0.250)
case PIECE_DELAY
'some delay before new piece starts falling
if pieceWaitTmr.ended() then pieceState = PIECE_FALLING
case PIECE_FALLING
movedPiece = activePiece 'temporary copy
movedPiece.p.y += 1.0 'check next grid pos
'check drop move possible
if game.piecePossible(movedPiece) then
activePiece.p.y += vDrop * dt
else
'piece has been dropped onto something
game.moveToBoard(activePiece)
activePiece.disable()
lineCount = game.checkLines()
if lineCount > 0 then
clearTmr.start(0.500)
pieceState = PIECE_WAIT_CLEAR
else
pieceState = PIECE_NEW
end if
end if
case PIECE_WAIT_CLEAR
if clearTmr.ended() then
score += game.removeLines() ^ 2
pieceState = PIECE_NEW
end if
case else
end select
screenlock
'game.clearScreen()
game.drawBoard()
game.drawPiece(activePiece)
xyPrint(2, 2, "Score: " & str(score))
xyPrint(2, 4, "Piece state: " & str(pieceState))
player.draw()
xyPrint(2, 8, "Player state: " + str(player.state) + " = " + states(player.state))
xyPrint(2, 10, "Player gridPos: " + str(gridPos.x) + ", " + str(gridPos.y))
xyPrint(2, 12, "jump: " + str(jump))
screenunlock
sleep 1,1
tPrev = tNow
tNow = timer
dt = tNow - tPrev
loop while quit = 0
xyPrint(2, 4, "Quit state: " & str(quit))
xyPrint(2, 6, "Game ended, press any key.")
waitKeyCode()
Let me know if errors occur.