$! ------------------ 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 +-+-+-+-+-+-+-+-