(***************************************************************

Tenho que fazer a documentacao aqui.

***************************************************************)
program Minhoca;
uses crt,dfs;


{Graficos}
const
GameOverLinhas=9;
GameOverColunas=58;
GameOverX=(80-GameOverColunas) shr 1;
GameOverY=(50-GameOverLinhas ) shr 1;
GameOverStr:array[0..GameOverLinhas-1] of string[GameOverColunas]=(
'                                                          ',
' @@@@@  @@@@@  @   @  @@@@@    @@@@@  @   @  @@@@@  @@@@@ ',
' @   @  @   @  @@ @@  @        @   @  @   @  @      @   @ ',
' @      @   @  @ @ @  @        @   @  @   @  @      @   @ ',
' @ @@@  @@@@@  @ @ @  @@@@@    @   @  @   @  @@@@@  @@@@@ ',
' @   @  @   @  @   @  @        @   @  @   @  @      @ @   ',
' @   @  @   @  @   @  @        @   @   @ @   @      @  @  ',
' @@@@@  @   @  @   @  @@@@@    @@@@@    @    @@@@@  @   @ ',
'                                                          ');

PauseLinhas=3;
PauseColunas=15;
PauseX=65;
PauseY=47;
PauseStr:array[0..PauseLinhas-1] of string[PauseColunas]=(
',-. _     _  _ ',
'|-'' _|| |(_'' _|',
'|  (_||_|._)(_|');

Numeros:array[0..4,0..9] of string[5]=(
(' ___ ',' _   ',' ___ ',' ___ ','     ',' ___ ',' ___ ',' ___ ',' ___ ',' ___ '),
('|  /|','  |  ','    |','    |','| |  ','|    ','|    ','   / ','|   |','|   |'),
('| + |','  +  ',' -+- ',' -+- ',' -+- ',' -+- ','|-+- ','  +  ',' -+- ',' -+-|'),
('|/  |','  |  ','|    ','    |','  |  ','    |','|   |',' /   ','|   |','    |'),
(' --- ',' --- ',' --- ',' --- ','     ',' --- ',' --- ','     ',' --- ',' --- '));

LogopeqLinhas=6;
LogopeqColunas=28;
LogopeqX=51;
LogopeqY=1;
LogopeqStr:array[0..LogopeqLinhas-1] of string[LogopeqColunas]=(
'|    |                      ',
'|\  /|        |             ',
'| \/ | @  __  |__ _ _ _     ',
'|    | | \  \ |  \ (_) /    ',
'|    | | |  | |  |    (   _)',
'|    | | |  | |  |_____\ (_)');

{Importantes}
const
  TelaTamX=48;  {Largura do campo}
  TelaTamY=48;  {Largura do campo}
                {Precisa ser menor que 255}

  TelaX=1;  {Posicao do campo na tela}
  TelaY=1;  {Posicao do campo na tela}
            {Precisam ser maior que 0, senao da bug!}

  TamMax=2000;  {Tamanho maximo da minhoca}
  NumMacas=10;  {Numero de macas}

  CharCorpo='#';  CorCorpo=$02;
  CharFundo=' ';  CorFundo=$0F;
  CharMaca ='@';  CorMaca =$0C;


{Relativas ao jogo}
var
  {Minhoca}
  a  : array[0..TamMax] of word; {Array principal com as posicoes da minhoca}

  tam    : word;    {Indica o tamanho da minhoca}
  cabeca : word;    {Indica a posicao da cabeca no array}
  cauda  : word;    {Indica a posicao da cauda no array}
                                                           {  3  }
  direcao: byte;    {Indica para onde ela esta se movendo} {2   0}
                                                           {  1  }
  {Outros}
  estado : byte;    {Indica o estado do jogo (verifique cada bit)}
{0 Em jogo (0=pausa/gameover)   4 ---                           }
{1 Colisao (gameover)           5 ---                           }
{2 Comeu maca                   6 ---                           }
{3 ---                          7 ---                           }

  key    : char; {Readkey}

  tempo     :word; {Delay}
  contatempo:word; {Contador de ciclos}

