$! ------------------ 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:44:58.51 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. MUSHROOM.PAS;1 $! 3. MUSHROOM.SC2;1 $! 4. MUSHROOM.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 MUSHROOM X$ LINK MUSHROOM,INTERACT/LIB X$ DELETE/NOCONFIRM *.OBJ;* X$ EXIT $ CALL UNPACK BUILD.COM;1 167907458 $ create 'f' X`5BINHERIT`20 X ( X 'SYS$LIBRARY:STARLET', X 'INTERACT' X ) X `5D X XProgram Mushroom( Input, output, infile ); X X `7B`20 XMAULER 131 -`20 X Mushrooms, a game of skill, patience and hard work. X You must tour around the mushroom field, eating all the mushrooms X you can, and not starving.`20 X Beware ! X X `5E = normal mushroom X - = poison mushroom X * = magic mushroom X `20 X You tend to feel better after a normal mushroom, X " " " " dead " " poison " X " " " go berserk " " magic " X X Simon Travaglia, Waikato University 1985 X `7D X XCONST linefeed = chr(10); X ctrl_z = chr(26); X esc = chr(27); X magic_mushroom = 42; X poison_mushroom = 45; X mushroom_char = 94; X XTYPE screenline = varying `5B127`5D of char; X XVAR X infile : text; X berserk : boolean; X x_pos : integer; X y_pos : integer; X lives : integer; `7Bnot used`7D X score : integer; X x_move : integer; X y_move : integer; X screen : packed array `5B1..23, 1..40`5D of integer; X dummy : integer; X dummy_2 : integer; X sleep_time : integer; X mushy_char : char; X char_input : integer; X mushy_x_pos : integer; X mushy_y_pos : integer; X old_x_pos : integer; X old_y_pos : integer; X total_mushrooms : integer; X dead_meat : boolean; X game_over : boolean; X current_obj : integer; X berserk_time : integer; X max_berserk_time : integer; X game_start_screen : screenline; X X Xprocedure write_score; X begin; X writeln( esc, 'Y ', score:1, esc, ' '); X end; X Xprocedure beep; X begin X writeln( chr(7) ); X end; X Xprocedure put_mushy; X begin X writeln( esc,'Y',chr(mushy_x_pos+31),chr(mushy_y_pos+31),mushy_char X , esc, 'Y '); X `7Bplace mushroom then home cursor, X otherwise the region could scroll `7 VD X X screen`5Bmushy_x_pos, mushy_y_pos`5D := ord(mushy_char); X end; X Xprocedure make_mushies; X BEGIN X mushy_char := '`5E'; X for dummy := 1 to 40 do X begin X mushy_x_pos := RANDOM(23); X mushy_y_pos := RANDOM(40); X if screen`5Bmushy_x_pos, mushy_y_pos`5D = 32 then X put_mushy; X end; X X mushy_char := '*'; X for dummy := 1 to 5 do X begin X mushy_x_pos := RANDOM(23); X mushy_y_pos := RANDOM(40); X if screen`5Bmushy_x_pos, mushy_y_pos`5D = 32 then X put_mushy; X end; X X mushy_char := '-'; X for dummy := 1 to 5 do X begin X mushy_x_pos := RANDOM(23); X mushy_y_pos := RANDOM(40); X if screen`5Bmushy_x_pos, mushy_y_pos`5D = 32 then X put_mushy; X end; X X max_berserk_time := max_berserk_time + 2; `20 X `7Bthe effects last longer !!!`7D X END; X Xprocedure init_game; X begin X FOR dummy := 1 to 23 do X FOR dummy_2 := 1 to 40 do X screen`5Bdummy, dummy_2`5D := 32; X X max_berserk_time := 15; `7B15 berserk_moves`7D X x_pos := 12; X y_pos := 20; X lives := 1; X sleep_time := 1000000; `7Bset up 1 sec sleep between m Vove`7D X show_graphedt ('mushroom.scn'); X show_graphedt ('mushroom.sc2',wait:=false); X write (esc+'`5B?2l'); X make_mushies; `7Bplace mushrooms`7D X total_mushrooms := 30; `7Bset number to be less...`7D X end; X Xprocedure check_mushrooms; X Begin X if total_mushrooms < 6 then`20 X begin X make_mushies; X sleep_time := sleep_time - 4000; `7Bmake it interesti Vng`7D X total_mushrooms := 46; X end; X end; X Xprocedure get_input; X BEGIN X char_input := ord(qio_1_char_now); X END; X XProcedure do_nothing; X begin; X `7Bself explanitary, it does nothing`7D X end; X XProcedure go_berserk; X begin; X char_input := random(4); `7Bsome random number`7D X char_input := 48 + (char_input * 2); `7Bsimulate a key stroke V`7D X berserk_time := berserk_time - 1; X if berserk_time < 10 then berserk := false; X end; X X XProcedure What_am_i_on; X BEGIN; X current_obj := screen`5Bx_pos, y_pos`5D; X screen`5Bx_pos, y_pos`5D := 32; X `20 X CASE current_obj of X 42 : BEGIN X score := score + 20; X write_score; X total_mushrooms := total_mushrooms - V 2; X check_mushrooms; X berserk := true; X berserk_time := max_berserk_time; X END; X X 94 : BEGIN X score := score + 10; X write_score; X total_mushrooms := total_mushrooms - V 1; X check_mushrooms; X END; X X 45 : dead_meat := true; X X 32 : do_nothing; X X OTHERWISE X begin X beep; X beep; X Writeln( 'Game consistancy failure.'); X Writeln( 'Position X=',x_pos,' Y=',y_pos,' Character=',curr Vent_obj); X game_over := true; X end; X End; X END; X Xprocedure place_man; X BEGIN X writeln( esc, 'Y', chr(old_x_pos+31), chr(old_y_pos+31), ' '); X writeln( esc, 'Y', chr(x_pos+31), chr(y_pos+31), '@'); X what_am_i_on; X END; X Xprocedure lite_man; X BEGIN X writeln( esc, 'Y', chr(x_pos+31), chr(y_pos+31), '*'); X writeln( esc, 'Y', chr(x_pos+31), chr(y_pos+31), '@'); X writeln( esc, 'Y', chr(x_pos+31), chr(y_pos+31), '*'); X END; X Xprocedure move_man; X BEGIN X case char_input of X 81,113,26,69,101 : begin X dead_meat := true; X game_over := true; X end; X X 50 : begin X x_move := 1; X y_move := 0; X end; X X 52 : begin X y_move := -1; X x_move := 0; X end; X X 54 : begin X y_move := 1; X x_move := 0; X end; X X 56 : begin X x_move := -1; X y_move := 0; X end; X otherwise; X end; X X old_x_pos := x_pos; X old_y_pos := y_pos; X x_pos := x_pos + x_move; X y_pos := y_pos + y_move; X if y_pos > 40 then y_pos := 1; X if y_pos < 1 then y_pos := 40; X if x_pos > 23 then x_pos := 1; X if x_pos < 1 then x_pos := 23; X place_man; X END; X X X XBEGIN `7Bmain game`7D X image_dir; X INIT_GAME; X beep; X While (not game_over) and (lives > 0) do`20 X BEGIN; X while not dead_meat do X BEGIN; X if berserk then go_berserk X else Get_input; X move_man; X sleep( 0, sleep_time / 10000000 ); X END; X lives := lives - 1; X beep; X END; X top_ten( score); XEND. $ CALL UNPACK MUSHROOM.PAS;1 75196948 $ create 'f' X`1B`5BH`1B`5BJ`1B(B`1B`5B0m`1B`5B1;1H`1B#6`1B`5B2;1H`1B#6 X`1B`5B3;1H`1B#6`1B`5B4;1H`1B#6`1B`5B5;1H`1B#6`1B`5B6;1H`1B#6 X`1B`5B7;1H`1B#6`1B`5B8;1H`1B#6`1B`5B9;1H`1B#6`1B`5B10;1H`1B#6 X`1B`5B11;1H`1B#6`1B`5B12;1H`1B#6`1B`5B13;1H`1B#6`1B`5B14;1H`1B#6 X`1B`5B15;1H`1B#6`1B`5B16;1H`1B#6`1B`5B17;1H`1B#6`1B`5B18;1H`1B#6 X`1B`5B19;1H`1B#6`1B`5B20;1H`1B#6`1B`5B21;1H`1B#6`1B`5B22;1H`1B#6 X`1B`5B23;1H`1B#6`1B`5B24;1H`1B#6`1B`5BH`1B>`1B`5B?2l $ CALL UNPACK MUSHROOM.SC2;1 1903117308 $ create 'f' X`1B`5BH`1B`5BJ`1B(B`1B`5B0m X`1B`5B1;1H`1B(0lqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq Vqqqqqqqqqqqqqqqqqqk X`1B`5B2;1Hx`1B`5B2;80Hx`1B`5B3;1Hx`1B`5B3;27HW`1B(Bhat a peice of luck !!!`1 VB`5B3;80H`1B(0x`1B`5B4;1Hx`1B`5B4;80Hx X`1B`5B5;1Hx Y`1B(Bou and Snow White were out looking for some food one d Vay when you `1B(0x X`1B`5B6;1Hx `1B(Bcame across the biggest mushroom patch this side V of the big `1B(0x X`1B`5B7;1Hx `1B(Bcompost heap outside of grumpies place !!!`1B`5B7;80H`1 VB(0x`1B`5B8;1Hx`1B`5B8;80Hx X`1B`5B9;1Hx B`1B(But, as fate, and the nasty witch with the apples th Vat have not `1B(0x X`1B`5B10;1Hx `1B(Bapproved by the apple and pear marketing board wou Vld have it, `1B(0x X`1B`5B11;1Hx `1B(Bthere are a few mushrooms there which are not approved V by the MMB `1B(0x X`1B`5B12;1Hx `1B(B(Mushroom Marketing Board). These consist of magic mu Vshrooms, (*) `1B(0x X`1B`5B13;1Hx `1B(Band toadstools (-). This is a real - life simulation V so there is `1B(0x X`1B`5B14;1Hx `1B(Babsolutely NO chance of more than one life, so don't V run over the `1B(0x X`1B`5B15;1Hx `1B(Btoadstools. The magic mushies, too, should be avoided V.`1B`5B15;80H`1B(0x X`1B`5B16;1Hx`1B`5B16;80Hx`1B`5B17;1Hx`1B`5B17;11HA M`1B(Bauler 131 Productio Vn. (c) 1985 Waikato University`1B`5B17;80H X`1B`5B17;80H`1B(0x`1B`5B18;1Hx`1B`5B18;80Hx`1B`5B19;1Hx`1B`5B19;80Hx`1B`5B20 V;1Hx`1B`5B20;17HP`1B(Bress >Return< to examine your l X`1B`5B20;49Hife expectancy...`1B`5B20;80H`1B(0x`1B`5B21;1Hx`1B`5B21;80Hx`1B` V5B22;1Hmqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq X`1B`5B22;38Hqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqj`1B(B`1B`5BH $ CALL UNPACK MUSHROOM.SCN;1 1450705975 $ v=f$verify(v) $ EXIT