The world needs more tetris

[badidea]

A new variant in development, I call it: Tetrisame (from Tetris + SameGame)
As you will see, the goal is not to make lines, but same color shapes >= 4 blocks. Floating 'leftovers' will drop afterwards.
Github link: https://github.com/verybadidea/tetrisame
Single file version:

Code: Select all

'* Initial date = 2023-08-17
'* Fbc = 1.09.0, 32/64-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: ????

Const As Integer SCREEN_W = 800
Const As Integer SCREEN_H = SCREEN_W
Width SCREEN_W \ 8, SCREEN_H \ 16

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_DARK_RED = &h00A02020
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

Sub panic(text As String)
	ScreenUnLock()
	Print "Panic: " & text
	GetKey()
	End -1
End Sub

Sub imageKill(p_img As Any Ptr)
	ImageDestroy(p_img)
	p_img = 0
End Sub

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 int2d
	'~ dim as integer x, y
'~ end type

'~ operator + (v1 as int2d, v2 as int2d) as int2d
	'~ 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_P = &h50
Const As UShort KEY_P = &h70
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

'===============================================================================

Type sgl2d_fwd As sgl2d
Type int2d_fwd As int2d

Type int2d
	Dim As Integer x, y
	'declare constructor
	'declare constructor(x as integer, y as integer)
	Declare Operator Cast () As String
	'~ declare operator cast () byref as sgl2d_fwd
	'~ declare operator let (v as sgl2d_fwd)
End Type

'~ constructor int2d
'~ end constructor

'~ constructor int2d(x as integer, y as integer)
	'~ this.x = x : this.y = y
'~ end constructor

Type sgl2d
	Dim As Single x, y
	Declare Operator Cast () As String
	'~ declare operator cast () byref as int2d_fwd
	'~ declare operator let (v as int2d_fwd)
End Type

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

Operator int2d.cast () As String
	Return "(" & Str(x) & "," & Str(y) & ")"
End Operator

'~ operator int2d.cast () byref as sgl2d
	'~ static as sgl2d temp
	'~ temp.x = x
	'~ temp.y = y
	'~ return temp
'~ end operator

'~ operator int2d.let (v as sgl2d)
	'~ x = cint(v.x)
	'~ y = cint(v.y)
'~ end operator

Operator = (a As int2d, b As int2d) As boolean
	If a.x <> b.x Then Return false
	If a.y <> b.y Then Return false
	Return true
End Operator

Operator + (v1 As int2d, v2 As int2d) As int2d
	Return Type(v1.x + v2.x, v1.y + v2.y)
End Operator

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

Operator sgl2d.cast () As String
	Return "(" & Str(x) & "," & Str(y) & ")"
End Operator

'~ operator sgl2d.cast () byref as int2d
	'~ static as int2d temp
	'~ temp.x = cint(x)
	'~ temp.y = cint(y)
	'~ return temp
'~ end operator

'~ operator sgl2d.let (v as int2d)
	'~ x = v.x
	'~ y = v.y
'~ end operator

Operator + (v1 As sgl2d, v2 As sgl2d) As sgl2d
	Return Type(v1.x + v2.x, v1.y + v2.y)
End Operator

Operator * (v As sgl2d, mul As Single) As sgl2d
	Return Type(v.x * mul, v.y * mul)
End Operator

Function distSql(p1 As sgl2d, p2 As sgl2d) As Single
	Dim As Single dx = p1.x - p2.x
	Dim As Single dy = p1.y - p2.y
	Return Sqr(dx * dx + dy * dy)
End Function 

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

Function toInt2d(v As sgl2d) As int2d
	Return Type(Int(v.x), Int(v.y))
End Function

Function toCint2d(v As sgl2d) As int2d
	Return Type(CInt(v.x), CInt(v.y))
End Function

Function toSgl2d(v As int2d) As sgl2d
	Return Type(v.x, v.y)
End Function

'===============================================================================

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()
	Declare Sub pause()
	Declare Sub unpause()
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 to original tStart
Sub timer_type.restart()
	tStart = tEnd
	tEnd = tStart + tSpan
	active = 1
End Sub

Sub timer_type.pause()
	active = 0
End Sub

Sub timer_type.unpause()
	tStart = Timer()
	tEnd = tStart + tSpan
	active = 1
End Sub

'===============================================================================

	'contains all piece tiles in all rotations + unrotated base_piece tiles

Const As Integer N_SHAPES = 7
Const As Integer N_COLORS = 4 'N_SHAPES
Const As Integer N_TILES = 4

Const As Integer T_I = 0
Const As Integer T_J = 1
Const As Integer T_L = 2
Const As Integer T_O = 3
Const As Integer T_S = 4
Const As Integer T_T = 5
Const As Integer T_Z = 6

Dim Shared As Const ULong colors(N_SHAPES-1) = {_ 'req: N_SHAPES >= N_COLORS
	&h00F0F0,_ 'lightblue
	&h0000F0,_ 'blue
	&hF0A000,_ 'orange
	&hF0F000,_ 'yellow
	&h00F000,_ 'green
	&HA000F0,_ 'purple
	&hF00000}  'red

Type all_pieces
	Dim As int2d baseTilePos(N_SHAPES-1, N_TILES-1) = _
	{_
		 {( 0, 1), ( 1, 1), ( 2, 1), ( 3, 1)}, _ 'I
		 {( 0, 0), ( 0, 1), ( 1, 1), ( 2, 1)}, _ 'J
		 {( 2, 0), ( 0, 1), ( 1, 1), ( 2, 1)}, _ 'L
		 {( 0, 0), ( 0, 1), ( 1, 0), ( 1, 1)}, _ 'O
		 {( 1, 0), ( 2, 0), ( 0, 1), ( 1, 1)}, _ 'S
		 {( 1, 0), ( 0, 1), ( 1, 1), ( 2, 1)}, _ 'T
		 {( 0, 0), ( 1, 0), ( 1, 1), ( 2, 1)}  _ 'Z
	}
	Dim As int2d offsetPos(N_SHAPES-1) = _
		{( 0, 0), ( 0, 0), ( 0, 0), ( 1, 0), ( 0, 0), ( 0, 0), ( 0, 0)}
	Dim As Integer areaSize(N_SHAPES-1) = _
		{4, 3, 3, 2, 3, 3, 3}
End Type

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

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

'~ dim shared as const ulong pieceColor(NUM_PIECES-1) = {&h00FFFF00, &h0000FFFF, _
	'~ &h0000FF00, &h00FF0000, &h00FFAA00, &h000000FF, &h009900FF}

