|
program navalwar; { AndRyu } uses crt; const max=8; type dimens=1..max; cel=array[dimens,dimens] of char; cell=^cel; { le varie tavole: } var avvcolp,avvocc,mytab:cell; { colpite, occupate e la propria } lv,ap:byte; { livello difficolt… e var di appoggio } pr:char; { var globale per la lettura dei tasti } vero:boolean; { usata per il posizionamento navi } procedure esc; { chiusura puntatori e arresto del programma, se premi esc } begin if pr=#27 then begin dispose(avvocc); dispose(avvcolp); if 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 diff; begin textcolor(15); textbackground(0); clrscr; write('Che livello di difficolta'' vuoi? (1=facile,2=medio,3=difficile) '); repeat pr:=readkey; esc until (pr>'0') and (pr<'4'); lv:=12-(ord(pr)-ord('0'))*3 end; procedure color(c:char); { controllo del colore } begin case c of '*','#':textcolor(red); '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); { probabile 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); write('ESCi'); 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'); 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+1<l) and (ord(ori)=1)) or ((max-co+1<l) and (ord(ori)<>1))) 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<l then pos(c,app,ri,co,l,ori); if ord(ori)=1 then ri:=ri-1 else co:=co-1; if vero then c^[ri,co]:='#' end else begin vero:=false; app:=0 end end; procedure move(tab:cell; x,y:byte;var i,j:byte); var c:byte; begin repeat c:=c+1; if c mod 2=0 then c:=0 else c:=9; color(tab^[i,j]); textbackground(c); gotoxy(x+i*4,y+j); write(tab^[i,j]); gotoxy(x+i*4,y+j); delay(200) until keypressed; pr:=readkey; esc; textbackground(0); write(tab^[i,j]); case pr of #72: j:=j-1; #75: i:=i-1; #77: i:=i+1; #80: j:=j+1; end; case i of 9: i:=1; 0: i:=8 else case j of 9: j:=1; 0: j:=8 end end; textcolor(15) end; procedure mynav; { Posiziona le proprie navi } const x=43; y=4; var i,j,c,t,l:byte; ori:char; begin repeat iniz(mytab); i:=1; j:=1; for l:=2 to 5 do begin t:=0; c:=0; repeat tab(avvcolp,mytab); writeln; writeln('Scegli dove posizionare la nave e premi Invio'); gotoxy(73,25); write('Resetta'); repeat gotoxy(54,15); write('Nave da ',l,' (',i,',',j,')'); move(mytab,x,y,i,j) until (pr=#13) or (pr='r') or (pr='R'); gotoxy(1,15); writeln('Premi il tasto destro per disporre in orizzontale'); writeln('quello giu'' in verticale. Premi invio per confermare'); ori:=#1; if (pr<>'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 gioco; { quale settore bombardare e dove vieni bombardato } const x=1; y=4; var i,j,c,t: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; for i:=1 to max do for j:=1 to max do if mytab^[i,j]='#' then begin i:=max; j:=max; perso:=false end end; function vinto:boolean; { controllo Vittoria } var i,j,c:byte; begin c:=0; vinto:=false; for i:=1 to max do for j:=1 to max do if (avvocc^[i,j]='#') and (avvcolp^[i,j]='*') then begin c:=c+1; if c=21 then begin vinto:=true; i:=max; j:=i end end 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 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; begin { procedura gioco } t:=0; i:=1; j:=1; repeat repeat tab(avvcolp,mytab); writeln; writeln('Su quali coordinate vuoi sparare? Colpi effettuati=',t); 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; t:=t+1 end; until pr=#1; pr:=readkey; esc; writeln; writeln; if vinto then pr:='v' else pcatk(t) until (pr='v') or perso; writeln; if pr='v' then writeln('Hai vinto!! Hai effettuato ',t,' spari.') else writeln('Hai perso!! Hai effettuato ben ',t,' spari.'); writeln; write('Premi un tasto per vedere la soluzione.'); pr:=readkey; esc; tab(avvocc,mytab); pr:=readkey; pr:=#27; esc end; begin { ---->>> Main <<<---- } iniz(avvocc); iniz(avvcolp); diff; navi(avvocc); mynav; baro; gioco end.
|
|
