HPAVC/HPAVC CD-ROM.iso/pc/SPADV.ZIP/SHIPED.PAS

Pascal/Delphi Source File | 1980-01-01 | 4.9 KB | 177 lines

program SA_SHIP_EDIT;
uses crt;
const
  cchar:array (.0..15.) of char= (#32,#208,#210,#186,#181,#188,#187,#185,
                                  #198,#200,#201,#204,#205,#202,#203,#206);
  sadir='';
  North=1; South=2; West=4; East=8;
  Shield=16; Block=32; Pform=64; Panel=128;
  Ppack=16; Key=17; Crystal=18;
type
  RoomTyp=record
            Interior:word;
            Object:byte;
            Visited:boolean;
          end;
var
  l,x,y,ctr:byte;
  k,k2:char;
  ship:array [1..3,1..14,1..3] of roomtyp;

function outside (x,y:byte):boolean;
begin
  outside:=(((x=1) or ((x>3) and (x<9))) and (y<>2))
           and not ((l=2) and (x=6) and (y=1));
end;

procedure putchr (l,x,y:byte; ch:char);
begin
  gotoxy(x+4,l*4+y-2); if ch<>#0 then write (ch);
end;

procedure drawship;
begin
  clrscr;
  for l:=1 to 3 do begin
    gotoxy(1,4*l); write (l:1);
    gotoxy(4,4*l); write ('<');
    if l=2 then begin
      putchr(2,5,1,'<');
      putchr(2,7,1,'<');
    end;
    for y:=1 to 3 do begin
      gotoxy(3,4*l+y-2); write (y:1);
      putchr (l,15,y,'<');
      for x:=1 to 14 do begin
        gotoxy(x+4,l*4-2); write (x:1);
        if ((y=1) and ((x=1) or (x=8))) or ((y=3) and (x=4)) then putchr (l,x,y,'/');
        if ((y=3) and ((x=1) or (x=8))) or ((y=1) and (x=4)) then putchr (l,x,y,'\');
        if not outside (x,y) then putchr (l,x,y,cchar[ship[l,x,y].interior and 15]);
        if (y=2) and ((x=1) or (x=12)) then putchr (l,x,y,'T');
      end;
    end;
  end;
end;

procedure clr;
begin
  window (1,15,40,24); clrscr; window (1,1,40,25);
end;

procedure LoadShip;
var
  FilVar:file of RoomTyp;
  l,x,y:byte;
begin
  Gotoxy(1,23); write ('Ok to Load ''SHIP.DAT''? ');
  k:=readkey; if k in ['Y','y'] then begin
    Assign(FilVar,SAdir+'SHIP.DAT');
    Reset(FilVar);
    for L:=1 to 3 do
      for X:=1 to 14 do
        for Y:=1 to 3 do
          Read (FilVar,Ship[L,X,Y]);
    Close (FilVar);
    drawship;
  end;
  clr;
end;

procedure SaveShip;
var
  FilVar:file of RoomTyp;
  l,x,y:byte;
begin
  Gotoxy(1,23); write ('Ok to Save ''SHIP.DAT''? ');
  k:=readkey; if k in ['Y','y'] then begin
    Assign(FilVar,SAdir+'SHIP.DAT');
    Rewrite(FilVar);
    for l:=1 to 3 do
      for X:=1 to 14 do
        for Y:=1 to 3 do
          Write (FilVar,Ship[L,X,Y]);
    Close (FilVar);
  end;
  clr;
end;


begin
  textmode(c40);
  drawship;
  l:=2; x:=6; y:=1;
  repeat
    gotoxy(1,16);
    with ship[l,x,y] do begin
      Write ('   Exits : ');
      if (interior and north)>0 then write ('Up ');
      if (interior and south)>0 then write ('Down ');
      if (interior and west)>0 then write ('Left ');
      if (interior and east)>0 then write ('Right ');
      writeln; write ('Interior : ');
      if (interior and shield)>0 then write ('Shields  ');
      if (interior and block)>0 then write ('Blocks  ');
      if (interior and pform)>0 then write ('Platforms  ');
      if (interior and Panel)>0 then write ('Computer ');
      writeln; write ('  Object : ');
      case Object of
        Ppack  : write ('Power Pack');
        Key    : write ('Electronic Key');
        Crystal: write ('Crystal');
      end;
      writeln; write ('Androids : ');
      case Visited of
        false:write ('Yes');
        true:write ('No');
      end;
      writeln; write (' Special : ');
      if (y=2) and ((x=1) or (x=12)) then write ('Teleport ');
      if (l=2) and (y=1) and (x=6) then write ('Your craft ');
      if Outside (x,y) then write ('Outside ship ');
      writeln;
    end;
    if not outside (x,y) and not((y=2) and ((x=1) or (x=12)))
      then putchr(l,x,y,cchar(.ship(.l,x,y.).interior and 15.));
    putchr (l,x,y,#0);
    k:=upcase(readkey);
    with ship[l,x,y] do begin
      if (k=#0) and keypressed then begin
        k2:=readkey;
        case k2 of
          'H':y:=y-1;
          'P':y:=y+1;
          'K':x:=x-1;
          'M':x:=x+1;
          #59:loadship;
          #60:saveship;
          #61:begin
                Interior:=0; Object:=0; Visited:=True;
              end;
        end;
      end;
      if (k<>#0) and not outside (x,y) then case k of
        'U':Interior:=Interior xor North;
        'D':Interior:=Interior xor South;
        'L':Interior:=Interior xor West;
        'R':Interior:=Interior xor East;

        'S':Interior:=Interior xor Shield;
        'B':Interior:=Interior xor Block;
        'P':Interior:=Interior xor Pform;
        'C':Interior:=Interior xor Panel;

        'O':begin
              Inc(Object);
              if Object=19 then Object:=0;
              if Object=1 then Object:=16;
            end;
        'A':Visited:=not Visited;
      end;
      if x<1 then x:=14 else if x>14 then x:=1;
      if y<1 then begin y:=3; l:=l-1; end else if y>3 then begin y:=1; l:=l+1; end;
      if l<1 then l:=3 else if l>3 then l:=1;
    end;
    clr;
  until k=#27;
end.