[Resolvido]Sair a meio do programa

[perez]

Boas, eu construi um relógio simples em pascal

Program relogio;
uses crt,dos;
var
Y,M,D,DS,H,MN,SG,MS:word;
x:Integer;
Begin
  Repeat
     GetDate(Y,M,D,DS);
     GetTime(H,MN,SG,MS);
     If ((MN >= 0) and (MN <= 9) and (SG >= 0) and (SG <= 9)) then
        WriteLn(H,':0',MN,':0',SG)
     Else If ((MN >= 0) and (MN <= 9) and (SG >= 10)) then
        WriteLn(H,':0',MN,':',SG)
     Else If ((MN >= 10) and (SG >= 0) and (SG <= 9)) then
        WriteLn(H,':',MN,':0',SG)
     Else WriteLn(H,':',MN,':',SG);
     WriteLn(D,'/',M,'/',Y);
     x := x + 1;
     Delay(1000);
     ClrScr;
  Until x = 120;
     ReadKey;
End.

Existe alguma maneira de fazer sempre repeat (ciclo infinito) e ao carregar X, por exemplo, sai do programa?

Eu já tentei, mas com readkey para o programa até carregar alguma tecla, eu queria que o programa fosse repetindo e a qualquer altura poder ser interrompido por acção do utilizador.

Cumprimentos,

David Perez

[M6]

Sim existe.

Vê a função Exit.

[perez]

podes mostrar-me como funciona, não estou a encontrar nada que me esclareça :/

[M6]

Vê aqui: http://www.mirrorservice.org/sites/www.gnu-pascal.de/gpc/Exit.html

[perez]

Acho que não é bem isso o que eu quero, eu quero, que por acção dum clique em determinada tecla pelo utilizador, o programa pare.

[M6]

perez, tens de ser mais claro e concreto porque por essa descrição vaga não dá para perceber.

[perez]

Ok vou tentar ser mais especifico.

Como podes ver neste algoritmo (encontrei na net) ao clicares "ESC" durante o jogo ele sai, o que eu quero é exactamente isso, que ao clicar numa tecla saia do programa mas sem parar o mesmo à espera que o user clique em algum lado.

Ex:

O programa começa:

se carregar 'esc' sai, se não o programa continua no seu loop infinito, mas sem parar, esperando por alguma acção do user

Algoritmo:

{ -------------------------------------------------------------

   Leonardo Pignataro's TETRIS

   Versão  : 1.01
   Data    : 12 / Abr / 2004

   Autor   : Leonardo Pignataro
   Contato : leopignataro@brturbo.com
    
  ------------------------------------------------------------- }



{ -------------------------------------------------------------
   Funcionamento geral do programa:

   Basicamente, há um grid, que armazena em memória o estado
   das 'casas' do jogo: quais estão preenchidas, e de que cor.
   Este grid é representado na tela, sendo que cada casa ocupa
   dois caracteres consecutivos, sendo eles caracteres #219.

   Há uma peça caindo no grid (tipo T_Object, variavel obj),
   controlada pelo usuário, e também uma outra fixa ao lado do
   grid (mesmo tipo, variavel next) que indica a próxima peça
   a cair no grid. A velocidade de queda está relacionada com
   o level em que está o jogador.

   Todas essas variáveis - grid, obj, next - entre outras,
   são globais e os módulos (procedures e functions) do progra-
   ma fazem acesso direto a elas. Geralmente, evita-se isso,
   passando variáveis como parâmetros, para que se crie módulos
   portáveis. Contudo, a modularização em prática nesse programa
   não visa portabilidade, visto que são módulos totalmente
   específicos, mas apenas simplificar o programa principal.

   NOTA: o sistema de coordenadas utilizado em todo o programa é
   cartesiano, e *não* segue a lógica de matrizes. Isto é, o ponto
   (1,4) significa x=1 e y=4, logo está na 1a coluna, 4a linha.

   - - - X  -->  (4,1) CORRETO
   - - - -       (1,4) ERRADO
   - - - -
   - - - -

------------------------------------------------------------- }