'~ dim shared as const ulong pieceColor(NUM_PIECES-1) = {_
	'~ &h00F0F0,_ 'lightblue
	'~ &h0000F0,_ 'blue
	'~ &hF0A100,_ 'orange
	'~ &hF0F000,_ 'yellow
	'~ &h00E000,_ 'green
	'~ &H922B8C,_ 'purple
	'~ &hF00000}  'red

'~ 'Official colors:
'~ ' Yellow O
'~ ' Cyan I
'~ ' Green S
'~ ' Red Z
'~ ' Orange L
'~ ' Blue J
'~ ' Purple T

'~ type pieces_type
	'~ private:
	'~ dim as int2d baseTilePos(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 int2d tilePos(NUM_PIECES-1, NUM_ORIENT-1, NUM_SQUARES-1)
	'~ dim as integer orientation(NUM_PIECES-1) = {1, 2, 2, 2, 4, 4, 4}
	'~ public:
	'~ 'functions/subs
	'~ declare function rotatedSquare(orientation as integer, p as int2d) as int2d
	'~ declare sub init()
	'~ declare function getSquarePos(iPiece as integer, iOrient as integer, _
		'~ iSquare as integer) as int2d
'~ end type

'~ 'get grid position of 1 square for a specified rotation
'~ function pieces_type.rotatedSquare(orientation as integer, p as int2d) as int2d
	'~ 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 orientation(iPiece)
				'~ tilePos(iPiece, iOrient, iSquare) = _
				'~ rotatedSquare(iOrientMod, baseTilePos(iPiece, iSquare))
			'~ next
		'~ next
	'~ next
'~ end sub

'~ function pieces_type.getSquarePos(iPiece as integer, iOrient as integer, _
	'~ iSquare as integer) as int2d
	'~ return tilePos(iPiece, iOrient, iSquare)
'~ end function

'===============================================================================

Type piece_type
	Public:
	Dim As Integer alive
	Dim As int2d position
	Dim As ULong tileColor(0 To 3)
	Dim As int2d tilePos(0 To 3) 'relative to piecePos
	Dim As int2d offsetPos
	Dim As Integer areaSize
	Public:
	Declare Sub init(shape As Integer, allPieces As all_pieces)
	Declare Sub rotRight()
	Declare Sub rotLeft()
	Declare Function getTilePos(tileNum As Integer) As int2d
	Declare Sub disable()
End Type

Sub piece_type.init(shape As Integer, allPieces As all_pieces)
	alive = true
	If shape = -1 Then shape = Int(Rnd * N_SHAPES) 'choose a random one
	For iTile As Integer = 0 To 3
		tileColor(iTile) = colors(Int(Rnd * N_COLORS))
		tilePos(iTile) = allPieces.baseTilePos(shape, iTile)
	Next
	offsetPos = allPieces.offsetPos(shape)
	areaSize = allPieces.areaSize(shape)
	position.x = 3 + offsetPos.x 'for placement on a 10 wide board, left alignment
	position.y = -1 + offsetPos.y 'TO BE DEFINED !!!
End Sub

Sub piece_type.rotRight()
	Dim As piece_type clone
	clone = This
	Dim As Integer tileBound = areaSize - 1
	For i As Integer = 0 To 3
		tilePos(i).x = tileBound - clone.tilePos(i).y
		tilePos(i).y = clone.tilePos(i).x
		tileColor(i) = clone.tileColor(i)
	Next
End Sub

Sub piece_type.rotLeft()
	Dim As piece_type clone
	clone = This
	Dim As Integer tileBound = areaSize - 1
	For i As Integer = 0 To 3
		tilePos(i).x = clone.tilePos(i).y
		tilePos(i).y = tileBound - clone.tilePos(i).x
		tileColor(i) = clone.tileColor(i)
	Next
End Sub

Function piece_type.getTilePos(tileNum As Integer) As int2d
	Return position + tilePos(tileNum)
End Function

Sub piece_type.disable()
	alive = false
End Sub

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

'~ 'Does not contain the tile positions itself

'~ const as integer NUM_SQUARES = 4
'~ const as integer NUM_ORIENT = 4
'~ const as integer NUM_PIECES = 7
'~ const as integer NUM_COLORS = NUM_PIECES

'~ type piece_type
	'~ dim as int2d p 'grid postion index (central piece position)
	'~ dim as integer id, rot 
	'~ public:
	'~ dim as integer colorIdx(NUM_SQUARES-1)  'color index
	'~ declare sub init(gridPos as int2d, iPiece as integer, iOrient as integer, iColor as integer)
	'~ declare sub disable()
'~ end type

'~ sub piece_type.init(gridPos as int2d, iPiece as integer, iOrient as integer, iColor as integer)
	'~ p.x = gridPos.x
	'~ p.y = gridPos.y
	'~ id  = iif(iPiece = -1, int(rnd * NUM_PIECES), iPiece)
	'~ rot = iif(iOrient = -1, int(rnd * NUM_ORIENT), iOrient)
	'~ for i as integer = 0 to NUM_SQUARES-1
		'~ colorIdx(i) = iif(iColor = -1, int(rnd * NUM_COLORS), iColor)
	'~ next
'~ end sub

'~ sub piece_type.disable
	'~ id = -1
'~ end sub

'===============================================================================

Const As Long BLOCK_INVALID = -1
Const As Long BLOCK_FREE = 0
'const as long BLOCK_FIXED = 1
Const As Long BLOCK_PIECE = 2
Const As Long BLOCK_MARKED = 3
'const as long BLOCK_RES = 32
Const As Short BLOCK_FAIL = 64
Const As Short BLOCK_CHECK = 128

Const MAX_TETRO = 20 'used in tetro search

#Define TILE_T Long
#Define TILE_C ULong

Type tile_type
	Dim As TILE_T tType ', colorIdx
	Dim As TILE_C tColor
End Type

Operator =(ByRef a As tile_type, ByRef b As tile_type) As Integer
	Return ((a.tType = b.tType) And (a.tColor = b.tColor))
End Operator

