# Write a better Tetris AI

August 8 2010 at 6:59 PM

Hi, this is my first post.

This is an old QB program that was an "attempt" at writing an AI that could play Tetris forever, but it still dies.

I always saw this program as a neat challenge so I googled, landed here and now I'm posting it.

Modify it or start from scratch and beat this program's avg/high score.

I will try to answer any questions about it, or if needed, I can break out it's scoring and block types if you want to start from scratch.

http://pastebin.com/CQ9SNCW4

Enjoy, and good luck,
Randy Taylor.
---

DECLARE SUB pal (c%, r%, g%, B%)
SCREEN 13
RANDOMIZE TIMER
'DEF SEG = &HA000
DEFINT A-Z
' \$DYNAMIC
' --------15 is text
boldr! = 0: boldg! = 0: boldb! = 0
pal 255, INT(boldr!), INT(boldg!), INT(boldb!)
pal 15, INT(bolr!), INT(boldg!), INT(boldb!)
'pal 255, 20, 20, 20
sp! = .001
sil = 1
DIM z(20, 13) AS INTEGER, temp(4, 4) AS INTEGER
DIM piece(4, 4) AS INTEGER, board(33, 23) AS INTEGER
DIM available(29) AS INTEGER, piece2(4, 4) AS INTEGER
DIM boardAI(33, 23) AS INTEGER: ', block(8, 8) AS INTEGER
'DIM tag(3), tagT(3) AS LONG
DIM eldropo(30000) AS INTEGER
DIM palr(255) AS INTEGER, palg(255) AS INTEGER, palb(255) AS INTEGER
DIM scrollsprite(2245) AS INTEGER
FOR num = 1 TO 20: FOR d = 0 TO 11
READ q: z(num, d) = q: NEXT d: NEXT num

blank\$ = " "
blank2\$ = " "
titleT\$ = "TETRiS rAIn (c)2003 by Randy Taylor"
title\$ = blank\$ + titleT\$ + blank\$

init:
speed = 0: maxy = 18: pau = 1: qui = pau: ic = 1
scroll = 1
'tag(0) = 2: tag(1) = 2: tag(2) = 2: tag(3) = 2
multione = 1: multitwo = 0: multithree = 0: hollow = 0: borderblk = 0
FOR xx = 0 TO 33: FOR yy = 0 TO 22
board(xx, yy) = 0
NEXT yy: NEXT xx
level:
palr(20) = 10: palg(20) = 30: palb(20) = 10
samehue! = 0

GOSUB setthepalette

LINE (0, 0)-(320, 180), 255, BF: ' background
demo = 1: score! = 0: DSPscore! = 0: lev = 0
bonus = 0: lines = 0: numblocks = 0
coin = 1: yy = 12: oyy = yy
GOSUB update
tempr = palr(lev + 20)
tempg = palg(lev + 20)
tempb = palb(lev + 20)

herewego:
GOSUB newpiece
t! = TIMER: split! = t!

start: ' <--------------------------------------------------<START MAIN LOOP
'GOSUB rollscore
IF TIMER < split! + 0! THEN GOTO start
GOSUB rollscore
FPS% = FPS% + 1
IF starttime# + 1 < TIMER THEN
IF FPS% > 50 THEN FPS2% = FPS%
FPS% = 0
starttime# = TIMER
END IF

g\$ = INKEY\$: g\$ = RIGHT\$(g\$, 1)
IF g\$ <> "" THEN gASC = ASC(g\$) ELSE gASC = 0
'IF g\$ = "s" OR g\$ = "S" THEN GOSUB silent
IF g\$ = "x" OR g\$ = "X" THEN GOSUB expert
'IF g\$ = " " OR g\$ = "p" THEN GOSUB pause
IF g\$ = "q" OR g\$ = "Q" OR gASC = 27 THEN GOSUB quit
IF g\$ = "+" OR g\$ = "=" THEN
IF sp! = 0 THEN NOrefresh = 1
sp! = sp! - .02
IF sp! < 0 THEN sp! = 0
'NOrefresh = 1
GOSUB wipe: sil = 1
END IF
IF (g\$ = "-" OR g\$ = "_") AND NOrefresh = 1 THEN NOrefresh = 0: GOTO skipfaster
IF g\$ = "-" OR g\$ = "_" THEN
sp! = sp! + .02
IF sp! > .02 THEN sp! = .02
END IF
'targetX = 25: ' enable to make it loose quick
' <---------------------- next lines maneuver the block
targetXten = targetX * 10
IF targetXten = x THEN GOTO skiplr
skipfaster:
IF targetXten < x THEN GOSUB left: IF hit = 1 THEN targetX = targetX + 1
IF targetXten > x THEN GOSUB right: IF hit = 1 THEN targetX = targetX - 1
IF targetXten <> x THEN GOTO skipfaster

IF rotateAI = 0 THEN GOTO skiprot
skiplr:
IF rotateAI > 0 THEN GOSUB clock: rotateAI = rotateAI - 1
IF rotateAI < 0 THEN GOSUB counter: rotateAI = rotateAI + 1
IF rotateAI <> 0 THEN GOTO skiplr

