Another Tetris

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

Another Tetris

Post by badidea »

Hi all, my implementation of Tetris. Let me know what you think.

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()
Screenshot added:
Image
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Another Tetris

Post by Tourist Trap »

Good. Very sober.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Another Tetris

Post by badidea »

Did a test with colors. I prefer the sober look.
Image
Roland Chastain
Posts: 992
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: Another Tetris

Post by Roland Chastain »

Very nice.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Another Tetris

Post by badidea »

Most annoying Tetris variant ever?
Uses Multiput by D.J.Peters (appended to code)

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, etc.) 

'To do:
' check use of integer and boolean
' repeat line check until none complete?
' 1 function for check, mark, remove lines
' Bug with H&V line togerther?
' Background
' Wallkick, hidden lines
' end of game strange

const as integer SCREEN_W = 800
const as integer SCREEN_H = SCREEN_W
const as integer GRID_DIM = 17 + 2 + 17 'playfield = 42 x 42
const as integer GRID_HALF = GRID_DIM \ 2
const as integer GRID_SIZE = SCREEN_H \ GRID_DIM 'size of squares
const as integer GRID_XOFFS = (SCREEN_W - GRID_DIM * GRID_SIZE) \ 2 'offset on screen
const as integer GRID_YOFFS = (SCREEN_H - GRID_DIM * 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 = &h00F04040 '&h00C0C0C0
const as ulong C_WHITE = &h00F0F0F0

'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

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
	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 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:
	'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
	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

function pieces_type.getSquarePos(iPiece as integer, iOrient as integer, _
	iSquare as integer) as xy_int
	return piece(iPiece, iOrient, iSquare)
end function

'******************************* 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 *************************************

#include "crt/string.bi"
 
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_DIM-1, GRID_DIM-1)
	dim as integer tempGrid(GRID_DIM-1, GRID_DIM-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 function checkVertLine(xiCheck as integer) as integer
	declare sub markHorzLine(yiMark as integer)
	declare sub markVertLine(xiMark as integer)
	declare sub moveHorzLines(yiRemove as integer, direction as integer)
	declare sub moveVertLines(xiRemove as integer, direction as integer)
	declare sub rotate(clockwise as boolean)
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(type(xi, yi), BLOCK_FREE)
			else
				set(type(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(type(xi, yi), BLOCK_FIXED)
				end if
			end if
		next
	next
end sub

function board_type.onBoard(p as xy_int) as integer
	if not inRange(p.x, 0, GRID_DIM-1) then return false
	if not inRange(p.y, 0, GRID_DIM-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 = GRID_HALF-5 to GRID_HALF+4
		if get_(type(xi, yiCheck)) = BLOCK_FREE then return false 
	next
	return true 'complete line
end function

function board_type.checkVertLine(xiCheck as integer) as integer
	dim as integer yi
	for yi = GRID_HALF-5 to GRID_HALF+4
		if get_(type(xiCheck, yi)) = BLOCK_FREE then return false 
	next
	return true 'complete line
end function

sub board_type.markHorzLine(yiMark as integer)
	dim as integer xi
	for xi = GRID_HALF-5 to GRID_HALF+4
		set(type(xi, yiMark), BLOCK_MARKED)
	next
end sub

sub board_type.markVertLine(xiMark as integer)
	dim as integer yi
	for yi = GRID_HALF-5 to GRID_HALF+4
		set(type(xiMark, yi), BLOCK_MARKED)
	next
end sub

'make 1 routine for horz and vert?
sub board_type.moveHorzLines(yiRemove as integer, direction as integer)
	dim as integer xi, yi
	if direction = DIR_DN then
		for yi = yiRemove to 1 step -1
			for xi = GRID_HALF-5 to GRID_HALF+4
				set(type(xi, yi), get_(type(xi, yi - 1))) 
			next
		next
	elseif direction = DIR_UP then
		for yi = yiRemove to GRID_DIM-2 step +1
			for xi = GRID_HALF-5 to GRID_HALF+4
				set(type(xi, yi), get_(type(xi, yi + 1))) 
			next
		next
	else
		'not good
	end if
end sub

'make 1 routine for horz and vert?
sub board_type.moveVertLines(xiRemove as integer, direction as integer)
	dim as integer xi, yi
	if direction = DIR_RI then
		for xi = xiRemove to 1 step -1
			for yi = GRID_HALF-5 to GRID_HALF+4
				set(type(xi, yi), get_(type(xi -1 , yi))) 
			next
		next
	elseif direction = DIR_LE then
		for xi = xiRemove to GRID_DIM-2 step +1
			for yi = GRID_HALF-5 to GRID_HALF+4
				set(type(xi, yi), get_(type(xi + 1, yi))) 
			next
		next
	else
		'not good
	end if
end sub

sub board_type.rotate(clockwise as boolean)
	dim as integer xi, yi
	memcpy(@tempGrid(0,0), @grid(0,0), sizeof(integer) * GRID_DIM * GRID_DIM)
	if clockwise = false then
		for xi = 0 to GRID_DIM-1
			for yi = 0 to GRID_DIM-1
				grid(xi, yi) = tempGrid((GRID_DIM - 1) - yi, xi)
			next
		next
	else
		for xi = 0 to GRID_DIM-1
			for yi = 0 to GRID_DIM-1
				grid(xi, yi) = tempGrid(yi, (GRID_DIM - 1) - xi)
			next
		next
	end if
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 checkLines() as integer
	declare function removeLines() as integer
	declare sub rotateBoard(clockwise as boolean)
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
	dim as xy_int squarePos
	for iSquare = 0 to NUM_SQUARES-1
		squarePos = pieces.getSquarePos(piece.id, piece.rot, iSquare)
		if board.onBoard(piece.p + squarePos) = false then return false
		if board.get_(piece.p + squarePos) <> 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(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_DIM-1
		for yi = 0 to GRID_DIM-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 xi, yi, iSquare
	dim as xy_int squarePos
	for iSquare = 0 to NUM_SQUARES-1
		squarePos = pieces.getSquarePos(piece.id, piece.rot, iSquare)
		board.set(piece.p + squarePos, 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
	dim as xy_int squarePos
	for iSquare = 0 to NUM_SQUARES-1
		squarePos = pieces.getSquarePos(piece.id, piece.rot, iSquare)
		drawSquare(piece.p + squarePos, 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_DIM-1) and inRange(gridPos.y, 0, GRID_DIM-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 BLOCK_MARKED
				line(GRID_XOFFS + gridPos.x * GRID_SIZE + 1, GRID_YOFFS + gridPos.y * GRID_SIZE + 1)-_
				step(GRID_SIZE-3, GRID_SIZE-3), C_LIGHT_GRAY, bf
			case else
				'not good, unknown block type
		end select	
	else
		'not good, outside grid
	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_HALF-2 to 0 step -1
		if board.checkHorzLine(yi) then
			numLines += 1
			board.markHorzLine(yi)
		end if
	next
	'from center to bottom
	for yi = GRID_HALF+1 to GRID_DIM-1 step +1
		if board.checkHorzLine(yi) then
			numLines += 1
			board.markHorzLine(yi)
		end if
	next
	'from center to left
	for xi = GRID_HALF-2 to 0 step -1
		if board.checkVertLine(xi) then
			numLines += 1
			board.markVertLine(xi)
		end if
	next
	'from center to right
	for xi = GRID_HALF+1 to GRID_DIM-1 step +1
		if board.checkVertLine(xi) then
			numLines += 1
			board.markVertLine(xi)
		end if
	next
	'do all check again
	return numLines
end function

'check and move lines, return number of lines removed
function game_type.removeLines() as integer
	dim as integer yi, xi
	dim as integer numLines = 0
	'from center to top
	for yi = GRID_HALF-2 to 0 step -1
		if board.checkHorzLine(yi) then
			board.moveHorzLines(yi, DIR_DN) 'falling direction
			numLines += 1
			yi += 1 'recheck this line
		end if
	next
	'from center to bottom
	for yi = GRID_HALF+1 to GRID_DIM-1 step +1
		if board.checkHorzLine(yi) then
			board.moveHorzLines(yi, DIR_UP) 'falling direction
			numLines += 1
			yi -= 1 'recheck this line
		end if
	next
	'from center to left
	for xi = GRID_HALF-2 to 0 step -1
		if board.checkVertLine(xi) then
			board.moveVertLines(xi, DIR_RI) 'falling direction
			numLines += 1
			xi += 1 'recheck this line
		end if
	next
	'from center to right
	for xi = GRID_HALF+1 to GRID_DIM-1 step +1
		if board.checkVertLine(xi) then
			board.moveVertLines(xi, DIR_LE) 'falling direction
			numLines += 1
			xi -= 1 'recheck this line
		end if
	next
	'do all check again
	return numLines
end function

sub game_type.rotateBoard(clockwise as boolean)
	board.rotate(clockwise)
end sub

'******************************* main.bas **************************************

declare Sub MultiPut(Byval pTarget As Any Ptr= 0, Byval xMidPos As Integer= 0, _
	 Byval yMidPos As Integer= 0, Byval pSource As Any Ptr, _
	 Byval xScale  As Single = 1, Byval yScale  As Single = 1, _
	 Byval Rotate  As Single = 0, Byval Transparent As boolean = false)

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, lineCount
'dim as integer playDir = DIR_DN
dim as any ptr pImage
dim as integer angle, clockwise

'delta x,y for falling direction: Down, Left, Up, Right 
'dim as xy_int pDelta(NUM_ORIENT-1) = {(0, +1), (-1, 0), (0, -1), (+1, 0)} 'WRONG ROTATION!
'dim as xy_int pStart(NUM_ORIENT-1) = {(GRID_HALF, 0), (GRID_DIM-1, GRID_HALF), _
'	(GRID_HALF, GRID_DIM-1), (0, GRID_HALF)}

screenres SCREEN_W, SCREEN_H, 32
pImage = imagecreate(SCREEN_W, SCREEN_H)

randomize(timer())
game.init()
'game.showAllPieces()
'waitKeyCode()
game.drawBoard()

do
	if requestNewPiece then
		requestNewPiece = false
		activePiece.init(type(GRID_HALF, 0), -1, 0)
		if not game.piecePossible(activePiece) then quit = 1

		if rnd() > 0.5 then clockwise = true else clockwise = false 
		sleep 100, 1 'delay before rotation
		get(0, 0)-(SCREEN_W-1, SCREEN_H-1), pImage
		for angle = 0 to 89 step 2
			screenlock
			game.clearScreen()
			if clockwise = true then
				MultiPut(0, SCREEN_W\2, SCREEN_H\2, pImage, 1, 1, angle, false)
			else
				MultiPut(0, SCREEN_W\2, SCREEN_H\2, pImage, 1, 1, -angle, false)
			end if
			screenunlock
			sleep 1, 1
		next
		game.rotateBoard(clockwise)

		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
				movedPiece.p.x -= 1
			case KEY_RI
				movedPiece.p.x += 1
			case KEY_UP
				movedPiece.rot = (movedPiece.rot + 1) mod NUM_ORIENT
			case KEY_DN
				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
		'movedPiece.p = movedPiece.p + pDelta(playDir)
		'check drop possible
		if game.piecePossible(movedPiece) then
			gravTmr.restart()
			activePiece = movedPiece
		else
			'piece has been dropped onto something
			game.moveToBoard(activePiece)
			lineCount = game.checkLines()
			'quick hack - begin
			if lineCount > 0 then
				screenlock
				game.clearScreen()
				game.drawBoard()
				'game.drawPiece(activePiece)
				locate 2, 2
				print "Score:"; score
				screenunlock
				sleep 500,1
			end if
			'quick hack - end
			score += game.removeLines() ^ 2
			requestNewPiece = true
			'playDir = (playDir + 1) mod NUM_ORIENT
			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

imagedestroy(pImage)
locate 4, 2
print "Game ended, press any key."
waitKeyCode()

'****************************** MultiPut.bi ************************************

#ifndef __MULTIPUT_BI__
#define __MULTIPUT_BI__

' Multiput by D.J.Peters (Joshy)
' MultiPut [destination],[xmidpos],[ymidpos], source,[xScale],[yScale],[Trans]

type FP16 ' fixed point 16:16
  union
  type
    as ushort l
    as  short h
  end type
  as integer v
  end union
end type

#define _ADD_ 0 ' increment a value
#define _CMP_ 1 ' compare values
#define _SET_ 2 ' set a value

#define _XScreen_  0
#define _YScreen_  1
#define _UTexture_ 2
#define _VTexture_ 3

#define _LeftIndex_    0
#define _RightIndex_   1

#define _CurrentIndex_ 0
#define _NextIndex_    1

#define _EdgeXStart_ 0
#define _EdgeUStart_ 1
#define _EdgeVStart_ 2
#define _EdgeXStep_  3
#define _EdgeUStep_  4
#define _EdgeVStep_  5

'#define UseRad 'if not then Rotate are in degrees

Sub MultiPut(Byval pTarget As Any Ptr= 0, _
             Byval xMidPos As Integer= 0, _
             Byval yMidPos As Integer= 0, _
             Byval pSource As Any Ptr   , _
             Byval xScale  As Single = 1, _
             Byval yScale  As Single = 1, _
             Byval Rotate  As Single = 0, _
             Byval Transparent As boolean = false)
  Dim As Integer SourceWidth=any,SourceHeight=any,SourceBytes=any,SourcePitch=any
  Dim as Integer TargetWidth=any,TargetHeight=any,TargetBytes=any,TargetPitch=any
  Dim As Integer i=any,yStart=any,yEnd=any,xStart=any,xEnd=any
  Dim As Integer CNS(1,1)=any 'Counters
  Dim As Integer ACS(1,2)=any '_ADD_ compare and _SET_
  Dim As Single fPoints(3,3)=any,fEdges(2,6)=any,fLength=any,fUSlope=any,fVSlope=any
  Dim As FP16 U=any,V=any,US=any,VS=any
  Dim As boolean MustRotate = iif(Rotate<>0,true,false)

  If (ScreenPtr()=0) Or (pSource=0) Then Exit Sub

  If xScale < 0.001 Then xScale=0.001
  If yScale < 0.001 Then yScale=0.001
 
  If pTarget=0 Then
    ScreenInfo     _
    TargetWidth  , _
    TargetHeight,, _
    TargetBytes  , _
    TargetPitch
    pTarget=ScreenPtr()
  Else
    ImageInfo     _
    pTarget     , _
    TargetWidth , _
    TargetHeight, _
    TargetBytes , _
    TargetPitch , _
    pTarget
  End If
  If (TargetWidth<4) Or (TargetHeight<4) Then Exit Sub

  ImageInfo     _
  pSource     , _
  SourceWidth , _
  SourceHeight, _
  SourceBytes , _
  SourcePitch , _
  pSource

  Select Case as const TargetBytes
  case 1    ' TargetPitch shr=0 : SourcePitch shr=0
  case 2    : TargetPitch shr=1 : SourcePitch shr=1
  case 4    : TargetPitch shr=2 : SourcePitch shr=2
  case else : exit sub
  end select

  fPoints(0,_XScreen_)=-SourceWidth/2 * xScale
  fPoints(1,_XScreen_)= SourceWidth/2 * xScale
  fPoints(2,_XScreen_)= fPoints(1,_XScreen_)
  fPoints(3,_XScreen_)= fPoints(0,_XScreen_)

  fPoints(0,_YScreen_)=-SourceHeight/2 * yScale
  fPoints(1,_YScreen_)= fPoints(0,_YScreen_)
  fPoints(2,_YScreen_)= SourceHeight/2 * yScale
  fPoints(3,_YScreen_)= fPoints(2,_YScreen_)

  fPoints(0,_UTexture_)=0
  fPoints(1,_UTexture_)= SourceWidth
  fPoints(2,_UTexture_)= fPoints(1,_UTexture_)
  fPoints(3,_UTexture_)=0
 
  fPoints(0,_VTexture_)=0
  fPoints(1,_VTexture_)=0
  fPoints(2,_VTexture_)= SourceHeight
  fPoints(3,_VTexture_)= fPoints(2,_VTexture_)

  If MustRotate=true Then
    #ifndef UseRad
    Rotate*=0.017453292 'deg 2 rad
    #endif
    var co = cos(rotate)
    var si = sin(rotate)
    For i=0 To 3
      var x = fPoints(i,_XScreen_)*co - fPoints(i,_YScreen_)*si
      var y = fPoints(i,_XScreen_)*si + fPoints(i,_YScreen_)*co
      fPoints(i,_XScreen_) = x
      fPoints(i,_YScreen_) = y
    Next
  End If
  yStart=30^2:yEnd=-yStart:xStart=yStart:xEnd=yEnd
 
  ' get min max
  For i=0 To 3
    fPoints(i,_XScreen_)=Int(fPoints(i,_XScreen_)+xMidPos)
    fPoints(i,_YScreen_)=Int(fPoints(i,_YScreen_)+yMidPos)
    If fPoints(i,_YScreen_)<yStart Then yStart=fPoints(i,_YScreen_):CNS(_LeftIndex_,_CurrentIndex_)=i
    If fPoints(i,_YScreen_)>yEnd   Then yEnd  =fPoints(i,_YScreen_)
    If fPoints(i,_XScreen_)<xStart Then xStart=fPoints(i,_XScreen_)
    If fPoints(i,_XScreen_)>xEnd   Then xEnd  =fPoints(i,_XScreen_)
  Next

  If yStart = yEnd        Then Exit Sub
  If xStart = xEnd        Then Exit Sub
  If yEnd   < 0           Then Exit Sub
  If xEnd   < 0           Then Exit Sub
  If yStart>=TargetHeight Then Exit Sub
  If xStart>=TargetWidth  Then Exit Sub
 
 
  ACS(_LeftIndex_ ,_ADD_)=-1:ACS(_LeftIndex_ ,_CMP_)=-1:ACS(_LeftIndex_ ,_SET_)=3
  ACS(_RightIndex_,_ADD_)= 1:ACS(_RightIndex_,_CMP_)= 4:ACS(_RightIndex_,_SET_)=0

  ' share the same highest point
  CNS(_RightIndex_,_CurrentIndex_)=CNS(_LeftIndex_,_CurrentIndex_)
 
  ' loop from Top to Bottom
  While yStart<yEnd
    'Scan Left and Right edges together
    For i=_LeftIndex_ To _RightIndex_
      ' bad to read but fast and short ;-)
      If yStart=fPoints(CNS(i,_CurrentIndex_),_YScreen_) Then
        CNS(i,_NextIndex_)=CNS(i,_CurrentIndex_)+ACS(i,_ADD_)
        If CNS(i,_NextIndex_)=ACS(i,_CMP_) Then CNS(i,_NextIndex_)=ACS(i,_SET_)
        While fPoints(CNS(i,_CurrentIndex_),_YScreen_) = fPoints(CNS(i,_NextIndex_),_YScreen_)
          CNS(i,_CurrentIndex_)=CNS(i,_NextIndex_)
          CNS(i,_NextIndex_   )=CNS(i,_CurrentIndex_)+ACS(i,_ADD_)
          If CNS(i,_NextIndex_)=ACS(i,_CMP_) Then CNS(i,_NextIndex_)=ACS(i,_SET_)
        Wend
        fEdges(i,_EdgeXStart_) = fPoints(CNS(i,_CurrentIndex_),_XScreen_)
        fEdges(i,_EdgeUStart_) = fPoints(CNS(i,_CurrentIndex_),_UTexture_)
        fEdges(i,_EdgeVStart_) = fPoints(CNS(i,_CurrentIndex_),_VTexture_)
        fLength  = fPoints(CNS(i,_NextIndex_),_YScreen_) - fPoints(CNS(i,_CurrentIndex_),_YScreen_)
        If fLength <> 0.0 Then
          fLength=1/fLength
          fEdges(i,_EdgeXStep_) = fPoints(CNS(i,_NextIndex_),_XScreen_ )-fEdges(i,_EdgeXStart_):fEdges(i,_EdgeXStep_)*=fLength
          fEdges(i,_EdgeUStep_) = fPoints(CNS(i,_NextIndex_),_UTexture_)-fEdges(i,_EdgeUStart_):fEdges(i,_EdgeUStep_)*=fLength
          fEdges(i,_EdgeVStep_) = fPoints(CNS(i,_NextIndex_),_VTexture_)-fEdges(i,_EdgeVStart_):fEdges(i,_EdgeVStep_)*=fLength
        End If
        CNS(i,_CurrentIndex_)=CNS(i,_NextIndex_)
      End If
    Next

    If (yStart<0)                                                   Then Goto NextScanLine
    xStart=fEdges(_LeftIndex_ ,_EdgeXStart_):If xStart>=TargetWidth Then Goto NextScanLine
    xEnd  =fEdges(_RightIndex_,_EdgeXStart_):If xEnd  < 0           Then Goto NextScanLine
    If (xStart=xEnd)                                                Then Goto NextScanLine
    if xEnd  <xStart                                                Then goto NextScanLine

    fLength=1/(xEnd-xStart)
    fUSlope=fEdges(_RightIndex_,_EdgeUStart_)-fEdges(_LeftIndex_,_EdgeUStart_):fUSlope*=fLength
    fVSlope=fEdges(_RightIndex_,_EdgeVStart_)-fEdges(_LeftIndex_,_EdgeVStart_):fVSlope*=fLength
    If xStart<0 Then
      fLength=-xStart
      U.v=(fEdges(_LeftIndex_,_EdgeUStart_)+fUSlope*fLength)*&HFFFF
      V.v=(fEdges(_LeftIndex_,_EdgeVStart_)+fVSlope*fLength)*&HFFFF
      xStart = 0
    Else
      U.v=fEdges(_LeftIndex_,_EdgeUStart_)*&HFFFF
      V.v=fEdges(_LeftIndex_,_EdgeVStart_)*&HFFFF
    End If
    If u.v<0 Then u.v=0
    If v.v<0 Then v.v=0
    US.v=fUSlope*&HFFFF
    VS.v=fVSlope*&HFFFF

    If xEnd>=TargetWidth Then xEnd=TargetWidth-1

    Select Case as const TargetBytes
    Case 1
      var s=cptr(ubyte ptr,pSource)
      var t=cptr(ubyte ptr,pTarget)+yStart*TargetPitch+xStart
      var e=t+(xEnd-xStart)
      If Transparent=false Then
        While t<e
          *t=*(s+V.h*SourcePitch+U.h)
          V.v+=VS.v : U.v+=US.v : t+=1
        Wend
      Else
        While t<e
          dim as ubyte c=*(s+V.h*SourcePitch+U.h)
          If c Then *t=c
          V.v+=VS.v : U.v+=US.v : t+=1
        Wend
      End If
    Case 2
      var s=cptr(ushort ptr,pSource)
      var t=cptr(ushort ptr,pTarget)+yStart*TargetPitch+xStart
      var e=t+(xEnd-xStart)
      If Transparent=false Then
        While t<e
          *t=*(s+V.h*SourcePitch+U.h)
          V.v+=VS.v : U.v+=US.v : t+=1
        Wend
      Else
        While t<e
          dim as ushort c=*(s+V.h*SourcePitch+U.h)
          If c<>&HF81F Then *t=c
          V.v+=VS.v : U.v+=US.v : t+=1
        Wend
      End If
    Case 4
      var s=cptr(ulong ptr,pSource)
      var t=cptr(ulong ptr,pTarget)+yStart*TargetPitch+xStart
      var e=t+(xEnd-xStart)
      If Transparent=false Then
        While t<e
          *t=*(s+V.h*SourcePitch+U.h)
          V.v+=VS.v : U.v+=US.v : t+=1
        Wend
      Else
        While t<e
          dim as ulong c=*(s+V.h*SourcePitch+U.h)
          If c<>&HFFFF00FF Then *t=c
          V.v+=VS.v : U.v+=US.v : t+=1
        Wend
      End If
    End Select

  NextScanLine:
    yStart+=1 : If yStart=TargetHeight Then exit while
    fEdges(_LeftIndex_ ,_EdgeXStart_)+=fEdges(_LeftIndex_ ,_EdgeXStep_)
    fEdges(_LeftIndex_ ,_EdgeUStart_)+=fEdges(_LeftIndex_ ,_EdgeUStep_)
    fEdges(_LeftIndex_ ,_EdgeVStart_)+=fEdges(_LeftIndex_ ,_EdgeVStep_)
    fEdges(_RightIndex_,_EdgeXStart_)+=fEdges(_RightIndex_,_EdgeXStep_)
    fEdges(_RightIndex_,_EdgeUStart_)+=fEdges(_RightIndex_,_EdgeUStep_)
    fEdges(_RightIndex_,_EdgeVStart_)+=fEdges(_RightIndex_,_EdgeVStep_)
  Wend
End Sub
#endif ' __MULTIPUT_BI__
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Another Tetris

Post by Tourist Trap »

This variant is far from boring, it's really going in the good way. I personally never liked tetris, but with the rotation it's more like the rubbics cube dynamics, I like it.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Another Tetris

Post by BasicCoder2 »

badidea wrote:Most annoying Tetris variant ever?
When Tetris first came out on one of those little hand held consoles I was hooked on it for maybe a couple of weeks before I got sick of it.
It has the important ingredients of being easy to learn to play but hard to get a high score.
Your variation plays well and adds something to the game. Is there any other variations you know of?
Now if only FB had sound commands ...
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Another Tetris

Post by badidea »

BasicCoder2 wrote:Now if only FB had sound commands ...
Yes, then I could add some annoying music as well.

The next variant I have in mind is still secret :-) It will be more work then this twisted version. Currently just an idea which might be a bad idea.

Until ready, here's another puzzle game to keep you busy: Small puzzle game.
Requires #lang "fblite" and may not work with 64-bit fbc (colour = integer).
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Another Tetris

Post by BasicCoder2 »

badidea wrote:... here's another puzzle game to keep you busy: Small puzzle game.
Requires #lang "fblite" and may not work with 64-bit fbc (colour = integer).
A couple of tweaks and it works without fblite and changing integer to ulong is simple enough.
Dr_D
Posts: 2451
Joined: May 27, 2005 4:59
Contact:

Re: Another Tetris

Post by Dr_D »

That thing with the rotation is cool. That is super creative!
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Another Tetris

Post by badidea »

Thanks. I wanted to continue with it, but got distracted by other stuff (as usual).
Jos'b
Posts: 17
Joined: Apr 25, 2007 17:53

Re: Another Tetris

Post by Jos'b »

Wow, it is very imaginative tetris. I miss some colours and music to be perfect but It deserves a place in my hard disk. Regarding games I prefer simple concept and original ideas instead of intricates plots. A game is simply for spending your spare time.

Good job
Post Reply