Resta1 em AdvPL

Introdução

Seguindo a linha de jogos em AdvPL, hoje o post traz para vocês a contribuição do desenvolvedor e nobre colega Flávio Luiz Vicco, que fez um porte do jogo “Resta 1” para o AdvPL, usando orientação a objeto em AdvPL.

O Jogo

Resta 1 é um quebra-cabeças, cujo objetivo é retirar todas as peças do tabuleiro, até que reste somente uma. No início do jogo, há 32 peças no tabuleiro, deixando vazia a posição central. Um movimento consiste em pegar uma peça e fazê-la “saltar” sobre outra peça, sempre na horizontal ou na vertical, terminando em um espaço vazio. A peça que foi “saltada” é retirada do tabuleiro. O jogo termina quando não mais é possível fazer nenhum outro movimento. Nesta ocasião, o jogador ganha se restar apenas uma peça no tabuleiro.

resta1

Com apenas 250 linhas a classe com o “core” do jogo foi implementada, e usando menos de 50 linhas, foi implementada a função executora do Jogo. Internamente, o jogo usa a classe tPaintPanel, e a classe executora monta o jogo usando uma caixa de diálogo e um menu superior. Os objetos correspondentes às peças do quebra-cabeça são criados nas respectivas posições, disparando um bloco de código a cada clique do mouse em cada posição. Ao clicar em uma posição ocupada por uma pedra, a respectiva posição é selecionada. Ao clicar em uma nova pedra, esta passa ser a pedra selecionada. Uma vez havendo a seleção de uma pedra, caso você clique em uma posição livre localizada a 2 pedras de distância da pedra selecionada, e entre elas existe uma pedra, a pedra selecionada é movida para a nova posição selecionada, e a pedra entre elas é removida.

Compilando e Executando

Para compilar e executar o Resta Um, basta baixar os fontes e imagens do GitHub, no endereço “https://github.com/siga0984/Resta1-OO“, criar um projeto no IDE/TDS, acrescentar os dois fontes PRW no projeto, acrescentar todas as imagens no projeto como recursos do Projeto, compilar tudo, e chamar a função “U_RESTA1” através do SmartClient.

O Código

Um jogo de tabuleiro, sem adversário ou contagem de tempo, deve ter uma representação em memória do estado do tabuleiro, uma interface que represente graficamente esta representação, e permita ao jogador imputar um movimento, e ser capaz de criticar um movimento inválido, e aplicar um movimento válido na representação do tabuleiro em memória.

Para desempenhar estas tarefas, o jogo foi implementado como uma classe em AdvPL, chamada “TResta1”, onde o construtor “New()” recebe como parâmetro o “container” de interface do Jogo — no nosso caso o objeto da janela de diálogo — e inicia a execução do jogo através do método Activete() da classe “TResta1”.

Na classe TRESTA1, a propriedade “aShape” contem todas as peças do quebra-cabeças. Como o tabuleiro é basicamente a união de um array 3×7 e outro 7×3, compartilhando a área central ( 3×3 ), o array é criado baseado em um loop de 7×7 elementos, onde as posições onde não entraria nenhuma pedra nao são ocupadas não criam nenhum novo elemento. São 16 posicoes ignoradas, 4 de cada quadrante. Sabendo que uma matriz 7×7 tem 49 elementos, e 16 serão ignorados, serão criadas 33 posições no tabuleiro, onde para cada uma será atribuído um status ( vazio / ocupado / selecionado ) e uma imagem correspondente ao estado.

Partindo de um loop 7×7, numerando cada elemento sequencialmente, eu teria as seguintes posições numeradas:

01 02 03 04 05 06 07
08 09 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31 32 33 34 35
36 37 38 39 40 41 42
43 44 45 46 47 48 49

Somente serão criados elementos para as posições onde podem haver pedras no quebra-cabeça. Logo, as 4 pedras de cada extremidade deste quadrado não serão usadas — repare que as posições a serem usadas estão em negrito. Cada pedra é criada como um “Shape” dentro do tPaintPanel, e cada uma delas recebe um identificador único, sendo criadas 33 pedras ( ou shapes ), no loop abaixo — vide método Activate() da classe tResta1.

For nX := 1 To 7
 For nY := 1 To 7
  nZ ++
  If !StrZero(nZ,2) $ "01|02|06|07|08|09|13|14|36|37|41|42|43|44|48|49"
   ::Create( ::oTPanel, nX, nY, "P"+StrZero(nZ,2), IIf(nZ==25,0,1) )
  EndIf
 Next nY
Next nX

O evento interessante tratado no jogo é o Click() … A classe tPaintPanel() tem uma propriedade que permite informar um bloco de código, que será disparado quando o usuário da aplicação clicar com o mouse dentro da área do tPaintPanel. Ao ver o fonte, reparamos que o evento em si não recebe nenhum parâmetro, mas isso não impede do método ‘descobrir’ se o evento de clique do mouse foi feito em cima de um determinado Shape. Ao ser criado, cada shape possui um “ID”, informado pela aplicação como um valor numérico. Quando um evento de clique do mouse é realizado sobre um shape, a propriedade ShapeAtu da instância do tPaintPanel é atualizada. Logo, o método somente precisa procurar no array de Shapes qual o shape que foi clicado. Se não foi clicado em nenhum shape, o evento é ignorado.

//-- Identifica obj. shape clicado.
nDestino := aScan(::aShape,{ |x|(x[1] == ::oTPanel:ShapeAtu)})

Ainda dentro do método Click(), existe todo o tratamento para avaliar como o clique deve ser tratado. Para realizar um “pulo”, você deve selecionar uma pedra, criando sobre ela, e depois clicando em um espaço em branco, indicando que você quer movê-la para aquela posição. Seu movimento somente será realizado se, a posição escolhida tiver a distancia de 2 casas, na horizontal ou vertical — diagonal não pode — , e entre a posição selecionada e a posição escolhida, exista uma pedra — que será removida.

E, da forma que o jogo foi idealizado, existe um programa “base”, ou “executor”, que é responsável por prover a interface externa do jogo — A janela de diálogo onde o jogo será montado e o menu de opções — Iniciar Novo Jogo, Ajuda, Sair, barra de status inferior, etc. Reparem que apenas uma instância do jogo é criada e armazenada na variável oResta1, e a partir deste ponto todas as ações externas que podem ser realizadas com o Jogo ( iniciar, reiniciar, mostrar ajuda) são feitas a partir dos métodos publicados.

#INCLUDE "PROTHEUS.CH"

/* -----------------------------------------------------
Fonte RESTA1.PRW
Programa Resta 1 - executor
Autor Flavio Luiz Vicco
Data 11/2016
----------------------------------------------------- */

User Function Resta1()
 Local oDlg
 Local oResta1
 DEFINE DIALOG oDlg TITLE "Resta1" From 180,180 TO 550,700 PIXEL COLOR CLR_BLACK,CLR_WHITE
 oDlg:lEscClose := .F.
 //-- Cria Resta1
 oResta1:= TResta1():New(oDlg)
 //-- Cria Menu superior
 CreateMenuBar(oDlg,oResta1)
 //-- Cria Barra de Status inferior
 CreateMsgBar(oDlg)
 // Na ativação do dialogo, ativa o jogo 
 ACTIVATE DIALOG oDlg CENTERED ON INIT oResta1:Activate()
Return Nil

//-- Cria Menu superior
Static Function CreateMenuBar(oDlg,oResta1)
 oTMenuBar:= TMenuBar():New(oDlg)
 oTMenuBar:SetCss("QMenuBar{background-color:#eeeddd;}")
 oTMenuBar:Align := CONTROL_ALIGN_TOP
 oTMenuBar:nClrPane := RGB(238,237,221)
 oTMenuBar:bRClicked := {||}
 oFile:= TMenu():New(0,0,0,0,.T.,,oDlg)
 oHelp:= TMenu():New(0,0,0,0,.T.,,oDlg)
 oTMenuBar:AddItem("&Arquivo",oFile,.T.)
 oTMenuBar:AddItem("Aj&uda" ,oHelp,.T.)
 oFile:Add(TMenuItem():New(oDlg,"&Novo Jogo",,,,{|| oResta1:NewGame()},,"",,,,,,,.T.))
 oFile:Add(TMenuItem():New(oDlg,"Sai&r",,,,{|| If(MsgYesNo("Deseja realmente sair do jogo?"),oDlg:End(),)},,"FINAL",,,,,,,.T.))
 oHelp:Add(TMenuItem():New(oDlg,"&Sobre... F1",,,,{|| oResta1:Help() },,"RPMPERG",,,,,,,.T.))
Return

//-- Cria Barra de Status inferior
Static Function CreateMsgBar(oDlg)
 oTMsgBar := TMsgBar():New(oDlg, "Resta1",.F.,.F.,.F.,.F., RGB(116,116,116),,,.F.) 
 oTMsgItem1 := TMsgItem():New( oTMsgBar,"2014", 100,,,,.T., {||} ) 
 oTMsgItem2 := TMsgItem():New( oTMsgBar,"V.1.00", 100,,,,.T., {||} )
Return


//----------------------------------------------------------------------------

E, segue abaixo o fonte da classe do jogo .

#INCLUDE "PROTHEUS.CH"

/* -----------------------------------------------------
Fonte TRESTA1.PRW
Programa Resta 1 - objetos
Autor Flavio Luiz Vicco
Data 11/2016
----------------------------------------------------- */

Class TResta1

Data nId AS INTEGER
 Data nOrigem AS INTEGER // Numero da posicao selecionada
 Data aShape AS ARRAY INIT {}
 DATA oTPanel AS OBJECT // tPaintPanel

Method New(oDlg) CONSTRUCTOR
 Method Activate()
 Method NewGame()
 Method Create()
 Method Click( x, y, oTPanel )
 Method Change( oTPanel, nItem, nStatus )
 Method SetId()
 Method ExportImage()
 Method Help()
EndClass

Method New(oDlg) Class TResta1
 ::nId := 0 
 ::nOrigem := 0 
 ::aShape := {} 
 ::oTPanel:= TPaintPanel():new(0,0,0,0,oDlg,.f.)
 ::oTPanel:Align := CONTROL_ALIGN_ALLCLIENT
 ::oTPanel:bLClicked := {|x,y| ::Click()}
 ::ExportImage()
Return Self

