$! ------------------ 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 22:38:35.10 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. MOLE.PAS;1 $! 3. MOLE.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 MOLE X$ LINK MOLE,INTERACT/LIB X$ DELETE/NOCONFIRM *.OBJ;* X$ EXIT $ CALL UNPACK BUILD.COM;1 135728919 $ create 'f' X`5B X Inherit`20 X ( X 'SYS$LIBRARY:STARLET', X 'INTERACT' X ) X`5D X XPROGRAM Mole; X XCONST X number_of_aliens = 10; X dirt = 1; X rock = 2; X gold = 3; X wall = 4; X dirt_percentage = 92; X rock_percentage = 3; X `7B the rest is gold, Yippee `7D X XVAR X x_posn : integer; X y_posn : integer; X rock_x : integer; X rock_y : integer; X score : integer; X gold_here : integer; X start_score : integer; X screen : array `5B1..40,1..20`5D of integer; X x_alien : array `5B1..number_of_aliens`5D of integer; X y_alien : array `5B1..number_of_aliens`5D of integer; X rock_fall : boolean; X person_killed : boolean; X alien_alive : array `5B1..number_of_aliens`5D of boolean; X command : char; X X XFUNCTION Max ( a,b,c,d : integer ) : integer; XVAR X temp : integer; XBEGIN X temp := -100000; X IF ( a <= 0 ) and ( a > temp ) then temp := a; X IF ( b <= 0 ) and ( b > temp ) then temp := b; X IF ( c <= 0 ) and ( c > temp ) then temp := c; X IF ( d <= 0 ) and ( d > temp ) then temp := d; X max := temp; XEND; X X XPROCEDURE Finish; XBEGIN X reset_screen; X qio_purge; X clear; X top_ten (score div 10); XEND; X X XPROCEDURE Refresh_screen; XVAR X i, x, y, r : integer; XBEGIN X command := ' '; X clear; X qio_write (VT100_inverse); X FOR y := 1 to 20 do X posn (1,y); X FOR y := 1 to 20 do X BEGIN X posn (1,y); X qio_write (VT100_wide); X END; X FOR y := 1 to 20 do X BEGIN X posn (1,y); X FOR x := 1 to 40 do X BEGIN X IF ( screen `5Bx,y`5D = wall ) then X qio_write ('#') X ELSE X IF ( screen `5Bx,y`5D in `5Bdirt,gold`5D ) then X qio_write (' ') X ELSE X IF ( screen `5Bx,y`5D = rock ) then X qio_write ( VT100_normal + VT100_graphics_on + '`60' + VT100_gra Vphics_off + VT100_inverse ) X ELSE X qio_write ( VT100_normal + ' ' + VT100_inverse ); X END; X END; X qio_write (VT100_normal); X posn (32,22); X qio_write ('SCORE : '); X posn (x_posn,y_posn); X qio_write ('*'); XEND; X X XPROCEDURE Setup; XVAR X i, x, y, r : integer; XBEGIN X command := ' '; X gold_here := 0; X clear; X qio_write (VT100_inverse); X FOR y := 1 to 20 do X BEGIN X posn (1,y); X qio_write (VT100_wide); X FOR x := 1 to 40 do X BEGIN X r := random (100); X IF ( x = 1 ) or ( x = 40 ) or ( y = 1 ) or ( y = 20 ) then X BEGIN X screen `5Bx,y`5D := wall; X qio_write ('#'); X END X ELSE X IF ( r < dirt_percentage ) then X BEGIN X screen `5Bx,y`5D := dirt; X qio_write (' '); X END X ELSE X IF ( r < dirt_percentage + rock_percentage + ((20-y) div 5))`20 X and ( y < 19 ) and ( screen`5Bx,y-1`5D <> rock ) then X BEGIN X screen `5Bx,y`5D := rock; X qio_write ( VT100_normal + VT100_graphics_on + '`60' + VT100_g Vraphics_off + VT100_inverse ); X END X ELSE X BEGIN X screen `5Bx,y`5D := gold; X gold_here := gold_here + 1; X qio_write (' '); X END; X END; X END; X X FOR i := 1 to number_of_aliens do X alien_alive`5Bi`5D := false; X X x_posn := 20; X y_posn := 10; X screen `5Bx_posn,y_posn-1`5D := dirt; X posn (x_posn,y_posn-1); X qio_write (' '); X qio_write (VT100_normal); X start_score := score; X posn (32,22); X qio_write ('SCORE : '); X posn (x_posn,y_posn); X qio_write ('*'); X XEND; X X XPROCEDURE Initialize; XBEGIN X show_graphedt ('mole.pic'); X score := 1; 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; X IF ( Upper_case(command) = 'W' ) then X refresh_screen; XEND; X X XPROCEDURE Move; XBEGIN X IF ( screen`5Bx_posn,y_posn-1`5D = rock ) and ( command in `5B'2','4','6'` V5D ) then X BEGIN X rock_fall := true; X rock_x := x_posn; X rock_y := y_posn-1; X END; X X CASE command of X '2' : IF not ( screen `5Bx_posn,y_posn+1`5D in `5Brock,wall`5D ) then X BEGIN X posn (x_posn,y_posn); X qio_write (' '+VT100_lf+VT100_bs+'*'); X y_posn := y_posn + 1; X END; X '4' : IF not ( screen `5Bx_posn-1,y_posn`5D in `5Brock,wall`5D ) then X BEGIN X posn (x_posn-1,y_posn); X qio_write ('* '); X x_posn := x_posn - 1; X END; X '6' : IF not ( screen `5Bx_posn+1,y_posn`5D in `5Brock,wall`5D ) then X BEGIN X posn (x_posn,y_posn); X qio_write (' *'); X x_posn := x_posn + 1; X END; X '8' : IF not ( screen `5Bx_posn,y_posn-1`5D in `5Brock,wall`5D ) then X BEGIN X posn (x_posn,y_posn-1); X qio_write ('*'+VT100_lf+VT100_bs+' '); X y_posn := y_posn - 1; X END; X otherwise; X End; `7Bcase`7D X X CASE ( screen `5Bx_posn,y_posn`5D ) of X dirt : BEGIN X score := score + 1; X IF (score mod 10) = 0 Then X BEGIN X posn (40,22); X qio_write (dec(score div 10)); X END; X END; X gold : BEGIN X score := score + 10; X posn (40,22); X qio_write (dec(score div 10)); X gold_here := gold_here - 1; X END; X otherwise; X End; `7Bcase`7D X X IF ( rock_fall ) and ( x_posn = rock_x ) and ( y_posn - 1 = rock_y ) then X rock_fall := false; X X screen `5Bx_posn,y_posn`5D := 0; XEND; X X XPROCEDURE Drop_rock; XVAR X nu : integer; XBEGIN X screen `5Brock_x,rock_y`5D := 0; X REPEAT X sleep ( frac := 0.02 ); X posn (rock_x,rock_y); X qio_write (' '); X rock_y := rock_y + 1; X posn (rock_x,rock_y); X qio_write (VT100_graphics_on+'`60'+VT100_graphics_off); X FOR nu := 1 to number_of_aliens do X IF ( alien_alive`5Bnu`5D ) then X IF ( rock_x = x_alien`5Bnu`5D ) and ( rock_y = y_alien`5Bnu`5D ) the Vn X BEGIN X alien_alive`5Bnu`5D := false; X score := score + 200; X posn (40,22); X qio_write (dec(score div 10)); X END; X IF ( rock_x = x_posn ) and ( rock_y = y_posn ) then X person_killed := true; X UNTIL ( screen`5Brock_x,rock_y+1`5D > 0 ); X X rock_fall := false; X posn (rock_x,rock_y); X qio_write (' '); XEND; X X XPROCEDURE Create_aliens; XVAR X nu : integer; X n : integer; XBEGIN X CASE ((score - start_score) div 30 ) of X 0 : nu := 0; X 1 : nu := 1; X otherwise nu := (((score- start_score) div 500) + 1); X End; `7Bcase`7D X X IF ( nu > number_of_aliens ) then X nu := number_of_aliens; X X IF ( nu > 0 ) and not (( x_posn in `5B15..25`5D ) and ( y_posn in `5B7..13 V`5D )) then X BEGIN X n := 1; X WHILE ( n < nu ) and ( alien_alive`5Bn`5D ) do X n := n + 1; X IF not ( alien_alive`5Bn`5D ) then X BEGIN X alien_alive`5Bn`5D := true; X x_alien`5Bn`5D := 20; X y_alien`5Bn`5D := 10; X END; X END; XEND; X X XPROCEDURE Move_aliens; XVAR X nu : integer; X slime_depth : integer; X x , y : integer; X i, r : integer; X ok : boolean; X count : integer; X number_times : integer; X X FUNCTION Clear_path ( x1 , y1 , x2 , y2 : integer ) : boolean; X VAR X temp : boolean; X BEGIN X temp := ( screen`5Bx1,y1`5D <= 0 ); X IF temp then X temp := ( x2 > 0 ) and ( x2 < 41 ) and ( y1 > 0 ) and ( y2 < 21 ); X IF temp then X temp := ( screen`5Bx2,y2`5D < 0 ) and ( screen`5Bx2,y2`5D > slime_de Vpth ); X clear_path := temp; X END; X XBEGIN X FOR nu := 1 to number_of_aliens do X BEGIN X IF ( alien_alive`5Bnu`5D ) then X BEGIN X r := random(5); X IF ( r <> 1 ) or ( x_alien`5Bnu`5D > x_posn + 2 ) or X ( x_alien`5Bnu`5D < x_posn - 2 ) or X ( y_alien`5Bnu`5D > y_posn + 2 ) or X ( y_alien`5Bnu`5D < y_posn - 2 ) then X BEGIN X IF ( x_alien`5Bnu`5D > x_posn + 5 ) or X ( x_alien`5Bnu`5D < x_posn - 5 ) or X ( y_alien`5Bnu`5D > y_posn + 5 ) or X ( y_alien`5Bnu`5D < y_posn - 5 ) then X number_times := 2 X ELSE `20 X number_times := 1; X X FOR count := 1 to number_times do X BEGIN X x := x_alien`5Bnu`5D; X y := y_alien`5Bnu`5D; X IF ( x_posn = x ) and ( y_posn = y ) then X person_killed := true; X slime_depth := Max ( screen`5Bx-1,y`5D, X screen`5Bx+1,y`5D, X screen`5Bx,y-1`5D, X screen`5Bx,y+1`5D); X screen `5Bx,y`5D := slime_depth - 1; X IF ( count = 1 ) then X BEGIN X ok := true; X FOR i := 1 to number_of_aliens do X IF alien_alive`5Bi`5D and (i <> nu) and (x = x_alien V`5Bi`5D) and (y = y_alien`5Bi`5D) Then X ok := false; X IF ok Then X BEGIN X posn (x,y); X qio_write (' '); X END; X END; X X Reset_randomizer; X REPEAT X r := randomize (4); X UNTIL (( r = 1 ) and ( x_posn < x ) and ( screen`5Bx-1,y`5 VD = slime_depth )) or X (( r = 2 ) and ( x_posn > x ) and ( screen`5Bx+1,y`5 VD = slime_depth )) or X (( r = 3 ) and ( y_posn < y ) and ( screen`5Bx,y-1`5 VD = slime_depth )) or X (( r = 4 ) and ( y_posn > y ) and ( screen`5Bx,y+1`5 VD = slime_depth )) or X ( r = 0 ); X IF ( r = 0 ) then X BEGIN X Reset_randomizer; X REPEAT X r := randomize (4); X UNTIL (( r = 1 ) and ( x_posn < x ) and ( clear_path ( V x-1,y,x-2,y ))) or X (( r = 2 ) and ( x_posn > x ) and ( clear_path ( V x+1,y,x+2,y ))) or X (( r = 3 ) and ( y_posn < y ) and ( clear_path ( V x,y-1,x,y-2 ))) or X (( r = 4 ) and ( y_posn > y ) and ( clear_path ( V x,y+1,x,y+2 ))) or X ( r = 0 ); X IF ( r = 0 ) then X BEGIN X Reset_randomizer; X REPEAT X r := randomize (4); X UNTIL (( r = 1 ) and ( screen`5Bx-1,y`5D = slime_d Vepth )) or X (( r = 2 ) and ( screen`5Bx+1,y`5D = slime_d +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+- * Program MOLE by Paul Denize. * For compilation you will need files INTERACT.PEN and INTERACT.OLB * which can be found in the LIBRARY directory. * MOLE.$PACKAGE MOLE.1 MOLE.2 -+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+ Vepth )) or X (( r = 3 ) and ( screen`5Bx,y-1`5D = slime_d Vepth )) or X (( r = 4 ) and ( screen`5Bx,y+1`5D = slime_d Vepth )); X END; X END; X CASE r of X 1 : x_alien`5Bnu`5D := x - 1; V `20 X 2 : x_alien`5Bnu`5D := x + 1; V `20 X 3 : y_alien`5Bnu`5D := y - 1; V `20 X 4 : y_alien`5Bnu`5D := y + 1; V `20 X End; `7Bcase`7D X X x := x_alien`5Bnu`5D; X y := y_alien`5Bnu`5D; X screen `5Bx,y`5D := slime_depth - 1; X IF ( number_times = count ) then X BEGIN X ok := true; X FOR i := 1 to number_of_aliens do X IF alien_alive`5Bi`5D and (i <> nu) and (x = x_alien V`5Bi`5D) and (y = y_alien`5Bi`5D) Then X ok := false; X IF ok Then X BEGIN X posn (x,y); X qio_write ('#'); X END; X END; X IF ( x_posn = x ) and ( y_posn = y ) then X person_killed := true; X END; X END; X END; X END; XEND; X X XBEGIN X Initialize; X setup; X REPEAT X IF ( gold_here < 4 ) then X setup; X sleep_start (20); X get_command; X move; X IF rock_fall then X drop_rock; X create_aliens; X move_aliens; X posn (1,1); X sleep_wait; X UNTIL ( person_killed ) or ( upper_case(command) = 'Q' ); X Finish; XEND. $ CALL UNPACK MOLE.PAS;1 2013486969 $ create 'f' X`1B`5BH`1B`5BJ`1B(B`1B`5B0m X`1B`5B1;1H`1B#6 `1B`5B7m `20 X`1B`5B2;1H`1B#3`1B`5B0m `1B`5B7m `1B`5B0m M O L E - K I L L E R `1B`5B V7m`20 X`1B`5B3;1H`1B#4`1B`5B0m `1B`5B7m `1B`5B0;1m M O L E - K I L L E R `1B` V5B0;7m`20 X`1B`5B4;1H`1B#6`1B`5B0m `1B`5B7m `20 X`1B`5B5;1H`1B#6`1B`5B0m`1B(0lqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqk X`1B`5B6;1H`1B#6x A`1B(Bnother Software Group Production `1B(0x X`1B`5B7;1H`1B#6x`1B`5B7;40Hx X`1B`5B8;1H`1B#6x `1B(B Paul Denize `1B(0x X`1B`5B9;1H`1B#6x`1B`5B9;40Hx X`1B`5B10;1H`1B#6x M`1B(Bove using the number key pad and `1B(0x X`1B`5B11;1H`1B#6x`1B(B dig out under the rocks causing them `1B(0x X`1B`5B12;1H`1B#6x `1B(Bto drop on the moles, being carefull `1B(0x X`1B`5B13;1H`1B#6x `1B(Bnot to drop them on yourself. `1B(0x X`1B`5B14;1H`1B#6x`1B`5B14;40Hx X`1B`5B15;1H`1B#6x T`1B(Bhe Moles will appear after you have `1B(0x X`1B`5B16;1H`1B#6x 10 `1B(Bpoints giving you a chance to get `1B(0x X`1B`5B17;1H`1B#6x `1B(Bwell away to start with. `1B(0x X`1B`5B18;1H`1B#6x`1B`5B18;40Hx X`1B`5B19;1H`1B#6x T`1B(Bhe screen will be refilled when you `1B(0x X`1B`5B20;1H`1B#6x `1B(Bhave cleared a certain amount of it. `1B(0x X`1B`5B21;1H`1B#6x`1B`5B21;40Hx X`1B`5B22;1H`1B#6x`1B`5B22;13H`1B(B`1B`5B1mPress <`1B`5B5mReturn`1B`5B0;1m>`1 VB`5B22;40H`1B`5B0m`1B(0x X`1B`5B23;1H`1B#6mqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqj`1B`5B1;1H X`1B(B`1B* $ CALL UNPACK MOLE.PIC;1 1331720211 $ v=f$verify(v) $ EXIT