$! ------------------ 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:44:40.07   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. GRANNY.JAI;1
$!       3. GRANNY.PAS;1
$!       4. GRANNY.PIC;1
$!       5. GRANNY.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 GRANNY
X$ LINK GRANNY, INTERACT/LIB
X$ DELETE *.OBJ;*/NOCONFIRM
X$ EXIT
$ CALL UNPACK BUILD.COM;1 253301427
$ create 'f'
X`1B`5BH`1B`5BJ`1B(B`1B`5B0m
X`1B`5B1;1H`1B#6`1B`5B2;1H`1B#3      Y E S   T H A T   W A S   A`1B`5B3;1H`1B
V#4      Y E S   T H A T   W A S   A`1B`5B4;1H`1B#6`1B`5B5;1H`1B#6`1B`5B5;12H
VP O L I C E M A N
X`1B`5B6;1H`1B#6`1B`5B7;1H`1B#6  `1B`5B7m                                `1B`
V5B8;1H`1B#6`1B`5B8;11H `1B`5B0m  `1B(0xx  xx  xx  `1B`5B7m `1B`5B9;1H`1B#6`1
VB`5B9;10H  `1B`5B0m  xx  xx  xx  `1B`5B7m`20
X`1B`5B9;27H `1B`5B10;1H`1B#6`1B`5B10;11H `1B`5B0m  xx  xx  xx  `1B`5B7m `1B`
V5B11;1H`1B#6`1B`5B11;10H  `1B`5B0m  xx  xx  xx  `1B`5B7m  `1B`5B12;1H`1B#6`1
VB`5B12;11H `1B`5B0m  xx  xx  xx  `1B`5B7m`20
X`1B`5B13;1H`1B#6`1B`5B13;10H  `1B`5B0m  xx  xx  xx  `1B`5B7m  `1B`5B14;1H`1B
V#6`1B`5B14;11H `1B`5B0m  xx  xx  xx  `1B`5B7m `1B`5B15;1H`1B#6`1B`5B15;10H
V  `1B`5B0m  xx  xx  xx  `1B`5B7m `20
X`1B`5B16;1H`1B#6`1B`5B16;11H      `1B(B/  \      `1B`5B17;1H`1B#6`1B`5B17;16
VH`1B`5B0m/    \`1B`5B18;1H`1B#6`1B`5B18;15H`1B(0lqqqqqqk`1B`5B19;1H`1B#6`1B`
V5B19;15Hx HOME x`1B`5B20;1H`1B#6`1B`5B20;15Hx SWEETx
X`1B`5B21;1H`1B#6`1B`5B21;15Hx JAIL x`1B`5B22;1H`1B#6`1B`5B22;15Hmqqqqqqj`1B`
V5B23;1H`1B#6`1B`5B1;1H
X`1B(B`1B*
$ CALL UNPACK GRANNY.JAI;1 2101957680
$ create 'f'
X`5B
X  Inherit`20
X    (
X      'SYS$LIBRARY:STARLET',
X      'INTERACT'
X    )
X`5D
X
XPROGRAM  Granny;
X
XCONST
X  max_victims = 20;
X  black  = 'B';
X  child  = 'C';
X  dog    = 'D';
X  granny = 'G';
X  mother = 'M';
X  police = 'P';
X  building  = 50;
X  building1 = 100;
X  building2 = 200;
X  building3 = 300;
X  building4 = 400;
X  building5 = 500;
X  building6 = 600;
X  building7 = 700;
X  building8 = 800;
X  building9 = 900;
X  road     = 0;
X  beep     = chr(7);
X
XTYPE
X  v_array  = varying `5B100`5D of char;
X
XVAR
X  x_posn        : integer;
X  y_posn        : integer;
X  direct        : integer;
X  score         : integer;
X  screen        : array `5B1..40,1..21`5D of integer;
X  command       : char;
X  person_killed : boolean;
X  victim        : array `5B1..max_victims`5D of char;
X  victim_x      : array `5B1..max_victims`5D of integer;
X  victim_y      : array `5B1..max_victims`5D of integer;
X  victim_d      : array `5B1..max_victims`5D of integer;
X  victim_o      : array `5B1..max_victims`5D of integer;
X  odd_even      : boolean;
X
X
XPROCEDURE  Finish;
XBEGIN
X  reset_screen;
X  qio_purge;
X  clear;
X  top_ten (score);
XEND;
X
X
XPROCEDURE Refresh_screen;
XVAR
X  i, x, y, r : integer;
XBEGIN
X  command := ' ';
X  show_graphedt ('granny.scn',wait:=false);
X  posn (x_posn,y_posn);
X  qio_write (VT100_graphics_on+'`60'+VT100_graphics_off);
XEND;
X
X
XPROCEDURE  Setup;
XVAR
X  i, x, y, r : integer;
XBEGIN
X  For x := 1 to 40 do
X    BEGIN
X      screen`5Bx,1`5D := building1;
X      screen`5Bx,2`5D := building1;
X      screen`5Bx,20`5D := building2;
X      screen`5Bx,21`5D := building2;
X    END;
X  For y := 1 to 20 do
X    BEGIN
X      screen`5B1,y`5D := building3;
X      screen`5B2,y`5D := building3;
X      screen`5B39,y`5D := building4;
X      screen`5B40,y`5D := building4;
X    END;
X  For x := 8 to 19 do
X    BEGIN
X      screen`5Bx,6`5D := building5;
X      screen`5Bx,7`5D := building5;
X      screen`5Bx,8`5D := building5;
X      screen`5Bx,9`5D := building5;
X      screen`5Bx,13`5D := building6;
X      screen`5Bx,14`5D := building6;
X      screen`5Bx,15`5D := building6;
X      screen`5Bx,16`5D := building6;
X    END;
X  For x := 24 to 34 do
X    BEGIN
X      screen`5Bx,6`5D := building7;
X      screen`5Bx,7`5D := building7;
X      screen`5Bx,8`5D := building7;
X      screen`5Bx,9`5D := building7;
X      screen`5Bx,13`5D := building8;
X      screen`5Bx,14`5D := building8;
X      screen`5Bx,15`5D := building8;
X      screen`5Bx,16`5D := building8;
X    END;
X
X  For x := 17 to 26 do
X    For y := 8 to 14 do
X      screen`5Bx,y`5D := road;
X
X  For x := 20 to 23 do
X    For y := 10 to 12 do
X      screen`5Bx,y`5D := building9;
X
X  For i := 1 to max_victims do
X    victim`5Bi`5D := ' ';
X
X  x_posn := 22;
X  y_posn := 18;
X  direct := 5;
X  refresh_screen;
XEND;
X
X
XPROCEDURE  Initialize;
XBEGIN
X  show_graphedt ('granny.pic');
X  score := 0;
XEND;
X
X
XPROCEDURE  Get_command;
XBEGIN
X  command := qio_1_char_now;
X  IF ( Upper_case(command) = 'W' ) then
X    refresh_screen;
XEND;
X
X
XPROCEDURE  Check_for_victim;
XVAR
X  i : integer;
XBEGIN
X  For i := 1 to max_victims do
X    IF ( victim`5Bi`5D <> ' ' ) and`20
X       ( victim_x`5Bi`5D = x_posn ) and ( victim_y`5Bi`5D = y_posn ) then
X      BEGIN
X        CASE victim`5Bi`5D of
X          granny : BEGIN
X                     score := score + 100;
X                     posn (16,22);
X                     qio_write ('Gota Granny'+beep);
X                     victim`5Bi`5D := ' ';
X                   END;
X          mother : BEGIN
X                     score := score + 25;
X                     posn (16,22);
X                     qio_write ('Gota Mother'+beep);
X                     victim`5Bi`5D := ' ';
X                   END;
X          black  : BEGIN
X                     score := score + 50;
X                     posn (16,22);
X                     qio_write ('Gota Bonus '+beep);
X                     victim`5Bi`5D := ' ';
X                   END;
X          child  : BEGIN
X                     score := score + 20;
X                     posn (16,22);
X                     qio_write ('Hit The Kid'+beep);
X                     victim`5Bi`5D := ' ';
X                   END;
X          dog    : BEGIN
X                     score := score + 10;
X                     posn (16,22);
X                     qio_write ('Dog Gone   '+beep);
X                     victim`5Bi`5D := ' ';
X                   END;
X          police : BEGIN
X                     show_graphedt ('granny.jai',wait:=false);
X                     sleep (2);
X                     person_killed := true;
X                   END;
X          otherwise;
X        End;
X      END;
XEND;
X
X
XPROCEDURE  Move;
XBEGIN
X  posn (24,23);
X  qio_write (dec(score));
X
X  CASE command of
X    '2' : direct := 2;
X    '4' : direct := 4;
X    '6' : direct := 6;
X    '8' : direct := 8;
X    otherwise;
X  End;
X
X  posn (x_posn,y_posn);
X  CASE direct of
X    2 : BEGIN
X          qio_write (' '+VT100_lf+VT100_bs+VT100_graphics_on+'`60'+VT100_gra
Vphics_off);
X          y_posn := y_posn + 1;
X        END;
X    4 : BEGIN
X          qio_write (' '+VT100_bs+VT100_bs+VT100_graphics_on+'`60'+VT100_gra
Vphics_off);
X          x_posn := x_posn - 1;
X        END;
X    6 : BEGIN
X          qio_write (' '+VT100_graphics_on+'`60'+VT100_graphics_off);
X          x_posn := x_posn + 1;
X        END;
X    8 : BEGIN
X          qio_write (' '+VT100_bs+VT100_esc+'`5BA'+VT100_graphics_on+'`60'+V
VT100_graphics_off);
X          y_posn := y_posn - 1;
X        END;
X    otherwise;
X  End; `7Bcase`7D
X
X  IF ( screen`5Bx_posn,y_posn`5D > building ) then
X    person_killed := true;
X
X  check_for_victim;
XEND;
X
X
XFUNCTION  Possible_door ( x , y : integer; VAR origin : integer ) : boolean;
XVAR
X  i : integer;
X  j : integer;
XBEGIN
X  possible_door := false;
X  IF ( screen`5Bx,y`5D = road ) then
X    FOR i := -1 to 1 do
X      FOR j := -1 to 1 do
X        IF ( screen`5Bx+i,y+j`5D > building ) then
X          BEGIN
X            possible_door := true;
X            origin := screen`5Bx+i,y+j`5D;
X          END;
XEND;
X
X
XPROCEDURE  Move_in_square ( VAR x, y, d : integer );
XBEGIN
X  IF ( d in `5B1,2,3`5D ) then
X    y := y + 1;
X  IF ( d in `5B7,8,9`5D ) then
X    y := y - 1;
X  IF ( d in `5B1,4,7`5D ) then
X    x := x - 1;
X  IF ( d in `5B3,6,9`5D ) then
X    x := x + 1;
XEND;
X
X
XFUNCTION  Move_onto_street ( x,y,d : integer ) : boolean;
XBEGIN
X  move_in_square ( x,y,d );
X  move_onto_street := ( screen `5Bx,y`5D = road );
XEND;
X
X
XPROCEDURE  Picka ( VAR victim : char );
XVAR
X  r : integer;
XBEGIN
X  r := random(15);
X  IF r < 2 then
X    victim := granny
X  ELSE
X  IF r < 6 then
X    victim := dog
X  ELSE
X  IF r < 9 then
X    victim := child
X  ELSE
X  IF r < 11 then
X    victim := black
X  ELSE
X  IF r < 14 then
X    victim := mother
X  ELSE
X    victim := police;
XEND;
X
X
XPROCEDURE  Create_victim;
XVAR
X  nu : integer;
X  n  : integer;
XBEGIN
X  nu := ( score div 100 ) + 3;
X  IF nu > max_victims then
X    nu := max_victims;
X
X  n := 1;
X  WHILE ( n < nu ) and ( victim`5Bn`5D <> ' ' ) do
X    n := n + 1;
X  IF ( n <= nu ) and ( victim`5Bn`5D = ' ' ) then
X    BEGIN
X      picka (victim`5Bn`5D);
X      REPEAT
X        victim_x`5Bn`5D := random(38)+1;
X        victim_y`5Bn`5D := random(19)+1;
X      UNTIL ( possible_door(victim_x`5Bn`5D,victim_y`5Bn`5D,victim_o`5Bn`5D)
V and`20
X            (( victim`5Bn`5D <> police ) or
X           ((( victim_x`5Bn`5D > x_posn + 2 ) or ( victim_x`5Bn`5D < x_posn
V - 2 )) or
X            (( victim_y`5Bn`5D > y_posn + 2 ) or ( victim_y`5Bn`5D < y_posn
V - 2 )))));
X      reset_randomizer;
X      REPEAT
X        victim_d`5Bn`5D := randomize(8);
X        IF victim_d`5Bn`5D > 4 then
X          victim_d`5Bn`5D := victim_d`5Bn`5D + 1;
X      UNTIL ( move_onto_street ( victim_x`5Bn`5D,victim_y`5Bn`5D,victim_d`5B
Vn`5D ) );
X    END;
XEND;
X
X
XPROCEDURE  Turn_and_run ( VAR d : integer );
XVAR
X  r : integer;
XBEGIN
X  reset_randomizer;
X  REPEAT
X    r := randomize(8);
X      IF r > 4 then
X        r := r + 1;
X   UNTIL ( r <> d );
X  d := r;
XEND;
X
X
XPROCEDURE  Move_victims;
XVAR
X  nu : integer;
X  r : integer;
X  x : integer;
X  y : integer;
X  d : integer;
X  outline : v_array;
XBEGIN
X  odd_even := not odd_even;
X  FOR nu := 1 to max_victims do
X    BEGIN
X      outline := '';
X      IF ( victim`5Bnu`5D = '`7E' ) then
X        BEGIN
X          outline := outline +`20
X              get_posn (victim_x`5Bnu`5D,victim_y`5Bnu`5D) + VT100_inverse +
V ' ' + VT100_normal;
X          victim`5Bnu`5D := ' ';
X        END
X      ELSE
X      IF (( odd(nu) and odd_even ) or ( not odd(nu) and not odd_even )) and
X       ( victim`5Bnu`5D <> ' ' ) then
X        BEGIN
X          outline := outline + get_posn (victim_x`5Bnu`5D,victim_y`5Bnu`5D)
V + ' ';
X `20
X          r := random(3);
X          IF r = 1 then
X            BEGIN
X              victim_d`5Bnu`5D := random(8);
X              IF victim_d`5Bnu`5D > 4 then
X                victim_d`5Bnu`5D := victim_d`5Bnu`5D + 1;
X            END;
X          x := victim_x`5Bnu`5D;
X          y := victim_y`5Bnu`5D;
X          d := victim_d`5Bnu`5D;
X          move_in_square ( x,y,d );
X          WHILE (( x = x_posn ) and ( y = y_posn ) and`20
X                not ( victim`5Bnu`5D = police )) or ( screen`5Bx,y`5D = vict
Vim_o`5Bnu`5D ) do
X            BEGIN
X              turn_and_run ( victim_d`5Bnu`5D );
X              x := victim_x`5Bnu`5D;
X              y := victim_y`5Bnu`5D;
X              d := victim_d`5Bnu`5D;
X              move_in_square ( x,y,d );
X            END;
X `20
X          move_in_square ( victim_x`5Bnu`5D,victim_y`5Bnu`5D,victim_d`5Bnu`5
VD );
X  `20
X          IF ( screen `5Bvictim_x`5Bnu`5D,victim_y`5Bnu`5D`5D > building ) t
Vhen
X            victim`5Bnu`5D := '`7E';
X `20
X          outline := outline + get_posn (victim_x`5Bnu`5D,victim_y`5Bnu`5D)
V + victim`5Bnu`5D;
X      END;
X      qio_write (outline);
X    END;
XEND;
X
XBEGIN
X  Initialize;
X  setup;
X  REPEAT
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-