$! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-007 22-FEB-1990 $! On 4-JUN-1992 01:11:30.43 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. TUNNEL.DAT;1 $! 3. TUNNEL.PAS;1 $! 4. TUNNEL.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 TUNNEL X$ LINK TUNNEL,INTERACT/LIB,UTIL/LIB X$ DELETE/NOCONFIRM *.OBJ;* X$ EXIT $ CALL UNPACK BUILD.COM;1 269249584 $ create 'f' Xaskdjhaskjdhaskjdhkasjhskjhd $ CALL UNPACK TUNNEL.DAT;1 1668180605 $ create 'f' X`5B X Inherit`20 X ( X 'SYS$LIBRARY:STARLET', X 'INTERACT' X ) X`5D X XPROGRAM Tunnel ( input , output ); X XTYPE X Pointer = `5Elist; X list = Record X left_side : integer; X right_side : integer; X prev : pointer; X next : pointer; X End; X v_array = varying `5B256`5D of char; XVAR X x_posn : integer; X score : integer; X command : char; X game_over : boolean; X head : pointer; X this : pointer; X line : pointer; X width : integer; X X XPROCEDURE Handler ( exitreason : integer := 1 ); XBEGIN X reset_screen; X clear; X qio_write (vt100_esc+'`5B?5l'); XEND; X X XPROCEDURE Finish; XBEGIN X reset_screen; X qio_write (vt100_esc+'`5B?5l'); X qio_purge; X clear; X top_ten (score); XEND; X X XPROCEDURE Setup; XVAR X i : integer; XBEGIN X clear; X posn (1,1); X qio_write (vt100_esc+'`5B?5h'); X qio_write (vt100_esc+'`5B7m'); X FOR i := 1 to 23 do X qio_writeln (vt100_wide+' '); X x_posn := 20; X NEW (head); X this := head; X FOR i := 1 to 22 do X BEGIN X NEW (line); X this`5E.next := line; X line`5E.prev := this; X this := line; X line`5E.left_side := 1; X line`5E.right_side := 40; X END; X head`5E.left_side := 1; X head`5E.right_side := 40; X head`5E.prev := line; X line`5E.next := head; X width := 10; X this`5E.left_side := 16; X this`5E.right_side := 26; X posn (this`5E.left_side+1,24); X qio_write (vt100_wide); X FOR i := 1 to width do X qio_write (' '); X qio_write (vt100_esc+'D'+vt100_wide); X posn (x_posn,1); X qio_write ('O'); XEND; X X XPROCEDURE Initialize; XBEGIN X image_dir; X show_graphedt ('tunnel.pic'); X score := 0; X Setup_handler(iaddress(handler)); X Force; XEND; X X XPROCEDURE Get_command; XVAR X last : char; XBEGIN X last := command; X command := qio_1_char_now; X IF ( command = chr(-1) ) then X command := last; XEND; X X XPROCEDURE Move; XVAR X i : integer; X outline : v_array; XBEGIN X score := score + 1; X this := this`5E.next; X X IF command = '1' then X x_posn := x_posn - 1 X ELSE X IF command = '3' then X x_posn := x_posn + 1; X X game_over := ( this`5E.next`5E.left_side >= x_posn ) or X ( this`5E.next`5E.right_side <= x_posn ); X X CASE random(2) of X 1 : IF ( this`5E.prev`5E.left_side > 2 ) then X this`5E.left_side := this`5E.prev`5E.left_side - 1 X ELSE X this`5E.left_side := this`5E.prev`5E.left_side + 1; X 2 : IF ( this`5E.prev`5E.left_side + width < 38 ) then X this`5E.left_side := this`5E.prev`5E.left_side + 1 X ELSE X this`5E.left_side := this`5E.prev`5E.left_side - 1; X End; X X this`5E.right_side := this`5E.left_side + width + 1; X X outline := ''; X FOR i := 1 to width do X outline := outline + ' '; X outline := vt100_esc+'`5B24;'+dec(this`5E.left_side+1)+'H'+ X outline + X vt100_esc+'D'+vt100_wide+ X vt100_esc+'`5B;'+dec(x_posn)+'HO'+ X vt100_cr+dec(score); X qio_write (outline); XEND; X X XBEGIN X Initialize; X setup; X REPEAT X sleep_start (width); X get_command; X move; X sleep_wait; X IF ( (score mod 200) = 0 ) then X BEGIN X qio_write (chr(7)); X width := width - 1; X END; X UNTIL ( game_over ) or ( upper(command) = 'Q' ); X No_handler; X Finish; XEND. $ CALL UNPACK TUNNEL.PAS;1 855709423 $ create 'f' X`1B`5BH`1B`5BJ`1B(B`1B`5B0mOM X`1B`5B1;1H`1B#6`1B`5B7;1m `20 X`1B`5B2;1H`1B#6 `1B`5B2;40H`20 X`1B`5B3;1H`1B#6 `1B`5B0m `1B`5B7;1m`1B(0qqwqq`1B`5B3;40H`20 X`1B`5B4;1H`1B#6 `1B`5B0m `1B`5B7;1mx`1B`5B4;40H`20 X`1B`5B5;1H`1B#6 `1B`5B0m `1B`5B7;1mx`1B`5B0m `1B`5B7;1mx`1B`5B0m `1B` V5B7;1mx`1B`5B0m `1B`5B7;1mlqk`1B`5B0m `1B`5B7;1mlqk`1B`5B0m `1B`5B7;1mlqq`1B V`5B0m `1B`5B7;1mx`1B`5B5;40H`20 X`1B`5B6;1H`1B#6 `1B`5B0m `1B`5B7;1mx`1B`5B0m `1B`5B7;1mx`1B`5B0m `1B` V5B7;1mx`1B`5B0m `1B`5B7;1mx`1B`5B0m `1B`5B7;1mx`1B`5B0m `1B`5B7;1mx`1B`5B0m V `1B`5B7;1mx`1B`5B0m `1B`5B7;1mtq`1B`5B0m `1B`5B7;1mx`1B`5B6;40H`20 X`1B`5B7;1H`1B#6 `1B`5B0m `1B`5B7;1mx`1B`5B0m `1B`5B7;1mmqj`1B`5B0m `1 VB`5B7;1mx`1B`5B0m `1B`5B7;1mx`1B`5B0m `1B`5B7;1mx`1B`5B0m `1B`5B7;1mx`1B`5B0 Vm `1B`5B7;1mmqq`1B`5B0m `1B`5B7;1mmqq`1B`5B7;40H`20 X`1B`5B8;1H`1B#6 `1B`5B8;40H`20 X`1B`5B9;1H`1B#6 `1B`5B0m `1B(BP.DENIZE & S.TRAVAGLIA`1B`5B9;40H`1B`5B7 V;1m`20 X`1B`5B10;1H`1B#6 `20 X`1B`5B11;1H`1B#6 `1B`5B11;40H`20 X`1B`5B12;1H`1B#6 `1B`5B12;40H`20 X`1B`5B13;1H`1B#6 `1B`5B0m Drive down the tunnel using the keys `1B`5B7;1m`20 X`1B`5B14;1H`1B#6 `1B`5B14;40H`20 X`1B`5B15;1H`1B#6 `1B`5B0m (1)..Left (2)..Stop (3)..Right `1B`5B7;1m`20 X`1B`5B16;1H`1B#6 `1B`5B16;40H`20 X`1B`5B17;1H`1B#6 `1B`5B17;40H`20 X`1B`5B18;1H`1B#6 `1B`5B18;11H`1B`5B0;1mThe Software Group.`1B`5B18;40H`1B`5B V0;7;1m`20 X`1B`5B19;1H`1B#6 `1B`5B19;40H`20 X`1B`5B20;1H`1B#6 `1B`5B20;40H`20 X`1B`5B21;1H`1B#6 `1B`5B21;13H`1B`5B0mPress < `1B`5B1;5mReturn`1B`5B0m >`1B`5 VB21;40H`1B`5B7;1m`20 X`1B`5B22;1H`1B#6 `1B`5B22;40H`20 X`1B`5B23;1H`1B#6 `20 X`1B`5B1;1H X`1B`5B0m $ CALL UNPACK TUNNEL.PIC;1 1547791503 $ v=f$verify(v) $ EXIT