Type board_type
	Private:
	Const As Integer GRID_YSZ = 20
	Const As Integer GRID_XSZ = 10
	Const As Integer GRID_SIZE = SCREEN_H \ GRID_YSZ 'size of squares
	Const As Integer GRID_XOFFS = (SCREEN_W - GRID_XSZ * GRID_SIZE) \ 2 'offset on screen
	Const As Integer GRID_YOFFS = (SCREEN_H - GRID_YSZ * GRID_SIZE) \ 2 'offset on screen
	'variables:
	Dim As tile_type tile(GRID_XSZ-1, -2 To GRID_YSZ-1) 'block type & color index
	Public:
	Declare Sub init()
	Declare Sub drawBoard()
	Declare Sub drawTile(x As Integer, y As Integer, tile As tile_type)
	Declare Sub drawTilePos(pos_ As int2d, tile As tile_type)
	Declare Function onBoard(x As Integer, y As Integer) As Integer
	Declare Function getWidth() As Integer
	Declare Function getHeight() As Integer
	Declare Function getSize() As int2d
	Declare Function getInfo(id As Integer) As Integer
	Declare Sub setTile(x As Integer, y As Integer, tile As tile_type)
	Declare Sub setTileType(x As Integer, y As Integer, tt As TILE_T)
	'~ declare sub setTileC(x as integer, y as integer, c as ulong)
	Declare Sub setTilePos(pos_ As int2d, tile As tile_type)
	Declare Function getTile(x As Integer, y As Integer) As tile_type
	Declare Function getTileType(x As Integer, y As Integer) As TILE_T
	'declare function checkHorzLine(yiCheck as integer) as integer
	'declare sub markHorzLine(yiMark as integer)
	'declare sub moveHorzLines(yiRemove as integer)
	'declare function checkLines() as integer
	'declare function removeLines() as integer
	Declare Sub replaceType(fromType As Integer, toType As Integer)
	Declare Function checkTetro() As Integer
	Declare Sub removeTetro()
	Declare Function floodFill(x As Integer, y As Integer, c As ULong) As Integer
End Type

'Can be converted to constructor
Sub board_type.init()
	For yi As Integer = -2 To GRID_YSZ-1
		For xi As Integer = 0 To GRID_XSZ-1
			tile(xi, yi) = Type(BLOCK_FREE, -1) '&hffffffff
		Next
	Next
End Sub

Sub board_type.drawBoard()
	For xi As Integer = 0 To GRID_XSZ-1
		For yi As Integer = 0 To GRID_YSZ-1
			Dim As tile_type tile = getTile(xi, yi)
			'dim as ulong c = &hF0F0F0
			'~ select case tile.tType
			'~ case BLOCK_PIECE, BLOCK_MARKED
				'~ c = pieceColor(tile.colorIdx)
			'~ end select
			'drawSquare(xi, yi, tile.tType, c)
			drawTile(xi, yi, tile)
		Next
	Next
End Sub

'Position (x,y) = grid position
Sub board_type.drawTile(x As Integer, y As Integer, tile As tile_type)
	If inRange(x, 0, GRID_XSZ-1) And inRange(y, 0, GRID_YSZ-1) Then
		Dim As Integer xScrn = GRID_XOFFS + x * GRID_SIZE
		Dim As Integer yScrn = GRID_YOFFS + y * GRID_SIZE
		'get color
		Dim As ULong c = &hF0F0F0
		Select Case tile.tType
		Case BLOCK_PIECE, BLOCK_MARKED
			'c = colors(tile.colorIdx)
			c = tile.tColor
		End Select
		'draw gray border always
		Line(xScrn, yScrn)-step(GRID_SIZE-1, GRID_SIZE-1), C_DARK_GRAY, b
		Select Case tile.tType 
		Case BLOCK_PIECE
			Line(xScrn + 1, yScrn + 1)-step(GRID_SIZE-3, GRID_SIZE-3), c, bf
		Case BLOCK_MARKED
			Line(xScrn + 1, yScrn + 1)-step(GRID_SIZE-3, GRID_SIZE-3), c, b
			Line(xScrn + 2, yScrn + 2)-step(GRID_SIZE-5, GRID_SIZE-5), c, b
			Line(xScrn + 3, yScrn + 3)-step(GRID_SIZE-7, GRID_SIZE-7), c, b
		'~ case BLOCK_RES
			'~ line(xScrn + 3, yScrn + 3)-step(GRID_SIZE-7, GRID_SIZE-7), c, bf
		Case Else
			'not good, unknown block type
		End Select
	Else
		'not good, outside grid
		'panic("drawSquare"), don't panic, just skip, can be 2 lines above
	End If
End Sub

Sub board_type.drawTilePos(pos_ As int2d, tile As tile_type)
	drawTile(pos_.x, pos_.y, tile)
End Sub

Function board_type.onBoard(x As Integer, y As Integer) As Integer
	If Not inRange(x, 0, GRID_XSZ-1) Then Return false
	If Not inRange(y, -2, GRID_YSZ-1) Then Return false
	Return true
End Function

Function board_type.getWidth() As Integer
	Return GRID_XSZ
End Function

Function board_type.getHeight() As Integer
	Return GRID_YSZ
End Function

Function board_type.getSize() As int2d
	Return Type(GRID_XSZ, GRID_YSZ)
End Function

Function board_type.getInfo(id As Integer) As Integer
	Select Case id
	Case 0: Return GRID_SIZE
	Case 1: Return GRID_XOFFS 'left
	Case 2: Return GRID_YOFFS 'top
	Case 3: Return GRID_XOFFS + GRID_XSZ * GRID_SIZE 'right
	Case 4: Return GRID_YOFFS + GRID_YSZ * GRID_SIZE 'bottom
	Case Else 'panic("board_type.getBoardEdge")
	End Select
End Function

Sub board_type.setTile(x As Integer, y As Integer, tile_ As tile_type)
	If onBoard(x, y) Then tile(x, y) = tile_
End Sub

Sub board_type.setTileType(x As Integer, y As Integer, bt As Long)
	If onBoard(x, y) Then tile(x, y).tType = bt
End Sub

'~ sub board_type.setTileColor(x as integer, y as integer, c as ulong)
	'~ if onBoard(x, y) then tile(x, y).tColor = c
'~ end sub

Sub board_type.setTilePos(pos_ As int2d, tile As tile_type)
	setTile(pos_.x, pos_.y, tile)
End Sub

Function board_type.getTile(x As Integer, y As Integer) As tile_type
	If Not onBoard(x, y) Then
		'panic("getTileType")
		Return Type(BLOCK_INVALID, -1)
	Else
		Return tile(x, y)
	End If
End Function

