-+-+-+-+-+-+-+-+ START OF PART 23 -+-+-+-+-+-+-+-+
X`09  end;
X`09otherwise
X`09  begin
X`09    if echo then smg$delete_chars(twind,1,22,pos);
X`09    line := substr(line,1,length(line)-1);
X`09    pos := pos - 1;
X`09    ch := getkey(keymode);
X`09  end;
X      end;
X    end
X    else if ch = chr(21) then
X    begin
X      if echo then smg$erase_line(twind,22,length(prompt)+1);
X      line := '';
X      pos := length(prompt);
X      ch := getkey(keymode);
X    end
X    else if length(line) + length(prompt) > 78 then
X    begin
X      smg$ring_bell(twind);
X      ch := getkey(keymode);
X    end
X    else if ((ord(ch) > 31) and (ord(ch) < 127)) then
X    begin `7Bno ctrls`7D
X      line := line + ch;
X      pos := pos + 1;
X      if echo then smg$put_chars(twind,ch);
X      ch := getkey(keymode);
X    end
X    else ch := getkey(keymode);
X  end;
X  if ch = chr(26) then s := chr(26)
X  else s := line;
X  if echo then smg$erase_line(twind,22,length(prompt)+1);
Xend;
X
Xprocedure grab_short(prompt:string := '';
X`09`09    var s:string;
X`09`09    keymode:integer := 0);
Xbegin
X  grab_line(prompt,s,keymode);
X  if length(s) > 20 then
X  begin
X    wl('String too long.  Truncated.');
X    s := substr(s,1,20);
X  end;
Xend;
X
Xfunction lowcase(s:string):string;
Xvar
X  sprime:string;
X  i:integer;
Xbegin
X  if length(s) = 0 then lowcase := ''
X  else
X  begin
X    sprime := s;
X    for i := 1 to length(s) do
X    if sprime`5Bi`5D in `5B'A'..'Z'`5D then
X    sprime`5Bi`5D := chr(ord('a')+(ord(sprime`5Bi`5D)-ord('A')));
X    lowcase := sprime;
X  end;
Xend;
X
Xprocedure grab_num(prompt:string; var n:integer;
X`09`09   min:integer := -maxint div 2;
X`09`09   max:integer := maxint div 2;
X`09`09   default:integer := 0);
Xvar
X  s:string;
Xbegin
X  grab_line(prompt,s);
X  if isnum(s) then
X  begin
X    n := number(s);
X    if privlevel <= 10 then
X    if (n < min) or (n > max) then n := default;
X  end
X  else n := default;   `20
Xend;
X
X`5Basynchronous`5D
Xfunction grab_yes(prompt:string):boolean;
Xvar
X  key:$uword := 0;
X  i:integer;
Xbegin
X  grab_yes := false;
X  sysstatus := 0;
X  prompt := new_prompt(prompt);
X  while sysstatus <> 1 do
X    sysstatus := smg$read_keystroke(keyboard,key,,10);
X  if chr(key) in `5B'Y','y','T','t','+','1'`5D then grab_yes := true;
Xend;
X
Xprocedure setup_display;
Xvar
X  io_status:iosb_type;
X  border:unsigned;
X  rows,cols:integer;
X  mask:unsigned;
Xbegin
X  now := 1;
X  seed := clock;
X  disable_cursor;
X  smg$create_virtual_keyboard(keyboard);
X  smg$set_keypad_mode(keyboard,1);
X  smg$create_pasteboard(pasteboard);
X  smg$create_virtual_display(15,29,xwind,smg$m_border);
X  smg$create_virtual_display(64,132,gwind,smg$m_border);
X  smg$label_border(xwind,game_name);
X  smg$create_virtual_display(22,78,twind,smg$m_border);
X  smg$set_cursor_mode(pasteboard,smg$m_cursor_off);
X  smg$create_viewport(gwind,1,1,15,48);
X  smg$begin_pasteboard_update(pasteboard);
X  smg$paste_virtual_display(gwind,pasteboard,2,2);
X  smg$paste_virtual_display(twind,pasteboard,2,2);
X  smg$paste_virtual_display(xwind,pasteboard,2,51);
X  smg$end_pasteboard_update(pasteboard);
X  sysstatus := $assign(devnam := 'sys$command', chan := tt_chan);
X  disable_c;
X  disable_y;
X  lib$init_timer(timercontext);
X  mask := lib$m_cli_ctrly + lib$m_cli_ctrlt;
X  sysstatus := lib$disable_ctrl(mask,save_dcl_ctrl);
Xend;
X
Xprocedure remove_display;
Xbegin
X  sysstatus := lib$enable_ctrl(save_dcl_ctrl);
X  smg$delete_virtual_keyboard(keyboard);
X  smg$delete_pasteboard(pasteboard);
X  enable_cursor;
Xend;
X
X`5Basynchronous`5D
Xfunction frozen:boolean;
Xbegin
X  frozen := (getticks < plr`5Bnow`5D.awake);
Xend;
X
X`5Basynchronous`5D
Xprocedure freeze(secs:real);
Xbegin
X  if (secs > 0) then
X  if plr`5Bnow`5D.awake < getticks then plr`5Bnow`5D.awake := trunc(getticks
V + secs* 10)
X  else plr`5Bnow`5D.awake := plr`5Bnow`5D.awake + trunc(secs * 10);
Xend;
X
Xfunction edit(file_name,definition:string := ''):boolean;
Xvar
X  dummy:string;
X  con:unsigned := 0;
X  old_symbol,s:string;
X  editor:tinystring := 'edit/tpu';
Xbegin
X  enable_cursor;
X  edit := false;
X  if definition <> '' then wl('Editing the '+definition+' description.');
X  grab_line('Would you prefer EDT or TPU ',s);
X  if length(s) > 0 then
X  if s`5B1`5D in `5B'e','E'`5D then editor := 'edit/edt';
X  sysstatus := lib$get_symbol(%descr 'edit',%descr old_symbol);
X  sysstatus := lib$set_symbol('edit','edit'+editor);
X  sysstatus := tpu$edit(%stdescr helproot+file_name,%stdescr helproot+file_n
Vame);
X  con := 0;
X  sysstatus := lib$find_file(helproot+file_name,%descr dummy,con);
X  if sysstatus = rms$_suc then
X  begin
X    edit := true;
X    add_acl(helproot+file_name,'(identifier=`5Bmas$user7`5D,access=read+writ
Ve)');
X    add_acl(helproot+file_name,'(identifier=`5Bv130kbnj`5D,access=read+write
V)');
X    add_acl(helproot+file_name,'(identifier=`5Bv119matc`5D,access=read+write
V)');
X  end;
X  sysstatus := lib$set_symbol(%descr 'edit',%descr old_symbol);
X  smg$repaint_screen(pasteboard);
X  disable_cursor;
Xend;
X
Xend.
$ CALL UNPACK SRSYS.PAS;1 352991116
$ create 'f'
X`5Binherit ('srinit','srsys','srother','srmove','srmisc','srcom',
X 'sys$library:starlet'),environment('srtime')`5D
X
Xmodule srtime;
X
Xvar
X  is_college:boolean := false;
X  is_hiding:boolean := false;
X  is_object:boolean := false;
X
X`5Basynchronous`5D
Xprocedure handle_event(eventnum:integer);
Xvar
X  moron,x,y,geometry,geo1,geo2,p1,p2,p3,p4:integer;
X  sp_effect,sp_element,duration,rendition:integer;
Xbegin
X  with event`5Beventnum`5D do
X  case action of
X
Xe_spell:
Xbegin
X  decompress(parm4,duration,rendition,moron);
X  decompress(xloc,x,y,moron);
X  decompress(yloc,geometry,geo1,geo2);
X  decompress(parm1,sp_effect,sp_element,moron);
X  decompress(parm2,p1,p2,moron);
X  decompress(parm3,p3,p4,moron);
X  map_foreground(parm4,geometry,x,y,geo1,geo2,false);
X  g_plot(geometry,x,y,geo1,geo2,0,10,chr(0));
X  fg.effect`5Bparm4`5D.kind := 0;
X  fg.effect`5Bparm4`5D.on := false;
X  fg.name`5Bparm4`5D := '';
Xend;
X
X  end;
X  event`5Beventnum`5D.action := 0;
Xend;
X
X
Xprocedure check_room;
Xvar
X  x,y:integer;
Xbegin
X  is_hiding := foreground_location(fg_normal,x,y);
X  is_college := foreground_location(fg_college,x,y);
X  is_object := object_location(x,y,true);
Xend;
X
Xprocedure allacts(check:boolean := true);
Xvar
X  i,int_result,old_now,player_top:integer;
X
X  procedure restore_stat;
X  var
X    addition,restore_time:integer;
X  begin
X    case i of
X  at_points`09:restore_time := 0;
X  at_health`09:if not pl`5Bnow`5D.sts`5Bps_poisoned`5D.on then
X`09         restore_time := pl`5Bnow`5D.attrib`5Bat_heal_speed`5D
X`09`09 else restore_time := pl`5Bnow`5D.attrib`5Bat_heal_speed`5D * 10;
X  at_mana`09:restore_time := pl`5Bnow`5D.attrib`5Bat_mana_speed`5D;
X  at_wealth`09:restore_time := 0;
X  at_mv_delay`09:restore_time := 2*60;
X  at_size`09:restore_time := 2*60;
X  at_heal_speed`09:restore_time := 2*60;
X  at_mana_speed`09:restore_time := 2*60;
X  at_noise`09:restore_time := 2*60;
X  at_perception`09:restore_time := 2*60;
X    end;
X    if restore_time > 0 then
X    begin
X      addition := min(
X      abs(round((pl`5Bnow`5D.attrib_max`5Bi`5D * slow)/restore_time)),
X      abs(pl`5Bnow`5D.attrib_max`5Bi`5D - pl`5Bnow`5D.attrib`5Bi`5D));
X      if pl`5Bnow`5D.attrib`5Bi`5D > pl`5Bnow`5D.attrib_max`5Bi`5D then addi
Vtion := -addition;
X      if addition <> 0 then change_stat(i,pl`5Bnow`5D.attrib`5Bi`5D + additi
Von);
X    end;
X  end;
X
Xbegin
X  if human then player_top := 1
X  else player_top := monsters_active;
X  old_now := now;
X  if getticks >= tickerquick then
X  begin
X    for now := 1 to player_top do
X    if check and not pl`5Bnow`5D.sts`5Bps_dead`5D.on then check_location(fal
Vse);
X    for i := 1 to event_max do
X    if event`5Bi`5D.action <> 0 then
X    if getticks > event_time`5Bi`5D then handle_event(i);
X    tickerquick := getticks + round(0.5 * 10); `7Bhalf second`7D
X  end;
X
X  if getticks >= tickerslow then
X  begin
X
X    if not human then check_room;
X
X    for now := 1 to player_top do
X    if not pl`5Bnow`5D.sts`5Bps_dead`5D.on then
X    for i := 1 to at_max do restore_stat;
X
X    for now := 1 to player_top do
X    for i := 1 to ps_max do
X    if pl`5Bnow`5D.sts`5Bi`5D.on then
X    if (pl`5Bnow`5D.sts`5Bi`5D.time < getticks) then
X    begin
X      pl`5Bnow`5D.sts`5Bi`5D.on := false;
X      case i of
Xps_poisoned:wl('You feel much better now.');
Xps_invisible:wl('You fade back into view.');
Xps_dead:if human then
X        begin
X`09  wl('The '+name`5Bna_race`5D.id`5Bpl`5Bnow`5D.attrib_ex`5Bst_race`5D`5D+
X`09  ' God has granted you a new body!');
X`09  do_rebirth(true);
X`09end;
X      end;
X    end;
X
X    sysstatus := $setpri(,,4);
X    tickerslow := getticks + 5 * 10; `7Bfive seconds`7D
X  end;
X
X  now := old_now;
Xend;
X
Xend.
$ CALL UNPACK SRTIME.PAS;1 1007956373
$ v=f$verify(v)
$ EXIT