(*
{Alteracao dos caracteres}
Var
  oldCharset :Array[0..255,1..16] of Byte;
  ch         :char;
  regs       :registers;
  p,x,y      :integer;

Procedure read_char_set;

Var
  b : Byte;
  w : Word;

begin
  For b := 0 to 255 do
  begin
    w := b * 32;
    Inline($FA);
    PortW[$3C4] := $0402;
    PortW[$3C4] := $0704;
    PortW[$3CE] := $0204;
    PortW[$3CE] := $0005;
    PortW[$3CE] := $0006;
    Move(Ptr($A000, w)^, oldCharset[b, 1], 16);
    PortW[$3C4] := $0302;
    PortW[$3C4] := $0304;
    PortW[$3CE] := $0004;
    PortW[$3CE] := $1005;
    PortW[$3CE] := $0E06;
    Inline($FB);
  end;
end;

Procedure restore_char_set;

Var
  b : Byte;
  w : Word;

begin
  For b := 0 to 255 do
  begin
    w := b * 32;
    Inline($FA);
    PortW[$3C4] := $0402;
    PortW[$3C4] := $0704;
    PortW[$3CE] := $0204;
    PortW[$3CE] := $0005;
    PortW[$3CE] := $0006;
    Move(oldCharset[b, 1], Ptr($A000, w)^, 16);
    PortW[$3C4] := $0302;
    PortW[$3C4] := $0304;
    PortW[$3CE] := $0004;
    PortW[$3CE] := $1005;
    PortW[$3CE] := $0E06;
    Inline($FB);
  end;
end;

Procedure setasciiChar(Charnum : Byte; Var data);
Var
  offset : Word;
begin
  offset := CharNum * 32;
  Inline($FA);
  PortW[$3C4] := $0402;
  PortW[$3C4] := $0704;
  PortW[$3CE] := $0204;
  PortW[$3CE] := $0005;
  PortW[$3CE] := $0006;
  Move(data, Ptr($A000, offset)^, 16);
  PortW[$3C4] := $0302;
  PortW[$3C4] := $0304;
  PortW[$3CE] := $0004;
  PortW[$3CE] := $1005;
  PortW[$3CE] := $0E06;
  Inline($FB);
end;

Procedure load_demo_Char;

Type
  ByteArray  = Array[0..15] of Byte;
  CharArray  = Array[1..11] of Record
    CN       : Byte;
    CD       : ByteArray;
  end;

Const newChars : CharArray =

             { characters ÈÉÊËÌÍÎÏÐÑÒ }

   ((CN:200;CD:(127,128,128,190,160,160,160,160,190,130,130,130,
                                              190,128,128,127)),         {È}
   { example first 16 bytes }

   { 128  64  32  16   8   4   2   1 }
   {---------------------------------}
   { 000 ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ   = 127 }
   { ÛÛÛ 000 000 000 000 000 000 000   = 128 }
   { ÛÛÛ 000 000 000 000 000 000 000   = 128 }
   { ÛÛÛ 000 ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ 000   = 190 }
   { ÛÛÛ 000 ÛÛÛ 000 000 000 000 000   = 160 }
   { ÛÛÛ 000 ÛÛÛ 000 000 000 000 000   = 160 }
   { ÛÛÛ 000 ÛÛÛ 000 000 000 000 000   = 160 }
   { ÛÛÛ 000 ÛÛÛ 000 000 000 000 000   = 160 }
   { ÛÛÛ 000 ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ 000   = 190 }
   { ÛÛÛ 000 000 000 000 000 ÛÛÛ 000   = 130 }
   { ÛÛÛ 000 000 000 000 000 ÛÛÛ 000   = 130 }
   { ÛÛÛ 000 000 000 000 000 ÛÛÛ 000   = 130 }
   { ÛÛÛ 000 ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ 000   = 190 }
   { ÛÛÛ 000 000 000 000 000 000 000   = 128 }
   { ÛÛÛ 000 000 000 000 000 000 000   = 128 }
   { 000 ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ   = 127 }


   (CN:201;CD:(255,0,0,60,66,66,66,66,66,66,66,66,60,0,0,255)),          {É}
   (CN:202;CD:(255,0,0,126,64,64,64,64,120,64,64,64,64,0,0,255)),        {Ê}
   (CN:203;CD:(255,0,0,159,4,4,4,4,4,132,132,132,4,0,0,255)),            {Ë}
   (CN:204;CD:(255,0,0,1,2,2,2,2,2,2,2,2,1,0,0,255)),                    {Ì}
   (CN:205;CD:(255,0,0,199,36,36,36,36,39,36,36,36,196,0,0,255)),        {Í}
   (CN:206;CD:(255,0,0,132,68,68,68,68,132,4,4,4,4,0,0,255)),            {Î}
   (CN:207;CD:(255,0,0,66,98,82,74,70,66,66,66,66,66,0,0,255)),          {Ï}
   (CN:208;CD:(255,0,0,33,34,34,34,34,34,34,34,34,33,0,0,255)),          {Ð}
   (CN:209;CD:(255,0,0,196,38,37,36,36,36,36,36,36,196,0,0,255)),        {Ñ}
   (CN:210;CD:(252,2,2,34,34,34,162,98,34,34,34,34,34,2,2,252)));        {Ò}



Var
  i : Byte;

begin
  for i := 1 to 11 do With regs do begin
    ah := $11;
    al := $0;
    bh := $10;
    bl := 0;
    cx := 1;
    dx := NewChars[i].CN;
    es := seg(NewChars[i].CD);
    bp := ofs(NewChars[i].CD);
    intr($10,regs);
  end;
end;*)









