Tetris vs Mario (Work in progress)

Game development specific discussions.
Post Reply
badidea
Posts: 2591
Joined: May 24, 2007 22:10
Location: The Netherlands

Tetris vs Mario (Work in progress)

Post by badidea »

Hello all, I started working on another Tetris variation that should combine Tetris with a platform game. Mario, or whatever the player character will look like, is still out (eating pizza). So one can only watch Tetris blocks falling at random positions at the moment. Updates will follow whenever something significant is added. Code (concatenated):

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()
It uses this image BMP (1.8 MB), but works without it.[/s]

Let me know if errors occur.
Last edited by badidea on May 14, 2020 21:48, edited 3 times in total.
badidea
Posts: 2591
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Tetris vs Mario (Work in progress)

Post by badidea »

Continuing work on this project again. There was a problem with collision detection / handling (e.g. falling through blocks) on machines longer a 'system clock tick' or 'interrupt time'. This has been discussed before on the forum with several possible solutions.

In the demo below, I run the screen update with 5 Hz (200 ms), but the physics update at < 5 ms. This can be seem from the behaviour when there is a collision with the wall.

Code: Select all

'============================== common.bas (begin) =============================

function rndChoiceInt(v1 as integer, v2 as integer) as integer
	return iif(rnd > 0.5, v1, v2)
end function

function rndRangeFlt(vMin as single, vMax as single) as single
	return rnd * (vMax - vMin) + vMin
end function

'=============================== common.bas (end) ==============================

'============================== vector.bas (begin) =============================

type xy_long
	dim as long x, y
end type 

operator +(p1 as xy_long, p2 as xy_long) as xy_long
	return type(p1.x + p2.x, p1.y + p2.y)
end operator

'-------------------------------------------------------------------------------

type xy_sgl
	dim as single x, y
end type 

operator +(p1 as xy_sgl, p2 as xy_sgl) as xy_sgl
	return type(p1.x + p2.x, p1.y + p2.y)
end operator

'=============================== vector.bas (end) ==============================

'============================= graphics.bas (begin) ============================

#include once "fbgfx.bi"

union rgba_union
	value as ulong
	type
		b as ubyte
		g as ubyte
		r as ubyte
		a as ubyte
	end type
end union

type graphics_type ' pretty dumb graphics class
	public:
		dim as long w, h 'size
		declare constructor(w as long, h as long)
		declare sub activate()
		declare sub clearScreen()
		declare sub dimScreen(dimFactor as single) '0...1 
end type

constructor graphics_type(w as long, h as long)
	this.w = w : this.h = h
end constructor

sub graphics_type.activate()
	screenres w, h, 32
end sub

sub graphics_type.clearScreen()
	line(0, 0)-(w - 1, h - 1), &h00000000, bf
end sub

sub graphics_type.dimScreen(dimFactor as single)
	dim as integer pitch, xi, yi
	dim as rgba_union ptr pRow
	ScreenInfo , , , , pitch
	dim as any ptr pPixels = ScreenPtr()
	if pPixels = 0 then exit sub
	for yi = 0 to h-1
		pRow = pPixels + yi * pitch
		for xi = 0 to w-1
			pRow[xi].r *= dimFactor
			pRow[xi].g *= dimFactor
			pRow[xi].b *= dimFactor
		next
	next
end sub

'============================== graphics.bas (end) =============================

'================================ box.bas (begin) ==============================

type box_type 'Axis Aligned (minimum) Bounding Box
	public:
		union
			type
				dim as single x, y
			end type
			dim as xy_sgl p 'center position
		end union
		union
			type
				dim as single w, h
			end type
			dim as xy_sgl size
		end union
		dim as ulong c 'color
		declare constructor()
		declare constructor(x as single, y as single, w as single, h as single, c as ulong)
		declare sub draw(solid as boolean)
		declare function left() as single
		declare function right() as single
		declare function up() as single
		declare function down() as single
end type

constructor box_type()
end constructor

constructor box_type(x as single, y as single, w as single, h as single, c as ulong)
	this.x = x : this.y = y
	this.w = w : this.h = h
	this.c = c
