perez Posted December 13, 2009 at 11:00 PM Report Share #300224 Posted 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 Link to comment Share on other sites More sharing options...
M6 Posted December 14, 2009 at 09:56 AM Report Share #300257 Posted December 14, 2009 at 09:56 AM Sim existe. Vê a função Exit. 10 REM Generation 48K! 20 INPUT "URL:", A$ 30 IF A$(1 TO 4) = "HTTP" THEN PRINT "400 Bad Request": GOTO 50 40 PRINT "404 Not Found" 50 PRINT "./M6 @ Portugal a Programar." Link to comment Share on other sites More sharing options...
perez Posted December 14, 2009 at 06:47 PM Author Report Share #300378 Posted December 14, 2009 at 06:47 PM podes mostrar-me como funciona, não estou a encontrar nada que me esclareça :/ Link to comment Share on other sites More sharing options...
M6 Posted December 15, 2009 at 10:07 AM Report Share #300456 Posted December 15, 2009 at 10:07 AM Vê aqui: http://www.mirrorservice.org/sites/www.gnu-pascal.de/gpc/Exit.html 10 REM Generation 48K! 20 INPUT "URL:", A$ 30 IF A$(1 TO 4) = "HTTP" THEN PRINT "400 Bad Request": GOTO 50 40 PRINT "404 Not Found" 50 PRINT "./M6 @ Portugal a Programar." Link to comment Share on other sites More sharing options...
perez Posted December 15, 2009 at 07:41 PM Author Report Share #300556 Posted 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. Link to comment Share on other sites More sharing options...
M6 Posted December 16, 2009 at 09:32 AM Report Share #300660 Posted 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. 10 REM Generation 48K! 20 INPUT "URL:", A$ 30 IF A$(1 TO 4) = "HTTP" THEN PRINT "400 Bad Request": GOTO 50 40 PRINT "404 Not Found" 50 PRINT "./M6 @ Portugal a Programar." Link to comment Share on other sites More sharing options...
perez Posted December 16, 2009 at 04:23 PM Author Report Share #300760 Posted 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. Link to comment Share on other sites More sharing options...
M6 Posted December 16, 2009 at 04:43 PM Report Share #300768 Posted 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. 10 REM Generation 48K! 20 INPUT "URL:", A$ 30 IF A$(1 TO 4) = "HTTP" THEN PRINT "400 Bad Request": GOTO 50 40 PRINT "404 Not Found" 50 PRINT "./M6 @ Portugal a Programar." Link to comment Share on other sites More sharing options...
perez Posted December 16, 2009 at 05:16 PM Author Report Share #300782 Posted 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. Link to comment Share on other sites More sharing options...
M6 Posted December 16, 2009 at 05:42 PM Report Share #300787 Posted 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? 10 REM Generation 48K! 20 INPUT "URL:", A$ 30 IF A$(1 TO 4) = "HTTP" THEN PRINT "400 Bad Request": GOTO 50 40 PRINT "404 Not Found" 50 PRINT "./M6 @ Portugal a Programar." Link to comment Share on other sites More sharing options...
perez Posted December 16, 2009 at 05:46 PM Author Report Share #300789 Posted 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 Link to comment Share on other sites More sharing options...
M6 Posted December 16, 2009 at 05:56 PM Report Share #300794 Posted 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. 10 REM Generation 48K! 20 INPUT "URL:", A$ 30 IF A$(1 TO 4) = "HTTP" THEN PRINT "400 Bad Request": GOTO 50 40 PRINT "404 Not Found" 50 PRINT "./M6 @ Portugal a Programar." Link to comment Share on other sites More sharing options...
perez Posted December 16, 2009 at 06:13 PM Author Report Share #300799 Posted 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 Link to comment Share on other sites More sharing options...
rjsma Posted December 16, 2009 at 06:22 PM Report Share #300803 Posted 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. Link to comment Share on other sites More sharing options...
perez Posted December 16, 2009 at 07:14 PM Author Report Share #300820 Posted December 16, 2009 at 07:14 PM Obrigado a todos, já consegui resolver a situação Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now