-+-+-+-+-+-+-+-+ START OF PART 13 -+-+-+-+-+-+-+-+
X      where.r := 1;
X    end;
X    put(playerfile);
X  end;
X  indx`5Bi_npc`5D.top := indx`5Bi_npc`5D.top + n;
X  indx`5Bi_ingame`5D.top := indx`5Bi_ingame`5D.top + n;
X  indx`5Bi_player`5D.top := indx`5Bi_player`5D.top + n;
X  putindex(i_npc);
X  putindex(i_ingame);
X  putindex(i_player);
Xend;
X
Xfunction allocate(indexnum:integer; var n:integer):boolean;
Xvar
X  found:boolean;
Xbegin
X  perf('allocate');
X  getindex(indexnum);
X  if indx`5Bindexnum`5D.inuse = indx`5Bindexnum`5D.top then
X  begin
X    freeindex;
X    n := 0;
X    allocate := false;
X    wl('There is no more space available.');
X  end
X  else
X  begin
X    n := 1;
X    found := false;
X    while (not found) and (n <= indx`5Bindexnum`5D.top) do
X    begin
X      if (not indx`5Bindexnum`5D.on`5Bn`5D) then found := true
X      else n := n + 1;
X    end;
X    if found then
X    begin
X      indx`5Bindexnum`5D.on`5Bn`5D := true;
X      allocate := true;
X      indx`5Bindexnum`5D.inuse := indx`5Bindexnum`5D.inuse + 1;
X      putindex(indexnum);
X    end
X    else
X    begin
X      freeindex;
X      wl('Allocation error.');
X      allocate := false;
X    end;
X  end;
X  getindex(indexnum);
X  freeindex;
Xend;
X
Xprocedure deallocate(indexnum:integer; n:integer);
Xbegin
X  getindex(indexnum);
X  indx`5Bindexnum`5D.inuse := indx`5Bindexnum`5D.inuse - 1;
X  indx`5Bindexnum`5D.on`5Bn`5D := false;
X  putindex(indexnum);
Xend;
X
Xprocedure delete_player(log:integer);
Xbegin
X  deallocate(i_player,log);
X  getname(na_player);
X  name`5Bna_player`5D.id`5Blog`5D := 'Deleted';
X  putname(na_player);
X  getname(na_user);
X  name`5Bna_user`5D.id`5Blog`5D := '';
X  putname(na_user);
X  wl('Player removed.');
Xend;
X
Xprocedure remove_old_player;
Xvar
X  i,lowest,lowlog:integer := 0;
Xbegin
X  for i := 1 to indx`5Bi_player`5D.top do
X  begin
X    getplayer(i);
X    freeplayer;
X    if (player.last_play < lowest) and (not indx`5Bi_npc`5D.on`5Bi`5D) then
X    begin
X      lowest := player.last_play;
X      lowlog := i;
X    end;
X  end;
X  delete_player(lowlog);
Xend;
X
Xprocedure openfiles;
Xvar
X  fname:string;
X  i:integer;
Xbegin
X  if not human and debug then
X  begin
X    writev(fname,'debug_',here.valid:0,'.sr');
X    open(outfile,temp_root+fname,access_method := sequential,
X`09sharing := readwrite,history := unknown);
X    add_acl(fname,'(identifier=`5Bmas,'+srop+'`5D,access=read+write+execute+
Vdelete)');
X  end;
X  open(fgfile,root+'fg.sr',access_method := direct,
X`09sharing := readwrite,history := unknown);
X  open(indexfile,root+'index.sr',access_method := direct,
X`09sharing := readwrite,history := unknown);
X  open(roomfile,root+'room.sr',access_method := direct,
X`09sharing := readwrite,history := unknown);
X  open(namefile,root+'name.sr',access_method := direct,
X`09sharing := readwrite,history := unknown);
X  open(spellfile,root+'spell.sr',access_method := direct,
X`09sharing := readwrite,history := unknown);
X  open(intfile,root+'integer.sr',access_method := direct,
X`09sharing := readwrite,history := unknown);
X  open(objfile,root+'object.sr',access_method := direct,
X`09sharing := readwrite,history := unknown);
X  open(playerfile,root+'player.sr',access_method := direct,
X`09sharing := readwrite,history := unknown);
X  open(racefile,root+'race.sr',access_method := direct,
X`09sharing := readwrite,history := unknown);
Xend;
X
Xend.
$ CALL UNPACK SRIO.PAS;1 1212785194
$ create 'f'
X`5Binherit ('srinit','srsys','srmisc','srother','srio'),
X environment('srmap')`5D
X
Xmodule srmap;
X
Xconst
X  maxjunction`09= 100;
X  maxroom`09= 50;
X  floor_icon`09= 'o';
X  fgt_floor`09= 0;
X  fgt_wall`09= 1;
X  fgt_door`09= 2;
X  fgt_stairup`09= 4;
X  fgt_stairdn`09= 5;
Xtype
X
X  roomsrec = record
X    x1,x2,y1,y2`09:integer;
X  end;
X
X  junction = record
X`09x,y,used:integer;
X`09home`09:integer;
X`09on`09:boolean;
X`09dir`09:array`5B1..4`5D of boolean;
X  end;
X
X`5Basynchronous`5D
Xprocedure draw_map;
Xvar
X  all_connected:boolean := false;
X  map_home`09:array`5B1..maxhoriz,1..maxvert`5D of integer;
X  junc`09`09:array`5B1..maxjunction`5D of junction;
X  connection`09:array`5B1..maxroom`5D of integer;
X  room`09`09:array`5B1..maxroom`5D of roomsrec;
X  path,tries,num_rooms,blocks,i,j,jn,direction:integer := 0;
X
X  function free_junction(var j_slot:integer):boolean;
X  var
X    i:integer := 1;
X    done:boolean := false;
X  begin
X    free_junction := false;
X    while (i <= maxjunction) and (not done) do
X    if not junc`5Bi`5D.on then
X    begin
X      done := true;
X      j_slot := i;
X      free_junction := true;
X    end
X    else i := i + 1;
X  end;
X
X  procedure do_connection(root1,root2:integer);
X  var
X    i,sum:integer := 0;
X  begin
X    while (root1 <> connection`5Broot1`5D) do root1 := connection`5Broot1`5D
V;
X    while (root2 <> connection`5Broot2`5D) do root2 := connection`5Broot2`5D
V;
X    if root1 <> root2 then connection`5Broot1`5D := root2;
X    for i := 1 to maxroom do
X    if connection`5Bi`5D <> i then sum := sum + 1;
X    if sum = num_rooms - 1 then all_connected := true;
X  end;
X
X  procedure draw_corridor;
X  var
X    i,j,j_slot,k,count,range,xx,yy,xo,yo:integer := 0;
X    first:boolean := true;
X    s:string;
X
X    procedure zap(n:integer);
X    begin
X      with junc`5Bj_slot`5D do
X      if not dir`5Bn`5D then
X      begin
X`09used := used + 1;
X`09dir`5Bn`5D := true;
X      end;
X    end;
X
X  function screen_edge(x,y:integer):boolean;
X  begin
X    screen_edge := false;
X    case direction of
X    1:if y = 1 then screen_edge := true;
X    2:if y = here.size.y then screen_edge := true;
X    3:if x = here.size.x then screen_edge := true;
X    4:if x = 1 then screen_edge := true;
X    end;
X  end;
X
X  begin
X    range := 2 * rnum(10);
X    xx := junc`5Bjn`5D.x;
X    yy := junc`5Bjn`5D.y;
X    xo := xx;
X    yo := yy;
X    path := junc`5Bjn`5D.home;
X    junc`5Bjn`5D.used := junc`5Bjn`5D.used + 1;
X    junc`5Bjn`5D.dir`5Bdirection`5D := true;
X    if not screen_edge(xx,yy) then
X    repeat
X      if first then
X      begin
X`09fg.map`5Bxx,yy,1`5D := fgt_floor;
X`09first := false;
X      end
X      else fg.map`5Bxx,yy,1`5D := fgt_floor;
X      map_home`5Bxx,yy`5D := path;
X      blocks := blocks + 1;
X      count := count + 1;
X      xo := xx;
X      yo := yy;
X      case direction of
X`091:yy := yy - 1;
X`092:yy := yy + 1;
X`093:xx := xx + 1;
X`094:xx := xx - 1;
X      end;
X    until screen_edge(xx,yy) or
X`09(count = range) or
X`09(fg.map`5Bxx,yy,1`5D = fgt_floor);
X
X    if fg.map`5Bxx,yy,1`5D = fgt_floor then
X    if map_home`5Bxx,yy`5D <> path then
X    begin
X      fg.map`5Bxo,yo,1`5D := fgt_door;
X      do_connection(map_home`5Bxx,yy`5D,path);
X    end;
X
X    if (fg.map`5Bxx,yy,1`5D <> fgt_floor) then
X      if free_junction(j_slot) then
X      with junc`5Bj_slot`5D do
X      begin
X`7B`09if xx = 1 then zap(4);
X`09if xx = here.size.x then zap(3);
X`09if yy = 1 then zap(1);
X`09if yy = here.size.y then zap(2);`7D
X`09home := path;
X`09on := true;
X`09used := 1;
X`09x := xx;
X`09y := yy;
X      end;
X  end;
X
X  procedure draw_rooms;
X  var
X    i,j,k:integer;
X  begin
X    for k := 1 to num_rooms do
X    begin
X      with room`5Bk`5D do
X      for j := room`5Bk`5D.y1 to room`5Bk`5D.y2 do
X      for i := room`5Bk`5D.x1 to room`5Bk`5D.x2 do
X      begin
X`09fg.map`5Bi,j,1`5D := fgt_floor;
X`09map_home`5Bi,j`5D := k;
X      end;
X    end;
X  end;
X
X  procedure create_rooms;
X  var
X    size_x,size_y,tries:integer;
X
X    function no_overlap:boolean;
X    var
X      ii:integer;
X      o_x,o_y:boolean := false;
X    begin
X      if i <> 1 then
X      for ii := 1 to i-1 do
X      begin
X        if (room`5Bi`5D.x1 in `5Broom`5Bii`5D.x1-1..room`5Bii`5D.x2+1`5D) or
X`09   (room`5Bi`5D.x1 in `5Broom`5Bii`5D.x1-1..room`5Bii`5D.x2+1`5D) or
X`09   (room`5Bii`5D.x1 in `5Broom`5Bi`5D.x1-1..room`5Bi`5D.x2 +1`5D) or
X`09   (room`5Bii`5D.x2 in `5Broom`5Bi`5D.x1-1..room`5Bi`5D.x2 +1`5D) then o_
Vx := true;
X        if (room`5Bi`5D.y1 in `5Broom`5Bii`5D.y1-1..room`5Bii`5D.y2+1`5D) or
X`09   (room`5Bi`5D.y2 in `5Broom`5Bii`5D.y1-1..room`5Bii`5D.y2+1`5D) or
X`09   (room`5Bii`5D.y2 in `5Broom`5Bi`5D.y1-1..room`5Bi`5D.y2 +1`5D) or
X`09   (room`5Bii`5D.y2 in `5Broom`5Bi`5D.y1-1..room`5Bi`5D.y2 +1`5D) then o_
Vy := true;
X      end;
X      no_overlap := not (o_x and o_y);
X    end;
X
X  begin
X    i := 1;
X    repeat
X      tries := tries + 1;
X      with room`5Bi`5D do
X      begin
X`09size_x := 4 + 2 * rnum(8);
X`09size_y := 2 + 2 * rnum(4);
X`09x1 := 2 * rnum((1 + here.size.x - size_x) div 2);
X`09y1 := 2 * rnum((1 + here.size.y - size_y) div 2);
X`09x2 := x1 + size_x -1;
X`09y2 := y1 + size_y -1;
X`09if no_overlap then
X`09with junc`5B1 + maxjunction - i`5D do
X`09begin
X`09  home := i;
X`09  on := true;
X`09  case rnum(2) of
X`09  1:begin
X`09      x := round((x1 + x2)/2);
X`09      if y1 = 1 then y := y2
X`09      else if y2 = here.size.y then y := y1
X`09      else
X`09      case rnum(2) of
X`09      1:y := y1;
X`09      2:y := y2;
X`09      end;
X`09    end;
X`09  2:begin
X`09      y := round((y1 + y2)/2);
X`09      if x1 = 1 then x := x2
X`09      else if x2 = here.size.x then x := x1
X`09      else
X`09      case rnum(2) of
X`09      1:x := x1;
X`09      2:x := x2;
X`09      end;
X`09    end;
X`09  end;
X`09  i := i + 1;
X`09end;
X      end;
X    until (tries > 1000) or (i = maxroom);
X    num_rooms := i - 1;
X  end;
X
X  procedure init_junction(i:integer);
X  var
X    j:integer;
X  begin
X    with junc`5Bi`5D do
X    begin
X      on := false;
X      used := 0;
X      home := 0;
X      for j := 1 to 4 do dir`5Bj`5D := false;
X    end;
X  end;
X
X  procedure init_junctions;
X  begin
X    for i := 1 to maxroom do connection`5Bi`5D := i;
X    for i := 1 to maxjunction do init_junction(i);
X    for i := 1 to here.size.x do
X    for j := 1 to here.size.y do
X    begin
X      fg.map`5Bi,j,1`5D := fgt_wall;
X      map_home`5Bi,j`5D := 0;
X    end;
X  end;
X
X  procedure map_stairways;
X  var
X    x,y:integer;
X  begin
X    for i := 1 to rnum(6) do
X    begin
X      free_space(x,y);
X      if i < 3 then fg.map`5Bx,y,1`5D := fgt_stairup
X      else fg.map`5Bx,y,1`5D := fgt_stairdn;
X    end;
X  end;
X
Xbegin
X  getfg(here.valid);
X  init_junctions;
X  create_rooms;
X  draw_rooms;
X  tries := 1;
X  repeat
X    tries := tries + 1;
X    for jn := 1 to maxjunction do
X    begin
X      if junc`5Bjn`5D.on then
X      if (junc`5Bjn`5D.used < 4) then
X      begin
X`09repeat
X`09  direction := rnum(4);
X`09until not junc`5Bjn`5D.dir`5Bdirection`5D;
X`09draw_corridor;
X`09if junc`5Bjn`5D.used = 4 then init_junction(jn);
X      end;
X    end;
X  until all_connected or (tries > 20);
X  tries := 1;
X  repeat
X    tries := tries + 1;
X    for jn := 1 to maxjunction do
X    with junc`5Bjn`5D do
X    begin
X      if on then
X      if used = 1 then
X      begin
X`09repeat
X`09  direction := rnum(4);
X`09until not dir`5Bdirection`5D;
X`09draw_corridor;
X      end;
X    end;
X  until (tries > 20);
X  map_stairways;
X  putfg;
Xend;
X
Xend.
$ CALL UNPACK SRMAP.PAS;1 626167925
$ create 'f'
X`5Binherit ('srinit','srsys','srio','srother','sys$library:starlet'),
X environment('srmenu')`5D
X
Xmodule srmenu(input,output);
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$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$begin_pasteboard_update (
X`09pasteboard_id : UNSIGNED) : INTEGER; EXTERNAL;
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$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$end_pasteboard_update (
X`09pasteboard_id : UNSIGNED) : INTEGER; EXTERNAL;
X
X`5BASYNCHRONOUS`5D FUNCTION smg$delete_virtual_display (
X`09display_id : UNSIGNED) : INTEGER; EXTERNAL;
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
Xprocedure do_menu(help_file:string := '');
Xconst
X  m_length = 14;
Xvar
X  i,m_first,m_last:integer;
X  done:boolean := false;
X  sel,dum_dum:integer;
X  context:unsigned := 0;
X  s:string;
X
X  procedure menu_help;
X  var
X    s:string;
X  begin
X    wl;
X    wl('Q   - Quits            U - Scroll up          D - Scroll down');
X    wl('t - toggle screen      v - view helpfile');
X    wl('h/? - This menu        L - List various names/etc');
X    writev(s,'Choose a number between 1 and ',mc:0,'.');
X    wl(s);
X  end;
X
X  procedure draw_menu(line_num:integer := 0);
X  var
X    i:integer;
X    s1,s2,s3:string;
X    d_first,d_last:integer;
X  begin
X    if line_num = 0 then
X    begin
X      d_first := m_first;
X      d_last := m_last;
X    end
X    else
X    begin
X      d_first := line_num;
+-+-+-+-+-+-+-+-  END  OF PART 13 +-+-+-+-+-+-+-+-