cls
break on$=setascii("on")
$seed=val(substr("@time",7,2)) $seed=$seed+1
do $=rnd(1) $seed=$seed-1 until $seed=0
; normal sized DOS box perimeter because I use a bigger box
box(0, 0, 25, 79, single)
; Define shapes
;
; There are four kinds: I, L, T and B
; each has four pieces: 0, 1, 2 and 3
; and each has four rotations: 1, 2, 3 and 4
;
; I= XXXX
;
; X
; X
; L= XX
;
; 7= XX
; X
; X
; X
; T= XX
; X
;
; B= XX
; XX
;
; These are created from a base point and then an array of the
; other relative points
;
; ie for the T that is XXX
; X
; the base is the top center and the
; other points are numbered: 102
; 3
; so, to generate a T we draw a X at base (0, 0)
; then one at (-1, 0) then (+1, 0) and then (0, +1)
;
dim $ix1[4] dim $ix2[4] dim $ix3[4] dim $ix4[4]
dim $iy1[4] dim $iy2[4] dim $iy3[4] dim $iy4[4] ; I
dim $lx1[4] dim $lx2[4] dim $lx3[4] dim $lx4[4]
dim $ly1[4] dim $ly2[4] dim $ly3[4] dim $ly4[4] ; L
dim $7x1[4] dim $7x2[4] dim $7x3[4] dim $7x4[4]
dim $7y1[4] dim $7y2[4] dim $7y3[4] dim $7y4[4] ; 7
dim $tx1[4] dim $tx2[4] dim $tx3[4] dim $tx4[4]
dim $ty1[4] dim $ty2[4] dim $ty3[4] dim $ty4[4] ; T
dim $bx1[4] dim $bx2[4] dim $bx3[4] dim $bx4[4]
dim $by1[4] dim $by2[4] dim $by3[4] dim $by4[4] ; Box
$ix1[1]=1 $iy1[1]=0 $ix1[2]=2 $iy1[2]=0 $ix1[3]=3 $iy1[3]=0
$ix2[1]=0 $iy2[1]=1 $ix2[2]=0 $iy2[2]=2 $ix2[3]=0 $iy2[3]=3
$ix3[1]=1 $iy3[1]=0 $ix3[2]=2 $iy3[2]=0 $ix3[3]=3 $iy3[3]=0
$ix4[1]=0 $iy4[1]=1 $ix4[2]=0 $iy4[2]=2 $ix4[3]=0 $iy4[3]=3
$lx1[1]=0 $ly1[1]=-1 $lx1[2]=1 $ly1[2]=0 $lx1[3]=2 $ly1[3]=0
$lx2[1]=1 $ly2[1]=0 $lx2[2]=0 $ly2[2]=1 $lx2[3]=0 $ly2[3]=2
$lx3[1]=0 $ly3[1]=1 $lx3[2]=-1 $ly3[2]=0 $lx3[3]=-2 $ly3[3]=0
$lx4[1]=-1 $ly4[1]=0 $lx4[2]=0 $ly4[2]=-1 $lx4[3]=0 $ly4[3]=-2
$7x1[1]=0 $7y1[1]=1 $7x1[2]=1 $7y1[2]=0 $7x1[3]=2 $7y1[3]=0
$7x2[1]=-1 $7y2[1]=0 $7x2[2]=0 $7y2[2]=1 $7x2[3]=0 $7y2[3]=2
$7x3[1]=0 $7y3[1]=-1 $7x3[2]=-1 $7y3[2]=0 $7x3[3]=-2 $7y3[3]=0
$7x4[1]=1 $7y4[1]=0 $7x4[2]=0 $7y4[2]=-1 $7x4[3]=0 $7y4[3]=-2
$tx1[1]=-1 $ty1[1]=0 $tx1[2]=0 $ty1[2]=-1 $tx1[3]=1 $ty1[3]=0
$tx2[1]=0 $ty2[1]=-1 $tx2[2]=1 $ty2[2]=0 $tx2[3]=0 $ty2[3]=1
$tx3[1]=1 $ty3[1]=0 $tx3[2]=0 $ty3[2]=1 $tx3[3]=-1 $ty3[3]=0
$tx4[1]=0 $ty4[1]=1 $tx4[2]=-1 $ty4[2]=0 $tx4[3]=0 $ty4[3]=-1
$bx1[1]=0 $by1[1]=1 $bx1[2]=1 $by1[2]=1 $bx1[3]=1 $by1[3]=0
$bx2[1]=0 $by2[1]=1 $bx2[2]=1 $by2[2]=1 $bx2[3]=1 $by2[3]=0
$bx3[1]=0 $by3[1]=1 $bx3[2]=1 $by3[2]=1 $bx3[3]=1 $by3[3]=0
$bx4[1]=0 $by4[1]=1 $bx4[2]=1 $by4[2]=1 $bx4[3]=1 $by4[3]=0
; dimension database
dim $grid[229] ; 12x19 grid - 1 is top left, 228 is bottom right
$i=1
do
$grid[$i]="." ; initialise grid database with .
$i=$i+1
until $i=229
goto main
:erase_block
;
; accepts:
;
; $x, $y: location of new block
;
; returns:
;
; block erased at ($x, $y)
;
at($x, $y) " "
at($x+$disp1x, $y+$disp1y) " "
at($x+$disp2x, $y+$disp2y) " "
at($x+$disp3x, $y+$disp3y) " "
return
:draw_block
;
; accepts:
;
; $x, $y: location of new block
;
; returns:
;
; block drawn at ($x, $y)
;
at($x, $y) chr(219)
at($x+$disp1x, $y+$disp1y) chr(219)
at($x+$disp2x, $y+$disp2y) chr(219)
at($x+$disp3x, $y+$disp3y) chr(219)
return
:random_colour
;
; accepts:
;
; nothing
;
; returns:
;
; sets the colour randomly
;
$col=rnd(6)
select
case $col=0 color b+/n
case $col=1 color g+/n
case $col=2 color c+/n
case $col=3 color r+/n
case $col=4 color m+/n
case $col=5 color y+/n
case $col=6 color w+/n
endselect
return
:choose_block
;
; accepts:
;
; $turn for rotation: 1..4
; $block for block shape: 0..4
; 0=i, 1=l, 2=7, 3=t or 4=b
;
; returns:
;
; $disp1x, $disp1y = offset of block 1
; $disp2x, $disp2y = offset of block 2
; $disp3x, $disp3y = offset of block 3
; $left = blocks to the left of base (center)
; $right = block to the right of base
; $height = blocks under base
;
select
case $block=0 ; i
select
case $turn=1
$disp1x=$ix1[1] $disp1y=$iy1[1]
$disp2x=$ix1[2] $disp2y=$iy1[2]
$disp3x=$ix1[3] $disp3y=$iy1[3]
$left=0 $right=0 $height=3
case $turn=2
$disp1x=$ix2[1] $disp1y=$iy2[1]
$disp2x=$ix2[2] $disp2y=$iy2[2]
$disp3x=$ix2[3] $disp3y=$iy2[3]
$left=0 $right=3 $height=0
case $turn=3
$disp1x=$ix3[1] $disp1y=$iy3[1]
$disp2x=$ix3[2] $disp2y=$iy3[2]
$disp3x=$ix3[3] $disp3y=$iy3[3]
$left=0 $right=0 $height=3
case $turn=4
$disp1x=$ix4[1] $disp1y=$iy4[1]
$disp2x=$ix4[2] $disp2y=$iy4[2]
$disp3x=$ix4[3] $disp3y=$iy4[3]
$left=0 $right=3 $height=0
endselect
case $block=1 ; L
select
case $turn=1
$disp1x=$lx1[1] $disp1y=$ly1[1]
$disp2x=$lx1[2] $disp2y=$ly1[2]
$disp3x=$lx1[3] $disp3y=$ly1[3]
$left=1 $right=0 $height=2
case $turn=2
$disp1x=$lx2[1] $disp1y=$ly2[1]
$disp2x=$lx2[2] $disp2y=$ly2[2]
$disp3x=$lx2[3] $disp3y=$ly2[3]
$left=0 $right=2 $height=1
case $turn=3
$disp1x=$lx3[1] $disp1y=$ly3[1]
$disp2x=$lx3[2] $disp2y=$ly3[2]
$disp3x=$lx3[3] $disp3y=$ly3[3]
$left=0 $right=1 $height=0
case $turn=4
$disp1x=$lx4[1] $disp1y=$ly4[1]
$disp2x=$lx4[2] $disp2y=$ly4[2]
$disp3x=$lx4[3] $disp3y=$ly4[3]
$left=2 $right=0 $height=0
endselect
case $block=2 ; 7
select
case $turn=1
$disp1x=$7x1[1] $disp1y=$7y1[1]
$disp2x=$7x1[2] $disp2y=$7y1[2]
$disp3x=$7x1[3] $disp3y=$7y1[3]
$left=0 $right=1 $height=2
case $turn=2
$disp1x=$7x2[1] $disp1y=$7y2[1]
$disp2x=$7x2[2] $disp2y=$7y2[2]
$disp3x=$7x2[3] $disp3y=$7y2[3]
$left=0 $right=2 $height=0
case $turn=3
$disp1x=$7x3[1] $disp1y=$7y3[1]
$disp2x=$7x3[2] $disp2y=$7y3[2]
$disp3x=$7x3[3] $disp3y=$7y3[3]
$left=1 $right=0 $height=0
case $turn=4
$disp1x=$7x4[1] $disp1y=$7y4[1]
$disp2x=$7x4[2] $disp2y=$7y4[2]
$disp3x=$7x4[3] $disp3y=$7y4[3]
$left=2 $right=0 $height=1
endselect
case $block=3 ; T
select
case $turn=1
$disp1x=$tx1[1] $disp1y=$ty1[1]
$disp2x=$tx1[2] $disp2y=$ty1[2]
$disp3x=$tx1[3] $disp3y=$ty1[3]
$left=1 $right=0 $height=1
case $turn=2
$disp1x=$tx2[1] $disp1y=$ty2[1]
$disp2x=$tx2[2] $disp2y=$ty2[2]
$disp3x=$tx2[3] $disp3y=$ty2[3]
$left=1 $right=1 $height=1
case $turn=3
$disp1x=$tx3[1] $disp1y=$ty3[1]
$disp2x=$tx3[2] $disp2y=$ty3[2]
$disp3x=$tx3[3] $disp3y=$ty3[3]
$left=0 $right=1 $height=1
case $turn=4
$disp1x=$tx4[1] $disp1y=$ty4[1]
$disp2x=$tx4[2] $disp2y=$ty4[2]
$disp3x=$tx4[3] $disp3y=$ty4[3]
$left=1 $right=1 $height=0
endselect
case $block=4 ; b
select
case $turn=1
$disp1x=$bx1[1] $disp1y=$by1[1]
$disp2x=$bx1[2] $disp2y=$by1[2]
$disp3x=$bx1[3] $disp3y=$by1[3]
$left=0 $right=1 $height=1
case $turn=2
$disp1x=$bx2[1] $disp1y=$by2[1]
$disp2x=$bx2[2] $disp2y=$by2[2]
$disp3x=$bx2[3] $disp3y=$by2[3]
$left=0 $right=1 $height=1
case $turn=3
$disp1x=$bx3[1] $disp1y=$by3[1]
$disp2x=$bx3[2] $disp2y=$by3[2]
$disp3x=$bx3[3] $disp3y=$by3[3]
$left=0 $right=1 $height=1
case $turn=4
$disp1x=$bx4[1] $disp1y=$by4[1]
$disp2x=$bx4[2] $disp2y=$by4[2]
$disp3x=$bx4[3] $disp3y=$by4[3]
$left=0 $right=1 $height=1
endselect
endselect
return
:check_block
;
; if the block is poking outside the box, move it in.
;
if $y+$right>14
$y=14-$right
at($x, $y+$right+1) chr(179) ; replace |
endif
if $y-$left<3
$y=3+$left
at($x, $y-$left-1) chr(179) ; replace |
endif
return
:show_grid
$xx=3
do
$yy=25
do
at($xx, $yy)
$quiz=(($xx-3)*12+($yy-25))+1
$disp=$grid[$quiz] "$disp"
$yy=$yy+1
until $yy=37
$xx=$xx+1
until $xx=22
return
:check_for_line
;
; Checks database for a complete line of blocks
; then removes this line and drops all other lines down
; and increments the score
;
$i=0
$line=""
$bFound=0 ; reset this now, if nothing is found, doesn't return here
do
$line=""
$column=1
do
$char=$i*12+$column
$line=$line+$grid[$char]
$column=$column+1
until $column=13
;at(0,0) "$i=$line " get$
if $line="xxxxxxxxxxxx" ; Line found
$bFound=1
$score=$score+10 ; you score!!! 
$ibackup=$i
do
$column=1
do
$dest=$i*12+$column
$source=$dest-12
;at(0,0) "$$source=$source $$dest=$dest " get$
$grid[$dest]=$grid[$source] ; move all lines down one
$column=$column+1
until $column=13
$i=$i-1
until $i=0
$i=$ibackup
; update screen
$x=3
do
$y=3
do
at($x, $y)
$scan=(($x-3)*12)+($y-2)
if $grid[$scan]="x" chr(219) else " " endif ; move all blocks down
$y=$y+1
until $y=15
$x=$x+1
until $x=22
$i=19
goto leave
endif
$i=$i+1
:leave
until $i=19
:check_grid
;
; accepts:
;
; $x, $y = screen location of block base
; $dispnX, $dispnY = additional block pieces
;
; returns:
;
; $clear = 1 next grid space down is free
; $clear = 0 next grid space down is occupied
;
$clear=0
$base=(($x-3)*12)+($y-2)
if $debug=1
color w+/n
at(3, 40) "x=$x "
at(4, 40) "y=$y "
at(5, 40) "$$base=$base "
at(6, 40) "$$blocks=$blocks "
endif
if $base>0 and $base<228 if $grid[$base]="x" $clear=1 endif endif
$base=((($x-3)+$disp1x)*12)+($y-2)+$disp1y
if $base>0 and $base<228 if $grid[$base]="x" $clear=1 endif endif
$base=((($x-3)+$disp2x)*12)+($y-2)+$disp2y
if $base>0 and $base<228 if $grid[$base]="x" $clear=1 endif endif
$base=((($x-3)+$disp3x)*12)+($y-2)+$disp3y
if $base>0 and $base<228 if $grid[$base]="x" $clear=1 endif endif
return
:choose_delay
;
; Increase speed as game progresses
;
select
case $score=100 $delay=450
case $score=200 $delay=400
case $score=300 $delay=350
case $score=400 $delay=300
case $score=500 $delay=250
case $score=600 $delay=200
case $score=700 $delay=150
case $score=800 $delay=100
case $score=900 $delay=50
endselect
return
:main
; open DLL
$kixlib=olecreateobject("kixlib32.library")
if $kixlib=0
cls
"KIXLIB32 not installed" ?
exit
endif
color w+/n
box(2, 2, 22, 15, single) ; draw box
at(22, 20) ",=left .=right SPACE=rotate ENTER=drop q=quit"
at(2, 2) " " ; cut the top off
$blocks=0 ; number of blocks that have fallen
$debug=0 ; show debug info
$delay=500 ; delay in milliseconds between block drops
$score=0
if $debug=1 box(2, 24, 22, 37, single) endif ; draw database grid display
$key=" " ; 
while $key<>"q"
if $debug=1
at(5, 20) @error " " ; display ascii code of keypress
gosub show_grid ; display grid database
endif
$blocks=$blocks+1
at(10, 40) "Block No: $blocks "
at(11, 40) "Score: $score"
$block=rnd(4) ; new block shape
; at(9, 40) "$$block=$block "
$turn=rnd(3)+1 ; new block direction
; at(8, 40) "$$turn=$turn "
;gosub random_colour
gosub choose_block ; choose new block
gosub choose_delay ; game gets faster as you get better
$x=3 $y=10 ; where the block starts its fall
$next=0
$nextline=0
$first=1
do
at(24, 1) ; move cursor out of the way
$key=""
if $nextline=0
olecallfunc($kixlib,"sleep","s","$delay") ; delay in milliseconds
if olecallfunc($kixlib,"kbhit") = 1
get $key ; get next key from buffer
endif
gosub erase_block ; remove current block
select
case $key="." $y=$y+1 if $y+$right>14 $y=14-$right endif ; right
case $key="," $y=$y-1 if $y-$left<3 $y=3+$left endif ; left
case $key=" " ; rotate
if $debug=1
at(8, 40) "$$turn=$turn "
at(9, 40) "$$block=$block "
endif
$turn=$turn+1
if $turn=5 $turn=1 endif
gosub choose_block ; choose rotated block
gosub check_block ; make sure block is within the box
case $key=chr(13) $nextline=1
case $key="q" color w+/n exit ; "Q"
case 1 $x=$x+1 ; down
endselect
else
olecallfunc($kixlib,"sleep","s","30")
gosub erase_block ; remove current block
$x=$x+1 ; down
endif
gosub check_grid ; check grid space is free
if $clear=1
$x=$x-1
gosub draw_block
if $first=1 $blocks=10 endif
$next=1
goto thats_it
endif
gosub draw_block ; draw new block
if $x+$height=21 $next=1 endif
:thats_it
$first=0
until $next=1 ; block has hit bottom
; update grid database
; base point
$base=(($x-3)*12)+($y-2)
if $debug=1
at(3, 40) "x=$x "
at(4, 40) "y=$y "
at(5, 40) "$$base=$base "
endif
$grid[$base]="x"
$base=((($x-3)+$disp1x)*12)+($y-2)+$disp1y
$grid[$base]="x"
$base=((($x-3)+$disp2x)*12)+($y-2)+$disp2y
$grid[$base]="x"
$base=((($x-3)+$disp3x)*12)+($y-2)+$disp3y
$grid[$base]="x"
; look for a continuous line
$bFound=1
while $bFound=1 ; keeps checking until no lines found so multiples are got.
gosub check_for_line
loop
loop ; while $key<>"q"
quit