Program tetris;


Uses Crt;


Const

    HEIGHT = 20;    // Altura do grid (área interna, sem contar as bordas)
    WIDTH = 11;     // Largura do grid (área interna, sem contar as bordas)



Type

    T_coordinate = record            // Coordenada cartesiana (x,y)
                     x : integer;
                     y : integer;
                   end;

    T_objgrid = array[1..4, 1..4] of boolean;   // Forma de peças. Constituida por uma array bidimensional
                                                // de 4x4 do tipo boolean. Por exemplo, a forma da peça "L"
                                                // é representada da seguinte maneira:    0 0 1 0
                                                //                                        1 1 1 0
                                                // (0 = FALSE, 1 = TRUE)                  0 0 0 0
                                                //                                        0 0 0 0

    T_grid = record                 // Informações sobre um ponto do grid, se ele está
               status : boolean;    // preenchido ou não (status) e de que cor ele está
               color  : integer;    // preenchido, se for o caso.
             end;

    T_object = record                     // Peças.
                 pos   : T_coordinate;    // posição
                 cell  : T_objgrid;       // formato
                 size  : integer;         // tamanho (ver comentário abaixo)
                 color : integer;         // cor
               end;



{ Quanto ao tamanho das peças, existem peças de 4x4 (size=4) e de 3x3 (size=3). No
   caso das de 4x4, o eixo de rotação é bem no meio da array. Exemplo (retângulo):

         |               |               |               |               |
      0 1 0 0   ->    0 0 0 0   ->    0 0 1 0   ->    0 0 0 0   ->    0 1 0 0
    _ 0 1 0 0 _ ->  _ 1 1 1 1 _ ->  _ 0 0 1 0 _ ->  _ 0 0 0 0 _ ->  _ 0 1 0 0 _
      0 1 0 0   ->    0 0 0 0   ->    0 0 1 0   ->    1 1 1 1   ->    0 1 0 0
      0 1 0 0   ->    0 0 0 0   ->    0 0 1 0   ->    0 0 0 0   ->    0 1 0 0
         |               |               |               |               |

   Já nas peças de 3x3, o eixo de rotação é na célula (2,2). Exemplo ("L"):

        |               |               |               |               |
      0 0 0 x   ->    1 0 0 x         1 1 1 x         0 1 1 x         0 0 0 x
    - 0 0 1 x - ->  - 1 0 0 x - ->  - 1 0 0 x - ->  - 0 0 1 x - ->  - 0 0 1 x -
      1 1 1 x   ->    1 1 0 x   ->    0 0 0 x   ->    0 0 1 x   ->    1 1 1 x
      x x x x   ->    x x x x         x x x x         x x x x         x x x x
        |               |               |               |               |

   Repare que a estrutura utilizada para representar as formas de 4x4 e de 3x3 é a
   mesma, uma array bidimensional de 4x4. Contudo, nas peças de 3x3, existem 7
   células (as da última coluna e as da úllima linha) que são inutilizadas. }



Var

    grid : array[0..WIDTH+1, 0..HEIGHT+1] of T_grid;    // Grid (incluindo bordas)
    obj  : T_object;                                    // Peça caindo no grid
    next : T_object;                                    // Próxima peça (fixa)

    level : integer;               // Nível em que se encontra o jogador
    score : integer;               // Pontuação

    cycle : record
              freq   : integer;    // Intervalo entre decaimentos da peça.
              status : integer;    // Tempo decorrido desde último decaimento.
              step   : integer;    // Tempo entre ciclos de execução. É a cada ciclo o programa
                                   // checa se o usuário pressionou alguma tecla.
            end;                   // (medidas em milisegundos)

    orig      : T_coordinate;    // Origem - posição do canto superior esquerdo do grid na tela.
    gameover  : boolean;         // O jogo acabou?
    quit      : boolean;         // O usuário deseja sair do jogo?

    i, j      : integer;    // Contadores
    c         : char;       // Variavel auxiliar (recebe input)