skiprot:
'IF targetXten = x THEN
GOSUB down: IF hit = 1 THEN GOTO inplace
'IF TIMER > t! + 1 - speed THEN GOSUB down: IF hit = 1 THEN GOTO inplace
'IF DSPscore! < score! THEN GOSUB rollscore
GOSUB rollscore
'GOSUB bordercolor

IF NOrefresh = 0 THEN WAIT &H3DA, 8
split! = TIMER
GOTO start: ' <---------------------------------------------<END MAIN LOOP

' ---------------------------------------------------------------------
' --------------------------<<<<<<<<<<<< BEGIN MAJOR CHUNK OF CODE
' ---------------------------------------------------------------------
' --< from here all the way through the end of AI: is one straight shot
' --< newpiece is called to pick a piece AND figure out where to put it

newpiece:
levcolor = INT(lev / 5) * 5
col = INT(RND(1) * 5) + levcolor + 20
x = 240: y = 10
ex = 9: IF pert = 1 THEN ex = 20
IF pNEXT = 0 THEN pNEXT = INT(RND(1) * ex) + 1
p = pNEXT
samedamnblock:
pNEXT = INT(RND(1) * ex) + 1
IF p = pNEXT THEN GOTO samedamnblock
'N = 0
currentROT = 0
'FOR yy = 0 TO 2: FOR xx = 0 TO 2
'piece(xx, yy) = z(pNEXT, N): N = N + 1
'NEXT xx: NEXT yy
'x = 145: ' y = 16
'y = 0
'LINE (145, 15)-(176, 50), 0, BF:' <<<---- wtf

N = 0
FOR yy = 0 TO 2: FOR xx = 0 TO 2
piece(xx, yy) = z(p, N): N = N + 1
NEXT xx: NEXT yy
x = 160: y = 10

'num = 0
'FOR yy = 0 TO 2: FOR xx = 0 TO 2
'IF piece(xx, yy) = 1 THEN num = num + 1
'NEXT xx: NEXT yy
'numblocks = numblocks + num
'numblocks = 1

IF pert = 1 THEN bns = 2 ELSE bns = 1: ' <<<<<<<--------??????
IF bonus = 1 THEN score! = score! + 100 * bns: ' WHY IS THE SCORRING
IF bonus = 2 THEN score! = score! + 300 * bns: ' CODE HERE???
IF bonus = 3 THEN score! = score! + 600 * bns: ' -----------------

'<-------------------------- NEW LEVEL - - - CHANGE COLORS
IF lines > 3 THEN
lev = lev + 1
IF lev > 230 THEN lev = 0
lines = 0
' speed = speed + .1
'IF RND(1) > .9 THEN borderblk = 1
'IF borderblk = 1 AND RND(1) > .85 THEN borderblk = 0: backblk = 0
'IF (lev > 8 AND lev < 11) OR (lev > 48 AND lev < 56) THEN
' borderblk = 1
' END IF
'IF (lev > 98 AND lev < 111) OR (lev > 148 AND lev < 156) THEN
' borderblk = 1
' END IF
'borderblk = 0: ' -------------<<<<<< NO MORE BLACK TEXT

tempr = palr(lev + 20)
tempg = palg(lev + 20)
tempb = palb(lev + 20)
'IF borderblk = 1 THEN tempr = 0: tempg = 0: tempb = 0
'morecolor! = .9: IF borderblk = 1 THEN morecolor! = .5
'multione = 0: IF RND(1) > morecolor! - .7 THEN multione = 1
'multitwo = 0:
'IF borderblk = 1 AND RND(1) > morecolor! - 1 AND lev > -1 THEN multitwo = 1
'multione = 1
'multithree = 0

END IF
GOSUB update

AI:
' -------------- imaginarally drop block and test for perfect placement

bestY = 0: bestX = 28: bestROT = 0: bestROW = 0
goodY = 0: goodX = 28: goodROT = 0: goodROW = 0
clearY = 0: clearX = 28: clearROT = 0: clearROW = 0
pegY = 0: pegX = 28: pegROT = 0: pegPEGS! = 0: pegROW = 0
peg! = 0

FOR xx = 0 TO 2: FOR yy = 0 TO 2
piece2(xx, yy) = piece(xx, yy)
NEXT yy: NEXT xx

FOR targetX = 0 TO 29: ' -----------DROP BLOCK ON EACH COLOMN
imagX = targetX * 10 ' -----------------THIS IS A LOOOOONG LOOP
FOR rotateAI = 0 TO 3: ' -----------TEST ALL ROTATIONS
imagY = 0
peg! = 0
dropblock:
hit = 0: foundgood = 1

FOR yy = 0 TO 2: FOR xx = 0 TO 2: ' CHECK FOR HIT
IF piece2(xx, yy + 1) = 1 THEN GOTO skipblock
IF piece2(xx, yy) = 0 THEN GOTO skipblock
ck = POINT(xx * 10 + imagX, yy * 10 + imagY + 10): '-----<<< was + 12
IF ck <> 255 THEN hit = 1
IF imagY = 180 THEN hit = 1
skipblock:
NEXT xx: NEXT yy
IF hit = 0 THEN imagY = imagY + 10: GOTO dropblock

