$! ------------------ 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 02:48:31.14 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 $! $! 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. CATCH.PAS;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 CATCH X$ LINK CATCH, INTERACT/LIB X$ DELETE *.OBJ;*/NOCONFIRM X$ EXIT $ CALL UNPACK BUILD.COM;1 1862404911 $ create 'f' X`5B Inherit ('INTERACT') `5D X Xprogram catch; X XTYPE`20 X string2 = packed array`5B1..2`5D of char; X XVAR i,j,x,y,numberstar, X think,score,mult, X howmanystar :integer; X esc,direction :char; X grid :array`5B0..18,0..18`5D of char; X ranvalue :real; X finish,catch :boolean; X timeran :packed array`5B1..11`5D of char; X X XPROCEDURE help; XBEGIN X posn (11,1); X clear; X qio_writeln (' Welcome to catch'); X qio_writeln (' `7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7E`7 VE'); X qio_writeln ('The idea of the game is to move the # about'); X qio_writeln ('the box , shown on the screen , using the'); X qio_writeln ('following keys-'); X qio_writeln (VT100_graphics_on); X qio_writeln (' l `5E k'); X qio_writeln (' \ x /'); X qio_writeln (' 7 8 9'); X qio_writeln (' '); X qio_writeln (' 1 2 3'); X qio_writeln (' / x \'); X qio_writeln (' m V j'); X qio_write (VT100_graphics_off); X qio_writeln (' point is given every time you move'); X qio_writeln ('But as you move around one of the 8 squares'); X qio_writeln ('around you will be blocked by a star.'); X qio_writeln ('You cannot move on to a star and you can not'); X qio_writeln ('move over the edges.'); X qio_writeln ('The highest score possible is 288 (I think).'); X qio_writeln ('See how close you can get to 288.'); X qio_writeln; X qio_writeln (' press to start'); X qio_1_char; XEND; X XPROCEDURE drawbox; XBEGIN X posn (1,1); X clear; X posn (18,1); X qio_write (VT100_top+'Catch'); X posn (18,2); X qio_write (VT100_bottom+'Catch'); X posn (18,3); X qio_write (VT100_wide+'`7E`7E`7E`7E`7E'); X qio_write (VT100_graphics_on); X posn (11,4); X qio_write (VT100_wide+'lqqqqqqqqqqqqqqqqqk'); X FOR i := 1 TO 17 DO X BEGIN X posn (11,4+i); X qio_write (VT100_wide+'x x'); X END; X posn (11,22); X qio_write (VT100_wide+'mqqqqqqqqqqqqqqqqqj'); X posn (20,13); X qio_write ('#'); X qio_write (VT100_graphics_off); X posn (31,4); X qio_write ('Score'); X posn (31,5); X qio_write ('-----'); X posn (33,6); X qio_write ('0'); X posn (1,13); X qio_write ('Type "e"'); X posn (1,14); X qio_write ('to exit'); XEND`7Bdrawbox`7D; X XPROCEDURE position(x,y:integer;character:char); X XBEGIN X x := x + 11; X y := y + 4; X posn (x,y); X qio_write (character); XEND`7Bposition`7D; X XPROCEDURE starcount(xstart,xfinish,ystart,yfinish:integer); X XVAR i,j :integer; X XBEGIN X numberstar := 0; X FOR i := xstart TO xfinish DO X`09FOR j := ystart TO yfinish DO X`09 IF (i <> 0) OR (j <> 0) THEN X`09`09IF (grid`5Bx + i,y + j`5D = '*') THEN X`09`09 numberstar := numberstar + 1; XEND`7Bstarcount`7D; X XPROCEDURE finalstar(xdisplace,ydisplace:integer); X XBEGIN X IF grid`5Bx + xdisplace,y + ydisplace`5D <> '*' THEN X`09BEGIN X`09 grid`5Bx + xdisplace,y + ydisplace`5D := '*'; X`09 position(x + xdisplace,y + ydisplace,'*'); X`09 finish := true; X`09END X ELSE X`09think := think + 1; XEND`7Bfinalstar`7D; X XPROCEDURE mainstar; X XBEGIN X starcount(-1,1,-1,1); X numberstar := 8 - numberstar; X IF numberstar = 1 THEN X `09catch := true; X think :=random(numberstar); X finish := false; X WHILE (finish = false) DO X`09CASE think OF X`09 1:finalstar(-1,-1); X`09 2:finalstar(0,-1); X`09 3:finalstar(-1,0); X`09 4:finalstar(1,-1); X`09 5:finalstar(-1,1); X`09 6:finalstar(1,0); X`09 7:finalstar(0,1); X`09 8:finalstar(1,1); X`09END; XEND`7Bmainstar`7D; X XPROCEDURE move; X XVAR overedge,commanderror :boolean; X tempx,tempy,numberstar :integer; X XBEGIN X overedge := false; X commanderror := false; X posn (1,17); X qio_write (' '); X posn (1,16); X qio_write ('Move'); X direction := qio_1_char; X posn (1,4); X qio_write (' '); X tempx := x; X tempy := y; X IF (direction >= '1') AND (direction <= '9') X AND (direction <> '5') THEN X`09CASE direction OF X`09 '1':IF (x > 1) AND (y < 17) THEN X`09`09BEGIN X`09`09 tempx := x - 1; X`09`09 tempy := y + 1; X`09 `09END X`09 ELSE X`09 overedge := true; X`09 '2':IF y < 17 THEN X`09 tempy := y + 1 X`09 ELSE X`09 overedge := true; X`09 '3':IF (x < 17) AND (y < 17) THEN X`09 `09BEGIN X`09`09 tempx := x + 1; X`09`09 tempy := y + 1; X`09 `09END X`09 ELSE X`09 `09overedge := true; X`09 '4':IF x > 1 THEN X`09`09tempx := x - 1 X`09 ELSE X`09`09overedge := true; X`09 '6':IF x < 17 THEN X`09`09tempx := x + 1 X`09 ELSE X`09`09overedge := true; X`09 '7':IF (x > 1) AND (y > 1) THEN X`09`09BEGIN X`09`09 tempx := x - 1; X`09`09 tempy := y - 1; X`09`09END X`09 ELSE X`09`09overedge := true; X`09 '8':IF y > 1 THEN X`09`09tempy := y - 1 X`09 ELSE X`09`09overedge := true; X`09 '9':IF (x < 17) AND (y > 1) THEN X`09`09BEGIN X`09`09 tempx := x + 1; X`09`09 tempy := y - 1; X`09`09END X`09 ELSE X`09`09overedge := true; X `09END X ELSE X`09commanderror := true; X IF grid`5Btempx,tempy`5D = '*' THEN X BEGIN X posn (1,4); X`09qio_write ('On to star'+chr(7)); X END X ELSE X IF overedge THEN X BEGIN X posn (1,4); X`09qio_write ('Over edge'+chr(7)); X END X ELSE X IF (direction <> 'e') AND (direction <> 'E') THEN X IF commanderror THEN X BEGIN X`09posn (1,4); X qio_write ('Try again'+chr(7)); X END X ELSE X`09BEGIN X`09 position(x,y,' '); X`09 position(tempx,tempy,'#'); X`09 x := tempx; X`09 y := tempy; X`09 mainstar; X`09 IF catch THEN X`09`09BEGIN X`09`09 posn (14,23); X qio_write (VT100_wide+'You are caught'); X`09`09 qio_write (chr(7)); X posn (1,16); X qio_write (chr(7)); X`09`09 direction := 'e'; X`09`09END; X`09 score := score + 1; X`09 posn (32,6); X qio_write (dec(score,,2)); X`09END; XEND`7Bmove`7D; X XBEGIN`7Bmainline`7D X esc := chr(155); X reset_screen; X ranvalue := 0.0; X time(timeran); X mult := (ord(timeran`5B11`5D) - 48)*1000000 + (ord(timeran`5B10`5D) - 48 V)*10000000; X posn (1,1); X clear; X qio_write ('Do you require instructions (y/n) '); X IF ( qio_1_char in `5B'y','Y'`5D ) THEN X help; X score := 0; X FOR i := 0 TO 18 DO X`09BEGIN X`09 grid`5B0,i`5D := '*'; X`09 grid`5B18,i`5D := '*'; X`09END; X FOR i := 1 TO 17 DO X`09BEGIN X`09 grid`5Bi,0`5D := '*'; X`09 grid`5Bi,18`5D := '*'; X`09END; X FOR i := 1 TO 17 DO X `09FOR j := 1 TO 17 DO X `09 grid`5Bi,j`5D := ' '; X x := 9; X y := 9; `20 X drawbox; X WHILE (direction <> 'e') AND (direction <> 'E') DO X move; X posn (1,17); X qio_write (' '); X posn (1,23); X top_ten (score); XEND. $ CALL UNPACK CATCH.PAS;1 375281496 $ v=f$verify(v) $ EXIT