DEFINT A-Z
DECLARE SUB ldhigh ()
DECLARE SUB chkhigh ()
DECLARE SUB calcpiece ()
DECLARE SUB game ()
DECLARE SUB check ()
COMMON SHARED numcol, sc, nsc, nblock, col, hitime#, hi, quit
SCREEN 13
numcol = 2
DIM SHARED blocks(300, 17), pieces(7, 3, 3, 1)
DIM SHARED arr(10, 20), done(10, 20), pnttodo(10, 20), ox(3), oy(3)
DIM SHARED hiscore$(9, 2)
FOR c = 0 TO 15
LINE (0, 0)-(6, 6), c, BF
LINE (0, 0)-(6, 6), 24, B
IF c = 0 THEN LINE (0, 0)-(6, 6), 0, B
GET (0, 0)-(7, 7), blocks(0, c)
NEXT
CLS
LINE (0, 1)-(5, 6), 4
LINE (1, 0)-(6, 5), 4
LINE (0, 5)-(5, 0), 4
LINE (1, 6)-(6, 1), 4
LINE (0, 0)-(6, 6), 40
LINE (6, 0)-(0, 6), 40
GET (0, 0)-(7, 7), blocks(0, 16)
LINE (0, 0)-(6, 6), 24, BF
GET (0, 0)-(7, 7), blocks(0, 17)


DEF SEG = &HA000: BLOAD "wrdtris.bin", 0: DEF SEG
LINE (0, 0)-(88, 168), 0, BF

RANDOMIZE TIMER
ldhigh
calcpiece
begin:
DO
nsc = 0
nc = FIX(RND * (numcol - 1)) + 2
pitch = 0
FOR y = 0 TO 20
FOR x = 0 TO 10
'LINE (x * 8, y * 8)-(x * 8 + 6, y * 8 + 6), FIX(RND * 2) + 1, BF: LINE (x * 8 - 1, y * 8 - 1)-(x * 8 + 7, y * 8 + 7), 0, B
PUT (x * 8, y * 8), blocks(0, FIX(RND * nc) + 1), PSET
NEXT: NEXT
FOR y = 0 TO 20
FOR x = 0 TO 10
arr(x, y) = POINT(x * 8 + 2, y * 8 + 2)
NEXT: NEXT
check
k$ = INKEY$
LOOP UNTIL k$ = " " OR k$ = CHR$(27)
IF k$ = " " THEN nsc = 1: sc = 0: game
IF k$ = CHR$(27) THEN END
gameover:
chkhigh
quit = 0
GOTO begin


DATA "efghbfjnefghbfjn"
DATA "efgjbfgjbefgbefj"
DATA "aefjbcefaefjbcef"
DATA "befiabfgbefiabfg"
DATA "abeieijkcgjkabcg"
DATA "bcgkabceaeijgijk"
DATA "abefabefabefabef"
DATA "aaaaaaaaaaaaaaaa"
' abc*  'abcd
' defg  'efgh
' hij*  'ijkl
' *k**  'mnop

