$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 30-MAY-1992 03:37:49.04   By user MASLIB 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 2 PARTS, TO KEEP EACH PART
$!  BELOW 30 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. BUILD.COM;1
$!       2. DOOR.PAS;1
$!       3. DOOR.SCN;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X$ PASCAL DOOR
X$ LINK DOOR, INTERACT/LIB
X$ DELETE *.OBJ;*/NOCONFIRM
X$ EXIT
$ CALL UNPACK BUILD.COM;1 174724013
$ create 'f'
X`5B Inherit ('INTERACT') `5D
X
Xprogram Door;
X
XConst gap_to_home = 2;
X
XType`20
X     Screens = Array `5B1..24`5D of packed array `5B1..40`5D of char;
X     traces  = Array `5B1..24`5D of array `5B1..40`5D of integer;
X
Xvar Pc,Pr,dc,dr,score,`20
X    R,C ,
X    Rc,Rr ,
X    move ,
X    Len,
X    Screen_no ,
X    lives ,
X    Screen ,`20
X    Num_dots  : integer;
X    M         : traces;
X    S         : Screens;
X    was_dot   ,
X    quit      : Boolean;
X
X   Tim : integer;
X
X
XProcedure at(X,Y:Integer;Ch:Char;I:Integer);
XBegin`20
X   M`5BX,y`5D := I;
X   IF S`5BX,y`5D = '`7E' then`20
X      Num_Dots := Num_Dots - 1;
X   S`5BX,y`5D := ch;
X   If ch = '`7E' then`20
X      Num_Dots := Num_Dots + 1;
X  `20
X   posn (y,x);
X   qio_write (ch);
Xend;
X
XProcedure New_Pos( var R,C : Integer );
X
XBegin
X   Repeat`20
X      R := rnd(4,22);
X      C := rnd(4,38);
X   Until ( S`5BR,c`5D  in `5B'`7E',' '`5D ) and ( M`5BR,c`5D < maxint );
Xend;
X
XProcedure Initalise;
X
XVar count,Er,Ec,W,Cc,Cr,Tr,Tc,Ix,Iy,J,F : Integer;
X    posnd,Rev : Boolean;
X
XBegin
X   tim := max(5,tim - screen div 2);
X   Screen := screen + 1;
X   S`5B1`5D  := '@@@      @@      @@      @@      @@     ';
X   S`5B2`5D  := '@@@  @@  @@  @@  @@  @@  @@  @@  @@  @@ ';
X   S`5B3`5D  := '@@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@
V`7E`7E@@`7E`7E@@ ';
X   S`5B4`5D  := '  `7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E
V`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E  ';
X   S`5B5`5D  := '  `7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E
V`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E  ';
X   S`5B6`5D  := ' @@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@
V`7E`7E@@`7E`7E@@@';
X   S`5B7`5D  := ' @@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@
V`7E`7E@@`7E`7E@@@';
X   S`5B8`5D  := '  `7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E
V`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E  ';
X   S`5B9`5D  := '  `7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E
V`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E  ';
X   S`5B10`5D := '@@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@
V`7E`7E@@`7E`7E@@ ';
X   S`5B11`5D := '@@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@
V`7E`7E@@`7E`7E@@ ';
X   S`5B12`5D := '  `7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E
V`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E  ';
X   S`5B13`5D := '  `7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E
V`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E  ';
X   S`5B14`5D := ' @@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@
V`7E`7E@@`7E`7E@@@';
X   S`5B15`5D := ' @@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@
V`7E`7E@@`7E`7E@@@';
X   S`5B16`5D := '  `7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E
V`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E  ';
X   S`5B17`5D := '  `7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E
V`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E  ';
X   S`5B18`5D := '@@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@
V`7E`7E@@`7E`7E@@ ';
X   S`5B19`5D := '@@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@
V`7E`7E@@`7E`7E@@ ';
X   S`5B20`5D := '  `7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E
V`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E  ';
X   S`5B21`5D := '  `7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E
V`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E  ';
X   S`5B22`5D := ' @@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@`7E`7E@@
V`7E`7E@@`7E`7E@@@';
X   S`5B23`5D := ' @@  @@  @@  @@  @@  @@  @@  @@  @@  @@@';
X   S`5B24`5D := '     @@      @@      @@      @@      @@@';`20
X   num_dots := 540;
X   For Cr := 1 to 5 do`20
X      For Cc := 1 to 9 do begin
X         tr := ( Cr - 1 ) * 4  + 3;
X         tc := ( Cc - 1 ) * 4  + 3;
X         posnd := false;
X         count := 0 ;
X         repeat`20
X            count := count + 1;
X            case random(4) of         `20
X               1 `7Btop`7D   : If (S`5Btr+1,tc-1`5D <> 'a'  )   and`20
X                              (S`5Btr,tc-2`5D <> 'a' ) and`20
X                              (S`5BTr-1,Tc+1`5D <> 'a' ) then begin
X                             posnd := true;
X                             S`5Btr,Tc+1`5D := 'a';
X                             S`5Btr,Tc+2`5D := 'a';
X                           end;                  `20
X               2 `7Bbot`7D   : If (S`5Btr+3,tc-2`5D <> 'a'  )   and`20
X                              ( (S`5Btr+1,tc-1`5D <> 'a'  )   or`20
X                               (S`5Btr-1,tc+1`5D <> 'a'  ) ) then begin`20
X                             posnd := true;
X                            S`5BTr+3,Tc+1`5D := 'a';
X                            S`5BTr+3,Tc+2`5D := 'a';
X                          end;
X               3 `7Bleft`7D  : If (S`5Btr,tc+1`5D <> 'a'  )   and
X                              (S`5Btr+1,tc-1`5D <> 'a'  )   and
X                              (S`5Btr-2,tc`5D <> 'a'  )   then begin`20
X                             posnd := true;
X                            S`5BTr+1,Tc`5D := 'a';
X                            S`5BTr+2,Tc`5D := 'a';
X                           end;
X               4 `7Bright`7D :If (S`5Btr-2,tc+3`5D <> 'a'  )   and
X                             ( (S`5Btr-1,tc+1`5D <> 'a'  )   or`20
X                              (S`5Btr+1,tc-1`5D <> 'a'  )   ) then begin`20
X                             posnd := true;
X                            S`5BTr+1,Tc+3`5D := 'a';
X                            S`5BTr+2,Tc+3`5D := 'a';
X                          end;
X               end `7B case `7D;
X         until posnd or ( count > 10 );
X         If posnd then`20
X            Num_dots := Num_dots - 2;
X      end;
X   len := 0;  `20
X   move := 0;
X   rev := False;
X   reset_screen;
X   clear;
X   qio_write (VT100_graphics_on);
X   For R := 1 to 24 do begin
X      qio_Write (VT100_Esc+'`5B'+dec(R)+'H'+VT100_Esc+'#6');
X      For C := 1 to 40 do`20
X         If ( S`5Br,c`5D = '@' ) Then Begin
X            If not Rev Then begin
X               rev := true;
X               qio_Write(VT100_Esc+'`5B7m');
X            end;
X            qio_write(' ');
X            M`5Br,c`5D := maxint;
X         end Else begin
X            If Rev Then Begin
X               rev := false;
X               qio_Write(VT100_Esc+'`5Bm');
X            end;
X            qio_Write(S`5BR,c`5D);
X            If S`5BR,c`5D = 'a' Then`20
X               M`5BR,c`5D := maxint
X            else
X               M`5BR,c`5D := 0;
X         end;
X      qio_write(VT100_Esc+'`5BH');
X   end;
X   qio_writeln(VT100_Esc+'`5Bm'+VT100_graphics_on);
X   New_Pos(Rr,Rc);
X   If S`5BRr,Rc`5D = '`7E' then`20
X      was_dot := true
X   else
X      was_dot := false;
X   Repeat`20
X      New_pos(Pr,Pc);`20
X   until ( Abs(pr-Rr)+abs(Pc-Rc)) > 20  ;
X   If S`5BPr,PC`5D = '`7E' then begin
X      Score := score + 1;
X   end;
X   at(Rr,Rc,'*',Move);
X   at(Pr,Pc,'`60',0);
X   at(2,2,Chr( Ord('0') + Lives ),maxint);
X   New_pos(Er,Ec);
X   at(Er,Ec,'E',maxint);
Xend;
X
X
X
XProcedure Do_Move;
X
Xvar Valid : Boolean;
X
X   Procedure Move_Robot;
X
X
X   var I,temp_dist,dist,Rcr,Rcc,Rdc,Rdr,Alt_Rdc,Alt_Rdr,alt_move : Integer;
X
X   Begin
X      If S`5BRr,Rc`5D = 'a' Then Begin `7B Been Hit By A Door `7D
X         New_Pos(Rr,Rc);
X         If S`5BRr,Rc`5D = '`7E' then`20
X            was_dot := true`20
X         else
X            was_dot := false;        `20
X         at(Rr,Rc,'*',Move);
X      end;
X      dist := maxint;
X      alt_move := maxint;
X      For I := 1 to 4 do begin
X         case I of`20
X            1 : Begin
X                  Rcr := 1;
X                  Rcc := 0;
X                end;
X            2 : Begin`20
X                  Rcr := -1;
X                  Rcc := 0;
X                end;
X            3 : Begin
X                  Rcr := 0;
X                  Rcc := 1;
X                end;
X             4 : Begin
X                   Rcr := 0;
X                   Rcc := -1;
X                 end;
X         end `7B Case `7D;
X         If (( Rr + Rcr ) >= 1 ) and (( Rc + Rcc ) >= 1 ) and`20
X            (( Rr + Rcr ) <= 24 ) and (( Rc + Rcc ) <= 40 ) Then Begin
X            temp_dist  := Abs((Rr+Rcr)-Pr)**2+Abs((Rc+Rcc)-Pc)**2;
X            If ( ( temp_dist < dist ) and`20
X                 ( M`5BRr+Rcr,Rc+Rcc`5D <= ( move - (temp_dist + 20))))`20
X                              Then begin
X                  dist := temp_dist;
X                  Rdc  := Rcc;
X                  Rdr  := Rcr;
X            end else`20
X               if (  alt_move > M`5BRr+Rcr,Rc+Rcc`5D ) then begin
X                  alt_move := M`5BRr+Rcr,Rc+Rcc`5D ;
X                  alt_Rdc  := Rcc;
X                  alt_Rdr  := Rcr;
X               end;
X         end;
X      end;
X      If Was_Dot Then`20
X         at(Rr,Rc,'`7E',move-1)
X      else
X         at(Rr,Rc,' ',move-1);
X      If dist = maxint then begin
X         RDr := alt_RDr;
X         RDc := alt_Rdc;
X      end;
X      Rr := Rr + Rdr;
X      Rc := Rc + Rdc;
X      If S`5BRr,Rc`5D = '`60' Then Begin
X         Lives := Lives - 1;
X         If lives > 0 then begin`20
X            at(2,2,Chr( Ord('0') + Lives ),maxint);
X            Repeat`20
X               New_pos(Pr,Pc);`20
X            until ( Abs(pr-Rr)+abs(Pc-Rc)) > 20  ;
X            Dr := 0;
X            Dc := 0;
X            If S`5BPr,PC`5D = '`7E' then begin
X               Score := score + 1;
X            end;
X         end;
X      end Else`20
X         If S`5BRr,Rc`5D = '`7E' Then begin
X            Was_Dot := true
X         end else
X            Was_dot := false;
X      at(Rr,Rc,'*',move);        `20
X   end;
X
X   Procedure pos_Extra( Ch : Char );
X
X   Var Er,Ec : Integer;
X
X   Begin
X     repeat`20
X        New_pos(Er,Ec);
X     Until (Abs(Er - Rr) + Abs(Ec - Rc) < 12 ) and
X           (S`5BEr+1,Ec`5D <> '@') and`20
X           (S`5BEr-1,Ec`5D <> '@') and`20
X           (S`5BEr,Ec+1`5D <> '@') and`20
X           (S`5BEr,Ec-1`5D <> '@');
X     at(Er,Ec,ch,maxint);
X    end;
X
XBegin
X  Move := Move + 1;
X  Case Ord(qio_1_Char_Now) of`20
X      50 `7B 2 `7D :  Begin
X                     dc := 0;
X                     dr := 1;
X                  end;
X      52 `7B 4 `7D  : Begin
X                     dr := 0;
X                     dc := -1;
X                  end;
X      53 `7B 5 `7D  : Begin`20
X                     dc := 0;
X                     dr := 0;
X                  end;
X      54 `7B 6 `7D  : Begin
X                     dr := 0;
X                     dc := 1;
X                  end;
X      56 `7B 8 `7D : Begin
X                     dc := 0;
X                     dr := -1;
X                  end;
X      48 `7B 0. Knock down `7D :
X                     If (( pr + dr ) > 1 ) and (( Pc + Dc ) >  1 ) and`20
X                        (( Pr + dr ) < 24) and (( Pc + Dc ) < 40 ) Then`20
X                           If S`5Bpr+dr,pc+dc`5D = 'a' Then begin
X                              at(pr+dr,Pc+dc,' ',0);
X                              Score := score - 20;
X                           end;
X      46 `7B . Stop `7D : repeat`20
X                        `7B nothing `7D
X                      until qio_1_char = '.';
X      81 `7B Q `7D,113 `7Bq`7D : Quit := True;
X      otherwise`20
X   end `7B Case `7D;
X   Move_Robot;
X   at(pr,pc,' ',0);
X   valid := true;
X   If (( pr + dr ) < 1 ) or (( Pc + Dc ) < 1 ) or
X      (( Pr + dr ) > 24) or (( Pc + Dc ) > 40 ) Then`20
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-