-+-+-+-+-+-+-+-+ START OF PART 27 -+-+-+-+-+-+-+-+ X`09`7B Help for available wizard commands`09`09`09`09`7D X`5Bpsect(wizard$code)`5D procedure wizard_help; X begin X clear(1,1); X if (wizard2) then X`09begin X`09 prt('`5EA - Remove Curse and Cure all maladies.',1,1); X`09 prt('`5EB - Print random objects sample.',2,1); X`09 prt('`5ED - Down/Up n levels.',3,1); X`09 prt('`5EE - Change character.',4,1); X`09 prt('`5EF - Delete monsters.',5,1); X`09 prt('`5EG - Allocate treasures.',6,1); X`09 prt('`5EH - Wizard Help.',7,1); X`09 prt('`5EI - Identify.',8,1); X`09 prt('`5EJ - Gain experience.',9,1); X`09 prt('`5EK - Summon monster.',10,1); X`09 prt('`5EL - Wizard light.',11,1); X`09 prt('`5EN - Print monster dictionary.',12,1); X`09 prt('`5EP - Wizard password on/off.',13,1); X`09 prt('`5ET - Teleport player.',14,1); X`09 prt('`5EV - Restore lost character.',15,1); X`09 prt('`5EW - Create any object *CAN CAUSE FATAL ERROR*',16,1); X`09end X else X`09begin X`09 prt('`5EA - Remove Curse and Cure all maladies.',1,1); X`09 prt('`5EB - Print random objects sample.',2,1); X`09 prt('`5ED - Down/Up n levels.',3,1); X`09 prt('`5EH - Wizard Help.',4,1); X`09 prt('`5EI - Identify.',5,1); X`09 prt('`5EL - Wizard light.',6,1); X`09 prt('`5EN - Print monster dictionary.',7,1); X`09 prt('`5EP - Wizard password on/off.',8,1); X`09 prt('`5ET - Teleport player.',9,1); X`09 prt('`5EV - Restore lost character.',10,1); X`09end; X pause(24); X draw_cave; X end; X X`0C X`09`7B Spawn a process to use HELP utility on the MORIA help library -RAK-`7 VD X`5Bpsect(misc2$code)`5D procedure moria_help(help_level : vtype); X type X`09msg_vec`09`09= record X`09`09`09 arg_count : `5Bword`5D 0..65535; X`09`09`09 def_opt : `5Bword`5D 0..65535; X`09`09`09 msg_code : unsigned; X`09`09`09 fao_parms : unsigned; X`09`09`09 end; X var X`09help_key`09`09`09: packed array `5B1..120`5D of char; X`09help_lib`09`09`09: packed array `5B1..120`5D of char; X`09flag_bits`09`09`09: unsigned; X`09help_stat`09`09`09: unsigned; X`09msg_block`09`09`09: msg_vec; X X`09`7B Call the HELP Librarian for help `7D X `5Bexternal(LIB$PUT_OUTPUT),ASYNCHRONOUS`5D X`09procedure lib$put_output; external; X `5Bexternal(LIB$GET_COMMAND),ASYNCHRONOUS`5D X`09procedure lib$get_command; external; X X `5Bexternal(SYS$PUTMSG)`5D function sys$putmsg( X`09%ref`09msgvec`09: msg_vec `09:= %immed 0; X`09%immed `5BUNBOUND,ASYNCHRONOUS`5D X`09`09procedure actrtn `09:= %immed 0; X`09%stdescr facnam : packed array `5B$l2..$l1:integer`5D of char X`09`09`09`09`09:= %immed 0; X`09%immed`09actprm`09: unsigned`09:= %immed 0) X`09`09`09: integer; external; X X `5Bexternal(LBR$OUTPUT_HELP)`5D function lbr$output_help( X`09%immed `5BUNBOUND,ASYNCHRONOUS`5D X`09`09procedure out_rtn;`09`09`7B Output routine `7D X`09%ref wld`09: integer := %immed 0;`09`7B Width of listing device `7D X`09%stdescr key`09: packed array `5B$l2..$l1:integer`5D X`09`09`09 of char;`09`09`7B HELP Library key `7D X`09%stdescr lib`09: packed array `5B$l4..$l3:integer`5D X`09`09`09 of char;`09`09`7B Library name `7D X`09%ref flgs`09: unsigned := %immed 0;`09`7B flags word `7D X`09%immed `5BUNBOUND,ASYNCHRONOUS`5D X`09`09procedure in_rtn`09:= %immed 0)`09`7B Input routine `7D X`09`09`09: integer; external; X X `5Bexternal(STR$COPY_DX)`5D function str$copy_dx( X`09%stdescr out_str: packed array `5B$l2..$l1:integer`5D of char; X`09%descr`09in_str`09: varying `5B$l3`5D of char) X`09`09`09: integer; external; X begin X flag_bits := %X'00000001';`09`7B HLP$M_PROMPT `7D X prt('`5BEntering Moria Help Library, Use `5EZ to resume game`5D',1,1); X clear(2,1); X put_qio; X str$copy_dx(help_key,help_level); X str$copy_dx(help_lib,moria_hlp); X revert;`09`09`09`09`09`7B No condition handler here `7D X lbr$output_help(out_rtn := LIB$PUT_OUTPUT, X`09`09`09`09 key := help_key, X`09`09`09`09 lib := help_lib, X`09`09`09`09 flgs := flag_bits, X`09`09`09`09 in_rtn := LIB$GET_COMMAND); X establish(oh_no); X end; $ CALL UNPACK [.SOURCE.INCLUDE]HELP.INC;1 1831678508 $ create 'f' X`09`7B Convert an integer into a system bin time`09`09-RAK-`09`7D X`09`7B NOTE: Int_time is number of 1/100 seconds`09`09`09`7D X`09`7B`09Max value = 5999`09`09`09`09`09`7D X`5Bpsect(misc2$code)`5D procedure convert_time( X`09`09 int_time`09: unsigned; X`09`09var bin_time`09: quad_type); X type X`09time_type = packed array `5B1..13`5D of char; X var X`09time_str`09: time_type; X`09secs,tics`09: unsigned; X`09out_val`09`09: varying`5B2`5D of char; X X `5Basynchronous,external(SYS$BINTIM)`5D function $bin_time( X`09`09%stdescr`09give_str`09: time_type; X`09`09var`09`09slp_time`09: quad_type X`09`09`09`09`09`09) : integer; X`09external; X X begin X time_str := '0 00:00:00.00'; X bin_time.l0 := 0; X bin_time.l1 := 0; X tics := int_time mod 100; X secs := int_time div 100; X if (secs > 0) then X`09begin X`09 if (secs > 59) then secs := 59; X`09 writev(out_val,secs:2); X`09 time_str`5B10`5D := out_val`5B2`5D; X`09 if (secs > 9) then time_str`5B9`5D := out_val`5B1`5D; X`09end; X if (tics > 0) then X`09begin X`09 writev(out_val,tics:2); X`09 time_str`5B13`5D := out_val`5B2`5D; X`09 if (tics > 9) then time_str`5B12`5D := out_val`5B1`5D; X`09end; X $bin_time(time_str,bin_time); X end; X X X`09`7B Set timer for hibernation`09`09`09`09-RAK-`09`7D X `5Basynchronous,external(SYS$SETIMR)`5D function set_time( X`09%immed efn`09: integer := %immed 5; X`09var bintime`09: quad_type; X`09%ref astadr`09: integer := %immed 0; X`09%immed reqidt`09: integer := %immed 0) : integer; X`09external; X X X`09`7B Hibernate `09`09`09`09`09`09-RAK-`09`7D X `5Basynchronous,external(SYS$WAITFR)`5D function hibernate( X`09%immed efn`09: integer := %immed 5) : integer; X`09external; X X X`09`7B Sleep for given time`09`09`09`09`09-RAK-`09`7D X`09`7B NOTE: Int_time is in seconds`09`09`09`09`09`7D X`5Bpsect(misc2$code)`5D procedure sleep(int_time : unsigned); X var X`09bin_time`09: quad_type; X begin X convert_time(int_time*100,bin_time); X set_time(bintime:=bin_time); X hibernate; X end; X X X`09`7B Setup system time format for io_pause. `09`09-RAK-`09`7D X`09`7B NOTE: IO$MOR_IOPAUSE is a constant`09`09`09`09`7D X`09`7B`09IO$BIN_PAUSE is a variable used to store results`09`7D X`09`7B NOTE: Remove or comment out for VMS 4.0 or greater`09`09`7D X`5Bpsect(setup$code)`5D procedure setup_io_pause; X begin X(* convert_time(IO$MOR_IOPAUSE,IO$BIN_PAUSE);`09*) X end; X X X`09`7B Turns SYSPRV off if 0; on if 1;`09`09`09-RAK-`09`7D X`09`7B This is needed if image is installed with SYSPRV because`09`7D X`09`7B user could write on system areas. By turning the priv off`09`7D X`09`7B system areas are secure`09`09`09`09`09`7D X`5Bpsect(setup$code)`5D procedure priv_switch(switch_val : integer); X type X`09priv_field=`09record`09`7B Quad word needed for priv mask`7D X`09`09`09 low`09: unsigned; X`09`09`09 high`09: unsigned; X`09`09`09end; X var X`09priv_mask`09: priv_field; X X`09`7B Turn off SYSPRV`09`09`09`09`09-RAK-`09`7D X `5Bexternal(SYS$SETPRV)`5D function $setprv( X`09%immed enbflg`09: integer := %immed 0; X`09var privs`09: priv_field; X`09%immed prmflg`09: integer := %immed 0; X`09%immed prvprv`09: integer := %immed 0) : integer; X`09external; X X begin X priv_mask.low := %X'10000000';`09`7B SYSPRV`09`7D X priv_mask.high := %X'00000000'; X $setprv(enbflg:=switch_val,privs:=priv_mask); X end; X X X`09`7B Spawn a shell`09`09`09`09`09`09-RAK-`09`7D X `5Bexternal(LIB$SPAWN)`5D function shell_out( X`09command_str`09: integer := %immed 0; X`09input_file `09: integer := %immed 0; X`09output_file`09: integer := %immed 0; X`09flags`09`09: integer := %immed 0; X`09process_name`09: integer := %immed 0; X`09process_id`09: integer := %immed 0; X`09comp_status`09: integer := %immed 0; X`09comp_efn`09: integer := %immed 0; X`09comp_astadr`09: integer := %immed 0; X`09comp_astprm`09: integer := %immed 0 ) : integer; X`09external; X X X`09`7B Turn off Control-Y`09`09`09`09`09-RAK-`09`7D X`5Bpsect(setup$code)`5D procedure no_controly; X var X`09bit_mask`09: unsigned; X X `5Bexternal(LIB$DISABLE_CTRL)`5D function y_off( X`09var mask`09: unsigned; X`09 old_mask`09: integer := %immed 0) : integer; X`09external; X X begin X bit_mask := %X'02000000';`09`7B No Control-Y`09`7D X y_off(mask:=bit_mask); X end; X X X`09`7B Turn on Control-Y`09`09`09`09`09-RAK-`09`7D X`5Bpsect(setup$code)`5D procedure controly; X var X`09bit_mask`09: unsigned; X X `5Bexternal(LIB$ENABLE_CTRL)`5D function y_on( X`09var mask`09: unsigned; X`09 old_mask`09: integer := %immed 0) : integer; X`09external; X X begin X bit_mask := %X'02000000';`09`7B Control-Y`09`7D X y_on(mask:=bit_mask); X end; X X X`09`7B Dump IO to buffer`09`09`09`09`09-RAK-`09`7D X`09`7B NOTE: Source is PUTQIO.MAR`09`09`09`09`09`7D X procedure put_buffer`09`09( X`09`09%ref`09out_str`09:`09varying `5Ba`5D of char; X`09`09%immed`09row`09:`09integer; X`09`09%immed`09col`09:`09integer X`09`09`09`09); X`09external; X X X `09`7B Dump the IO buffer to terminal`09`09`09-RAK-`09`7D X`09`7B NOTE: Source is PUTQIO.MAR`09`09`09`09`09`7D X procedure put_qio; X`09external; X X X`5Bpsect(setup$code)`5D procedure exit; X X`09`7B Immediate exit from program`09`09`09`09`09`7D X `5Bexternal(SYS$EXIT)`5D function $exit( X`09%immed status`09: integer := %immed 1) : integer; X`09external; X X begin X`09controly;`09`7B Turn control-Y back on`09`7D X`09put_qio;`09`7B Dump any remaining buffer`09`7D X`09$exit;`09`09`7B exit from game`09`09`7D X end; X X X`09`7B Initializes I/O channel for use with INKEY`09`09`09`7D X`5Bpsect(setup$code)`5D procedure init_channel; X type X ttype = packed array `5B1..3`5D of char; X var X status`09`09: integer; X terminal`09`09: ttype; X X `5Bexternal(SYS$ASSIGN)`5D function assign( X`09%stdescr terminal`09: ttype; X`09var channel`09`09: `5Bvolatile`5D integer; X`09acmode`09`09`09: integer := %immed 0; X`09mbxnam`09 `09`09: integer := %immed 0) : integer;`20 X`09external; X X begin X terminal := 'TT:'; X status := assign(terminal,channel); X if (not odd(status)) then X begin X`09 writeln('Channel could not be assigned '); X`09 exit; X end X end; X X X`09`7B QIOW definition`09`09`09`09`09-RAK-`09`7D X `5Basynchronous,external(SYS$QIOW)`5D function qiow_read( X`09%immed efn`09`09: integer := %immed 1; X`09%immed chan `09`09: integer; X`09%immed func`09`09: integer := %immed 0; X`09%immed isob`09`09: integer := %immed 0; X`09%immed astadr`09`09: integer := %immed 0; X`09%immed astprm`09`09: integer := %immed 0; X`09%ref get_char`09`09: `5Bunsafe`5D char := %immed 0; X`09%immed buff_len`09`09: integer := %immed 0; X`09%immed delay_time`09: integer := %immed 0; X`09%immed p4`09`09: integer := %immed 0; X`09%immed p5`09`09: integer := %immed 0; X`09%immed p6`09`09: integer := %immed 0) : integer; X`09external; X X`09`7B SET/SENSEMODE definition`09`09`09-RHM-`09`7D X `5Basynchronous,external(SYS$QIOW)`5D function qiow_mode( X`09%immed efn`09`09: integer := %immed 1; X`09%immed chan `09`09: integer; X`09%immed func`09`09: integer := %immed 0; X`09%immed isob`09`09: integer := %immed 0; X`09%immed astadr`09`09: integer := %immed 0; X`09%immed astprm`09`09: integer := %immed 0; X`09%ref mode_buffer`09: `5Bunsafe`5D array`5Bl1..l2:integer`5D X`09`09`09`09`09of unsigned := %immed 0; X`09%immed buf_size`09`09: integer := %immed 12; X`09%immed p3`09`09: integer := %immed 0; X`09%immed p4`09`09: integer := %immed 0; X`09%immed p5`09`09: integer := %immed 0; X`09%immed p6`09`09: integer := %immed 0) : integer; X`09external; X X`09`7B Gets single character from keyboard and returns`09`09`7D X`5Bpsect(io$code)`5D procedure inkey(var getchar : char); X var X`09term_char`09`09: array `5B0..2`5D of unsigned;`09`7B -RHM- `7D X`09status`09`09`09: integer; X begin X put_qio;`09`09`09`7B Dump IO buffer`09`09`7D X`09`7B Do a SENSEMODE to get the characteristics`09-RHM-`7D X qiow_mode(chan:=channel, X`09`09func:=IO$_SENSEMODE, X`09`09mode_buffer:=term_char); X`09`7B Now, set the XON bit`09`09`09-RHM-`7D X`09term_char`5B2`5D := uor(term_char`5B2`5D,tt2$m_xon); X`09`7B Do a setmode now -RHM-`7D X qiow_mode(chan:=channel, X`09`09func:=IO$_SETMODE, X`09`09mode_buffer:=term_char); X`09`7B Now read`09`09`09`09`7D X qiow_read(chan:=channel, X`09`09func:=IO$MOR_INPUT, X`09`09get_char:=getchar, X`09`09buff_len:=1`09); X`09`7B Now, set the XON bit again...`09`09-RHM-`7D X`09term_char`5B2`5D := uor(term_char`5B2`5D,tt2$m_xon); X`09`7B Do a setmode now -RHM-`7D X qiow_mode(chan:=channel, X`09`09func:=IO$_SETMODE, X`09`09mode_buffer:=term_char); X msg_flag := false; X end; X X X`09`7B Gets single character from keyboard and returns`09`09`7D X`5Bpsect(io$code)`5D procedure inkey_delay`09( X`09`09`09var getchar`09: char; X`09`09`09delay`09`09: integer X`09`09`09`09`09); X var X`09status`09`09`09: integer; X begin X put_qio;`09`09`09`7B Dump the IO buffer`09`09`7D X`09`7B Allow device driver to catch up`09`09`09`7D X`09`7B NOTE: Remove or comment out for VMS 4.0 or greater`09`7D X(* set_time(bintime:=IO$BIN_PAUSE); X hibernate;`09`09*) X`09`7B Now read`09`09`09`09`7D X getchar := null;`09`09`7B Blank out return character`09`7D X qiow_read(chan:=channel, X`09`09func:=IO$MOR_DELAY, X`09`09get_char:=getchar, X`09`09buff_len:=1, X`09`09delay_time:=delay ); X end; X X X`09`7B Flush the buffer`09`09`09`09`09-RAK-`09`7D X`5Bpsect(io$code)`5D procedure flush; X begin X`09`7B Allow device driver to catch up`09`09`09`7D X`09`7B NOTE: Remove or comment out for VMS 4.0 or greater`09`7D X(* set_time(bintime:=IO$BIN_PAUSE); X hibernate;`09`09*) X`09`7B Now flush`09`09`09`09`7D X qiow_read(chan:=channel,func:=IO$MOR_IPURGE); X end; X X X`09`7B Flush buffer before input`09`09`09`09-RAK-`09`7D X`5Bpsect(io$code)`5D procedure inkey_flush(var x : char); X begin X put_qio;`09`7B Dup the IO buffer`09`7D X if (not(wizard1)) then flush; X inkey(x); X end; X X +-+-+-+-+-+-+-+- END OF PART 27 +-+-+-+-+-+-+-+-