FOR yy = 0 TO 2: FOR xx = 0 TO 2: ' CHECK BELOW FOR EMPTY SPACE
IF piece2(xx, yy + 1) = 1 THEN GOTO skipblock2
IF piece2(xx, yy) = 0 THEN GOTO skipblock2

scanY = imagY
scantobottom:
ck = POINT(xx * 10 + imagX, yy * 10 + scanY + 10)
IF ck = 255 THEN foundgood = foundgood - 1
IF scanY > 170 THEN GOTO skipblock2: ' ------------------<<<<new line
IF ck <> 1 THEN scanY = scanY + 10: GOTO scantobottom

skipblock2:
NEXT xx: NEXT yy

'---------------------------------------SCAN BOARD FOR COMPLETE ROWS
'copy 3 rows from board() into boardAI()
clearTMP = 0
FOR dy = imagY \ 10 TO imagY \ 10 + 3
FOR dx = 0 TO 31
boardAI(dx, dy) = board(dx, dy)
NEXT dx: NEXT dy
'input piece() blocks into boardAI()
FOR yy = 0 TO 2
FOR xx = 0 TO 2
IF piece2(xx, yy) = 1 THEN
boardAI(targetX + xx, imagY \ 10 + yy) = 1
END IF
NEXT xx: NEXT yy
'check the 3 boardAI() rows for a winner
FOR yy = imagY \ 10 TO imagY \ 10 + 3
count = 0
FOR xx = 0 TO 31
IF boardAI(xx, yy) = 1 THEN count = count + 1
NEXT xx
IF count > 30 THEN clearTMP = clearTMP + 1: ' --<<<<< ?????
NEXT yy

' --------------------------------------SCAN FOR PEG-IN-HOLE
peg! = 0

FOR yy = 0 TO 2: FOR xx = 0 TO 2: ' CHECK RIGHT FOR HIT
IF piece2(xx + 1, yy) = 1 THEN GOTO skipright
IF piece2(xx, yy) = 0 THEN GOTO skipright
ck = POINT(xx * 10 + imagX + 12, yy * 10 + imagY)
IF ck <> 255 THEN peg! = peg! + 1: GOTO skipright
'IF xx * 10 + imagX > 310 THEN peg! = peg! + 1: ' ---<<< SIDE PROB
skipright:
NEXT xx: NEXT yy

FOR yy = 0 TO 2: FOR xx = 0 TO 2: ' CHECK LEFT FOR HIT
IF xx = 0 THEN GOTO skipleftlook
IF piece2(xx - 1, yy) = 1 THEN GOTO skipleft
skipleftlook:
IF piece2(xx, yy) = 0 THEN GOTO skipleft
ck = POINT(xx * 10 + imagX - 2, yy * 10 + imagY)
IF ck <> 255 THEN peg! = peg! + 1: GOTO skipleft
'IF xx * 10 + imagX < 10 THEN peg! = peg! + 1: ' ---<<< SIDE PROB
skipleft:
NEXT xx: NEXT yy

'---------------------------------------FIND THE BEST OF THE BEST
' ---------first shave off empty tops
FOR N = 0 TO 0: count = 0: FOR xx = 0 TO 2
IF piece2(xx, N) = 1 THEN count = count + 1
NEXT xx
IF count = 0 THEN imagY = imagY + 10
NEXT N

IF clearTMP > clearROW THEN
clearROW = clearTMP: clearY = imagY
clearX = targetX: clearROT = rotateAI
END IF

IF foundgood = 1 AND imagY > bestY THEN
bestY = imagY: bestROT = rotateAI
bestX = targetX: bestROW = clearTMP
END IF

IF foundgood = 1 AND imagY = bestY AND targetX < bestX THEN
bestY = imagY: bestROT = rotateAI
bestX = targetX: bestROW = clearTMP
END IF

'IF foundgood = 0 AND imagY > goodY THEN
' goodY = imagY: goodROT = rotateAI
' goodX = targetX: goodROW = clearTMP
' END IF

'IF foundgood < 0 AND imagY - goodY > 39 THEN
' goodY = imagY: goodROT = rotateAI
' goodX = targetX: goodROW = clearTMP
' END IF

IF imagY > goodY OR imagY = goodY AND targetX < goodX THEN
goodY = imagY: goodROT = rotateAI
goodX = targetX: goodROW = clearTMP
END IF

IF peg! > pegPEGS! THEN
pegPEGS! = peg!: pegY = imagY: pegROW = clearTMP
pegX = targetX: pegROT = rotateAI
END IF

FOR yy = 0 TO 2: FOR xx = 0 TO 2 ' -------------------
temp(xx, yy) = piece2(xx, yy) ' - ROTATE THE BLOCK
NEXT xx: NEXT yy ' -
FOR yy = 0 TO 2: FOR xx = 0 TO 2 ' -
piece2(2 - yy, xx) = temp(xx, yy) ' -
NEXT xx: NEXT yy ' -------------------

