Código fuente de un clon del juego Pong desarrollado en Pascal.
Controles
- W: Jugador 1 arriba.
- S: Jugador 1 abajo.
- Flecha arriba: Jugador 2 arriba.
- Flecha abajo: Jugador 2 abajo.
- Escape: Salir del juego.
{ Pascal YAPong - Yet Another Pong clone https://kodrs.com/ version 1.0 Provided as is, with no warranty, etc. License is granted to use, copy, modify, just credit to me and don't blame me if it doesn't work. } Uses crt, graph; const teclaArriba : char = #$48; teclaAbajo : char = #$50; teclaW : char = 'W'; teclaS : char = 'S'; teclaEsc : char = #27; teclaEnter : char = #13; type pelota = Record X, Y, DX, DY : integer; Col : byte; End; barra = Record X1, Y1, X2, Y2 : integer; Col : byte; End; var LaPelota : pelota; barraIzq : barra; barraDer : barra; Cerrar : boolean; p1 : byte; p2 : byte; procedure IniciaGraficos; var gn,gd: integer; begin gd:=detect; initgraph(gd,gn,'c:\tp\bgi'); end; procedure Sonido(hertz, duracion : word); begin sound(hertz); delay(duracion); nosound; end; procedure PintaPelota(Col : Byte); begin setfillstyle(1, Col); setcolor(Col); fillellipse(LaPelota.X, LaPelota.Y,5,5); end; procedure MuevePelota; begin PintaPelota(0); LaPelota.X := LaPelota.X + LaPelota.DX; LaPelota.Y := LaPelota.Y + LaPelota.DY; if (LaPelota.X > barraDer.X1-6) then begin if (LaPelota.Y>barraDer.Y1-6) and (LaPelota.Y<barraDer.Y2+6) then begin LaPelota.X := barraDer.X1-6; Sonido(2000, 5); LaPelota.DX := LaPelota.DX * -1; end else begin Sonido(100, 50); LaPelota.X := barraIzq.X2+10; LaPelota.DY := LaPelota.DY*-1; p1 := p1 + 1; end; end; if (LaPelota.X < barraIzq.X2+6) then begin if (LaPelota.Y>barraIzq.Y1-6) and (LaPelota.Y<barraIzq.Y2+6) then begin LaPelota.X := barraIzq.X2+6; Sonido(2000, 5); LaPelota.DX := LaPelota.DX * -1; end else begin Sonido(100, 50); LaPelota.X := barraDer.X1-10; LaPelota.DY := LaPelota.DY*-1; p2 := p2 + 1; end; end; if LaPelota.Y > 468 then begin LaPelota.Y := 467; Sonido(1000, 5); LaPelota.DY := LaPelota.DY * -1; end; if LaPelota.Y < 61 then begin LaPelota.Y := 62; Sonido(1000, 5); LaPelota.DY := LaPelota.DY * -1; end; PintaPelota(LaPelota.Col); end; procedure PintaBarra(Col, Tipo : Byte); begin setfillstyle(1, Col); setcolor(Col); if (Tipo=1) then begin bar(barraIzq.X1,barraIzq.Y1,barraIzq.X2,barraIzq.Y2); end else begin bar(barraDer.X1,barraDer.Y1,barraDer.X2,barraDer.Y2); end; end; procedure MueveBarra(arriba:boolean; Tipo:byte); var color:byte; begin PintaBarra(0,Tipo); if (arriba=True) then begin if (Tipo=1) then begin barraIzq.Y1 := barraIzq.Y1 - 25; barraIzq.Y2 := barraIzq.Y2 - 25; end else begin barraDer.Y1 := barraDer.Y1 - 25; barraDer.Y2 := barraDer.Y2 - 25; end; end else begin if (Tipo=1) then begin barraIzq.Y1 := barraIzq.Y1 + 25; barraIzq.Y2 := barraIzq.Y2 + 25; end else begin barraDer.Y1 := barraDer.Y1 + 25; barraDer.Y2 := barraDer.Y2 + 25; end; end; if (Tipo=1) then begin if (barraIzq.Y1<60) then begin barraIzq.Y1:=61; barraIzq.Y2:=111; end; if (barraIzq.Y2>470) then begin barraIzq.Y1:=420; barraIzq.Y2:=470; end; end else begin if (barraDer.Y1<60) then begin barraDer.Y1:=61; barraDer.Y2:=111; end; if (barraDer.Y2>470) then begin barraDer.Y1:=420; barraDer.Y2:=470; end; end; if (Tipo=1) then begin color:=barraIzq.Col; end else begin color:=barraDer.Col; end; PintaBarra(color,Tipo); end; procedure Inicializa; begin cleardevice; setfillstyle(1,15); bar(0,50,639,55); bar(0,474,639,479); Randomize; p1 := 0; p2 := 0; settextstyle(0,0,2); outtextxy(235,18, 'P1'); outtextxy(375,18, 'P2'); rectangle(270,10,320,40); rectangle(321,10,371,40); LaPelota.X := 150 + Random(20); LaPelota.Y := 100; LaPelota.Col := 15; LaPelota.DX := 1; LaPelota.DY := -1; barraIzq.X1 := 1; barraIzq.X2 := 6; barraIzq.Y1 := 215; barraIzq.Y2 := 265; barraIzq.Col := 15; barraDer.X1 := 633; barraDer.X2 := 638; barraDer.Y1 := 215; barraDer.Y2 := 265; barraDer.Col := 15; PintaBarra(barraIzq.Col, 1); PintaBarra(barraDer.Col, 2); PintaPelota(LaPelota.Col); end; procedure LeeTeclado; var Ch : Char; begin if KeyPressed Then begin Ch := UpCase(ReadKey); if (Ch=teclaEsc) then begin Cerrar:=True; end; if (Ch=teclaW) then begin MueveBarra(True,1); end; if (Ch=teclaS) then begin MueveBarra(False,1); end; if (Ch=teclaArriba) then begin MueveBarra(True,2); end; if (Ch=teclaAbajo) then begin MueveBarra(False,2); end; end; end; procedure Marcador; var marc : string; begin setfillstyle(1,0); bar(290,18,305,32); str(p1,marc); outtextxy(290,18,marc); bar(340,18,355,32); str(p2,marc); outtextxy(340,18,marc); end; procedure fin(jugador:string); var ch:char; begin setfillstyle(1,8); bar(240,220,415,270); setfillstyle(1,15); bar(235,215,410,265); setcolor(0); outtextxy(245,230,jugador); outtextxy(275,230,' ganador'); repeat Ch := UpCase(ReadKey); if (Ch=teclaEnter) then begin Cerrar:=True; end; until(Cerrar=True); end; procedure Juega; var i : integer; begin repeat MuevePelota; Delay(3); for i:=1 to 25 do LeeTeclado; Marcador; if (p1=7) then begin fin('p1'); end; if (p2=7) then begin fin('p2'); end; until Cerrar = true; end; begin IniciaGraficos; Inicializa; Juega; textmode(2); End. |