Function board_type.getTileType(x As Integer, y As Integer) As TILE_T
	If Not onBoard(x, y) Then
		'panic("getTileType")
		Return BLOCK_INVALID
	Else
		Return tile(x, y).tType
	End If
End Function

'~ function board_type.checkHorzLine(yiCheck as integer) as integer
	'~ dim as integer xi
	'~ for xi = 0 to GRID_XSZ-1
		'~ if getTile(xi, yiCheck).tType = BLOCK_FREE then return false
	'~ next
	'~ return true 'complete line
'~ end function

'~ 'move all lines 1 down from yiRemove and above
'~ sub board_type.moveHorzLines(yiRemove as integer)
	'~ dim as integer xi, yi
	'~ for yi = yiRemove to 1 step -1
		'~ for xi = 0 to GRID_XSZ-1
			'~ if not onBoard(xi, yi) then panic("moveHorzLines")
			'~ setTile(xi, yi, getTile(xi, yi - 1))
		'~ next
	'~ next
'~ end sub

'~ sub board_type.markHorzLine(yiMark as integer)
	'~ dim as integer xi
	'~ for xi = 0 to GRID_XSZ-1
		'~ if not onBoard(xi, yiMark) then panic("markHorzLine")
		'~ 'setTile(xi, yiMark, type(BLOCK_MARKED, -1))
		'~ tile(xi, yiMark).tType = BLOCK_MARKED
	'~ next
'~ end sub

'~ 'find and mark complete lines
'~ function board_type.checkLines() as integer
	'~ dim as integer yi, xi
	'~ dim as integer numLines = 0
	'~ 'from bottom to top
	'~ for yi = GRID_YSZ-1 to -2 step -1
		'~ if checkHorzLine(yi) then
			'~ numLines += 1
			'~ markHorzLine(yi)
		'~ end if
	'~ next
	'~ return numLines
'~ end function

'~ 'check and move lines, return number of lines removed
'~ function board_type.removeLines() as integer
	'~ dim as integer xi, yi
	'~ dim as integer numLines = 0
	'~ 'loop bottom to top
	'~ for yi = GRID_YSZ-1 to -2 step -1
		'~ 'check complete horizontal line
		'~ if checkHorzLine(yi) then
			'~ moveHorzLines(yi)
			'~ numLines += 1
			'~ yi += 1 'recheck this line
		'~ end if
	'~ next
	'~ return numLines
'~ end function

Sub board_type.replaceType(fromType As Integer, toType As Integer)
	For yi As Integer = GRID_YSZ-1 To -2 Step -1
		For xi As Integer  = 0 To GRID_XSZ-1
			If tile(xi, yi).tType = fromType Then
				tile(xi, yi).tType = toType
			End If
		Next
	Next
End Sub

'find and mark neighbouring blocks sections
Function board_type.checkTetro() As Integer
	Dim As int2d tetroPos(0 To MAX_TETRO-1)
	Dim As Integer xi, yi, numTiles, numTetro = 0
	Dim As ULong c
	'loop bottom to top, find and count tetrominoes+ (4-tile piece or larger)
	For yi = GRID_YSZ-1 To -2 Step -1
		For xi = 0 To GRID_XSZ-1
			If tile(xi, yi).tType = BLOCK_PIECE Then
				c = tile(xi, yi).tColor
				numTiles = floodFill(xi, yi, c)
				If numTiles >= 4 Then
					tetroPos(numTetro) = Type(xi, yi)
					numTetro += 1
				End If
			End If
		Next
	Next
	'clear all again, tetro positions were saved
	replaceType(BLOCK_MARKED, BLOCK_PIECE)
	'run the recursive thing again on listed positions
	For iTetro As Integer = 0 To numTetro-1
		xi = tetroPos(iTetro).x
		yi = tetroPos(iTetro).y
		If tile(xi, yi).tType = BLOCK_PIECE Then
			c = tile(xi, yi).tColor
			numTiles = floodFill(xi, yi, c)
		End If
	Next
	'if no tetrominoes+ found, clear marks
	'if numTetro = 0 then clearMarked()
	Return numTetro
End Function

Sub board_type.removeTetro()
	'replaceType(BLOCK_MARKED, BLOCK_FREE)
	For yi As Integer = GRID_YSZ-1 To -2 Step -1
		For xi As Integer  = 0 To GRID_XSZ-1
			If tile(xi, yi).tType = BLOCK_MARKED Then
				tile(xi, yi) = Type(BLOCK_FREE, -1) '&hffffffff
			End If
		Next
	Next
End Sub

Function board_type.floodFill(x As Integer, y As Integer, c As ULong) As Integer
	Dim As Integer count
	Dim As tile_type matchTile = Type(BLOCK_PIECE, c)
	'mark this tile, prevent resursive loop
	tile(x, y).tType = BLOCK_MARKED
	'check neighbour tiles
	If onBoard(x + 1, y) AndAlso tile(x + 1, y) = matchTile Then count += floodFill(x + 1, y, c)
	If onBoard(x - 1, y) AndAlso tile(x - 1, y) = matchTile Then count += floodFill(x - 1, y, c)
	If onBoard(x, y + 1) AndAlso tile(x, y + 1) = matchTile Then count += floodFill(x, y + 1, c)
	If onBoard(x, y - 1) AndAlso tile(x, y - 1) = matchTile Then count += floodFill(x, y - 1, c)
	Return count + 1 'should return at least 1 if nothing else is found
End Function