'GOSUB rollscore
NEXT rotateAI
GOSUB rollscore
NEXT targetX
' <------------- END OF DROPING BLOCK ON EVERY SQUARE LOOP

decesions: '-------------------------------------------- MAKE FINAL CHOICE
rotateAI = bestROT: targetX = bestX
logic\$ = "---"
IF bestY = 0 AND goodY > 0 THEN
: ' ------------- PREVENT SLUFF
logic\$ = "-^-"
rotateAI = goodROT: targetX = goodX
END IF

'IF bestY < 51 AND goodY > bestY THEN
' logic\$ = "-+-"
' rotateAI = goodROT: targetX = goodX
' END IF

'IF bestY < 81 AND clearROW > 0 THEN
': ' ------------ IF IN TROUBLE AND HAVE A SCORE READY
' logic\$ = "*-*"
' rotateAI = clearROT: targetX = clearX
' END IF

IF pegPEGS! > 4 THEN
: ' ------------ PEG-IN-HOLE
logic\$ = "#!#"
rotateAI = pegROT: targetX = pegX
END IF

IF goodY - bestY > 49 THEN
: ' ------------- DEFENSE ANTI-TOWER
logic\$ = "___"
rotateAI = goodROT: targetX = goodX
END IF

IF pegPEGS! > 3 AND pegROW > 0 THEN
: ' ------------ MOSTLY A HOLE AND A SCORE THEN USE IT
logic\$ = "#|#"
rotateAI = pegROT: targetX = pegX
END IF

IF clearROW > bestROW + 1 THEN
: ' ------------ KILLER SCORE -- ALWAYS USE
logic\$ = "***"
rotateAI = clearROT: targetX = clearX
END IF
x = targetX * 10
y = 10
'IF x > 290 THEN x = 290
'IF x < 10 THEN x = 10
IF rotateAI = 3 THEN rotateAI = -1
RETURN: ' ---------------------------------------------------------
' ----------------------------------- END OF AI
' ---------------------------------------------------------

down: ' <<<<------------------------------------- MAJOR SECTION OF CODE
' <<<<------------------------------------- HANDLES DROPING THE BLOCK
' <<<<------------------------------------- AND DROPING THE BOARD
hit = 0
FOR yy = 0 TO 2: FOR xx = 0 TO 2
IF piece(xx, yy + 1) = 1 THEN GOTO noblock
IF piece(xx, yy) = 0 THEN GOTO noblock
IF yy * 10 + y + 10 < 0 THEN GOTO noblock
ck = POINT(xx * 10 + x, yy * 10 + y + 10): '-----------<<<< was +12
IF ck <> 255 THEN hit = 1
'IF y = 180 THEN hit = 1
noblock:
NEXT xx: NEXT yy

IF hit = 0 AND NOrefresh = 1 THEN
GOSUB wipe
y = y + 10
t! = TIMER: split! = t!
RETURN
END IF
IF hit = 0 THEN GOSUB wipe: y = y + 10
GOSUB plot: '---------------<<<<< MAIN PLOT CALL (ONLY HAPPENS ONCE)
IF hit = 1 AND y = 10 THEN GOTO over
IF hit = 1 THEN RETURN
t! = TIMER: split! = t!
RETURN

inplace: ' < -------------------- < BLOCK CAME TO REST
bonus = 0
IF y \ 10 < maxy THEN maxy = y \ 10
FOR yy = 0 TO 2: FOR xx = 0 TO 2
IF piece(xx, yy) = 1 THEN board(x \ 10 + xx, y \ 10 + yy) = 1
NEXT xx: NEXT yy

yy = 19
inplaceloop:
count = 0: yy = yy - 1: IF yy = maxy OR yy = 1 THEN GOTO herewego
FOR xx = 0 TO 31
IF board(xx, yy) = 1 THEN count = count + 1
NEXT xx: IF count > 31 THEN GOTO drop
GOTO inplaceloop

drop: ' < -------------------- < FOUND A COMPLETE ROW
GOSUB vaporize
FOR dy = yy TO maxy STEP -1: FOR dx = 0 TO 31
board(dx, dy) = board(dx, dy - 1)
NEXT dx: NEXT dy

'-----------------------------------------------------------------------
' NEW DROP DOWN GRAPHICS
'-----------------------------------------------------------------------
dy = yy * 10 + 8: dy = yy * 10 + 8
GET (0, maxy * 10 - 10)-(319, dy - 10), eldropo
IF NOrefresh = 0 THEN
FOR qy = maxy * 10 - 9 TO maxy * 10
PUT (0, qy), eldropo, PSET
'GOSUB bordercolor
'IF DSPscore! < score! THEN GOSUB rollscore
GOSUB rollscore
WAIT &H3DA, 8
NEXT qy
ELSE
PUT (0, maxy * 10), eldropo, PSET
END IF
yy = yy + 2: IF yy > 19 THEN yy = 19
bonus = bonus + 1: lines = lines + 2: maxy = maxy + 1
'numblocks = numblocks - 11: IF numblocks < 1 THEN GOSUB super
GOTO inplaceloop

