N-Battle.p

Naval Battle Game for 2 players. Running on NCR-Tower (UNIX V.2, Motorola 680x0). Sources in Pascal programming language. (c) 1989 - Stefano Caschi
PROGRAM  NBattle (input,output); {Battaglia Navale per NCR TOWER}

CONST    dim=10;
         posy=10;
         posxs=4;
         posxd=20;
         dir='/tmp/';
  versione='1.4';
         des=06; giu=10; sin=21; suu=26;
         des_=54;giu_=50;sin_=52;suu_=56;

TYPE     stringa=string[80];
         lato=0..12;
         matrice=array[lato,lato] of char;

VAR      l,num_lu,num_io,x,y,xn,yn,c:integer;
         car:char;
         Smatr,Dmatr:matrice;
         filein,fileout:text;
         CN,CF,so,se,myname,nemico:stringa;
  ok_term:boolean;

PROCEDURE   system(command:stringa);
         c_external;

FUNCTION    getchar:integer;
  c_external;

PROCEDURE   xy(i,j:integer);
         begin
            gotoxy(i*2,j)
         end;

PROCEDURE   insert;
         var   ok:boolean;
               lun,lar,n,m:integer;
         begin
            lun:=1; lar:=1;
            ok:=true;
            if c=ord('o') then lun:=l else lar:=l;
            for n:=0 to lun+1 do
               for m:=0 to lar+1 do
                  if Smatr[x+n-posxs-1,y+m-posy-1]<>' ' then ok:=false;
            if ok=true then begin
               for n:=1 to lun do
                  for m:=1 to lar do begin
                     Smatr[x+n-posxs-1,y+m-posy-1]:='|';
                     xy(x+n-1,y+m-1); write('||')
                  end;
               num_lu:=num_lu+1;
               if (num_lu=1)or(num_lu=3)or(num_lu=6) then l:=l-1;
               xy(posxs,posy-2); write('nave di lungh. ',l:0)
            end
            else begin
               xy(posxs,posy-2); write('posizione errata')
            end
         end;

PROCEDURE   cursor(k,m:integer; var matrix:matrice);
         begin
            c:=getchar;
            xy(x,y); write(matrix[x-k,y-m],matrix[x-k,y-m]);
            if (((c=des)or(c=des_))&(x<k+10)) then x:=succ(x);
            if (((c=giu)or(c=giu_))&(y<m+10)) then y:=succ(y);
            if (((c=sin)or(c=sin_))&(x>k+1)) then x:=pred(x);
            if (((c=suu)or(c=suu_))&(y>m+1)) then y:=pred(y);
            if (((c=ord('o'))or(c=ord('v')))&(num_lu<10)) then insert;
            xy(x,y); write(so,matrix[x-k,y-m],matrix[x-k,y-m],se)
         end;

FUNCTION    affondata:boolean;
         var   i:integer;
         begin
            affondata:=true;
            i:=0;
            repeat
               i:=i+1;
               if Smatr[xn,yn+i]='|' then affondata:=false
            until Smatr[xn,yn+i]=' ';
            i:=0;
            repeat
               i:=i+1;
               if Smatr[xn+i,yn]='|' then affondata:=false
            until Smatr[xn+i,yn]=' ';
            i:=0;
            repeat
               i:=i+1;
               if Smatr[xn,yn-i]='|' then affondata:=false
            until Smatr[xn,yn-i]=' ';
            i:=0;
            repeat
               i:=i+1;
               if Smatr[xn-i,yn]='|' then affondata:=false
            until Smatr[xn-i,yn]=' '
         end;

PROCEDURE   term;
  begin
     ok_term:=true;
     system('echo $TERM>.tmp');
     reset(fileout,'.tmp');
     read(fileout,car);
     if (car='7') {serie 79xx}
     then begin
       so:=concat(chr(27),'0P',chr(14)); {Stand Out Mode}
       se:=chr(15); {End Stand Out Mode}
       CF:=chr(23); {Cursor Invisable}
       CN:=chr(24); {Cursor Visable}
       end
     else begin
       if (car='v') then begin
          so:=concat(chr(27),'[7m');
          se:=concat(chr(27),'[0m');
          CF:='';
          CN:='';
   end
              else begin
   writeln('Terminale non previsto');
   ok_term:=false
              end
     end;
         end;

PROCEDURE   istruzioni;
  begin
     writeln;
     writeln(so,'Istruzioni per il gioco:',se);
     writeln('"o" per l''inserimento orizzontale');
     writeln('"v" per l''inserimento verticale');
     writeln('"NEW LINE" per sparare');
     writeln('"ESC" per ritirarsi');
     writeln('"4","8","6","2" per posizionarsi,');
     writeln('   oppure ''frecce'' (solo terminali 7901)');
     writeln;
         end;

PROCEDURE   inizio;
  begin
     writeln(so,'Terminali attivati',se);
            system('who ; tty|cut -c 9-11>.tmp');
            reset(fileout,'.tmp');
            readln(fileout,myname);
            myname:=concat(dir,myname);
            write('Inserisci il terminale nemico(T1-T9): ');
            readln(nemico);
            nemico:=concat(dir,nemico);
            rewrite(filein,nemico);
            for x:=0 to dim+1 do for y:=0 to dim+1 do Smatr[x,y]:=' ';
            for x:=0 to dim+1 do for y:=0 to dim+1 do Dmatr[x,y]:=' ';
            for y:=0 to dim+2 do Smatr[dim+2,y]:='.';
            for x:=0 to dim+2 do Smatr[x,dim+2]:='.';
  end;