'~ 'Drop all pieces not touching? Only floating parts? most natural!
'~ 'Make block lists & mark --> use additional map or reset afterwards?
'~ 'wait for all block lists to finish dropping? Easier with current dynamic list
'~ 'then check for complete lines
'~ function game_type.stirBlocks() as integer
	'~ 'create lists of blocks, loop all blocks
	'~ dim as integer bcNum, canMove, tType, count = 0
	'~ dim as int2d blockPos
	'~ for yi as integer = 0 to board.Y_DIM-1
		'~ for xi as integer = 0 to board.X_DIM-1
			'~ if board.getType(type(xi, yi)) = BLOCK_PIECE then
				'~ bcNum = bl.alloc() 'start a block list
				'~ with bl.bc(bcNum)
					'~ .speed = type(0, V_STIR_BLOCK)
					'~ .relPosCurrent = type(0, 0)
					'~ .absPosSource = type(xi, yi)
					'~ .relPosTarget = type(0, 1)
					'~ .addBlock(type(0, 0), board.getBlock(type(xi, yi))) 'first one at rel. pos 0,0
				'~ end with
				'~ checkBlocks(xi, yi, bcNum) 'resurve block search
				'~ 'check if dropable (all piece of section nothing below?)
				'~ canMove = 1
				'~ for iBlock as integer = 0 to bl.bc(bcNum).getSize() - 1
					'~ blockPos = toCint2d(bl.bc(bcNum).getAbsPosBlocks(iBlock))
					'~ tType = board.getType(type(blockPos.x, blockPos.y + 1))
					'~ if not(tType = BLOCK_FREE or tType = BLOCK_CHECK) then
						'~ canMove = 0
						'~ exit for
					'~ end if
				'~ next
				'~ if canMove = 1 then
					'~ 'remove from board + reserve position
					'~ for iBlock as integer = 0 to bl.bc(bcNum).getSize() - 1
						'~ blockPos = toCint2d(bl.bc(bcNum).getAbsPosBlocks(iBlock))
						'~ board.setType(blockPos, BLOCK_FREE)
						'~ board.setType(type(blockPos.x, blockPos.y + 1), BLOCK_RES)
					'~ next
					'~ count += 1
				'~ else
					'~ bl.bc(bcNum).cleanUp() 'remove from list
				'~ end if
			'~ end if
		'~ next
	'~ next
	'marked --> piece
	'~ for yi as integer = 0 to board.Y_DIM-1
		'~ for xi as integer = 0 to board.X_DIM-1
			'~ if board.getType(type(xi, yi)) = BLOCK_CHECK then
				'~ board.setType(type(xi, yi), BLOCK_PIECE)
			'~ end if
		'~ next
	'~ next
	'~ 'note: count can also be obtained form list length
	'~ return count
'~ end function

'===============================================================================

#Include Once "file.bi"

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 int2d size, half 
	Declare Sub create(sizeInit As int2d, colorInit As ULong)
	Declare Function createFromBmp(fileName As String) As Integer
	Declare Sub destroy()
	Declare Destructor()
End Type