vaporize: ' < --------------------- < FANCY SCHMANCY
IF NOrefresh = 1 THEN RETURN
pal 3, 20, 20, 20
pal 254, backr, backg, backb
FOR dx = 0 TO 31
LINE (dx * 10, yy * 10)-(dx * 10 + 8, yy * 10 + 8), 3, BF
LINE (dx * 10, yy * 10)-(dx * 10 + 8, yy * 10 + 8), 254, B
NEXT dx
GOSUB vapormation
LINE (0, yy * 10)-(318, yy * 10 + 8), 255, BF
RETURN

vapormation: ' ---------------- animate palette of c 3
a = 0: B = 63: q = 30
' --- if background is white then reverse vapormation
IF backr = 63 THEN a = 63: B = 0: q = -30: pal 254, 63, 63, 63
FOR c = a TO B STEP q: ' < --------forward animation
c2 = c - 20: IF c2 < 0 THEN c2 = 0
pal 3, c, c, c
'pal 254, c2, c2, c2
'GOSUB bordercolor
'IF DSPscore! < score! THEN GOSUB rollscore
GOSUB shortpause
GOSUB rollscore
WAIT &H3DA, 8
NEXT c
q = -q
FOR c = B TO a STEP q: ' < ----------backwards animation
c2 = c - 20: IF c2 < 0 THEN c2 = 0
pal 3, c, c, c
pal 254, c2, c2, c2
'GOSUB bordercolor
'IF DSPscore! < score! THEN GOSUB rollscore
GOSUB shortpause
GOSUB rollscore
WAIT &H3DA, 8
NEXT c
RETURN

shortpause:
t3! = TIMER
palpause:
'GOSUB bordercolor
'IF DSPscore! < score! THEN GOSUB rollscore
GOSUB rollscore
IF t3! + .0001 > TIMER THEN GOTO palpause
RETURN
' <-------------------------------------- END OF DOWN SEQUIENCE
' <-----------------------------------------------------------------

plot:
'c = lev + 20
FOR yy = 0 TO 2: FOR xx = 0 TO 2
IF piece(xx, yy) = 0 THEN GOTO noplot
IF y + yy * 10 < 0 THEN GOTO noplot: '<-- BLOCK COMES FROM ABOVE TOP OF SCREEN
c = col
LINE (xx * 10 + x, yy * 10 + y)-(xx * 10 + x + 8, yy * 10 + y + 8), c, BF
noplot:
NEXT xx: NEXT yy
RETURN

wipe:
FOR yy = 0 TO 2: FOR xx = 0 TO 2
IF piece(xx, yy) = 0 THEN GOTO nowipe
IF y + yy * 10 < 0 THEN GOTO nowipe
c = 255
LINE (xx * 10 + x, yy * 10 + y)-(xx * 10 + x + 8, yy * 10 + y + 8), c, BF
nowipe:
NEXT xx: NEXT yy
RETURN

left:
hit = 0
FOR yy = 0 TO 2: ck = 0
FOR xx = 0 TO 2
IF ck = 1 THEN GOTO leftck
IF piece(xx, yy) = 1 THEN ck = 1: pt = xx
leftck:
NEXT xx
IF ck = 1 AND POINT(pt * 10 + x - 2, yy * 10 + y + 2) <> 255 THEN hit = 1
NEXT yy
'IF hit = 0 AND NOrefresh = 1 THEN x = x - 10: RETURN: '----<<<
'IF hit = 0 THEN GOSUB msnd: GOSUB wipe: x = x - 10: GOSUB plot
'hit = 0:
IF hit = 0 THEN x = x - 10
RETURN

right:
hit = 0
FOR yy = 0 TO 2: ck = 0
FOR xx = 2 TO 0 STEP -1
IF ck = 1 THEN GOTO rightck
IF piece(xx, yy) = 1 THEN ck = 1: pt = xx
rightck:
NEXT xx
IF ck = 1 AND POINT(pt * 10 + x + 10, yy * 10 + y + 2) <> 255 THEN hit = 1
NEXT yy
'IF hit = 0 AND NOrefresh = 1 THEN x = x + 10: RETURN: '------<<<<
'IF hit = 0 THEN GOSUB msnd: GOSUB wipe: x = x + 10: GOSUB plot
'hit = 0:
IF hit = 0 THEN x = x + 10
RETURN

counter:
'IF NOrefresh = 0 THEN GOSUB wipe
GOSUB tmp
FOR yy = 0 TO 2: FOR xx = 0 TO 2
piece(yy, 2 - xx) = temp(xx, yy)
NEXT xx: NEXT yy
GOSUB check
currentROT = currentROT - 1: IF currentROT = -2 THEN currentROT = 2
'IF NOrefresh = 0 THEN GOSUB plot
RETURN

clock:
'IF NOrefresh = 0 THEN GOSUB wipe
GOSUB tmp
FOR yy = 0 TO 2: FOR xx = 0 TO 2
piece(2 - yy, xx) = temp(xx, yy)
NEXT xx: NEXT yy
GOSUB check
currentROT = currentROT + 1: IF currentROT = 3 THEN currentROT = -1
'IF NOrefresh = 0 THEN GOSUB plot
RETURN

