-+-+-+-+-+-+-+-+ START OF PART 21 -+-+-+-+-+-+-+-+
X`5Basynchronous`5D
Xprocedure x_label(s:string);
Xbegin
X  window_name := s;
X  smg$label_border(xwind,window_name);
Xend;
X
Xprocedure x_write_array(an_array:`5Bunsafe`5D array`5Bfirst..last:whole`5D o
Vf shortstring;
X`09`09`09add_numbers:boolean := false; new_name:string := '';
X`09`09`09count:integer := 0; indexnum:integer := 0);
Xvar
X  i:integer;
X  s:string;
Xbegin
X  if (new_name <> window_name) or (new_name = '') then
X  begin
X    x_label(new_name);
X    purge_x;
X    for i := first to last do
X    begin
X      if an_array`5Bi`5D <> '' then
X      begin
X        s := '';
X`09if add_numbers then writev(s,count:2,') ');
X`09if indexnum <> 0 then s := s + boo(indx`5Bindexnum`5D.on`5Bi+1`5D) + ' ';
X`09s := s + an_array`5Bi`5D;
X`09add_x(s);
X      end;
X      count := count + 1;
X    end;
X    draw_x;
X  end;
Xend;
X
Xfunction lookup(an_array:`5Bunsafe`5D array `5Bfirst..last:counting`5D of sh
Vortstring;
X`09`09looking_for:string; var result:integer; echo:boolean := false)
X`09`09:boolean;
Xvar
X  i,poss,maybe,num:integer := 0;
X  s:string;
Xbegin
X  result := 0;
X  if looking_for = '' then result := 0
X  else if isnum(looking_for) then result := number(looking_for)
X  else
X  begin
X    looking_for := lowcase(looking_for);
X    for i := first to last do
X    begin
X      an_array`5Bi`5D := lowcase(an_array`5Bi`5D);
X      if looking_for = an_array`5Bi`5D then num := i
X      else if index(an_array`5Bi`5D,looking_for) = 1 then
X      begin
X`09maybe := maybe + 1;
X`09poss := i;
X      end;
X    end;
X    if num <> 0 then result := num
X    else if maybe = 1 then result := poss
X    else if maybe > 1 then result := 0
X    else result := 0;
X  end;
X  lookup := result <> 0;
X  if echo then
X  if checkprivs(4) then
X  begin
X    if grab_yes('Show lookup_array') then
X`09x_write_array(an_array,true,'Lookup array',1);
X  end
X  else wl('No such luck.')
Xend;
X
Xfunction exact_name(nametype:integer; var n:integer; s:string):boolean;
Xbegin
X  exact_name := false;
X  if lookup(name`5Bnametype`5D.id,s,n) then
X  if lowcase(name`5Bnametype`5D.id`5Bn`5D) = lowcase(s) then exact_name := t
Vrue
Xend;
X
Xfunction get_name(an_array:`5Bunsafe`5D array `5Bfirst..last:counting`5D of
V shortstring;
X`09`09prompt:string := 'Enter name:'; var result:integer;
X`09`09def,indexnum:integer := 0; count:integer := 1):boolean;
Xvar
X  g:string;
Xbegin
X  get_name := true;
X  if def <> 0 then wl('Enter * for default');
X  grab_line(prompt,g);
X  if (g = '?') or (g = '') then
X  begin
X    window_name := '';
X    x_write_array(an_array,true,'Enter a name',count,indexnum);
X    grab_line(prompt,g);
X  end;
X  if g = '*' then result := def
X  else if not lookup(an_array,g,result) then get_name := false;
X  if result > last then result := last;
Xend;
X
Xprocedure do_list(kind:integer := 0);
X
X  procedure list_prime;
X  begin
X    case kind of
X    1..na_max`09:x_write_array(name`5Bkind`5D.id,true,names`5Bkind`5D,1);
X    na_foreground:x_write_array(fg.name,true,names`5Bkind`5D,1);
X    na_fg_type`09:x_write_array(fg_type,true,names`5Bkind`5D,0);
X    na_weapon`09:x_write_array(stat,true,names`5Bkind`5D,0);
X    na_attribute:x_write_array(attrib_name,true,names`5Bkind`5D,1);
X    na_spell_ef`09:x_write_array(spell_effects,true,names`5Bkind`5D,0);
X    na_elements`09:x_write_array(element,true,names`5Bkind`5D,0);
X    na_equipment:x_write_array(equipment,true,names`5Bkind`5D,1);
X    na_classes`09:x_write_array(class_name,true,names`5Bkind`5D,1);
X    end;
X  end;
X
Xbegin
X  if kind <> 0 then list_prime
X  else if get_name(names,,kind) then list_prime;
Xend;
X
Xfunction valid_name(nametype:integer; s:string):boolean;
Xvar
X  dummy:integer;
Xbegin
X  valid_name := false;
X  if (s = '') then wl('Name too short.')
X  else if length(s) > 20 then wl('The name must be less than 21 characters.'
V)
X  else if exact_name(nametype,dummy,s) then wl(s+' is not a unique name.')
X  else valid_name := true;
Xend;
X
X`5Basynchronous`5D
Xfunction show_condition(condition:integer):string;
Xbegin
X  case condition of
X  -maxint..0:show_condition := 'Useless';
X   1..10:show_condition := 'Nearly useless';
X  11..20:show_condition := 'Terrible';
X  21..30:show_condition := 'Bad';
X  31..40:show_condition := 'Poor';
X  41..60:show_condition := 'Fair';
X  61..70:show_condition := 'Good';
X  71..80:show_condition := 'Very Good';
X  81..90:show_condition := 'Excellent';
X  91..100:show_condition := 'Exceptional';
X  101..125:show_condition := 'Truly magnificent';
X  126..150:show_condition := 'Hoopy';
X  151..200:show_condition := 'Tremendous';
X  201..1000:show_condition := 'Ludicrous';
X  1001..maxint:show_condition := 'Godlike';
X  end;
Xend;
X
X`5Basynchronous`5D
Xfunction a_an(name_type:integer):string;
Xbegin
X  case name_type of
X    1:a_an := 'a';
X    2:a_an := 'an';
X    3:a_an := 'some';
X    4:a_an := 'the';
X    otherwise a_an := '';
X  end;
Xend;
X
X`5Basynchronous`5D
Xfunction object_name(objnum:integer):string;
Xbegin
X  read_object(objnum);
X  object_name := a_an(obj.howprint)+' '+name`5Bna_obj`5D.id`5Bobjnum`5D;
Xend;
X
X`5Basynchronous`5D
Xprocedure print(file_name:string := '';
X`09`09default_string:string := '';
X`09`09subs1:shortstring := '';
X`09`09icon1:char := '#';
X`09`09subs2:shortstring := '';
X`09`09icon2:char := '#');
Xvar
X  textfile:text;
X  aline,str,q,p:string;
X  icon:char;
X  count:integer := 0;
X  more:boolean;
X  error:boolean := false;
X
X  function subs_parm(s,parm:string; icon:char):string;
X
X    function left_half(s:string):string;
X    var
X      i:integer;
X    begin
X      i := index(s,icon);
X      if i > 0 then left_half := substr(s,1,i-1)
X      else left_half := '';
X    end;
X
X    function right_half(s:string):string;
X    var
X      i:integer;
X    begin
X      i := index(s,icon);
X      if i > 0 then right_half := substr(s,i+1,length(s)-i)
X      else right_half := s;
X    end;
X
X  begin
X    if (length(s) + length(parm) <= 80) and (index(s,icon) > 0) then
X    subs_parm := left_half(s) + parm + right_half(s)
X    else subs_parm := s;
X  end;
X
Xbegin
X  if human then
X  begin
X    if file_name = '' then
X    begin
X      p := subs_parm(default_string,subs1,icon1);
X      q := subs_parm(p,subs2,icon2);
X      if q <> '' then wl(q);
X    end
X    else
X    begin
X      open(textfile,helproot+file_name,history := old,sharing := readonly,
X`09error := continue);
X      reset(textfile);
X      repeat
X`09count := count + 1;
X`09readln(textfile,aline);
X`09p := subs_parm(aline,subs1,icon1);
X`09q := subs_parm(p,subs2,icon2);
X`09wl(q);
X        if full_text then more := (count = 20)
X        else more := (count = 6);
X        if more then
X`09begin
X`09  count := 0;
X`09  grab_yes('`5BMore`5D');
X`09end;
X      until eof (textfile);
X      close(textfile);
X    end;
X  end;
Xend;
X
Xend.
$ CALL UNPACK SROTHER.PAS;1 7031937
$ create 'f'
X`5Binherit('sys$library:starlet','srinit'),environment ('srsys')`5D
X
Xmodule srsys(input,output);
X
Xtype
X  $UQUAD = `5BQUAD,UNSAFE`5D RECORD
X    L0,L1:UNSIGNED; END;
X
X`5BASYNCHRONOUS`5D FUNCTION lib$enable_ctrl (
X`09enable_mask : UNSIGNED;
X`09VAR old_mask : `5BVOLATILE`5D UNSIGNED := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION lib$stat_timer (
X`09code : INTEGER;
X`09%REF value_argument : `5BVOLATILE,UNSAFE`5D ARRAY `5B$l2..$u2:INTEGER`5D
V OF $UBYTE;
X`09handle_address : $DEFPTR := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION lib$cvtf_from_internal_time (
X`09operation : UNSIGNED;
X`09VAR resultant_time : `5BVOLATILE`5D SINGLE;
X`09input_time : $UQUAD) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION lib$wait (
X`09seconds : SINGLE) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION lib$getjpi (
X`09item_code : INTEGER;
X`09VAR process_id : `5BVOLATILE`5D UNSIGNED := %IMMED 0;
X`09process_name : `5BCLASS_S`5D PACKED ARRAY `5B$l3..$u3:INTEGER`5D OF CHAR
V := %IMMED 0;
X`09%REF resultant_value : `5BVOLATILE,UNSAFE`5D ARRAY `5B$l4..$u4:INTEGER`5D
V OF $UBYTE := %IMMED 0;
X`09VAR resultant_string : `5BCLASS_S,VOLATILE`5D PACKED ARRAY `5B$l5..$u5:IN
VTEGER`5D OF CHAR := %IMMED 0;
X`09VAR resultant_length : `5BVOLATILE`5D $UWORD := %IMMED 0) : INTEGER; EXTE
VRNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION lib$init_timer (
X`09VAR context : `5BVOLATILE`5D UNSIGNED := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION lib$disable_ctrl (
X`09disable_mask : UNSIGNED;
X`09VAR old_mask : `5BVOLATILE`5D UNSIGNED := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION lib$enable_ctrl (
X`09enable_mask : UNSIGNED;
X`09VAR old_mask : `5BVOLATILE`5D UNSIGNED := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION lib$get_symbol (
X`09symbol : `5BCLASS_S`5D PACKED ARRAY `5B$l1..$u1:INTEGER`5D OF CHAR;
X`09VAR resultant_string : `5BCLASS_S,VOLATILE`5D PACKED ARRAY `5B$l2..$u2:IN
VTEGER`5D OF CHAR;
X`09VAR resultant_length : `5BVOLATILE`5D $UWORD := %IMMED 0;
X`09VAR table_type_indicator : `5BVOLATILE`5D INTEGER := %IMMED 0) : INTEGER;
V EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION lib$set_symbol (
X`09symbol : `5BCLASS_S`5D PACKED ARRAY `5B$l1..$u1:INTEGER`5D OF CHAR;
X`09value_string : `5BCLASS_S`5D PACKED ARRAY `5B$l2..$u2:INTEGER`5D OF CHAR;
X`09table_type_indicator : INTEGER := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION lib$find_file (
X`09filespec : `5BCLASS_S`5D PACKED ARRAY `5B$l1..$u1:INTEGER`5D OF CHAR;
X`09VAR resultant_filespec : `5BCLASS_S,VOLATILE`5D PACKED ARRAY `5B$l2..$u2:
VINTEGER`5D OF CHAR;
X`09VAR context : `5BVOLATILE`5D UNSIGNED;
X`09default_filespec : `5BCLASS_S`5D PACKED ARRAY `5B$l4..$u4:INTEGER`5D OF C
VHAR := %IMMED 0;
X`09related_filespec : `5BCLASS_S`5D PACKED ARRAY `5B$l5..$u5:INTEGER`5D OF C
VHAR := %IMMED 0;
X`09VAR status_value : `5BVOLATILE`5D UNSIGNED := %IMMED 0;
X`09flags : UNSIGNED := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$set_cursor_abs (
X`09display_id : UNSIGNED;
X`09start_row : INTEGER := %IMMED 0;
X`09start_column : INTEGER := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$scroll_display_area (
X`09display_id : UNSIGNED;
X`09start_row : INTEGER := %IMMED 0;
X`09start_column : INTEGER := %IMMED 0;
X`09height : INTEGER := %IMMED 0;
X`09width : INTEGER := %IMMED 0;
X`09direction : UNSIGNED := %IMMED 0;
X`09count : INTEGER := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$put_line (
X`09display_id : UNSIGNED;
X`09text : `5BCLASS_S`5D PACKED ARRAY `5B$l2..$u2:INTEGER`5D OF CHAR;
X`09line_advance : INTEGER := %IMMED 0;
X`09rendition_set : UNSIGNED := %IMMED 0;
X`09rendition_complement : UNSIGNED := %IMMED 0;
X`09flags : UNSIGNED := %IMMED 0;
X`09character_set : UNSIGNED := %IMMED 0;
X`09direction : UNSIGNED := %IMMED 0) : INTEGER; EXTERNAL;
X`20
X`5BASYNCHRONOUS`5D FUNCTION smg$read_keystroke (
X`09keyboard_id : UNSIGNED;
X`09VAR word_terminator_code : `5BVOLATILE`5D $UWORD;
X`09prompt_string : `5BCLASS_S`5D PACKED ARRAY `5B$l3..$u3:INTEGER`5D OF CHAR
V := %IMMED 0;
X`09timeout : INTEGER := %IMMED 0;
X`09display_id : UNSIGNED := %IMMED 0;
X`09rendition_set : UNSIGNED := %IMMED 0;
X`09rendition_complement : UNSIGNED := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$delete_chars (
X`09display_id : UNSIGNED;
X`09number_of_characters : INTEGER;
X`09start_row : INTEGER;
X`09start_column : INTEGER) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$erase_line (
X`09display_id : UNSIGNED;
X`09start_row : INTEGER := %IMMED 0;
X`09start_column : INTEGER := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$ring_bell (
X`09display_id : UNSIGNED;
X`09number_of_times : INTEGER := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$create_virtual_keyboard (
X`09VAR keyboard_id : `5BVOLATILE`5D UNSIGNED;
X`09input_device : `5BCLASS_S`5D PACKED ARRAY `5B$l2..$u2:INTEGER`5D OF CHAR
V := %IMMED 0;
X`09default_filespec : `5BCLASS_S`5D PACKED ARRAY `5B$l3..$u3:INTEGER`5D OF C
VHAR := %IMMED 0;
X`09VAR resultant_filespec : `5BCLASS_S,VOLATILE`5D PACKED ARRAY `5B$l4..$u4:
VINTEGER`5D OF CHAR := %IMMED 0;
X`09recall_size : $UBYTE := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$set_keypad_mode (
X`09keyboard_id : UNSIGNED;
X`09flags : UNSIGNED) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$create_pasteboard (
X`09VAR pasteboard_id : `5BVOLATILE`5D UNSIGNED;
X`09output_device : `5BCLASS_S`5D PACKED ARRAY `5B$l2..$u2:INTEGER`5D OF CHAR
V := %IMMED 0;
X`09VAR number_of_pasteboard_rows : `5BVOLATILE`5D INTEGER := %IMMED 0;
X`09VAR number_of_pasteboard_columns : `5BVOLATILE`5D INTEGER := %IMMED 0;
X`09flags : UNSIGNED := %IMMED 0;
X`09VAR type_of_terminal : `5BVOLATILE`5D UNSIGNED := %IMMED 0) : INTEGER; EX
VTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$create_virtual_display (
X`09number_of_rows : INTEGER;
X`09number_of_columns : INTEGER;
X`09VAR display_id : `5BVOLATILE`5D UNSIGNED;
X`09display_attributes : UNSIGNED := %IMMED 0;
X`09video_attributes : UNSIGNED := %IMMED 0;
X`09character_set : UNSIGNED := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$label_border (
X`09display_id : UNSIGNED;
X`09text : `5BCLASS_S`5D PACKED ARRAY `5B$l2..$u2:INTEGER`5D OF CHAR := %IMME
VD 0;
X`09position_code : UNSIGNED := %IMMED 0;
X`09units : INTEGER := %IMMED 0;
X`09rendition_set : UNSIGNED := %IMMED 0;
X`09rendition_complement : UNSIGNED := %IMMED 0;
X`09character_set : UNSIGNED := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$set_cursor_mode (
X`09pasteboard_id : UNSIGNED;
X`09flags : UNSIGNED) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$create_viewport (
X`09display_id : UNSIGNED;
X`09viewport_row_start : INTEGER;
X`09viewport_column_start : INTEGER;
X`09viewport_number_rows : INTEGER;
X`09viewport_number_columns : INTEGER) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$paste_virtual_display (
X`09display_id : UNSIGNED;
X`09pasteboard_id : UNSIGNED;
X`09pasteboard_row : INTEGER;
X`09pasteboard_column : INTEGER;
X`09top_display_id : UNSIGNED := %IMMED 0) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$delete_virtual_keyboard (
X`09keyboard_id : UNSIGNED) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$delete_pasteboard (
X`09pasteboard_id : UNSIGNED;
X`09flags : UNSIGNED := %IMMED 0) : INTEGER; EXTERNAL;
X`20
+-+-+-+-+-+-+-+-  END  OF PART 21 +-+-+-+-+-+-+-+-