$! ------------------ 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:21:53.45 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. BUNNY.PAS;1 $! 3. BUNNY.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 BUNNY X$ LINK BUNNY, INTERACT/LIB X$ DELETE *.OBJ;*/NOCONFIRM X$ EXIT $ CALL UNPACK BUILD.COM;1 1696273735 $ create 'f' X`5B Inherit ('INTERACT') `5D X XProgram Bunny_Hunt (ins_file); X XCONST X hole_pos = 11; X XTYPE X one_nine = 1..9; X two = array`5B1..2`5D of integer; X two_char = Packed Array`5B1..2`5D of char; X one_10 = Packed Array`5B1..10`5D of char; X one_17 = Packed Array`5B1..17`5D of char; X one_49 = Packed Array`5B1..49`5D of char; X super_b_type = record X pos : two; X sb_level:integer; X end; X X bunny_type = record X pos : two; X alive : boolean; X end; X X level_type = record X any_bunnies : boolean; X bunny : array`5B1..20`5D of bunny_type; X end; X Xvar`20 X last_pos, X evador : two; X max_g_at : array`5Bone_nine`5D of integer; X level : array`5Bone_nine`5D of level_type; X score_ch : packed array`5B0..3`5D of char; X ins_file : text; X X super_bunny : super_b_type; X last_at_den, X at_den : two; X seed : real; X ev_speed, score, cmd, X this_level, last_level, X limit, counter, time_thru, bunny_speed, X den_ux, den_uy, den_lx, den_ly, den_dir : integer; X exit, failure, success, X just_turned, next_level_found : boolean; X X XProcedure spot(x,y :integer; ch :char); Xbegin X x := x + 1; y := y + 7; X posn (y,x); X qio_write (ch); Xend; `20 X X XProcedure send_message(x :integer; message :one_49); XVAR X l,k :integer; Xbegin X qio_write (VT100_graphics_off); X for l := 0 to 6 do X begin X posn (32,x+l); X last_pos`5B1`5D := 8888; X for k := 1 to 7 do X qio_write (message`5B(l*7)+k`5D); X end; X qio_write (VT100_graphics_on); Xend; X X XProcedure main_message(x :integer; message :one_17); Xvar l,k :integer; X Xbegin X qio_write (VT100_graphics_off); X posn (9,x); X last_pos`5B1`5D := 8888; X for k := 1 to 17 do X qio_write (message`5Bk`5D); X qio_write (VT100_graphics_on); Xend; X X XProcedure tell_story; Xvar len :integer; X ins_line :varying `5B256`5D of char; X Xbegin X open(ins_file,'Image_dir:bunny.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 main_message(5,' Can''t find the '); X main_message(7,' instructions...'); X main_message(9,' It''s all up to '); X main_message(11,' you now. '); X main_message(15,' Good Luck... '); X end; X qio_1_char; Xend; `20 X X XProcedure assign_bunnies; Xvar k,l :integer; Xbegin X seed := clock; X for k := 1 to 9 do X with level`5Bk`5D do X begin X any_bunnies := true; X for l := 1 to max_g_at`5Bk`5D do X with bunny`5Bl`5D do X begin X alive := true; X case random(4) of X 1 : begin X pos`5B1`5D := random(21); X pos`5B2`5D := random(8); X end; X 2 : begin X pos`5B1`5D := random(8); X pos`5B2`5D := random(21); X end; X 3 : begin X pos`5B1`5D := random(21); X pos`5B2`5D := 13+random(8); X end; X 4 : begin X pos`5B1`5D := 13+random(8); X pos`5B2`5D := random(21); X end X end;`20 X end; X end; Xend;`20 X X XProcedure initialise; Xvar l ,k : integer; Xbegin X for k:=1 to 9 do max_g_at`5Bk`5D := k+4; X assign_bunnies; X bunny_speed:= 1; X time_thru := 1; X this_level := 1; X limit := 1; X ev_speed := 50; X score := 0; X for k := 0 to 3 do`20 X score_ch`5Bk`5D := ' '; X super_bunny.pos`5B1`5D := 11; X super_bunny.pos`5B2`5D := 11; X super_bunny.sb_level := 0; X next_level_found := true; X `7B** Bunny Den **`7D X at_den`5B1`5D := 1; at_den`5B2`5D := 1; den_dir:=3; X den_ux:=21; den_uy:=21; den_lx:=1; den_ly:=1; just_turned := true; Xend;`20 X X XProcedure plot(x,y :integer; ch :char); Xbegin X if ((x in `5B1..21`5D) and (y in `5B1..21`5D)) then X qio_write(Get_posn(y+7,x+1)+ch); Xend; X X XProcedure boom; Xvar ch : char; X k : integer; Xbegin X ch := '.'; X for k := 1 to 2 do X begin X plot(evador`5B1`5D,evador`5B2`5D,ch); plot(evador`5B1`5D+1,evador`5B2` V5D,ch); X plot(evador`5B1`5D-1,evador`5B2`5D-1,ch); plot(evador`5B1`5D,evador`5B2`5D V+1,ch); X plot(evador`5B1`5D+1,evador`5B2`5D-1,ch); plot(evador`5B1`5D-1,evador`5B2` V5D+1,ch); X plot(evador`5B1`5D+2,evador`5B2`5D,ch); plot(evador`5B1`5D-2,evador`5B2` V5D,ch); X plot(evador`5B1`5D+1,evador`5B2`5D+1,ch); plot(evador`5B1`5D,evador`5B2`5D V-1,ch); X plot(evador`5B1`5D,evador`5B2`5D+2,ch); plot(evador`5B1`5D-2,evador`5B2` V5D+2,ch); X plot(evador`5B1`5D-1,evador`5B2`5D-2,ch); plot(evador`5B1`5D+2,evador`5B2` V5D-2,ch); X plot(evador`5B1`5D+2,evador`5B2`5D+2,ch); ch := ' '; X end; Xend; X X XProcedure Draw_level_value; Xbegin X if last_level > 0 then X BEGIN X posn (3,3 + ((10 - last_level) * 2)); X qio_write (' '); X END; X if this_level > 0 then X BEGIN X posn (3,3 + ((10 - this_level) * 2)); X qio_write (chr(this_level + 48)); X END; X last_pos`5B1`5D := 8888; Xend; X X XProcedure draw_new_score; Xvar k :integer; XBegin 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; `20 X X XProcedure sub_draw(value : one_nine; x_val : integer); Xvar l : integer; Xbegin X send_message(x_val+1,' '); X with level`5Bvalue`5D do X for l := 1 to max_g_at`5Bvalue`5D do X begin X if bunny`5Bl`5D.alive then X begin X with bunny`5Bl`5D do X spot( ((pos`5B1`5D-1)DIV(3) + x_val),((pos`5B2`5D-1)DIV(3) + 25),'.' V ); X end; X end; Xend; X X XProcedure draw_next_level_up; Xvar k : integer; Xbegin X if this_level < 9 then X begin X k := this_level; X Repeat X k := k+1; X Until ((level`5Bk`5D.any_bunnies) or (k=9)); X if level`5Bk`5D.any_bunnies then X sub_draw(k,3) X else X send_message(4,' No Upper Level '); X end X else X send_message(4,' On Top Level '); Xend;`20 X X XProcedure draw_next_level_down; Xvar k : integer; Xbegin X if this_level > 1 then X begin X k := this_level; X Repeat X k := k-1; X Until ((level`5Bk`5D.any_bunnies) or (k=1)); X if level`5Bk`5D.any_bunnies X then sub_draw(k,14) X else X send_message(15,' No Lower Level '); X end X else X send_message(15,' On Lowest Level '); Xend;`20 X X X XProcedure plot_bunnies(value :one_nine; chr :char); Xvar k:integer; Xbegin X spot(11,11,'a'); X with level`5Bvalue`5D do X for k := 1 to max_G_at`5Bvalue`5D do X if bunny`5Bk`5D.alive then X with bunny`5Bk`5D do spot(pos`5B1`5D,pos`5B2`5D,chr); X with super_bunny do X begin X if (this_level = sb_level) X then spot(pos`5B1`5D,pos`5B2`5D,'#') X else X begin X if (pos`5B1`5D = 11) and (pos`5B2`5D = 11) X then spot(pos`5B1`5D,pos`5B2`5D,'a') X else spot(pos`5B1`5D,pos`5B2`5D,' '); X end; X end; Xend; `20 X XProcedure move_bunnies; Xvar X l,k : integer; X dir : array`5B1..2`5D of -1..1; X Xbegin X for k := 1 to max_G_at`5Bthis_level`5D do X with level`5Bthis_level`5D.bunny`5Bk`5D do X if alive then X begin X for l := 1 to 2 do X if pos`5Bl`5D < evador`5Bl`5D X then dir`5Bl`5D:=1 X else dir`5Bl`5D:=-1; X spot(pos`5B1`5D,pos`5B2`5D,' '); X if (ABS(pos`5B1`5D - evador`5B1`5D) >= ABS(pos`5B2`5D - evador`5B2`5D)) X then pos`5B1`5D := pos`5B1`5D + dir`5B1`5D X else pos`5B2`5D := pos`5B2`5D + dir`5B2`5D; X if (pos`5B1`5D = evador`5B1`5D) and (pos`5B2`5D = evador`5B2`5D) X then failure := true; X if ((pos`5B1`5D = hole_pos) and (pos`5B2`5D = hole_pos)) X then X begin X alive := false; X case this_level of X 1,2,3 : score := score + (time_thru * this_level); X 4,5,6 : score := score + (2 * time_thru * this_level); X 7,8,9 : score := score + (3 * time_thru * this_level) X end; X draw_new_score; X end X else spot(pos`5B1`5D,pos`5B2`5D,'*'); X if alive then level`5Bthis_level`5D.any_bunnies := true; X end; `7B for k , if alive , with level`5Bthis_level`5D.bunny`5Bk`5D`7D Xend; `20 X X XProcedure Plot_Bunny_den(ch :char); Xvar lx,ly,ux,uy,x,y :integer; X met :boolean; Xbegin X spot(11,11,ch); X Draw_next_level_up; X y:=1; ly:=1; lx:=0; uy:=21; ux:=21; X met := false; X Repeat X x:=lx; X Repeat X x:=x+1; X if not ((x=at_den`5B1`5D) and (y=at_den`5B2`5D)) X then spot(x,y,ch) X else met:=true; X until met or (x=ux); X lx:=lx+1; X if not met then X begin X y:=ly; X Repeat X y:=y+1; X if not ((x=at_den`5B1`5D) and (y=at_den`5B2`5D)) X then spot(x,y,ch) X else met:=true; X until met or (y=uy); X ly:=ly+1; X end; X if not met then X begin X x:=ux; X Repeat X x:=x-1; X if not ((x=at_den`5B1`5D) and (y=at_den`5B2`5D)) X then spot(x,y,ch) X else met:=true; X until met or (x=lx); X ux:=ux-1; X end; X if not met then X begin X y:=uy; X Repeat X y:=y-1; X if not ((x=at_den`5B1`5D) and (y=at_den`5B2`5D)) X then spot(x,y,ch) X else met:=true; X until met or (y=ly); X uy:=uy-1; X end; X until met; Xend;`20 X X XProcedure Close_in_den; X X Function cond_main :boolean; X begin X cond_main := ((evador`5B1`5D >= den_lx) and (evador`5B1`5D <= den_ux) X and (evador`5B2`5D >= den_ly) and (evador`5B2`5D <= den_uy)); X end; X X Function cond_1 :boolean; X begin X cond_1 := (at_den`5B2`5D=den_ly) and (evador`5B1`5D>at_den`5B1`5D) and X (evador`5B1`5Dat_den`5B2`5D) and X (evador`5B2`5Dden_lx) and (evador`5B2`5D=den_uy); X end; X X Function cond_4 :boolean; X begin X cond_4 := (at_den`5B1`5D=den_lx) and (evador`5B2`5Dden_ly) and (evador`5B1`5D=den_lx); X end; X Xbegin`20 X last_pos := last_at_den; X spot(at_den`5B1`5D,at_den`5B2`5D,'a'); X if not just_turned then X begin X if (at_den`5B1`5D=den_ux) and (at_den`5B2`5D=den_ly) then X begin X den_dir:=2; den_ly:=den_ly+1; just_turned := true; X end; X if (at_den`5B1`5D=den_lx) and (at_den`5B2`5D=den_uy) then X begin`20 X den_dir:=4; den_uy:=den_uy-1; just_turned := true; X end; X if (at_den`5B2`5D=den_ly) and (at_den`5B1`5D=den_lx) then X begin X den_dir:=3; den_lx:=den_lx+1; just_turned := true; X end; +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+-