Method Activate() Class TResta1
 Local nX := 0
 Local nY := 0
 Local nZ := 0
 Local cImg := "backg.png"
 Local cId := ""
 //-- Tamanho da tabuleiro
 cTabLarg := cValToChar(400)
 cTabAlt := cValToChar(450)
 //-- Ajusta tela conforme tabuleiro
 ::oTPanel:oWnd:nHeight := Val(cTabAlt)
 ::oTPanel:oWnd:nWidth := Val(cTabLarg)
 //-- Altura largura do tabuleiro
 cAltura := '0'
 cLargura := '0'
 //-- Cria Container
 ::oTPanel:addShape( "id="+::SetId()+";type=1;left=0;top=0;width="+cValToChar(Val(cTabLarg))+;
   ";height="+cValToChar(Val(cTabAlt))+";"+;
   "gradient=1,0,0,0,0,0.0,#FFFFFF;pen-width=0;pen-color=#FFFFFF"+;
   ";can-move=0;can-mark=0;is-container=1;")
 //-- Cria shape com imagem do tabuleiro
 cId := ::SetId()
 ::oTPanel:addShape( "id="+cId+";type=8;left="+cLargura+";top="+cAltura+";width="+cTabLarg+;
   ";height="+cTabAlt+";image-file="+::GetTempPath()+cImg+";tooltip=Resta1"+;
   ";can-move=0;can-deform=0;can-mark=0;is-container=1")
 For nX := 1 To 7
  For nY := 1 To 7
   nZ ++
   If !StrZero(nZ,2) $ "01|02|06|07|08|09|13|14|36|37|41|42|43|44|48|49"
    ::Create( ::oTPanel, nX, nY, "P"+StrZero(nZ,2), IIf(nZ==25,0,1) )
   EndIf
  Next nY
 Next nX
Return

Method NewGame() Class TResta1
 Local nX := 0
 Local nY := 0
 Local nZ := 0
 For nZ := 1 To Len(::aShape)
  nX := ::aShape[nZ,3]
  nY := ::aShape[nZ,4]
  If ::aShape[nZ,5] <> IIf(nX==4.And.nY==4,0,1)
   ::Change( ::oTPanel, nZ, IIf(nX==4.And.nY==4,0,1 ) )
  EndIf
 Next nZ
Return

Method Create( oPanel, nImgX, nImgY, cCodigo, nStatus, nShape, cImgId ) Class TResta1
 Local cWidth := "30"
 Local cHeight := "30"
 Local cImg := ""
 Local cToolTip := AllTrim(cCodigo)+" X= "+AllTrim(Str(nImgX))+" Y= "+AllTrim(Str(nImgY))
 Default nShape := 0
 Default cImgId := ::SetId()

 //-- Define imagem para cada status
 // 0 = Nao há pedra - vazio
 // 1 - Espaço ocupado com uma pedra
 // 2 - Pedra atualmente selecionada
 Do Case
 Case nStatus == 0
   cImg := "empty.png"
 Case nStatus == 1
   cImg := "full.png"
 Case nStatus == 2
   cImg := "select.png"
 EndCase
 //-- criacao do obj
 If nShape == 0
  aAdd(::aShape,Array(5))
  nShape := Len(::aShape)
 EndIf
 //-- config. do obj
 ::aShape[nShape,1] := Val(cImgId) //CODIGO DO SHAPE
 ::aShape[nShape,2] := cCodigo //CODIGO
 ::aShape[nShape,3] := nImgX //POSICAO X
 ::aShape[nShape,4] := nImgY //POSICAO Y
 ::aShape[nShape,5] := nStatus //STATUS

oPanel:addShape("id="+cImgId+";type=8;left="+Str(nImgY*45)+;
 ";top="+Str(nImgX*45)+";width="+cWidth+";height="+cHeight+;
 ";image-file="+::GetTempPath()+cImg+";tooltip="+cToolTip+;
 ";can-move=0;can-deform=1;can-mark=0;is-container=0")
Return

Method Click() Class TResta1
 Local nDestino := 0
 Local nSalto := 0
 Local nIdImg := 0
 Local nX := 0
 Local nY := 0
 Local nIdClk := 0
 Local nStatus := 0
 Local lOk := .F.

//-- Identifica obj. shape clicado.
 nDestino := aScan(::aShape,{ |x|(x[1] == ::oTPanel:ShapeAtu)})
 If nDestino > 0
  nStatus := ::aShape[nDestino,5]
  Do Case
  Case nStatus == 0
  If ::nOrigem > 0
  nX0 := ::aShape[::nOrigem ,3]
  nY0 := ::aShape[::nOrigem ,4]
  nX1 := ::aShape[ nDestino,3]
  nY1 := ::aShape[ nDestino,4]
  //-- Verifica se movimento horizontal valido...
  If (nX0 == nX1 .And. Abs(nDif := nY0 - nY1) == 2)
   If nDif == 2
    nDif := -1
   Else
    nDif := 1
   EndIf
   lOk := (nSalto:=aScan(::aShape,{|x| x[3]==nX0 .And. x[4]==nY0+nDif .And. x[5]==1})) > 0
  EndIf
  //-- Verifica se movimento vertical valido...
  If (nY0 == nY1 .And. Abs(nDif := nX0 - nX1) == 2)
   If nDif == 2
    nDif := -1
   Else
    nDif := 1
   EndIf
   lOk := (nSalto:=aScan(::aShape,{|x| x[3]==nX0+nDif .And. x[4]==nY0 .And. x[5]==1})) > 0
  EndIf
  If lOk
   nStatus := 1
   //-- Retira da posicao saltada
   ::Change( ::oTPanel, nSalto, 0 )
   //-- Retira da posicao anterior
   ::Change( ::oTPanel, ::nOrigem, 0 )
   ::nOrigem := 0
  EndIf
 EndIf
 Case nStatus == 1
 If ::nOrigem > 0
  //-- Retira da posicao anterior
  ::Change( ::oTPanel, ::nOrigem, 1 )
 EndIf
 nStatus := 2
 ::nOrigem:= nDestino
 lOk := .T.
 Case nStatus == 2
  nStatus := 1
  ::nOrigem:= 0
  lOk := .T.
 EndCase
 //-- Troca figura da posicao atual
 If lOk
  ::Change( ::oTPanel, nDestino, nStatus )
 EndIf
 EndIf
Return

//-- Realiza uma mudança de status de um elemento ( pedra ) do jogo 
Method Change( oTPanel, nItem, nStatus ) Class TResta1
 Local nIdImg := 0
 Local cCodigo := ""
 Local nX := 0
 Local nY := 0
 nIdImg := ::aShape[nItem,1]
 cCodigo := ::aShape[nItem,2]
 nX := ::aShape[nItem,3]
 nY := ::aShape[nItem,4]
 //-- Excluir shape com status anterior
 ::oTPanel:DeleteItem(nIdImg)
 //-- Recriar shape com status atual
 ::Create( ::oTPanel, nX, nY, cCodigo, nStatus, nItem, Str(nIdImg) )
Return

//-- CRia identificador sequencial para objetos
Method SetId() Class TResta1
Return cValToChar(++::nId)

//-- Exporta as imagens do RPO para o temporario %TEMP%
Method ExportImage() Class TResta1
 Local aImage := { "backg.png" , "empty.png" , "full.png" , "select.png" }
 Local nImage, cImageTo
 For nImage := 1 To Len(aImage)
  cImageTo := ::GetTempPath()+aImage[nImage]
  If !Resource2File(aImage[nImage],cImageTo)
   MsgStop("Image not found: " + aImage[nImage])
   QUIT
  EndIf
 Next nImage
Return

Method Help() Class TResta1
 MsgInfo( "Resta1 em ADVPL.","Bem Vindo!")
Return

Conclusão

Agradeço novamente a colaboração do Fávio Vicco, neste momento em que eu estou enfrentando um breve “bloqueio criativo” ..risos.. e desejo a todos TERABYTES DE SUCESSO !!!

Referências

https://github.com/siga0984/Resta1-OO
http://tdn.totvs.com/display/tec/TPaintPanel
https://pt.wikipedia.org/wiki/Resta_um

Anúncios

Damas em AdvPL

Introdução

Em 2006, eu fiz um jogo de Damas em AdvPL, para jogar contra o Computador. Não cheguei a reforçar muito o algoritmo de decisão, mas ficou bom o suficiente pra dar um pouco de trabalho. O fonte ainda está cm alguns remendos, ainda não está pronto para um post de fins didáticos, MAS, atendendo a pedidos no FaceBook, estou disponibilizando um Patch da P11 (RPO TOP / Português) do Jogo, para degustação 😀

O Jogo

Após aplicar o patch, basta iniciar o SmartClient com a função “U_APGAMES”, e será mostrada a interface abaixo, para você entrar com o NickName do Jogador.

Checkers003

Após inserir o NickName e clicar em “Iniciar”, inicia-se o jogo de Damas. Você joga com as pedras amarelas, e o computador com as azuis. Você inicia a partida. Para jogar, primeiro você clica em cima de uma pedra sua, depois clica no lugar onde a sua pedra deve ser movimentada, vide sequência abaixo:

Checkers006a

Checkers006b

Checkers006c

Assim que você jogar, o computador jogará uma pedra dele. E já é a sua vez de novo.

Regras

  • As pedras normais somente movimentam-se para a frente.Em nenhuma hipótese uma pedra normal movimenta-se para trás.
  • Não existe “assopro”. Se você oferecer uma ou mais pedras ao computador, ele é obrigado a comer a sua pedra, e vice-versa.
  • Se mais de uma pedra for oferecida, o adversário escolhe como e qual pedra ele vai atacar.
  • Ao chegar do outro lado do tabuleiro com uma pedra normal, ela vira uma “Dama”.
  • A Dama pode mover-se para a frente e para trás, mas apenas UMA CASA por vez.
  • O mecanismo de navegação do Computador é “reativo”, então para você ganhar o jogo, você tem que encurralar o computador e fazer ele entregar as suas peças.
  • É mais fácil vencê-lo em jogo aberto, havendo troca de peças, e você abrindo caminho primeiro para fazer uma Dama. Mas cuidado com as “arapucas”, ele pode oferecer “inocentemente” uma pedra, e limpar duas ou três suas. 😉

Patch

O Patch do jogo está disponível para download no link “https://github.com/siga0984/Blog/blob/master/tttp110_APGames.zip” . Basta abrir a página, e clicar em “View RAW”, no final da página, para o Browse fazer o Dowload do ZIP contendo o Patch.

Conclusão

Existem diversas melhorias previstas no design do jogo, e inclusive a separação completa do core do jogo e da interface, além da utilização de orientação a objetos. Uma vez passado a limpo, o jogo será disponibilizado na íntegra, co os fontes 😀

Espero que vocês gostem do desafio, joguem um pouco contra o algoritmo, postem seus resultados no FaceBook 😉 E se você gostou, faça como eu: Compartilhe 😀

Desejo a todos TERABYTES de SUCESSO 😀 Abraços 😉 

 

Tetris Orientado a Objetos em AdvPL

Introdução

Nada mais providencial do que ter em mãos um fonte relativamente complexo, escrito utilizando funções e variáveis estáticas e construído totalmente amarrado à camada de interface, para usar de exemplo para aplicar a orientação a objetos.

Tetris em AdvPL

No post sobre o clone do jogo Tetris escrito em AdvPL, ao analisarmos o código-fonte, percebemos que ele se encaixa perfeitamente na introdução deste tópico.