{--------------------------------------------------------------}
{---  Funcoes que facilitam (e muito) o codigo mais abaixo  ---}
{--------------------------------------------------------------}

{Pega o valor X na tela do monitor}
{Se quiser o X no "campo virtual", utilize Lo(coord)}
function getX(coord:word):byte;assembler;
asm
  mov ax,[coord]
  add al,TelaX
end;

{Pega o valor X na tela do monitor}
{Se quiser o X no "campo virtual", utilize Lo(coord)}
function getY(coord:word):byte;assembler;
asm
  mov ax,[coord]
  mov al,ah
  add al,TelaX
end;


{Verifica o estado do bit 0 da variavel "estado"}
function emJogo:boolean;assembler;
asm
  mov al,[estado]
  and al,00000001b
end;

{Define como 1 o bit 0 da variavel "estado"}
procedure SETemJogo;assembler;
asm
  mov al,[estado]
  or  al,00000001b
  mov [estado],al
end;

{Define como 0 o bit 0 da variavel "estado"}
procedure CLEARemJogo;assembler;
asm
  mov al,[estado]
  and al,11111110b
  mov [estado],al
end;

{Inverte o estado do bit 0 da variavel "estado"}
procedure TROCAemJogo;assembler;
asm
  mov al,[estado]
  xor al,00000001b
  mov [estado],al
end;


{Verifica o estado do bit 1 da variavel "estado"}
function colidiu:boolean;assembler;
asm
  mov al,[estado]
  and al,00000010b
end;

{Define como 1 o bit 1 da variavel "estado"}
procedure SETcolidiu;assembler;
asm
  mov al,[estado]
  or  al,00000010b
  mov [estado],al
end;

{Define como 0 o bit 1 da variavel "estado"}
procedure CLEARcolidiu;assembler;
asm
  mov al,[estado]
  and al,11111101b
  mov [estado],al
end;

{Verifica o estado do bit 2 da variavel "estado"}
function comeu:boolean;assembler;
asm
  mov al,[estado]
  and al,00000100b
end;

{Define como 1 o bit 2 da variavel "estado"}
procedure SETcomeu;assembler;
asm
  mov al,[estado]
  or  al,00000100b
  mov [estado],al
end;

{Define como 0 o bit 2 da variavel "estado"}
procedure CLEARcomeu;assembler;
asm
  mov al,[estado]
  and al,11111011b
  mov [estado],al
end;

{--------------------------------------------------------------}
{-------------  Criacao dos graficos da interface  ------------}
{--------------------------------------------------------------}