PROCEDURE   schermata;
         procedure   cornice(i,j:integer);
            begin
               xy(i,j); write('[][][][][][][][][][][][]');
               for x:=1 to dim do begin
                  xy(i,j+x); write('[]');
                  xy(i+dim+1,j+x); write('[]')
               end;
               xy(i,j+dim+1); write('[][][][][][][][][][][][]')
            end;
         procedure   copyright;
            var   copyright:stringa;
            begin
               copyright:=' BY STEFANO ';
               for y:=0 to 11 do begin
                  xy(34,posy+y); write('[',copyright[y+1],']')
               end
            end;

  begin
            xy(0,0); system('banner " N-Battle" ; stty ignbrk -echo raw');
            xy(34,posy-4); write(versione);
            cornice(posxs,posy);
            cornice(posxd,posy);
            copyright;
            xy(posxs,posy-2); write('nave di lungh. 4');
     x:=posxs+1; y:=posy+1;
            xy(x,y); write(CF,so,'NB',se);
  end;

PROCEDURE   ins_navi;
  begin
     num_lu:=0; l:=4;
            repeat cursor(posxs,posy,Smatr) until (num_lu=10)or(c=27);
            xy(posxs,posy-2); write('inserim.corretto');
            num_io:=num_lu;
            xy(x,y); write(Smatr[x-posxs,y-posy],Smatr[x-posxs,y-posy]);
            x:=posxd+1; y:=posy+1; xy(x,y); write(so,'NB',se);
            reset(filein,nemico);
            xy(posxd,posy-2); write('unMOMENTO');
  end;

PROCEDURE   invio_sparo;
  begin
  if ord(car)<>119 then begin
            repeat cursor(posxd,posy,Dmatr) until (c=13)or(c=27);
     if c=27 then car:=chr(119) else begin
               xn:=x-posxd;
               yn:=y-posy;
               car:=chr(yn*dim+xn);
        end;
            rewrite(fileout,myname);
            writeln(fileout,car)
     end
         end;

PROCEDURE   chi_comincia;
  begin
         if eof(filein) then begin
            rewrite(fileout,myname);
            writeln(fileout);
            repeat
               reset(filein,nemico);
            until (not eof(filein));
            xy(posxd,posy-2); write('INIZI TU!');
            rewrite(filein);
     invio_sparo
            end
         else begin
            rewrite(filein,nemico);
            rewrite(fileout,myname);
            writeln(fileout,chr(120))
            end;
         end;

PROCEDURE   risp_lu;
         begin
            repeat
               reset(fileout,myname);
               if not eof(fileout) then readln(fileout,car);
            until (ord(car)>=120);
            xy(posxd,posy-2);
            l:=ord(car);
            if (l>120) then case l of
               121:begin
                  if num_lu=1 then write('hai vinto') else write('affondata');
                  Dmatr[x-posxd,y-posy]:='!';
                  num_lu:=num_lu-1
                  end;
               122:begin
                  write('colpita  ');
                  Dmatr[x-posxd,y-posy]:='|'
                  end;
               123:begin
                  write('acqua    ');
                  Dmatr[x-posxd,y-posy]:='~'
                  end
               end;
            if l<>120 then rewrite(fileout,myname);
         end;
PROCEDURE   ricez_sparo;
  begin
            xy(x,y); write(Dmatr[x-posxd,y-posy],Dmatr[x-posxd,y-posy]);
            repeat reset(filein,nemico) until (not eof(filein))or(ord(car)<120);
     read(filein,car);
            xy(posxd,posy-2); write('OK !!!!!!');
     if ord(car)<>119 then begin
               xn:=ord(car) mod dim;
               yn:=ord(car) div dim;
               if xn=0 then begin xn:=dim; yn:=pred(yn) end;
        end
         end;

PROCEDURE   risp_io;
         begin
            rewrite(filein,nemico);
            xy(posxs,posy-2);
            if Smatr[xn,yn]='|' then begin
               if affondata then begin
                  writeln(filein,chr(121));
                  num_io:=num_io-1;
                  if num_io=0
                  then write('HAI PERSO !!!!!!')
                  else write('AFFONDATA !!!!!!')
                  end
               else begin
                  writeln(filein,chr(122));
                  write('NAVE COLPITA !!!')
                  end;
               Smatr[xn,yn]:='.';
               xy(xn+posxs,yn+posy); write('><');
               end
            else begin
               writeln(filein,chr(123));
               write('ACQUA.........!!');
               Smatr[xn,yn]:=' ';
               xy(xn+posxs,yn+posy); write('~~')
               end;
            xy(x,y); write(so,Dmatr[x-posxd,y-posy],Dmatr[x-posxd,y-posy],se);
         end;

PROCEDURE   fine;
  begin
     xy(0,22);
            system('stty -ignbrk echo -raw');
     if ord(car)=119 then writeln('Ritirato!');
            writeln('Ciao...',CN)
  end;

BEGIN
         term;
  if ok_term then begin
        istruzioni;
     inizio;
            schermata;
     ins_navi;
     chi_comincia;
            repeat
        risp_lu;
        ricez_sparo;
               risp_io;
        invio_sparo
            until (c=27)or(num_lu=0)or(num_io=0)or(ord(car)=119);
     fine
  end
END.