tmp:
FOR yy = 0 TO 2: FOR xx = 0 TO 2
temp(xx, yy) = piece(xx, yy)
NEXT xx: NEXT yy
RETURN

check:
hit = 0
FOR yy = 0 TO 2: FOR xx = 0 TO 2
IF piece(xx, yy) = 1 AND POINT(xx * 10 + x + 5, yy * 10 + y + 5) <> 255 THEN hit = 1
NEXT xx: NEXT yy
IF hit = 0 THEN RETURN
FOR yy = 0 TO 2: FOR xx = 0 TO 2
piece(xx, yy) = temp(xx, yy)
NEXT xx: NEXT yy
RETURN

over:
lastscore! = score!
IF score! > high! THEN high! = score!
dy = yy * 10 + 8: dy = yy * 10 + 8
'LOCATE 2, 17: PRINT "GAME OVER"
deathy = 1
tempr = 0: tempg = 0: tempb = 0
backr = 0: backg = 0: backb = 0
endeath: ' ----------------0000000000----<<<<<<<<<<<<<<<<<, NEW DEATH
'LINE (189, 0)-(190, 18), 0, BF
GET (0, 0)-(319, 179), eldropo: ' gets the board
FOR qy = 1 TO 10: ' scroll board down one
PUT (0, 0 + qy), eldropo, PSET
'GOSUB bordercolor
'GOSUB bordercolor
'GOSUB bordercolor
'IF DSPscore! < score! THEN GOSUB rollscore
g\$ = INKEY\$: g\$ = RIGHT\$(g\$, 1)
IF g\$ <> "" THEN gASC = ASC(g\$) ELSE gASC = 0
IF g\$ = "q" OR g\$ = "Q" OR gASC = 27 THEN GOSUB quit
GOSUB rollscore
WAIT &H3DA, 8
NEXT qy

FOR dy = 19 TO 1 STEP -1: FOR dx = 0 TO 31
board(dx, dy) = board(dx, dy - 1)
NEXT dx: NEXT dy

IF deathy < 19 THEN deathy = deathy + 1: GOTO endeath
'FOR i = 1 TO 25: GOSUB bordercolor: NEXT i
GOTO init

update:
'LOCATE 25, 2: PRINT "Score:";
'IF DSPscore! = 0 THEN LOCATE 25, 8: PRINT " ";
'LOCATE 25, 8: PRINT DSPscore!
GOSUB scrolltext
RETURN

rollscore:
'IF score! > DSPscore! THEN DSPscore! = DSPscore! + 100
'LOCATE 25, 8: PRINT DSPscore!;
GOSUB scrolltext
RETURN

msnd:
'IF sil = 0 THEN PLAY "mbo3f32a32"
RETURN

pause:
GOSUB rollscore
'GOSUB bordercolor
'IF DSPscore! < score! THEN GOSUB rollscore
'IF pau = 1 THEN LOCATE 20, 11: PRINT "-PAUSED-";
'IF pau = -1 THEN LOCATE 20, 11: PRINT " ";
IF TIMER > t! THEN pau = pau * -1: t! = TIMER + .3: GOTO pause
g\$ = INKEY\$: g\$ = RIGHT\$(g\$, 1)
IF g\$ <> "" THEN gASC = ASC(g\$) ELSE gASC = 0
IF g\$ = "q" OR g\$ = "Q" OR gASC = 27 THEN GOSUB quit: GOTO pause
IF g\$ = "s" OR g\$ = "S" THEN GOSUB silent: GOTO pause
IF g\$ = "a" OR g\$ = "A" THEN GOSUB expert: GOTO pause
IF g\$ = "" THEN GOTO pause
'LOCATE 20, 11: PRINT " ";
RETURN

super:
RETURN
score! = score! + 1000
cleartext\$ = " CLEAR BONUS! +1000 "
FOR i = 1 TO LEN(cleartext\$) - 10
clearit\$ = MID\$(cleartext\$, i, 13)
'LOCATE 22, 25: PRINT clearit\$;
GOSUB shortpause: GOSUB shortpause
tempr = INT(RND(1) * 43) + 20
tempg = INT(RND(1) * 43) + 20
tempb = INT(RND(1) * 43) + 20
'GOSUB bordercolor
GOSUB rollscore
'IF score! < DSPscore! THEN GOSUB rollscore
NEXT i
LINE (0, 10)-(320, 180), 255, BF: ' background
'LINE (0, 10)-(8, 180), 1, BF: ' next 3 draw the cup
'LINE (0, 180)-(310, 190), 1, BF
'LINE (300, 180)-(310, 10), 1, BF
RETURN

silent:
IF sil = 0 THEN sil = 1: RETURN
'LOCATE 17, 11: PRINT "-SILENT-"; : RETURN
sil = 0
'LOCATE 17, 11: PRINT " ";
RETURN

expert:
IF pert = 0 THEN pert = 1: RETURN
'LOCATE 18, 11: PRINT "-EXPERT-"; : RETURN
pert = 0
'LOCATE 18, 11: PRINT " ";
RETURN

