{**********************************************************************}
{* La Vida por un Barco 02/06/06 *}
{* Gracias: *}
{* a foros.solocodigo.com *}
{* a Enko (moderador del foro Pascal), por las ayudas. *}
{* a mi Amor Estela, por hacerme el aguante. *}
{* *}
{* Dise¤ado por: *}
{* Gustavo Insaurralde *}
{* tavo.guanako@gmail.com *}
{* www.anaprog.com.ar *}
{**********************************************************************}
Program lifeXship;
uses crt;
const
m=10;
NADA = 0;
TIBURON = 1;
BARCO = 2;
var
Mar: array[1..m,1..m] of integer;
CasillasDescubiertas: array[1..m,1..m] of Boolean;
vic,i,j: Integer;
op:string;
procedure Init;
var
i,j,p,q: integer;
begin
for i:=1 to m do
for J:=1 to m do
Mar[i,j] := NADA;
for i:=1 to m do
Mar[i,1] := TIBURON;
for i:=1 to 10 do
Mar[i,2] := BARCO;
end;
{Intercambia dos variables}
procedure Intercambiar(var A,B: Integer);
var
C: Integer;
begin
C := A;
A := B;
B := C;
end;
{esto mezcla los campos y los desordena, de manera que uno se asegura que
hay 10 tiburones y 10 barcos}
procedure Mezclar;
var
i,j, nI, nJ: integer;
begin
Randomize;
for i:=1 to m do
for J:=1 to m do
begin
nI := RAndom(10)+1;
nJ := RAndom(10)+1;
Intercambiar(Mar[i,j], Mar[nI,nJ]);
end;
end;
procedure limpiar; {limpiar la jugada escrita}
begin
readkey;
gotoxy(10,14);
clreol;
end;
procedure ImprimirMar; {graficar la matriz de * y ponerle true}
var
i,j: Integer;
begin
gotoxy(20,2);
for i:=1 to m do
begin
for j:=1 to m do
begin
CasillasDescubiertas[i,j]:=true;
Write(' *':3);
end;
writeln;
gotoxy(20,2+i);
end;
end;
procedure limpiartodo; {cuando termina el juego}
var i:integer;
begin
for i:=20 downto 1 do
begin
gotoxy(1,i);
clreol;
end;
end;
procedure mover;
var
i,j,bar,tib,c: integer;
g:char;
Begin
tib:=0;
bar:=0;
While (tib<3) and (bar<3) do
Begin
Gotoxy(14,14);
write('Digite el numero de columna en que desee moverse: ');
readln(i);
Gotoxy(1,14);
clreol;
gotoxy(14,14);
clreol;
write('Digite el numero de fila en que desee moverse: ');
read(j);
Gotoxy(1,14);
clreol;
if (CasillasDescubiertas[i,j]=true) then
begin
gotoxy(29,15);
case Mar[i,j] of
0:begin
Writeln('Estas en el Agua');
CasillasDescubiertas[i,j]:=false;
limpiar;
end;
1: begin
Writeln('Hallaste un Barco!');
bar:=bar+1;
CasillasDescubiertas[i,j]:=false;
limpiar;
Gotoxy(63,2);
write(bar);
end;
2: begin
Writeln('Te ha mordido un Tiburon');
tib:=tib+1;
CasillasDescubiertas[i,j]:=false;
limpiar;
gotoxy(72,2);
write(tib);
end;
end;
end
else
begin
textcolor(lightgreen+blink);
gotoxy(15,16);
Writeln('Esa jugada ya fue realizada (Columna:',i,'-Fila:',j,')');
readkey;
gotoxy(12,16);
clreol;
normvideo;
end;
begin {grafica la jugada "procedure pq no?"}
gotoxy(21,2);
gotoxy(19+i*2+i,1+j);
case Mar[i,j] of
0:begin
g:='A';
textcolor(lightblue);
write(g);
normvideo;
end;
1:begin
g:='B';
textcolor(brown);
write(g);
normvideo;
sound(300);
delay(200);
sound(400);
delay(200);
nosound;
end;
2:begin
g:='T';
textcolor(lightred);
write(g);
normvideo;
sound(90);
delay(300);
sound(85);
delay(300);
nosound;
end;
end;
gotoxy(1,14);
end;
gotoxy(1,30);
for c:=30 downto 13 do
begin
clreol;
gotoxy(1,c);
clreol;
end;
end;
limpiartodo;
gotoxy(30,13);
Writeln('Fin del Juego!');
if tib=3 then
begin
gotoxy(20,14);
textcolor(lightred);
Write('Perdiste. Te han mordido 3 Tiburones.');
vic:=1;
end
else
begin
gotoxy(20,14);
textcolor(red+blink);
Writeln('Ganaste!! Has encontrado los 3 Botes!!!');
end;
normvideo;
gotoxy(65,18);
textcolor(lightblue);
Write('Isoft¸');
normvideo;
textcolor(lightgreen);
gotoxy(59,19);
Write('Powered by Unicyber.');
normvideo;
end;
Procedure sonido;
Begin
for i:=1 to 1 do
begin
for j:=1 to 3 do
begin
sound(200);
Delay(200);
sound(200);
delay(200);
NoSound;
end;
sound(300);delay(200);sound(250);delay(180);sound(200);delay(500);
nosound;
end;
end;
Procedure Sonidoper;
begin
for i:=1 to 2 do
begin
sound(500);
delay(150);
sound(280);
delay(150);
nosound;
sound(150);
delay(500);
nosound;
end;
end;
Procedure sonidogan;
begin
for i:=1 to 2 do
begin
sound(600);
delay(150);
sound(480);
delay(150);
nosound;
end;
sound(600);
delay(500);
nosound;
end;
Procedure Puntos;
Begin
for i:=1 to 3 do
begin
gotoxy(59,0+i);
Write('³');
gotoxy(77,4-i);
Write('³');
gotoxy(67,4-i);
Write('');
end;
for i:=1 to 17 do
begin
gotoxy(59+i,3);
write('_');
end;
gotoxy(61,1);
textcolor(brown);
Write('Botes');
normvideo;
gotoxy(68,1);
textcolor(red);
Write('Tiburones');
normvideo;
gotoxy(72,2);
Write('0');
gotoxy(63,2);
Write('0');
end;
Procedure intro;
Begin {presentacion}
clrscr;
gotoxy(32,10);
textcolor(lightblue);
Writeln('Isoft Games ¸');
normvideo;
gotoxy(34,11);
Writeln('presenta');
delay(2000);
gotoxy(34,11);
clreol;
gotoxy(28,10);
clreol;
textcolor(lightred);
Write('La Vida Por un Barco!!!');
normvideo;
delay(2500);
gotoxy(1,10);
clreol;
Writeln('Un buen d¡a se te ocurre ir de vacaciones a Miami.');
Writeln('Y cuando llegas, tienes ganas de ir al a nadar al mar.');
Writeln('Te vas a nadar al mar... muy relajado...');
Writeln('Cuando de repente... estas rodeado de tiburones!!!');
Writeln(' ');
Writeln('Debes encontrar 3 barcos!');
Writeln('Si te muerden 3 tiburones... pierdes.');
Writeln('Suerte!');
Writeln(' ');
Writeln(' ');
Write('Presiona una tecla para continuar...');
readkey;
for i:=100 downto 1 do
begin
gotoxy(1,i);
clreol;
end;
end;
Procedure Refer; {Imprime referencia de filas y Columnas}
begin
gotoxy(20,1);
textcolor(green);
for i:=1 to m do
begin
Write(' ',i:2);
end;
normvideo;
gotoxy(18,2);
textcolor(magenta);
for i:=1 to m do
begin
Writeln(i);
gotoxy(18,2+i);
end;
normvideo;
end;
Procedure descubrir;
var g:char;
begin
gotoxy(21,2);
for i:=1 to m do
for j:=1 to m do
begin
gotoxy(19+i*2+i,j+1);
case Mar[i,j] of
0:
begin
g:='A';
if CasillasDescubiertas[i,j]=true then {grafica en amarillo si/}
textcolor(yellow) {fue jugada la posicion}
else
textcolor(lightblue);
Write(g);
end;
1:
begin
g:='T';
if CasillasDescubiertas[i,j]=true then {idem anterior}
textcolor(yellow)
else
textcolor(lightred);
Write(g);
end;
2:
begin
g:='B';
if CasillasDescubiertas[i,j]=true then {idem anterior}
textcolor(yellow)
else
textcolor(brown);
Write(g);
end;
end;
normvideo;
end;
end;
Begin {START}
ClrScr;
intro;
Init;
Mezclar;
Refer;
imprimirmar;
puntos;
mover;
descubrir;
if vic=1 then
sonidoper
else
sonidogan;
Readkey;
end.
----------------------