Sub image_type.create(sizeInit As int2d, 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 int2d 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

'===============================================================================

Type bd_type 'block descriptor
	Dim As int2d relPos
	Dim As tile_type block
End Type

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

Type bc_type 'block collection class
	Public:
	Dim As boolean inUse
	Dim As int2d relPos 'relative to absPosSource
	Dim As bd_type bd(Any) 'positions relative to relPosCurrent 
	Dim As int2d absPosSource 'initial position ??????????????????????????????????
	Public:
	Declare Function getSize() As Integer
	'declare sub setSpeed(speed as sgl2d)
	Declare Sub cleanUp()
	Declare Sub addBlock(blockPos As int2d, block As tile_type)
	Declare Function getAbsPosBlocks(blockNum As Integer) As int2d
	Declare Function getBlock(blockNum As Integer) As tile_type
	'declare function update() as integer
	'declare sub copyToBoard(relPos as int2d, blockType as TILE_T, board as board_type)
	Declare Sub copyToBoard(relPos As int2d, board As board_type)
	Declare Function possible(checkPos As int2d, board As board_type) As boolean
	'declare sub extendTarget()
End Type

Function bc_type.getSize() As Integer
	Return UBound(bd) + 1
End Function

Sub bc_type.cleanUp()
	inUse = false
	Erase bd
	relPos = Type(0, 0)
	absPosSource = Type(0, 0)
End Sub

Sub bc_type.addBlock(blockPos As int2d, block As tile_type)
	Dim As Integer ub = UBound(bd)
	ReDim Preserve bd(ub + 1)
	bd(ub + 1).relPos = blockPos
	bd(ub + 1).block = block
End Sub

Function bc_type.getAbsPosBlocks(blockNum As Integer) As int2d
	Dim As int2d blockPos
	If blockNum >= 0 And blockNum <= UBound(bd) Then
		blockPos = relPos + absPosSource + bd(blockNum).relPos
	End If
	Return blockPos
End Function

Function bc_type.getBlock(blockNum As Integer) As tile_type
	If blockNum >= 0 And blockNum <= UBound(bd) Then
		Return bd(blockNum).block
	End If
	Return Type(BLOCK_INVALID, -1)
End Function

'updates position of block collection
'return 1 on target position reached <-- IS REMOVED NOW
'~ function bc_type.update() as integer
	'~ if inUse = true then
		'~ relPosCurrent.y += 1
		'~ return 1
	'~ end if
	'~ return 0
'~ end function

'IS NIET GOED, moet ook tColor kopieren! ???
Sub bc_type.copyToBoard(relPos As int2d, board As board_type)
	Dim As int2d blockPos
	For iBlock As Integer = 0 To UBound(bd)
		blockPos = relPos + absPosSource + bd(iBlock).relPos
		board.setTile(blockPos.x, blockPos.y, bd(iBlock).block)
	Next
End Sub

'~ sub bc_type.copyToBoard(relPos as int2d, blockType as TILE_T, board as board_type)
	'~ dim as int2d blockPos
	'~ for iBlock as integer = 0 to ubound(bd)
		'~ 'blockPos = relPos + toSgl2d(absPosSource + bd(iBlock).relPos)
		'~ blockPos = relPos + absPosSource + bd(iBlock).relPos
		'~ if blockType = BLOCK_FREE or blockType = BLOCK_RES then
			'~ 'board.setType(toCint2d(blockPos), blockType)
			'~ board.setTileType(blockPos.x, blockPos.y, blockType)
		'~ elseif blockType = BLOCK_PIECE then
			'~ 'board.setBlock(toCint2d(blockPos), bd(iBlock).block)
			'~ board.setTile(blockPos.x, blockPos.y, bd(iBlock).block)
		'~ end if
	'~ next
'~ end sub

Function bc_type.possible(checkPos As int2d, board As board_type) As boolean
	Dim As int2d blockPos
	Dim As TILE_T blockType
	For iBlock As Integer = 0 To UBound(bd)
		blockPos = checkPos + absPosSource + bd(iBlock).relPos
		blockType = board.getTileType(blockPos.x, blockPos.y)
		If blockType <> BLOCK_FREE Then Return false
	Next
	Return true
End Function

'~ sub bc_type.extendTarget()
	'~ if inUse = true then
		'~ relPosTarget.y += 1
	'~ end if
'~ end sub

'===============================================================================

Type bcl_type 'block (collection) list class
	Public:
	Dim As bc_type bc(Any)
	Public:
	Declare Function getSize() As Integer
	Declare Function getUsed() As Integer
	Declare Function alloc() As Integer
	Declare Function free() As Integer
	'declare function free(index as integer) as integer
	Declare Sub show()
	Declare Function update(board As board_type) As Integer
	'~ declare sub changeDrop(vSpeed as single)
	Declare Sub drawBlocks(board As board_type)
End Type

Function bcl_type.getSize() As Integer
	Return UBound(bc) + 1
End Function

Function bcl_type.getUsed() As Integer
	Dim As Integer count = 0 
	For i As Integer = 0 To UBound(bc)
		If bc(i).inUse = true Then count += 1
	Next
	Return count
End Function

Function bcl_type.alloc() As Integer
	Dim As Integer index = -1
	Dim As Integer ub = UBound(bc)
	For i As Integer = 0 To ub
		If bc(i).inUse = false Then
			index = i
			Exit For
		End If
	Next
	If index < 0 Then
		ReDim Preserve bc(ub + 1)
		index = ub + 1
	End If
	bc(index).inUse = true
	Return index
End Function

Function bcl_type.free() As Integer
	For i As Integer = 0 To UBound(bc)
		bc(i).cleanUp()
	Next
	Return 0
End Function

Sub bcl_type.show()
	For i As Integer = 0 To UBound(bc)
		Print "list index: " & Str(i)
		'bc(i).show()
		Print
	Next
End Sub

'update position of block sections
'copy to board if next position not possible
Function bcl_type.update(board As board_type) As Integer
	Dim As Integer blUpdate = 0
	For iBc As Integer = 0 To getSize()-1
		'update position
		With bc(iBc)
			If .inUse Then
				.relPos.y += 1 'move down
				'check further drop possible
				If .possible(.relPos + Type(0, 1), board) Then
					'nothing, chack next update again
				Else
					.copyToBoard(.relPos, board)
					.cleanUp() 'remove from list
					blUpdate = 1
				End If
			End If
		End With
	Next
	Return blUpdate
End Function

'draw all alive block collections on board
Sub bcl_type.drawBlocks(board As board_type)
	For iBc As Integer = 0 To getSize()-1
		If bc(iBc).inUse = true Then
			For iBlock As Integer = 0 To bc(iBc).getSize() - 1
				Dim As int2d blockPos = bc(iBc).getAbsPosBlocks(iBlock)
				Dim As tile_type tile = bc(iBc).getBlock(iBlock)
				board.drawTilePos(blockPos, tile)
			Next
		End If
	Next
End Sub

'~ function bcl_type.update(board as board_type) as integer
	'~ dim as integer blUpdate = 0
	'~ for iBc as integer = 0 to getSize()-1
		'~ 'update position
		'~ with bc(iBc)
			'~ 'check if target reached --> Now, move 1 step!!!
			'~ if .update() = 1 then '<-- always true now? -------- MOVE CURRENT 1 DOWN -----------
				'~ 'clear reservation
				'~ '.copyToBoard(.relPosCurrent, BLOCK_FREE, board) RESERVERING 1 tE lAAG wordt VREWIJDERD?
				'~ 'set next target
				'~ .extendTarget()
				'~ 'check next pos. possible
				'~ if .possible(.relPosTarget, board) then
					'~ 'set new reservation
					'~ .copyToBoard(.relPosTarget, BLOCK_RES, board) 
				'~ else
					'~ .copyToBoard(.relPosCurrent, BLOCK_PIECE, board)
					'~ .cleanUp() 'remove from list
					'~ blUpdate = 1
				'~ end if
			'~ end if
		'~ end with
	'~ next
	'~ return blUpdate
'~ end function

'~ sub bcl_type.changeDrop(vSpeed as single)
	'~ for iBc as integer = 0 to getSize()-1
		'~ with bc(iBc)
			'~ if .inUse = true then
				'~ 'check, only block collections dropping down
				'~ if .speed.x = 0 and .speed.y > 0 then
					'~ .speed.y = vSpeed
				'~ end if
			'~ end if
		'~ end with
	'~ next
'~ end sub

'===============================================================================

'message centered on screen
Sub showMsg(msgStr As String, c1 As ULong, c2 As ULong)
	Dim As Integer widthPx =  Len(msgStr) * 8
	Dim As Integer x = (SCREEN_W - widthPx) \ 2
	Dim As Integer y = (SCREEN_H - 16) \ 2
	Line(x-8,y-8)-step(widthPx + 16 - 1, 16 + 8 - 1), c2, bf
	Line(x-8,y-8)-step(widthPx + 16 - 1, 16 + 8 - 1), c1, b
	Draw String (x,y), msgStr, c1
End Sub

Enum playStateEnum
	psNewPiece
	psActivePlay
	psWaitDrop
	psCheckBoard
	psWaitClearLine
	psFloatDrop
	psPaused
	psEnd 'not used
End Enum

Dim Shared As String playStateStr(0 To psEnd)
playStateStr(0) = "psNewPiece"
playStateStr(1) = "psActivePlay"
playStateStr(2) = "psWaitDrop"
playStateStr(3) = "psCheckBoard"
playStateStr(4) = "psWaitClearLine"
playStateStr(5) = "psFloatDrop"
playStateStr(6) = "psPaused"
playStateStr(7) = "psEnd"

Type game_type
	Private:
	Dim As all_pieces allPieces
	Dim As piece_type piece
	Dim As image_type bgImg
	Dim As playStateEnum playState
	Dim As piece_type activePiece, nextPiece
	Dim As bcl_type bcl 'block collection list
	'public: 'TEMPORARY until gameloop in here game.bi
	Dim As board_type board
	Public:
	Declare Sub init()
	Declare Function loop_() As Integer
	Declare Sub drawScene()
	Declare Sub clearScreen()
	Declare Sub showAllPieces()
	Declare Sub gameOver()
	Declare Function piecePossible(piece As piece_type) As Integer
	Declare Sub wallKick(piece As piece_type)
	Declare Sub copyToBoard(piece As piece_type)
	Declare Sub drawPiece(piece As piece_type)
	Declare Sub showPiece(piece As piece_type, xOffs As Integer, yOffs As Integer, tileSize As Integer)
	Declare Function CheckFloat() As Integer
	Declare Function checkNeighbours(x As Integer, y As Integer, bcNum As Integer) As Integer
End Type

Sub game_type.init()
	'pieces.init()
	board.init()
	'bgImg.createFromBmp("res/Basil-cathedral-morning_800.bmp")
	bgImg.createFromBmp("res/radioactive_800.bmp")
	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 Sub

Function game_type.loop_() As Integer
	Dim As Integer quit = 0
	Dim As UShort keyCode
	Dim As timer_type gravTmr, clearTmr
	Dim As piece_type movedPiece
	Dim As all_pieces allPieces
	'dim as integer dropActive
	'dim as integer requestNewPiece = true
	Dim As Integer score, lineCount, tetroCount, floatCount

	playState = psNewPiece
	nextPiece.init(-1, allPieces)
	Do
		keyCode = pollKeyCode()

		If playState = psNewPiece Then
			'if requestNewPiece then
				'~ 'requestNewPiece = false
				'~ 'activePiece.init(type(game.board.getWidth()\2, 0), -1, 0, -1)
				'activePiece.init(-1, allPieces)
				activePiece = nextPiece
				nextPiece.init(-1, allPieces)
				If Not piecePossible(activePiece) Then quit = 1
				gravTmr.start(0.500)
			'end if
			playState = psActivePlay
		End If

		movedPiece = activePiece 'copy piece for location / orientation

		If playState = psPaused Then
			Select Case keyCode
				Case KEY_P
					gravTmr.unpause()
					playState = psActivePlay
					keyCode = 0 'hack, prevent repause in section below
				Case KEY_ESC
					quit = 1
				Case Else
				'...
			End Select
		End If

		If playState = psActivePlay Then
			Select Case keyCode
				Case KEY_LE
					movedPiece.position.x -= 1
				Case KEY_RI
					movedPiece.position.x += 1
				Case KEY_UP
					'movedPiece.rot = (movedPiece.rot + 1) mod NUM_ORIENT
					movedPiece.rotRight()
					wallKick(movedPiece)
				Case KEY_DN
					'movedPiece.rot = (movedPiece.rot + 3) mod NUM_ORIENT
					movedPiece.rotLeft()
					wallKick(movedPiece)
				Case KEY_SPACE
					playState = psWaitDrop 'disable user piece control
					gravTmr.start(0.025) 'drop faster
				Case KEY_P
					gravTmr.pause()
					playState = psPaused
				Case KEY_ESC
					quit = 1
				Case Else
				'...
			End Select
			'check move possible
			If piecePossible(movedPiece) Then
				activePiece = movedPiece 'update position
			Else
				movedPiece = activePiece 'reset moved piece, for next step
			End If
		End If

		If playState = psActivePlay Or playState = psWaitDrop Then
			'piece drop by timer
			If gravTmr.ended() Then
				movedPiece.position.y += 1
				'check drop possible
				If piecePossible(movedPiece) Then 'continue drop
					gravTmr.restart()
					activePiece = movedPiece
				Else
					copyToBoard(activePiece)
					activePiece.disable() 
					playState = psCheckBoard
					'dropActive = false
				End If
			End If
		End If
		
		If playState = psCheckBoard Then
			'piece has been dropped onto something
			tetroCount = board.checkTetro() 'and mark for visualisation
			If tetroCount > 0 Then
				clearTmr.start(0.500) 'remove section after this time
				playState = psWaitClearLine
			Else
				playState = psNewPiece
			End If
		End If

		If playState = psWaitClearLine Then
			If clearTmr.ended() Then
				score += tetroCount
				board.removeTetro() 'marked -> free
				'
				floatCount = checkFloat() 'find + remove + reserve + build list
				If floatCount > 0 Then
					clearTmr.start(0.250)
					playState = psFloatDrop
				Else
					playState = psNewPiece
				End If
			End If
		End If

		If playState = psFloatDrop Then
			If clearTmr.ended() Then
				bcl.update(board) 'move down and/or copy bl to board
				floatCount = bcl.getUsed()
				If floatCount > 0 Then
					clearTmr.start(0.250) 'stay in this play state
				Else
					'playState = psNewPiece
					'No recheck tetro !!!!!!
					playState = psCheckBoard
				End If
			End If
		End If

		ScreenLock
		clearScreen()
		drawScene()
		Locate 2, 2: Print "Score:"; score;
		Locate 4, 2: Print "State:"; playState; " " ;playStateStr(playState)
		Locate 6, 2: Print "Time: "; Time;
		Locate 8, 2: Print "floatCount:"; floatCount;
		ScreenUnLock
		Sleep 1,1
	Loop Until quit = 1
	Return quit
End Function

Sub game_type.drawScene()
	Put (0, 0), bgImg.pFbImg, PSet
	board.drawBoard()
	bcl.drawBlocks(board)
	showPiece(nextPiece, board.getInfo(3) + 50, 50, 32)
	If activePiece.alive Then drawPiece(activePiece)
	If playState = psPaused Then showMsg("PAUSED", C_WHITE, C_DARK_RED)
End Sub

Sub game_type.clearScreen()
	Line(0, 0) - (SCREEN_W-1, SCREEN_H-1), C_BLACK, bf
End Sub

'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<int2d>(5 + iPiece * 5, 5 + iOrient * 5), iPiece, iOrient)
			'~ piece.id = iPiece
			'~ piece.rot = iOrient
			'~ drawPiece(piece)
		'~ next
	'~ next
'~ end sub

'Game over animation, fill board to to bottom
Sub game_type.gameOver()
	Dim As int2d boardSize = board.getSize()
	Dim As tile_type tile
	For yi As Integer = boardSize.y-1 To 0 Step -1
		For xi As Integer  = 0 To boardSize.x-1
			tile = board.getTile(xi, yi)
			tile.tType = BLOCK_MARKED
			board.setTile(xi, yi, tile)
		Next
		ScreenLock
		clearScreen()
		drawScene()
		ScreenUnLock
		Sleep 25, 1
	Next
End Sub

'check if piece is possible on board
Function game_type.piecePossible(piece As piece_type) As Integer
	For iTile As Integer = 0 To 3
		Dim As Integer xi = piece.position.x + piece.tilePos(iTile).x
		Dim As Integer yi = piece.position.y + piece.tilePos(iTile).y
		If board.onBoard(xi, yi) = false Then Return false
		If board.getTileType(xi, yi) <> BLOCK_FREE Then Return false
	Next
	Return true
End Function

'test and shift piece (max 1 block/tile), after turn
Sub game_type.wallKick(piece As piece_type)
	Dim As Integer bw = board.getWidth()
	For iTest As Integer = 0 To 1 'run twice for long piece
		'check left/right (can't be both)
		For iTile As Integer = 0 To 3
			Dim As Integer xi = piece.position.x + piece.tilePos(iTile).x
			If xi < 0 Then
				piece.position.x += 1 'move piece right
				Exit For
			End If
			If xi >= bw Then
				piece.position.x -= 1 'move piece left
				Exit For
			End If
		Next
	Next
