gem matching game

[mysoft]

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 )

#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