end constructor

sub box_type.draw(solid as boolean = false)
	if solid = true then
		line(x - w / 2, y - h / 2)-step(w - 1, h -1), c, bf
	else
		line(x - w / 2, y - h / 2)-step(w - 1, h -1), c, b
	end if
end sub

function box_type.left() as single
	return x - w / 2
end function

function box_type.right() as single
	return x + w / 2
end function

function box_type.up() as single
	return y - h / 2
end function

function box_type.down() as single
	return y + h / 2
end function

'================================ box.bas (end) ================================

var graphics = graphics_type(800, 600)
graphics.activate()

const as integer NUM_BOX = 2
dim as box_type box(NUM_BOX-1)
dim as xy_sgl vBox(NUM_BOX-1) 'speed of the boxes
dim as xy_sgl dPosBox(NUM_BOX-1) 'delta position of the boxes

dim as integer iBox
dim as single x, y, w, h, vx, vy
dim as ulong c
const as single MAX_SPEED = 200.0 'pixels/s
const as double MIN_DT = 5.0 / 1000

randomize 121 'timer
for iBox = 0 to NUM_BOX-1
	w = rnd * 90 + 10
	h = rnd * 90 + 10
	x = rnd * (graphics.w - 110) + 50
	y = rnd * (graphics.h - 110) + 50
	c = int(rnd * &h00ffffff) or &h000f0f0f
	box(iBox) = box_type(x, y, w, h, c)
	vx = rndRangeFlt(-MAX_SPEED, +MAX_SPEED)
	vy = rndRangeFlt(-MAX_SPEED, +MAX_SPEED)
	vBox(iBox) = type(vx, vy)
next

dim as integer numSteps, iStep
dim as double tNow = timer, tPrev = tNow, dtLoop, dtStep
while inkey <> chr(27)
	numSteps = int(dtLoop / MIN_DT) + 1 'ceiling, at least 1 step
	dtStep = dtLoop / numSteps
	for iStep = 0 to numSteps-1
		'check collision with walls
		for iBox = 0 to NUM_BOX-1
			dPosBox(iBox).x = vBox(iBox).x * dtStep ' todo: vector multiply
			dPosBox(iBox).y = vBox(iBox).y * dtStep
		next
		for iBox = 0 to NUM_BOX-1
			if (box(iBox).left + dPosBox(iBox).x < 0) or (box(iBox).right + dPosBox(iBox).x > graphics.w - 1) then
				vBox(iBox).x = -vBox(iBox).x
				dPosBox(iBox).x = vBox(iBox).x * dtStep
			end if
			if (box(iBox).up + dPosBox(iBox).y < 0) or (box(iBox).down + dPosBox(iBox).y > graphics.h - 1) then
				vBox(iBox).y = -vBox(iBox).y
				dPosBox(iBox).y = vBox(iBox).y * dtStep
			end if
			box(iBox).p += dPosBox(iBox)
		next
	next
	screenlock
	'graphics.clearScreen
	graphics.dimScreen(0.90)
	for iBox = 0 to NUM_BOX-1
		box(iBox).draw(0)
	next
	locate 1,1: print "numSteps (dt): " & str(numSteps) + " "; 
	screenunlock
	sleep 200
	tPrev = tNow
	tNow = timer
	dtLoop = tNow - tPrev
wend
Next step implement it in the tetris game...
badidea
Posts: 2591
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Tetris vs Mario (Work in progress)

Post by badidea »

For those you missed it, the 'final' result (with Mario as a horse) can be found here: https://freebasic.net/forum/viewtopic.p ... 90#p260499
Unfortunately, the competition organizer was apparently so disappointed with the result that he ran away.
badidea
Posts: 2591
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Tetris vs Mario (Work in progress)

Post by badidea »

Found this funny animated GIF online :-)
Image
aurelVZAB
Posts: 666
Joined: Jul 02, 2008 14:55
Contact:

Re: Tetris vs Mario (Work in progress)

Post by aurelVZAB »

WOW ..not just funny than excellent !!!!!!!!!!!!!!!!!!!!
Post Reply