Another Tetris

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

Another Tetris

Postby badidea » Jan 20, 2018 10:27

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: 2383
Joined: Jun 02, 2015 16:24

Re: Another Tetris

Postby Tourist Trap » Jan 20, 2018 18:15

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

Re: Another Tetris

Postby badidea » Jan 20, 2018 23:44

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

Re: Another Tetris

Postby Roland Chastain » Jan 22, 2018 7:55

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

Re: Another Tetris

Postby badidea » Jan 25, 2018 0:45

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: 2383
Joined: Jun 02, 2015 16:24

Re: Another Tetris

Postby Tourist Trap » Jan 25, 2018 21:47

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: 3243
Joined: Jan 01, 2009 7:03

Re: Another Tetris

Postby BasicCoder2 » Jan 30, 2018 23:37

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: 907
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Another Tetris

Postby badidea » Jan 31, 2018 18:19

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: 3243
Joined: Jan 01, 2009 7:03

Re: Another Tetris

Postby BasicCoder2 » Jan 31, 2018 21:15

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: 2357
Joined: May 27, 2005 4:59
Contact:

Re: Another Tetris

Postby Dr_D » Apr 28, 2018 17:35

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

Re: Another Tetris

Postby badidea » Apr 28, 2018 22:04

Thanks. I wanted to continue with it, but got distracted by other stuff (as usual).

Return to “Game Dev”

Who is online

Users browsing this forum: No registered users and 2 guests