SUB calcpiece
FOR piece = 0 TO 7
READ wrk$
FOR rot = 0 TO 3
FOR lp = 0 TO 3
SELECT CASE MID$(wrk$, rot * 4 + lp + 1, 1)
CASE "a": pieces(piece, rot, lp, 0) = 0: pieces(piece, rot, lp, 1) = 0
CASE "b": pieces(piece, rot, lp, 0) = 1: pieces(piece, rot, lp, 1) = 0
CASE "c": pieces(piece, rot, lp, 0) = 2: pieces(piece, rot, lp, 1) = 0
CASE "d": pieces(piece, rot, lp, 0) = 3: pieces(piece, rot, lp, 1) = 0
CASE "e": pieces(piece, rot, lp, 0) = 0: pieces(piece, rot, lp, 1) = 1
CASE "f": pieces(piece, rot, lp, 0) = 1: pieces(piece, rot, lp, 1) = 1
CASE "g": pieces(piece, rot, lp, 0) = 2: pieces(piece, rot, lp, 1) = 1
CASE "h": pieces(piece, rot, lp, 0) = 3: pieces(piece, rot, lp, 1) = 1
CASE "i": pieces(piece, rot, lp, 0) = 0: pieces(piece, rot, lp, 1) = 2
CASE "j": pieces(piece, rot, lp, 0) = 1: pieces(piece, rot, lp, 1) = 2
CASE "k": pieces(piece, rot, lp, 0) = 2: pieces(piece, rot, lp, 1) = 2
CASE "l": pieces(piece, rot, lp, 0) = 3: pieces(piece, rot, lp, 1) = 2
CASE "m": pieces(piece, rot, lp, 0) = 0: pieces(piece, rot, lp, 1) = 3
CASE "n": pieces(piece, rot, lp, 0) = 1: pieces(piece, rot, lp, 1) = 3
CASE "o": pieces(piece, rot, lp, 0) = 2: pieces(piece, rot, lp, 1) = 3
CASE "p": pieces(piece, rot, lp, 0) = 3: pieces(piece, rot, lp, 1) = 3
END SELECT
NEXT: NEXT: NEXT
' abc*  'abcd
' defg  'efgh
' hij*  'ijkl
' *k**  'mnop
END SUB

SUB check
pitch = 0


IF col = 16 THEN
FOR x = 0 TO 10
FOR y = 0 TO 20
IF arr(x, y) = 16 THEN arr(x, y) = 0: PUT (x * 8, y * 8), blocks(0, 0), PSET: IF y <> 20 THEN del = arr(x, y + 1) ELSE del = 253
NEXT: NEXT
FOR x = 0 TO 10
FOR y = 0 TO 20
IF arr(x, y) = del THEN LINE (x * 8, y * 8)-(x * 8 + 7, y * 8 + 7), 0, BF: sc = sc + numcol
NEXT: NEXT
FOR lp = 0 TO 5
ti# = TIMER
FOR x = 0 TO 10
FOR y = 0 TO 20
IF arr(x, y) = del THEN PUT (x * 8, y * 8), blocks(0, del)
NEXT: NEXT
'DO: LOOP UNTIL TIMER - ti# >= .2
PLAY "mf t255 l64 n60 n58 n56 n54 n52 n50 n48 n46 n44 n42 n40 n38 n36 n34 n32 n30"
NEXT
FOR x = 0 TO 10
FOR y = 0 TO 20
IF arr(x, y) = del THEN arr(x, y) = 0
NEXT: NEXT

END IF

FOR x = 0 TO 10
IF arr(x, 0) <> 0 AND nsc = 1 THEN quit = 1: GOTO skipall
NEXT


DO
IF TIMER - hitime# >= 1.5 THEN
hitime# = TIMER
LOCATE 16, 13: PRINT hi + 1; ") "; hiscore$(hi, 0); " "
LOCATE 17, 14: PRINT "Level : "; hiscore$(hi, 1)
LOCATE 18, 14: PRINT "Score : "; hiscore$(hi, 2)
hi = (hi + 1) MOD 10
END IF



recheck = 0

DO

again = 0
FOR x = 0 TO 10
FOR y = 19 TO 0 STEP -1
IF arr(x, y) AND arr(x, y + 1) = 0 THEN arr(x, y + 1) = arr(x, y): arr(x, y) = 0: again = 1: recheck = 1: PUT (x * 8, y * 8), blocks(0, 0), PSET: PUT (x * 8, (y + 1) * 8), blocks(0, arr(x, y + 1)), PSET
NEXT
NEXT

'IF again = 1 THEN
'FOR x = 0 TO 10
'FOR y = 0 TO 20
'LINE (x * 8, y * 8)-(x * 8 + 6, y * 8 + 6), arr(x, y), BF: LINE (x * 8 - 1, y * 8 - 1)-(x * 8 + 7, y * 8 + 7), 0, B
'PUT (x * 8, y * 8), blocks(0, arr(x, y)), PSET
'NEXT: NEXT
'END IF

LOOP UNTIL again = 0