quit:
'GOSUB bordercolor
GOSUB rollscore
'IF DSPscore! < score! THEN GOSUB rollscore
'IF qui = 1 THEN LOCATE 20, 11: PRINT "QUIT Y/N"
'IF qui = -1 THEN LOCATE 20, 11: PRINT " "
IF TIMER > t! THEN qui = qui * -1: t! = TIMER + .3: GOTO quit
g\$ = INKEY\$: g\$ = RIGHT\$(g\$, 1)
IF g\$ <> "" THEN gASC = ASC(g\$) ELSE gASC = 0
'IF g\$ = "n" OR g\$ = "N" THEN LOCATE 20, 11: PRINT " ": RETURN
IF g\$ <> "" THEN END
IF g\$ = "" THEN GOTO quit
'LOCATE 20, 11: PRINT " "
RETURN

intro:
RETURN
qx = 190: qy = 30
FOR yy = 0 TO 4: FOR xx = 0 TO 10
IF q = 0 THEN GOTO skiptitblock
LINE (qx + xx * 10, qy + yy * 10)-(qx + xx * 10 + 8, qy + yy * 10 + 8), q + 16, BF
skiptitblock:
NEXT xx: NEXT yy

'LOCATE 9, 27: PRINT "TETRIS-AI"
'LOCATE 12, 25: PRINT "Randy Taylor"
'LOCATE 17, 25: PRINT "This game is"
'LOCATE 18, 25: PRINT "not playable."
'LOCATE 20, 25: PRINT "press any key"
'LOCATE 21, 25: PRINT " to start "
introloop:
IF INKEY\$ <> "" THEN GOTO introloop
firsttime = 1
DATA 1,1,0,1,0,0,1,0,0,0,0,0: ' L
DATA 0,0,0,1,1,0,1,1,0,0,0,0: ' box 2x2
DATA 1,0,0,1,0,0,1,0,0,0,0,0: ' |
DATA 0,0,0,1,1,0,0,1,0,0,0,0: ' ,
DATA 1,0,0,1,0,0,1,1,0,0,0,0: ' L other
DATA 1,0,0,1,1,0,1,0,0,0,0,0: ' T
DATA 0,1,0,1,1,0,1,0,0,0,0,0: ' S
DATA 1,0,0,1,1,0,0,1,0,0,0,0: ' S other
DATA 1,0,0,1,0,0,1,0,0,0,0,0: ' | same

DATA 0,1,0,1,1,1,0,1,0,0,0,0: ' +
DATA 0,0,0,1,0,1,1,1,1,0,0,0: ' U
DATA 0,0,1,1,1,1,1,0,0,0,0,0: ' Z
DATA 1,0,0,1,1,1,0,0,1,0,0,0: ' Z other
DATA 1,1,1,1,1,0,0,0,0,0,0,0: ' piggie
DATA 1,1,1,0,1,1,0,0,0,0,0,0: ' piggie other
DATA 0,1,1,1,1,0,1,0,0,0,0,0: ' bat
DATA 1,1,0,0,1,1,0,0,1,0,0,0: ' bat other
DATA 0,0,0,1,0,0,0,0,0,0,0,0: ' .
DATA 0,0,0,1,0,0,1,0,0,0,0,0: ' i
DATA 0,0,0,1,0,1,0,0,0,0,0,0: ' . .
FOR yy = 0 TO 8: FOR xx = 0 TO 8
READ q: block(xx, yy) = q
NEXT xx: NEXT yy
DATA 01,01,01,01,01,01,01,01,00
DATA 01,01,01,01,01,01,01,01,01
DATA 01,01,01,01,01,01,01,01,01
DATA 01,01,01,01,01,01,01,01,01
DATA 01,01,01,01,01,01,01,01,01
DATA 01,01,01,01,01,01,01,01,01
DATA 01,01,01,01,01,01,01,01,01
DATA 01,01,01,01,01,01,01,01,01
DATA 01,01,01,01,01,01,01,01,01

DATA 01,01,02,02,05,05,06,06,04,03,03
DATA 00,01,02,00,05,06,00,06,04,03,00
DATA 00,01,02,02,05,06,06,06,04,03,03
DATA 00,01,02,00,05,06,06,00,04,00,03
DATA 00,01,02,02,05,06,00,06,04,03,03

bordercolor:
IF TIMER < fade! + .1 THEN RETURN
IF oldr! = tempr AND oldg! = tempg AND oldb! = tempg THEN RETURN
difr! = (tempr - oldr!) / 32
'FOR i = 1 TO 8: difr! = difr! / 2: NEXT i
'shl difr!, 8
difg! = (tempg - oldg!) / 32
'FOR i = 1 TO 8: difg! = difg! / 2: NEXT i
difb! = (tempb - oldb!) / 32
'FOR i = 1 TO 8: difb! = difb! / 2: NEXT i
' IF oldr! - tempr <> 2 THEN oldr! = tempr
oldr! = oldr! + difr!
oldg! = oldg! + difg!
oldb! = oldb! + difb!
pal 15, INT(oldr!), INT(oldg!), INT(oldb!)
'END IF
RETURN