{Cria o contorno do campo do jogo}
procedure contorno;
var i:byte;
begin
  putchar(TelaX-1,TelaY-1,#201);
  for i:=1 to TelaTamX do
    putchar(TelaX+i-1,TelaY-1,#205);
  putchar(TelaX+TelaTamX,TelaY-1,#187);

  for i:=1 to TelaTamY do begin
    putchar(TelaX-1,TelaY+i-1,#186);
    putchar(TelaX+TelaTamX,TelaY+i-1,#186);
  end;

  putchar(TelaX-1,TelaY+TelaTamY,#200);
  for i:=1 to TelaTamX do
    putchar(TelaX+i-1,TelaY+TelaTamY,#205);
  putchar(TelaX+TelaTamX,TelaY+TelaTamY,#188);
end;

{Mostra "Pausa" na tela}
procedure mostraPausa;
var i:byte;
begin
  for i:=0 to PauseLinhas-1 do
    putstr(PauseX,PauseY+i,PauseStr[i]);
end;

{Apaga "Pausa" na tela}
procedure apagaPausa;
begin
  clearchar(PauseX,PauseY,PauseX+PauseColunas-1,PauseY+PauseLinhas-1,CharFundo);
end;

{Mostra o logotipo (pequeno) na tela}
procedure mostraLogopeq;
var i:byte;
begin
  for i:=0 to LogopeqLinhas-1 do
    putstr(LogopeqX,LogopeqY+i,LogopeqStr[i]);

  putcor( 7+LogopeqX, 2+LogopeqY,CorMaca);

  putcor(18+LogopeqX, 2+LogopeqY,CorCorpo);
  putcor(22+LogopeqX, 2+LogopeqY,CorCorpo);

  putcor(18+LogopeqX, 5+LogopeqY,CorCorpo);
  putcor(19+LogopeqX, 5+LogopeqY,CorCorpo);
  putcor(20+LogopeqX, 5+LogopeqY,CorCorpo);
  putcor(21+LogopeqX, 5+LogopeqY,CorCorpo);
  putcor(22+LogopeqX, 5+LogopeqY,CorCorpo);
end;

{Escreve um numero (usando ASCII Art) na tela}
procedure poenumero(x,y:byte;numero:word;digitos:byte);
var i:byte;
  num:word;
begin
  num:=numero;
  for i:=digitos-1 downto 0 do begin
    putstr(x+i*5,y  ,Numeros[0,num mod 10]);
    putstr(x+i*5,y+1,Numeros[1,num mod 10]);
    putstr(x+i*5,y+2,Numeros[2,num mod 10]);
    putstr(x+i*5,y+3,Numeros[3,num mod 10]);
    putstr(x+i*5,y+4,Numeros[4,num mod 10]);
    num:=num div 10;
    if num=0 then break;
  end;
end;

{Mostra informacoes que sao atualizadas a cada ciclo}
procedure showinfo;
begin
  {Pisca "Pausa" na tela}
  if NOT emJogo AND (contatempo * tempo mod 1000 < 500) then mostraPausa
  else apagaPausa;

  poenumero(60,20,tam,4);
end;

{Mostra informacoes estaticas}
procedure showinfoestatica;
begin
  mostraLogopeq;

  putPChar(55, 9,'Criado por Denilson');

  putPCharcor(54,11,'http://go.to/denilson',$09);
  putPCharcor(54,12,'http://pagina.de/denilson',$09);

  putPChar(51,40,'Setas - Comandam a minhoca');
  putPChar(51,41,'F2    - Recome‡a o jogo');
  putPChar(51,42,'F3    - Pausa o jogo');
end;

{Mostra a mensagem "GAME OVER"}
procedure gameover;
var i:byte;
begin
  for i:=0 to GameOverLinhas-1 do
    putstrcor(GameOverX,GameOverY+i,GameOverStr[i],$03);
end;

{--------------------------------------------------------------}
{--------------------------  O Jogo  --------------------------}
{--------------------------------------------------------------}

{Muda a direcao da minhoca, se possivel}
procedure mudaDirecao(novadir:byte);assembler;
asm
  mov al,[direcao]  {Caso um numero seja par e o outro impar, }
  mov bl,[novadir]  {ou seja, o bit 0 eh diferente entre eles,}
  xor al,bl         {eh porque o eixo (vertical/horizontal) eh}
  and al,1          {diferente. Como muda de eixo, a minhoca  }
  jz @fim           {pode mudar de direcao.}
  mov [direcao],bl
  @fim:
end;

{Cria uma nova maca em algum lugar vazio do campo do jogo}
procedure criarmaca;
var x,y:byte;
begin
  repeat
    x:=random(TelaTamX);
    y:=random(TelaTamY);
  until getchar(x+TelaX,y+TelaY)=CharFundo;
  putcharcor(x+TelaX,y+TelaY,CharMaca,CorMaca);
end;

{Quando a minhoca encosta numa maca, ela come!}
procedure comemaca;
begin
  inc(tam);
  dec(cauda);
  SETcomeu;
  criarmaca;
end;

{Verifica se houve alguma colisao entre a minhoca e qualquer outra coisa}
procedure colisoes;
var x,y:byte;
begin
{ Esta eh a forma mais simples poss¡vel, por‚m exige }
{ que tudo seja desenhado na tela, inclusive a borda }
  x:=getX(a[cabeca]);
  y:=getY(a[cabeca]);

  if (lo(a[cabeca])>=TelaTamX) OR (hi(a[cabeca])>=TelaTamY) then SETcolidiu
  else if getchar(x,y) = CharMaca then comemaca
  else if getchar(x,y) <> CharFundo then SETcolidiu;
end;

{Executada a cada ciclo se estiver emJogo e nao estiver pausado,}
{realiza a movimentacao da minhoca e chama a funcao "colisoes"  }
procedure vaiminhoca;
var old:word;
begin
  old:=a[cabeca];
  inc(cabeca);
  if cabeca=TamMax then cabeca:=0;
  case direcao of
    0 : a[cabeca]:=old+1;
    1 : a[cabeca]:=old+$100;
    2 : a[cabeca]:=old-1;
    3 : a[cabeca]:=old-$100;
  end;

  colisoes;

  if NOT colidiu then begin
    putcharcor(getX(a[cabeca]),getY(a[cabeca]),CharCorpo,CorCorpo);
    if comeu then CLEARcomeu
    else putcharcor(getX(a[cauda]),getY(a[cauda]),CharFundo,CorFundo);
  end;

  inc(cauda);
  if cauda=TamMax then cauda:=0;
end;

{--------------------------------------------------------------}
{-----------------------  Inicializacao  ----------------------}
{--------------------------------------------------------------}

{Inicializacao de variaveis e preparacao da tela}
procedure iniciar;
var i:byte;
begin
  {Inicializacao de variaveis}
  tam:=1;
  cabeca:=0;
  cauda:=0;
  direcao:=0;
  asm
    mov al,00000001b
    mov [estado],al
  end;
  a[0]:=(TelaTamY div 2) shl 8 + (TelaTamX div 2);

  tempo:=100;

  {Prepara a tela}
  limpatela80x50(CharFundo,CorFundo);
  contorno;
  showinfoestatica;

  {Inicializacao do campo de jogo}
  putcharcor(getX(a[cabeca]),getY(a[cabeca]),CharCorpo,CorCorpo);
  for i:=1 to NumMacas do criarmaca
end;

{--------------------------------------------------------------}
{------------------  Interacao com o jogador  -----------------}
{--------------------------------------------------------------}

{Executa a pausa para retardar o jogo e verifica o que o       }
{usuario pressionou, executando a devida acao:                 }
{  Esc   = Nada (sai do jogo no loop principal do programa)    }
{  F2    = Reinicia o jogo (chama a funcao "iniciar")          }
{  F3    = Pausa o jogo                                        }
{  Setas = Chamam a funcao "mudaDirecao"                       }
procedure comandaminhoca;
begin
  pausar(tempo);
  inc(contatempo);
  if contatempo=60000 then contatempo:=0;

  while keypressed do begin
    key:=readkey;

    case key of
{Esc} #27 : break;

      #0  : begin
        key:=readkey;
        case key of
{F2}      #60 : begin iniciar; break; end;
{F3}      #61 : if NOT colidiu then begin TROCAemJogo; break; end;

          #77 : if not keypressed then mudaDirecao(0);
          #80 : if not keypressed then mudaDirecao(1);
          #75 : if not keypressed then mudaDirecao(2);
          #72 : if not keypressed then mudaDirecao(3);
        end; {case 2}
      end; {key=#0}

    end; {case 1}

  end; {while true}
end;

{--------------------------------------------------------------}
{--------------------------------------------------------------}
{--------------------------  INICIO  --------------------------}
{--------------------------------------------------------------}
{--------------------------------------------------------------}

BEGIN

{Preparacao}
SetText80x50;
Randomize;
Iniciar;

{INICIO}
repeat
  comandaminhoca;
  if NOT colidiu AND emJogo then vaiminhoca;
  showinfo;
  if colidiu then gameover;
until key=#27;

{Finalizacao do programa}
SetText80x25;

END.