dim pieces$(7)
dim letterTemplates$(10)
dim gridTemplate$(50, 5)
for x=1 to 5
for i=1 to 50
gridTemplate$(i, x)=mid$("TEXTRIS", q mod 7+1, 1)
q=q+1
next
next
dim grid(10, 21)
for x=1 to 10
grid(x, 21)=1
next
global readyDrop, score, list$
letterTemplates$(1)="112131415132333435"
letterTemplates$(2)="11213141121323331415253545"
letterTemplates$(3)="115122423324441555"
letterTemplates$(4)="11213112411323331444154542"
letterTemplates$(5)="11213141513233341525354555"
letterTemplates$(6)="2131411223334354253545"
letterTemplates$(7)="11512242333435"
letterTemplates$(8)="213141125213531454253545"
letterTemplates$(9)="1151125213531454253545"
letterTemplates$(10)="1112131415253545"
pieces$(1)="11213141"
pieces$(2)="11122232"
pieces$(3)="12223132"
pieces$(4)="11122122"
pieces$(5)="12212231"
pieces$(6)="12212232"
pieces$(7)="11212232"
for i=1 to 6
list$=list$+str$(int(rnd(1)*7)+1)
next
for i=1 to 7
text$=space$(7-i)+left$("TEXTRIS", i)
call textrisText text$
timer 500, [loopAround]
wait
[loopAround]
timer 0
cls
next
for i=1 to 3
call textrisText " "
timer 300, [next]
wait
[next]
timer 0
cls
call textrisText "TEXTRIS"
timer 300, [next2]
wait
[next2]
cls
timer 0
next
inputMode=1
[mainMenu]
cls
print "Hello, welcome to Textris! This game is a clone of Tetris. The"
print "game gives you shapes, which you manipulate in an attempt"
print "to create horizontal lines. But don't let them stack up to the"
print "top, or it's game over! Enter h for more instructions, enter o"
print "for options, enter anything else for new game. Note that this"
print "version does not allow the shapes to drop of their own"
print "accord, giving you more time to plan out your ideas."
input "";todo$
if lower$(mid$(todo$, 1, 1))="h" then
cls
print "The shapes begin at the top. You may press s to move the"
print "shapes down, w to rotate them, a to move them left, and d to"
print "move them right. Once you press down and it cannot go down"
print "any further, it stops and becomes part of the terrain. If an"
print "entire row is filled, the row is cleared and the rows above"
print "it drop. You also score 1 point if you eliminated 1 row, 3"
print "for 2 rows, 6 for 3 rows, and 10 for 4 rows. At the"
print "right, you can see which pieces are coming up next. If the"
print "shapes stack up to the top, you lose! Good luck!"
print "Press enter to go back to the main menu."
input "";dummy
goto[mainMenu]
end if
if lower$(mid$(todo$, 1, 1))="o" then
print "There are two forms of entering the controls. With option"
print "one, you enter your selection and press enter. Option two"
print "does not require you to press enter. However, option two will"
print "use all the processor power it can get, whereas option one uses"
print "very little. Note that during the game pressing t toggles these"
print "modes. Please enter 1 or 2. If you do not your current choice"
print "will remain."
input "";l
if l=1 or l=2 then inputMode=l
goto[mainMenu]
end if
[nextPiece]
done=0
rotating=0
nextPiece=val(left$(list$, 1))
list$=right$(list$, 5)+str$(int(rnd(1)*7)+1)
rotate$=pieces$(nextPiece)
curUpLeftX=4
curUpLeftY=0
curRot=0
lines=0
for i=1 to 4
curX=val(mid$(rotate$, i*2-1, 1))-1
curY=val(mid$(rotate$, i*2, 1))-1
if grid(curUpLeftX+curX, curUpLeftY+curY+1)=1 then lost=1
next
if lost=1 then goto[lost]
[redoit]
emptyLine=0
for i=20 to 1 step -1
empty=0
for x=1 to 10
if grid(x, i)=0 then
empty=1
exit for
end if
next
if empty=0 then
emptyLine=1
lines=lines+1
score=score+lines
which=i
for x=1 to 10
grid(x, i)=0
next
exit for
end if
next
if emptyLine=1 then
for i=which to 1 step -1
for x=1 to 10
grid(x, i)=grid(x, i-1)
next
next
goto[redoit]
end if
[frameUp]
for i=1 to 4
curX=val(mid$(rotate$, i*2-1, 1))-1
curY=val(mid$(rotate$, i*2, 1))-1
grid(curUpLeftX+curX, curUpLeftY+curY)=0
if grid(curUpLeftX+curX, curUpLeftY+curY+1)=1 then done=1
next
if done=1 then
for i=1 to 4
curX=val(mid$(rotate$, i*2-1, 1))-1
curY=val(mid$(rotate$, i*2, 1))-1
grid(curUpLeftX+curX, curUpLeftY+curY)=1
next
goto[nextPiece]
end if
curUpLeftY=curUpLeftY+1
for i=1 to 4
curX=val(mid$(rotate$, i*2-1, 1))-1
curY=val(mid$(rotate$, i*2, 1))-1
grid(curUpLeftX+curX, curUpLeftY+curY)=2
next
[redo]
cls
call draw
if inputMode=1 then input "What to do? s is down, w is rotate, a is left, d is right.";key$
if inputMode=2 then
print "What to do? s is down, w is rotate, a is left, d is right."
key$=input$(1)
end if
key$=lower$(key$)
if instr(key$, "t")>0 then inputMode=3-inputMode
if instr(key$, "s")>0 then goto[frameUp]
if instr(key$, "w")>0 then
rotating=rotating+1
new$=rotate$(nextPiece, rotating)
rotatel$=mid$(new$, 1, 1)+mid$(new$, 3, 1)+mid$(new$, 5, 1)+mid$(new$, 7, 1)
oldulx=curUpLeftX
olduly=curUpLeftY
if curUpLeftX>9 and instr(rotatel$, "2")>0 then curUpLeftX=9
if curUpLeftX>8 and instr(rotatel$, "3")>0 then curUpLeftX=8
if curUpLeftX>7 and instr(rotatel$, "4")>0 then curUpLeftX=7
for q=0 to 3
experCur=curUpLeftY-q
bad=0
for i=1 to 4
curX=val(mid$(new$, i*2-1, 1))-1
curY=val(mid$(new$, i*2, 1))-1
if grid(curUpLeftX+curX, experCur+curY)=1 then bad=1
next
if bad=0 then
curUpLeftY=experCur
for i=1 to 4
oldX=val(mid$(rotate$, i*2-1, 1))-1
oldY=val(mid$(rotate$, i*2, 1))-1
grid(oldulx+oldX, olduly+oldY)=0
next
rotate$=new$
for i=1 to 4
newX=val(mid$(rotate$, i*2-1, 1))-1
newY=val(mid$(rotate$, i*2, 1))-1
grid(curUpLeftX+newX, curUpLeftY+newY)=2
next
exit for
end if
next
if bad=1 then rotate=rotate-1
end if
if instr(key$, "a")>0 then
curUpLeftX=curUpLeftX-1
if curUpLeftX=0 then
curUpLeftX=1
goto[skipa]
end if
for i=1 to 4
curX=val(mid$(rotate$, i*2-1, 1))
curY=val(mid$(rotate$, i*2, 1))-1
grid(curUpLeftX+curX, curUpLeftY+curY)=0
next
for i=1 to 4
curX=val(mid$(rotate$, i*2-1, 1))-1
curY=val(mid$(rotate$, i*2, 1))-1
grid(curUpLeftX+curX, curUpLeftY+curY)=2
next
end if
[skipa]
if instr(key$, "d")>0 then
curUpLeftX=curUpLeftX+1
if curUpLeftX>10 then goto[dropIn]
rotatel$=mid$(rotate$, 1, 1)+mid$(rotate$, 3, 1)+mid$(rotate$, 5, 1)+mid$(rotate$, 7, 1)
if curUpLeftX>9 and instr(rotatel$, "2")>0 then goto[dropIn]
if curUpLeftX>8 and instr(rotatel$, "3")>0 then goto[dropIn]
if curUpLeftX>7 and instr(rotatel$, "4")>0 then
[dropIn]
curUpLeftX=curUpLeftX-1
goto[skipb]
end if
for i=1 to 4
curX=val(mid$(rotate$, i*2-1, 1))-1
curY=val(mid$(rotate$, i*2, 1))-1
if grid(curUpLeftX+curX, curUpLeftY+curY)=1 then bad=1
next
if bad=1 then
bad=0
goto[skipb]
end if
for i=1 to 4
curX=val(mid$(rotate$, i*2-1, 1))-2
curY=val(mid$(rotate$, i*2, 1))-1
grid(curUpLeftX+curX, curUpLeftY+curY)=0
next
for i=1 to 4
curX=val(mid$(rotate$, i*2-1, 1))-1
curY=val(mid$(rotate$, i*2, 1))-1
grid(curUpLeftX+curX, curUpLeftY+curY)=2
next
end if
[skipb]
if readyDrop=1 then
for i=1 to 4
curX=val(mid$(rotate$, i*2-1, 1))-1
curY=val(mid$(rotate$, i*2, 1))-1
if grid(curUpLeftX+curX, curUpLeftY+curY+1)=1 then stopping=1
next
for i=1 to 4
curX=val(mid$(rotate$, i*2-1, 1))-1
curY=val(mid$(rotate$, i*2, 1))-1
grid(curUpLeftX+curX, curUpLeftY+curY)=stopping
if stopping=0 then grid(curUpLeftX+curX, curUpLeftY+curY+1)=2
curUpLeftY=curUpLeftY+1
next
if stopping=1 then
stopping=0
goto[nextPiece]
end if
end if
goto[redo]
[lost]
cls
for i=1 to 8
text$=space$(8-i)+left$("YOU LOSE", i)
call textrisText text$
timer 500, [loopAround2]
wait
[loopAround2]
timer 0
cls
next
for i=1 to 3
call textrisText " "
timer 300, [next3]
wait
[next3]
timer 0
cls
call textrisText "YOU LOSE"
timer 300, [next4]
wait
mainwin 70 25
[next4]
cls
timer 0
next
input "Press Y to play again, anything else to exit.";again$
if left$(upper$(again$), 1)="Y" then goto[mainMenu]
print "Press alt-f4 to exit."
end
sub draw
cls
for y=1 to 20
for x=1 to 10
if grid(x, y)>0 then grid$=grid$+"X" else grid$=grid$+" "
next
grid$=grid$+chr$(13)
next
grid$=grid$+"OOOOOOOOOO"+chr$(13)
print grid$
locate 12, 1
print "Score: ";str$(score)
locate 12, 2
print "Next"
for i=3 to 18 step 3
locate 12, i
curPiece$=mid$(list$, i/3, 1)
show$=pieces$(val(curPiece$))
for a=1 to 4
curX=val(mid$(show$, a*2-1, 1))-1
curY=val(mid$(show$, a*2, 1))-1
locate 12+curX, i+curY
print "X"
next
next
locate 1, 22
end sub
sub nextFrame
readyDrop=1
end sub
function rotate$(pieceNum, rotations) 'Rotate clockwise
if pieceNum=1 and rotations mod 2=0 then rotate$="11213141"
if pieceNum=1 and rotations mod 2=1 then rotate$="11121314"
if pieceNum=2 and rotations mod 4=0 then rotate$="11122232"
if pieceNum=2 and rotations mod 4=1 then rotate$="11121321"
if pieceNum=2 and rotations mod 4=2 then rotate$="11213132"
if pieceNum=2 and rotations mod 4=3 then rotate$="13212223"
if pieceNum=3 and rotations mod 4=0 then rotate$="12223132"
if pieceNum=3 and rotations mod 4=1 then rotate$="11121323"
if pieceNum=3 and rotations mod 4=2 then rotate$="11122131"
if pieceNum=3 and rotations mod 4=3 then rotate$="11212223"
if pieceNum=4 then rotate$="11122122"
if pieceNum=5 and rotations mod 2=0 then rotate$="12212232"
if pieceNum=5 and rotations mod 2=1 then rotate$="11122223"
if pieceNum=6 and rotations mod 4=0 then rotate$="12212232"
if pieceNum=6 and rotations mod 4=1 then rotate$="11121322"
if pieceNum=6 and rotations mod 4=2 then rotate$="11212231"
if pieceNum=6 and rotations mod 4=3 then rotate$="12212223"
if pieceNum=7 and rotations mod 2=0 then rotate$="11212232"
if pieceNum=7 and rotations mod 2=1 then rotate$="12132122"
end function
sub textrisText text$
text$=upper$(text$)
for i=1 to len(text$)
curLetter$=mid$(text$, i, 1)
if curLetter$=" " then goto[noletter]
if curLetter$="T" then pos=1
if curLetter$="E" then pos=2
if curLetter$="X" then pos=3
if curLetter$="R" then pos=4
if curLetter$="I" then pos=5
if curLetter$="S" then pos=6
if curLetter$="Y" then pos=7
if curLetter$="O" then pos=8
if curLetter$="U" then pos=9
if curLetter$="L" then pos=10
xPos=(i-1)*6+1
posShow$=letterTemplates$(pos)
for x=1 to len(posShow$)/2
curX=val(mid$(posShow$, x*2-1, 1))-1
curY=val(mid$(posShow$, x*2, 1))-1
locate xPos+curX, 1+curY
print gridTemplate$(xPos+curX, 1+curY)
next
[noletter]
next
end sub
Code:' jb mainwin
' pac-main
' cundo 2008
on error goto [Error]
'Dim double array
dim map$(19,23),start(4,2)
difficulty = 3 ' 1 to 10
lives=3
r$="STARTING"
alternateMov = 1
mainwin 50 25
'Print a message to the Mainwin
Print "Press ";chr$(34);"q";chr$(34);" to quit"
Print "Movement keys: W,A,S,D, or 8,4,6,2 "
Print "Press any key to start",
if lower$(input$()) = "q" Then [quit]
gosub [restartscreen]
r$="RE";r$
'Store the data in the array
read height : read width : read wall$
read player$ : read ghost$ : read sghost$
read power$
b$ = wall$ 'walls
dots$ = chr$(186) 'change this to "*" or "." if you want
for i= 1 to height
read map$
for u= 1 to width
map$(i,u) = mid$(map$,u,1)
Select case map$(i,u)
Case " ","t","-"
If map$(i,u)="t" Then t=i
a = abs(not(a))
if a= 0 Then
max.points = max.points+1
map$(i,u) = dots$
End if
Case power$
p= p+1
power(p,0)=u : power(p,1)=i
Case player$
start(0,1)=u : start(0,2)=i
map$(i,u) = " "
Case ghost$
g=g+1
start(g,1)=u : start(g,2)=i
map$(i,u) = " "
End select
next u
next i
[restart]
h=0
scared=0
player.x=start(0,1) : player.y=start(0,2)
for i= 1 to g
ghost.x(i) =start(i,1) : ghost.y(i) =start(i,2)
next i
[reprint]
temp$= ""
mapscreen$= ""
'put the data in the mapscreen$ var
for i= 1 to height
for u= 1 to width
temp$=mapscreen$;map$(i,u)
if i = player.y and u = player.x Then
temp$= mapscreen$;player$
End if
for z= 1 to g
ghost.y=ghost.y(z) : ghost.x = ghost.x(z)
if i = ghost.y and u = ghost.x Then
if scared>0 Then
temp$= mapscreen$;sghost$
else
temp$= mapscreen$;ghost$
end if
End if
next
mapscreen$ = temp$
next u
mapscreen$=mapscreen$ + chr$(13)
next i
'show me the level
cls
scoreScreen=score + extraPoints
score$ = using("###",scoreScreen)
print mapscreen$, "Score: ";score$;" Lives: ";lives
If score=max.points or g = 0 Then [win]
if scared>0 Then
scared=scared - 1
End if
print "ghosts scared ";scared
for z = 1 to g
ghost.y=ghost.y(z) : ghost.x = ghost.x(z)
If player.x = ghost.x And player.y = ghost.y And lives>0 Then
If scared=0 Then [lose]
extraPoints=extraPoints+10
r$="Good"
locate 23,10: Print "10 Points"
locate 23,11
gosub [restartscreen]
r$="RESTARTING"
locate 0,0
'the ghost appear in the box
ghost.x(z) = start(z,1) : ghost.y(z)=start(z,2)
'the ghost disappear
'z was removed
'remove the last ghost, move the others in the array.
' r = g-z
' ghost.y(g-r)=ghost.y(g)
' ghost.x(g-r)=ghost.x(g)
' g=g-1
End if
next z
'player movement
key$=""
key$ = input$(1)
select case key$
case "6","d","D"
if map$(player.y, player.x+1)<>b$ Then
player.x = player.x+1
if player.x >=width and player.y=t Then player.x = 1
End if
case "4","a","A"
if map$(player.y, player.x-1)<>b$ Then
player.x = player.x-1
if player.x <=0 and player.y=t Then player.x =width
End if
case "8","w","W"
if map$(player.y-1, player.x)<>b$ Then
player.y = player.y-1
End if
case "2","s","S"
if map$(player.y+1, player.x)<>b$ Then
player.y = player.y+1
End if
case "q","Q"
goto [quit]
end select
if map$(player.y, player.x)=dots$ then map$(player.y, player.x)=" " : score=score+1
if map$(player.y, player.x)=power$ then
map$(player.y, player.x)=" " ': score=score+1
extraPoints= extraPoints +5
scared= 22
End if
'Ghost moves
if h<=2 then h= h+ 0.025
for z = 1 to g
ghost.y=ghost.y(z) : ghost.x = ghost.x(z)
new.x(z)=0:new.y(z)=0
If INT(rnd(1)*11)>INT(difficulty+h) OR _
(ABS(player.x-ghost.x)>5 and ABS(player.y-ghost.y)>5) Then
alternateMov = -1 * alternateMov
If map$(ghost.y+alternateMov, ghost.x)=b$ Then
if map$(ghost.y, ghost.x+alternateMov)=b$ Then
if map$(ghost.y+alternateMov*-1, ghost.x)=b$ Then
if map$(ghost.y, ghost.x+alternateMov*-1)=b$ Then
new.x(z)= alternateMov
else
new.x(z)=alternateMov*-1
End if
else
new.y(z)=alternateMov*-1
End if
else
new.x(z)=alternateMov
End if
else
new.y(z)=alternateMov
End if
Else
'Check player position and move according
if scared >0 Then m=-1 else m=1
if player.y>ghost.y Then
If map$(ghost.y +1*m, ghost.x)<>b$ Then new.y(z)= 1*m
else
If map$(ghost.y -1*m, ghost.x)<>b$ Then new.y(z)=-1*m
End if
if player.x>ghost.x Then
If map$(ghost.y, ghost.x +1*m)<>b$ Then new.x(z)= 1*m
else
If map$(ghost.y, ghost.x -1*m)<>b$ Then new.x(z)=-1*m
End if
End if
If (ghost.y=10 AND ghost.x=11) OR (ghost.y=9 AND ghost.x=11) Then
new.y(z)=-1 : new.x(z)=0
Else
If INT(rnd(0)*10)>5 Then new.y(z)=0 else new.x(z)=0
End if
If ghost.y=10 Then
if ghost.x<=1 then new.x(z)=1
if ghost.x>=width then new.x(z)=-1
End if
ghost.x(z)= ghost.x(z) + new.x(z)
ghost.y(z)= ghost.y(z) + new.y(z)
next z
Goto [reprint]
[lose]
lives = lives -1
locate 23,10
Print "Oops!"
if lives <=0 Then [quit]
key$=input$(1)
locate 23,11
gosub [restartscreen]
cls:locate 0,0
goto [restart]
[win]
Print "Yeah!"+chr$(13)+"Level complete."
Print "Lives ";lives
Print "Score ";score+extraPoints
END
[Error]
Print
print "Error",Err$
[quit]
if lives<=0 Then Cls : Print "------- LOSER -------"
Print chr$(13); "---------------------";chr$(13);"------ Bye! -------"
Print "---------------------"
END
[restartscreen]
for i = 1 To len(r$)
pause = time$("ms")+100
while time$("ms") < pause : wend
Print mid$(r$,i,1);
next i
return
'level data,
'height, width, walls, player, ghost, PacPowerPill, map
data 19,21
data "#","O","n","ñ","@"
data "#####################"
data "#@ ##### @#"
data "# ##### ##### ##### #"
data "# # ##### # #"
data "## ## # # ## ##"
data "## ##### ##"
data "##### # # # #####"
data "##### # # #####"
data "##### # ##-## # #####"
data "t #nnn# "
data "##### # ##### # #####"
data "##### # # #####"
data "##### ##### #####"
data "# # # # #"
data "#@ ## # # # # ## @#"
data "## # ## ## # ##"
data "## #### ## ## ### ##"
data "## O ##"
data "#####################"
' Just BASIC program to remove line numbers from GW-BASIC
' source code. It preserves the lines referenced by a
' GOTO, THEN, ELSE or GOSUB.
' It will also make them JB-style labels by putting [ and ]
' around them. It will do the same to the calling line
' so that something like --
' 100 IF a=b THEN 250 ELSE 350
' becomes --
' IF a=b THEN GOTO [250] ELSE GOTO [350]
filedialog "Select BAS file", "*.*", myfile$
if myfile$="" then End
open myfile$ for input as #fin
open myfile$+".new" for output as #fout
n = 0
all$ = " "
while eof(#fin)=0
line input #fin, aline$
if val(aline$)>0 then
n = n + 1
call xtracto aline$, "GOTO ", all$
call xtracto aline$, "THEN ", all$
call xtracto aline$, "ELSE ", all$
call xtracto aline$, "GOSUB ", all$
' PRINT aline$
print #fout, aline$
end if
wend
close #fin
close #fout
print myfile$; " has "; n; " lines."
print
print "Length of all$ = "; len(all$); " characters."
print all$
' now that we have an string with all the lines that need to be labeled
' we open our .new file, adding brackets to those lines needing
' them and removing the line numbers from those lines that don't.
open myfile$+".new" for input as #fin
while eof(#fin)=0
line input #fin, aline$
n = val(aline$)
if n>0 then
if instr(all$, " ";str$(n);" ", 1)>0 then
print "["; str$(n); "]"; mid$(aline$, len(str$(n))+1)
else
print mid$(aline$, len(str$(n))+1)
end if
else
print aline$ ' if no line #, print full line
end if
wend
close #fin
print
print "Done."
End
sub xtracto byref ln$, s$, byref t$
pos = instr(ln$, s$, 1)
while pos>0
g = val(trim$(mid$(ln$, pos+len(s$))))
if g>0 then
t$ = t$ + str$(g) + " " ' save line number
' if you want to store each label once, replace the line above this
' comment with the line below. I find it useful to know the number
' of times each label is called.
' if instr(t$, " ";g$;" ", 1)=0 then t$ = t$ + str$(g)+" "
' add brackets for GOTOs and GOSUBs
' add GOTO + brackets for THENs and ELSEs.
p2 = pos+len(s$)
p3 = pos+len(s$)+len(str$(g))
if left$(s$, 2)="GO" then
ln$ = mid$(ln$, 1, p2-1); "["; mid$(ln$, p2, p3-p2); "]"; mid$(ln$, p3)
else ' for THEN or ELSE
ln$ = mid$(ln$, 1, p2-1); "GOTO [" _
+ mid$(ln$, p2, len(str$(g))); "]" _
+ mid$(ln$, p3)
end if
end if
pos = instr(ln$, s$, pos+len(s$))
wend
end sub