FOR y = 0 TO 20

   FOR l4 = 0 TO 20
      FOR l3 = 0 TO 10
         pnttodo(l3, l4) = 0
      NEXT: NEXT


   col = arr(0, y)
      IF col <> 0 AND col <> 17 AND col <> 16 THEN
      LINE (0, y * 8 + 1)-(0, y * 8 + 5), col
      pnttodo(0, y) = 1
      DO
         lit = 0
         FOR l2 = 0 TO 20
            FOR l1 = 0 TO 10
               IF pnttodo(l1, l2) <> 0 AND done(l1, l2) = 0 THEN
'                  LINE (l1 * 8, l2 * 8)-(l1 * 8 + 6, l2 * 8 + 6), y * 2 + 31, B
                  IF l1 <> 0 THEN IF arr(l1 - 1, l2) = col THEN pnttodo(l1 - 1, l2) = 1: lit = 1: LINE (l1 * 8 - 2, l2 * 8 + 1)-(l1 * 8, l2 * 8 + 5), 24, B: LINE (l1 * 8 - 2, l2 * 8 + 2)-(l1 * 8, l2 * 8 + 4), col, BF ELSE LINE (l1 * 8, l2 * 8 + 2)-( _
l1 * 8, l2 * 8 + 4), 24: LINE (l1 * 8 - 1, l2 * 8 + 1)-(l1 * 8 - 1, l2 * 8 + 5), 0
                  IF l1 <> 10 THEN IF arr(l1 + 1, l2) = col THEN pnttodo(l1 + 1, l2) = 1: lit = 1: LINE (l1 * 8 + 6, l2 * 8 + 1)-(l1 * 8 + 8, l2 * 8 + 5), 24, B: LINE (l1 * 8 + 6, l2 * 8 + 2)-(l1 * 8 + 8, l2 * 8 + 4), col, BF ELSE LINE (l1 * 8 + 6,  _
l2 * 8 + 2)-(l1 * 8 + 6, l2 * 8 + 4), 24: LINE (l1 * 8 + 7, l2 * 8 + 1)-(l1 * 8 + 7, l2 * 8 + 5), 0
                  IF l2 <> 0 THEN IF arr(l1, l2 - 1) = col THEN pnttodo(l1, l2 - 1) = 1: lit = 1: LINE (l1 * 8 + 1, l2 * 8 - 2)-(l1 * 8 + 5, l2 * 8), 24, B: LINE (l1 * 8 + 2, l2 * 8 - 2)-(l1 * 8 + 4, l2 * 8), col, BF ELSE LINE (l1 * 8 + 2, l2 * 8)-( _
l1 * 8 + 4, l2 * 8), 24: LINE (l1 * 8 + 1, l2 * 8 - 1)-(l1 * 8 + 5, l2 * 8 - 1), 0
                  IF l2 <> 20 THEN IF arr(l1, l2 + 1) = col THEN pnttodo(l1, l2 + 1) = 1: lit = 1: LINE (l1 * 8 + 1, l2 * 8 + 6)-(l1 * 8 + 5, l2 * 8 + 8), 24, B: LINE (l1 * 8 + 2, l2 * 8 + 6)-(l1 * 8 + 4, l2 * 8 + 8), col, BF ELSE LINE (l1 * 8 + 2,  _
l2 * 8 + 6)-(l1 * 8 + 4, l2 * 8 + 6), 24: LINE (l1 * 8 + 1, l2 * 8 + 7)-(l1 * 8 + 5, l2 * 8 + 7), 0
                  done(l1, l2) = y + 1
                  END IF
               NEXT: NEXT
      LOOP UNTIL lit = 0
     END IF
NEXT