Embora o núcleo do jogo trabalhe com um array de strings contento a representação da tela do jogo, onde cada caractere dentro do array representa um espaço em branco ou um espaço ocupado pela parte de uma peça de uma determinada cor, as funções do jogo que lidam com os eventos de atualização de interface estão amarrados às características e objetos de interface, tanto os resources para a pintura da tela, quando o objeto tTimer, usado para movimentar a peça em jogo uma linha para baixo em intervalos de um segundo.

Utilizando a orientação a objetos, e segmentando um pouco o código, é possível separar boa parte das variáveis e funçoes estáticas em propriedades e métodos de uma classe ApTetris, que será responsável pelo processamento do “core” (ou núcleo) do jogo. E, indo um pouco mais além, podemos desamarrar a interface do jogo, fornecendo algumas propriedades para a classe, para esta ser capaz de chamar as funções apropriadas para compor a interface do jogo quando e como necessário.

Segmentação e refatoração

A primeira parte da refatoração do código foi criar a classe APTetris, transformando todas as variáveis STATIC em propriedades da classe, e praticamente todas as funções STATIC em métodos. Neste primeiro momento, em 10 minutos o jogo já estava operacional novamente, porém as propriedades da classe armazenavam e lidavam diretamente com a pintura da interface.

Num segundo momento, este um pouco mais demorado, os métodos que lidavam estritamente com as tarefas de pintar o grid, score, timer e mensagens do jogo, bem como as mudanças de estado (running, pause, game over), passaram a chamar CodeBlocks para estas tarefas. Cada code-block é chamado em um momento distinto, para atender a um tipo de evento disparado pelo Core do Jogo. Todos os CodeBlocks foram implementados como propriedades da classe principal, e devem ser alimentados após a construção da instância. E, os métodos ligados diretamente a interface voltaram a ser STATIC FUNCTIONS do código, que recebem como parâmetro informações do core do jogo e da interface em uso, para interagir com ela.

Vamos ao código

Após estas duas etapas completas com sucesso, algumas correções na lógica do jogo inicial foram realizadas, commo por exemplo a funçao de “Pause” agora apaga a tela do jogo, para o jogador não se aproveitar da pausa para ficar estudando onde melhor encaixar a peça, entre outros ajustes menores. A última etapa foi isolar as constantes usadas para alguns elementos de arrays e status do core do jogo para um arquivo de #include separado, e a classe do jogo, totalmente desamarrada de interface ser isolada em um código-fonte separado.

O projeto final está no GitHub https://github.com/siga0984/Tetris-OO, que contém os resources (imagens) das pedras, e os fontes “Tetris-OO.PRW” (fonte da interface do jogo para SmartClient), e o fonte “Tetris-Core.prw”, que agora contém apenas o núcleo do jogo, sem a interface. Da mesma forma que o jogo anterior, basta criar um projeto AdvPL no IDE ou TDS, acrescentar os fontes e imagens, compilar e executar. a função U_TetrisOO diretamente a partir do SmartClient.

Segue abaixo o fonte client, responsável pela interface e utilização da classe ApTetris.

#include 'protheus.ch'
#include 'tetris-core.ch'
/* ========================================================
Função U_TETRISOO
Autor Júlio Wittwer
Data 21/03/2015
Versão 1.150321
Descriçao Réplica do jogo Tetris, feito em AdvPL
Remake reescrito a partir do Tetris.PRW, utiliando Orientação a Objetos
Para jogar, utilize as letras :
A ou J = Move esquerda
D ou L = Move Direita
S ou K = Para baixo
W ou I = Rotaciona sentido horario
Barra de Espaço = Dropa a peça
======================================================== */
 
// =======================================================
USER Function TetrisOO()
Local oDlg, oBGGame , oBGNext
Local oFont , oLabel 
Local oScore , oTimer
Local nC , nL
Local oTetris 
Local aBMPGrid 
Local aBMPNext 
Local aResources
// Arrays de componentes e recursos de Interface
aBMPGrid := array(20,10) // Array de bitmaps de interface do jogo 
aBMPNext := array(4,5) // Array de bitmaps da proxima peça
aResources := { "BLACK","YELOW2","LIGHTBLUE2","ORANGE2","RED2","GREEN2","BLUE2","PURPLE2" }
// Fonte default usada na caixa de diálogo 
// e respectivos componentes filhos
oFont := TFont():New('Courier new',,-16,.T.,.T.)
// Interface principal do jogo
DEFINE DIALOG oDlg TITLE "Object Oriented Tetris AdvPL" FROM 10,10 TO 450,365 ;
 FONT oFont COLOR CLR_WHITE,CLR_BLACK PIXEL
// Cria um fundo cinza, "esticando" um bitmap
@ 8, 8 BITMAP oBGGame RESOURCE "GRAY" ;
 SIZE 104,204 Of oDlg ADJUST NOBORDER PIXEL
// Desenha na tela um grid de 20x10 com Bitmaps
// para desenhar o Game
For nL := 1 to 20
 For nC := 1 to 10
 
 @ nL*10, nC*10 BITMAP oBmp RESOURCE "BLACK" ;
 SIZE 10,10 Of oDlg ADJUST NOBORDER PIXEL
 
 aBMPGrid[nL][nC] := oBmp
 
 Next
Next
 
// Monta um Grid 4x4 para mostrar a proxima peça
// ( Grid deslocado 110 pixels para a direita )
@ 8, 118 BITMAP oBGNext RESOURCE "GRAY" ;
 SIZE 54,44 Of oDlg ADJUST NOBORDER PIXEL
For nL := 1 to 4
 For nC := 1 to 5
 
 @ nL*10, (nC*10)+110 BITMAP oBmp RESOURCE "BLACK" ;
 SIZE 10,10 Of oDlg ADJUST NOBORDER PIXEL
 
 aBMPNext[nL][nC] := oBmp
 
 Next
Next
// Label fixo, Pontuação do Jogo 
@ 80,120 SAY oLabel1 PROMPT "[Score]" SIZE 60,20 OF oDlg PIXEL
 
// Label para Mostrar score
@ 90,120 SAY oScore PROMPT " " SIZE 60,120 OF oDlg PIXEL
// Label fixo, Tempo de Jogo
@ 110,120 SAY oLabel2 PROMPT "[Time]" SIZE 60,20 OF oDlg PIXEL
 
