$! ------------------ 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:01:32.52 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. CHICKEN.PAS;1 $! 3. CHICKEN.PIC;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 CHICKEN X$ LINK CHICKEN, INTERACT/LIB X$ DELETE *.OBJ;*/NOCONFIRM X$ EXIT $ CALL UNPACK BUILD.COM;1 252207749 $ create 'f' X`5B X Inherit`20 X ( X 'SYS$LIBRARY:STARLET', X 'INTERACT' X ) X`5D X XPROGRAM Chicken ( input , output ); X XCONST X max_chickens = 5; X max_shots = 5; X space = 0; X chicken = 1; X player = 2; X shot = 3; X wall = 4; X top = 1; X bot = 23; X lef = 5; X rig = 40; X shoot = ' '; X XVAR X x_posn : integer; X y_posn : integer; X direct : integer; X screen : array `5Blef..rig,top..bot`5D of integer; X x_chicken : array `5B1..max_chickens`5D of integer; X y_chicken : array `5B1..max_chickens`5D of integer; X d_chicken : array `5B1..max_chickens`5D of integer; X chicken_alive : array `5B1..max_chickens`5D of boolean; X command : char; X l_score : integer; X score : integer; X person_killed : boolean; X x_shot : array `5B1..max_shots`5D of integer; X y_shot : array `5B1..max_shots`5D of integer; X d_shot : array `5B1..max_shots`5D of integer; X shot_alive : array `5B1..max_shots`5D of boolean; X beep : boolean := true; X X XPROCEDURE Refresh_screen; XVAR X i, y : integer; XBEGIN X clear; X FOR y := top to bot do X BEGIN X posn (1,y); X qio_write (VT100_wide); X END; X Square (lef,top,rig,bot); X FOR i := 1 to max_chickens do X IF chicken_alive`5Bi`5D then X BEGIN X posn (x_chicken`5Bi`5D,y_chicken`5Bi`5D); X qio_write ('C'); X END; 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 command := ' '; X clear; X FOR y := top to bot do X BEGIN X posn (1,y); X qio_write (VT100_wide); X END; X Square (lef,top,rig,bot); X X FOR x := lef to rig do X screen`5Bx,top`5D := wall; X FOR x := lef to rig do X screen`5Bx,bot`5D := wall; X FOR y := top to bot do X screen`5Blef,y`5D := wall; X FOR y := top to bot do X screen`5Brig,y`5D := wall; X X FOR i := 1 to max_chickens do X chicken_alive`5Bi`5D := false; X FOR i := 1 to max_shots do X shot_alive`5Bi`5D := false; X person_killed := false; X X x_posn := random(rig-lef-11)+lef+5; X y_posn := random(bot-top-11)+top+5; X direct := random(8); X IF direct > 4 then X direct := direct + 1; X X posn (1,2); X qio_write ('0'); XEND; X X XPROCEDURE Initialize; XBEGIN X image_dir; X show_graphedt ('chicken.pic'); X score := 0; X l_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 Move_in_square ( VAR x, y, d : integer ); XBEGIN X IF ( d in `5B1,2,3`5D ) and ( screen`5Bx,y+1`5D = wall ) then X d := d + 6; X IF ( d in `5B7,8,9`5D ) and ( screen`5Bx,y-1`5D = wall ) then X d := d - 6; X IF ( d in `5B1,4,7`5D ) and ( screen`5Bx-1,y`5D = wall ) then X d := d + 2; X IF ( d in `5B3,6,9`5D ) and ( screen`5Bx+1,y`5D = wall ) then`20 X d := d - 2; X 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 XPROCEDURE Create_shot; XVAR X n : integer; XBEGIN X n := 1; X WHILE ( n < max_shots ) and ( shot_alive`5Bn`5D ) do X n := n + 1; X IF not ( shot_alive`5Bn`5D ) then X BEGIN X shot_alive`5Bn`5D := true; X x_shot`5Bn`5D := x_posn; X y_shot`5Bn`5D := y_posn; X d_shot`5Bn`5D := direct; X screen`5Bx_posn,y_posn`5D := shot; X END; XEND; X X XPROCEDURE Find_delete_shot ( x, y : integer ); XVAR X n : integer; XBEGIN X FOR n := 1 to max_shots do X IF ( x_shot`5Bn`5D = x ) and ( y_shot`5Bn`5D = y ) then X shot_alive`5Bn`5D := false; XEND; X X `20 XPROCEDURE Find_and_kill_chicken ( x, y : integer ); XVAR X i : integer; XBEGIN X FOR i := 1 to max_chickens do X IF ( x_chicken`5Bi`5D = x ) and ( y_chicken`5Bi`5D = y ) then X chicken_alive`5Bi`5D := false; XEND; X X XPROCEDURE Move_shots; XVAR X n : integer; XBEGIN X`7B step 1 `7D X FOR n := 1 to max_shots do X IF ( shot_alive`5Bn`5D ) then X BEGIN X screen `5Bx_shot`5Bn`5D,y_shot`5Bn`5D`5D := space; X posn (x_shot`5Bn`5D,y_shot`5Bn`5D); X qio_write (' '); X X move_in_square ( x_shot`5Bn`5D,y_shot`5Bn`5D,d_shot`5Bn`5D ); X X IF ( screen `5Bx_shot`5Bn`5D,y_shot`5Bn`5D`5D = player ) then X BEGIN X person_killed := true; X find_delete_shot(x_shot`5Bn`5D,y_shot`5Bn`5D); X END X ELSE X IF ( screen `5Bx_shot`5Bn`5D,y_shot`5Bn`5D`5D = shot ) then X BEGIN X screen `5Bx_shot`5Bn`5D,y_shot`5Bn`5D`5D := space; X find_delete_shot(x_shot`5Bn`5D,y_shot`5Bn`5D); X posn (x_shot`5Bn`5D,y_shot`5Bn`5D); X qio_write (' '); X END X ELSE X IF ( screen `5Bx_shot`5Bn`5D,y_shot`5Bn`5D`5D = chicken ) then X BEGIN X shot_alive`5Bn`5D := false; X find_and_kill_chicken (x_shot`5Bn`5D,y_shot`5Bn`5D); X screen `5Bx_shot`5Bn`5D,y_shot`5Bn`5D`5D := space; X posn (x_shot`5Bn`5D,y_shot`5Bn`5D); X qio_write (' '); X score := score + 5; X END X ELSE X screen `5Bx_shot`5Bn`5D,y_shot`5Bn`5D`5D := shot; X END; X`7B step 2 `7D X FOR n := 1 to max_shots do X IF ( shot_alive`5Bn`5D ) then X BEGIN X screen `5Bx_shot`5Bn`5D,y_shot`5Bn`5D`5D := space; X X move_in_square ( x_shot`5Bn`5D,y_shot`5Bn`5D,d_shot`5Bn`5D ); X X IF ( screen `5Bx_shot`5Bn`5D,y_shot`5Bn`5D`5D = player ) then X BEGIN X person_killed := true; X find_delete_shot(x_shot`5Bn`5D,y_shot`5Bn`5D); X END `20 X ELSE X IF ( screen `5Bx_shot`5Bn`5D,y_shot`5Bn`5D`5D = shot ) then X BEGIN X screen `5Bx_shot`5Bn`5D,y_shot`5Bn`5D`5D := space; X find_delete_shot(x_shot`5Bn`5D,y_shot`5Bn`5D); X posn (x_shot`5Bn`5D,y_shot`5Bn`5D); X qio_write (' '); X END X ELSE X IF ( screen `5Bx_shot`5Bn`5D,y_shot`5Bn`5D`5D = chicken ) then X BEGIN X shot_alive`5Bn`5D := false; X find_and_kill_chicken (x_shot`5Bn`5D,y_shot`5Bn`5D); X screen `5Bx_shot`5Bn`5D,y_shot`5Bn`5D`5D := space; X posn (x_shot`5Bn`5D,y_shot`5Bn`5D); X qio_write (' '); X score := score + 5; X END X ELSE X BEGIN X screen `5Bx_shot`5Bn`5D,y_shot`5Bn`5D`5D := shot; X posn (x_shot`5Bn`5D,y_shot`5Bn`5D); X qio_write ('.'); X END; X END; XEND; X X XPROCEDURE Move; XBEGIN X posn (x_posn,y_posn); X qio_write (' '); X screen`5Bx_posn,y_posn`5D := space; X X CASE command of X 'B' : beep := not beep; X '1' : direct := 1; X '2' : direct := 2; X '3' : direct := 3; X '4' : direct := 4; X '6' : direct := 6; X '7' : direct := 7; X '8' : direct := 8; X '9' : direct := 9; X otherwise; X End; `7Bcase`7D X X move_in_square ( x_posn,y_posn,direct ); X X IF ( screen`5Bx_posn,y_posn`5D = chicken ) then X person_killed := true X ELSE X IF ( screen`5Bx_posn,y_posn`5D = shot ) then X person_killed := true X ELSE X BEGIN X posn (x_posn,y_posn); X qio_write ('*'); X screen `5Bx_posn,y_posn`5D := player; X END; XEND; X X XFUNCTION Corner_too_close ( r : integer ) : boolean; XBEGIN X Corner_too_close := X (( r = 1 ) and ( x_posn < lef+5 ) and ( y_posn < top+5 )) or X (( r = 2 ) and ( x_posn > rig-5 ) and ( y_posn < top+5 )) or X (( r = 3 ) and ( x_posn < lef+5 ) and ( y_posn > bot-5 )) or X (( r = 4 ) and ( x_posn > rig-5 ) and ( y_posn > bot-5 )); XEND; X X XPROCEDURE Create_chickens; XVAR X nu : integer; X n : integer; X r : integer; XBEGIN X nu := ( score div 50 ) + 1; X IF ( nu > max_chickens ) then X nu := max_chickens; X X IF ( nu > 0 ) then X BEGIN X n := 1; X WHILE ( n < nu ) and ( chicken_alive`5Bn`5D ) do X n := n + 1; X IF not ( chicken_alive`5Bn`5D ) then X BEGIN X IF beep then X qio_write (chr(7)); X chicken_alive`5Bn`5D := true; X reset_randomizer; X REPEAT X r := random(4); X UNTIL ( NOT corner_too_close(r) ); X CASE r of X 1 : BEGIN X x_chicken`5Bn`5D := lef+1; X y_chicken`5Bn`5D := top+1; X END; X 2 : BEGIN X x_chicken`5Bn`5D := rig-1; X y_chicken`5Bn`5D := top+1; X END; X 3 : BEGIN X x_chicken`5Bn`5D := lef+1; X y_chicken`5Bn`5D := bot-1; X END; X 4 : BEGIN X x_chicken`5Bn`5D := rig-1; X y_chicken`5Bn`5D := bot-1; X END; X End; X d_chicken`5Bn`5D := random(8); X IF d_chicken`5Bn`5D > 4 then X d_chicken`5Bn`5D := d_chicken`5Bn`5D + 1; X END; X END; XEND; X X XPROCEDURE Turn_chickens ( x , y : integer ); XVAR X i : integer; XBEGIN X FOR i := 1 to max_chickens do X IF ( chicken_alive`5Bi`5D ) and`20 X ( x_chicken`5Bi`5D = x ) and ( y_chicken`5Bi`5D = y ) then X BEGIN X d_chicken`5Bi`5D := random(8); X IF d_chicken`5Bi`5D > 4 then X d_chicken`5Bi`5D := d_chicken`5Bi`5D + 1; X END; XEND; X X XPROCEDURE Move_chickens; XVAR X nu : integer; X r : integer; XBEGIN X FOR nu := 1 to max_chickens do X IF ( chicken_alive`5Bnu`5D ) then X BEGIN X screen `5Bx_chicken`5Bnu`5D,y_chicken`5Bnu`5D`5D := space; X posn (x_chicken`5Bnu`5D,y_chicken`5Bnu`5D); X qio_write (' '); X X move_in_square ( x_chicken`5Bnu`5D,y_chicken`5Bnu`5D,d_chicken`5Bnu` V5D ); X X IF ( screen `5Bx_chicken`5Bnu`5D,y_chicken`5Bnu`5D`5D = player ) the Vn X person_killed := true X ELSE X IF ( screen `5Bx_chicken`5Bnu`5D,y_chicken`5Bnu`5D`5D = shot ) then X BEGIN X chicken_alive`5Bnu`5D := false; X screen `5Bx_chicken`5Bnu`5D,y_chicken`5Bnu`5D`5D := space; X find_delete_shot(x_chicken`5Bnu`5D,y_chicken`5Bnu`5D); X posn (x_chicken`5Bnu`5D,y_chicken`5Bnu`5D); X qio_write (' '); X score := score + 5; X END X ELSE X IF ( screen `5Bx_chicken`5Bnu`5D,y_chicken`5Bnu`5D`5D = chicken ) th Ven X turn_chickens (x_chicken`5Bnu`5D,y_chicken`5Bnu`5D) X ELSE X BEGIN X screen `5Bx_chicken`5Bnu`5D,y_chicken`5Bnu`5D`5D := chicken; X posn (x_chicken`5Bnu`5D,y_chicken`5Bnu`5D); X qio_write ('C'); X END; X END; XEND; X X XBEGIN X Initialize; X setup; X REPEAT X sleep_start(20); X get_command; X move; X IF not person_killed then X IF ( command = shoot ) then X create_shot; X IF not person_killed then X move_shots; X IF not person_killed then X create_chickens; X IF not person_killed then X move_chickens; X IF l_score <> score then X BEGIN +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+-