graphsize 600,440
fastgraphics
font ("arial",20,100)
Dim i(4):Dim j(4):Dim l(4):Dim o(4):Dim s(4):Dim t(4):Dim z(4)
i = { 0x10F00, 0x12222, 0x100F0, 0x14444}
j = { 0x144C0, 0x18E00, 0x16440, 0x10E20}
l = {0x14460, 0x10E80, 0x1C440, 0x12E00 }
o = { 0x1CC00, 0x1CC00, 0x1CC00, 0x1CC00}
s = {0x106C0, 0x18C40, 0x16C00, 0x14620 }
t = {0x10E40, 0x14C40, 0x14E00, 0x14640}
z = { 0x10C60, 0x14C80, 0x1C600, 0x12640}
Dim board(14,29)
Dim stat(7)
Score = 0
endgame = false
initialwait= 0.1
# main loop for each newpiece
do
wait = initialwait
rot=int(rand*4)
shape = int (rand*7)
stat[shape]=stat[shape]+1
cores = int (rand*7)+1
piecedown = false
ypos=-1
xpos=5
# loop for each frame
do
ypos=ypos+1
# controls
for press = 1 to 4
a = key
if 16777234=a then xpos=xpos -checkmove(ref (board),a,xpos,ypos,shape$)
if 16777236 = a then xpos=xpos +checkmove(ref (board),a,xpos,ypos,shape$)
if 16777237=a then wait =0.01
if 16777235=a then
oldrot=rot
rot = rot+1
if rot = 4 then rot = 0
gosub selectshape
if checkmove(ref (board),a,xpos,ypos,shape$)=0 then
rot = oldrot
gosub selectshape
end if
end if
pause wait
next press
# procedures
gosub scorepanel
gosub selectshape
gosub drawboard
gosub drawshape
refresh
until piecedown = true
# these procedures are executed when a piece is down
gosub newboard
gosub takeline
gosub takeline
until endgame = true
#last instructions before end of game
Color white
font ("arial",50,100)
text 70,100, "Game Over"
refresh
end
scorepanel:
color darkgreen
rect 0,0,600,450
color green
Text 300,20,"Use arrow keys"
Text 300,60, "I .... "+stat[0]
Text 300,100,"J .... "+stat[1]
Text 300,140,"L .... "+stat[2]
Text 300,180,"O .... "+stat[3]
Text 300,220,"S .... "+stat[4]
Text 300,260,"T .... "+stat[5]
Text 300,300,"Z .... "+stat[6]
Text 300,350,"Score .... "+Score
return
selectshape:
if shape = 0 then shape$ = tobinary (i[rot])
if shape = 1 then shape$ = tobinary (j[rot])
if shape = 2 then shape$ = tobinary (l[rot])
if shape = 3 then shape$ = tobinary (o[rot])
if shape = 4 then shape$ = tobinary (s[rot])
if shape = 5 then shape$ = tobinary (t[rot])
if shape = 6 then shape$ = tobinary (z[rot])
return
function checkmove (ref (board),a,xpos,ypos,shape$)
checkmove=1
p=1
For v = 1 to 4
For h = 1 to 4
p=p+1
if mid(shape$,p,1)="1" then
if board[xpos+h,ypos+v]>0 then checkmove=0
if chr(a)="N" and (xpos+h>11 or xpos+h<2) then
checkmove=0
return
end if
if a=16777236 and xpos+h>10 then checkmove=0
if a=16777236 and board[xpos+h+1,ypos+v]>0 then checkmove=0
if a=16777234 and xpos+h<3 then checkmove=0
if a=16777234 and board[xpos+h-1,ypos+v]>0 then checkmove=0
end if
next h
next v
end function
drawshape:
if cores = 1 then color red
if cores = 2 then color blue
if cores = 3 then color yellow
if cores = 4 then color orange
if cores = 5 then color green
if cores = 6 then color purple
if cores = 7 then color white
p=1
For v = 1 to 4
For h = 1 to 4
p=p+1
if mid(shape$,p,1)="1" then
rect xpos*20+h*20,ypos*20+v*20,19,19
if board[xpos+h,ypos+v+1]>0 or ypos+v=20 then piecedown=true
end if
next h
next v
if piecedown=true then
if ypos<2 then endgame =true
return
end if
return
newboard:
p=2
For v = 1 to 4
For h = 1 to 4
if mid(shape$,p,1)="1" then board[xpos+h,ypos+v]=cores
p=p+1
next h
next v
return
drawboard:
For y = 1 to 20
For x = 2 to 11
if board[x,y] = 1 then color red
if board[x,y] = 2 then color blue
if board[x,y] = 3 then color yellow
if board[x,y] = 4 then color orange
if board[x,y] = 5 then color green
if board[x,y] = 6 then color purple
if board[x,y] = 7 then color white
if board[x,y]=0 then color black
rect x*20,y*20,19,19
next x
next y
return
takeline:
For y = 20 to 1 step -1
complete = true
For x = 2 to 11
if board[x,y]=0 then complete = false
next x
if complete = true then
For row = y to 1 step -1
For position = 1 to 10
board[position,row]=board[position,row-1]
next position
next row
Score = Score +1
ix = initialwait*.9
initialwait=ix
end if
next y
return
Posts