End Sub

'copy piece to board
Sub game_type.copyToBoard(piece As piece_type)
	For iTile As Integer = 0 To N_TILES-1
		Dim As int2d absTilePos = piece.getTilePos(iTile)
		Dim As ULong c = piece.tileColor(iTile)
		board.setTilePos(absTilePos, Type(BLOCK_PIECE, c))
	Next
End Sub

'draw teris 1 piece, multiple squares, on board
Sub game_type.drawPiece(piece As piece_type)
	For iTile As Integer = 0 To N_TILES-1
		Dim As int2d absTilePos = piece.getTilePos(iTile)
		Dim As ULong c = piece.tileColor(iTile)
		board.drawTilePos(absTilePos, Type(BLOCK_PIECE, c))
	Next
End Sub

'display anyway, at specified location and tile size
Sub game_type.showPiece(piece As piece_type, xScrn As Integer, yScrn As Integer, tileSize As Integer)
	For iTile As Integer = 0 To N_TILES-1
		Dim As int2d tilePos = piece.tilePos(iTile)
		Dim As ULong c = piece.tileColor(iTile)
		Dim As Integer x = xScrn + (tilePos.x + piece.offsetPos.x) * tileSize
		Dim As Integer y = yScrn + (tilePos.y + piece.offsetPos.y) * tileSize
		Line(x, y)-step(tileSize - 2, tileSize - 2), c, bf
	Next