{ ------------------------------------------------------------------
    Function shock: Verifica se a peça se chocará (se sobreporá a
    alguma parte preenchida do grid) ao mover-se horizontalmente xmov
    unidades e verticalmente ymov unidades.
   ------------------------------------------------------------------ }

Function shock( xmov, ymov : integer ): boolean;

    Var i, j   : integer;
        return : boolean;

    Begin
    gotoxy(1,1);
    return := FALSE;
    for i := 1 to 4 do
        for j := 1 to 4 do
            if (obj.cell[i,j])
                and (obj.pos.x + i + xmov >= 0)
                and (obj.pos.x + i + xmov <= WIDTH+1)
                and (grid[obj.pos.x+i+xmov, obj.pos.y+j+ymov].status)   // esta condição precisa aparecer por último!
                then return := TRUE;
    shock := return;
    End;



{ ------------------------------------------------------------------
    Procedure rotate: Roda a peça no sentido horário, se possível.
   ------------------------------------------------------------------ }

Procedure rotate;

    Var i, j : integer;
        old  : T_objgrid;

    Begin
    for i := 1 to 4 do
        for j := 1 to 4 do
            old[i,j] := obj.cell[i,j];

    for i := 1 to obj.size do
        for j := 1 to obj.size do
            obj.cell[i,j] := old[j,obj.size+1-i];

    if (shock(0,0)) then
        for i := 1 to 4 do
            for j := 1 to 4 do
                obj.cell[i,j] := old[i,j];
    End;



{ ------------------------------------------------------------------
    Procedure consolidate: Prende a peça ao local onde ela se
    encontra. Após isso, a peça perde seu status de peça e passa a
    ser apenas parte do grid. Este procedimento é chamado quando a 
    peça chega ao fundo do grid, ou encontra com outra abaixo dela.
   ------------------------------------------------------------------ }

Procedure consolidate;

    Var i, j : integer;

    Begin
        for i := 1 to 4 do
            for j := 1 to 4 do
                if (obj.cell[i,j]) then
                    begin
                    grid[obj.pos.x+i, obj.pos.y+j].status := TRUE;
                    grid[obj.pos.x+i, obj.pos.y+j].color := obj.color;
                    end;
    End;



{ ------------------------------------------------------------------
    Procedure checklines: Checa se alguma linha do grid foi
    completada. Se sim, apaga o conteudo dela, trazendo todas as
    linhas acima para baixo (as linhas que estão acima da que foi
    completada 'caem'). Também recalcula o score, o level e o
    cycle.freq.
   ------------------------------------------------------------------ }

Procedure checklines;

    Var i, j, down  : integer;
        LineCleared : boolean;

    Begin
    down := 0;

    for j := HEIGHT downto 1 do
        begin
        LineCleared := TRUE;

        for i := 1 to WIDTH do
            if not (grid[i,j].status)
                then LineCleared := FALSE;

        if (LineCleared)
            then
                begin
                down := down + 1;
                score := score + 10;
                end
            else
                for i := 1 to WIDTH do
                    begin
                    grid[i,j+down].status := grid[i,j].status;
                    grid[i,j+down].color := grid[i,j].color;
                    end;
        end;

        level := score div 200;
        cycle.freq := trunc( 500 * exp(level*ln(0.85)) );
        textcolor(YELLOW);
        gotoxy( orig.x + (WIDTH+2)*2 + 18, orig.y + 15 );
        write(level);
        gotoxy( orig.x + (WIDTH+2)*2 + 30, orig.y + 15 );
        write(score);
        End;



{ ------------------------------------------------------------------
    Procedure hideobj: esconde a peça da tela.
   ------------------------------------------------------------------ }

Procedure hideobj( obj : T_object );

    Var i, j : integer;

    Begin
    for i := 1 to 4 do
        for j := 1 to 4 do
            if (obj.cell[i,j]) then
                begin
                gotoxy( orig.x + (obj.pos.x + i) * 2, orig.y + obj.pos.y+j );
                write('  ');
                end;
    gotoxy( orig.x, orig.y );
    End;



{ ------------------------------------------------------------------
    Procedure drawobj: desenha a peça na tela.
   ------------------------------------------------------------------ }

