$! ------------------ 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 23:45:25.00   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. DRUNK.PAS;1
$!       3. DRUNK.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 DRUNK
X$ LINK DRUNK, INTERACT/LIB
X$ DELETE *.OBJ;*/NOCONFIRM
X$ EXIT
$ CALL UNPACK BUILD.COM;1 1780223284
$ create 'f'
X`5B Inherit ('INTERACT') `5D
X
XProgram  DRUNK_HUNT (ins_file);
X
Xconst
X  ubx = 22;
X  uby = 30;
X  max_shots = 5;
X  max_drunks = 15;
X  x_margin = 1;
X  y_margin = 5;
X
Xtype
X  one_nine = 1..9;
X  two = array`5B1..2`5D of integer;
X  string_type = Varying`5B 256 `5D of char;
X  player_type = Record
X                  pos : two;
X                  turn,
X                  dir : integer;
X                end;
X  some_type = Record
X                pos   : two;
X                turn,
X                dir   : integer;
X                alive : boolean;
X              end;
X
XVAR`20
X player   : player_type;
X gardiner : some_type;
X The_Park : array`5B0..ubx+1,0..uby+1`5D of char;
X drunk    : array`5B1..max_drunks`5D of some_type;
X shot     : array`5B1..max_shots`5D of some_type;
X ins_file : text;
X score_ch : packed array`5B0..3`5D of char;
X shot_speed, drunk_speed, gardiner_speed,
X drunk_freq, gardiner_freq,
X drunks_deployed, shot_limit, score,
X limit, counter, last_shot : integer;
X drunks_out, shots_fired, shot_just_fired,
X exit, failure : boolean;
X
X
XProcedure  spot(x,y :integer; ch :char);
Xbegin
X x := x + x_margin; y := y + y_margin;
X posn (y,x);
X qio_write (ch);
Xend;  `7Bspot`7D
X
X
XProcedure  assign_asterix;
Xvar  k,l :integer;
Xbegin
X for k := 1 to ubx do
X  for l := 1 to ubx do
X   The_Park`5Bk,l`5D := ' ';
X for k := 1 to rnd(25,35) do
X  case random(4) of
X   1 : The_Park`5Brnd(2,8),random(uby)`5D := '*';
X   2 : The_Park`5Brnd(2,ubx),rnd(14,uby)`5D := '*';
X   3 : The_Park`5Brnd(14,ubx),random(ubx)`5D := '*';
X   4 : The_Park`5Brnd(2,ubx),random(8)`5D := '*';
X  end;`20
Xend; `7B assign_asterix `7D
X
X
XProcedure  tell_story;
Xvar   len :integer;
X    ins_line :varying `5B256`5D of char;
X
Xbegin
X open(ins_file,'Image_dir:drunk.scn',history := readonly,error := continue);
X if status(ins_file) = 0 then
X  begin
X   reset(ins_file);
X   while not eof(ins_file) do
X    begin
X     readln(ins_file,ins_line);
X     len := ins_line.length;
X     if len = 3
X      then qio_1_char
X      else qio_write(ins_line);
X    end;
X  end
X else
X  begin
X   clear;
X   posn(5,5); qio_write(' Can''t find the  ');
X   posn(5,7); qio_write('  instructions...');
X   posn(5,9); qio_write('  It''s all up to ');
X   posn(5,11); qio_write('     you now.    ');
X   posn(5,15); qio_write('   Good Luck...  ');
X  end;
X qio_1_char;
Xend;  `7B tell story `7D
X
X
XProcedure  initialise;
Xvar   l ,k : integer;
Xbegin
X Image_dir;
X assign_asterix;
X with player do
X  begin
X   pos`5B1`5D := (ubx)div(2);
X   pos`5B2`5D := (uby)div(2);
X   dir := rnd(0,7);
X   turn := 2;
X  end;
X score := 0;
X for k := 0 to 3 do
X  score_ch`5Bk`5D := ' ';
X for k := 1 to max_drunks do
X  drunk`5Bk`5D.alive := false;
X for k := 1 to max_shots do
X  shot`5Bk`5D.alive := false;
X gardiner.alive := false;
X shot_limit := 1;
X shot_speed := 2;
X drunk_speed := 1;
X gardiner_speed := 1;
X drunks_deployed := 0;
X drunk_freq := 100;
X gardiner_freq := 250;
X shots_fired := false; drunks_out := false;
X limit := 1000; counter := 0;
X exit := false; failure := false;
Xend; `7Binit`7D
X
X
XProcedure  draw_new_score(added : integer);
Xvar  k :integer;
XBegin
X score := score + added;
X posn(1,1);
X for k := 0 to 3 do
X  if not ( ( (((score)mod(10 ** (4-k)))div(10 ** (3-k))) = 0 )
X             and (score_ch`5Bk`5D = ' ') )
X   then score_ch`5Bk`5D := chr( (((score)mod(10 ** (4-k)))div(10 ** (3-k)))
V + 48 );
X qio_write (score_ch`5B0`5D + score_ch`5B1`5D + score_ch`5B2`5D + score_ch`5
VB3`5D);
XEnd;  `7B draw_new_score `7D
X
X
XProcedure  opposite(var what :integer);
XBegin
X what := (what + 4)mod(8);
XEnd;  `7B opposite `7D
X
XProcedure  right(var what :integer);
XBegin
X what := (what + 7)mod(8);
XEnd;  `7B right `7D
X
XProcedure  left(var what :integer);
XBegin
X what := (what + 9)mod(8);
XEnd;  `7B left `7D
X
XProcedure  x_bounce(var this_dir :integer);
XBegin
X this_dir := 6 - this_dir;
XEnd;  `7B x_bounce `7D
X
XProcedure  y_bounce(var this_dir :integer);
XBegin
X this_dir := (10 - this_dir)mod(8);
XEnd;  `7B y_bounce `7D
X
XProcedure  rand_bounce(var this_dir :integer);
XBegin
X this_dir := (this_dir + 10 + random(3))mod(8);
XEnd;  `7B rand_bounce `7D
X
XFunction  in_bounds(this_pos :two):boolean;
XBegin
X in_bounds := (this_pos`5B1`5D in `5B1..ubx`5D) and (this_pos`5B2`5D in `5B1
V..uby`5D);
XEnd;  `7B in_bounds `7D
X
XFunction  equiv_pos(this_pos, that_pos :two):boolean;
XBegin
X equiv_pos := (this_pos`5B1`5D = that_pos`5B1`5D) and (this_pos`5B2`5D = tha
Vt_pos`5B2`5D);
XEnd;  `7B equiv_pos `7D
X
X
XFunction  move(this_pos :two; this_dir :integer):two;
Xvar  move_temp :two;
XBegin
X move_temp := this_pos;
X case this_dir of
X  0 : begin
X       move_temp`5B1`5D := this_pos`5B1`5D+1;
X       move_temp`5B2`5D := this_pos`5B2`5D-1;
X      end;
X  1 : move_temp`5B1`5D := this_pos`5B1`5D+1;
X  2 : begin
X       move_temp`5B1`5D := this_pos`5B1`5D+1;
X       move_temp`5B2`5D := this_pos`5B2`5D+1;
X      end;
X  3 : move_temp`5B2`5D := this_pos`5B2`5D+1;
X  4 : begin
X       move_temp`5B1`5D := this_pos`5B1`5D-1;
X       move_temp`5B2`5D := this_pos`5B2`5D+1;
X      end;
X  5 : move_temp`5B1`5D := this_pos`5B1`5D-1;
X  6 : begin
X       move_temp`5B1`5D := this_pos`5B1`5D-1;
X       move_temp`5B2`5D := this_pos`5B2`5D-1;
X      end;
X  7 : move_temp`5B2`5D := this_pos`5B2`5D-1
X end;
X move := move_temp;
XEnd;  `7B move `7D
X
X
XProcedure  check_shot( shot_value :integer; var this_shot : some_type);
Xvar  j :integer;
X
XBegin
X with this_shot do
X case the_park`5Bpos`5B1`5D,pos`5B2`5D`5D of
X  '%','`60' : begin
X             failure := true;
X             alive := false;
X            end;
X    '#'   : begin
X            j := 0;
X             repeat
X              j := j + 1;
X             until equiv_pos(pos,drunk`5Bj`5D.pos) or (j = 15);
X             drunk`5Bj`5D.alive := false;
X             alive := false;
X             spot(pos`5B1`5D,pos`5B2`5D,' ');
X             the_park`5Bpos`5B1`5D,pos`5B2`5D`5D := ' ';
X             draw_new_score(10);
X             drunks_deployed := drunks_deployed - 1;
X            end;
X    '$'   : begin
X             alive := false;
X             gardiner.alive := false;
X             spot(pos`5B1`5D,pos`5B2`5D,' ');
X             the_park`5Bpos`5B1`5D,pos`5B2`5D`5D := ' ';
X             draw_new_score(15);
X            end;
X    '.'   : begin
X             j := 0;
X             repeat
X              j := j + 1;
X              if shot`5Bj`5D.alive then
X               if equiv_pos(pos,shot`5Bj`5D.pos) and (j <> shot_value) then
X                begin
X                 alive := false;
X                 shot`5Bj`5D.alive := false;
X                end;
X             until  not alive or (j = 5);
X             spot(pos`5B1`5D,pos`5B2`5D,' ');
X             the_park`5Bpos`5B1`5D,pos`5B2`5D`5D := ' ';
X            end;
X    '*'   : begin
X             draw_new_score(1);
X             alive := false;
X             spot(pos`5B1`5D,pos`5B2`5D,' ');
X             the_park`5Bpos`5B1`5D,pos`5B2`5D`5D := ' ';
X            end;
X   otherwise
X         shots_fired := true;
X         spot(pos`5B1`5D,pos`5B2`5D,'.');
X         the_park`5Bpos`5B1`5D,pos`5B2`5D`5D := '.'
X end; `7B case `7D
XEnd;  `7B check_shot `7D
X
X
XProcedure  start_shot(this_pos :two; this_dir :integer);
Xvar  temp :two;
XBegin
X with shot`5Blast_shot`5D do
X  begin
X   dir := this_dir;
X   alive := true;
X   shot_just_fired := not shot_just_fired;
X   if not shot_just_fired then
X    begin
X     the_park`5Bpos`5B1`5D,pos`5B2`5D`5D := ' ';
X     spot(pos`5B1`5D,pos`5B2`5D,' ');
X    end;
X   temp := move(this_pos,this_dir);
X   while not in_bounds(temp) do
X    begin
X     if not (temp`5B1`5D in `5B1..ubx`5D) then x_bounce(this_dir);
X     if not (temp`5B2`5D in `5B1..uby`5D) then y_bounce(this_dir);
X     temp := move(this_pos,this_dir);
X    end;
X   pos := temp;
X   check_shot(last_shot, shot`5Blast_shot`5D);
X   if not alive then shot_just_fired := false;
X  end; `7B with shot`5Blast_shot`5D `7D
XEnd;  `7B start_shot `7D
X
X
XProcedure  move_player;
Xvar  temp :two;
X
XBegin
X with player do
X  begin
X   case turn of
X    1 : left(dir);
X    3 : right(dir);
X    2 : if shot_just_fired then
X         with shot`5Blast_shot`5D do
X           start_shot(pos,dir);
X   end;
X   temp := move(pos,dir);
X   while not in_bounds(temp) do
X    begin
X     if not (temp`5B1`5D in `5B1..ubx`5D) then x_bounce(dir);
X     if not (temp`5B2`5D in `5B1..uby`5D) then y_bounce(dir);
X     temp := move(pos,dir);
X    end;
X   if The_Park`5Bpos`5B1`5D,pos`5B2`5D`5D in `5B'*','%'`5D then
X    begin
X     the_park`5Bpos`5B1`5D,pos`5B2`5D`5D := '*';
X     spot(pos`5B1`5D,pos`5B2`5D,'*');
X    end
X   else
X    begin
X     the_park`5Bpos`5B1`5D,pos`5B2`5D`5D := ' ';
X     spot(pos`5B1`5D,pos`5B2`5D,' ');`20
X    end;
X   pos := temp;
X   if The_Park`5Bpos`5B1`5D,pos`5B2`5D`5D = '*' then
X    begin
X     dir := rnd(0,7);
X     The_park`5Bpos`5B1`5D,pos`5B2`5D`5D := '%';
X    end
X   else The_park`5Bpos`5B1`5D,pos`5B2`5D`5D := '`60';
X   spot(pos`5B1`5D,pos`5B2`5D,'`60');
X   posn (1,1);
X  end; `7B with player `7D
XEnd;  `7B player_move `7D
X
X
XProcedure  initiate_gardiner;
Xvar k :integer;
XBegin
X with gardiner do
X begin
X  turn := 2;
X  alive := true;
X  case random(4) of
X   1 : begin
X        pos`5B1`5D := 1;
X        pos`5B2`5D := 1;
X       end;
X   2 : begin
X        pos`5B1`5D := 1;
X        pos`5B2`5D := uby;
X       end;
X   3 : begin
X        pos`5B1`5D := ubx;
X        pos`5B2`5D := 1;
X       end;
X   4 : begin
X        pos`5B1`5D := ubx;
X        pos`5B2`5D := uby;
X       end
X  end;  `7B case `7D
X  dir := rnd(0,7);
X  the_park`5Bpos`5B1`5D,pos`5B2`5D`5D := '$';
X  spot(pos`5B1`5D,pos`5B2`5D,'$');
X  qio_write(VT100_bell + VT100_bell);
X end;
XEnd;  `7B initiate_gardiner `7D
X
X
XProcedure  move_gardiner;
Xvar  temp :two;
X     loop_cntr : integer;
X
X Procedure  check_gardiner;
X Begin
X  with gardiner do
X  case the_park`5Bpos`5B1`5D,pos`5B2`5D`5D of
X   '%','`60' : begin
X              failure := true;
X              alive := false;
X             end;
X     '*'   : spot(pos`5B1`5D,pos`5B2`5D,'*');
X     '$'   : begin
X              spot(pos`5B1`5D,pos`5B2`5D,' ');
X              the_park`5Bpos`5B1`5D,pos`5B2`5D`5D := ' ';
X             end;
X     '.'   : begin
X              spot(pos`5B1`5D,pos`5B2`5D,'.');
X              alive := false;
X             end;
X   otherwise
X             spot(pos`5B1`5D,pos`5B2`5D,'$');
X             the_park`5Bpos`5B1`5D,pos`5B2`5D`5D := '$'
X  end; `7B case `7D
X End;  `7B check_gardiner `7D
X
XBegin
X with gardiner do
X  begin
X   case random(30) of
X    2,4,17  : turn := 1;
X    5,13,18 : turn := 3;
X    6,7,8,9 : The_park`5Bpos`5B1`5D,pos`5B2`5D`5D := '*';
X    otherwise
X            turn := 2
X   end; `7B case `7D
X   case turn of
X    1 : left(dir);
X    3 : right(dir);
X    otherwise
X   end;
X   temp := move(pos,dir);
X   loop_cntr := 0;
X   while (loop_cntr < 5) and ((not in_bounds(temp))
X            or (The_Park`5Btemp`5B1`5D,temp`5B2`5D`5D in `5B'*','$','#'`5D))
V do
X    begin
X     if not (temp`5B1`5D in `5B1..ubx`5D) then x_bounce(dir);
X     if not (temp`5B2`5D in `5B1..uby`5D) then y_bounce(dir);
X     temp := move(pos,dir);
X     if in_bounds(temp) then
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-