scrolltext:
IF scrolltimer! = 0 THEN scrolltimer! = TIMER: RETURN
IF scrolltimer! + .02 > TIMER THEN RETURN
GOSUB bordercolor
IF scrollpixel < 1 THEN GOTO scrollreprint
PUT (scrollpixel, 191), scrollsprite, PSET
scrollpixel = scrollpixel - 1
scrolltimer! = TIMER
RETURN

scrollreprint:
scrollpixel = 7

text\$ = title\$
text\$ = text\$ + "Score:" + STR\$(INT(score!)) + blank2\$
IF lastscore! > 0 THEN
text\$ = text\$ + blank2\$ + "Last Score:"
text\$ = text\$ + STR\$(INT(lastscore!)) + blank2\$
END IF
IF high! > 0 THEN
text\$ = text\$ + blank2\$ + "High Score:"
text\$ = text\$ + STR\$(INT(high!)) + blank2\$
END IF
text\$ = text\$ + "Logic:" + logic\$ + blank2\$
text\$ = text\$ + "FPS:" + STR\$(INT(FPS2%)) + blank2\$
text\$ = text\$ + blank\$

LOCATE 25, 1
PRINT " "; MID\$(text\$, scroll, 39);
scroll = scroll + 1
IF scroll > LEN(text\$) - 39 THEN scroll = 1
scrolltimer! = TIMER
GET (8, 191)-(320, 199), scrollsprite
RETURN

setthepalette:
FOR c = 20 TO 254
palagain:
numcolors = 62: overzero = 1
r = INT(RND(1) * numcolors) + overzero
g = INT(RND(1) * numcolors) + overzero
B = INT(RND(1) * numcolors) + overzero
brightness = INT((r + g + B) / 3)
' ---------HSV CALCULATIONS
'-- Calculate the value component
IF r > g THEN
V = r: m = g
ELSE
m = r: V = g
END IF
IF B > V THEN V = B
IF B < m THEN m = B
'-- Calculate the saturation component
IF V <> 0 THEN
sat! = 255 * (V - m) / V
ELSE
sat! = 0
END IF
'-- Calculate the hue
IF sat! = 0 THEN hue! = 0: GOTO donehue
Delta = V - m
IF r = V THEN hue! = (g - B) / Delta: GOTO donehue
IF g = V THEN hue! = 2 + (B - r) / Delta: GOTO donehue
hue! = 4 + (r - g) / Delta
donehue:
hue! = hue! * 60!
IF hue! < 0 THEN hue! = hue! + 360
cmyk = ABS(r - g) + ABS(g - B) + ABS(B - r)
IF samehue! = 0 THEN samehue! = hue!
IF c / 5 = INT(c / 5) THEN GOSUB getanewcolor
IF samehue! - hue! > 40 THEN GOTO palagain
IF hue! - samehue! > 40 THEN GOTO palagain
IF brightness < 15 OR brightness > 55 THEN GOTO palagain
IF sat! < 80 OR sat! > 200 THEN GOTO palagain

pal c, r, g, B
palr(c) = r: palg(c) = g: palb(c) = B
NEXT c

IF firsttime = 0 THEN
pal 1, INT(oldr!), INT(oldg!), INT(oldb!)
oldr! = r: oldg! = g: oldb! = B
END IF
firsttime = 1
pal 2, 10, 10, 30
RETURN

getanewcolor:
z = INT(RND(1) * 359) + 1
q = samehue! - z
IF q < 0 THEN q = q * -1
IF q < 100 THEN GOTO getanewcolor
samehue! = z
RETURN

oldupdate:
LOCATE 3, 2: PRINT "Level:";
IF lev = 0 THEN LOCATE 4, 2: PRINT " ";
LOCATE 4, 2: PRINT lev;
LOCATE 3, 14: PRINT "Next:";
LOCATE 6, 2: PRINT "Score:";
IF DSPscore! = 0 THEN LOCATE 7, 2: PRINT " ";
LOCATE 7, 2: PRINT DSPscore!;
LOCATE 9, 2: PRINT "Last Score:";
LOCATE 10, 2: PRINT lastscore!;

LOCATE 22, 1: PRINT "High Score:";
LOCATE 23, 2: PRINT high!;
LOCATE 12, 2: PRINT "MUTE: S";
LOCATE 13, 2: PRINT "EXPERT: X";
LOCATE 14, 2: PRINT "SPEED: +/-";
LOCATE 15, 2: PRINT "QUIT: ESC";

IF sil = 1 THEN LOCATE 17, 11: PRINT "-SILENT-";
IF pert = 1 THEN LOCATE 18, 11: PRINT "-EXPERT-";
RETURN

REM \$STATIC
DEFSNG A-Z
SUB pal (c%, r%, g%, B%)
OUT &H3C8, c%
OUT &H3C9, r%
OUT &H3C9, g%
OUT &H3C9, B%
END SUB

 Respond to this message
 Current Topic - Write a better Tetris AI