-+-+-+-+-+-+-+-+ START OF PART 28 -+-+-+-+-+-+-+-+ XNow flush `7D X qiow_read(chan:=channel,func:=IO$MOR_IPURGE); X END; X`20 X`20 X`7B Flush buffer before input `7D X`5Bpsect(io$code)`5D procedure inkey_flush(var x : char); X BEGIN X put_qio; `7B Dump the IO buffer `7D X if (not(wizard)) then flush; X inkey(x); X END; X`20 X`20 X`7B Retrieves foreign string input with game command `7D X `5Bexternal(LIB$GET_FOREIGN)`5D procedure get_foreign( X %descr msg_str : vtype; X %descr prompt : vtype := %immed 0; X %ref len : integer := %immed 0); X external; X`20 X`20 X`7B Clears given line of text `7D X`5Bpsect(io$code)`5D procedure erase_line ( row,col : integer ); X BEGIN X put_buffer(cursor_erl,row,col); X END; X`20 X`20 X`7B Clears screen at given row, column `7D X`5Bpsect(io$code)`5D procedure clear(row,col : integer); X var X i1 : integer; X BEGIN X for i1 := 2 to 23 do used_line`5Bi1`5D := false; X put_buffer(cursor_erp,row,col); X put_qio; `7B Dump the Clear Sequence `7D X END; X`20 X`20 X`7B Outputs a line to a given interpolated y,x position `7D X`5Bpsect(io$code)`5D procedure print( X str_buff : varying`5Ba`5D of char; X row : integer; X col : integer ); X BEGIN X row := row - panel_row_prt;`7B Real co-ords convert to screen position Vs `7D X col := col - panel_col_prt; X used_line`5Brow`5D := true; X put_buffer(str_buff,row,col) X END; X`20 X`20 X`7B Outputs a line to a given y,x position `7D X`5Bpsect(io$code)`5D procedure prt( X str_buff : varying`5Ba`5D of char; X row : integer; X col : integer ); X BEGIN X put_buffer(cursor_erl+str_buff,row,col); X END; X`20 X`20 X`7B Outputs message to top line of screen `7D X`5Bpsect(io$code)`5D procedure msg_print(str_buff : varying`5Ba`5D of char V); X var X old_len : integer; X in_char : char; X BEGIN X if (msg_flag) then X BEGIN X old_len := length(old_msg) + 1; X put_buffer(' -more-',msg_line,old_len); X repeat `20 X inkey(in_char); X until (ord(in_char) in `5B3,13,25,26,27,32`5D); X END; X put_buffer(cursor_erl+str_buff,msg_line,msg_line); X old_msg := str_buff; X msg_flag := true; X END; X`20 X`20 X`7B Prompts (optional) and returns ord value of input char X Function returns false if ,CNTL/(Y,C,Z) is input `7D X`5Bpsect(io$code)`5D function get_com ( X prompt : varying`5Ba`5D of char; X var command : char ) : boolean; X var X com_val : integer; X BEGIN X if (length(prompt) > 1) then prt(prompt,1,1); X inkey(command); X com_val := ord(command); X CASE com_val of X 3,25,26,27: get_com := false; X otherwise get_com := true; X END; X erase_line(msg_line,msg_line); X msg_flag := false; X END; X`20 X`20 X`7B Gets a string terminated by X Function returns false if ,CNTL/(Y,C,Z) is input `7D X`5Bpsect(io$code)`5D function get_string ( X var in_str: varying`5Ba`5D of char; X row,column,slen : integer ) : boolean; X var X start_col,END_col,i1 : integer; X x : char; X tmp : vtype; X flag,abort : boolean; X`20 X BEGIN X abort := false; X flag := false; X in_str:= ''; X put_buffer(pad(in_str,' ',slen),row,column); X put_buffer('',row,column); X start_col := column; X END_col := column + slen - 1; X repeat X inkey(x); X CASE ord(x) of X 3,25,26,27 : abort := true; X 13 : flag := true; X 127 : BEGIN X if (column > start_col) then X BEGIN X column := column - 1; X put_buffer(' '+chr(8),row,column); X in_str := substr(in_str,1,length(in_str)-1); X END; X END; X otherwise BEGIN X tmp := x; X put_buffer(tmp,row,column); X in_str := in_str + tmp; X column := column + 1; X if (column > END_col) then X flag := true; X END; X END; X until (flag or abort); X if (abort) then X get_string := false X else X BEGIN `7B Remove trailing blanks `7D X i1 := length(in_str); X if (i1 > 1) then X BEGIN X while ((in_str`5Bi1`5D = ' ') and (i1 > 1)) do X i1 := i1 - 1; X in_str := substr(in_str,1,i1); X END; X get_string := true; X END; X END; X`20 X`20 X`7B Return integer value of hex string `7D X`5Bpsect(wizard$code)`5D function get_hex_value(row,col,slen : integer) : in Vteger; X type X pack_type = packed array `5B1..9`5D of char; X var X bin_val : integer; X tmp_str : vtype; X pack_str : pack_type; X`20 X `5Basynchronous,external(OTS$CVT_TZ_L)`5D function convert_hex_to_bin( X %stdescr hex_str : pack_type; X %ref hex_val : integer; X %immed val_size : integer := %immed 4; X %immed flags : integer := %immed 1) : integer; X external; X`20 X BEGIN `20 X bin_val := 0; X get_hex_value := 0; X if (get_string(tmp_str,row,col,slen)) then X if (length(tmp_str) <= 8) then X BEGIN X pack_str := pad(tmp_str,' ',9); X if (odd(convert_hex_to_bin(pack_str,bin_val))) then X get_hex_value := bin_val; X END; X END; X`20 X`20 X`20 X`7B Pauses for user response before returning `7D X`5Bpsect(misc2$code)`5D procedure pause(prt_line : integer); X var X dummy : char; X BEGIN X prt('`5BPress any key to continue`5D',prt_line,24); X inkey(dummy); X erase_line(24,1); X END; X`20 X`20 X`7B Pauses for user response before returning X NOTE: Delay is for players trying to roll up "perfect" X characters. Make them wait a bit.`7D X`5Bpsect(misc2$code)`5D procedure pause_exit( X prt_line : integer; X delay : integer); X var X dummy : char; X BEGIN X prt('`5BPress any key to continue, or -Z to exit`5D',prt_line V,11); X inkey(dummy); X CASE ord(dummy) of X 3,25,26 : BEGIN X erase_line(prt_line,1); X if (delay > 0) then sleep(delay); X exit; X END; X otherwise; X END; X erase_line(prt_line,1); X END; X`20 X`20 X`7B Returns the image path for Moria X Path is returned in a VARYING`5B80`5D of char `7D X`5Bpsect(setup$code)`5D procedure get_paths; X type X word = 0..65535; X rec_jpi = record X pathinfo : packed record X pathlen: word; X jpi$_imagname: word; X END; X ptr_path : `5Epath; X ptr_pathlen : `5Einteger; X ENDlist : integer X END; X path = packed array `5B1..128`5D of char; X var X i1 : integer; X tmp_str : path; X image_path: vtype; X flag: boolean; X`20 X`7B Call JPI and return the image path as a packed 128 `7D X function get_jpi_path : path; X var X status : integer; X user: path; X jpirec : rec_jpi; X`20 X`7B GETJPI definition `7D X `5Basynchronous,external(SYS$GETJPI)`5D function $getjpi( X %immed p1: integer := %immed 0; X %immed p2: integer := %immed 0; X %immed p3: integer := %immed 0; X var itmlst : rec_jpi; X %immed p4: integer := %immed 0; X %immed p5: integer := %immed 0; X %immed p6: integer := %immed 0) : integer; X external; X`20 X BEGIN X with jpirec do X BEGIN X pathinfo.pathlen:= 128; `7B Image length `7D X pathinfo.jpi$_imagname:= %x207; `7B Image path `7D X new (ptr_path); X new (ptr_pathlen); X ptr_pathlen`5E := 0; X ENDlist := 0; X END; X status := $getjpi(itmlst:=jpirec); X if (not(odd(status))) then X BEGIN X clear(1,1); X put_buffer('Error in retrieving image path.',1,1); X exit; X END X else X get_jpi_path := jpirec.ptr_path`5E; X END; X`20 X BEGIN X tmp_str := get_jpi_path; X i1 := 0; X flag := false; X image_path := ''; X repeat X i1 := i1 + 1; X if (tmp_str`5Bi1`5D = '`5D') then flag := true; X image_path := image_path + tmp_str`5Bi1`5D; X until(flag); X MORIA_HOU := image_path + 'HOURS.DAT'; X MORIA_MOR := image_path + 'MORIA.DAT'; X MORIA_MAS := image_path + 'MORIACHR.DAT'; X MORIA_TOP := image_path + 'MORIATOP.DAT'; X MORIA_HLP := image_path + 'MORIAHLP.HLB'; X MORIA_MON := image_path + 'MONSTERIN.DAT'; X MORIA_LOS := image_path + 'MORLOSER.DAT'; X MORIA_WIZ := image_path + 'MORIAWIZ.DAT'; X END; $ CALL UNPACK [.SOURCE.INCLUDE]IO.INC;1 675779095 $ create 'f' X`7B Throw a magic spell `7D`20 X`5Bpsect(misc2$code)`5D procedure cast; X var X i1,i2,item_val,dir : integer; X choice,chance : integer; X dumy,y_dumy,x_dumy : integer; X redraw : boolean; X BEGIN X reset_flag := true; X if (py.flags.blind > 0) then X msg_print('You can''t see to read your spell book!') X else if (no_light) then X msg_print('You have no light to read by.') X else if (py.flags.confused > 0) then X msg_print('You are too confused...') X else if (class`5Bpy.misc.pclass`5D.mspell) then X if (inven_ctr > 0) then X BEGIN X if (find_range(`5B90`5D,i1,i2)) then X BEGIN X redraw := false; X if (get_item(item_val,'Use which spell-book?', X redraw,i1,i2)) then X BEGIN X if (cast_spell('Cast which spell?',item_val, X choice,chance,redraw)) then X with mage_spell`5Bpy.misc.pclass,choice`5D do X BEGIN X reset_flag := false; X if (randint(100) < chance) then X msg_print('You failed to get the spell off!') X else X BEGIN X y_dumy := char_row; X x_dumy := char_col; X`7B Spells. `7D X CASE choice of X 1 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then X fire_bolt(0,dir,char_row,char_col, X damroll('2d6')+1,'Magic Missle'); X 2 : detect_monsters; X 3 : teleport(10); X 4 : light_area(char_row,char_col); X 5 : hp_player(damroll('4d4'),'a magic spell.'); X 6 : BEGIN X detect_sdoor; X detect_trap; X END; X 7 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then X fire_ball(2,dir,char_row,char_col,9,'Stinking Cloud'); X 8 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then X confuse_monster(dir,char_row,char_col); X 9 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then X fire_bolt(1,dir,char_row,char_col, X damroll('3d8')+1,'Lightning Bolt'); X 10 : td_destroy; X 11 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then X sleep_monster(dir,char_row,char_col); X 12 : cure_poison; X 13 : teleport(py.misc.lev*5); X 14 : for i1 := 23 to inven_max-1 do X with inventory`5Bi1`5D do X flags := uand(flags,%X'7FFFFFFF'); X 15 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then X fire_bolt(4,dir,char_row,char_col, X damroll('4d8')+1,'Frost Bolt'); X 16 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then X wall_to_mud(dir,char_row,char_col); X 17 : ident_spell; X 18 : recharge(20); X 19 : sleep_monsters2_3(char_row,char_col,1); X 20 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then X poly_monster(dir,char_row,char_col); X 21 : create_food; X 22 : sleep_monsters2_3(char_row,char_col,20); X 23 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then X fire_bolt(5,dir,char_row,char_col, X damroll('6d8')+1,'Fire Bolt'); X 24 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then X speed_monster(dir,char_row,char_col,-1); X 25 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then X fire_ball(4,dir,char_row,char_col,33,'Frost Ball'); X 26 : recharge(50); X 27 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then X teleport_monster(dir,char_row,char_col); X 28 : with py.flags do X fast := fast + randint(20) + py.misc.lev; X 29 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then +-+-+-+-+-+-+-+- END OF PART 28 +-+-+-+-+-+-+-+-