Tetris clone

[tsh73]

Graphical application without actual drawing.

Started from "hey, could I do something tetris-like in 1k?"
Of cource I can't.
But this did not stop me.
(5398 as of now, with tabs indent
Could be made under 4k by decommenting and killing indent)
)
'tetris clone
'tsh73 June 2022
'main ideas are
' 1) massively use binary ops
' 2) use sprite background upscaling instead of drawing
nomainwin

w=10:h=20 'active size in blocks
gameHeight = 0.75*DisplayHeight 'change to taste
boxSize = int(gameHeight/(h+2)) '+2 for border lines

desiredWidth = w*boxSize
desiredHeight = h*boxSize
gosub [ajustWindow]
UpperLeftX=(DisplayWidth-WindowWidth)/2
UpperLeftY=(DisplayHeight-WindowHeight)/2

open "Ttr-s" for graphics_nsb_nf as #g
#g "trapclose [q]"
#g "when characterInput [k]"
#g "down; setfocus"

#g "getbmp b 0 0 ";w+2;" ";h+2 'screen, pixel to square
'with pixel for borders
bmpsave "b", "ttr.bmp"
'(tested) 4 bpp pixel BBGGRR00, 66 offset
FF$=chr$(255)
w$=FF$+FF$+FF$+" "
gy$="ZZZ " 'any 4 bytes will do, last one any
'(~) is chr 126
bl$="~   " 'blue
gr$=" ~  " 'green
rd$="  ~ " 'red

'piece
dim p(4) '0..5
gosub [initFig]
gosub [nextFig]

movesToDrop = 10
movesPassed = 0
level = 1

dim lines(h+1)
'empty screen
aLine=2^12-1 'full line
for y = 0 to h
if y>0 then aLine=1+2^11 'borders
lines(y)=aLine
next

checkOk=1
gosub [redraw]

timer 50, [tick]
timerOn=1
wait

[k]
k$=Inkey$
if k$="q" then [q]
if k$=chr$(27) or k$="p" then
timerOn=not(timerOn)
if timerOn then
timer 50, [tick]
else
timer 0
msg$="P A U S E"
#g "stringwidth? msg$ wid"
#g "home; posxy cx cy"
#g "place ";cx-wid/2;" "; cy
#g "\";msg$
end if
end if
wait

[tick]
move=move+1
if move mod 1000 = 0 then
level=level+1
movesToDrop=movesToDrop-1
end if
movesPassed =movesPassed +1
if movesPassed>movesToDrop or dropFlg then
movesPassed=0
mv=mv+1 'Number of down moves, as score
goto [drop]
end if
if len(k$)>1 then k$=right$(k$,1) 'for cursor keys
if instr("wasd "+chr$(_VK_LEFT)+chr$(_VK_RIGHT)+chr$(_VK_DOWN)+chr$(_VK_UP), k$)=0 then wait
x1=x0:y1=y0:r1=r0 'piece position and rotation
if k$="w" or k$=chr$(_VK_UP) then r1=(r0+1) mod 4
if k$="a" or k$=chr$(_VK_LEFT) then x1=x0-1
if k$="s" or k$=chr$(_VK_DOWN) then k$="":goto [drop]
if k$="d" or k$=chr$(_VK_RIGHT) then x1=x0+1
if k$=" "then dropFlg=1:k$="":goto [drop]
k$="" 'used up
gosub [check]
if not(checkOk) then wait 'don't execute invalid move
x0=x1:y0=y1:r0=r1 'accept move
gosub [redraw]
wait

[q]
close #g
end

[drop]
x1=x0:y1=y0:r1=r0
y1=y0-1
gosub [check]
if checkOk then
x0=x1:y0=y1:r0=r1
gosub [redraw]
wait
end if
'else - not OK
''soft drop (dropped piece doesn't stick)
' if dropFlg then
' dropFlg=0
' checkOk=1
' movesPassed=0
' gosub [redraw]
' wait
' end if
'freese figure
for y=y0 to y0+4 'by figure lines
if y>0 then
aLine=lines(y) 'current line
pp=int(p(y-y0)/32^r1) mod 32 'line of figure, rotated at r1
lines(y)=aLine OR pp*2^x1 'new combined line
end if
next
'check for filled, remove
for y=y0+4 to y0 step -1
remmed=0
if y>0 then
if lines(y)=2^12-1 then 'all 1's
for i = y to h-1 'remove
lines(i)=lines(i+1)
next
remmed=remmed+1
mv=mv+val(word$("100 220 450 800", remmed))
end if
end if
next

'add new piece (if fits)
gosub [nextFig]
x1=x0:y1=y0:r1=r0
gosub [check]
gosub [redraw]
if not(checkOk) then
notice "Game over!"
goto [q]
end if
wait

[redraw]
gosub [writeBMP]
gosub [showBMP]
#g "place 0 0"
#g "\\";using("#####",mv);"   Level ";level
return

[writeBMP]
open "ttr.bmp" for binary as #1
for y = 0 to h
aLine=lines(y)
pp=0
if y-y0>=0 and y-y0<=4 then
pp=int(p(y-y0)/32^r0) mod 32
aLine=aLine OR pp*2^x0
end if
for x = 0 to w+1
seek #1, 66+(y*(w+2)+x)*4
if aLine And 2^x then
select case
case x=0 or x=w+1 or y=0 '>0
#1 gy$;
case ((pp*2^x0) and (2^x)) >0
if not(checkOk) then #1 rd$; else #1 bl$;
case else
#1 gr$;
end select
else
#1 w$;
end if
next
next
close #1
return

[showBMP]
loadbmp "b", "ttr.bmp"
#g "background b"
#g "drawsprites" 'indeed it scaled great!
return

[check] 'uses x1 y1 r1
checkOk=1
for y=y1 to y1+4
pp=int(p(y-y1)/32^r1) mod 32
if pp then
if y<=0 then checkOk=0:exit for 'bottom
aLine=lines(y)
if aLine AND pp*2^x1 then checkOk=0:exit for'clash
end if
next
print
return

[initFig]
dim fig(7, 5)
for f = 0 to 7
for i = 0 to 4
read tmp
fig(f,i)=tmp
next
next
'figures in 5x5 binary, each line 4 rotations as 2^5
data 4,4100,987620,4100,4096
data 0,4228,465356,135172,0
data 0,2436,399564,200712,0
data 0,4296,203148,395268,0
data 0,266246,463300,12356,0
data 0,4172,463300,268292,0
data 0,405900,405900,0,0
data 0,135168,209286,132,0
return

[nextFig]
'piece position
'lower left, 1 1 is lower useful corner
x0=4: y0=17 'top center
f=int(rnd(0)*8) 'random figure f (0..7)

r0=0:r1=r0 'start with no rotation
for i = 0 to 4
p(i)=fig(f,i)
next
dropFlg=0
return

[ajustWindow]
WindowWidth = 200
WindowHeight = 200

open "..." for graphics_nsb_nf as #gr
#gr, "home ; down ; posxy x y"
close #gr
'x, y give us width, height
width = 2*x : height = 2*y

slackX = 200-width
slackY = 200-height

WindowWidth = desiredWidth + slackX
WindowHeight = desiredHeight + slackY

return


[dan1101]

Outstanding program. It works flawlessly, very similar to the original. Nice work!