-+-+-+-+-+-+-+-+ START OF PART 41 -+-+-+-+-+-+-+-+ 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 msg_flag := false; X end; X X X`09`7B Gets single character from keyboard and returns`09`09`7D X`5Bglobal,psect(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`7B X set_time(bintime:=IO$BIN_PAUSE); X hibernate; X`7D 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`5Bglobal,psect(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`7B X set_time(bintime:=IO$BIN_PAUSE); X hibernate; X`7D 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`5Bglobal,psect(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`5Bexternal(smg$create_pasteboard)`5D function create_pasteboard( X`09`09var`09pa_id`09`09`09: unsigned; X`09`09`09output_device`09`09: integer:=%immed 0; X`09`09`09pb_rows`09`09`09: integer:=%immed 0; X`09`09`09pb_columns`09`09: integer:=%immed 0; X`09`09`09preserve_screen_flag`09: integer:=%immed 0 X`09`09`09) : integer; external; X X`5Bexternal(smg$delete_pasteboard)`5D function delete_pasteboard( X`09`09`09%ref pasteboard_id`09: unsigned; X`09`09`09%ref clear_screen_flag`09: integer:=%immed 0 X`09`09`09) : integer; external; X X`5Bexternal(smg$set_broadcast_trapping)`5D function set_broadcast_trapping( X`09`09`09%ref ast_routine`09: unsigned:=%immed 0; X`09`09`09 ast_argument`09: integer:=%immed 0 X`09`09`09) : integer; external; X X`5Bexternal(smg$disable_broadcast_trapping)`5D function disable_broadcast_tr Vapping( X`09`09`09%ref pasteboard_id`09: unsigned X`09`09`09) : integer; external; X X`5Bexternal(smg$get_broadcast_message)`5D function get_broadcast_message( X`09`09`09pasteboard_id`09`09: unsigned; X`09`09`09%descr message`09`09: string; X`09`09`09%ref message_length`09: wordint:=%immed 0 X`09`09`09) : integer; external; X X`5Bexternal(str$position)`5D function position( X`09`09`09`09%descr src_str : varying`5Bsize`5D of char; X`09`09`09`09%descr sub_str : varying`5Bsize1`5D of char; X`09`09`09`09%ref start_pos : integer:= 0) : integer; X`09`09`09`09external; X X`5Bglobal,psect(io$code)`5D procedure get_message; X var X`09`09brd_message`09`09: string; X`09`09node`09`09`09: string; X`09`09username`09`09: string; X`09`09b,e`09`09`09: integer; X begin X`09get_broadcast_message(pasteb,brd_message); X`09e := position(brd_message,'(') - 1; X`09if (caught_message = nil) then X`09 begin X`09 new (caught_message); X`09 cur_message := caught_message; X`09 cur_message`5E.next := nil; X`09 cur_message`5E.data := brd_message; `7B Stack dump in this line V `7D X`09 caught_count := 1 X`09 end X`09else X`09 begin X`09 new (message_cursor); X`09 cur_message`5E.next := message_cursor; X`09 message_cursor := nil; X`09 cur_message := cur_message`5E.next; X`09 cur_message`5E.next := nil; X`09 cur_message`5E.data := brd_message; X`09 caught_count := caught_count + 1 X`09 end; X`7B`09if e = 1 then X`09 network X`09else if e < 0 then X`09 control_t X`09else if e > 20 then X`09 phone X`09else X`09 local; X`7D Xend; X X`5Bglobal,psect(io$code)`5D procedure set_the_trap; X begin X`09create_pasteboard(pasteb,,,,1); X`09set_broadcast_trapping(pasteb,%immed get_message); X end; X X`5Bglobal,psect(io$code)`5D procedure disable_the_trap; X begin X`09disable_broadcast_trapping(pasteb); X`09delete_pasteboard(pasteb,0); X end; X X`09`7B Clears given line of text`09`09`09`09-RAK-`09`7D X`5Bglobal,psect(io$code)`5D procedure erase_line`09`09( X`09`09row`09`09:`09integer; X`09`09col`09`09:`09integer X`09`09`09`09); X begin X put_buffer(cursor_erl,row,col); X end; X X X`09`7B Clears screen at given row, column`09`09`09`09`7D X`5Bglobal,psect(io$code)`5D procedure clear(row,col : integer); X var X`09i1`09`09`09: 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;`09`7B Dump the Clear Sequence`09`7D X end; X X X`09`7B Outputs a line to a given interpolated y,x position`09-RAK-`09`7D X`5Bglobal,psect(io$code)`5D procedure print( X`09`09str_buff`09: varying`5Ba`5D of char; X`09`09row`09`09: integer; X`09`09col`09`09: integer X`09`09`09`09); 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 X X`09`7B Outputs a line to a given y,x position`09`09-RAK-`09`7D X`5Bglobal,psect(io$code)`5D procedure prt( X`09`09str_buff`09: varying`5Ba`5D of char; X`09`09row`09`09: integer; X`09`09col`09`09: integer X`09`09`09`09); X begin X put_buffer(cursor_erl+str_buff,row,col); X end; X X X`09`7B Outputs message to top line of screen`09`09`09`09`7D X`5Bglobal,psect(io$code)`5D function msg_print(str_buff : varying`5Ba`5D of V char) : boolean; X var X`09old_len`09`09: integer; X`09in_char`09`09: char; X begin X if ((msg_flag) and (not msg_terse)) then X`09begin X`09 old_len := length(old_msg) + 1; X`09 put_buffer(' -more-',msg_line,old_len); X`09 repeat X`09 inkey(in_char); X`09 until (ord(in_char) in `5B3,13,25,26,27,32`5D); X`09end; X put_buffer(cursor_erl+str_buff,msg_line,msg_line); X old_msg := str_buff; X msg_record (str_buff,true); X msg_flag := true; X if ord(in_char) in `5B3,25,26,27`5D then X`09msg_print := true X else X`09msg_print := false; X end; X X X`7Bthis procedure records and displays previous messages`7D X`7Bif record is TRUE then the procedure records the message otherwise`7D X`7Bthe procedure shows the previously recorded messages`7D X`7Bmaximum number of messages recorded is defined by MAX_MESSAGES`7D X X`5Bglobal,psect(io$code)`5D procedure msg_record (message : vtype; save : bo Volean); X X`09var X`09 count`09`09: byteint; X`09 temp_ctr `09: byteint; X`09 in_char`09: char; X X`09begin X`09 if (save) then X`09 begin X`09 record_ctr := record_ctr + 1; X`09 if (record_ctr > max_messages) then record_ctr := 1; X`09 msg_prev`5Brecord_ctr`5D := message; X`09 if (length(msg_prev`5Brecord_ctr`5D) > 74) then X`09`09msg_prev`5Brecord_ctr`5D := substr(msg_prev`5Brecord_ctr`5D,1,74); X`09 end X`09 else X`09 begin X`09`09`7Bpre-declaration of variables`7D X`09 count := 0; X`09 temp_ctr := record_ctr; X X`09 repeat X`09`09count := count + 1;`09`09 X`09`09prt(pad(msg_prev`5Btemp_ctr`5D,' ',74) + ':' + dec(count,4,3),1,1); X`09`09temp_ctr := temp_ctr - 1; X`09`09if (temp_ctr < 1) then temp_ctr := max_messages; X`09`09inkey(in_char); X`09 until ((not(ord(in_char) in `5B13,32,86`5D)) X`09`09`09 or (count = max_messages)); X`09 msg_print(pad('End of buffer. ',' ',80)); X`09 end; X`09end; X X X`09`7B Prompts (optional) and returns ord value of input char`09`7D X`09`7B Function returns false if ,CNTL/(Y,C,Z) is input`09`7D X`5Bglobal,psect(io$code)`5D function get_com`09( X`09`09`09`09prompt`09`09: varying`5Ba`5D of char; X`09`09`09`09var command`09: char X`09`09`09`09`09) : boolean; X var X`09com_val`09`09: 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`093,25,26,27`09: get_com := false; X`09otherwise`09 get_com := true; X end; X erase_line(msg_line,msg_line); X msg_flag := false; X end; X X X`09`7B Gets response to a Y/N question`09`09`09`09`7D X`5Bglobal,psect(io$code)`5D function get_yes_no`09( X`09`09`09prompt`09`09: varying`5Ba`5D of char X`09`09`09`09`09`09) : boolean; `20 X var X`09command`09: char; X begin X msg_print(' '); X get_com(prompt+' (Y/N) ',command); X case command of X`09'y','Y' : get_yes_no := true; X`09otherwise get_yes_no := false; X end; X end; X X X`09`7B Gets a string terminated by `09`09`09`09`7D X`09`7B Function returns false if ,CNTL/(Y,C,Z) is input`09`7D`20 X`5Bglobal,psect(io$code)`5D function get_string`09( X`09`09`09var in_str`09: varying`5Ba`5D of char; X`09`09`09row,column,slen : integer X`09`09`09`09`09) : boolean; X var X`09start_col,end_col,i1`09: integer; X`09x`09`09`09: char; X`09tmp`09`09`09: vtype; X`09flag,abort`09`09: boolean; X`09 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`09inkey(x); X`09case ord(x) of X`09 3,25,26,27 :`09abort := true; X`09`0913 : `09flag := true; X`09`09127 : `09begin X`09`09`09 if (column > start_col) then X`09`09`09 begin X`09`09`09 column := column - 1; X`09`09`09 put_buffer(' '+chr(8),row,column); X`09`09`09 in_str := substr(in_str,1,length(in_str)-1); X`09`09`09 end; X`09`09`09end; X`09 otherwise`09begin X`09`09`09 tmp := x; X`09`09`09 put_buffer(tmp,row,column); X`09`09`09 in_str := in_str + tmp; X`09`09`09 column := column + 1; X`09`09`09 if (column > end_col) then X`09`09`09 flag := true; X`09`09`09end; X`09end; X until (flag or abort); X if (abort) then X`09get_string := false X else X`09begin`09`09`09`7B Remove trailing blanks`09`7D X`09 i1 := length(in_str); X`09 if (i1 > 1) then X`09 begin X`09 while ((in_str`5Bi1`5D = ' ') and (i1 > 1)) do X`09 i1 := i1 - 1; X`09 in_str := substr(in_str,1,i1); X`09 end; X`09 get_string := true; X`09end; X end; X X X`09`7B Return integer value of hex string`09`09`09-RAK-`09`7D X`5Bglobal,psect(wizard$code)`5D function get_hex_value(row,col,slen : intege Vr) : integer; X type X`09pack_type`09`09= packed array `5B1..9`5D of char; X var X`09bin_val`09`09`09: integer; X`09tmp_str`09`09`09: vtype; X`09pack_str`09`09: pack_type; X X `5Basynchronous,external(OTS$CVT_TZ_L)`5D function convert_hex_to_bin( X`09`09%stdescr hex_str`09: pack_type; X`09`09%ref`09 hex_val `09: integer; X`09`09%immed`09 val_size`09: integer := %immed 4; X`09`09%immed`09 flags`09`09: integer := %immed 1) : integer; X`09`09external; X X begin X get_hex_value := 0; X if (get_string(tmp_str,row,col,slen)) then X`09if (length(tmp_str) <= 8) then X`09 begin X`09 pack_str := pad(tmp_str,' ',9); X`09 if (odd(convert_hex_to_bin(pack_str,bin_val))) then X`09 get_hex_value := bin_val; X`09 end; X end; X X X`09`7B Return hex string of integer value`09`09`09-DMF-`09`7D X`5Bglobal,psect(wizard$code)`5D procedure print_hex_value(num,row,col : inte Vger); X type X`09pack_type`09`09= packed array `5B1..9`5D of char; X var X`09bin_val`09`09`09: integer; X`09tmp_str`09`09`09: vtype; X`09pack_str`09`09: pack_type; X X `5Basynchronous,external(OTS$CVT_L_TZ)`5D function convert_bin_to_hex( X`09`09%ref`09 hex_val `09: integer; X`09`09%stdescr hex_str`09: pack_type; X`09`09%immed`09 int_digits`09: integer := %immed 8; X`09`09%immed`09 val_size`09: integer := %immed 4) : integer; X`09`09external; X X begin X if (odd(convert_bin_to_hex(num,pack_str))) then X`09begin X`09 tmp_str := pack_str; X`09 prt(tmp_str,row,col); X`09end; X end; X X X X`09`7B Pauses for user response before returning`09`09-RAK-`09`7D X`5Bglobal,psect(misc2$code)`5D procedure pause(prt_line : integer); X var X`09dummy`09`09`09: char; X begin X prt('`5BPress any key to continue`5D',prt_line,24); X inkey(dummy); X erase_line(prt_line,1); X end; X X X`09`7B Pauses for user response before returning`09`09-RAK-`09`7D X`09`7B NOTE: Delay is for players trying to roll up "perfect"`09`7D X`09`7B`09characters. Make them wait a bit...`09`09`09`7D X`5Bglobal,psect(misc2$code)`5D procedure pause_exit( X`09`09prt_line`09: integer; X`09`09delay`09`09: integer); X var X`09dummy`09`09`09: 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`093,25,26 :`09begin X`09`09`09 erase_line(prt_line,1); X`09`09`09 if (delay > 0) then sleep(delay); X`09`09`09 exit; X`09`09`09end; X`09otherwise; X end; X erase_line(prt_line,1); X end; X X X`09`7B Returns the image path for Moria`09`09`09-RAK-`09`7D X`09`7B Path is returned in a VARYING`5B80`5D of char`09`09`09`7D X`5Bglobal,psect(setup$code)`5D procedure get_paths; X type X`09word`09= 0..65535; X`09rec_jpi`09= record X`09`09`09pathinfo : packed record X`09`09`09`09 pathlen`09`09: word; X`09`09`09`09 jpi$_imagname`09: word; X`09`09 `09`09 end; X`09`09`09ptr_path`09: `5Epath; X`09`09`09ptr_pathlen`09: `5Einteger; X`09`09`09endlist`09`09: integer X`09`09 end; X`09path`09`09= packed array `5B1..128`5D of char; X var X`09i1`09`09: integer; X`09tmp_str`09`09: path; X`09image_path`09: vtype; X`09flag`09`09: boolean; X X`09`7B Call JPI and return the image path as a packed 128`09-RAK-`09`7D X function get_jpi_path : path; X var X`09status`09`09: integer; X`09user`09`09: path; X`09jpirec`09`09: rec_jpi; X X`09`7B GETJPI definition`09`7D X `5Basynchronous,external(SYS$GETJPI)`5D function $getjpi( X`09`09%immed`09p1`09: integer := %immed 0; X`09`09%immed`09p2`09: integer := %immed 0; X`09`09%immed`09p3`09: integer := %immed 0; X`09`09var`09itmlst`09: rec_jpi; X`09`09%immed`09p4`09: integer := %immed 0; +-+-+-+-+-+-+-+- END OF PART 41 +-+-+-+-+-+-+-+-