-+-+-+-+-+-+-+-+ START OF PART 20 -+-+-+-+-+-+-+-+
X`09if get_name(name`5Bkind`5D.id,names`5Bkind`5D,n) then custom_spell(n);
Xna_race:if checkprivs(8,true) then
X`09if get_name(name`5Bkind`5D.id,names`5Bkind`5D,n) then custom_race(n);
Xna_room:if checkprivs(2,true) then custom_room;
Xna_foreground:if checkprivs(2,true) then custom_foreground;
X  end;
Xend;
X
Xprocedure delete_object(objnum:integer);
Xbegin
Xend;
X
Xprocedure delete_room;
Xbegin
Xend;
X
Xprocedure do_delete(thename:string);
Xvar
X  s:string;
X  n:integer;
Xbegin
X  n := 0;
X  if length(thename) > 0 then
X  begin
X    s := lowcase(thename);
X    case s`5B1`5D of
X      'o':if lookup(name`5Bna_obj`5D.id,thename,n,true) then delete_object(n
V);
X      'r':delete_room;
X    end;
X  end;
Xend;
X
Xprocedure do_create;
Xvar
X  s:string;
X  n,kind:integer;
X  ok:boolean := false;
Xbegin
X  grab_kind('Make',kind);
X  if not (kind in `5B0,na_foreground`5D) then
X  begin
X    grab_line('Name',s);
X    ok := valid_name(kind,s);
X    if ok then
X    begin
X      case kind of
Xna_spell:create_spell(s);
Xna_obj :create_object(s);
Xna_race:create_race(s);
Xna_room:begin
X`09  create_room(s);
X`09  getroom;
X`09  freeroom;
X`09end;
X      end;
X    end;
X  end;
Xend;
X
Xprocedure do_system(cmd:char := ' ');
Xvar
X  i,j,n:integer;
X  done:boolean := false;
X  system_help:array`5B1..9`5D of shortstring := (
X`09'i - rebuild indexs',
X`09'I - rebuild intfile',
X`09'n - rebuild namefile',
X`09'a - add races',
X`09'o - add objects',
X`09'p - add players',
X`09'r - add rooms',
X`09's - add spells',
X`09'R - rebuild all');
X
X  procedure rebuild_indexfile;
X  begin
X    for i := 1 to i_max do
X    begin
X      locate(indexfile,i);
X      for j := 1 to maxindex do indexfile`5E.on`5Bj`5D := false;
X      indexfile`5E.valid := i;
X      indexfile`5E.top := 0;
X      indexfile`5E.inuse := 0;
X      put(indexfile);
X    end;
X  end;
X
X  procedure rebuild_namefile;
X  begin
X    for j := 1 to na_max do
X    begin
X      locate(namefile,j);
X      namefile`5E.valid := j;
X      namefile`5E.loctop := 0;
X      for i := 1 to maxindex do namefile`5E.id`5Bi`5D := '';
X      put(namefile);
X    end;
X  end;
X
X  procedure rebuild_intfile;
X  begin
X    for i := 1 to n_max do
X    begin
X      locate(intfile,i);
X      intfile`5E.valid := i;
X      put(intfile);
X    end;
X  end;
X
X  procedure check_indexfile;
X  var
X    total:integer;
X  begin
X    for i := 1 to i_max do
X    begin
X      total := 0;
X      getindex(i);
X      for j := 1 to indx`5Bi`5D.top do
X      if indx`5Bi`5D.on`5Bj`5D then total := total + 1;
X      indx`5Bi`5D.inuse := total;
X      putindex(i);
X    end;
X  end;
X
Xbegin
X  x_write_array(system_help,,'System');
X  repeat
X    case grab_key('System>') of
X  '9':check_indexfile;
X  'R':if grab_yes('This nukes everything.  Really do it') then
X      if grab_yes('Ya sure') then
X      if grab_yes('Do you have a note from your mother') then
X      begin
X`09rebuild_indexfile;
X`09rebuild_intfile;
X`09rebuild_namefile;
X`09addplayers(10,false);
X`09addplayers(10,true);
X`09addrooms(5);
X`09addraces(10);
X`09addobjects(5);
X`09addspells(5);
X`09create_room('Land of Opportunity',132,64);
X`09create_race('Human');
X`09create_race('Elf');
X`09create_race('Dwarf');
X`09create_race('Snark');
X`09create_race('Orc');
X`09create_race('Troll');
X`09create_race('Mummy');
X`09create_race('Snipe');
X`09create_race('Boojum');
X`09create_race('Dragon');
X      end;
X  'q':done := true;
X  'i':if grab_yes('Rebuild index file') then rebuild_indexfile;
X  'n':if grab_yes('Add namefile') then rebuild_namefile;
X  'I':if grab_yes('Rebuild intfile') then rebuild_intfile;
X  'r':begin
X        grab_num('Number of rooms to add',n,0);
X        if n > 0 then addrooms(n);
X      end;
X  'o':begin
X        grab_num('Number of object to add',n,0);
X        if n > 0 then addobjects(n);
X      end;
X  's':begin
X        grab_num('Number of spells to add',n,0);
X        if n > 0 then addspells(n);
X      end;
X  'a':begin
X        grab_num('Number of races to add',n,0);
X        if n > 0 then addraces(n);
X      end;
X  'p':begin
X        grab_num('Number of players to add',n,0);
X        if n > 0 then
X`09begin
X`09  if grab_yes('Shall there be npcs') then addplayers(n,true)
X`09  else addplayers(n,false);
X`09end;
X      end;
X    end;
X  until done;
Xend;
X
Xend.
$ CALL UNPACK SROP.PAS;1 1850196538
$ create 'f'
X`5Binherit ('srinit','srsys','srio'),environment('srother')`5D
X
Xmodule srother;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$repaste_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`20
X`5BASYNCHRONOUS`5D FUNCTION smg$end_pasteboard_update (
X`09pasteboard_id : UNSIGNED) : INTEGER; EXTERNAL;
X`20
X`5BASYNCHRONOUS`5D FUNCTION smg$begin_pasteboard_update (
X`09pasteboard_id : UNSIGNED) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$put_chars (
X`09display_id : UNSIGNED;
X`09text : `5BCLASS_S`5D PACKED ARRAY `5B$l2..$u2:INTEGER`5D OF CHAR;
X`09start_row : INTEGER := %IMMED 0;
X`09start_column : INTEGER := %IMMED 0;
X`09flags : UNSIGNED := %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$erase_display (
X`09display_id : UNSIGNED;
X`09start_row : INTEGER := %IMMED 0;
X`09start_column : INTEGER := %IMMED 0;
X`09end_row : INTEGER := %IMMED 0;
X`09end_column : INTEGER := %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`20
Xprocedure toggle_full_text(on:boolean; g_wind:boolean := true);
Xbegin
X  full_text := on;
X  smg$begin_pasteboard_update(pasteboard);
X  if full_text then
X  smg$repaste_virtual_display(twind,pasteboard,2,2)
X  else
X  begin
X    if g_wind then smg$repaste_virtual_display(gwind,pasteboard,2,2)
X    else smg$repaste_virtual_display(ywind,pasteboard,2,2);
X    smg$repaste_virtual_display(xwind,pasteboard,2,51);
X  end;
X  smg$end_pasteboard_update(pasteboard);
Xend;
X
Xprocedure add_class(xname:shortstring; number,
X  xa1,xa2,xa3,xa4,xa5,xa6,xa7,xa8,xa9,xa10,xa11,xa12,xa13,xa14,xa15,xa16,
X  xa17,xa18,xa19,xa20,
X  xpoints,xhealth,xmana,xwealth,
X  xdelay_m,xsize,xheal_speed,
X  xmana_speed,xnoise,xperception,xforce,xwind,xfire,xcold,xelectric,xmagic,
X  xholy,xself,xweapon,xmissile:integer);
Xbegin
X  with class`5Bnumber`5D do
X  begin
X    class_name`5Bnumber`5D := xname;
X    armor`5B1`5D.chance`09:= xa1;
X    armor`5B1`5D.magnitude`09:= xa2;
X    armor`5B2`5D.chance`09:= xa3;
X    armor`5B2`5D.magnitude`09:= xa4;
X    armor`5B3`5D.chance`09:= xa5;
X    armor`5B3`5D.magnitude`09:= xa6;
X    armor`5B4`5D.chance`09:= xa7;
X    armor`5B4`5D.magnitude`09:= xa8;
X    armor`5B5`5D.chance`09:= xa9;
X    armor`5B5`5D.magnitude`09:= xa10;
X    armor`5B6`5D.chance`09:= xa11;
X    armor`5B6`5D.magnitude`09:= xa12;
X    armor`5B7`5D.chance`09:= xa13;
X    armor`5B7`5D.magnitude`09:= xa14;
X    armor`5B8`5D.chance`09:= xa15;
X    armor`5B8`5D.magnitude`09:= xa16;
X    armor`5B9`5D.chance`09:= xa17;
X    armor`5B9`5D.magnitude`09:= xa18;
X    armor`5B10`5D.chance`09:= xa19;
X    armor`5B10`5D.magnitude`09:= xa20;
X    attrib`5Bat_points`5D`09:= xpoints;
X    attrib`5Bat_health`5D`09:= xhealth;
X    attrib`5Bat_mana`5D`09:= xmana;
X    attrib`5Bat_wealth`5D`09:= xwealth;
X    attrib`5Bat_mv_delay`5D`09:= xdelay_m;
X    attrib`5Bat_size`5D`09:= xsize;
X    attrib`5Bat_heal_speed`5D:= xheal_speed;
X    attrib`5Bat_mana_speed`5D:= xmana_speed;
X    attrib`5Bat_noise`5D`09:= xnoise;
X    attrib`5Bat_perception`5D:= xperception;
X    proficiency`5Bel_force`5D:= xforce;
X    proficiency`5Bel_wind`5D := xwind;
X    proficiency`5Bel_fire`5D:= xfire;
X    proficiency`5Bel_cold`5D:= xcold;
X    proficiency`5Bel_electric`5D:=xelectric;
X    proficiency`5Bel_magic`5D:= xmagic;
X    proficiency`5Bel_holy`5D := xholy;
X    proficiency`5Bel_self`5D := xself;
X    proficiency`5Bel_weapon`5D := xweapon;
X    proficiency`5Bel_missile`5D := xmissile;
X  end;            `20
Xend;
X
X`5Basynchronous`5D
Xfunction obj_effect(effectnum:integer):integer;
Xvar
X  i:integer := 1;
X  found:boolean := false;
Xbegin
X  obj_effect := 0;
X  while (i <= maxparm) and not found do
X  if obj.parm`5Bi`5D = effectnum then
X  begin
X    found := true;
X    obj_effect := obj.mag`5Bi`5D;
X  end
X  else i := i + 1;
Xend;
X
X`5Basynchronous`5D
Xprocedure free_space(var x,y:integer);
Xvar
X  i,tries:integer := 1;
X  ok:boolean;
Xbegin
X  repeat
X    ok := true;
X    tries := tries + 1;
X    x := rnum(here.size.x);
X    y := rnum(here.size.y);
X    for i := 1 to fg_layers do if fg.map`5Bx,y,i`5D <> 0 then ok := false;
X  until (tries > 1000) or ok;
X  if not ok then
X  begin
X    x := 0;
X    y := 1;
X    while (x < here.size.x) and (not ok) do
X    begin
X      x := x + 1;
X      while (y < here.size.y) and (not ok) do
X      for i := 1 to fg_layers do if fg.map`5Bx,y,i`5D = 0 then ok := true
X      else y := y + 1;
X    end;
X  end;
Xend;
X
X`5Basynchronous`5D
Xfunction write_nice(s:string; l:integer):string;
Xvar
X  i:integer;
X  srt:string;
Xbegin
X  if l >= length(s) + 1 then
X  for i := length(s) + 1 to l do s := s +(' ');
X  write_nice := s;
Xend;
X
X`5Basynchronous`5D
Xfunction adverb:string;
Xbegin
X  case rnum(10) of
X1:adverb := 'terrific';
X2:adverb := 'spectacular';
X3:adverb := 'graceful';
X4:adverb := 'clumsly';
X5:adverb := 'awesome';
X6:adverb := 'cunning';
X7:adverb := 'elegant';
X8:adverb := 'truly gifted';
X9:adverb := 'most impressive';
X10:adverb := 'godlike';
X  end;
Xend;
X
X`5Basynchronous`5D
Xfunction checkprivs(level:integer := 0; echo:boolean := false):boolean;
Xbegin
X  if privlevel >= level then checkprivs := true
X  else
X  begin
X    checkprivs := false;
X    if echo then
X    begin
X      writev(qpqp,'That operation requires level ',level:0,' privs.');
X      wl(qpqp);
X    end;
X  end;
Xend;
X
X`5Basynchronous`5D
Xprocedure draw_x(line_num:integer := 0);
Xvar
X  i,y_coord,d_first,d_last:integer;
X  ok:boolean := false;
Xbegin
X  if line_num = 0 then
X  begin
X    ok := true;
X    d_first := x_start;
X    d_last := x_end;
X  end
X  else if line_num in `5Bx_start..x_end`5D then
X  begin
X    ok := true;
X    d_first := line_num;
X    d_last := line_num;
X  end;
X  if ok then
X  for i := d_first to d_last do
X  begin
X    y_coord := 1 + i - x_start;
X    smg$put_chars(xwind,x_window`5Bi`5D,y_coord,1);
X  end;
Xend;
X
X`5Basynchronous`5D
Xprocedure purge_x;
Xvar
X  i:integer;
Xbegin
X  smg$erase_display(xwind,1,1,15,29);
X  for i := 1 to x_max do x_window`5Bi`5D := '';
X  x_start := 1;
X  x_last := 0;
X  x_end := 0;
Xend;
X
X`5Basynchronous`5D
Xprocedure set_xsize(var s:string);
Xbegin
X  if length(s) > 29 then s := substr(s,1,29)
X  else s := write_nice(s,29);
Xend;
X
X`5Basynchronous`5D
Xprocedure change_x(old_s,new_s:string; draw:boolean := true);
Xvar
X  i:integer := 1;
X  done:boolean := false;
Xbegin
X  set_xsize(old_s);
X  set_xsize(new_s);
X  while (not done) and (i <= x_last) do
X  if x_window`5Bi`5D = old_s then
X  begin
X    x_window`5Bi`5D := new_s;
X    done := true;
X  end
X  else i := i + 1;
X  draw_x(i);
Xend;
X
X`5Basynchronous`5D
Xprocedure add_x(s:string; draw:boolean := false);
Xbegin
X  set_xsize(s);
X  if x_last < x_max then
X  begin
X    x_last := x_last + 1;
X    x_window`5Bx_last`5D := s;
X    if x_last - x_start < x_length then x_end := x_last;
X  end;
X  if draw then draw_x;
Xend;
X
X`5Basynchronous`5D
Xprocedure x_check;
Xbegin
X  if x_end > x_last then x_end := x_last;
Xend;
X
X`5Basynchronous,global`5D
Xprocedure remove_x(s:string; draw:boolean := false);
Xvar
X  i,j:integer;
Xbegin
X  for i := 1 to x_last do
X  if x_window`5Bi`5D = s then
X  begin
X    for j := i to x_last do
X    x_window`5Bj`5D := x_window`5Bj+1`5D;
X    x_last := x_last - 1;
X    x_check;
X    if (x_end = x_last) and ((x_end - x_start) < 14) then
X    smg$put_chars(xwind,write_nice('',27),2 + x_end - x_start,1);
X  end;
X  if draw then draw_x;
Xend;
X
Xprocedure x_up;
Xbegin
X  x_start := x_start - x_length;
X  if x_start < 1 then x_start := 1;
X  x_end := x_start + x_length -1;
X  x_check;
X  draw_x;
Xend;
X
Xprocedure x_down;
Xbegin
X  x_end := x_end + x_length;
X  x_check;
X  x_start := 1 + x_end - x_length;
X  if x_start < 1 then x_start := 1;
X  draw_x;
Xend;
X
X`5Basynchronous`5D
Xprocedure change_stat(statnum,change_to:integer; max_stat:boolean := false);
Xvar
X  old_s,new_s:string;
Xbegin
X  if window_name = name`5Bna_player`5D.id`5Bplr`5Bnow`5D.log`5D then
X  begin
X    writev(old_s,write_nice(attrib_name`5Bstatnum`5D,16),':',
X`09pl`5Bnow`5D.attrib`5Bstatnum`5D:0,'/',pl`5Bnow`5D.attrib_max`5Bstatnum`5D
V:0);
X    if max_stat then writev(new_s,write_nice(attrib_name`5Bstatnum`5D,16),':
V',
X`09pl`5Bnow`5D.attrib`5Bstatnum`5D:0,'/',change_to:0)
X    else writev(new_s,write_nice(attrib_name`5Bstatnum`5D,16),':',
X`09change_to:0,'/',pl`5Bnow`5D.attrib_max`5Bstatnum`5D:0);
X    change_x(old_s,new_s);
X  end;
X  if max_stat then pl`5Bnow`5D.attrib_max`5Bstatnum`5D := change_to
X  else pl`5Bnow`5D.attrib`5Bstatnum`5D := change_to;
Xend;
X
X`5Basynchronous`5D
Xprocedure change_stat_ex(statnum,change_to:integer);
Xvar
X  old_s,new_s:string;
Xbegin
X  if pl`5Bnow`5D.attrib_ex`5Bstatnum`5D <> change_to then
X  begin
X    if window_name = name`5Bna_player`5D.id`5Bplr`5Bnow`5D.log`5D then
X    begin
X      writev(old_s,write_nice(attrib_ex_name`5Bstatnum`5D,16),':',
X`09pl`5Bnow`5D.attrib_ex`5Bstatnum`5D:0);
X      writev(new_s,write_nice(attrib_ex_name`5Bstatnum`5D,16),':',
X`09change_to:0);
X      change_x(old_s,new_s);
X    end;
X    pl`5Bnow`5D.attrib_ex`5Bstatnum`5D := change_to;
X  end;
Xend;
X
+-+-+-+-+-+-+-+-  END  OF PART 20 +-+-+-+-+-+-+-+-