/************************************
名 称:Tetris
作 者:freewind
版 本:v1.0
时 间:2002-08
Email:freewind22@163.com
*************************************/
DECLARE SUB showfiles (introw AS INTEGER, intcol AS INTEGER, page AS INTEGER)
DECLARE SUB showfiles (introw AS INTEGER, intcol AS INTEGER, page AS INTEGER)
DECLARE SUB showfiles (introw AS INTEGER, intcol AS INTEGER, page AS INTEGER)
DECLARE SUB saveit (filename AS STRING)
DECLARE SUB resetcolor ()
DECLARE SUB changeboxbgcolor ()
DECLARE SUB changeforecolor ()
DECLARE SUB changetitlecolor ()
DECLARE SUB changetitlebgcolor ()
DECLARE SUB changeformcolor ()
DECLARE SUB changebgcolor ()
DECLARE SUB savesetting ()
DECLARE SUB getsetting ()
DECLARE FUNCTION getapppath$ ()
DECLARE SUB ldetlay (s AS LONG)
DECLARE SUB changeboxcolor ()
DECLARE SUB changeboxmode ()
DECLARE SUB getfiles ()
DECLARE SUB loaddata ()
DECLARE SUB loadit (filename AS STRING)
DECLARE SUB saveit (filename AS STRING)
DECLARE SUB setlevel ()
DECLARE SUB showspeed ()
DECLARE FUNCTION checkspace! (r AS INTEGER, c AS INTEGER)
DECLARE SUB movebox2 (dir AS STRING)
DECLARE FUNCTION findit! (strfilename AS STRING)
DECLARE SUB showtime ()
DECLARE SUB ENTER (introw AS INTEGER, intcol AS INTEGER, intlen AS INTEGER, mode AS STRING)
DECLARE SUB cursor (r AS INTEGER, c AS INTEGER, mode AS STRING)
DECLARE SUB scrollbar (x AS INTEGER, y AS INTEGER, inthei AS INTEGER, maxpage AS INTEGER, curpage AS INTEGER)
DECLARE SUB listbox (introw AS INTEGER, intcol AS INTEGER, introws AS INTEGER, scrollbar2 AS INTEGER)
DECLARE SUB savedata ()
DECLARE FUNCTION getfilename$ (strtitle AS STRING)
DECLARE SUB pause ()
DECLARE SUB showlevel ()
DECLARE SUB showscore ()
DECLARE SUB deleterow (r AS INTEGER)
DECLARE SUB checkrow (intline AS INTEGER)
DECLARE SUB changeshape ()
DECLARE FUNCTION waitpress$ ()
DECLARE SUB clearflag ()
DECLARE SUB gameover ()
DECLARE FUNCTION checkhave! ()
DECLARE SUB newbox ()
DECLARE SUB setflag ()
DECLARE SUB clearnext ()
DECLARE SUB drawbox (introw AS INTEGER, intcol AS INTEGER, num AS INTEGER, shape AS INTEGER, mode AS STRING)
DECLARE SUB movebox (dir AS STRING)
DECLARE SUB changemode ()
DECLARE SUB clearall ()
DECLARE SUB shownextbox (mode AS STRING)
DECLARE SUB textbox (x AS INTEGER, y AS INTEGER, intlen AS INTEGER, value AS STRING, mode AS STRING)
DECLARE SUB checkbox (x AS INTEGER, y AS INTEGER, value AS INTEGER)
DECLARE SUB drawbg ()
DECLARE SUB startgame ()
DECLARE SUB unload ()
DECLARE SUB drawpoint (l AS INTEGER, t AS INTEGER, w AS INTEGER, h AS INTEGER)
DECLARE SUB frmabout ()
DECLARE SUB Refresh ()
DECLARE SUB movemenu (arrow AS STRING)
DECLARE SUB listmenu (intpos AS INTEGER, strmode AS STRING)
DECLARE SUB openwindow (intleft AS INTEGER, inttop AS INTEGER, intwid AS INTEGER, inthei AS INTEGER, strtitle AS STRING, intbutton!)
DECLARE SUB button (intleft AS INTEGER, inttop AS INTEGER, intwid AS INTEGER, inthei AS INTEGER)
DECLARE SUB msg (strmsg AS STRING)
DECLARE SUB initstring ()
DECLARE SUB frmmain ()
DECLARE SUB createbox ()
DECLARE SUB initmap ()
DECLARE SUB testbox ()
DECLARE SUB initcolor ()
DECLARE SUB box (introw AS INTEGER, intcol AS INTEGER, mode AS STRING)
DECLARE SUB init ()
TYPE boxs
x AS INTEGER
y AS INTEGER
have AS INTEGER
END TYPE
CONST True = 1
CONST False = 0
SCREEN 12
DIM SHARED maxrow AS INTEGER, maxcol AS INTEGER, maxbox AS INTEGER, maxspeed AS INTEGER, maxlevel AS INTEGER
DIM SHARED bordercolor AS INTEGER, forecolor AS INTEGER, bgcolor AS INTEGER, trueforecolor
DIM SHARED menubgcolor AS INTEGER
DIM SHARED boxcolor AS INTEGER, background AS INTEGER, titlebgcolor AS INTEGER
DIM SHARED wid AS INTEGER, hei AS INTEGER
DIM SHARED startrow AS INTEGER, startcol AS INTEGER
DIM SHARED curnum AS INTEGER, curshape AS INTEGER
DIM SHARED nextnum AS INTEGER, nextshape AS INTEGER
DIM SHARED intload(500) AS INTEGER
DIM SHARED file0(500) AS INTEGER, file1(1000) AS INTEGER, file2(1000) AS INTEGER, file3 AS INTEGER, file4(1500) AS INTEGER
DIM SHARED file5(800) AS INTEGER, file6 AS INTEGER, file7(1000) AS INTEGER
DIM SHARED fileleft AS INTEGER, filetop(0 TO 7) AS INTEGER
DIM SHARED edit0(500) AS INTEGER, edit1(1000) AS INTEGER, edit2(1000) AS INTEGER
DIM SHARED editleft AS INTEGER, edittop(0 TO 2) AS INTEGER
DIM SHARED help0(500) AS INTEGER, help1(500) AS INTEGER, aboutcopy(1000) AS INTEGER
DIM SHARED helpleft AS INTEGER, aboutname(1000) AS INTEGER, aboutauthor(700) AS INTEGER
DIM SHARED showmenu AS INTEGER, mainmenu AS INTEGER, curmenu AS INTEGER
DIM SHARED btnok(200) AS INTEGER
DIM SHARED scalewidth AS INTEGER, scaleheight AS INTEGER
DIM SHARED row AS INTEGER, col AS INTEGER
DIM SHARED boxbg AS INTEGER
DIM SHARED scorerow AS INTEGER, scorecol AS INTEGER
DIM SHARED levelrow AS INTEGER, levelcol AS INTEGER
DIM SHARED speedrow AS INTEGER, speedcol AS INTEGER
DIM SHARED linerow AS INTEGER, linecol AS INTEGER
DIM SHARED nextrow AS INTEGER, nextcol AS INTEGER
DIM SHARED intscore(500) AS INTEGER, intlevel(500) AS INTEGER, intspeed(500) AS INTEGER
DIM SHARED intmode(1000) AS INTEGER, intlines(500) AS INTEGER
DIM SHARED advrow AS INTEGER, advcol AS INTEGER, advmode AS INTEGER
DIM SHARED score AS LONG
DIM SHARED level AS LONG, speed AS LONG, lines AS LONG
DIM SHARED lightcolor AS INTEGER, darkcolor AS INTEGER
DIM SHARED boxpos(0 TO 10) AS INTEGER
DIM SHARED gamestate AS STRING
DIM SHARED intfilename(600) AS INTEGER, intfilelist(600) AS INTEGER
DIM SHARED entervalue AS STRING, controlvalue AS STRING, initvalue AS STRING
DIM SHARED strfiles(50) AS STRING
DIM SHARED AppPath AS STRING
DIM SHARED totalfiles AS INTEGER
DIM SHARED music AS INTEGER, boxmode AS INTEGER
DIM detlay AS INTEGER, i AS INTEGER, center AS INTEGER
DIM strkey AS STRING, j AS INTEGER
DIM SHARED boxstate AS STRING
DIM SHARED initlevel AS INTEGER
DIM SHARED initspeed AS INTEGER
DIM change AS STRING
DIM SHARED textcolor AS INTEGER
DIM SHARED backgroundcolor AS INTEGER, titlecolor AS INTEGER
RANDOMIZE TIMER
strkey = ""
change = "level"
CLS
init
DIM SHARED flag(1 TO maxrow, 1 TO maxcol) AS boxs
initcolor
getsetting
IF bgcolor < 8 THEN lightcolor = bgcolor + 8 ELSE lightcolor = 15
bordercolor = boxbg + 6
IF bordercolor > 15 THEN bordercolor = bordercolor - 15
initstring
LINE (0, 0)-(639, 479), backgroundcolor, BF
msg "Loading..."
ldetlay 28
frmmain
drawbg
initmap
i = 0
detlay = 6000
center = 1000
j = 1
DO WHILE True
strkey = INKEY$
IF gamestate = "start" AND showmenu = False THEN
i = i + 1
IF i >= j * center AND (curnum = 8 OR curnum = 9 OR curnum = 12) THEN
j = j + 1
IF boxstate = "show" THEN boxstate = "hide" ELSE boxstate = "show"
drawbox row, col, curnum, curshape, boxstate
END IF
IF i > detlay - (speed + initspeed) * 600 THEN
i = 0
j = 1
movebox "down"
END IF
END IF
SELECT CASE strkey
CASE CHR$(27) 'Press ESC **********************************************
IF showmenu = True THEN
showmenu = False
listmenu 0, "Inactive"
END IF
CASE CHR$(0) + CHR$(34), CHR$(0) + CHR$(18), CHR$(0) + CHR$(35) '*******
IF showmenu = False THEN
showmenu = True
mainmenu = 1 'Press Alt+G
IF strkey = CHR$(0) + CHR$(18) THEN mainmenu = 2 'Press Alt+E
IF strkey = CHR$(0) + CHR$(35) THEN mainmenu = 3 'Press Alt+H
curmenu = 1
listmenu 0, "Active"
listmenu curmenu, "Active"
END IF
CASE CHR$(0) + "H" 'Press UP ******************************************
IF showmenu = True THEN
movemenu "Up"
ELSEIF gamestate = "start" THEN 'move box
changeshape
END IF
IF gamestate = "over" AND showmenu = False THEN
IF change = "level" THEN change = "speed" ELSE change = "level"
END IF
CASE CHR$(0) + "P" 'Press Down ****************************************
IF showmenu = True THEN
movemenu "Down"
ELSEIF gamestate = "start" THEN 'move box
movebox "quickdown"
END IF
IF gamestate = "over" AND showmenu = False THEN
IF change = "level" THEN change = "speed" ELSE change = "level"
END IF
CASE CHR$(0) + "M" 'Press Left ****************************************
IF showmenu = True THEN
movemenu "Left"
ELSEIF gamestate = "start" THEN 'move box
movebox "right"
END IF
IF gamestate = "over" AND showmenu = False THEN
IF change = "level" THEN
initlevel = initlevel + 1
IF initlevel > maxlevel THEN initlevel = 0
showscore
ELSE
initspeed = initspeed + 1
IF initspeed > maxlevel THEN initspeed = 0
showscore
END IF
END IF
CASE CHR$(0) + "K" 'Press Right **************************************
IF showmenu = True THEN
movemenu "Right"
ELSEIF gamestate = "start" THEN 'move box
movebox "left"
END IF
IF gamestate = "over" AND showmenu = False THEN
IF change = "level" THEN
initlevel = initlevel - 1
IF initlevel < 0 THEN initlevel = maxlevel
showscore
ELSE
initspeed = initspeed - 1
IF initspeed < 0 THEN initspeed = maxlevel
showscore
END IF
END IF
CASE CHR$(13) 'Press Enter **************************************
IF showmenu = True THEN
listmenu 0, "Inactive"
showmenu = False
SELECT CASE mainmenu
CASE 1 'Select Menu Game
SELECT CASE curmenu
CASE 1 'Start
startgame
CASE 2 'Pause
pause
CASE 4 'Load
loaddata
CASE 5 'Save
savedata
CASE 7 'Exit
unload
END SELECT
CASE 2 'Select Menu Edit
SELECT CASE curmenu
CASE 1
changeboxcolor
CASE 2
changeboxmode
END SELECT
CASE 3 'Select Menu Help
frmabout
END SELECT
END IF
CASE CHR$(32) 'Press Space *****************************
IF gamestate = "start" AND showmenu = False THEN changeshape
CASE CHR$(0) + ";" 'Prees F1 ********************************
IF showmenu = False THEN frmabout
CASE CHR$(0) + "<" 'Press F2 ********************************
IF showmenu = False THEN startgame
CASE CHR$(0) + ">" 'Press F4 ********************************
IF showmenu = False THEN pause
CASE CHR$(1) 'Press Ctrl+A ****************************
IF showmenu = False THEN changemode
CASE CHR$(19) 'Press Ctrl+S ****************************
IF showmenu = False THEN savedata
CASE CHR$(15) 'Press Ctrl+O ****************************
IF showmenu = False THEN loaddata
CASE CHR$(20) 'Press Ctrl+T *****************************
IF showmenu = False THEN showtime
CASE CHR$(3) 'Press Ctrl+C *****************************
IF showmenu = False AND gamestate <> "over" THEN gameover
CASE CHR$(14) 'Press Ctrl+N *****************************
IF showmenu = False THEN changeboxmode
CASE CHR$(2) 'Press Ctrl+B *****************************
IF showmenu = False THEN changeboxcolor
CASE CHR$(8) 'Press Ctrl+H *****************************
IF showmenu = False THEN changebgcolor
CASE CHR$(6) 'Press Ctrl+F *****************************
IF showmenu = False THEN changeforecolor
CASE CHR$(16) 'Press Ctrl+P *****************************
IF showmenu = False THEN changeformcolor
CASE CHR$(25) 'Press Ctrl+Y *****************************
IF showmenu = False THEN changetitlebgcolor
CASE CHR$(21) 'Press Ctrl+U *****************************
IF showmenu = False THEN changetitlecolor
CASE CHR$(22) 'Press Ctrl+V *****************************
IF showmenu = False THEN changeboxbgcolor
CASE CHR$(18) 'Press Ctrl+R
IF showmenu = False THEN resetcolor
CASE CHR$(24) 'Press Ctrl+X *****************************
IF showmenu = False THEN unload
END SELECT
LOOP
SUB box (introw AS INTEGER, intcol AS INTEGER, mode AS STRING)
DIM r AS INTEGER, c AS INTEGER
DIM x AS INTEGER, y AS INTEGER
DIM lcolor AS INTEGER, dcolor AS INTEGER
IF mode = "show" THEN
intcolor = boxcolor
IF intcolor < 8 THEN lcolor = intcolor + 8 ELSE lcolor = 15
dcolor = 8
ELSE
intcolor = boxbg
lcolor = boxbg
dcolor = boxbg
END IF
IF intcol > maxcol THEN
r = introw + startrow
c = intcol + startcol
x = c * wid
y = r * hei
ELSE
x = flag(introw, intcol).x
y = flag(introw, intcol).y
END IF
LINE (x, y)-(x + wid - 1, y + hei - 1), intcolor, BF
IF boxmode = 0 THEN
LINE (x, y)-(x + wid - 1, y + hei - 1), lcolor, B
END IF
IF boxmode >= 1 THEN
'darw light
LINE (x, y)-(x + wid - 2, y), lcolor
IF boxmode <> 2 THEN LINE (x, y)-(x, y + hei - 2), lcolor
'draw dark
IF boxmode <> 2 THEN LINE (x + wid - 1, y + 1)-(x + wid - 1, y + hei - 1), dcolor
LINE (x + 1, y + hei - 1)-(x + wid - 1, y + hei - 1), dcolor
END IF
'draw wall
IF boxmode = 2 THEN
PSET (x + wid - 1, y), lcolor
LINE (x, y + hei - 1)-(x + wid - 1, y + hei - 1), dcolor
LINE (x, y + hei / 2 - 1)-(x + wid - 1, y + hei / 2 - 1), dcolor
LINE (x, y + hei / 2)-(x + wid - 1, y + hei / 2), lcolor
LINE (x + wid / 2 - 1, y + hei / 2 + 1)-(x + wid / 2 - 1, y + hei - 1), dcolor
LINE (x + wid / 2, y + hei / 2 + 1)-(x + wid / 2, y + hei - 1), lcolor
END IF
'draw X
IF boxmode = 3 THEN
LINE (x + 1, y + 1)-(x + wid - 2, y + hei - 2), lcolor
LINE (x + wid - 2, y + 1)-(x + 1, y + hei - 2), lcolor
END IF
IF boxmode = 4 THEN
'big
LINE (x + 3, y + 3)-(x + wid - 4, y + hei - 4), dcolor, B
LINE (x + wid - 4, y + 3)-(x + wid - 4, y + hei - 4), lcolor
LINE (x + 3, y + hei - 4)-(x + wid - 4, y + hei - 4), lcolor
'small
LINE (x + 5, y + 5)-(x + wid - 6, y + hei - 6), lcolor, B
LINE (x + 5, y + hei - 6)-(x + wid - 6, y + hei - 6), dcolor
LINE (x + wid - 6, y + 5)-(x + wid - 6, y + hei - 6), dcolor
END IF
IF boxmode = 5 THEN
LINE (x + 1, y + 1)-(x + wid - 3, y + hei - 3), lcolor, B
LINE (x + 2, y + 2)-(x + wid - 4, y + hei - 4), dcolor, B
END IF
IF boxmode = 6 THEN
FOR i = 2 TO 12 STEP 2
LINE (x + 2, y + i)-(x + wid - 3, y + i), dcolor
LINE (x + i, y + 2)-(x + i, y + hei - 3), lcolor
NEXT
END IF
IF boxmode = 7 THEN
FOR i = 1 TO 5
IF i MOD 2 = 0 THEN c = dcolor ELSE c = lcolor
CIRCLE (x + 7, y + 7), i, c
NEXT
END IF
IF boxmode = 8 THEN
FOR i = 0 TO 10
IF i > 5 THEN j = 9 - i + 1 ELSE j = i
IF i MOD 2 = 0 THEN c = dcolor ELSE c = lcolor
LINE (x + 7 - j, y + i + 2)-(x + 7 + j, y + i + 2), c
NEXT
END IF
END SUB
SUB button (intleft AS INTEGER, inttop AS INTEGER, intwid AS INTEGER, inthei AS INTEGER)
LINE (intleft, inttop)-(intleft + intwid, inttop + inthei), lightcolor, BF
LINE (intleft + 1, inttop + 1)-(intleft + intwid, inttop + inthei), bgcolor, BF
LINE (intleft + intwid, inttop)-(intleft + intwid, inttop + inthei), darkcolor
LINE (intleft + 0, inttop + inthei)-(intleft + intwid, inttop + inthei), darkcolor
PSET (intleft, inttop + inthei), bgcolor
END SUB
SUB changebgcolor
backgroundcolor = backgroundcolor + 1
IF backgroundcolor > 15 THEN backgroundcolor = 0
frmmain
Refresh
END SUB
SUB changeboxbgcolor
boxbg = boxbg + 1
IF boxbg > 15 THEN boxbg = 0
bordercolor = boxbg + 6
IF bordercolor > 15 THEN bordercolor = bordercolor - 15
drawbg
Refresh
END SUB
SUB changeboxcolor
boxcolor = boxcolor + 1
IF boxcolor > 7 THEN boxcolor = 0
Refresh
END SUB
SUB changeboxmode
boxmode = boxmode + 1
IF boxmode > 8 THEN boxmode = 0
Refresh
END SUB
SUB changeforecolor
trueforecolor = trueforecolor + 1
IF trueforecolor > 15 THEN trueforecolor = 1
initstring
frmmain
Refresh
END SUB
SUB changeformcolor
bgcolor = bgcolor + 1
IF bgcolor > 15 THEN bgcolor = 1
IF bgcolor < 8 THEN lightcolor = bgcolor + 8 ELSE lightcolor = 15
frmmain
Refresh
END SUB
SUB changemode
IF advmode = True THEN
advmode = False
maxbox = 7
ELSE
advmode = True
maxbox = 15
END IF
checkbox levelcol * 8 - 10, (levelrow + 8) * 16, advmode
END SUB
SUB changeshape
IF music = True THEN SOUND 2000, 1
DIM i AS INTEGER
IF curnum = 8 THEN
FOR i = row + 2 TO maxrow
IF flag(i, col).have = True THEN
flag(i, col).have = Fasle
box i, col, "hide"
EXIT FOR
END IF
NEXT
EXIT SUB
END IF
IF curnum = 9 THEN
FOR i = row + 2 TO maxrow
IF flag(i, col).have = True THEN EXIT FOR
NEXT
i = i - 1
flag(i, col).have = True
box i, col, "show"
checkrow i
EXIT SUB
END IF
IF curnum = 12 THEN EXIT SUB
DIM newshape AS INTEGER, retval AS INTEGER
newshape = curshape + 1
IF newshape > 4 THEN newshape = 1
drawbox row, col, curnum, newshape, "return"
retval = checkhave
IF retval = False THEN
drawbox row, col, curnum, curshape, "hide"
curshape = newshape
drawbox row, col, curnum, curshape, "show"
END IF
END SUB
SUB changetitlebgcolor
titlebgcolor = titlebgcolor + 1
IF titlebgcolor > 15 THEN titlebgcolor = 0
frmmain
Refresh
END SUB
SUB changetitlecolor
titlecolor = titlecolor + 1
IF titlecolor > 15 THEN titlecolor = 1
frmmain
Refresh
END SUB
SUB checkbox (x AS INTEGER, y AS INTEGER, value AS INTEGER)
y = y + 1
LINE (x, y)-(x + 12, y + 12), lightcolor, BF
LINE (x, y)-(x, y + 12), darkcolor
LINE (x, y)-(x + 12, y), darkcolor
IF value = True THEN
LINE (x + 2, y + 6)-(x + 5, y + 9), darkcolor
LINE (x + 2, y + 7)-(x + 5, y + 10), darkcolor
LINE (x + 5, y + 9)-(x + 11, y + 3), darkcolor
LINE (x + 5, y + 10)-(x + 11, y + 4), darkcolor
END IF
END SUB
FUNCTION checkhave
DIM result AS INTEGER
DIM r AS INTEGER, c AS INTEGER
DIM i AS INTEGER
result = False
FOR i = 1 TO boxpos(0)
r = boxpos((i - 1) * 2 + 1)
c = boxpos((i - 1) * 2 + 2)
IF r > maxrow THEN result = 2
IF c < 1 OR c > maxcol THEN result = 3
IF result <> False THEN EXIT FOR
IF r > 0 THEN
IF flag(r, c).have = True THEN result = True: EXIT FOR
END IF
NEXT
checkhave = result
END FUNCTION
SUB checkrow (intline AS INTEGER)
IF intline = 0 THEN
DIM count AS INTEGER, totalrow AS INTEGER, r AS INTEGER
DIM i AS INTEGER, j AS INTEGER, k AS INTEGER, temp AS INTEGER
count = boxpos(0)
DIM fullrow(6) AS INTEGER
totalrow = 0
FOR i = 1 TO count
r = boxpos((i - 1) * 2 + 1)
FOR k = 1 TO totalrow
IF r = fullrow(k) THEN EXIT FOR
NEXT
IF k = totalrow + 1 THEN
FOR j = 1 TO maxcol
IF flag(r, j).have = False THEN EXIT FOR
NEXT
IF j = maxcol + 1 THEN 'row full
totalrow = totalrow + 1
fullrow(totalrow) = r
END IF
END IF
NEXT
FOR i = 1 TO totalrow - 1
FOR j = i + 1 TO totalrow
IF fullrow(i) > fullrow(j) THEN
temp = fullrow(i)
fullrow(i) = fullrow(j)
fullrow(j) = temp
END IF
NEXT
NEXT
FOR i = 1 TO totalrow
deleterow fullrow(i)
NEXT
ELSE
FOR j = 1 TO maxcol
IF flag(intline, j).have = False THEN EXIT FOR
NEXT
IF j = maxcol + 1 THEN
totalrow = 1
deleterow intline
END IF
END IF
DIM s AS INTEGER
lines = lines + totalrow
SELECT CASE totalrow
CASE 1: s = 100
CASE 2: s = 300
CASE 3: s = 700
CASE 4: s = 1500
END SELECT
score = score + s
COLOR 10
IF score >= (speed + 1) * 10000 THEN
level = level + 1
speed = speed + 1
IF level + initlevel > maxlevel THEN level = maxlevel - initlevel
IF speed + initspeed > maxspeed THEN speed = maxspeed - initspeed
END IF
showscore
END SUB
FUNCTION checkspace (r AS INTEGER, c AS INTEGER)
DIM result AS INTEGER, i AS INTEGER
result = False
FOR i = r TO maxrow
IF flag(i, c).have = False THEN result = True: EXIT FOR
NEXT
checkspace = result
END FUNCTION
SUB clearall
clearnext
drawbg
END SUB
SUB clearflag
FOR r = 1 TO maxrow
FOR c = 1 TO maxcol
flag(r, c).have = False
NEXT
NEXT
END SUB
SUB clearnext
DIM x AS INTEGER, y AS INTEGER
x = (startcol + nextcol + 21) * 8
y = (startrow + nextrow - 3) * 16
LINE (x, y)-(x + 100, y + 100), bgcolor, BF
END SUB
SUB createbox
nextnum = INT(RND * maxbox) + 1
IF nextnum = 8 OR nextnum = 9 OR nextnum = 12 THEN
nextshape = 1
ELSE
nextshape = INT(RND * 4) + 1
END IF
END SUB
SUB cursor (r AS INTEGER, c AS INTEGER, mode AS STRING)
DIM intcolor AS INTEGER
DIM x AS INTEGER, y AS INTEGER
intcolor = 15
IF mode = "hide" THEN intcolor = 0
x = c * 8 - 1
y = r * 16 + 1
LINE (x, y)-(x, y + 12), intcolor
END SUB
SUB deleterow (r AS INTEGER)
DIM mode AS STRING
DIM i AS INTEGER, j AS INTEGER
FOR i = r TO 2 STEP -1
FOR j = 1 TO maxcol
flag(i, j).have = flag(i - 1, j).have
IF flag(i, j).have = True THEN mode = "show" ELSE mode = "hide"
box i, j, mode
NEXT
NEXT
FOR j = 1 TO maxcol
flag(1, j).have = False
box i, j, "hide"
NEXT
END SUB
SUB displayscore
END SUB
SUB drawbg
DIM x, y, w, h
x = startcol * wid + wid
y = startrow * hei + hei
w = maxcol * wid
h = maxrow * hei
LINE (x - wid - 8, y - hei)-(x + w + wid + 8, y + h + hei), boxbg, BF
LINE (x - wid - 8, y - hei)-(x + w + wid + 8, y + h + hei), 0, B
LINE (x - wid - 8, y + h + hei)-(x + w + wid + 8, y + h + hei), lightcolor
LINE (x + w + wid + 8, y - hei)-(x + w + wid + 8, y + h + hei), lightcolor
LINE (x - 1, y - 1)-(x + w, y + h), bordercolor, B
END SUB
SUB drawbox (introw AS INTEGER, intcol AS INTEGER, num AS INTEGER, shape AS INTEGER, mode AS STRING)
'introw,intcol(draw position)
'num(1-15)
'shape(A,B,C,D)
'mode(show or hide)
DIM poswid AS INTEGER, poshei AS INTEGER
DIM strpos(0 TO 5) AS STRING
SELECT CASE num
CASE IS = 1
strpos(0) = "4"
FOR i = 1 TO 4
IF shape = 1 OR shape = 3 THEN
strpos(i) = STR$(introw - 2 + i) + "," + STR$(intcol)
ELSE
strpos(i) = STR$(introw) + "," + STR$(intcol - 2 + i)
END IF
NEXT
CASE IS = 2
strpos(0) = "4"
strpos(1) = STR$(introw) + "," + STR$(intcol)
strpos(2) = STR$(introw) + "," + STR$(intcol + 1)
strpos(3) = STR$(introw + 1) + "," + STR$(intcol)
strpos(4) = STR$(introw + 1) + "," + STR$(intcol + 1)
CASE IS = 3
strpos(0) = "4"
IF shape = 1 OR shape = 3 THEN
strpos(1) = STR$(introw - 1) + "," + STR$(intcol)
strpos(2) = STR$(introw) + "," + STR$(intcol)
strpos(3) = STR$(introw) + "," + STR$(intcol + 1)
strpos(4) = STR$(introw + 1) + "," + STR$(intcol + 1)
ELSE
strpos(1) = STR$(introw) + "," + STR$(intcol)
strpos(2) = STR$(introw) + "," + STR$(intcol + 1)
strpos(3) = STR$(introw + 1) + "," + STR$(intcol - 1)
strpos(4) = STR$(introw + 1) + "," + STR$(intcol)
END IF
CASE IS = 4
strpos(0) = "4"
IF shape = 1 OR shape = 3 THEN
strpos(1) = STR$(introw - 1) + "," + STR$(intcol + 1)
strpos(2) = STR$(introw) + "," + STR$(intcol + 1)
strpos(3) = STR$(introw) + "," + STR$(intcol)
strpos(4) = STR$(introw + 1) + "," + STR$(intcol)
ELSE
strpos(1) = STR$(introw) + "," + STR$(intcol - 1)
strpos(2) = STR$(introw) + "," + STR$(intcol)
strpos(3) = STR$(introw + 1) + "," + STR$(intcol)
strpos(4) = STR$(introw + 1) + "," + STR$(intcol + 1)
END IF
CASE IS = 5
strpos(0) = "4"
strpos(1) = STR$(introw) + "," + STR$(intcol)
SELECT CASE shape
CASE IS = 1
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw) + "," + STR$(intcol - 1)
strpos(4) = STR$(introw) + "," + STR$(intcol + 1)
CASE IS = 2
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw) + "," + STR$(intcol + 1)
strpos(4) = STR$(introw + 1) + "," + STR$(intcol)
CASE IS = 3
strpos(2) = STR$(introw) + "," + STR$(intcol - 1)
strpos(3) = STR$(introw) + "," + STR$(intcol + 1)
strpos(4) = STR$(introw + 1) + "," + STR$(intcol)
CASE IS = 4
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw) + "," + STR$(intcol - 1)
strpos(4) = STR$(introw + 1) + "," + STR$(intcol)
END SELECT
CASE IS = 6
strpos(0) = "4"
strpos(1) = STR$(introw) + "," + STR$(intcol)
SELECT CASE shape
CASE IS = 1
strpos(2) = STR$(introw) + "," + STR$(intcol - 1)
strpos(3) = STR$(introw + 1) + "," + STR$(intcol)
strpos(4) = STR$(introw + 2) + "," + STR$(intcol)
CASE IS = 2
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw) + "," + STR$(intcol - 1)
strpos(4) = STR$(introw) + "," + STR$(intcol - 2)
CASE IS = 3
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw - 2) + "," + STR$(intcol)
strpos(4) = STR$(introw) + "," + STR$(intcol + 1)
CASE IS = 4
strpos(2) = STR$(introw) + "," + STR$(intcol + 1)
strpos(3) = STR$(introw) + "," + STR$(intcol + 2)
strpos(4) = STR$(introw + 1) + "," + STR$(intcol)
END SELECT
CASE IS = 7
strpos(0) = "4"
strpos(1) = STR$(introw) + "," + STR$(intcol)
SELECT CASE shape
CASE IS = 1
strpos(2) = STR$(introw) + "," + STR$(intcol + 1)
strpos(3) = STR$(introw + 1) + "," + STR$(intcol)
strpos(4) = STR$(introw + 2) + "," + STR$(intcol)
CASE IS = 2
strpos(2) = STR$(introw) + "," + STR$(intcol - 1)
strpos(3) = STR$(introw) + "," + STR$(intcol - 2)
strpos(4) = STR$(introw + 1) + "," + STR$(intcol)
CASE IS = 3
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw - 2) + "," + STR$(intcol)
strpos(4) = STR$(introw) + "," + STR$(intcol - 1)
CASE IS = 4
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw) + "," + STR$(intcol + 1)
strpos(4) = STR$(introw) + "," + STR$(intcol + 2)
END SELECT
CASE IS = 8
strpos(0) = "2"
strpos(1) = STR$(introw) + "," + STR$(intcol)
IF shape = 1 OR shape = 3 THEN
strpos(2) = STR$(introw + 1) + "," + STR$(intcol)
ELSE
strpos(2) = STR$(introw) + "," + STR$(intcol + 1)
END IF
CASE IS = 9
strpos(0) = "3"
FOR i = 1 TO 3
IF shape = 1 OR shape = 3 THEN
strpos(i) = STR$(introw - 2 + i) + "," + STR$(intcol)
ELSE
strpos(i) = STR$(introw) + "," + STR$(intcol - 2 + i)
END IF
NEXT
CASE IS = 10
strpos(0) = "5"
strpos(1) = STR$(introw) + "," + STR$(intcol)
SELECT CASE shape
CASE IS = 1
strpos(2) = STR$(introw) + "," + STR$(intcol - 1)
strpos(3) = STR$(introw) + "," + STR$(intcol + 1)
strpos(4) = STR$(introw + 1) + "," + STR$(intcol)
strpos(5) = STR$(introw + 2) + "," + STR$(intcol)
CASE IS = 2
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw + 1) + "," + STR$(intcol)
strpos(4) = STR$(introw) + "," + STR$(intcol + 1)
strpos(5) = STR$(introw) + "," + STR$(intcol + 2)
CASE IS = 3
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw - 2) + "," + STR$(intcol)
strpos(4) = STR$(introw) + "," + STR$(intcol - 1)
strpos(5) = STR$(introw) + "," + STR$(intcol + 1)
CASE IS = 4
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw + 1) + "," + STR$(intcol)
strpos(4) = STR$(introw) + "," + STR$(intcol - 1)
strpos(5) = STR$(introw) + "," + STR$(intcol - 2)
END SELECT
CASE IS = 11
strpos(0) = "5"
strpos(1) = STR$(introw) + "," + STR$(intcol)
IF shape = 1 OR shape = 3 THEN
strpos(2) = STR$(introw - 1) + "," + STR$(intcol - 1)
strpos(3) = STR$(introw) + "," + STR$(intcol - 1)
strpos(4) = STR$(introw) + "," + STR$(intcol + 1)
strpos(5) = STR$(introw + 1) + "," + STR$(intcol + 1)
ELSE
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw - 1) + "," + STR$(intcol + 1)
strpos(4) = STR$(introw + 1) + "," + STR$(intcol)
strpos(5) = STR$(introw + 1) + "," + STR$(intcol - 1)
END IF
CASE IS = 12
strpos(0) = "1"
strpos(1) = STR$(introw) + "," + STR$(intcol)
CASE IS = 13
strpos(0) = "3"
strpos(1) = STR$(introw) + "," + STR$(intcol)
SELECT CASE shape
CASE IS = 1
strpos(2) = STR$(introw) + "," + STR$(intcol - 1)
strpos(3) = STR$(introw + 1) + "," + STR$(intcol)
CASE IS = 2
strpos(2) = STR$(introw) + "," + STR$(intcol + 1)
strpos(3) = STR$(introw + 1) + "," + STR$(intcol)
CASE IS = 3
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw) + "," + STR$(intcol + 1)
CASE IS = 4
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw) + "," + STR$(intcol - 1)
END SELECT
CASE IS = 14
strpos(0) = "5"
strpos(1) = STR$(introw) + "," + STR$(intcol)
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw + 1) + "," + STR$(intcol)
strpos(4) = STR$(introw) + "," + STR$(intcol - 1)
strpos(5) = STR$(introw) + "," + STR$(intcol + 1)
CASE IS = 15
strpos(0) = "5"
strpos(1) = STR$(introw) + "," + STR$(intcol)
SELECT CASE shape
CASE IS = 1
strpos(2) = STR$(introw - 1) + "," + STR$(intcol - 1)
strpos(3) = STR$(introw - 1) + "," + STR$(intcol + 1)
strpos(4) = STR$(introw) + "," + STR$(intcol - 1)
strpos(5) = STR$(introw) + "," + STR$(intcol + 1)
CASE IS = 2
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw - 1) + "," + STR$(intcol + 1)
strpos(4) = STR$(introw + 1) + "," + STR$(intcol)
strpos(5) = STR$(introw + 1) + "," + STR$(intcol + 1)
CASE IS = 3
strpos(2) = STR$(introw + 1) + "," + STR$(intcol - 1)
strpos(3) = STR$(introw + 1) + "," + STR$(intcol + 1)
strpos(4) = STR$(introw) + "," + STR$(intcol - 1)
strpos(5) = STR$(introw) + "," + STR$(intcol + 1)
CASE IS = 4
strpos(2) = STR$(introw - 1) + "," + STR$(intcol)
strpos(3) = STR$(introw - 1) + "," + STR$(intcol - 1)
strpos(4) = STR$(introw + 1) + "," + STR$(intcol)
strpos(5) = STR$(introw + 1) + "," + STR$(intcol - 1)
END SELECT
END SELECT
DIM count AS INTEGER, intpos AS INTEGER, r AS INTEGER, c AS INTEGER
DIM result AS STRING
count = VAL(strpos(0))
boxpos(0) = count
FOR i = 1 TO count
intpos = INSTR(strpos(i), ",")
r = VAL(MID$(strpos(i), 1, intpos - 1))
c = VAL(MID$(strpos(i), intpos + 1))
IF mode = "return" THEN
boxpos((i - 1) * 2 + 1) = r
boxpos((i - 1) * 2 + 2) = c
ELSE
IF r > 0 AND c > 0 THEN box r, c, mode
END IF
NEXT
IF mode <> "return" AND num = curnum THEN boxstate = mode
END SUB
SUB drawpoint (l AS INTEGER, t AS INTEGER, w AS INTEGER, h AS INTEGER)
FOR i = 1 TO w - 4 STEP 2
PSET (l + 2 + i, t + 2), forecolor
PSET (l + 2 + i, t + h - 2), forecolor
NEXT
FOR i = 0 TO h - 4 STEP 2
PSET (l + 2, t + 2 + i), forecolor
PSET (l + w - 2, t + 2 + i), forecolor
NEXT
END SUB
SUB ENTER (introw AS INTEGER, intcol AS INTEGER, intlen AS INTEGER, mode AS STRING)
DIM r AS INTEGER, c AS INTEGER, detlay AS INTEGER
DIM m AS STRING, kbd AS STRING
DIM i AS INTEGER, total AS INTEGER
DIM result AS STRING
i = 0: detlay = 6000
kbd = ""
r = introw: c = intcol: m = "show"
total = LEN(initvalue)
c = c + total
result = initvalue
cursor r, c, m
DO WHILE True
kbd = INKEY$
i = i + 1
IF i > detlay THEN
i = 0
IF m = "show" THEN m = "hide" ELSE m = "show"
cursor r, c, m
END IF
SELECT CASE kbd
CASE CHR$(27)
controlvalue = "ESC"
EXIT DO
CASE "0" TO "9", "a" TO "z", "A" TO "Z"
IF total < intlen THEN
m = "hide"
cursor r, c, m
COLOR textcolor
LOCATE r + 1, c + 1: PRINT kbd
result = result + kbd
c = c + 1
total = total + 1
END IF
CASE CHR$(8) 'BackSpace
IF total > 0 THEN
m = "hide"
cursor r, c, m
LOCATE r + 1, c: PRINT CHR$(32)
result = MID$(result, 1, LEN(result) - 1)
c = c - 1
total = total - 1
END IF
CASE CHR$(13)
entervalue = result
controlvalue = "ENTER"
EXIT DO
CASE CHR$(9)
entervalue = result
controlvalue = "TAB"
cursor r, c, "hide"
EXIT DO
END SELECT
LOOP
END SUB
FUNCTION findit (strfilename AS STRING)
FOR i = 1 TO totalfiles
IF UCASE$(strfiles(i)) = UCASE$(strfilename) THEN
findit = True
EXIT FUNCTION
END IF
NEXT
findit = False
END FUNCTION
SUB frmabout
DIM str AS STRING
DIM l AS INTEGER, t AS INTEGER
l = 180: t = 100
openwindow l, t, 280, 150, "About", 4
PUT (l + 94, t + 30), aboutname
PUT (l + 98, t + 55), aboutauthor
PUT (l + 35, t + 80), aboutcopy
button l + 115, t + 110, 50, 20
drawpoint l + 115, t + 110, 50, 20
PUT (l + 128, t + 113), btnok
str = ""
DO WHILE True
str = INKEY$
IF str = CHR$(13) OR str = CHR$(32) OR str = CHR$(27) THEN EXIT DO
LOOP
LINE (l, t)-(l + 280, t + 150), bgcolor, BF
frmmain
shownextbox "show"
Refresh
END SUB
SUB frmmain
LINE (0, 0)-(639, 479), backgroundcolor, BF
DIM left AS INTEGER, top AS INTEGER
'DIM menuleft0 AS INTEGER, menutop0(0 TO 4) AS INTEGER
left = 140: top = 2
'create a new window
openwindow left, top, scalewidth, scaleheight, "Super Tris", 7
'create menu
'init menu position
'Menu Game
fileleft = left + 7
filetop(0) = top + 22
FOR i = 1 TO 7
IF i = 4 OR i = 7 THEN
filetop(i) = filetop(i - 1) + 10 + 3
ELSE
filetop(i) = filetop(i - 1) + 17 + 3
END IF
NEXT
PUT (fileleft, filetop(0)), file0
LINE (fileleft, filetop(0) + 13)-(fileleft + 6, filetop(0) + 13), titlebgcolor
'Menu Edit
editleft = fileleft + 42
FOR i = 0 TO 2
edittop(i) = filetop(i)
NEXT
PUT (editleft, filetop(0)), edit0
LINE (editleft, filetop(0) + 13)-(editleft + 6, filetop(0) + 13), titlebgcolor
'Menu Help
helpleft = editleft + 42
PUT (helpleft, filetop(0)), help0
LINE (helpleft, filetop(0) + 13)-(helpleft + 6, filetop(0) + 13), titlebgcolor
'score & Level
PUT (scorecol * 8 - 10, scorerow * 16), intscore
textbox scorerow, scorecol + 5, 8, STR$(score), "show"
PUT (linecol * 8 - 10, linerow * 16), intlines
textbox linerow, linecol + 5, 8, STR$(lines), "show"
PUT (levelcol * 8 - 10, levelrow * 16), intlevel
textbox levelrow, levelcol + 5, 8, STR$(initlevel), "show"
PUT (speedcol * 8 - 10, speedrow * 16), intspeed
textbox speedrow, speedcol + 5, 8, STR$(initspeed), "show"
'Adv Mode
checkbox levelcol * 8 - 10, (levelrow + 8) * 16, advmode
PUT (levelcol * 8 + 10, (levelrow + 8) * 16), intmode
END SUB
SUB gameover
msg "Game over"
gamestate = "over"
speed = 0
lines = 0
level = 0
score = 0
nextnum = 0
curnum = 0
clearflag
IF waitpress$ = "S" THEN
END IF
frmmain
drawbg
END SUB
FUNCTION getapppath$
DIM strname AS STRING
strname = "Temp" + LTRIM$(RTRIM$(STR$(INT(RND * 10000)))) + ".tmp"
OPEN strname FOR OUTPUT AS #1
CLOSE
SHELL "dir >" + strname
DIM str AS STRING, result AS STRING
DIM p AS INTEGER
OPEN strname FOR INPUT AS #2
result = ""
DO WHILE NOT EOF(2)
LINE INPUT #2, str
str = LTRIM$(RTRIM$(str))
p = INSTR(str, "Directory")
IF p > 0 THEN
result = MID$(str, 14)
EXIT DO
END IF
IF INSTR(str, "<DIR>") > 0 THEN EXIT DO
LOOP
CLOSE
SHELL "del " + strname
getapppath$ = result
'getapppath$ = "G:/jiajia~1"
END FUNCTION
FUNCTION getfilename$ (strtitle AS STRING)
DIM filerow AS INTEGER, filecol AS INTEGER, page AS INTEGER
DIM x AS INTEGER, y AS INTEGER, inthei AS INTEGER
DIM r AS INTEGER, c AS INTEGER
DIM position AS INTEGER, activecolor AS INTEGER
DIM kbd AS STRING
DIM x2 AS INTEGER, y2 AS INTEGER, curitem(1600) AS INTEGER
initvalue = ""
activecolor = 15
page = 1
position = 1
filerow = 8
filecol = 26
x = (filecol + 26) * 8 - 7
y = (filerow + 2) * 16 - 3
inthei = 12 * 16 + 2
openwindow 200, 100, 236, 260, strtitle, 4
PUT (filecol * 8 + 2, filerow * 16), intfilename
textbox filerow, filecol + 10, 17, " ", "show"
PUT (filecol * 8 + 2, (filerow + 2) * 16 - 8), intfilelist
listbox filerow + 2, filecol + 10, 12, True
scrollbar x, y, inthei, INT((totalfiles - 1) / 12) + 1, page
r = filerow + 3: c = filecol + 11
showfiles r, c, page
COLOR activecolor
'LOCATE r + position - 1, c: PRINT strfiles(position)
GOSUB inputvalue
EXIT FUNCTION
selectvalue:
COLOR activecolor
LOCATE r + position - 1, c: PRINT strfiles(position)
'x2 = c * 8 - 8: y2 = (r + position - 2) * 16
'GET (x2, y2)-(x2 + 15 * 8, y2 + 16), curitem
'LINE (x2, y2)-(x2 + 15 * 8, y2 + 16), 10, BF
'PUT (x2, y2), curitem
DO WHILE True
kbd = INKEY$
SELECT CASE kbd
CASE CHR$(27)
getfilename = ""
EXIT FUNCTION
CASE CHR$(9) 'change focus
COLOR textcolor
LOCATE r + position - (page - 1) * 12 - 1, c: PRINT strfiles(position)
GOSUB inputvalue
EXIT DO
CASE CHR$(0) + "P" 'Press Down ****************************************
IF position < totalfiles THEN
COLOR textcolor
LOCATE r + position - (page - 1) * 12 - 1, c: PRINT strfiles(position)
position = position + 1
IF position > page * 12 THEN
page = page + 1
showfiles r, c, page
scrollbar x, y, inthei, INT((totalfiles - 1) / 12) + 1, page
END IF
COLOR activecolor
LOCATE r + position - (page - 1) * 12 - 1, c: PRINT strfiles(position)
END IF
CASE CHR$(0) + "H" 'Press UP *****************************************
IF position > 1 THEN
COLOR textcolor
LOCATE r + position - (page - 1) * 12 - 1, c: PRINT strfiles(position)
position = position - 1
IF position < (page - 1) * 12 + 1 THEN
page = page - 1
showfiles r, c, page
scrollbar x, y, inthei, INT((totalfiles - 1) / 12) + 1, page
END IF
COLOR activecolor
LOCATE r + position - (page - 1) * 12 - 1, c: PRINT strfiles(position)
END IF
CASE CHR$(13) 'select file
getfilename = strfiles(position)
EXIT FUNCTION
END SELECT
LOOP
RETURN
inputvalue:
ENTER filerow, filecol + 10, 15, "string"
SELECT CASE controlvalue
CASE "ESC"
getfilename = ""
EXIT FUNCTION
CASE "ENTER"
'IF findit(entervalue) = False THEN
getfilename = entervalue
EXIT FUNCTION 'Exit
'ELSE
'END IF
CASE "TAB" 'change focus
initvalue = entervalue
GOSUB selectvalue
END SELECT
RETURN
END FUNCTION
SUB getfiles
'ON ERROR GOTO createfile
DIM strname AS STRING
DIM position AS INTEGER, i AS INTEGER
'OPEN AppPath + "/tris.sav" FOR INPUT AS #1
OPEN "g:/mysite/JiaJia~1/tris.sav" FOR INPUT AS #1
i = 1
DO WHILE NOT EOF(1)
LINE INPUT #1, strname
position = INSTR(strname, ",")
IF position > 0 THEN
strfiles(i) = MID$(strname, 1, position - 1)
i = i + 1
END IF
LOOP
CLOSE
totalfiles = i - 1
EXIT SUB
'createfile:
END SUB
SUB getsetting
DIM str AS STRING, p AS INTEGER, temp AS INTEGER
DIM strkey AS STRING, value AS INTEGER
'OPEN AppPath + "/tris.ini" FOR INPUT AS #1
OPEN "G:/mysite/jiajia~1/tris.ini" FOR INPUT AS #1
DO WHILE NOT EOF(1)
LINE INPUT #1, str
str = LTRIM$(RTRIM$(str))
IF str <> "" THEN
p = INSTR(str, "=")
strkey = MID$(str, 1, p - 1)
value = VAL(MID$(str, p + 1))
SELECT CASE strkey
CASE "boxcolor"
boxcolor = value
CASE "boxmode"
boxmode = value
CASE "backgroundcolor"
backgroundcolor = value
CASE "bgcolor"
bgcolor = value
CASE "titlebgcolor"
titlebgcolor = value
CASE "titlecolor"
titlecolor = value
CASE "forecolor"
trueforecolor = value
CASE "boxbgcolor"
boxbg = value
END SELECT
END IF
LOOP
CLOSE
END SUB
SUB gettruecolor (f AS INTEGER, B AS INTEGER)
DIM result AS INTEGER, i AS INTEGER
'FOR i = 1 TO 15 'forecolor
SELECT CASE B
CASE 1, 5, 9, 13
IF f MOD 2 = 0 THEN
result = f + B
ELSE
result = f - B
END IF
CASE 2, 6, 10, 14
CASE 3, 11
CASE 4, 12
CASE 7, 15
CASE 0
END SELECT
'NEXT
END SUB
SUB init
maxrow = 24
maxcol = 10
maxspeed = 9
maxlevel = 9
wid = 16
hei = 16
startrow = 3
startcol = 10
maxbox = 7
showmenu = False
scalewidth = 360
scaleheight = 476
row = 1
col = 5
scorerow = 14: scorecol = 48
linerow = 16: linecol = 48
levelrow = 18: levelcol = 48
speedrow = 20: speedcol = 48
initspeed = 0
initlevel = 0
nextrow = 4
nextcol = 16
advmode = False
gamestate = "over"
AppPath = getapppath
totalfiles = 0
music = False
getfiles
boxmode = 1
initvalue = ""
END SUB
SUB initcolor
bgcolor = 7
forecolor = 1
boxcolor = 3
trueforecolor = 6
boxbg = 8
titlebgcolor = 1
menubgcolor = 1
IF bgcolor < 8 THEN lightcolor = bgcolor + 8 ELSE lightcolor = 15
'IF bgcolor = 8 THEN darkcolor = 0 ELSE darkcolor = 8
darkcolor = 0
textcolor = 10
backgroundcolor = 0
titlecolor = 14
END SUB
SUB initmap
DIM x AS INTEGER, y AS INTEGER
DIM i AS INTEGER, j AS INTEGER, w AS INTEGER, h AS INTEGER
x = startcol * wid + wid
y = startrow * hei + hei
w = maxcol * wid
h = maxrow * hei
i = 1
FOR yy = y TO y + h - 1 STEP hei
j = 1
FOR xx = x TO x + w - 1 STEP wid
flag(i, j).have = False
flag(i, j).x = xx
flag(i, j).y = yy
'box i, j, "show"
j = j + 1
NEXT
i = i + 1
NEXT
END SUB
SUB initstring
CLS
COLOR trueforecolor
DIM strload AS STRING
LOCATE 2, 1: PRINT "Game ": GET (0, 16)-(32, 32), file0
LOCATE 2, 11: PRINT "Load... Ctrl+O ": GET (80, 16)-(208, 32), file4
LOCATE 2, 21: PRINT "Save... Ctrl+S ": GET (160, 16)-(288, 32), file5
file3 = -1
LOCATE 2, 41: PRINT "Start F2 ": GET (320, 16)-(416, 32), file1
LOCATE 2, 41: PRINT "Pause F4 ": GET (320, 16)-(416, 32), file2
file6 = -1
LOCATE 1, 1: PRINT "Exit Ctrl+X ": GET (0, 0)-(128, 15), file7
LOCATE 1, 1: PRINT "Edit ": GET (0, 0)-(32, 15), edit0
LOCATE 1, 1: PRINT "Set color Ctrl+B ": GET (0, 0)-(128, 15), edit1
LOCATE 1, 1: PRINT "Set skin Ctrl+N ": GET (0, 0)-(128, 15), edit2
LOCATE 1, 1: PRINT "Help ": GET (0, 0)-(32, 15), help0
LOCATE 1, 1: PRINT "About... ": GET (0, 0)-(64, 15), help1
LOCATE 1, 1: PRINT " Super Tris ": GET (0, 0)-(90, 15), aboutname
LOCATE 1, 1: PRINT " V0.2 ": GET (0, 0)-(90, 15), aboutauthor
LOCATE 1, 1: PRINT "2003 Copyright(C) HuangJian ": GET (0, 0)-(216, 15), aboutcopy
LOCATE 1, 1: PRINT "O K ": GET (0, 0)-(24, 15), btnok
LOCATE 1, 1: PRINT "Score: ": GET (0, 0)-(48, 15), intscore
LOCATE 1, 1: PRINT "Lines: ": GET (0, 0)-(48, 15), intlines
LOCATE 1, 1: PRINT "Level: ": GET (0, 0)-(48, 15), intlevel
LOCATE 1, 1: PRINT "Speed: ": GET (0, 0)-(48, 15), intspeed
LOCATE 1, 1: PRINT "Adv(Ctrl+A) ": GET (0, 0)-(88, 15), intmode
LOCATE 1, 1: PRINT "Filename: ": GET (0, 0)-(72, 15), intfilename
LOCATE 1, 1: PRINT "FileList: ": GET (0, 0)-(80, 15), intfilelist
CLS
END SUB
SUB ldetlay (s AS LONG)
DIM i AS LONG
FOR i = 1 TO s * 10000
i = i + 1
i = i - 1
NEXT
END SUB
SUB listbox (introw AS INTEGER, intcol AS INTEGER, introws AS INTEGER, intscrollbar AS INTEGER)
DIM intwid AS INTEGER, inthei AS INTEGER
x = intcol * 8 - 2
y = introw * 16 - 4
inthei = introws * 16
intwid = 17 * 8 + 2
'draw border
LINE (x, y)-(x + intwid, y + inthei + 4), 0, BF
LINE (x + intwid, y)-(x + intwid, y + inthei + 4), lightcolor
LINE (x, y + inthei + 4)-(x + intwid, y + inthei + 4), lightcolor
'draw scrollbar
END SUB
SUB listmenu (intpos AS INTEGER, strmode AS STRING)
IF bgcolor = 1 THEN menubgcolor = 7 ELSE menubgcolor = 1
DIM x AS INTEGER, y AS INTEGER, intwid AS INTEGER, inthei AS INTEGER
x = fileleft - 3: intwid = 145: inthei = 127
IF mainmenu = 2 THEN x = editleft - 3: intwid = 145: inthei = 41
IF mainmenu = 3 THEN x = helpleft - 3: intwid = 100: inthei = 21
y = filetop(0) + 18
IF intpos = 0 THEN
'3D
IF strmode = "Active" THEN
LINE (x, y - 19)-(x + 36, y - 3), darkcolor, B
LINE (x + 36, y - 19)-(x + 36, y - 3), lightcolor
LINE (x, y - 3)-(x + 36, y - 3), lightcolor
ELSEIF strmode = "Inactive" THEN
LINE (x, y - 19)-(x + 36, y - 3), bgcolor, B
LINE (x, y - 1)-(x + intwid, y + inthei - 1), bgcolor, BF
Refresh
EXIT SUB
END IF
'Button Base
button x, y - 1, intwid, inthei
'son menu
SELECT CASE mainmenu
CASE 1
PUT (x + 6, filetop(1)), file1
PUT (x + 6, filetop(2)), file2
LINE (x + 3, filetop(3) + 3)-(x + intwid - 4, filetop(3) + 3), darkcolor
LINE (x + 3, filetop(3) + 4)-(x + intwid - 4, filetop(3) + 4), lightcolor
PUT (x + 6, filetop(4)), file4
PUT (x + 6, filetop(5)), file5
LINE (x + 3, filetop(6) + 3)-(x + intwid - 4, filetop(6) + 3), darkcolor
LINE (x + 3, filetop(6) + 4)-(x + intwid - 4, filetop(6) + 4), lightcolor
PUT (x + 6, filetop(7)), file7
CASE 2
PUT (x + 6, edittop(1)), edit1
PUT (x + 6, edittop(2)), edit2
CASE 3
PUT (x + 6, filetop(1)), help1
END SELECT
ELSE 'Move son menu
IF strmode = "Active" THEN
LINE (x + 2, filetop(intpos) - 1)-(x + intwid - 2, filetop(intpos) + 16), menubgcolor, BF
ELSE
LINE (x + 2, filetop(intpos) - 1)-(x + intwid - 2, filetop(intpos) + 16), bgcolor, BF
END IF
SELECT CASE intpos
CASE 1
IF mainmenu = 1 THEN PUT (x + 6, filetop(1)), file1
IF mainmenu = 2 THEN PUT (x + 6, edittop(1)), edit1
IF mainmenu = 3 THEN PUT (x + 6, filetop(1)), help1
CASE 2
IF mainmenu = 1 THEN PUT (x + 6, filetop(2)), file2
IF mainmenu = 2 THEN PUT (x + 6, edittop(2)), edit2
CASE 4: PUT (x + 6, filetop(4)), file4
CASE 5: PUT (x + 6, filetop(5)), file5
CASE 7: PUT (x + 6, filetop(7)), file7
END SELECT
END IF
END SUB
'
SUB loaddata
t$ = gamestate
gamestate = "pause"
DIM filename AS STRING
filename = getfilename("Load")
IF filename <> "" THEN loadit filename
gamestate = "start"
frmmain
Refresh
IF filename <> "" THEN k$ = waitpress$
END SUB
SUB loadit (filename AS STRING)
msg "Loading..."
DIM curflag AS INTEGER, p AS INTEGER
DIM v(1) AS STRING
DIM str AS STRING, strname AS STRING, result AS STRING
'OPEN AppPath + "/" + "tris.sav" FOR INPUT AS #2
OPEN "g:/mysite/jiajia~1/tris.sav" FOR INPUT AS #2
DO WHILE NOT EOF(2)
LINE INPUT #2, str
p = INSTR(str, ",")
IF p > 0 THEN
strname = MID$(str, 1, p - 1)
IF UCASE$(LTRIM$(RTRIM$(filename))) = UCASE$(LTRIM$(RTRIM$(strname))) THEN
INPUT #2, result
EXIT DO
END IF
END IF
LOOP
CLOSE
IF result = "" THEN EXIT SUB
'set property
'filename,curnum,curshape,nextnum,nextshape,row,col,initlevel,initspeed,score,lines,level,speed,advmode
DIM p2 AS INTEGER, temp AS LONG
FOR i = 1 TO 12
p2 = INSTR(p + 1, str, ",")
temp = VAL(MID$(str, p + 1, p2 - p - 1))
IF i = 1 THEN curnum = temp
IF i = 2 THEN curshape = temp
IF i = 3 THEN nextnum = temp
IF i = 4 THEN nextshape = temp
IF i = 5 THEN row = temp
IF i = 6 THEN col = temp
IF i = 7 THEN initlevel = temp
IF i = 8 THEN initspeed = temp
IF i = 9 THEN score = temp
IF i = 10 THEN lines = temp
IF i = 11 THEN level = temp
IF i = 12 THEN speed = temp
p = p2
NEXT
IF initlevel + level > maxlevel THEN level = maxlevel - initlevel
IF initspeed + speed > maxspeed THEN speed = maxspeed - initspeed
advmode = VAL(MID$(str, p + 1))
'setflag
DIM num AS INTEGER, r AS INTEGER, c AS INTEGER
p = 1
curflag = 0
num = 0
r = 1: c = 1
v(0) = "A": v(1) = "B"
DO WHILE True
p2 = INSTR(p, result, v(curflag))
IF p2 = 0 THEN EXIT DO
IF p2 > p THEN num = VAL(MID$(result, p, p2 - p)) ELSE num = 1
FOR i = 1 TO num
flag(r, c).have = curflag
'PRINT r; c; curflag
c = c + 1
IF c > maxcol THEN
r = r + 1: c = 1
IF r > maxrow THEN EXIT DO
END IF
NEXT
p = p2 + 1
IF curflag = 0 THEN curflag = 1 ELSE curflag = 0
LOOP
ldetlay 8
END SUB
SUB movebox (dir AS STRING)
IF curnum = 8 OR curnum = 9 OR curnum = 12 THEN
IF NOT ((curnum = 8 OR curnum = 9) AND (dir = "left" OR dir = "right" OR dir = "quickdown")) THEN
movebox2 dir
EXIT SUB
END IF
END IF
DIM result AS STRING
DIM retval AS INTEGER, c AS INTEGER
IF music = True AND dir <> "down" THEN SOUND 2000, 1
SELECT CASE dir
CASE "down"
drawbox row + 1, col, curnum, curshape, "return"
retval = checkhave
IF retval = False THEN
drawbox row, col, curnum, curshape, "hide"
row = row + 1
drawbox row, col, curnum, curshape, "show"
END IF
IF retval = 2 OR retval = True THEN
drawbox row, col, curnum, curshape, "return"
setflag
IF gamestate = "over" THEN EXIT SUB
checkrow 0
newbox
END IF
CASE "left", "right"
IF dir = "left" THEN c = col - 1 ELSE c = col + 1
drawbox row, c, curnum, curshape, "return"
retval = checkhave
IF retval = False THEN
drawbox row, col, curnum, curshape, "hide"
col = c
drawbox row, col, curnum, curshape, "show"
END IF
CASE "quickdown"
FOR i = 1 TO 4
drawbox row + i, col, curnum, curshape, "return"
retval = checkhave
IF retval <> False THEN EXIT FOR
NEXT
i = i - 1
drawbox row, col, curnum, curshape, "hide"
row = row + i
drawbox row, col, curnum, curshape, "show"
END SELECT
END SUB
SUB movebox2 (dir AS STRING)
DIM result AS STRING
DIM retval AS INTEGER, c AS INTEGER, r AS INTEGER, i AS INTEGER
DIM mode AS STRING
SELECT CASE dir
CASE "down"
drawbox row + 1, col, curnum, curshape, "return"
retval = checkhave
IF retval = False OR curnum = 12 AND checkspace(row + 1, col) = True THEN
IF curnum = 12 AND flag(row, col).have = True THEN
drawbox row, col, curnum, curshape, "show"
ELSE
drawbox row, col, curnum, curshape, "hide"
END IF
row = row + 1
drawbox row, col, curnum, curshape, "show"
ELSEIF curnum = 8 OR curnum = 9 THEN
IF retval = 2 OR retval = True THEN
drawbox row, col, curnum, curshape, "hide"
newbox
END IF
ELSEIF curnum = 12 THEN
drawbox row, col, curnum, curshape, "show"
drawbox row, col, curnum, curshape, "return"
setflag
IF gamestate = "over" THEN EXIT SUB
checkrow 0
newbox
END IF
CASE "left"
IF col > 1 THEN
IF flag(row, col).have = True THEN mode = "show" ELSE mode = "hide"
drawbox row, col, curnum, curshape, mode
col = col - 1
drawbox row, col, curnum, curshape, "show"
END IF
CASE "right"
IF col < maxcol THEN
IF flag(row, col).have = True THEN mode = "show" ELSE mode = "hide"
drawbox row, col, curnum, curshape, mode
col = col + 1
drawbox row, col, curnum, curshape, "show"
END IF
CASE "quickdown"
FOR i = row + 4 TO maxrow
IF flag(i, col).have = Fasle THEN
IF flag(row, col).have = True THEN mode = "show" ELSE mode = "hide"
drawbox row, col, curnum, curshape, mode
row = row + 4
drawbox row, col, curnum, curshape, "show"
EXIT FOR
END IF
NEXT
END SELECT
END SUB
SUB movemenu (arrow AS STRING)
DIM v AS INTEGER
IF arrow = "Up" OR arrow = "Down" THEN
IF arrow = "Up" THEN v = -1 ELSE v = 1
SELECT CASE mainmenu
CASE IS = 1 'Menu file
listmenu curmenu, "Inactive"
curmenu = curmenu + v
IF curmenu = 0 THEN curmenu = 7
IF curmenu = 8 THEN curmenu = 1
IF curmenu = 3 OR curmenu = 6 THEN curmenu = curmenu + v
listmenu curmenu, "Active"
CASE IS = 2
listmenu curmenu, "Inactive"
curmenu = curmenu + v
IF curmenu = 0 THEN curmenu = 2
IF curmenu = 3 THEN curmenu = 1
listmenu curmenu, "Active"
END SELECT
ELSEIF arrow = "Left" OR arrow = "Right" THEN
listmenu 0, "Inactive"
IF arrow = "Left" THEN v = 1 ELSE v = -1
curmenu = 1
mainmenu = mainmenu + v
IF mainmenu = 4 THEN mainmenu = 1
IF mainmenu = 0 THEN mainmenu = 3
listmenu 0, "Active"
listmenu curmenu, "Active"
END IF
END SUB
SUB msg (strmsg AS STRING)
DIM intleft AS INTEGER, intwid AS INTEGER, inttop AS INTEGER, inthei AS INTEGER
DIM intstring(1000) AS INTEGER
DIM r AS INTEGER, c AS INTEGER
IF strmsg = "Game over" THEN intleft = 160 ELSE intleft = 190
intwid = 260
inttop = 200
inthei = 60
r = INT(inttop / 16) + 2
c = INT(intleft / 8) + 2
COLOR trueforecolor
LOCATE r, c: PRINT strmsg; " "
GET (c * 8 - 8, r * 16 - 16)-((c - 1 + LEN(strmsg)) * 8, r * 16 - 1), intstring
button intleft, inttop, intwid, inthei
PUT (intleft + (intwid - LEN(strmsg) * 8) / 2, inttop + inthei / 2 - 7), intstring
END SUB
SUB newbox
curnum = nextnum
curshape = nextshape
createbox
row = 1
col = 5
drawbox row, col, curnum, curshape, "show"
shownextbox "show"
END SUB
SUB openwindow (intleft AS INTEGER, inttop AS INTEGER, intwid AS INTEGER, inthei AS INTEGER, strtitle AS STRING, intbutton)
DIM inttitle(1500) AS INTEGER, r AS INTEGER, c AS INTEGER
r = (inttop / 16) + 2
c = (intleft / 8) + 2
COLOR titlecolor 'call gettruecolor
LOCATE r, c: PRINT strtitle + " "
GET ((c - 1) * 8, (r - 1) * 16)-((c + LEN(strtitle) - 1) * 8, r * 16 - 1), inttitle
'body
button intleft, inttop, intwid, inthei
'title
LINE (intleft + 2, inttop + 2)-(intleft + intwid - 2, inttop + 18), titlebgcolor, BF
PUT (intleft + 5, inttop + 3), inttitle
'control box
IF intbutton >= 4 THEN 'close button
button intleft + intwid - 19, inttop + 3, 15, 14
LINE (intleft + intwid - 16, inttop + 5)-(intleft + intwid - 7, inttop + 14), titlebgcolor
LINE (intleft + intwid - 16, inttop + 14)-(intleft + intwid - 7, inttop + 5), titlebgcolor
intbutton = intbutton - 4
END IF
IF intbutton >= 2 THEN 'max button
button intleft + intwid - 37, inttop + 3, 15, 14
LINE (intleft + intwid - 34, inttop + 6)-(intleft + intwid - 25, inttop + 15), titlebgcolor, B
intbutton = intbutton - 2
END IF
IF intbutton >= 1 THEN 'min button
button intleft + intwid - 55, inttop + 3, 15, 14
LINE (intleft + intwid - 52, inttop + 14)-(intleft + intwid - 43, inttop + 14), titlebgcolor
END IF
END SUB
SUB pause
IF gamestate = "start" THEN
gamestate = "pause"
ELSEIF gamestate = "pause" THEN
gamestate = "start"
END IF
END SUB
SUB Refresh
DIM i AS INTEGER, j AS INTEGER
DIM mode AS STRING
drawbg
FOR i = 1 TO maxrow
FOR j = 1 TO maxcol
IF flag(i, j).have = True THEN
box i, j, "show"
END IF
NEXT
NEXT
IF gamestate = "start" OR gamestate = "pause" THEN
drawbox row, col, curnum, curshape, "show"
shownextbox "show"
END IF
showscore
END SUB
SUB resetcolor
initcolor
initstring
frmmain
Refresh
END SUB
SUB savedata
t$ = gamestate
gamestate = "pause"
DIM filename AS STRING
filename = getfilename("Save")
IF filename <> "" THEN saveit filename
gamestate = t$
frmmain
Refresh
END SUB
SUB saveit (filename AS STRING)
msg "Saving..."
DIM curflag AS INTEGER
DIM result AS STRING, str AS STRING
DIM i AS INTEGER, j AS INTEGER, total AS INTEGER
DIM v(1) AS STRING
v(0) = "A": v(1) = "B"
FOR i = 1 TO maxrow
FOR j = 1 TO maxcol
IF i = 1 AND j = 1 THEN
curflag = flag(i, j).have
total = 1
ELSE
IF flag(i, j).have = curflag THEN
total = total + 1
ELSE
IF total = 1 THEN
result = result + v(curflag)
ELSE
result = result + LTRIM$(RTRIM$(STR$(total))) + v(curflag)
END IF
curflag = flag(i, j).have
total = 1
END IF
END IF
NEXT
NEXT
IF total = 1 THEN
result = result + v(curflag)
ELSE
result = result + LTRIM$(RTRIM$(STR$(total))) + v(curflag)
END IF
'filename,curnum,curshape,nextnum,nextshape,row,col,initlevel,initspeed,score,lines,level,speed,advmode
str = filename + "," + STR$(curnum) + "," + STR$(curshape) + "," + STR$(nextnum) + "," + STR$(nextshape) + ","
str = str + STR$(row) + "," + STR$(col) + "," + STR$(initlevel) + "," + STR$(initspeed) + "," + STR$(score) + ","
str = str + STR$(lines) + "," + STR$(level) + "," + STR$(speed) + "," + STR$(advmode)
OPEN AppPath + "/" + "tris.sav" FOR APPEND AS #1
PRINT #1, str
PRINT #1, result
CLOSE
totalfiles = totalfiles + 1
strfiles(totalfiles) = filename
ldetlay 8
END SUB
SUB savesetting
'OPEN AppPath + "/tris.ini" FOR OUTPUT AS #1
OPEN "g:/mysite/jiajia~1/tris.ini" FOR OUTPUT AS #1
PRINT #1, "boxcolor=" + STR$(boxcolor)
PRINT #1, "boxmode=" + STR$(boxmode)
PRINT #1, "backgroundcolor=" + STR$(backgroundcolor)
PRINT #1, "bgcolor=" + STR$(bgcolor)
PRINT #1, "titlebgcolor=" + STR$(titlebgcolor)
PRINT #1, "titlecolor=" + STR$(titlecolor)
PRINT #1, "forecolor=" + STR$(trueforecolor)
PRINT #1, "boxbgcolor=" + STR$(boxbg)
CLOSE
END SUB
SUB scrollbar (x AS INTEGER, y AS INTEGER, inthei AS INTEGER, maxpage AS INTEGER, curpage AS INTEGER)
DIM barhei AS INTEGER
LINE (x, y)-(x + 14, y + inthei), bgcolor, BF
'
button x, y, 14, 13
FOR i = 0 TO 4
LINE (x - i + 7, y + i + 4)-(x + i + 7, y + i + 4), titlebgcolor
NEXT
'
button x, y + inthei - 13, 14, 13
FOR i = 4 TO 0 STEP -1
LINE (x - i + 7, y + inthei - i - 4)-(x + i + 7, y + inthei - i - 4), titlebgcolor
NEXT
'
barhei = inthei - 28
IF maxpage > 1 THEN barhei = barhei / maxpage
button x, y + 14 + (curpage - 1) * barhei, 14, barhei
END SUB
SUB setflag
DIM r AS INTEGER, c AS INTEGER
DIM count AS INTEGER
count = boxpos(0)
IF curnum = 8 OR curnum = 9 THEN PRINT "OK"
FOR i = 1 TO count
r = boxpos((i - 1) * 2 + 1)
c = boxpos((i - 1) * 2 + 2)
IF r < 1 THEN gameover: EXIT FOR
flag(r, c).have = True
NEXT
END SUB
SUB setlevel
DIM colbox AS INTEGER
DIM c AS INTEGER, i AS INTEGER, j AS INTEGER
IF initlevel > 5 THEN colbox = 4 ELSE colbox = 2
FOR i = maxrow TO maxrow - initlevel + 1 STEP -1
FOR j = 1 TO colbox
c = INT(RND * maxcol) + 1
flag(i, c).have = True
box i, c, "show"
NEXT
NEXT
END SUB
SUB showfiles (introw AS INTEGER, intcol AS INTEGER, page AS INTEGER)
COLOR textcolor
DIM i AS INTEGER, j AS INTEGER
j = 0
FOR i = (page - 1) * 12 + 1 TO page * 12
LOCATE introw + j, intcol: PRINT STRING$(15, CHR$(32))
IF i <= totalfiles THEN LOCATE introw + j, intcol: PRINT strfiles(i)
j = j + 1
NEXT
END SUB
SUB shownextbox (mode AS STRING)
clearnext
drawbox nextrow, nextcol, nextnum, nextshape, mode
END SUB
SUB showscore
COLOR textcolor
LOCATE scorerow + 1, scorecol + 6: PRINT score
LOCATE linerow + 1, linecol + 6: PRINT lines
LOCATE levelrow + 1, levelcol + 6: PRINT level + initlevel
LOCATE speedrow + 1, speedcol + 6: PRINT speed + initspeed
END SUB
SUB showtime
DIM t AS STRING
t = DATE$ + " " + TIME$
msg t
t = gamestate
gamestate = "pause"
k$ = waitpress$
frmmain
Refresh
gamestate = t
END SUB
SUB startgame
score = 0
lines = 0
level = 0
speed = 0
gamestate = "start"
clearall
clearflag
createbox
newbox
showscore
IF initlevel > 0 THEN
setlevel
END IF
END SUB
SUB testbox
DIM i AS INTEGER, j AS INTEGER
r = 1
c = 1
FOR i = 6 TO 10
rr = i - 5
FOR j = 1 TO 4
drawbox r + (rr - 1) * 5, c + (j - 1) * 5, i, j, "show"
NEXT
NEXT
END SUB
SUB textbox (introw AS INTEGER, intcol AS INTEGER, intlen AS INTEGER, value AS STRING, mode AS STRING)
DIM intwid AS INTEGER
x = intcol * 8 - 2
y = introw * 16
intwid = intlen * 8 + 4
IF mode = "show" THEN
LINE (x, y)-(x + intwid, y + 16), 0, BF
LINE (x + intwid, y)-(x + intwid, y + 16), lightcolor
LINE (x, y + 16)-(x + intwid, y + 16), lightcolor
END IF
COLOR textcolor
LOCATE introw + 1, intcol + 1: PRINT value
END SUB
SUB unload
savesetting
END
END SUB
FUNCTION waitpress$
DIM kbd AS STRING
kbd = ""
DO WHILE kbd = "": kbd = INKEY$: LOOP
waitpress$ = kbd
END FUNCTION