FOR y = 0 TO 20
IF done(10, y) <> 0 AND arr(10, y) <> 0 THEN
recheck = 1
thecol = done(10, y)
FOR lp = 0 TO 2
'PLAY "mb t255 l64 n60 n56 n52 n48 n44 n40 n36 n32 n28 n24 n20 n16 n12 n8 n4"
pla$ = "mb t255 l64"
FOR n = 1 TO 15
pla$ = pla$ + "n" + STR$(64 + pitch * 3 - n * 3)
NEXT
PLAY pla$
FOR cl = 44 TO 40 STEP -1
PAINT (82, y * 8 + 2), cl, 24
NEXT: DO: LOOP UNTIL PLAY(0) = 0: NEXT
FOR cl = 24 TO 16 STEP -1
PAINT (82, y * 8 + 2), cl, 0
NEXT
PAINT (82, y * 8 + 2), 0
pitch = pitch + 1

FOR l2 = 0 TO 20
FOR l1 = 0 TO 10
IF done(l1, l2) = thecol THEN arr(l1, l2) = 0: IF nsc = 1 THEN sc = sc + (numcol * (pitch + 1)): nblock = nblock - 1: IF nblock = 0 THEN numcol = numcol + 1: nblock = 50 * numcol
NEXT: NEXT
END IF
NEXT

   FOR l4 = 0 TO 20
      FOR l3 = 0 TO 10
         done(l3, l4) = 0
         pnttodo(l3, l4) = 0
      NEXT: NEXT
LOOP UNTIL recheck = 0
skipall:
LOCATE 23, 1: PRINT "SCORE :"; sc; "        "
LOCATE 23, 20: PRINT "BLOCKS :"; nblock; "   "
LOCATE 22, 20: PRINT "LEVEL  :"; numcol - 1
END SUB

SUB chkhigh
nh = -1
FOR lp = 9 TO 0 STEP -1
IF sc > VAL(hiscore$(lp, 2)) THEN nh = lp
NEXT

IF nh <> -1 THEN
tmp$ = LTRIM$(STR$(sc))
IF lp <> 9 THEN
FOR lp2 = 9 TO nh + 1 STEP -1
FOR lp3 = 0 TO 2
hiscore$(lp2, lp3) = hiscore$(lp2 - 1, lp3)
NEXT: NEXT
END IF
LOCATE 19, 13: PRINT "High Score - ENTER NAME!"
LOCATE 20, 13: INPUT "", name$
IF LEN(name$) > 20 THEN name$ = LEFT$(name$, 20)
IF LEN(name$) < 20 THEN DO: name$ = name$ + " ": LOOP UNTIL LEN(name$) = 20
IF LEN(tmp$) < 5 THEN DO: tmp$ = "0" + tmp$: LOOP UNTIL LEN(tmp$) = 5
hiscore$(nh, 0) = name$
hiscore$(nh, 1) = LTRIM$(STR$(numcol - 1))
hiscore$(nh, 2) = tmp$

OPEN "hi.dat" FOR OUTPUT AS #1
FOR lp = 0 TO 9
PRINT #1, hiscore$(lp, 0); hiscore$(lp, 1); " "; hiscore$(lp, 2)
NEXT
CLOSE #1
END IF



'0123456789
'012x345678

LOCATE 19, 13: PRINT "                        "
LOCATE 20, 13: PRINT "                           "

END SUB

SUB game
LINE (0, 0)-(87, 167), 0, BF
LINE (88, 0)-(88, 168), 183
LINE (0, 168)-(88, 168), 183

quit = 0
numcol = 2
FOR l4 = 0 TO 20
FOR l3 = 0 TO 10
done(l3, l4) = 0
pnttodo(l3, l4) = 0
arr(l3, l4) = 0
NEXT: NEXT
nblock = 50 * numcol

rot = 0
tm# = TIMER
hightime# = TIMER

piece = FIX(RND * 7): y = 0: x = 4: col = FIX(RND * numcol) + 1

LOCATE 23, 1: PRINT "SCORE :"; sc; "        "
LOCATE 23, 20: PRINT "BLOCKS :"; nblock; "   "
LOCATE 22, 20: PRINT "LEVEL  :"; numcol - 1
DO
IF TIMER - hitime# >= 1.5 THEN
hitime# = TIMER
LOCATE 16, 13: PRINT hi + 1; ") "; hiscore$(hi, 0); " "
LOCATE 17, 14: PRINT "Level : "; hiscore$(hi, 1)
LOCATE 18, 14: PRINT "Score : "; hiscore$(hi, 2)
hi = (hi + 1) MOD 10
END IF
FOR lp = 0 TO 3
ox(lp) = pieces(piece, rot, lp, 0) * 8 + x * 8
oy(lp) = pieces(piece, rot, lp, 1) * 8 + y * 8
NEXT