Procedure drawobj( obj : T_object );

    Var i, j : integer;

    Begin
    textcolor(obj.color);
    for i := 1 to 4 do
        for j := 1 to 4 do
            if (obj.cell[i,j]) then
                begin
                gotoxy( orig.x + (obj.pos.x + i) * 2, orig.y + obj.pos.y + j );
                write(#219, #219);
                end;
    gotoxy( orig.x, orig.y );
    End;



{ ------------------------------------------------------------------
    Procedure refresh: redesenha todo o grid na tela.
   ------------------------------------------------------------------ }

Procedure refresh;

    Var i, j : integer;

    Begin
    for i := 0 to WIDTH+1 do
        for j := 0 to HEIGHT+1 do
            begin
            gotoxy( orig.x + 2*i, orig.y + j );
            if (grid[i,j].status)
                then
                    begin
                    textcolor(grid[i,j].color);
                    write(#219, #219);
                    end
                else
                    write('  ');
            end;
    gotoxy( orig.x, orig.y );
    End;



{ ------------------------------------------------------------------
    Procedure createtgt: pega a peça já gerada anteriormente que está
    na caixa "next" (variável next) e a transforma na peça atual.
    Depois, gera nova peça randomicamente, posicionando-a na caixa
    "next".
   ------------------------------------------------------------------ }

Procedure createtgt;

    Var i, j : integer;

    Begin

    hideobj(next);
    obj := next;

    obj.pos.x := WIDTH div 2 - 2;
    obj.pos.y := 0;

    next.pos.x := WIDTH + 4;
    next.pos.y := 6;

    for i := 1 to 4 do
        for j := 1 to 4 do
            next.cell[i,j] := FALSE;

    case random(7) of
        0: begin                    // Quadrado
           next.cell[2,2] := TRUE;
           next.cell[2,3] := TRUE;
           next.cell[3,2] := TRUE;
           next.cell[3,3] := TRUE;
           next.size := 4;
           next.color := WHITE;
           end;
        1: begin                    // Retangulo
           next.cell[2,1] := TRUE;
           next.cell[2,2] := TRUE;
           next.cell[2,3] := TRUE;
           next.cell[2,4] := TRUE;
           next.size := 4;
           next.color := LIGHTRED;
           end;
        2: begin                    // "L"
           next.cell[3,2] := TRUE;
           next.cell[1,3] := TRUE;
           next.cell[2,3] := TRUE;
           next.cell[3,3] := TRUE;
           next.size := 3;
           next.color := LIGHTGREEN;
           end;
        3: begin                    // "L" invertido
           next.cell[1,2] := TRUE;
           next.cell[1,3] := TRUE;
           next.cell[2,3] := TRUE;
           next.cell[3,3] := TRUE;
           next.size := 3;
           next.color := LIGHTBLUE;
           end;
        4: begin                    // "S"
           next.cell[2,2] := TRUE;
           next.cell[2,3] := TRUE;
           next.cell[3,1] := TRUE;
           next.cell[3,2] := TRUE;
           next.size := 4;
           next.color := LIGHTCYAN;
           end;
        5: begin                    // "Z"
           next.cell[2,2] := TRUE;
           next.cell[2,3] := TRUE;
           next.cell[3,3] := TRUE;
           next.cell[3,4] := TRUE;
           next.size := 4;
           next.color := LIGHTMAGENTA;
           end;
        6: begin                    // "T"
           next.cell[1,2] := TRUE;
           next.cell[2,1] := TRUE;
           next.cell[2,2] := TRUE;
           next.cell[2,3] := TRUE;
           next.size := 3;
           next.color := LIGHTGRAY;
           end;
        end;

    drawobj(next);

    End;



{ ------------------------------------------------------------------
    Procedure prninfo: imprime as informações presentes ao lado
    do grid (contorno da caixa "next" e comandos do jogo).
   ------------------------------------------------------------------ }

Procedure prninfo (xpos, ypos: integer);

    Begin

    window( xpos, ypos, 80, 40 );
    clrscr;
    textcolor(WHITE);

    writeln(#218, #196, #196, ' Next ', #196, #196, #191);
    writeln(#179, '          ', #179);
    writeln(#179, '          ', #179);
    writeln(#179, '          ', #179);
    writeln(#179, '          ', #179);
    writeln(#179, '          ', #179);
    writeln(#179, '          ', #179);
    writeln(#192, #196, #196, #196, #196, #196, #196, #196, #196, #196, #196, #217);
    writeln;
    writeln;
    textcolor(YELLOW);
    writeln('       Level: 0    Score: 0');
    textcolor(WHITE);
    writeln;
    writeln;
    writeln('Autor   : Leonardo Pignataro');
    writeln('Contato : secret_doom@hotmail.com');

    window( xpos+17, ypos+1, 80, 40 );
    writeln('Controles:');
    writeln('  Mover : [setas]');
    writeln('  Girar : [space]');
    writeln('  Cair  : [enter]');
    writeln('  Pausa : "P"');
    writeln('  Sair  : [esc]');

    window(1,1,80,40);

    End;



{ ------------------------------------------------------------------
    Procedure prnGameover: imprime mensagem de "game over" ao lado
    do grid.
   ------------------------------------------------------------------ }

Procedure prnGameover (xpos, ypos : integer);

    Begin

    window( xpos, ypos, 80, 40 );
    clrscr;
    textcolor(WHITE);

    writeln;
    writeln;
    writeln('    * * *   FIM DE JOGO  * * *');
    writeln;
    writeln;
    writeln;
    write('Deseja iniciar um ');
    textcolor(LIGHTRED);
    write('N');
    textcolor(WHITE);
    write('ovo jogo ou ');
    textcolor(LIGHTRED);
    write('S');
    textcolor(WHITE);
    write('air?');

    window( 1, 1, 80, 40 );

    End;






{ ------------------------------------------------------------------
                         PROGRAMA PRINCIPAL
   ------------------------------------------------------------------ }

Begin

randomize;

orig.x := 2;
orig.y := 2;

clrscr;
gotoxy( orig.x + (WIDTH+2)*2 + 11, orig.y + 1 );
textcolor(WHITE);
write('> > >  Tetris  < < <');

repeat

    prninfo( orig.x + (WIDTH+2)*2 + 4, orig.y + 5 );

    for i := 0 to WIDTH+1 do              // Preenche todo o grid (inclusive bordas)
        for j := 0 to HEIGHT+1 do
            begin
            grid[i,j].status := TRUE;
            grid[i,j].color := DARKGRAY;
            end;

    for i := 1 to WIDTH do                // Esvazia área interna do grid (deixando apenas
        for j := 1 to HEIGHT do           // as bordas preenchidas)
            grid[i,j].status := FALSE;

    refresh;

    gameover := FALSE;
    quit := FALSE;
    cycle.freq := 500;
    cycle.step := 50;
    cycle.status := 0;
    score := 0;
    createtgt;
    createtgt;
    refresh;

    while not (gameover or quit) do
        begin

        if (keypressed) then    // Se o usuário pressionou uma tecla (keypressed = TRUE),
            begin               // é preciso agir de acordo com o comando correspondente.

            case upcase(readkey) of
                #0: case (readkey) of
                       #75: begin           // seta para esquerda
                            hideobj(obj);
                            if (not shock(-1,0))     // A peça pode mover-se para a esquerda?
                                then obj.pos.x := obj.pos.x - 1;     // Se sim, move-a
                            drawobj(obj);
                            end;
                       #77: begin           // seta para direita
                            hideobj(obj);
                            if (not shock(1,0))      // A peça pode mover-se para a direita?
                                then obj.pos.x := obj.pos.x + 1;     // Se sim, move-a
                            drawobj(obj);
                            end;
                       #80: cycle.status := 0;    // seta para baixo
                            end;
               #13: begin                     // [enter]
                    while (not shock(0,1)) do
                        obj.pos.y := obj.pos.y + 1;
                    cycle.status := 0;
                    end;
               #27: quit := TRUE;   // [esc]
               #32: begin           // espaço
                    hideobj(obj);
                    rotate;
                    drawobj(obj);
                    end;
               'P': begin
                    textbackground(LIGHTGRAY);
                    for i := 1 to WIDTH do
                        for j := 1 to HEIGHT do
                            begin
                            gotoxy( orig.x + 2*i, orig.y + j );
                            write('  ');
                            end;
                    textbackground(BLACK);
                    textcolor(LIGHTGRAY);
                    gotoxy( orig.x + WIDTH - 2, orig.y + HEIGHT div 2 - 1 );
                    write('       ');
                    gotoxy( orig.x + WIDTH - 2, orig.y + HEIGHT div 2 );
                    write(' PAUSE ');
                    gotoxy( orig.x + WIDTH - 2, orig.y + HEIGHT div 2 + 1 );
                    write('       ');
                    gotoxy( orig.x, orig.y );
                    repeat
                        c := upcase(readkey);
                    until (c = 'P') or (c = #27);
                    if (c = #27) then quit := TRUE;
                    refresh;
                    drawobj(obj);
                    end;
               end;
            end;

        if (cycle.status < cycle.step) then    // Já está na hora de fazer um decaimento?
            begin                              // Se sim...
            hideobj(obj);          // esconde peça
            if (shock(0,1))
                then               
                    begin          // Se a peça não pode mover-se para baixo:
                    consolidate;      // ancora a peça
                    checklines;       // checa por linhas completadas
                    refresh;          // redesenha todo o grid
                    createtgt;        // cria nova peça
                    if shock(0,0) then gameover := TRUE;   // caso já não haja espaço no grid para essa nova peça,
                    end                                    // o jogo está acabado
                else               // Se a peça pode mover-se para baixo:
                    obj.pos.y := obj.pos.y + 1;    // move a peça para baixo
            drawobj(obj);          // desenha peça
            end;

        cycle.status := (cycle.status + cycle.step) mod cycle.freq;
        delay(cycle.step);

        end;

    if (quit) then break;

    prnGameover( orig.x + (WIDTH+2)*2 + 4, orig.y + 5 );
    repeat
        c := upcase(readkey);
    until (c = 'N') or (c = 'S');

until (c = 'S');

End.

[M6]

Sair do programa tem apenas um significado: sair do programa e voltar ao sistema operativo.

O que tu queres não é sair do programa é sair de uma rotina, o que é diferente.

Isso podes ver nesse código que está ai.

[perez]

Mas como o algoritmo que eu fiz, nao faz mais nada eu disse sair.

Se eu soubesse não tinha vindo perguntar.

[M6]

No final do ciclo do teu algoritmo o teu programa pede que pressiones uma tecla qualquer e depois termina.

O que querias que fizesse?

[perez]

Não é no final do ciclo, é a meio de um ciclo infinito, ao carregar ele para o ciclo, mas só se carregar, se não continua

[M6]

Então, no teu caso, tens de ler se há alguma tecla carregada e, em caso afirmativo, colocas a true a tua condição de paragem do ciclo, que actualmente é x = 120 e tem de deixar de ser porque actualmente ele faz 120 iterações e para.

[perez]

isso eu até consiguia resolver, o meu problema é como posso ler se alguma tecla é pressionada sem parar o ciclo, porque com readkey ele para até o user clicar

[rjsma]

ve se e isto que queres

repeat
opcao:=readkey;

until(upcase(opcao)='I')or (upcase(opcao)='A') or (upcase(opcao)='L') or (upcase(opcao)='C') or (upcase(opcao)='S');

desenha_menu:=upcase(opcao);
end;


Begin
clrscr;
assign(ficheiro,'aluno.dat');
repeat
opcao:=desenha_menu;
clrscr;
case opcao of
'v':vendas;
'F':Funcionarios;
'e':stock;
'D':Receitas;
'D':Despesas;
'A':altera;
'L':listar;
'C':consulta;
end;
until opcao='S';
end.

[perez]

Obrigado a todos, já consegui resolver a situação