$! ------------------ 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:32:34.70   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 4 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. DIG.PAS;1
$!       3. DIGDET.DAT;1
$!       4. DIGHLP.DAT;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 DIG
X$ LINK DIG, INTERACT/LIB
X$ DELETE *.OBJ;*/NOCONFIRM
X$ EXIT
$ CALL UNPACK BUILD.COM;1 51342986
$ create 'f'
X`5B Inherit ('INTERACT') `5D
X
XPROGRAM DigDug(input,output,Detpic,HlpPic);
X
X`7B A game of low cunning and high boredom ... any resemblance between this
X  game and any existing game is entirely deliberate.
X  Idea stolen and program written by Ian Thornborough.
X  Started writing on 28-9-84.
X  Copyright (C) I.H.Thornborough 1984. `7D
X
XCONST
X`09MaxSpook= '9';
X
XTYPE
X`09vstring`09= varying`5B255`5D of char;
X`09spk`09= RECORD
X`09`09`09state `09: char;
X`09`09`09x`09: integer;
X`09`09`09y`09: integer;
X  `09`09`09dir`09: 0..3;
X`09`09  END;
X
XVAR
X`09DetPic,
X`09HlpPic`09`09: text;
X`09spook`09`09: array `5B'0'..MaxSpook`5D of spk;
X`09map`09`09: packed array `5B1..24`5D of packed array `5B1..40`5D of char;
X`09buffer  `09: vstring;
X`09beep,
X`09SaveSpookNo,
X`09SpookNo`09`09: char;
X`09MeX,
X`09MeY,
X`09i,
X`09delay,
X`09lives,
X`09score,
X`09move,
X`09lastmove,
X`09screen,
X`09fire_count,
X`09x,
X`09y`09`09: integer;
X`09dead,
X`09HavePick,
X`09SpookGone,
X`09GameOver,
X`09LastSpook`09: boolean;
X
X`7B*************************************************************************
V****`7D
X
XFUNCTION dirt : char;
XBEGIN
X`09If x < 8 then
X`09  dirt := '.'
X`09Else
X`09  If x < 16 then
X`09    dirt := 'O'
X`09  Else
X`09    dirt := '@';
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE pos(v,h : integer);
XVAR
X`09Xdis,
X`09Ydis`09: integer;
XBEGIN
X`09qio_write (VT100_esc+'`5B'+dec(v)+';'+dec(h+1)+'H');
X`09x := v;
X`09y := h;
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE LoadHelp;
XVAR
X`09line`09: varying`5B255`5D of char;
XBEGIN
X    Image_dir;
X`09open(HlpPic,'image_dir:Dighlp.dat',history := readonly,error := continue)
V;
X`09reset(HlpPic);
X`09While not EOF(HlpPic) do
X`09  BEGIN
X`09    readln(HlpPic,line);
X`09    If line`5B1`5D <> '%' then
X`09      qio_write (line)
X`09    Else
X              qio_1_char;
X`09  END;
X`09close(HlpPic);
XEND;
X
X`7B*************************************************************************
V****`7D
X
XProcedure AskBeep;
X`7B Ask if they want beeps or not ...
X  if not assign beep the null char. / if so  assign beep the bell char. `7D
XBegin
X`09qio_write (VT100_esc+'`5B2J'+VT100_esc+'(0'+VT100_esc+'`5B11;13H'+VT100_e
Vsc+'#6lqqqqqqqqqqqqqk'+VT100_esc+'`5B12;13H'+VT100_esc+'#6x BEEP (Y/N)  x'+V
VT100_esc+'`5B13;13H'+VT100_esc+'#6mqqqqqqqqqqqqqj'+VT100_esc+'`5B12;25H');
X`09If upper_case(qio_1_char) = 'Y' then
X`09  beep := chr(7)
X`09Else
X`09  beep := chr(0);
X`09qio_write (beep);
XEnd;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE AskHelp;
XBEGIN
X`09qio_write (VT100_esc+'`5B12;15H'+VT100_esc+'#6HELP'+VT100_esc+'`5B12;25H'
V);
X`09If (upper_case(qio_1_char) = 'Y') then
X`09  LoadHelp;
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE DrawField;
XVAR
X`09i`09: integer;
XBEGIN
X`09qio_write (VT100_esc+'(0');
X`09For i := 1 to 24 do
X`09  qio_write (VT100_esc+'`5B'+dec(i)+';1H'+VT100_esc+'#6'+map`5Bi`5D);
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE UpdateScnNo;
XBEGIN
X`09qio_write (VT100_esc+'`5B24;2H'+dec(screen));
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE UpdateScore;
XBEGIN
X`09qio_write (VT100_esc+'7'+VT100_esc+'`5B24;15H'+dec(score)+VT100_esc+'8');
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE UpdateLives;
XVAR
X`09i`09: integer;
XBEGIN
X`09For i := 1 to lives do
X`09  qio_write (VT100_esc+'`5B24;'+dec(26+(i*2))+'H`60');
X`09If lives < 5 then
X`09  For i := (lives+1) to 5 do
X`09    qio_write (VT100_esc+'`5B24;'+dec(26+(i*2))+'H`7E');
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE HighLightDetails;
XVAR
X`09i,
X`09j`09: integer;
XBEGIN
X`09qio_write (VT100_esc+'`5B1m');
X`09For j := 2 to 39 do
X`09  For i := 2 to 22 do
X`09    If map`5Bi,j`5D in `5B'`60','0'..'9','U','T','a'`5D then
X`09      BEGIN
X`09`09qio_write (VT100_esc+'`5B'+dec(i)+';'+dec(j)+'H');
X`09        If map`5Bi,j`5D in `5B'0'..'9'`5D then
X`09`09  BEGIN
X`09`09    If spook`5Bmap`5Bi,j`5D`5D.state = 'M' then
X`09  `09      qio_write ('*')
X`09`09    Else
X`09`09      qio_write ('#');
X`09`09  END
X`09        Else
X`09  `09  qio_write (map`5Bi,j`5D);
X`09      END;
X`09qio_write (VT100_esc+'`5Bm');
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE RedrawScreen;
XVAR
X`09i`09: integer;
XBEGIN
X`09DrawField;
X`09UpdateScnNo;
X`09UpdateScore;
X`09UpdateLives;
X`09HighLightDetails;
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE LoadDetails;
XVAR`09
X`09line`09: packed array`5B1..40`5D of char;
X`09c`09: integer;
XBEGIN
X`09c := 0;
X    Image_dir;
X`09open(DetPic,'image_dir:Digdet.dat',history := readonly,error := continue)
V;
X`09reset(DetPic);
X`09While not EOF(DetPic) do
X`09   BEGIN
X`09     c := c+1;
X`09     readln(DetPic,line);
X`09     map`5Bc`5D := line;
X`09   END;
X`09close(DetPic);
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE GenerateSpooks;
XVAR
X`09chk,
X`09g,
X`09h,
X`09testx,
X`09testy`09: integer;
X`09e,
X`09f,
X`09count`09: char;
XBEGIN
X`09count := '/';
X`09chk := 0;
X`09For e := '0' to SpookNo do
X`09  BEGIN
X`09    spook`5Be`5D.state := 'M';
X`09    spook`5Be`5D.dir := 0;
X`09  END;
X`09REPEAT
X`09  chk := chk+1;
X`09  If chk = 100 then
X            chk := 0;
X`09  testx := rnd(delay,22);
X`09  testy := rnd(4,37);
X`09  If  ((map`5Btestx,testy`5D     in `5B'.','O','@'`5D)
X`09   and (map`5Btestx-1,testy-1`5D in `5B'.','O','@'`5D)
X`09   and (map`5Btestx-1,testy`5D   in `5B'.','O','@'`5D)
X`09   and (map`5Btestx-1,testy+1`5D in `5B'.','O','@'`5D)
X`09   and (map`5Btestx,testy-1`5D   in `5B'.','O','@'`5D)
X`09   and (map`5Btestx,testy`5D     in `5B'.','O','@'`5D)
X`09   and (map`5Btestx,testy+1`5D   in `5B'.','O','@'`5D)
X`09   and (map`5Btestx+1,testy-1`5D in `5B'.','O','@'`5D)
X`09   and (map`5Btestx+1,testy`5D   in `5B'.','O','@'`5D)
X`09   and (map`5Btestx+1,testy+1`5D in `5B'.','O','@'`5D)) then
X`09    BEGIN `20
X`09      count := succ(count);
X`09      spook`5Bcount`5D.X := testx;
X`09      spook`5Bcount`5D.Y := testy;
X`09      For g := (testx-1) to (testx+1) do
X`09`09For h := (testy-1) to (testy+1) do
X`09`09  qio_write (VT100_esc+'`5B'+dec(g)+';'+dec(h)+'H ');
X`09      qio_write (VT100_esc+'`5B'+dec(testx)+';'+dec(testy)+'H'+VT100_esc+
V'`5B1m*'+VT100_esc+'`5Bm');
X`09      For g := (testx-1) to (testx+1) do
X`09`09For h := (testy-1) to (testy+1) do
X`09          map`5Bg,h`5D := ' ';
X`09      map`5Btestx,testy`5D := count;
X`09    END;
X`09UNTIL count = SpookNo;
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE GenerateRocks;
XVAR
X`09go`09: boolean;
X`09chk,
X`09v,
X`09testx,
X`09testy`09: integer;
X`09count`09: char;
XBEGIN
X`09chk := 0;
X`09count := '0';
X`09REPEAT
X`09  chk := chk+1;
X`09  If chk = 100 then
X            chk := 0;
X`09  go := true;
X`09  testx := rnd(4,18);
X`09  testy := rnd(4,36);
X`09  For v := 4 to 18 do
X`09    If ((map`5Bv,testy`5D = 'a')
X`09     or (map`5Bv,testy-1`5D = 'a')
X`09     or (map`5Bv,testy+1`5D = 'a')) then
X`09      go := false;
X`09  If ((not (map`5Btestx+1,testy`5D in `5B' ','0'..'9'`5D)) and go) then
X`09    BEGIN
X`09      count := succ(count);
X`09      qio_write (VT100_esc+'`5B'+dec(testx)+';'+dec(testy)+'H'+VT100_esc+
V'`5B1m'+'a'+VT100_esc+'`5Bm');
X`09      map`5Btestx,testy`5D := 'a';
X`09    END;
X`09UNTIL count = '6';
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE GeneratePick;
XVAR
X`09chk,
X`09testx,
X`09testy`09: integer;
X`09count`09: char;
XBEGIN
X`09count := '0';
X`09chk := 0;
X`09REPEAT
X`09  chk := chk+1;
X`09  If chk = 100 then
X            chk := 0;
X`09  testx := rnd(4,19);
X`09  testy := rnd(4,36);
X`09  If (map`5Btestx,testy`5D in `5B'.','O','@'`5D) then
X`09    BEGIN
X`09      count := succ(count);
X`09      qio_write (VT100_esc+'`5B'+dec(testx)+';'+dec(testy)+'H'+VT100_esc+
V'`5B1m'+'T'+VT100_esc+'`5Bm');
X`09      map`5Btestx,testy`5D := 'T';
X`09    END;
X`09UNTIL count = '1';
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE GenerateUranium;
XVAR
X`09chk,
X`09testx,
X`09testy`09: integer;
X`09count`09: char;
XBEGIN
X`09count := '0';
X`09chk := 0;
X`09REPEAT
X`09  chk := chk+1;
X`09  If chk = 100 then
X            chk := 0;
X`09  testx := rnd(4,19);
X`09  testy := rnd(4,36);
X`09  If map`5Btestx,testy`5D in `5B'.','O','@'`5D then
X`09    BEGIN
X`09      count := succ(count);
X`09      qio_write (VT100_esc+'`5B'+dec(testx)+';'+dec(testy)+'H'+VT100_esc+
V'`5B1m'+'U'+VT100_esc+'`5Bm');
X`09      map`5Btestx,testy`5D := 'U';
X`09    END;
X`09UNTIL count = '8';
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE GenerateMe;
XVAR
X`09chk`09: integer;
XBEGIN
X`09chk := 0;
X`09MeX := 2;
X`09REPEAT
X`09  chk := chk+1;
X`09  If chk = 100 then
X            chk := 0;
X`09  MeY := rnd(3,38);
X`09UNTIL map`5B2,MeY`5D in `5B'.',' '`5D;
X`09qio_write (VT100_esc+'`5B'+dec(MeX)+';'+dec(MeY)+'H'+VT100_esc+'`5B1m'+'`
V60'+VT100_esc+'`5Bm');
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE GenerateDetails;
XBEGIN
X`09GenerateMe;
X`09GenerateSpooks;
X`09GenerateRocks;
X`09GeneratePick;
X`09GenerateUranium;
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE killspook(k : char; how : char := 'L');
XBEGIN
X`09If spook`5Bk`5D.X < 8 then
X`09  score := score+1
X`09Else
X`09  If spook`5Bk`5D.X < 16 then
X`09    score := score+3
X`09  Else
X`09    score := score+5;
X`09If (lastspook and (how <> 'R')) then
X`09  score := score+100;
X`09If how = 'L' then
X`09  score := score+15
X`09Else
X`09  score := score+30;
X`09UpdateScore;
X`09map`5Bspook`5Bk`5D.X,spook`5Bk`5D.Y`5D := ' ';
X`09spook`5Bk`5D := spook`5BSpookNo`5D;
X`09SpookNo := pred(SpookNo);
X`09If SpookNo = '0' then
X`09  lastspook := true;
X`09If SpookNo < '0' then
X`09  spookgone := true;
X`09qio_write (beep);
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE MoveUp(obj,bckgrd : char);
XBEGIN
X`09If not (map`5Bx-1,y`5D in `5B'a','q','x','k','l','m','j'`5D) then
X`09  BEGIN
X`09    x := x-1;
X`09    qio_write (VT100_esc+'`5BD'+bckgrd+VT100_esc+'`5BD'+VT100_esc+'`5BA'+
VVT100_esc+'`5B1m'+obj+VT100_esc+'`5Bm');
X`09  END;
XEND;
X
X`7B*************************************************************************
V****`7D
X
XPROCEDURE MoveDown(obj,bckgrd : char);
XBEGIN
X`09If not (map`5Bx+1,y`5D in `5B'a','q','x','k','l','m','j'`5D) then
X`09  BEGIN
X`09    x := x+1;
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-