so another simple game made for lessons...
mouse: click & drag to form triples
keyboard: arrows to move enter to select (after select arrow will drag to that direction)
space: (cheat! show avaliable moves :P)
#include "fbgfx.bi"
dim shared as integer matriz( -2 to 8+3 , -2 to 8+3 )
dim shared as integer MostraPossibilidade=0
dim as integer lin,Col,N,I
locate ,,0 'hide cursor
width 10*3-2,10*2-2
'write a single block
sub DesenhaBloco( Lin as integer , Col as integer , Num as integer , Sel as integer )
if Num = 0 then 'break dimension effect
color 13, 0
locate lin*2+0 , col*3 : print chr(32+rnd*95,32+rnd*95,32+rnd*95);
locate lin*2+1 , col*3 : print chr(32+rnd*95,32+rnd*95,32+rnd*95);
sleep Sel,1
exit sub
end if
if Num < 0 then 'black if hidden
color 0,0
else
if sel<>0 then color Num+8,Num else color Num,Num+8
end if
locate lin*2+0 , col*3 : print chr(&hC9,&hCD,&hBB);
locate lin*2+1 , col*3 : print chr(&hC8,&hCD,&hBC);
end sub
'draws whole map (matrix)
sub DesenhaMatriz()
dim as integer lin,Col,N
for lin=1 to 8
for Col=1 to 8
DesenhaBloco( lin,Col , matriz(lin,col) , 0 )
next col
next lin
end sub
'check matrix for triplets to drop
function VerificaMatriz() as integer
dim as integer Lin,Col , N
dim as integer Cor=0,Qtd=0
dim as integer Resultado=0
'check for 3+ consecutives same color blocks in a column
For Col=1 to 8
For Lin=1 to 9
if Cor=abs(matriz(Lin,Col)) then 'if color matches then increment count
Qtd = Qtd + 1
else 'if does not match, but there was 3+ matches then drop it and in both cases restart counter
if Qtd >= 3 then 'if 3+ matches negative them so they fall
for N = 1 to Qtd
if matriz(Lin-N,Col)>0 then DesenhaBloco( Lin-N , Col , 0 , 150 )
matriz(Lin-N,Col) = -Cor
next N
Resultado = Resultado+1
end if
Cor=abs(matriz(Lin,Col)) : Qtd=1
end if
next
next
'check for 3+ consecutive same color blocks in a row
For Lin=1 to 8
For Col=1 to 9
if Cor=abs(matriz(Lin,Col)) then 'if color matches then increment count
Qtd = Qtd + 1
else 'if does not match, but there was 3+ matches then drop it and in both cases restart counter
if Qtd >= 3 then 'if 3+ matches negative them so they fall
for N = 1 to Qtd
if matriz(Lin,Col-N)>0 then DesenhaBloco( Lin , Col-N , 0 , 150 )
matriz(Lin,Col-N) = -Cor
next N
Resultado = Resultado+1
end if
Cor=abs(matriz(Lin,Col)) : Qtd=1
end if
next
next
return Resultado
end function
'drop negatived elements
sub DesabaMatriz()
dim as integer lin,col,N,desabou
for lin=8 to 1 step -1 'for each line starting from bottom
desabou=0
for col=1 to 8 'if negative(removed)
if matriz(lin,col)<0 then 'drop this column
for N = lin to 2 step -1
matriz(N,col) = matriz(N-1,col)
next N
matriz(1,col) = int(rnd*7)+1
desabou = 1
end if
next col
if desabou<>0 then
DesenhaMatriz() : sleep 100,1
lin = lin+1 'if dropped then verify same line again
end if
next lin
DesenhaMatriz()
end sub
'show possible moves (cheat, but should be limited attempts :P)
sub Mostra(Lin as integer ,Col as integer,OLin as integer,OCol as integer, Sel as integer)
if MostraPossibilidade=0 then exit sub
dim as integer L,C
for L=Lin to Lin+OLin
for C=Col to Col+OCol
DesenhaBloco( L,C , Matriz(L,C) , Sel )
next C
next L
end sub
'there are movements possible?
function ExisteMovimentos() as integer
' 3 2 ?4 1 3 5
'
' 1 3? 5 ?2 1 3
'
' 2 4 [3] 1 2 4
'
' 1 *2 [3] 5 *1 2
'
' *2 ?5 <4>?4> 3 *1
'
' 1 *4 ?2 1 *5 4
'
'if there's 2 consecutives blocks on a row or column
'check surrounding blocks to see if same block
dim as integer I,N,Num,Sel
dim as integer Resultado = 0
for Sel = 1 to 4
For I=1 to 7
For N=1 to 8
Num = matriz(I,N) 'check column <> *
if Num = matriz(I,N+1) then
rem check surroundings
if matriz(I ,N-2)=Num then Mostra(I,N,0,1,Sel mod 2) : Resultado = 1
if matriz(I-1,N-1)=Num then Mostra(I,N,0,1,Sel mod 2) : Resultado = 1
if matriz(I+1,N-1)=Num then Mostra(I,N,0,1,Sel mod 2) : Resultado = 1
if matriz(I-1,N+2)=Num then Mostra(I,N,0,1,Sel mod 2) : Resultado = 1
if matriz(I+1,N+2)=Num then Mostra(I,N,0,1,Sel mod 2) : Resultado = 1
if matriz(I ,N+3)=Num then Mostra(I,N,0,1,Sel mod 2) : Resultado = 1
end if
Num = matriz(N,I) 'check rows [] ?
if Num=matriz(N+1,I) then
rem check surroundings
if matriz(N-2,I )=Num then Mostra(N,I,1,0,Sel mod 2) : Resultado = 1
if matriz(N-1,I-1)=Num then Mostra(N,I,1,0,Sel mod 2) : Resultado = 1
if matriz(N-1,I+1)=Num then Mostra(N,I,1,0,Sel mod 2) : Resultado = 1
if matriz(N+2,I-1)=Num then Mostra(N,I,1,0,Sel mod 2) : Resultado = 1
if matriz(N+2,I+1)=Num then Mostra(N,I,1,0,Sel mod 2) : Resultado = 1
if matriz(N+3,I )=Num then Mostra(N,I,1,0,Sel mod 2) : Resultado = 1
end if
next
next
if Resultado=0 or MostraPossibilidade=0 then exit for
sleep 250,1
next Sel
return Resultado
end function
'init the random number generator
randomize()
do 'create random map
For lin=1 to 8
For col=1 to 8
matriz(lin,col)=int(rnd*7)+1
next col
next lin
'if triples are found restart... (cheap trick, but easy)
For I=1 to 6
For N=1 to 8
if matriz(I,N)=matriz(I+1,N) and matriz(I,N)=matriz(I+2,N) then continue do
if matriz(N,I)=matriz(N,I+1) and matriz(N,I)=matriz(N,I+2) then continue do
next
next
exit do
loop
DesenhaMatriz()
dim as integer cursor,alternacursor
dim as integer cursorlin=4,cursorcol=4
dim as integer antigalin,antigacol
dim as integer sellin,selcol
dim as integer MLin,MCol,MBut,MEsquerdo
dim as string tecla
do
if antigalin<>cursorlin or antigacol<>cursorcol then
if cursor<>0 then DesenhaBloco( antigalin,antigacol , matriz(antigalin,antigacol) , 0 )
antigalin=cursorlin : antigacol=cursorcol
endif
alternacursor=alternacursor+1
if alternacursor>=5 then
alternacursor=0
if cursor=1 then cursor=0 else cursor=1
end if
if sellin<>0 then cursor=1
DesenhaBloco( cursorlin,cursorcol , matriz(cursorlin,cursorcol) , cursor )
tecla=inkey
if tecla="" then sleep 50
if tecla=chr(255,fb.sc_up) and cursorlin>1 then
cursorlin=cursorlin-1 : if sellin<>0 then tecla=chr(13)
end if
if tecla=chr(255,fb.sc_down) and cursorlin<8 then
cursorlin=cursorlin+1 : if sellin<>0 then tecla=chr(13)
end if
if tecla=chr(255,fb.sc_left) and cursorcol>1 then
cursorcol=cursorcol-1 : if sellin<>0 then tecla=chr(13)
end if
if tecla=chr(255,fb.sc_right) and cursorcol<8 then
cursorcol=cursorcol+1 : if sellin<>0 then tecla=chr(13)
end if
if tecla=" " then
MostraPossibilidade = 1
ExisteMovimentos()
MostraPossibilidade = 0
end if
'----- mouse -----
'MLin,MCol,MBut,MButAntigo
getmouse MCol,MLin,,MBut
color 7,0 : locate 1,1
Lin = (MLin-1+2)\2 : Col = (MCol-2+3)\3
if MBut=1 and MEsquerdo=0 then 'left button pressed
if Lin >= 1 and Col >= 1 and Lin <= 8 and Col <= 8 then
MEsquerdo = 1
sellin = Lin : selcol = Col
cursorlin = Lin : cursorcol = Col
end if
end if
if MBut=1 and MEsquerdo=1 and SelLin<>0 then 'was pressed, verify movement
if Lin >= 1 and Col >= 1 and Lin <= 8 and Col <= 8 then
if (abs(Lin-SelLin)+abs(Col-SelCol))=1 then
cursorlin = Lin : cursorcol = Col
tecla=chr(13) 'make it as if ENTER was pressed
end if
end if
end if
if MBut=0 and MEsquerdo=1 then 'released left button
MEsquerdo = 0
sellin = 0 : selcol = 0
#if 0
if Lin >= 1 and Col >= 1 and Lin <= 8 and Col <= 8 then
MEsquerdo = 0
if (abs(Lin-SelLin)+abs(Col-SelCol))=1 then
cursorlin = Lin : cursorcol = Col
tecla=chr(13) 'make it as if ENTER was pressed
else
sellin = 0 : selcol = 0 'clear selection if invalid click
end if
end if
#endif
end if
'-----------------
if tecla=chr(26) and sellin=0 then 'ctrl+z
for lin=8 to 1 step -1
for col=1 to 8
matriz(lin,col) = -1
DesenhaBloco( lin , col , 0 , 30 )
next col
next lin
sellin=cursorlin : selcol=cursorcol : tecla=chr(13)
end if
if tecla=chr(13) then 'enter
if sellin=0 then
sellin=cursorlin
selcol=cursorcol
else
dim as integer desabou = 0
swap matriz(sellin,selcol),matriz(cursorlin,cursorcol)
do
if VerificaMatriz()<>0 then 'if triples found then drop them
DesabaMatriz() : desabou=1
else 'if not then it was a bad movement
if desabou<>0 then
if ExisteMovimentos()=0 then
'if no movements are possible clear the map and restart
'(this time no triples prevention checks are needed)
for lin=8 to 1 step -1
for col=1 to 8
matriz(lin,col) = -1
DesenhaBloco( lin , col , 0 , 30 )
next col
next lin
continue do 'and make it verify matrix for triples again
end if
exit do 'if it dropped at least once then we're done
end if
'didnt dropped anything so undo movement (invalid)
DesenhaMatriz() : sleep 250
swap matriz(sellin,selcol),matriz(cursorlin,cursorcol)
exit do
end if
loop
DesenhaMatriz()
sellin=0 : selcol=0
endif
endif
loop
sleep