[Resolvido]Sair a meio do programa

perez · December 13, 2009 at 11:00 PM

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 · December 14, 2009 at 09:56 AM

Sim existe.

Vê a função Exit.

perez · December 14, 2009 at 06:47 PM

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

M6 · December 15, 2009 at 10:07 AM

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

perez · December 15, 2009 at 07:41 PM

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 · December 16, 2009 at 09:32 AM

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

perez · December 16, 2009 at 04:23 PM

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 · December 16, 2009 at 04:43 PM

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 · December 16, 2009 at 05:16 PM

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

Se eu soubesse não tinha vindo perguntar.

M6 · December 16, 2009 at 05:42 PM

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 · December 16, 2009 at 05:46 PM

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 · December 16, 2009 at 05:56 PM

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 · December 16, 2009 at 06:13 PM

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 · December 16, 2009 at 06:22 PM

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 · December 16, 2009 at 07:14 PM

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

[Resolvido]Sair a meio do programa

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Create an account or sign in to comment

Create an account

Sign in

Important Information