-+-+-+-+-+-+-+-+ START OF PART 27 -+-+-+-+-+-+-+-+ X`7BVampire Bite `7D 25 : nbt_out_val := nbt_out_val + X 'losing strength and experience'; X`7BTurn to Stone `7D 26 : nbt_out_val := nbt_out_val + 'turning to ston Ve.'; X`7BMind Flayer `7D 27 : nbt_out_val := nbt_out_val + 'sucking your br Vain out.'; X`7BHell Horse`09`7D 28 : nbt_out_val := nbt_out_val + 'NightMare blindne Vss.'; X`7BVargouille`09`7D 29 : nbt_out_val := nbt_out_val + 'draining max hit V points.'; X`7B Special `7D 99 : nbt_out_val := nbt_out_val + 'blank message.' V; X otherwise nbt_out_val := nbt_out_val + '**Unknown valu Ve**'; X end; X nbt_out_val := nbt_out_val + ' (' + damstr + ')'; X prt(nbt_out_val,((cur_line + 1) div 2),1); X cur_line := cur_line + 2; X end; Xend; Xpause(24); XDraw_cave; Xend; X X`7BDisplays info about monsters -NBT`7D X`5Bpsect(misc2$code)`5D procedure mon_info; X XVar choice : char; X quitflag : boolean; X howmany,i,j,moncode,aux_code : integer; X namestr,dummy : vtype; X XBegin X choice := ' '; X quitflag := true; X Repeat X if (get_com X('Enter creature code for information, ? for the list, or to abort: ' X ,choice)) then X begin X quitflag := false; X if choice = '?' then do_all_mons; X end; X Until ((choice <> '?') or quitflag); X If not(quitflag) then X Begin X clear (1,1); X howmany := 0; X for i := 1 to max_creatures do X if c_list`5Bi`5D.cchar = choice then howmany := howmany + 1; X if howmany = 0 then X Begin X prt ('That character is not used for any creatures.',12,1); X pause (24); X`09 draw_cave; X end X else X if howmany = 1 then X begin X for i := 1 to max_creatures do X if c_list`5Bi`5D.cchar = choice then moncode := i; X do_mon_out(moncode); X end X else X begin `7B there's more than one creature in the list using that co Vde `7D X`09 howmany := 0; X`09 j := 1; X`09 for i := 1 to max_creatures do X`09 if c_list`5Bi`5D.cchar = choice then X `09`09begin X namestr := ''; X`09`09 namestr := ' ' + c_list`5Bi`5D.name + X ' '; X`09`09 prt(namestr,(4+(howmany div 2)),(1+(40*(howmany mod 2)))); X`09`09 prt_num ( '',j,(4+(howmany div 2)),(1+40*(howmany mod 2))); X`09`09 howmany := howmany + 1; X`09`09 j := j + 1; X`09`09end; X`09 Repeat X`09`09erase_line(msg_line,msg_line); X`09`09msg_print('Enter the number for your choice:'); X`09`09get_string(dummy,1,36,10); X`09`09aux_code := 999; X`09`09readv(dummy,aux_code,error:=continue); X`09 Until ((aux_code > 0) and (aux_code <= howmany)); X`09 howmany := 0; X`09 i := 0; X`09 while howmany <> aux_code do X Begin X`09`09i := i + 1; X`09`09if c_list`5Bi`5D.cchar = choice then howmany := howmany + 1; X`09 end; X`09 moncode := i; X`09 do_mon_out(moncode); X`09 end; X end; Xend; X X X`7BHelp for available wizard commands`7D X`5Bpsect(wizard$code)`5D procedure wizard_help; X begin X clear(1,1); X prt('`5EA - Remove Curse and Cure all maladies.',1,1); X prt('`5EB - Print random objects sample.',2,1); X prt('`5EC - Make nice character.',3,1); X prt('`5ED - Down/Up n levels.',4,1); X prt('`5EE - Change character.',5,1); X prt('`5EF - Delete monsters.',6,1); X prt('`5EG - Allocate treasures.',7,1); X prt('`5EH - Wizard Help.',8,1); X prt('`5EI - Identify.',9,1); X prt('`5EJ - Gain experience.',10,1); X prt('`5EK - Summon monster.',11,1); X prt('`5EL - Wizard light.',12,1); X prt('`5EN - Print monster dictionary.',13,1); X prt('`5EP - Wizard password on/off.',14,1); X prt('`5ET - Teleport player.',15,1); X prt('`5EV - Restore lost character.',16,1); X prt('`5EW - Create any object *CAN CAUSE FATAL ERROR*',17,1); X pause(24); X draw_cave; X end; X`20 X`20 X`20 X`7BSpawn a process to use HELP utility on the MORIA help library -RAK-`7D X`5Bpsect(misc2$code)`5D procedure moria_help(help_level : vtype); X var `20 X dcl_command : varying `5B120`5D of char; X flag_bits : unsigned; X`20 X `7B Spawn a shell and execute DCL command -RAK- `7 VD X `5Bexternal(LIB$SPAWN)`5D function dcl( X %DESCR command : varying `5Ba`5D of char; X dum2 : integer := %immed 0; X dum3 : integer := %immed 0; X %REF flags : unsigned; X dum5 : integer := %immed 0; X dum6 : integer := %immed 0; X dum7 : integer := %immed 0; X dum8 : integer := %immed 0; X dum9 : integer := %immed 0; X dum10 : integer := %immed 0 ) : integer; X external; X`20 X begin X flag_bits := %X'00000006'; X prt('`5BEntering Moria Help Library, Use `5EZ to resume game`5D',1,1); X put_qio; X dcl_command := 'HELP/PAGE/NOLIBLIST/LIBRARY='+MORIA_HLP; X dcl_command := dcl_command + ' ' + help_level; X dcl(dcl_command,flags:=flag_bits); X end; X X X X`5Bpsect(misc2$code)`5D procedure moria_help_lbr(help_level : vtype); X `5Bexternal(LBR$OUTPUT_HELP)`5D function output_help( X`09%REF output_routine : unsigned; X`09%REF output_width : unsigned; X`09%DESCR line_desc : varying `5Ba`5D of char; X`09%DESCR library_name : varying `5Bb`5D of char; X %REF flags : unsigned) : integer; X external; X`20 X begin X end; X X X $ CALL UNPACK [.SOURCE.INCLUDE]HELP.INC;1 622652073 $ create 'f' X`7B Convert an integer into a system bin time X NOTE: Int_time is number of 1/100 seconds X Max value = 5999`7D X`5Bpsect(misc2$code)`5D procedure convert_time(int_time : unsigned;`20 X var bin_time : quad_type); X type X time_type = packed array `5B1..13`5D of char; X var X time_str : time_type; X secs,tics : unsigned; X out_val : varying`5B2`5D of char; X`20 X `5Basynchronous,external(SYS$BINTIM)`5D function $bin_time( X %stdescr give_str : time_type; X var slp_time : quad_type ) : integer; X external; X`20 X BEGIN `20 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 BEGIN X if (secs > 59) then secs := 59; X writev(out_val,secs:2); X time_str`5B10`5D := out_val`5B2`5D; X if (secs > 9) then time_str`5B9`5D := out_val`5B1`5D; X END; X if (tics > 0) then X BEGIN X writev(out_val,tics:2); X time_str`5B13`5D := out_val`5B2`5D; X if (tics > 9) then time_str`5B12`5D := out_val`5B1`5D; X END; X $bin_time(time_str,bin_time); X END; X`20 X`20 X`7B Set timer for hibernation `7D X `5Basynchronous,external(SYS$SETIMR)`5D function set_time( X %immed efn: integer := %immed 5; X var bintime : quad_type; X %ref astadr : integer := %immed 0; X %immed reqidt : integer := %immed 0) : integer; X external; X`20 X`20 X`7B Hibernate `7D X `5Basynchronous,external(SYS$WAITFR)`5D function hibernate( X %immed efn: integer := %immed 5) : integer; X external; X`20 X`20 X`7B Sleep for given time`20 X NOTE: Int_time is in seconds `7D X`5Bpsect(misc2$code)`5D procedure sleep(int_time : unsigned); X var X bin_time : quad_type; X BEGIN X convert_time(int_time*100,bin_time); X set_time(bintime:=bin_time); X hibernate; X END; X`20 X`20 X`7B Setup system time format for io_pause. X NOTE: IO$MOR_IOPAUSE is a constant X IO$BIN_PAUSE is a variable used to store results X NOTE: Remove or comment out for VMS 4.0 or greater `7D X`7B X`5Bpsect(setup$code)`5D procedure setup_io_pause; X BEGIN X convert_time(IO$MOR_IOPAUSE,IO$BIN_PAUSE); X END; X`7D X`20 X`20 X`7B Turns SYSPRV off if 0; on if 1; X This is needed if image is installed with SYSPRV because user could write X on system areas. By turning the priv off system areas are secure `7D X`5Bpsect(setup$code)`5D procedure priv_switch(switch_val : integer); X type X priv_field= record `7B Quad word needed for priv mask`7D X low : unsigned; X high : unsigned; X END; X var X priv_mask : priv_field; X`20 X`7B Turn off SYSPRV `7D X `5Bexternal(SYS$SETPRV)`5D function $setprv( X %immed enbflg : integer := %immed 0; X var privs : priv_field; X %immed prmflg : integer := %immed 0; X %immed prvprv : integer := %immed 0) : integer; X external; X`20 X BEGIN X priv_mask.low := %X'10000000'; `7B SYSPRV `7D X priv_mask.high := %X'00000000'; X $setprv(enbflg:=switch_val,privs:=priv_mask); X END; X`20 X`20 X`7B Spawn a shell `7D X `5Bexternal(LIB$SPAWN)`5D function shell_out( X command_str : integer := %immed 0; X input_file: integer := %immed 0; X output_file : integer := %immed 0; X flags : integer := %immed 0; X process_name : integer := %immed 0; X process_id: integer := %immed 0; X comp_status : integer := %immed 0; X comp_efn : integer := %immed 0; X comp_astadr : integer := %immed 0; X comp_astprm : integer := %immed 0 ) : integer; X external; X`20 X`20 X`7B Turn off Control-Y `7D X`5Bpsect(setup$code)`5D procedure no_controly; X var X bit_mask : unsigned; X`20 X `5Bexternal(LIB$DISABLE_CTRL)`5D function y_off( X var mask : unsigned; X old_mask : integer := %immed 0) : integer; X external; X`20 X BEGIN X bit_mask := %X'02000000'; `7B No Control-Y `7D X y_off(mask:=bit_mask); X END; X`20 X`20 X`7B Turn on Control-Y `7D X`5Bpsect(setup$code)`5D procedure controly; X var X bit_mask : unsigned; X`20 X `5Bexternal(LIB$ENABLE_CTRL)`5D function y_on( X var mask : unsigned; X old_mask : integer := %immed 0) : integer; X external; X`20 X BEGIN X bit_mask := %X'02000000'; `7B Control-Y `7D X y_on(mask:=bit_mask); X END; X`20 X`20 X`7B Dump IO to buffer`20 X NOTE: Source is PUTQIO.MAR `7D X procedure put_buffer ( X %ref out_str : varying `5Ba`5D of char; X %immed row : integer; X %immed col : integer ); X external; X`20 X`20 X`7B Dump the IO buffer to terminal X NOTE: Source is PUTQIO.MAR `7D X procedure put_qio; X external; X`20 X`20 X`5Bpsect(setup$code)`5D procedure exit; X`20 X`7B Immediate exit from program `7D X `5Bexternal(SYS$EXIT)`5D function $exit( X %immed status : integer := %immed 1) : integer; X external; X`20 X BEGIN X controly; `7B Turn control-Y back on `7D X put_qio; `7B Dump any remaining buffer `7D X $exit; `7B exit from game `7D X END; X`20 X`20 X`7B Initializes I/O channel for use with INKEY `7D X`5Bpsect(setup$code)`5D procedure init_channel; X type X ttype = packed array `5B1..3`5D of char; X var X status: integer; X terminal : ttype; X`20 X `5Bexternal(SYS$ASSIGN)`5D function assign( X %stdescr terminal : ttype; X var channel : `5Bvolatile`5D integer; X acmode: integer := %immed 0; X mbxnam: integer := %immed 0) : integer; X external; X`20 X BEGIN X terminal := 'TT:'; X status := assign(terminal,channel); X if (not odd(status)) then X BEGIN X writeln('Channel could not be assigned '); X exit; X END X END; X`20 X`20 X`7B QIOW definition `7D X `5Basynchronous,external(SYS$QIOW)`5D function qiow_read( X %immed efn : integer := %immed 1; X %immed chan : integer; X %immed func : integer := %immed 0; X %immed isob : integer := %immed 0; X %immed astadr : integer := %immed 0; X %immed astprm : integer := %immed 0; X %ref get_char : `5Bunsafe`5D char := %immed 0; X %immed buff_len : integer := %immed 0; X %immed delay_time : integer := %immed 0; X %immed p4 : integer := %immed 0; X %immed p5 : integer := %immed 0; X %immed p6 : integer := %immed 0) : integer; X external; X`20 X`7B Gets single character from keyboard and returns `7D X`5Bpsect(io$code)`5D procedure inkey(var getchar : char); X var X status: integer; X BEGIN X put_qio; `7B Dump IO buffer XAllow device driver to catch up`20 XNOTE: Remove or comment out for VMS 4.0 or greater X set_time(bintime:=IO$BIN_PAUSE); X hibernate; XNow read `7D X qiow_read(chan:=channel, X func:=IO$MOR_INPUT, X get_char:=getchar, X buff_len:=1 ); X msg_flag := false; X END; X`20 X`20 X`7B Gets single character from keyboard and returns `7D X`5Bpsect(io$code)`5D procedure inkey_delay ( X var getchar : char; X delay : integer ); X var X status: integer; X BEGIN X put_qio; `7B Dump the IO buffer XAllow device driver to catch up`20 XNOTE: Remove or comment out for VMS 4.0 or greater X set_time(bintime:=IO$BIN_PAUSE); X hibernate; XNow read `7D X getchar := null; `7B Blank out return character `7D X qiow_read(chan:=channel, X func:=IO$MOR_DELAY, X get_char:=getchar, X buff_len:=1, X delay_time:=delay ); X END; X`20 X`20 X`7B Flush the buffer `7D X`5Bpsect(io$code)`5D procedure flush; X BEGIN X`7B Allow device driver to catch up X NOTE: Remove or comment out for VMS 4.0 or greater X set_time(bintime:=IO$BIN_PAUSE); X hibernate; +-+-+-+-+-+-+-+- END OF PART 27 +-+-+-+-+-+-+-+-