IF TIMER - tm# >= .2 OR drop = 1 THEN
IF drop = 1 THEN sc = sc + numcol
y = y + 1
FOR ly = 0 TO 3
FOR lx = 0 TO 3
FOR lp = 0 TO 3
IF x + lx >= 0 AND x + lx <= 10 AND y + ly <= 20 THEN
IF arr(x + lx, y + ly) <> 0 AND pieces(piece, rot, lp, 0) = lx AND pieces(piece, rot, lp, 1) = ly THEN
FOR lp2 = 0 TO 3
ox(lp2) = 0
oy(lp2) = 0
arr(x + pieces(piece, rot, lp2, 0), y + pieces(piece, rot, lp2, 1) - 1) = col
NEXT
check
piece = FIX(RND * 7): y = 0: x = 4: col = FIX(RND * numcol) + 1
IF FIX(RND * (75 - numcol * 3)) = 5 THEN col = 17
IF FIX(RND * (75 - numcol * 3)) = 5 THEN piece = 7: col = 16
drop = 0
GOTO dun
END IF
END IF
IF pieces(piece, rot, lp, 1) + y >= 21 THEN
FOR lp2 = 0 TO 3
ox(lp2) = 0
oy(lp2) = 0
arr(x + pieces(piece, rot, lp2, 0), y + pieces(piece, rot, lp2, 1) - 1) = col
NEXT
check
piece = FIX(RND * 7): y = 0: x = 4: col = FIX(RND * numcol) + 1
IF FIX(RND * (75 - numcol * 3)) = 5 THEN col = 17
IF FIX(RND * (75 - numcol * 3)) = 5 THEN piece = 7: col = 16
drop = 0
GOTO dun
END IF
NEXT: NEXT: NEXT
dun:
tm# = TIMER
END IF

SELECT CASE INKEY$
CASE " ": drop = 1

CASE "4": x = x - 1
FOR lp = 0 TO 3
IF pieces(piece, rot, lp, 0) = 0 AND x = -1 THEN x = 0: GOTO skip
IF pieces(piece, rot, lp, 0) = 1 AND x = -2 THEN x = -1: GOTO skip
NEXT
FOR ly = 0 TO 3
FOR lx = 0 TO 3
FOR pc = 0 TO 3
IF x + lx >= 0 AND x + lx <= 10 AND y + ly <= 20 THEN
IF arr(x + lx, y + ly) <> 0 AND pieces(piece, rot, pc, 0) = lx AND pieces(piece, rot, pc, 1) = ly THEN
x = x + 1
GOTO skip
END IF
END IF
NEXT: NEXT: NEXT


CASE "6": x = x + 1
FOR lp = 0 TO 3
IF pieces(piece, rot, lp, 0) = 1 AND x = 10 THEN x = 9: GOTO skip
IF pieces(piece, rot, lp, 0) = 2 AND x = 9 THEN x = 8: GOTO skip
IF pieces(piece, rot, lp, 0) = 3 AND x = 8 THEN x = 7: GOTO skip
NEXT
FOR ly = 0 TO 3
FOR lx = 0 TO 3
FOR pc = 0 TO 3
IF x + lx >= 0 AND x + lx <= 10 AND y + ly <= 20 THEN
IF arr(x + lx, y + ly) <> 0 AND pieces(piece, rot, pc, 0) = lx AND pieces(piece, rot, pc, 1) = ly THEN
x = x - 1
GOTO skip
END IF
END IF
NEXT: NEXT: NEXT