// Label para Mostrar Tempo de Jogo
@ 120,120 SAY oElapTime PROMPT " " SIZE 60,120 OF oDlg PIXEL
// Label para Mostrar Status do Jogo 
@ 140,120 SAY oGameMsg PROMPT " " SIZE 60,120 OF oDlg PIXEL
// Botões com atalho de teclado
// para as teclas usadas no jogo
// colocados fora da area visivel da caixa de dialogo
@ 480,10 BUTTON oDummyB0 PROMPT '&A' ACTION ( oTetris:DoAction('A') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB1 PROMPT '&S' ACTION ( oTetris:DoAction('S') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB2 PROMPT '&D' ACTION ( oTetris:DoAction('D') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB3 PROMPT '&W' ACTION ( oTetris:DoAction('W') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB4 PROMPT '&J' ACTION ( oTetris:DoAction('J') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB5 PROMPT '&K' ACTION ( oTetris:DoAction('K') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB6 PROMPT '&L' ACTION ( oTetris:DoAction('L') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB7 PROMPT '&I' ACTION ( oTetris:DoAction('I') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB8 PROMPT '& ' ACTION ( oTetris:DoAction(' ') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB9 PROMPT '&P' ACTION ( oTetris:DoPause() ) SIZE 1, 1 OF oDlg PIXEL
// Inicializa o objeto do core do jogo 
oTetris := APTetris():New()
// Define um timer, para fazer a peça em jogo
// descer uma posição a cada um segundo
// ( Nao pode ser menor, o menor tempo é 1 segundo )
// A ação '#' é diferente de "S" ou "K", pois nao atualiza 
// o score quando a peça está descento "sozinha" por tempo 
oTimer := TTimer():New(1000, {|| oTetris:DoAction('#') }, oDlg )
// Registra evento para atualização de score
// Apos uma ação ser processada pelo objeto Tetris, caso o score 
// tenha mudado, este codeclobk será disparado com o novo score 
oTetris:bShowScore := {|cMsg| oScore:SetText(cMsg) }
// Registra evento para atualização do tempo decorrido de jogo 
// Apos uma ação ser processada pelo objeto Tetris, caso o tempo 
// de jogo tenha mudado, este codeclobk será disparado com o tempo 
// decorrido de jogo atualizado. 
oTetris:bShowElap := {|cMsg| oElapTime:SetText(cMsg) }
// Registra evento de mudança de estado do jogo 
// Running , Pause, Game Over. Caso seja disparado um
// pause ou continue, ou mesmo a última peça nao caber 
// na TEla ( Game Over ), este bloco é disparado, informando o novo 
// estado de jogo 
oTetris:bChangeState := {|nStat| GameState( nStat , oTimer , oGameMsg ) }
// Registra evento de pintura do grid 
// Apos processamento de ação, caso o grid precise ser repintado, 
// este bloco de código será disparado
oTetris:bPaintGrid := {|aGameGrid| PaintGame( aGameGrid, aBmpGrid , aResources ) }
// Registra evento de pintura da proxima peça 
// Apos processamento de ação, caso seja sorteada uma nova próxima peça, 
// este bloco de código será disparado para pintar a proxima peça na interface
oTetris:bPaintNext := {|aNextPiece| PaintNext(aNextPiece, aBMPNext, aResources) }
// Na inicialização do Dialogo, começa o jogo 
oDlg:bInit := {|| oTetris:Start() }
ACTIVATE DIALOG oDlg CENTER
Return
/* -------------------------------------------------------
Notificação de mudança de estado de jogo
GAME_RUNNING, GAME_PAUSED ou GAME_OVER
------------------------------------------------------- */
STATIC Function GameState( nStat , oTimer , oGameMsg ) 
Local cMsg
If nStat == GAME_RUNNING
// Jogo em execuçao, ativa timer de interface
 oTimer:Activate()
cMsg := "*********"+CRLF+;
 "* PLAY *"+CRLF+;
 "*********"
ElseIf nStat == GAME_PAUSED
// Jogo em pausa
 // desativa timer de interface 
 oTimer:DeActivate()
 
 // e acrescenta mensagem de pausa
 cMsg := "*********"+CRLF+;
 "* PAUSE *"+CRLF+;
 "*********"
ElseIf nStat == GAME_OVER
// Game Over
 // desativa timer de interface 
 oTimer:DeActivate()
// e acresenta a mensagem de "GAME OVER"
 cMsg := "********"+CRLF+;
 "* GAME *"+CRLF+; 
 "********"+CRLF+;
 "* OVER *"+CRLF+;
 "********"
Endif
// Atualiza a mensagem na interface
oGameMsg:SetText(cMsg)
Return
/* ----------------------------------------------------------
Função PaintGame()
Pinta o Grid do jogo da memória para a Interface
Chamada pelo objeto Tetris via code-block
Optimizada para apenas trocar os resources diferentes
---------------------------------------------------------- */
STATIC Function PaintGame( aGameGrid, aBmpGrid , aResources ) 
Local nL, nc , cLine, nPeca
For nL := 1 to 20
 cLine := aGameGrid[nL+1]
 For nC := 1 to 10
 nPeca := val(substr(cLine,nC+2,1))
 If aBmpGrid[nL][nC]:cResName != aResources[nPeca+1]
 // Somente manda atualizar o bitmap se houve
 // mudança na cor / resource desta posição
 aBmpGrid[nL][nC]:SetBmp(aResources[nPeca+1])
 endif
 Next
Next
Return
/* -----------------------------------------------------------------
Pinta na interface a próxima peça a ser usada no jogo 
Chamada pelo objeto Tetris via code-block
Optimizada para apenas trocar os resources diferentes
----------------------------------------------------------------- */
STATIC Function PaintNext(aNext,aBMPNext,aResources) 
Local nL, nC, cLine , nPeca
For nL := 1 to 4
 cLine := aNext[nL]
 For nC := 1 to 5
 nPeca := val(substr(cLine,nC,1))
 If aBMPNext[nL][nC]:cResName != aResources[nPeca+1]
 aBMPNext[nL][nC]:SetBmp(aResources[nPeca+1])
 endif
 Next
Next

Return

E, agora segue abaixo o fonte Tetris-Core.PRW, que contém a classe core do clone do Tetris.

#include 'protheus.ch' 
#include 'tetris-core.ch'
// ============================================================================
// Classe "CORE" do Jogo Tetris
// ============================================================================
CLASS APTETRIS
 
 // Propriedades publicas
 
 DATA aGamePieces // Peças que compoe o jogo 
 DATA nGameStart // Momento de inicio de jogo 
 DATA nGameTimer // Tempo de jogo em segundos
 DATA nGamePause // Controle de tempo de pausa
 DATA nNextPiece // Proxima peça a ser usada
 DATA nGameStatus // 0 = Running 1 = PAuse 2 == Game Over
 DATA aNextPiece // Array com a definição e posição da proxima peça
 DATA aGameCurr // Array com a definição e posição da peça em jogo
 DATA nGameScore // pontuação da partida
 DATA aGameGrid // Array de strings com os blocos da interface representados em memoria
// Eventos disparados pelo core do Jogo 
 
 DATA bShowScore // CodeBlock para interface de score 
 DATA bShowElap // CodeBlock para interface de tempo de jogo 
 DATA bChangeState // CodeBlock para indicar mudança de estado ( pausa / continua /game over )
 DATA bPaintGrid // CodeBlock para evento de pintura do Grid do Jogo
 DATA bPaintNext // CodeBlock para evento de pintura da Proxima peça em jogo
 
 // Metodos Publicos
 
 METHOD New() // Construtor
 METHOD Start() // Inicio de Jogo
 METHOD DoAction(cAct) // Disparo de ações da Interface
 METHOD DoPause() // Dispara Pause On/Off
// Metodos privados ( por convenção, prefixados com "_" )
METHOD _LoadPieces() // Carga do array de peças do Jogo 
 METHOD _MoveDown() // Movimenta a peça corrente uma posição para baixo
 METHOD _DropDown() // Movimenta a peça corrente direto até onde for possível
 METHOD _SetPiece(aPiece,aGrid) // Seta uma peça no Grid em memoria do jogo 
 METHOD _DelPiece(aPiece,aGrid) // Remove uma peça no Grid em memoria do jogo 
 METHOD _FreeLines() // Verifica e eliminha linhas totalmente preenchidas 
 METHOD _GetEmptyGrid() // Retorna um Grid em memoria inicializado vazio
ENDCLASS
/* ----------------------------------------------------------
Construtor da classe
---------------------------------------------------------- */
METHOD NEW() CLASS APTETRIS
::aGamePieces := ::_LoadPieces()
::nGameTimer := 0
::nGameStart := 0
::aNextPiece := {}
::aGameCurr := {}
::nGameScore := 0
::aGameGrid := {}
::nGameStatus := GAME_RUNNING
Return self
/* ----------------------------------------------------------
Inicializa o Grid na memoria
Em memoria, o Grid possui 14 colunas e 22 linhas
Na tela, são mostradas apenas 20 linhas e 10 colunas
As 2 colunas da esquerda e direita, e as duas linhas a mais
sao usadas apenas na memoria, para auxiliar no processo
de validação de movimentação das peças.
---------------------------------------------------------- */
METHOD Start() CLASS APTETRIS
Local aDraw, nPiece, cScore
// Inicializa o grid de imagens do jogo na memória
// Sorteia a peça em jogo
// Define a peça em queda e a sua posição inicial
// [ Peca, rotacao, linha, coluna ]
// e Desenha a peça em jogo no Grid
// e Atualiza a interface com o Grid
// Inicializa o grid do jogo "vazio"
::aGameGrid := aClone(::_GetEmptyGrid())
// Sorteia peça em queda do inicio do jogo
nPiece := randomize(1,len(::aGamePieces)+1)
// E coloca ela no topo da tela
::aGameCurr := {nPiece,1,1,6}
::_SetPiece(::aGameCurr,::aGameGrid)
// Dispara a pintura do Grid do Jogo
Eval( ::bPaintGrid , ::aGameGrid)
// Sorteia a proxima peça e desenha
// ela no grid reservado para ela
::aNextPiece := array(4,"00000")
::nNextPiece := randomize(1,len(::aGamePieces)+1)
aDraw := {::nNextPiece,1,1,1}
::_SetPiece(aDraw,::aNextPiece)
// Dispara a pintura da próxima peça
Eval( ::bPaintNext , ::aNextPiece )
// Marca timer do inicio de jogo
::nGameStart := seconds()
// Chama o codeblock de mudança de estado - Jogo em execução
Eval(::bChangeState , ::nGameStatus )
// E chama a pintura do score inicial 
cScore := str(::nGameScore,7)
Eval( ::bShowScore , cScore )
Return
/* ----------------------------------------------------------
Recebe uma ação de movimento de peça, e realiza o movimento
da peça corrente caso exista espaço para tal.
---------------------------------------------------------- */
METHOD DoAction(cAct) CLASS APTETRIS
Local aOldPiece
Local cScore, cElapTime 
Local cOldScore, cOldElapTime
If ::nGameStatus != GAME_RUNNING
 // Jogo não está rodando, nao aceita ação nenhuma
 Return .F. 
Endif
// Pega pontuação e tempo decorridos agora 
cOldScore := str(::nGameScore,7)
cOldElapTime := STOHMS(::nGameTimer)
// Clona a peça em queda
aOldPiece := aClone(::aGameCurr)
if cAct $ 'AJ'
 
 // Movimento para a Esquerda (uma coluna a menos)
 // Remove a peça do grid
 ::_DelPiece(::aGameCurr,::aGameGrid)
 ::aGameCurr[PIECE_COL]--
 If !::_SetPiece(::aGameCurr,::aGameGrid)
 // Se nao foi feliz, pinta a peça de volta
 ::aGameCurr := aClone(aOldPiece)
 ::_SetPiece(::aGameCurr,::aGameGrid)
 Endif
 
Elseif cAct $ 'DL'
 
 // Movimento para a Direita ( uma coluna a mais )
 // Remove a peça do grid
 ::_DelPiece(::aGameCurr,::aGameGrid)
 ::aGameCurr[PIECE_COL]++
 If !::_SetPiece(::aGameCurr,::aGameGrid)
 // Se nao foi feliz, pinta a peça de volta
 ::aGameCurr := aClone(aOldPiece)
 ::_SetPiece(::aGameCurr,::aGameGrid)
 Endif
 
Elseif cAct $ 'WI'
 
 // Movimento para cima ( Rotaciona sentido horario )
 
 // Remove a peça do Grid
 ::_DelPiece(::aGameCurr,::aGameGrid)
 
 // Rotaciona a peça 
 ::aGameCurr[PIECE_ROTATION]--
 If ::aGameCurr[PIECE_ROTATION] < 1
 ::aGameCurr[PIECE_ROTATION] := len(::aGamePieces[::aGameCurr[PIECE_NUMBER]])-1
 Endif
 
 If !::_SetPiece(::aGameCurr,::aGameGrid)
 // Se nao consegue colocar a peça no Grid
 // Nao é possivel rotacionar. Pinta a peça de volta
 ::aGameCurr := aClone(aOldPiece)
 ::_SetPiece(::aGameCurr,::aGameGrid)
 Endif
 
ElseIF cAct $ 'SK#'
 
 // Desce a peça para baixo uma linha intencionalmente
 ::_MoveDown()
 
 If cAct $ 'SK'
 // se o movimento foi intencional, ganha + 1 ponto
 ::nGameScore++
 Endif
 
ElseIF cAct == ' '
 
 // Dropa a peça - empurra para baixo até a última linha
 // antes de bater a peça no fundo do Grid. Isto vai permitir
 // movimentos laterais e roração, caso exista espaço
If !::_DropDown()
 // Se nao tiver espaço para o DropDown, faz apenas o MoveDown 
 // e "assenta" a peça corrente
 ::_MoveDown()
 Endif
 
Else
UserException("APTETRIS:DOACTION() ERROR: Unknow Action ["+cAct+"]")
 
Endif
// Dispara a repintura do Grid
Eval( ::bPaintGrid , ::aGameGrid)
// Calcula tempo decorrido
::nGameTimer := seconds() - ::nGameStart
 
If ::nGameTimer < 0
 // Ficou negativo, passou da meia noite
 ::nGameTimer += 86400
Endif
// Pega Score atualizado e novo tempo decorrido
cScore := str(::nGameScore,7)
cElapTime := STOHMS(::nGameTimer)
If ( cOldScore <> cScore ) 
 // Dispara o codeblock que atualiza o score
 Eval( ::bShowScore , cScore )
Endif
If ( cOldElapTime <> cElapTime ) 
 // Dispara atualizaçao de tempo decorrido
 Eval( ::bShowElap , cElapTime )
Endif
Return .T.
/* ----------------------------------------------------------
Coloca e retira o jog em pausa
Este metodo foi criado isolado, pois é o unico 
que poderia ser chamado dentro de uma pausa
---------------------------------------------------------- */
METHOD DoPause() CLASS APTETRIS
Local lChanged := .F.
Local nPaused
Local cElapTime 
Local cOldElapTime
cOldElapTime := STOHMS(::nGameTimer)
If ::nGameStatus == GAME_RUNNING
 // Jogo em execução = Pausa : Desativa o timer
 lChanged := .T.
 ::nGameStatus := GAME_PAUSED
 ::nGamePause := seconds()
ElseIf ::nGameStatus == GAME_PAUSED
 // Jogo em pausa = Sai da pausa : Ativa o timer
 lChanged := .T.
 ::nGameStatus := GAME_RUNNING
 // Calcula quanto tempo o jogo ficou em pausa
 // e acrescenta esse tempo do start do jogo
 nPaused := seconds()-::nGamePause
 If nPaused < 0
 nPaused += 86400
 Endif
 ::nGameStart += nPaused
Endif
If lChanged
 
 // Chama o codeblock de mudança de estado - Entrou ou saiu de pausa
 Eval(::bChangeState , ::nGameStatus )
 
 If ::nGameStatus == GAME_PAUSED
 // Em pausa, Dispara a pintura do Grid do Jogo vazio
 Eval( ::bPaintGrid , ::_GetEmptyGrid() )
 Else
 // Game voltou da pausa, pinta novamente o Grid
 Eval( ::bPaintGrid , ::aGameGrid)
 Endif
 
 // Calcula tempo de jogo sempre ao entrar ou sair de pausa
 ::nGameTimer := seconds() - ::nGameStart
 
 If ::nGameTimer < 0
 // Ficou negativo, passou da meia noite
 ::nGameTimer += 86400
 Endif
// Pega novo tempo decorrido
 cElapTime := STOHMS(::nGameTimer)
If ( cOldElapTime <> cElapTime ) 
 // Dispara atualizaçao de tempo decorrido
 Eval( ::bShowElap , cElapTime )
 Endif
Endif
Return
/* ----------------------------------------------------------
Metodo SetGridPiece
Aplica a peça informada no array do Grid.
Retorna .T. se foi possivel aplicar a peça na posicao atual
Caso a peça não possa ser aplicada devido a haver
sobreposição, a função retorna .F. e o grid não é atualizado
Serve tanto para o Grid do Jogo quando para o Grid da próxima peça
---------------------------------------------------------- */
METHOD _SetPiece(aPiece,aGrid) CLASS APTETRIS
Local nPiece := aPiece[PIECE_NUMBER] // Numero da peça
Local nRotate := aPiece[PIECE_ROTATION] // Rotação
Local nRow := aPiece[PIECE_ROW] // Linha no Grid
Local nCol := aPiece[PIECE_COL] // Coluna no Grid
Local nL , nC
Local aTecos := {}
Local cTecoGrid, cPeca , cPieceId
conout("_SetPiece on COL "+cValToChar(nCol))
cPieceId := str(nPiece,1)
For nL := nRow to nRow+3
 cPeca := ::aGamePieces[nPiece][1+nRotate][nL-nRow+1]
 If nL > len(aGrid) 
 // Se o grid acabou, verifica se o teco 
 // da peça tinha alguma coisa a ser ligada
 // Se tinha, nao cabe, se não tinha, beleza
 If '1' $ cPeca 
 Return .F.
 Else
 EXIT
 Endif
 Endif
 cTecoGrid := substr(aGrid[nL],nCol,4)
 For nC := 1 to 4
 If Substr(cPeca,nC,1) == '1'
 If SubStr(cTecoGrid,nC,1) != '0'
 // Vai haver sobreposição,
 // a peça nao cabe ...
 Return .F.
 Endif
 cTecoGrid := Stuff(cTecoGrid,nC,1,cPieceId)
 Endif
 Next
 // Array temporario com a peça já colocada
 aadd(aTecos,cTecoGrid)
Next
// Aplica o array temporario no array do grid
For nL := nRow to nRow+len(aTecos)-1
 aGrid[nL] := stuff(aGrid[nL],nCol,4,aTecos[nL-nRow+1])
Next
// A peça "coube", retorna .T.
Return .T.
/* -----------------------------------------------------------------
Carga do array de peças do jogo
Array multi-dimensional, contendo para cada
linha a string que identifica a peça, e um ou mais
arrays de 4 strings, onde cada 4 elementos
representam uma matriz binaria de caracteres 4x4
para desenhar cada peça
Exemplo - Peça "O"
aLPieces[1][1] C "O"
aLPieces[1][2][1] "0000"
aLPieces[1][2][2] "0110"
aLPieces[1][2][3] "0110"
aLPieces[1][2][4] "0000"
----------------------------------------------------------------- */
METHOD _LoadPieces() CLASS APTETRIS
Local aLPieces := {}
// Peça "O" , uma posição
aadd(aLPieces,{'O', { '0000','0110','0110','0000'}})
// Peça "I" , em pé e deitada
aadd(aLPieces,{'I', { '0000','1111','0000','0000'},;
 { '0010','0010','0010','0010'}})
// Peça "S", em pé e deitada
aadd(aLPieces,{'S', { '0000','0011','0110','0000'},;
 { '0010','0011','0001','0000'}})
// Peça "Z", em pé e deitada
aadd(aLPieces,{'Z', { '0000','0110','0011','0000'},;
 { '0001','0011','0010','0000'}})
// Peça "L" , nas 4 posições possiveis
aadd(aLPieces,{'L', { '0000','0111','0100','0000'},;
 { '0010','0010','0011','0000'},;
 { '0001','0111','0000','0000'},;
 { '0110','0010','0010','0000'}})
// Peça "J" , nas 4 posições possiveis
aadd(aLPieces,{'J', { '0000','0111','0001','0000'},;
 { '0011','0010','0010','0000'},;
 { '0100','0111','0000','0000'},;
 { '0010','0010','0110','0000'}})
// Peça "T" , nas 4 posições possiveis
aadd(aLPieces,{'T', { '0000','0111','0010','0000'},;
 { '0010','0011','0010','0000'},;
 { '0010','0111','0000','0000'},;
 { '0010','0110','0010','0000'}})
Return aLPieces
/* ----------------------------------------------------------
Função _MoveDown()
Movimenta a peça em jogo uma posição para baixo.
Caso a peça tenha batido em algum obstáculo no movimento
para baixo, a mesma é fica e incorporada ao grid, e uma nova
peça é colocada em jogo. Caso não seja possivel colocar uma
nova peça, a pilha de peças bateu na tampa -- Game Over
---------------------------------------------------------- */
METHOD _MoveDown() CLASS APTETRIS
Local aOldPiece
Local nMoved := 0
If ::nGameStatus != GAME_RUNNING
 Return
Endif
// Clona a peça em queda na posição atual
aOldPiece := aClone(::aGameCurr)
// Primeiro remove a peça do Grid atual
::_DelPiece(::aGameCurr,::aGameGrid)
// Agora move a peça apenas uma linha pra baixo
::aGameCurr[PIECE_ROW]++
// Recoloca a peça no Grid
If ::_SetPiece(::aGameCurr,::aGameGrid)
 
 // Nao bateu em nada, beleza. 
 // Retorna aqui mesmo 
 Return
 
Endif
// Opa ... Esbarrou em alguma peça ou fundo do grid
// Volta a peça pro lugar anterior e recoloca a peça no Grid
::aGameCurr := aClone(aOldPiece)
::_SetPiece(::aGameCurr,::aGameGrid)
// Encaixou uma peça .. Incrementa o score em 4 pontos
// Nao importa a peça ou como ela foi encaixada
::nGameScore += 4
// Verifica apos a pea encaixada, se uma ou mais linhas
// foram preenchidas e podem ser eliminadas
::_FreeLines()
// Pega a proxima peça e coloca em jogo
nPiece := ::nNextPiece
::aGameCurr := {nPiece,1,1,6} // Peca, direcao, linha, coluna
If !::_SetPiece(::aGameCurr,::aGameGrid)
 
 // Acabou, a peça nova nao entra (cabe) no Grid
 // "** GAME OVER** "
 ::nGameStatus := GAME_OVER
 
 // Chama o codeblock de mudança de estado - Game Over
 Eval(::bChangeState , ::nGameStatus )
 
 // E retorna aqui mesmo
 Return
 
Endif
// Inicializa proxima peça em branco
::aNextPiece := array(4,"00000")
// Sorteia a proxima peça que vai cair
::nNextPiece := randomize(1,len(::aGamePieces)+1)
::_SetPiece( {::nNextPiece,1,1,1} , ::aNextPiece)
// Dispara a pintura da próxima peça
Eval( ::bPaintNext , ::aNextPiece )
// e retorna para o processamento de ações
Return
METHOD _DropDown() CLASS APTETRIS
Local aOldPiece
Local nMoved := 0
If ::nGameStatus != GAME_RUNNING
 Return .F.
Endif
// Clona a peça em queda na posição atual
aOldPiece := aClone(::aGameCurr)
// Dropa a peça até bater embaixo
// O Drop incrementa o score em 1 ponto
// para cada linha percorrida. Quando maior a quantidade
// de linhas vazias, maior o score acumulado com o Drop
// Remove a peça do Grid atual
::_DelPiece(::aGameCurr,::aGameGrid)
// Desce uma linha pra baixo
::aGameCurr[PIECE_ROW]++
While ::_SetPiece(::aGameCurr,::aGameGrid)
 
 // Peça desceu mais uma linha
 // Incrementa o numero de movimentos dentro do Drop
 nMoved++
// Incrementa o Score
 ::nGameScore++
// Remove a peça da interface
 ::_DelPiece(::aGameCurr,::aGameGrid)
 
 // Guarda a peça na posição atual
 aOldPiece := aClone(::aGameCurr)
 
 // Desce a peça mais uma linha pra baixo
 ::aGameCurr[PIECE_ROW]++
 
Enddo
// Volta a peça na última posição válida, 
::aGameCurr := aClone(aOldPiece)
::_SetPiece(::aGameCurr,::aGameGrid)
 
// Se conseguiu mover a peça com o Drop
// pelo menos uma linha, retorna .t. 
Return (nMoved > 0)
/* -----------------------------------------------------------------------
Remove a peça informada do grid informado
----------------------------------------------------------------------- */
METHOD _DelPiece(aPiece,aGrid) CLASS APTETRIS
Local nPiece := aPiece[PIECE_NUMBER]
Local nRotate := aPiece[PIECE_ROTATION]
Local nRow := aPiece[PIECE_ROW]
Local nCol := aPiece[PIECE_COL]
Local nL, nC
Local cTecoGrid, cTecoPeca
// Como a matriz da peça é 4x4, trabalha em linhas e colunas
// Separa do grid atual apenas a área que a peça está ocupando
// e desliga os pontos preenchidos da peça no Grid.
// Esta função não verifica se a peça que está sendo removida
// é a correta, apenas apaga do grid os pontos ligados que
// a peça informada ocupa nas coordenadas especificadas
For nL := nRow to nRow+3
 cTecoPeca := ::aGamePieces[nPiece][1+nRotate][nL-nRow+1]
 If nL > len(aGrid)
 // O Grid acabou, retorna
 Return
 Endif
 cTecoGrid := substr(aGrid[nL],nCol,4)
 For nC := 1 to 4
 If Substr(cTecoPeca,nC,1)=='1'
 cTecoGrid := Stuff(cTecoGrid,nC,1,'0')
 Endif
 Next
 aGrid[nL] := stuff(aGrid[nL],nCol,4,cTecoGrid)
Next
Return
/* -----------------------------------------------------------------------
Verifica e elimina as linhas "completas"
após uma peça ser encaixada no Grid
----------------------------------------------------------------------- */
METHOD _FreeLines() CLASS APTETRIS
Local nErased := 0
Local cTecoGrid
For nL := 21 to 2 step -1
 
 // Sempre varre de baixo para cima
 cTecoGrid := substr(::aGameGrid[nL],3)
 
 If !('0'$cTecoGrid)
 // Se a linha nao tem nenhum espaço em branco
 // Elimina esta linha e acrescenta uma nova linha
 // em branco no topo do Grid
 adel(::aGameGrid,nL)
 ains(::aGameGrid,1)
 ::aGameGrid[1] := GRID_EMPTY_LINE
 nL++
 nErased++
 Endif
 
Next
// Pontuação por linhas eliminadas
// Quanto mais linhas ao mesmo tempo, mais pontos
If nErased == 4
 ::nGameScore += 100
ElseIf nErased == 3
 ::nGameScore += 50
ElseIf nErased == 2
 ::nGameScore += 25
ElseIf nErased == 1
 ::nGameScore += 10
Endif
Return
/* ------------------------------------------------------
Retorna um grid de jogo vazio / inicializado
O Grid no core do tetris contem 21 linhas por 14 colunas
As limitações nas laterais esquerda e direita para 
facilitar os algoritmos para fazer a manutenção no Grid 
A área visivel nas colunas do Grid está indicada usando 
"." Logo, mesmo que o grid em memoria 
tenha 21x14, o grid de bitmaps de interface tem apenas 20x10, 
a partir da coordenada 2,3 ( linha,coluna ) do Grid do Jogo
"11000000000011" -- Primeira linha, não visivel 
"11..........11" -- demais 20 linhas, visiveis da coluna 2 a 11
------------------------------------------------------ */
METHOD _GetEmptyGrid() CLASS APTETRIS
Local aEmptyGrid 
aEmptyGrid := array(21,GRID_EMPTY_LINE)
Return aEmptyGrid
/* ------------------------------------------------------
Função auxiliar de conversão de segundos para HH:MM:SS
------------------------------------------------------ */
STATIC Function STOHMS(nSecs)
Local nHor
Local nMin
nHor := int(nSecs/3600)
nSecs -= (3600*nHor)
nMin := int(nSecs/60)
nSecs -= (60*nMin)
Return strzero(nHor,2)+':'+Strzero(nMin,2)+':'+strzero(nSecs,2)

Conclusão

A implementação realizada poderia ser mais refinada ou flexível, mas atende a esta necessidade. Uma outra alternativa interessante, ao invés de criar vários CodeBlocks, um para cada evento, seria criar apenas um CodeBlock e passar ele em uma propriedade da classe, e através dele fazer todas as chamadas de interface, passando como parâmetros a instância do jogo (self), um código para indicar qual evento está sendo disparado, e um ou mais parâmetros especificos do evento. Neste caso, o fonte de interface teria que construir uma função única de “CallBack”, onde dentro dela cada evento seria tratado em um DO CASE…END CASE, por exemplo.

Agora, dêem uma olhada no código antigo, todo “amarrado”, e no código novo. Pra mim é visivelmente mais fácil dar manutenção no código orientado a objetos do que no código procedural, pois cada coisa está visivelmente em seu lugar, e cada parte do código têm a sua responsabilidade e atribuições bem definidas. Espero que vocês tirem proveito da orientação a objeto, com tanta satisfação como a que eu tenho em escrever estes códigos !!

Até o próximo post, pessoal 😉 E obrigado pela audiência 😀

Jogos em AdvPL – Tetris

Introdução

Como eu havia dito, no primeiro post deste blog, em AdvPL muita coisa pode ser feita, até um ERP. E, para dar ênfase em outras características do AdvPL, resolvi fazer algumas revisões e publicar um programinha interessante … um clone do famoso jogo Tetris. Sim, aquele que os blocos caem e você precisa alinhá-los para eliminar linhas da tela 😉

Tetris - Versão Final

O Algoritmo

Não foi tão difícil fazer o jogo funcionar, foi mais trabalhoso o refactoring para publicação e as explicações de como ele funciona por dentro do que bolar a lógica e interface do game. Ao ser executado, o programa já abre direto uma caixa de interface com uma peça sorteada em queda progressiva em intervalos de 1 segundo, mostrando a próxima peça a ser usada, atualizando um score lateral e um contador de tempo de jogo. Você pode usar as letras ASDW ou JKLI para mover a peça em queda para a esquerda, para baixo, para a direita e rotacioná-la, respectivamente, e a barra de espaços para dropar a peça até a linha inferior que ela pode alcançar na tela, sendo possível neste ponto ainda mover a peça para a direita ou esquerda, ou mesmo rotacioná-la caso exista espaço hábil para tais operações.Ainda pode ser usada a letra P para colocar e retirar o jogo de modo “Pause”. E, para sair do jogo instantaneamente, pressione a tecla [ESC].

Na versão inicial, o jogo não foi montado usando orientação a objeto. Ele ainda será passado a limpo, com classes e propriedades, mas já funciona muito bem com o paradigma estruturado. Em poucas linhas, o painel de jogo possui uma representação em memória usando array de strings, onde cada elemento do array representa uma linha da tela, e a sequência de números dentro de cada linha corresponde a um quadradinho colorido. A tela do jogo é desenhada na interface do Advpl em um Grid de 20 x 10 imagens, onde o jogo lida com a aplicação de peças e movimento de peças dentro desse array, e a camada de interface apenas atualiza essa matriz na interface trocando os resources das imagens. Como cada resource possui uma cor diferente, com uma matriz de 200 quadradinhos na tela e oito imagens, é possível montar a interface.

O miolo do jogo consiste em trabalhar com um array de strings, com 20 linhas, contendo em cada linha uma string com um valor numérico, onde “0” significa um espaço não preenchido, e cada valor maior que zero representa uma imagem 10×10 de uma cor diferente na respectiva posição do grid de bitmaps da interface. Como todo o jogo é baseado em array de strings, cada peça e sua respectiva representação de blocos é feita em um array multi-dimensional de peças, onde cada peça é representada por um grid de string 4×4 com “0” e “1”.

As funções de trabalho com as matrizes devem ser capazes de remover ou colocar uma peça do array que representa a interface, e no caso de colocar a peça, a função somente deve conseguir realizar esta operação caso as posições dos quadrados usados pela peça estejam vazias no Grid. A animação consiste apenas em remover a peça em jogo da posição atual do grid no array, inseri-la em uma nova posição, e repintar o grid de interface. Esta pintura é realizada simplesmente setando novamente o nome do resource (bitmap) usado naquela posição, caso ele esteja diferente do recurso indicado no array.

Cada STATIC FUNCTION do código tem um propósito distinto, e para economizar com a passagem de parâmetros, como este fonte é executado sem recursão, as variáveis contendo o estado do jogo também são STATIC. A interface para obter as teclas pressionadas foi feita com botões, criados fora da área visível da tela, onde cada letra usada é indicada no prompt do botão como uma tecla de atalho ( prefixada com & ). Neste caso especifico, quando o foco da interface está em um componente que não permite edição de conteúdo, o uso das teclas de atalho não precisa ser concomitante com a tecla [ALT], o que torna essa idéia de input de interface viável no AdvPL.

Dentro do fonte AdvPL as partes do código e suas funcionalidades estão bem documentadas. É claro que não é um fonte arroz com feijão, esse prato têm uns temperos um pouco mais “puxados”, e como ele não foi escrito usando orientação a objeto, ele requer um pouco mais de atenção para ser assimilado na íntegra. Posteriormente eu vou fazer a segunda versão desse clone, com todas as funcionalidades do primeiro, porém usando Orientação a Objetos do AdvPL, fazendo isso vai ficar muito visível o nível de clareza da aplicação quando utilizamos a Orientação a Objetos.

Fontes e Patch

O fonte deste aplicativo e os bitmaps (resources) necessários estão no GitHub https://github.com/siga0984/Tetris , bem como um patch gerado para o Protheus 11 ( RPO TOP , Português ) com apenas o fonte Tetris.PRW e as imagens do projeto. Para gerar a aplicação, basta ter um Protheus 10 ou superior, criar um projeto em branco, baixar o PRW e as imagens do GitHub, acrescentar o fonte no projeto, e acrescentar todas as imagens como “resources”. Para executá-lo, basta chamar o SmartClient, informando a função U_TETRIS

E, pra você que está se coçando de curiosidade, o fonte com todos os comentários e afins, ficou com pouco mais de 700 linhas. Segue abaixo o fonte AdvPL do clone do Tetris.

#include "protheus.ch"
/* ========================================================
Função U_TETRIS
Autor Júlio Wittwer
Data 03/11/2014
Versão 1.150226
Descriçao Réplica do jogo Tetris, feito em AdvPL
Para jogar, utilize as letras :
A ou J = Move esquerda
D ou L = Move Direita
S ou K = Para baixo
W ou I = Rotaciona sentido horario
Barra de Espaço = Dropa a peça
Pendencias
Fazer um High Score
Cores das peças
O = Yellow
I = light Blue
L = Orange
Z = Red
S = Green
J = Blue
T = Purple
======================================================== */
STATIC _aPieces := LoadPieces() // Array de peças do jogo 
STATIC _aBlockRes := { "BLACK","YELOW2","LIGHTBLUE2","ORANGE2","RED2","GREEN2","BLUE2","PURPLE2" }
STATIC _nGameClock // Tempo de jogo 
STATIC _nNextPiece // Proxima peça a ser usada
STATIC _GlbStatus := 0 // 0 = Running 1 = PAuse 2 == Game Over
STATIC _aBMPGrid := array(20,10) // Array de bitmaps de interface do jogo 
STATIC _aBMPNext := array(4,5) // Array de botmaps da proxima peça
STATIC _aNext := {} // Array com a definição e posição da proxima peça
STATIC _aDropping := {} // Array com a definição e posição da peça em jogo
STATIC _nScore := 0 // pontuação da partida
STATIC _oScore // label para mostrar o score e time e mensagens
STATIC _aMainGrid := {} // Array de strings com os blocos da interface representados em memoria
STATIC _oTimer // Objeto timer de interface para a queda automática da peça em jogo
 
// =======================================================
USER Function Tetris()
Local nC , nL
Local oDlg
Local oBackGround , oBackNext
Local oFont , oLabel , oMsg
// Fonte default usada na caixa de diálogo 
// e respectivos componentes filhos
oFont := TFont():New('Courier new',,-16,.T.,.T.)
DEFINE DIALOG oDlg TITLE "Tetris AdvPL" FROM 10,10 TO 450,365 ;
 FONT oFont COLOR CLR_WHITE,CLR_BLACK PIXEL
// Cria um fundo cinza, "esticando" um bitmap
@ 8, 8 BITMAP oBackGround RESOURCE "GRAY" ;
SIZE 104,204 Of oDlg ADJUST NOBORDER PIXEL
// Desenha na tela um grid de 20x10 com Bitmaps
// para ser utilizado para desenhar a tela do jogo
For nL := 1 to 20
 For nC := 1 to 10
 
 @ nL*10, nC*10 BITMAP oBmp RESOURCE "BLACK2" ;
 SIZE 10,10 Of oDlg ADJUST NOBORDER PIXEL
 
 _aBMPGrid[nL][nC] := oBmp
 
 Next
Next
 
// Monta um Grid 4x4 para mostrar a proxima peça
// ( Grid deslocado 110 pixels para a direita )
@ 8, 118 BITMAP oBackNext RESOURCE "GRAY" ;
 SIZE 54,44 Of oDlg ADJUST NOBORDER PIXEL
For nL := 1 to 4
 For nC := 1 to 5
 
 @ nL*10, (nC*10)+110 BITMAP oBmp RESOURCE "BLACK" ;
 SIZE 10,10 Of oDlg ADJUST NOBORDER PIXEL
 
 _aBMPNext[nL][nC] := oBmp
 
 Next
Next
// Label fixo, título do Score.
@ 80,120 SAY oLabel PROMPT "[Score]" SIZE 60,10 OF oDlg PIXEL
 
// Label para Mostrar score, timers e mensagens do jogo
@ 90,120 SAY _oScore PROMPT " " SIZE 60,120 OF oDlg PIXEL
 
// Define um timer, para fazer a peça em jogo
// descer uma posição a cada um segundo
// ( Nao pode ser menor, o menor tempo é 1 segundo )
_oTimer := TTimer():New(1000, ;
 {|| MoveDown(.f.) , PaintScore() }, oDlg )
// Botões com atalho de teclado
// para as teclas usadas no jogo
// colocados fora da area visivel da caixa de dialogo
@ 480,10 BUTTON oDummyBtn PROMPT '&A' ;
 ACTION ( DoAction('A'));
 SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyBtn PROMPT '&S' ;
 ACTION ( DoAction('S') ) ;
 SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyBtn PROMPT '&D' ;
 ACTION ( DoAction('D') ) ;
 SIZE 1, 1 OF oDlg PIXEL
 
@ 480,20 BUTTON oDummyBtn PROMPT '&W' ;
 ACTION ( DoAction('W') ) ;
 SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyBtn PROMPT '&J' ;
 ACTION ( DoAction('J') ) ;
 SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyBtn PROMPT '&K' ;
 ACTION ( DoAction('K') ) ;
 SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyBtn PROMPT '&L' ;
 ACTION ( DoAction('L') ) ;
 SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyBtn PROMPT '&I' ;
 ACTION ( DoAction('I') ) ;
 SIZE 1, 1 OF oDlg PIXEL
 
@ 480,20 BUTTON oDummyBtn PROMPT '& ' ; // Espaço = Dropa
 ACTION ( DoAction(' ') ) ;
 SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyBtn PROMPT '&P' ; // Pause
 ACTION ( DoPause() ) ;
 SIZE 1, 1 OF oDlg PIXEL
// Na inicialização do Dialogo uma partida é iniciada
oDlg:bInit := {|| Start() }
ACTIVATE DIALOG oDlg CENTER
Return
/* ------------------------------------------------------------
Função Start() Inicia o jogo
------------------------------------------------------------ */
STATIC Function Start()
Local aDraw
// Inicializa o grid de imagens do jogo na memória
// Sorteia a peça em jogo
// Define a peça em queda e a sua posição inicial
// [ Peca, direcao, linha, coluna ]
// e Desenha a peça em jogo no Grid
// e Atualiza a interface com o Grid
InitGrid()
nPiece := randomize(1,len(_aPieces)+1)
_aDropping := {nPiece,1,1,6}
SetGridPiece(_aDropping,_aMainGrid)
PaintMainGrid()
// Sorteia a proxima peça e desenha 
// ela no grid reservado para ela 
InitNext()
_nNextPiece := randomize(1,len(_aPieces)+1)
aDraw := {_nNextPiece,1,1,1}
SetGridPiece(aDraw,_aNext)
PaintNext()
// Inicia o timer de queda automática da peça em jogo
_oTimer:Activate()
// Marca timer do inicio de jogo 
_nGameClock := seconds()
Return
/* ----------------------------------------------------------
Inicializa o Grid na memoria
Em memoria, o Grid possui 14 colunas e 22 linhas
Na tela, são mostradas apenas 20 linhas e 10 colunas
As 2 colunas da esquerda e direita, e as duas linhas a mais
sao usadas apenas na memoria, para auxiliar no processo
de validação de movimentação das peças.
---------------------------------------------------------- */
STATIC Function InitGrid()
_aMainGrid := array(20,"11000000000011")
aadd(_aMainGrid,"11111111111111")
aadd(_aMainGrid,"11111111111111")
return
STATIC Function InitNext()
_aNext := array(4,"00000")
return
//
// Aplica a peça no Grid.
// Retorna .T. se foi possivel aplicar a peça na posicao atual
// Caso a peça não possa ser aplicada devido a haver
// sobreposição, a função retorna .F. e o grid não é atualizado
//
STATIC Function SetGridPiece(aOnePiece,aGrid)
Local nPiece := aOnePiece[1] // Numero da peça
Local nPos := aOnePiece[2] // Posição ( para rotacionar ) 
Local nRow := aOnePiece[3] // Linha atual no Grid
Local nCol := aOnePiece[4] // Coluna atual no Grid
Local nL , nC
Local aTecos := {}
Local cTeco, cPeca , cPieceStr
cPieceStr := str(nPiece,1)
For nL := nRow to nRow+3
 cTeco := substr(aGrid[nL],nCol,4)
 cPeca := _aPieces[nPiece][1+nPos][nL-nRow+1]
 For nC := 1 to 4
 If Substr(cPeca,nC,1) == '1'
 If substr(cTeco,nC,1) != '0'
 // Vai haver sobreposição,
 // Nao dá para desenhar a peça
 Return .F.
 Endif
 cTeco := Stuff(cTeco,nC,1,cPieceStr)
 Endif
 Next
 // Array temporario com a peça já colocada
 aadd(aTecos,cTeco)
Next
// Aplica o array temporario no array do grid
For nL := nRow to nRow+3
 aGrid[nL] := stuff(_aMainGrid[nL],nCol,4,aTecos[nL-nRow+1])
Next
Return .T.
/* ----------------------------------------------------------
Função PaintMainGrid()
Pinta o Grid do jogo da memória para a Interface
Release 20150222 : Optimização na camada de comunicação, apenas setar
o nome do resource / bitmap caso o resource seja diferente do atual.
---------------------------------------------------------- */
STATIC Function PaintMainGrid()
Local nL, nc , cLine, nPeca
for nL := 1 to 20
 cLine := _aMainGrid[nL]
 For nC := 1 to 10
 nPeca := val(substr(cLine,nC+2,1))
 If _aBMPGrid[nL][nC]:cResName != _aBlockRes[nPeca+1]
 // Somente manda atualizar o bitmap se houve
 // mudança na cor / resource desta posição
 _aBMPGrid[nL][nC]:SetBmp(_aBlockRes[nPeca+1])
 endif
 Next
Next
Return
// Pinta na interface a próxima peça 
// a ser usada no jogo 
STATIC Function PaintNext()
Local nL, nC, cLine , nPeca
For nL := 1 to 4
 cLine := _aNext[nL]
 For nC := 1 to 5
 nPeca := val(substr(cLine,nC,1))
 If _aBMPNext[nL][nC]:cResName != _aBlockRes[nPeca+1]
 _aBMPNext[nL][nC]:SetBmp(_aBlockRes[nPeca+1])
 endif
 Next
Next
Return
/* -----------------------------------------------------------------
Carga do array de peças do jogo 
Array multi-dimensional, contendo para cada 
linha a string que identifica a peça, e um ou mais
arrays de 4 strings, onde cada 4 elementos 
representam uma matriz binaria de caracteres 4x4 
para desenhar cada peça
Exemplo - Peça "O"
aLPieces[1][1] C "O"
aLPieces[1][2][1] "0000" 
aLPieces[1][2][2] "0110" 
aLPieces[1][2][3] "0110" 
aLPieces[1][2][4] "0000"
----------------------------------------------------------------- */
STATIC Function LoadPieces()
Local aLPieces := {}
// Peça "O" , uma posição
aadd(aLPieces,{'O', { '0000','0110','0110','0000'}})
// Peça "I" , em pé e deitada
aadd(aLPieces,{'I', { '0000','1111','0000','0000'},;
 { '0010','0010','0010','0010'}})
// Peça "S", em pé e deitada
aadd(aLPieces,{'S', { '0000','0011','0110','0000'},;
 { '0010','0011','0001','0000'}})
// Peça "Z", em pé e deitada
aadd(aLPieces,{'Z', { '0000','0110','0011','0000'},;
 { '0001','0011','0010','0000'}})
// Peça "L" , nas 4 posições possiveis
aadd(aLPieces,{'L', { '0000','0111','0100','0000'},;
 { '0010','0010','0011','0000'},;
 { '0001','0111','0000','0000'},;
 { '0110','0010','0010','0000'}})
// Peça "J" , nas 4 posições possiveis
aadd(aLPieces,{'J', { '0000','0111','0001','0000'},;
 { '0011','0010','0010','0000'},;
 { '0100','0111','0000','0000'},;
 { '0010','0010','0110','0000'}})
// Peça "T" , nas 4 posições possiveis
aadd(aLPieces,{'T', { '0000','0111','0010','0000'},;
 { '0010','0011','0010','0000'},;
 { '0010','0111','0000','0000'},;
 { '0010','0110','0010','0000'}})
Return aLPieces
/* ----------------------------------------------------------
Função MoveDown()
Movimenta a peça em jogo uma posição para baixo.
Caso a peça tenha batido em algum obstáculo no movimento
para baixo, a mesma é fica e incorporada ao grid, e uma nova
peça é colocada em jogo. Caso não seja possivel colocar uma
nova peça, a pilha de peças bateu na tampa -- Game Over
---------------------------------------------------------- */
STATIC Function MoveDown(lDrop)
Local aOldPiece
 
If _GlbStatus != 0
 Return
Endif
// Clona a peça em queda na posição atual
aOldPiece := aClone(_aDropping)
If lDrop
 
 // Dropa a peça até bater embaixo
 // O Drop incrementa o score em 1 ponto 
 // para cada linha percorrida. Quando maior a quantidade
 // de linhas vazias, maior o score acumulado com o Drop
 
 // Guarda a peça na posição atual
 aOldPiece := aClone(_aDropping)
 
 // Remove a peça do Grid atual
 DelPiece(_aDropping,_aMainGrid)
 
 // Desce uma linha pra baixo
 _aDropping[3]++
 
 While SetGridPiece(_aDropping,_aMainGrid)
 
 // Encaixou, remove e tenta de novo
 DelPiece(_aDropping,_aMainGrid)
 
 // Guarda a peça na posição atual
 aOldPiece := aClone(_aDropping)
 
 // Desce a peça mais uma linha pra baixo
 _aDropping[3]++
// Incrementa o Score
 _nScore++
 
 Enddo
 
 // Nao deu mais pra pintar, "bateu"
 // Volta a peça anterior, pinta o grid e retorna
 // isto permite ainda movimentos laterais
 // caso tenha espaço.
 
 _aDropping := aClone(aOldPiece)
 SetGridPiece(_aDropping,_aMainGrid)
 PaintMainGrid()
 
Else
 
 // Move a peça apenas uma linha pra baixo
 
 // Primeiro remove a peça do Grid atual
 DelPiece(_aDropping,_aMainGrid)
 
 // Agora move a peça apenas uma linha pra baixo
 _aDropping[3]++
 
 // Recoloca a peça no Grid
 If SetGridPiece(_aDropping,_aMainGrid)
 
 // Se deu pra encaixar, beleza
 // pinta o novo grid e retorna
 PaintMainGrid()
 Return
 
 Endif
 
 // Opa ... Esbarrou em alguma coisa
 // Volta a peça pro lugar anterior
 // e recoloca a peça no Grid
 _aDropping := aClone(aOldPiece)
 SetGridPiece(_aDropping,_aMainGrid)
// Incrementa o score em 4 pontos 
 // Nao importa a peça ou como ela foi encaixada
 _nScore += 4
// Agora verifica se da pra limpar alguma linha
 ChkMainLines()
 
 // Pega a proxima peça
 nPiece := _nNextPiece
 _aDropping := {nPiece,1,1,6} // Peca, direcao, linha, coluna
If !SetGridPiece(_aDropping,_aMainGrid)
 
 // Acabou, a peça nova nao entra (cabe) no Grid
 // Desativa o Timer e mostra "game over"
 // e fecha o programa
_GlbStatus := 2 // GAme Over
// volta os ultimos 4 pontos ... 
 _nScore -= 4
// Cacula o tempo de operação do jogo 
 _nGameClock := round(seconds()-_nGameClock,0)
 If _nGameClock < 0 
 // Ficou negativo, passou da meia noite 
 _nGameClock += 86400
 Endif
// Desliga o timer de queda de peça em jogo
 _oTimer:Deactivate() 
 
 Endif
 
 // Se a peca tem onde entrar, beleza
 // -- Repinta o Grid -- 
 PaintMainGrid()
// Sorteia a proxima peça
 // e mostra ela no Grid lateral
If _GlbStatus != 2 
 // Mas apenas faz isso caso nao esteja em game over
 InitNext()
 _nNextPiece := randomize(1,len(_aPieces)+1)
 SetGridPiece( {_nNextPiece,1,1,1} , _aNext)
 PaintNext()
 Else
 // Caso esteja em game over, apenas limpa a proxima peça
 InitNext()
 PaintNext()
 Endif
 
 
Endif
Return
/* ----------------------------------------------------------
Recebe uma ação da interface, através de uma das letras
de movimentação de peças, e realiza a movimentação caso
haja espaço para tal.
---------------------------------------------------------- */
STATIC Function DoAction(cAct)
Local aOldPiece
// conout("Action = ["+cAct+"]")
If _GlbStatus != 0 
 Return
Endif
// Clona a peça em queda
aOldPiece := aClone(_aDropping)
if cAct $ 'AJ'
// Movimento para a Esquerda (uma coluna a menos)
 // Remove a peça do grid
 DelPiece(_aDropping,_aMainGrid)
 _aDropping[4]--
 If !SetGridPiece(_aDropping,_aMainGrid)
 // Se nao foi feliz, pinta a peça de volta
 _aDropping := aClone(aOldPiece)
 SetGridPiece(_aDropping,_aMainGrid)
 Endif
 // Repinta o Grid
 PaintMainGrid()
 
Elseif cAct $ 'DL'
// Movimento para a Direita ( uma coluna a mais )
 // Remove a peça do grid
 DelPiece(_aDropping,_aMainGrid)
 _aDropping[4]++'
 If !SetGridPiece(_aDropping,_aMainGrid)
 // Se nao foi feliz, pinta a peça de volta
 _aDropping := aClone(aOldPiece)
 SetGridPiece(_aDropping,_aMainGrid)
 Endif
 // Repinta o Grid
 PaintMainGrid()
 
Elseif cAct $ 'WI'
 
 // Movimento para cima ( Rotaciona sentido horario )
 
 // Remove a peça do Grid
 DelPiece(_aDropping,_aMainGrid)
 
 // Rotaciona
 _aDropping[2]--
 If _aDropping[2] < 1
 _aDropping[2] := len(_aPieces[_aDropping[1]])-1
 Endif
 
 If !SetGridPiece(_aDropping,_aMainGrid)
 // Se nao consegue colocar a peça no Grid
 // Nao é possivel rotacionar. Pinta a peça de volta
 _aDropping := aClone(aOldPiece)
 SetGridPiece(_aDropping,_aMainGrid)
 Endif
 
 // E Repinta o Grid
 PaintMainGrid()
 
ElseIF cAct $ 'SK'
 
 // Desce a peça para baixo uma linha intencionalmente 
 MoveDown(.F.)
 
 // se o movimento foi intencional, ganha + 1 ponto 
 _nScore++
 
ElseIF cAct == ' '
 
 // Dropa a peça - empurra para baixo até a última linha
 // antes de baer a peça no fundo do Grid
 MoveDown(.T.)
 
Endif
// Antes de retornar, repinta o score
PaintScore()
Return .T.
Static function DoPause()
If _GlbStatus == 0
 // Pausa
 _GlbStatus := 1
 _oTimer:Deactivate()
Else
 // Sai da pausa
 _GlbStatus := 0
 _oTimer:Activate()
Endif
// Antes de retornar, repinta o score
PaintScore()
Return
/* -----------------------------------------------------------------------
Remove uma peça do Grid atual
----------------------------------------------------------------------- */
STATIC Function DelPiece(aPiece,aGrid)
Local nPiece := aPiece[1]
Local nPos := aPiece[2]
Local nRow := aPiece[3]
Local nCol := aPiece[4]
Local nL, nC
Local cTeco, cPeca
// Como a matriz da peça é 4x4, trabalha em linhas e colunas
// Separa do grid atual apenas a área que a peça está ocupando
// e desliga os pontos preenchidos da peça no Grid.
For nL := nRow to nRow+3
 cTeco := substr(aGrid[nL],nCol,4)
 cPeca := _aPieces[nPiece][1+nPos][nL-nRow+1]
 For nC := 1 to 4
 If Substr(cPeca,nC,1)=='1'
 cTeco := Stuff(cTeco,nC,1,'0')
 Endif
 Next
 aGrid[nL] := stuff(_aMainGrid[nL],nCol,4,cTeco)
Next
Return
/* -----------------------------------------------------------------------
Verifica se alguma linha esta completa e pode ser eliminada
----------------------------------------------------------------------- */
STATIC Function ChkMainLines()
Local nErased := 0
For nL := 20 to 2 step -1
 
 // Sempre varre de baixo para cima
 // Pega uma linha, e remove os espaços vazios
 cTeco := substr(_aMainGrid[nL],3)
 cNewTeco := strtran(cTeco,'0','')
 
 If len(cNewTeco) == len(cTeco)
 // Se o tamanho da linha se manteve, não houve
 // nenhuma redução, logo, não há espaços vazios
 // Elimina esta linha e acrescenta uma nova linha
 // em branco no topo do Grid
 adel(_aMainGrid,nL)
 ains(_aMainGrid,1)
 _aMainGrid[1] := "11000000000011"
 nL++
 nErased++
 Endif
 
Next
// Pontuação por linhas eliminadas 
// Quanto mais linhas ao mesmo tempo, mais pontos
If nErased == 4
 _nScore += 100
ElseIf nErased == 3
 _nScore += 50
ElseIf nErased == 2
 _nScore += 25
ElseIf nErased == 1
 _nScore += 10
Endif
Return
/* ------------------------------------------------------
Seta o score do jogo na tela
Caso o jogo tenha terminado, acrescenta 
a mensagem de "GAME OVER"
------------------------------------------------------*/
STATIC Function PaintScore()
If _GlbStatus == 0
// JOgo em andamento, apenas atualiza score e timer
 _oScore:SetText(str(_nScore,7)+CRLF+CRLF+;
 '[Time]'+CRLF+str(seconds()-_nGameClock,7,0)+' s.')
ElseIf _GlbStatus == 1
// Pausa, acresenta a mensagem de "GAME OVER"
 _oScore:SetText(str(_nScore,7)+CRLF+CRLF+;
 '[Time]'+CRLF+str(seconds()-_nGameClock,7,0)+' s.'+CRLF+CRLF+;
 "*********"+CRLF+;
 "* PAUSE *"+CRLF+;
 "*********")
ElseIf _GlbStatus == 2
// Terminou, acresenta a mensagem de "GAME OVER"
 _oScore:SetText(str(_nScore,7)+CRLF+CRLF+;
 '[Time]'+CRLF+str(_nGameClock,7,0)+' s.'+CRLF+CRLF+;
 "********"+CRLF+;
 "* GAME *"+CRLF+;
 "********"+CRLF+;
 "* OVER *"+CRLF+;
 "********")
Endif
Return

Conclusão

Para se tirar o melhor de cada ferramenta, devemos conhecê-la, e quanto mais profundamente a conhecemos, melhores são os resultados que podemos obter dela. Espero que isso estimulem vocês a quererem saber mais, e colocar em prática o seu conhecimento. E, aprender também pode ser divertido !!! Espero que todos gostem !! Até o próximo post, pessoal 😉

Referências

TDN – Totvs Development Network. TOTVS, 2015. Disponível em http://tdn.totvs.com/display/tec/AdvPL . Acesso em: 26 fev. 2015.

TETRIS. In: WIKIPÉDIA, a enciclopédia livre. Flórida: Wikimedia Foundation, 2015. Disponível em: [http://pt.wikipedia.org/w/index.php?title=Tetris&oldid=41347620]. Acesso em: 23 fev. 2015.

Tetris. (2015, February 16). In Wikipedia, The Free Encyclopedia. Retrieved 04:38, February 23, 2015, from http://en.wikipedia.org/w/index.php?title=Tetris&oldid=647443725