This is the original game 'Tetris' but written in DBC. All it needs is a 30x30 bitmap named "block.bmp" to be in the same folder as the code. One that I have made already is attached.
short:
set window on : set display mode 300,600,32 : hide mouse : sync on : sync rate 50 : load image "block.bmp",1 : gosub layout : dim board(9,20) : randomize timer() : do : if active = 0 : current = rnd(6) : active = 1 : xpos = 4 : ypos = 0 : endif : if (pressed = 0 or (pressed > 19 and toggle = 0)) and count > 0 : if rightkey() = 1 : inc xpos : endif : if leftkey() = 1 : dec xpos : endif : if pressed = 0 : if upkey() = 1
gosub turn : endif : endif : endif : if rot > 3 : rot = 0 : endif : if scancode() = 0 : pressed = 0 : else : inc pressed : inc toggle : if toggle > 3 : toggle = 0 : endif : endif : if count = 6 or count = 13 : if downkey() = 1 : inc ypos : endif : endif : if count = 0 : inc ypos : endif : inc count
if count > 19 : count = 0 : endif : for d = 0 to 4 : if rot = 0 : bx = shapes(current,d,0) : by = shapes(current,d,1) : endif : if rot = 1 : bx = 0-shapes(current,d,1) : by = shapes(current,d,0) : endif : if rot = 2 : bx = 0-shapes(current,d,0) : by = 0-shapes(current,d,1) : endif : if rot = 3 : bx = shapes(current,d,1) : by = 0-shapes(current,d,0) : endif : while (bx+xpos) < 0 : inc xpos : endwhile : while (bx+xpos) > 9 : dec xpos
endwhile : while (by+ypos) < 0 : inc ypos : endwhile : while board(bx+xpos,by+ypos) = 1 and stopping = 0 : if bx > 0 : dec xpos : else : inc xpos : endif : endwhile : next d : stopping = 0 : for d = 0 to 4 : if rot = 0 : bx = shapes(current,d,0) : by = shapes(current,d,1) : endif : if rot = 1 : bx = 0-shapes(current,d,1) : by = shapes(current,d,0) : endif : if rot = 2 : bx = 0-shapes(current,d,0) : by = 0-shapes(current,d,1)
endif : if rot = 3 : bx = shapes(current,d,1) : by = 0-shapes(current,d,0) : endif : if by+ypos > 19 : ypos = 19-by : stopped = 1 : endif : if by+ypos > -1 : if board(bx+xpos,by+ypos+1) = 1 : stopping = 1 : endif : if board(bx+xpos,by+ypos) = 1 : dec ypos : stopped = 1 : endif : endif : next d : if stopped = 1 : gosub fix : endif : stopped = 0 : for x = 0 to 9 : for y = 0 to 19
if board(x,y) : paste image 1,x*30,y*30 : endif : next y : next x : for b = 0 to 4 : if rot = 0 : bx = shapes(current,b,0) : by = shapes(current,b,1) : endif : if rot = 1 : bx = 0-shapes(current,b,1) : by = shapes(current,b,0) : endif : if rot = 2 : bx = 0-shapes(current,b,0) : by = 0-shapes(current,b,1) : endif : if rot = 3 : bx = shapes(current,b,1) : by = 0-shapes(current,b,0) : endif : paste image 1,(bx+xpos)*30,(by+ypos)*30 : next b : tlne = 0
for y = 0 to 19 : for x = 0 to 9 : if board(x,y) : inc nline : endif : next x : if nline > 9 : gosub rmv_ln : inc tlne : inc score,2 : endif : nline = 0 : next y : if tlne > 0 : inc score,((tlne-1)*5) : endif : sync : cls : loop : layout: : dim shapes(6,4,1) : shapes(0,0,0) = -1 : shapes(0,1,0) = 0 : shapes(0,2,0) = 0 : shapes(0,3,0) = 0
shapes(0,4,0) = 0 : shapes(0,0,1) = 1 : shapes(0,1,1) = 1 : shapes(0,2,1) = 0 : shapes(0,3,1) = -1 : shapes(0,4,1) = -2 : shapes(1,0,0) = 1 : shapes(1,1,0) = 0 : shapes(1,2,0) = 0 : shapes(1,3,0) = 0 : shapes(1,4,0) = 0 : shapes(1,0,1) = 1 : shapes(1,1,1) = 1 : shapes(1,2,1) = 0 : shapes(1,3,1) = -1 : shapes(1,4,1) = -2 : shapes(2,0,0) = -1 : shapes(2,1,0) = 0 : shapes(2,2,0) = 1 : shapes(2,3,0) = 0 : shapes(2,4,0) = 0 : shapes(2,0,1) = 0 : shapes(2,1,1) = 0 : shapes(2,2,1) = 0 : shapes(2,3,1) = 1
shapes(2,4,1) = 0 : shapes(3,0,0) = -1 : shapes(3,1,0) = 0 : shapes(3,2,0) = 0 : shapes(3,3,0) = 1 : shapes(3,4,0) = 0 : shapes(3,0,1) = 0 : shapes(3,1,1) = 0 : shapes(3,2,1) = 1 : shapes(3,3,1) = 1 : shapes(3,4,1) = 0 : shapes(4,0,0) = 1 : shapes(4,1,0) = 0 : shapes(4,2,0) = 0 : shapes(4,3,0) = -1 : shapes(4,4,0) = 0 : shapes(4,0,1) = 0 : shapes(4,1,1) = 0 : shapes(4,2,1) = 1 : shapes(4,3,1) = 1 : shapes(4,4,1) = 0 : shapes(5,0,0) = -2 : shapes(5,1,0) = -1 : shapes(5,2,0) = 0 : shapes(5,3,0) = 1
shapes(5,4,0) = 2 : shapes(5,0,1) = 0 : shapes(5,1,1) = 0 : shapes(5,2,1) = 0 : shapes(5,3,1) = 0 : shapes(5,4,1) = 0 : shapes(6,0,0) = 0 : shapes(6,1,0) = 1 : shapes(6,2,0) = 0 : shapes(6,3,0) = 1 : shapes(6,4,0) = 0 : shapes(6,0,1) = 0 : shapes(6,1,1) = 0 : shapes(6,2,1) = 1 : shapes(6,3,1) = 1 : shapes(6,4,1) = 0 : return : fix: : active = 0 : for d = 0 to 4 : if rot = 0 : bx = shapes(current,d,0) : by = shapes(current,d,1) : endif : if rot = 1
bx = 0-shapes(current,d,1) : by = shapes(current,d,0) : endif : if rot = 2 : bx = 0-shapes(current,d,0) : by = 0-shapes(current,d,1) : endif : if rot = 3 : bx = shapes(current,d,1) : by = 0-shapes(current,d,0) : endif : if by+ypos < 1 : gosub lose : endif : board(bx+xpos,by+ypos) = 1 : next d : return : rmv_ln: : for ty = y to 1 step -1 : for tx = 0 to 9 : board(tx,ty) = board(tx,ty-1) : next tx : next ty : for tx = 0 to 9 : board(tx,0) = 0
next tx : return : turn: : while turnable = 0 : inc rot : for d = 0 to 4 : if rot = 0 : bx = shapes(current,d,0) : by = shapes(current,d,1) : endif : if rot = 1 : bx = 0-shapes(current,d,1) : by = shapes(current,d,0) : endif : if rot = 2 : bx = 0-shapes(current,d,0) : by = 0-shapes(current,d,1) : endif : if rot = 3 : bx = shapes(current,d,1) : by = 0-shapes(current,d,0) : endif : if by+ypos > 19 : goto no : endif
if bx+xpos > 9 : mdst = 9-(bx+xpos) : gosub checkturn : if noturn = 1 : goto no : endif : endif : if bx+xpos < 0 : mdst = 0-(bx+xpos) : gosub checkturn : if noturn = 1 : goto no : endif : endif : if by+ypos > -1 : if board(bx+xpos,by+ypos) = 1 : if bx > 0 : mdst = 0 : while board(bx+xpos+mdst,by+ypos) = 1 : dec mdst : if bx+xpos+mdst < 0 : goto no : endif : endwhile : else
mdst = 0 : while board(bx+xpos+mdst,by+ypos) = 1 : inc mdst : if bx+xpos+mdst > 9 : goto no : endif : endwhile : endif : gosub checkturn : if noturn = 1 : goto no : endif : endif : endif : next d : turnable = 1 : no: : endwhile : turnable = 0 : return : checkturn: : noturn = 0 : for z = 0 to 4 : if rot = 0 : bx = shapes(current,z,0)
by = shapes(current,z,1) : endif : if rot = 1 : bx = 0-shapes(current,z,1) : by = shapes(current,z,0) : endif : if rot = 2 : bx = 0-shapes(current,z,0) : by = 0-shapes(current,z,1) : endif : if rot = 3 : bx = shapes(current,z,1) : by = 0-shapes(current,z,0) : endif : if board(bx+xpos+mdst,by+ypos) = 1 : noturn = 1 : endif : next z : return : lose: : cls 0 : while scancode() <> 0 : sync : endwhile : set display mode 900,200,32
increment = 2 : set text font "Arial" : set text size 100 : while scancode() = 0 : inc fade#,increment : if fade# = 254 : increment = -2 : endif : if fade# = 0 : increment = 2 : endif : ink rgb(fade#,fade#*0.7,fade#*0.2),0 : center text 450,100-(20+(fade#*0.2)),"Your score was: " + str$(score) : sync : endwhile : end
Long:
set window on : set display mode 300,600,32
hide mouse : sync on : sync rate 50
load image "block.bmp",1
gosub layout
dim board(9,20)
randomize timer()
do
if active = 0
current = rnd(6)
active = 1
xpos = 4
ypos = 0
endif
if (pressed = 0 or (pressed > 19 and toggle = 0)) and count > 0
if rightkey() = 1 then inc xpos
if leftkey() = 1 then dec xpos
if pressed = 0
if upkey() = 1 then gosub turn
endif
endif
if rot > 3 then rot = 0
if scancode() = 0
pressed = 0
else
inc pressed
inc toggle
if toggle > 3 then toggle = 0
endif
if count = 6 or count = 13
if downkey() = 1 then inc ypos
endif
if count = 0 then inc ypos
inc count
if count > 19 then count = 0
for d = 0 to 4
if rot = 0
bx = shapes(current,d,0)
by = shapes(current,d,1)
endif
if rot = 1
bx = 0-shapes(current,d,1)
by = shapes(current,d,0)
endif
if rot = 2
bx = 0-shapes(current,d,0)
by = 0-shapes(current,d,1)
endif
if rot = 3
bx = shapes(current,d,1)
by = 0-shapes(current,d,0)
endif
while (bx+xpos) < 0
inc xpos
endwhile
while (bx+xpos) > 9
dec xpos
endwhile
while (by+ypos) < 0
inc ypos
endwhile
while board(bx+xpos,by+ypos) = 1 and stopping = 0
if bx > 0
dec xpos
else
inc xpos
endif
endwhile
next d
stopping = 0
for d = 0 to 4
if rot = 0
bx = shapes(current,d,0)
by = shapes(current,d,1)
endif
if rot = 1
bx = 0-shapes(current,d,1)
by = shapes(current,d,0)
endif
if rot = 2
bx = 0-shapes(current,d,0)
by = 0-shapes(current,d,1)
endif
if rot = 3
bx = shapes(current,d,1)
by = 0-shapes(current,d,0)
endif
if by+ypos > 19
ypos = 19-by
stopped = 1
endif
if by+ypos > -1
if board(bx+xpos,by+ypos+1) = 1
stopping = 1
endif
if board(bx+xpos,by+ypos) = 1
dec ypos
stopped = 1
endif
endif
next d
if stopped = 1 then gosub fix
stopped = 0
for x = 0 to 9
for y = 0 to 19
if board(x,y)
paste image 1,x*30,y*30
endif
next y
next x
for b = 0 to 4
if rot = 0
bx = shapes(current,b,0)
by = shapes(current,b,1)
endif
if rot = 1
bx = 0-shapes(current,b,1)
by = shapes(current,b,0)
endif
if rot = 2
bx = 0-shapes(current,b,0)
by = 0-shapes(current,b,1)
endif
if rot = 3
bx = shapes(current,b,1)
by = 0-shapes(current,b,0)
endif
paste image 1,(bx+xpos)*30,(by+ypos)*30
next b
tlne = 0
for y = 0 to 19
for x = 0 to 9
if board(x,y)
inc nline
endif
next x
if nline > 9
gosub rmv_ln
inc tlne
inc score,2
endif
nline = 0
next y
if tlne > 0
inc score,((tlne-1)*5)
endif
sync
cls
loop
layout:
dim shapes(6,4,1)
shapes(0,0,0) = -1
shapes(0,1,0) = 0
shapes(0,2,0) = 0
shapes(0,3,0) = 0
shapes(0,4,0) = 0
shapes(0,0,1) = 1
shapes(0,1,1) = 1
shapes(0,2,1) = 0
shapes(0,3,1) = -1
shapes(0,4,1) = -2
shapes(1,0,0) = 1
shapes(1,1,0) = 0
shapes(1,2,0) = 0
shapes(1,3,0) = 0
shapes(1,4,0) = 0
shapes(1,0,1) = 1
shapes(1,1,1) = 1
shapes(1,2,1) = 0
shapes(1,3,1) = -1
shapes(1,4,1) = -2
shapes(2,0,0) = -1
shapes(2,1,0) = 0
shapes(2,2,0) = 1
shapes(2,3,0) = 0
shapes(2,4,0) = 0
shapes(2,0,1) = 0
shapes(2,1,1) = 0
shapes(2,2,1) = 0
shapes(2,3,1) = 1
shapes(2,4,1) = 0
shapes(3,0,0) = -1
shapes(3,1,0) = 0
shapes(3,2,0) = 0
shapes(3,3,0) = 1
shapes(3,4,0) = 0
shapes(3,0,1) = 0
shapes(3,1,1) = 0
shapes(3,2,1) = 1
shapes(3,3,1) = 1
shapes(3,4,1) = 0
shapes(4,0,0) = 1
shapes(4,1,0) = 0
shapes(4,2,0) = 0
shapes(4,3,0) = -1
shapes(4,4,0) = 0
shapes(4,0,1) = 0
shapes(4,1,1) = 0
shapes(4,2,1) = 1
shapes(4,3,1) = 1
shapes(4,4,1) = 0
shapes(5,0,0) = -2
shapes(5,1,0) = -1
shapes(5,2,0) = 0
shapes(5,3,0) = 1
shapes(5,4,0) = 2
shapes(5,0,1) = 0
shapes(5,1,1) = 0
shapes(5,2,1) = 0
shapes(5,3,1) = 0
shapes(5,4,1) = 0
shapes(6,0,0) = 0
shapes(6,1,0) = 1
shapes(6,2,0) = 0
shapes(6,3,0) = 1
shapes(6,4,0) = 0
shapes(6,0,1) = 0
shapes(6,1,1) = 0
shapes(6,2,1) = 1
shapes(6,3,1) = 1
shapes(6,4,1) = 0
return
fix:
active = 0
for d = 0 to 4
if rot = 0
bx = shapes(current,d,0)
by = shapes(current,d,1)
endif
if rot = 1
bx = 0-shapes(current,d,1)
by = shapes(current,d,0)
endif
if rot = 2
bx = 0-shapes(current,d,0)
by = 0-shapes(current,d,1)
endif
if rot = 3
bx = shapes(current,d,1)
by = 0-shapes(current,d,0)
endif
if by+ypos < 1 then gosub lose
board(bx+xpos,by+ypos) = 1
next d
return
rmv_ln:
for ty = y to 1 step -1
for tx = 0 to 9
board(tx,ty) = board(tx,ty-1)
next tx
next ty
for tx = 0 to 9
board(tx,0) = 0
next tx
return
turn:
while turnable = 0
inc rot
for d = 0 to 4
if rot = 0
bx = shapes(current,d,0)
by = shapes(current,d,1)
endif
if rot = 1
bx = 0-shapes(current,d,1)
by = shapes(current,d,0)
endif
if rot = 2
bx = 0-shapes(current,d,0)
by = 0-shapes(current,d,1)
endif
if rot = 3
bx = shapes(current,d,1)
by = 0-shapes(current,d,0)
endif
if by+ypos > 19 then goto no
if bx+xpos > 9
mdst = 9-(bx+xpos)
gosub checkturn
if noturn = 1 then goto no
endif
if bx+xpos < 0
mdst = 0-(bx+xpos)
gosub checkturn
if noturn = 1 then goto no
endif
if by+ypos > -1
if board(bx+xpos,by+ypos) = 1
if bx > 0
mdst = 0
while board(bx+xpos+mdst,by+ypos) = 1
dec mdst
if bx+xpos+mdst < 0 then goto no
endwhile
else
mdst = 0
while board(bx+xpos+mdst,by+ypos) = 1
inc mdst
if bx+xpos+mdst > 9 then goto no
endwhile
endif
gosub checkturn
if noturn = 1 then goto no
endif
endif
next d
turnable = 1
no:
endwhile
turnable = 0
return
checkturn:
noturn = 0
for z = 0 to 4
if rot = 0
bx = shapes(current,z,0)
by = shapes(current,z,1)
endif
if rot = 1
bx = 0-shapes(current,z,1)
by = shapes(current,z,0)
endif
if rot = 2
bx = 0-shapes(current,z,0)
by = 0-shapes(current,z,1)
endif
if rot = 3
bx = shapes(current,z,1)
by = 0-shapes(current,z,0)
endif
if board(bx+xpos+mdst,by+ypos) = 1 then noturn = 1
next z
return
lose:
cls 0
while scancode() <> 0
sync
endwhile
set display mode 900,200,32
increment = 2
set text font "Arial"
set text size 100
while scancode() = 0
inc fade#,increment
if fade# = 254 then increment = -2
if fade# = 0 then increment = 2
ink rgb(fade#,fade#*0.7,fade#*0.2),0
center text 450,100-(20+(fade#*0.2)),"Your score was: " + str$(score)
sync
endwhile
end
Executable is also attached for anybody who can't run the code
There are three types of people, those that can count and those that can't.
