gioco della battaglia navale in pascal

program navalwar; { AndRyu }
uses crt;
const max=8;
type dati=record
nome: string[10]; { livello difficolt…, colpi effettuati }
lv,colp,ncol,nsub: byte; { navi colpite e subite }
point: integer; { punteggio }
baro: char; { baro (s/n) }
end;
dimens=1..max;
cel=array[dimens,dimens] of char;
info=array[dimens] of dati;
cell=^cel; { le varie tavole: }
var avvcolp,avvocc,mytab:cell; { colpite, occupate e la propria }
ap:byte; { var di appoggio }
pr:char; { var globale per la lettura dei tasti }
vero:boolean; { usata per il posizionamento navi }
inf:dati;
vet:^info;
fil:file of info;
procedure esc; { chiusura puntatori e arresto del programma, se esc }
begin
if pr=#27 then
begin
dispose(vet);
dispose(avvocc);
dispose(avvcolp);
if inf.lv<>0 then
dispose(mytab);
textcolor(15);
textbackground(0);
halt
end
else
if pr=#0 then
pr:=readkey
end;
procedure iniz(var x:cell); { inizializzazione puntatori }
var i,j:dimens;
begin
new(x);
for i:=1 to max do
for j:=1 to max do
x^[i,j]:=#126
end;
procedure error;
begin
sound(264);
delay(200);
nosound;
end;
procedure inizpunti;
var i:integer;
begin
assign(fil,'scores.txt');
new(vet);
{$I-}
reset(fil);
{$I+}
if ioresult<>0 then
begin
rewrite(fil);
with vet^[1] do
begin
nome:='Nobody ';
ncol:=0;
nsub:=0;
point:=1000;
lv:=12;
colp:=0;
baro:='n'
end;
for i:=2 to max do
vet^[i]:=vet^[1];
write(fil,vet^)
end
else
read(fil,vet^);
close(fil)
end;
procedure askinfo;
var i:byte;
begin
ap:=1;
inf.nome:=' ';
clrscr;
write('Inserisci il tuo nome (max 10 caratteri): ');
for i:=1 to 10 do { non permette l'inserimento di + di 10 caratteri }
if inf.nome[i]=' ' then { quasi inutile, se non per mia soddisfazione}
i:=10
else
write(inf.nome[i]);
repeat
pr:=readkey;
esc;
if (pr=#13) and not (ap=1) then { invio }
ap:=10
else
if (pr=#8) and not (ap=1) then { cancellazione }
begin
ap:=ap-1;
inf.nome[ap]:=' ';
write(pr,' ',pr)
end
else
if (ap<10)>#8) and (pr<>#13) then
begin { scrittura se corretto }
write(pr);
inf.nome[ap]:=pr;
ap:=ap+1
end
until pr=#13;
writeln; writeln;
write('Che livello di difficolta'' vuoi? (1=facile,2=medio,3=difficile) ');
repeat
pr:=readkey;
esc
until (pr>'0') and (pr<'4'); inf.lv:=12-(ord(pr)-ord('0'))*3 end; procedure color(c:char); { controllo del colore } begin case c of '*':textcolor(red); 'þ':textcolor(8); 'o':textcolor(3); '~':textcolor(lightblue); end; end; procedure tab(av,my:cell); var i,j:integer; procedure orizz; { trattini orizzontali} var i:integer; begin for i:=1 to 2*max+1 do write(' Ä'); for i:=1 to max do write(' '); for i:=1 to 2*max+1 do write(' Ä'); writeln end; begin {Procedura Tabella} clrscr; textcolor(green); writeln('BATTAGLIA NAVALE':48); { questi allineamenti sono fatti } textcolor(6); { apposta per il mio monitor, Š } write('Flotta Avversaria':27); { possibile che dovrete cambiarli } textcolor(5); { provate a fare dei tentativi ;) } write('Propria Flotta':40); textcolor(yellow); writeln; write(' '); for i:=1 to max do write(' ',i); write(' '); for i:=1 to max do write(' '); for i:=1 to max do write(' ',i); write(' '); writeln; textcolor(white); orizz; for i:=1 to max do begin textcolor(blue); write(i); textcolor(white); write(' '); for j:=1 to max do begin color(av^[j,i]); write(av^[j,i]); textcolor(white); write(' '); end; for j:=1 to 6 do write(' '); textcolor(blue); write(i); textcolor(white); write(' '); for j:=1 to max do begin color(my^[j,i]); write(my^[j,i]); textcolor(white); write(' '); end; writeln end; orizz; gotoxy(2,25); textcolor(10); write('ESC'); textcolor(8); write('i'); textcolor(15); gotoxy(1,14) end; procedure baro; { se si mostra la soluzione } begin clrscr; write('Sei un baro? (s/n) '); repeat pr:=readkey; esc until (pr='s') or (pr='n') or (pr='S') or (pr='N'); inf.baro:=pr; if (pr='s') or (pr='S') then begin tab(avvocc,mytab); pr:=readkey; end; esc end; procedure pos(var c:cell;var app,ri,co,l:byte;ori:char); begin { stabilisce le posizioni } if (app=0) and (((max-ri+11))) then
vero:=false;
if (c^[ri,co]<>'þ') and vero then
begin
if ord(ori)=1 then
ri:=ri+1
else
co:=co+1;
app:=app+1;
if app'r') and (pr<>'R') then
repeat
gotoxy(55,16);
if ori=#0 then
write('Verticale ')
else
write('Orizzontale');
pr:=readkey;
esc;
case pr of
#77: ori:=chr(1);
#80: ori:=#0;
end
until (pr=#13) or (pr='r') or (pr='R');
vero:=true;
ap:=0;
pos(mytab,ap,i,j,l,ori);
if (not vero) and (pr<>'r') and (pr<>'R') then
error;
t:=t+ap
until (t=2) or (t=6) or(t=8) or (t=5) or (pr='r') or (pr='R');
if (pr='r') or (pr='R') then
l:=5
end
until (pr<>'r') and (pr<>'R') { permette di resettare le navi }
end;
procedure navi(var c:cell); { assegna le posizioni dell'avversario }
var i,j,t,k,ap:byte;
begin
randomize;
for k:=2 to 5 do
begin
t:=0;
repeat
ap:=0;
vero:=true;
i:=random(max)+1;
j:=random(max)+1;
pr:=chr(random(2));
pos(c,ap,i,j,k,pr);
t:=t+ap
until (t=2) or (t=6) or (t=5) or (t=8);
end
end;
procedure points;
var i:byte;
begin
clrscr;
textcolor(10);
writeln('HighScores':44);
writeln;
textcolor(8);
writeln('Navi distrutte':64);
textcolor(15);
writeln('Posto','Nome':7,'Livello':12,'Baro':9,'Colpi':10,'Avversarie':14,
'Proprie':10,'Punteggio':12); writeln;
for i:=1 to max do
with vet^[i] do
begin
textcolor(1+i mod 4);
writeln(i:3,nome:15,(12-lv)div 3:3,baro:10,colp:10,ncol:11,nsub:12,point:12)
end;
textcolor(15);
gotoxy(2,25);
textcolor(4); write('CANC'); textcolor(8); write('ella'); textcolor(15);
gotoxy(1,15);
pr:=readkey;
esc;
if pr=#83 then
begin
write('Sei sicuro di voler cancellare i punteggi? (s/n) ');
repeat
pr:=readkey;
esc
until (pr='s') or (pr='n') or (pr='S') or (pr='N');
if (pr='s') or (pr='S') then
begin
erase(fil);
inizpunti
end
end
end;
procedure gioco; { quale settore bombardare e dove vieni bombardato }
const x=1; y=4;
var i,j:byte;
procedure colrig(var n:integer; sogg:string); { Richiesta Colonna/Riga }
begin
write(sogg);
repeat
pr:=readkey;
esc
until (pr>'0') and (pr<'9'); n:=ord(pr)-ord('0'); writeln(n) end; function perso:boolean; { controllo Perdita } var i,j:byte; begin perso:=true; inf.nsub:=0; for i:=1 to max do for j:=1 to max do if mytab^[i,j]='þ' then perso:=false else if mytab^[i,j]='*' then inf.nsub:=inf.nsub+1 end; function vinto:boolean; { controllo Vittoria } var i,j:byte; begin vinto:=true; inf.ncol:=0; for i:=1 to max do for j:=1 to max do if (avvocc^[i,j]='þ') and (avvcolp^[i,j]<>'*') then
vinto:=false
else
if avvcolp^[i,j]='*' then
inf.ncol:=inf.ncol+1
end;
procedure colpito(a,b:integer); {Sottoprocedura di controllo Colpito}
begin
if avvocc^[a,b]='þ' then
begin
avvcolp^[a,b]:='*';
write('Hai colpito una nave!');
end
else
begin
avvcolp^[a,b]:='o';
write('Hai fatto un buco nell''acqua!');
end
end;
procedure pcatk(c:byte); { attacco del pc }
var i,j:byte;
begin
repeat
i:=random(max)+1;
j:=random(max)+1;
if (mytab^[i,j]<>'*') and (mytab^[i,j]<>'o') then
if mytab^[i,j]='þ' then
begin
mytab^[i,j]:='*';
writeln('Il tuo avversario spara in (',i,',',j,')');
write('Sei stato colpito!');
pr:='o'
end
else
if c mod inf.lv<>0 then
begin
mytab^[i,j]:='o';
writeln('Il tuo avversario spara in (',i,',',j,')');
write('Ha fatto un buco nell''acqua!');
pr:='o'
end
until pr='o';
pr:=readkey;
esc
end;
function addpoints:boolean; { aggiunge il punteggio }
var i:byte;
procedure scambia(var a,b:dati);
var x:dati;
begin
x:=a;
a:=b;
b:=x
end;
begin { addpoints }
with inf do
begin
if (baro='s') or (baro='S') then
i:=2
else
i:=1;
if ncol>nsub then
ap:=255 { bonus di vittoria }
else
ap:=0;
point:=(ncol*lv*100)div i - (colp+nsub)*10+ap
end;
if inf.point>vet^[5].point then
begin
addpoints:=true;
vet^[5]:=inf;
for i:=4 downto 1 do
if vet^[i+1].point>vet^[i].point then
scambia(vet^[i],vet^[i+1]);
reset(fil);
write(fil,vet^);
close(fil)
end
else
addpoints:=false
end;
begin { procedura gioco }
inf.colp:=0;
i:=1;
j:=1;
repeat
repeat
tab(avvcolp,mytab);
writeln;
writeln('Su quali coordinate vuoi sparare? Colpi effettuati=',inf.colp);
repeat
gotoxy(55,15);
write('(',i,',',j,')');
move(avvcolp,x,y,i,j)
until pr=#13;
gotoxy(1,17);
if (avvcolp^[i,j]='o') or (avvcolp^[i,j]='*') then
begin
writeln('Hai gi… colpito questa cella!');
error;
pr:=readkey;
pr:=#0
end
else
begin
colpito(i,j);
pr:=#1;
inf.colp:=inf.colp+1
end;
until pr=#1;
pr:=readkey;
esc;
writeln; writeln;
if vinto then
pr:=#0
else
pcatk(inf.colp)
until perso or (pr=#0);
writeln;
if pr=#0 then
writeln('Hai vinto!! Hai effettuato ',inf.colp,' spari.')
else
begin
writeln('Hai perso!! Hai effettuato ben ',inf.colp,' spari.');
writeln;
write('Premi un tasto per vedere la soluzione.');
pr:=readkey;
esc;
tab(avvocc,mytab)
end;
writeln;
if addpoints then
writeln('Aggiunto il tuo punteggio alla classifica')
else
writeln('Non sei entrato in classifica');
pr:=readkey;
esc
end;
begin { ---->>> Main <<<---- } repeat inizpunti; iniz(avvocc); iniz(avvcolp); repeat textcolor(15); textbackground(0); clrscr; writeln('Premi:'); writeln; writeln('> 1 <<-- per giocare'); writeln('> 2 <<-- per vedere i punteggi'); writeln('>esc<<-- per uscire'); writeln; pr:=readkey; esc; if pr='2' then points until pr='1'; askinfo; navi(avvocc); mynav; baro; gioco until pr=#27; end.

il programma è da testare e mi è stato mandato da un amico!!!!