perez Posted December 13, 2009 at 11:00 PM Report #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
M6 Posted December 14, 2009 at 09:56 AM Report #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."
perez Posted December 14, 2009 at 06:47 PM Author Report #300378 Posted December 14, 2009 at 06:47 PM podes mostrar-me como funciona, não estou a encontrar nada que me esclareça :/
M6 Posted December 15, 2009 at 10:07 AM Report #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."
perez Posted December 15, 2009 at 07:41 PM Author Report #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.
M6 Posted December 16, 2009 at 09:32 AM Report #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."
perez Posted December 16, 2009 at 04:23 PM Author Report #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.
M6 Posted December 16, 2009 at 04:43 PM Report #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."
perez Posted December 16, 2009 at 05:16 PM Author Report #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.
M6 Posted December 16, 2009 at 05:42 PM Report #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."
perez Posted December 16, 2009 at 05:46 PM Author Report #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
M6 Posted December 16, 2009 at 05:56 PM Report #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."
perez Posted December 16, 2009 at 06:13 PM Author Report #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
rjsma Posted December 16, 2009 at 06:22 PM Report #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.
perez Posted December 16, 2009 at 07:14 PM Author Report #300820 Posted December 16, 2009 at 07:14 PM Obrigado a todos, já consegui resolver a situação
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