End Sub

'Drop all pieces not touching? Only floating parts? most natural!
'Make block lists & mark --> use additional map or reset afterwards?
'wait for all block lists to finish dropping? Easier with current dynamic list
'then check for complete lines

'find + remove + reserve + build list
Function game_type.checkFloat() As Integer
	'create lists of blocks, loop all blocks
	Dim As Integer bcNum, floating, blockType, count = 0
	Dim As int2d blockPos
	For yi As Integer = 0 To board.getHeight() - 1
		For xi As Integer = 0 To board.getWidth() - 1
			If board.getTileType(xi, yi) = BLOCK_PIECE Then
				bcNum = bcl.alloc() 'start a block list
				With bcl.bc(bcNum)
					'.speed = type(0, V_STIR_BLOCK)
					.relPos = Type(0, 0)
					.absPosSource = Type(xi, yi)
					'.relPosTarget = type(0, 1)
					.addBlock(Type(0, 0), board.getTile(xi, yi)) 'first one at rel. pos 0,0
				End With
				'start resurve block search, add more neighbour blocks to list
				checkNeighbours(xi, yi, bcNum)
				'check if dropable (all piece of section with nothing below)
				floating = 1
				For iBlock As Integer = 0 To bcl.bc(bcNum).getSize() - 1
					blockPos = bcl.bc(bcNum).getAbsPosBlocks(iBlock)
					blockType = board.getTileType(blockPos.x, blockPos.y + 1)
					If Not(blockType = BLOCK_FREE Or blockType = BLOCK_CHECK) Then
						floating = 0
						Exit For
					End If
				Next
				'if floation section then remove from board & reserve position
				If floating = 1 Then
					For iBlock As Integer = 0 To bcl.bc(bcNum).getSize() - 1
						blockPos = bcl.bc(bcNum).getAbsPosBlocks(iBlock)
						'board.setTileType(blockPos.x, blockPos.y, BLOCK_FREE)
						board.setTile(blockPos.x, blockPos.y, Type(BLOCK_FREE, -1)) '&hffffffff = clear
						'board.setTileType(blockPos.x, blockPos.y + 1, BLOCK_RES) Waarom ???????????????
					Next
					count += 1
				Else
					bcl.bc(bcNum).cleanUp() 'remove from list (no floating)
				End If
			End If
		Next
	Next
	'restore all marked blocks to normal
	For yi As Integer = 0 To board.getHeight() - 1
		For xi As Integer = 0 To board.getWidth() - 1
			If board.getTileType(xi, yi) = BLOCK_CHECK Then
				board.setTileType(xi, yi, BLOCK_PIECE)
			End If
		Next
	Next
	'note: count can also be obtained from list length
	Return count
End Function

'resurve block search + mark, no check
Function game_type.checkNeighbours(x As Integer, y As Integer, bcNum As Integer) As Integer
	With bcl.bc(bcNum)
		If .getSize() > 0 Then 'skip first block here
			.addBlock(Type(x - .absPosSource.x, y - .absPosSource.y), board.getTile(x, y)) 'relative to source
		End If
	End With
	board.setTileType(x, y, BLOCK_CHECK)
	If board.getTileType(x - 1, y) = BLOCK_PIECE Then checkNeighbours(x - 1, y, bcNum)
	If board.getTileType(x + 1, y) = BLOCK_PIECE Then checkNeighbours(x + 1, y, bcNum)
	If board.getTileType(x, y - 1) = BLOCK_PIECE Then checkNeighbours(x, y - 1, bcNum)
	If board.getTileType(x, y + 1) = BLOCK_PIECE Then checkNeighbours(x, y + 1, bcNum)
	Return 0
End Function

'===============================================================================

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

Dim As game_type game

ScreenRes SCREEN_W, SCREEN_H, 32

Randomize(Timer())
'randomize (88)
game.init()
game.loop_()
game.gameOver()

'game.drawScene()

'game.showAllPieces() '<-- This is broken, pieces too large
'sleep 1000,1

Locate 4, 2: Print "Game ended, press any key."
waitKeyCode()

[D.J.Peters]

Good job so ar

Joshy

[neil]

Nice your puzzle games are addicting.

[badidea]

Nice your puzzle games are addicting.

Yes, I noticed this myself as well. I think the the human mind is more sensitive to quick small rewards/accomplishments then to larger less frequent large awards.

[Gh]

This tetris variant is more difficult but very good. It would be nice, if the score was visible in the last screen. I tried to save the score, but my programming skills are not good enough. Even better would be a score list (rank, name, score). Thank you very much for the game.

[dafhi]

cool! i noticed 'samegame' in desc .. once i got to playing and saw some blocks disappear, i got it. will def play again

[neil]

Here's another addictive game called Hexxagon.
https://hexxagon.com/