After the discussion about how to make a tetris game in the DBC forum, I decided to make one in DBP, and it took a record ~30 minutes
It should run on any resolution perfectly
A screeny:
Here is the code (Media-less, but you will need Cloggy's d3d plugin)
sync on : sync rate 80
type colour
r as byte
g as byte
b as byte
endtype
dim grid(9,19) as byte
dim piece(3,3) as byte
dim nextpiece(3,3) as byte
dim palette(7) as colour
palette(1).r = 0
palette(1).g = 255
palette(1).b = 255
palette(2).r = 0
palette(2).g = 0
palette(2).b = 255
palette(3).r = 255
palette(3).g = 200
palette(3).b = 100
palette(4).r = 255
palette(4).g = 255
palette(4).b = 0
palette(5).r = 0
palette(5).g = 255
palette(5).b = 0
palette(6).r = 200
palette(6).g = 50
palette(6).b = 255
palette(7).r = 255
palette(7).g = 0
palette(7).b = 0
global TileSize as integer
global Offset as integer
TileSize = screen height()/20
Offset = (screen width() - TileSize*10)/2
global posx as integer
global posy as integer
global lose as boolean
global TileFall as integer
global Score as integer
MakeTileImage(1)
sprite 1,0,0,1
set sprite 1,0,0
hide sprite 1
backdrop off
cls 0
LoadNewTile()
LoadNewTile()
do
DrawGrid()
DrawTiles()
DrawNextTiles()
mov = rightkey()-leftkey()
if mov
if countdown < 2
if countdown = 0
countdown = 50
else
countdown = 10
endif
inc posx,mov
if CheckCollision()
dec posx,mov
endif
else
dec countdown
endif
else
countdown = 0
endif
if nextmove = 0
nextmove = 50
inc posy
if CheckCollision()
dec posy
MergeTile()
CheckRows()
LoadNewTile()
endif
else
dec nextmove
endif
if upkey()
if nextrotate < 2
if nextrotate = 0
nextrotate = 80
else
nextrotate = 20
endif
RotateTile()
if CheckCollision()
RotateTile()
RotateTile()
RotateTile()
endif
else
dec nextrotate
endif
else
nextrotate = 0
endif
if downkey() and nextmove
dec nextmove
if nextmove then dec nextmove
if nextmove then dec nextmove
if nextmove then dec nextmove
endif
text 0,0,"FPS: "+str$(screen fps())
text 0,20,"Score: "+str$(Score)
sync
DrawBack()
if lose
Score = 0
ClearTiles()
LoadNewTile()
LoadNewTile()
lose = 0
endif
loop
function DrawGrid()
for y = 0 to 19
for x = 0 to 9
if grid(x,y)
DrawTile(x,y,grid(x,y))
endif
next x
next y
endfunction
function CheckRows()
count = 0
for y = 0 to 19
removerow = 1
for x = 0 to 9
if grid(x,y) = 0
removerow = 0
endif
next x
if removerow
inc count
DeleteRow(y)
endif
next y
inc Score,count*count*10
endfunction
function DeleteRow(row)
for x = 0 to 9
grid(x,row) = 0
next x
for i = 1 to TileSize-1 step 2
for y = 0 to 19
TileFall = 0
if y < row then TileFall = i
for x = 0 to 9
if grid(x,y)
DrawTile(x,y,grid(x,y))
endif
next x
next y
DrawNextTiles()
text 0,0,"FPS: "+str$(screen fps())
text 0,20,"Score: "+str$(Score)
sync
DrawBack()
next i
for y = row-1 to 0 step -1
for x = 0 to 9
grid(x,y+1) = grid(x,y)
next x
next y
TileFall = 0
endfunction
function DrawBack()
d3d_box 0,0,Offset,screen height(),d3d_rgba(0,0,0,20)
d3d_box Offset,0,Offset+TileSize*5,screen height(),d3d_rgba(25,25,25,20),d3d_rgba(0,0,0,20),d3d_rgba(50,50,50,20),d3d_rgba(25,25,25,20)
d3d_box Offset+TileSize*5,0,Offset+TileSize*10,screen height(),d3d_rgba(0,0,0,20),d3d_rgba(25,25,25,20),d3d_rgba(25,25,25,20),d3d_rgba(50,50,50,20)
d3d_box Offset+TileSize*10,0,screen width(),screen height(),d3d_rgba(0,0,0,20)
endfunction
function ClearTiles()
for y = 0 to 19
for x = 0 to 9
grid(x,y) = 0
next x
next y
cls 0
endfunction
function RotateTile()
local dim newlayout(3,3) as byte
for y = 0 to 3
for x = 0 to 3
newlayout(x,y) = piece(y,3-x)
next x
next y
for y = 0 to 3
for x = 0 to 3
piece(x,y) = newlayout(x,y)
next x
next y
endfunction
function CellInvalid(x,y)
if x < 0 then exitfunction 1
if y < 0 then exitfunction 1
if x > 9 then exitfunction 1
if y > 19 then exitfunction 1
endfunction 0
function DrawTile(x,y,i)
set sprite diffuse 1,palette(i).r,palette(i).g,palette(i).b
paste sprite 1,x*TileSize + Offset,y*TileSize + TileFall
endfunction
function DrawTiles()
for y = 0 to 3
for x = 0 to 3
if piece(x,y)
DrawTile(x+posx,y+posy,piece(x,y))
endif
next x
next y
endfunction
function DrawNextTiles()
for y = 0 to 3
for x = 0 to 3
if nextpiece(x,y)
DrawTile(x+11,y,nextpiece(x,y))
endif
next x
next y
endfunction
function CheckCollision()
for y = 0 to 3
for x = 0 to 3
if piece(x,y)
if CellInvalid(x+posx,y+posy)
exitfunction 1
else
if grid(x+posx,y+posy)
exitfunction 1
endif
endif
endif
next x
next y
endfunction 0
function MergeTile()
inc Score
for y = 0 to 3
for x = 0 to 3
if piece(x,y)
grid(x+posx,y+posy) = piece(x,y)
endif
next x
next y
endfunction
function MakeTileImage(id)
create bitmap id,TileSize,TileSize
d3d_box 0,0,TileSize,TileSize,rgb(200,200,200)
d3d_line 0,0,TileSize,0,rgb(255,255,255)
d3d_line 0,0,0,TileSize,rgb(255,255,255)
d3d_line TileSize,TileSize,TileSize,0,rgb(100,100,100)
d3d_line TileSize,TileSize,0,TileSize,rgb(100,100,100)
d3d_line 1,1,TileSize-1,1,rgb(255,255,255)
d3d_line 1,1,1,TileSize-1,rgb(255,255,255)
d3d_line TileSize-1,TileSize-1,TileSize-1,1,rgb(100,100,100)
d3d_line TileSize-1,TileSize-1,1,TileSize-1,rgb(100,100,100)
get image id,0,0,TileSize,TileSize,1
delete bitmap id
set current bitmap 0
endfunction
function ChooseRandomTile()
TileID = rnd(6)
select TileID
case 0 : restore Tile0 : endcase
case 1 : restore Tile1 : endcase
case 2 : restore Tile2 : endcase
case 3 : restore Tile3 : endcase
case 4 : restore Tile4 : endcase
case 5 : restore Tile5 : endcase
case 6 : restore Tile6 : endcase
endselect
endfunction
function LoadNewTile()
ChooseRandomTile()
for y = 0 to 3
for x = 0 to 3
piece(x,y) = nextpiece(x,y)
next x
next y
for y = 0 to 3
for x = 0 to 3
read nextpiece(x,y)
next x
next y
posx = 3
posy = 0
if CheckCollision()
lose = 1
endif
endfunction
Tile0:
data 0,0,1,0
data 0,0,1,0
data 0,0,1,0
data 0,0,1,0
Tile1:
data 0,0,2,0
data 0,0,2,0
data 0,2,2,0
data 0,0,0,0
Tile2:
data 0,3,0,0
data 0,3,0,0
data 0,3,3,0
data 0,0,0,0
Tile3:
data 0,0,0,0
data 0,4,4,0
data 0,4,4,0
data 0,0,0,0
Tile4:
data 0,0,0,0
data 0,0,5,5
data 0,5,5,0
data 0,0,0,0
Tile5:
data 0,0,0,0
data 0,6,6,6
data 0,0,6,0
data 0,0,0,0
Tile6:
data 0,0,0,0
data 7,7,0,0
data 0,7,7,0
data 0,0,0,0
.exe in 7-zip format is attached
[b]