CASE "5": rot = (rot + 1) MOD 4
FOR lp = 0 TO 3
IF pieces(piece, rot, lp, 0) = 1 AND x = 10 THEN
rot = rot - 1: IF rot = -1 THEN rot = 3
GOTO skip
END IF
IF pieces(piece, rot, lp, 0) = 2 AND x = 9 THEN
rot = rot - 1: IF rot = -1 THEN rot = 3
GOTO skip
END IF
IF pieces(piece, rot, lp, 0) = 3 AND x = 8 THEN
rot = rot - 1: IF rot = -1 THEN rot = 3
GOTO skip
END IF
IF pieces(piece, rot, lp, 0) = 0 AND x = -1 THEN
rot = rot - 1: IF rot = -1 THEN rot = 3
GOTO skip
END IF
IF pieces(piece, rot, lp, 0) = 1 AND x = -2 THEN
rot = rot - 1: IF rot = -1 THEN rot = 3
GOTO skip
END IF
NEXT
FOR ly = 0 TO 3
FOR lx = 0 TO 3
FOR pc = 0 TO 3
IF x + lx >= 0 AND x + lx <= 10 AND y + ly <= 20 THEN
IF arr(x + lx, y + ly) <> 0 AND pieces(piece, rot, pc, 0) = lx AND pieces(piece, rot, pc, 1) = ly THEN
rot = rot - 1: IF rot = -1 THEN rot = 3
GOTO skip
END IF
END IF
FOR lpx = 0 TO 3
IF y + pieces(piece, rot, lpx, 1) >= 21 THEN
rot = rot - 1: IF rot = -1 THEN rot = 3
GOTO skip
END IF
NEXT
NEXT: NEXT: NEXT

CASE CHR$(27): quit = 1

'CASE " ":
'y = y + 1
'FOR ly = 0 TO 3
'FOR lx = 0 TO 3
'FOR lp = 0 TO 3
'IF x + lx >= 0 AND x + lx <= 10 AND y + ly <= 20 THEN
'IF arr(x + lx, y + ly) <> 0 AND pieces(piece, rot, lp, 0) = lx AND pieces(piece, rot, lp, 1) = ly THEN
'FOR lp2 = 0 TO 3
'ox(lp2) = 0
'oy(lp2) = 0
'arr(x + pieces(piece, rot, lp2, 0), y + pieces(piece, rot, lp2, 1) - 1) = col
'NEXT
'piece = FIX(RND * 6): y = 0: x = 4: col = FIX(RND * numcol) + 1
'check
'GOTO dun2
'END IF
'END IF
'IF pieces(piece, rot, lp, 1) + y >= 21 THEN
'FOR lp2 = 0 TO 3
'ox(lp2) = 0
'oy(lp2) = 0
'arr(x + pieces(piece, rot, lp2, 0), y + pieces(piece, rot, lp2, 1) - 1) = col
'NEXT

'piece = FIX(RND * 6): y = 0: x = 4: col = FIX(RND * numcol) + 1
'check
'GOTO dun2
'END IF
'NEXT: NEXT: NEXT
'dun2:


END SELECT
skip:

rd = 0
FOR lp = 0 TO 3
IF ox(lp) <> pieces(piece, rot, lp, 0) * 8 + x * 8 THEN rd = 1
IF oy(lp) <> pieces(piece, rot, lp, 1) * 8 + y * 8 THEN rd = 1
NEXT
IF rd THEN
FOR lp = 0 TO 3
PUT (ox(lp), oy(lp)), blocks(0, 0), PSET
NEXT
FOR lp = 0 TO 3
PUT (pieces(piece, rot, lp, 0) * 8 + x * 8, pieces(piece, rot, lp, 1) * 8 + y * 8), blocks(0, col), PSET
NEXT
END IF
LOOP UNTIL quit = 1
LINE (0, 0)-(87, 167), 0, BF
END SUB

SUB ldhigh
OPEN "hi.dat" FOR INPUT AS #1
FOR lp = 0 TO 9
LINE INPUT #1, wrk$
hiscore$(lp, 0) = MID$(wrk$, 1, 20)
hiscore$(lp, 1) = MID$(wrk$, 21, 1)
hiscore$(lp, 2) = MID$(wrk$, 23, 5)
NEXT
CLOSE #1
END SUB

