-+-+-+-+-+-+-+-+ START OF PART 5 -+-+-+-+-+-+-+-+
X`7Bmissile`7D`090,0,
X`7Bpoints`7D`09120,
X`7Bhealth`7D`09100,
X`7Bmana`7D`09`09500,
X`7Bwealth`7D`0917,
X`7Bdelay_m`7D`095,
X`7Bsize`7D`09`091,
X`7Bheal_speed`7D`0920,
X`7Bmana_speed`7D`0960,
X`7Bnoise`7D`09`090,
X`7Bperception`7D`090,
X`7Bspell force`7D`0970,
X`7Bspell wind`7D`0970,
X`7Bspell fire`7D`0970,
X`7Bspell cold`7D`0970,
X`7Bspell electric`7D70,
X`7Bspell magic`7D`0970,
X`7Bspell holy`7D`0970,
X`7Bspell self`7D`0920,
X`7Bspell weapon`7D`0925,
X`7Bspell missile`7D`0920
X);
$ CALL UNPACK SRCLASS.PAS;1 2121293039
$ create 'f'
X`5Binherit ('srinit','srsys','srother','srio','srmove','srmisc'),
X environment('srcom')`5D
X
Xmodule srcom;
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`5Bhidden,external`5D
Xfunction getkey(key_mode:integer := 0):char;
Xexternal;
X
X`5Basynchronous`5D
Xfunction x_object(obj_slot:integer):string;
Xbegin
X  x_object := '('+chr(96+obj_slot)+') '+ boo(player.equipped`5Bobj_slot`5D)+
V' '+
X  name`5Bna_obj`5D.id`5Bplayer.equipment`5Bobj_slot`5D.num`5D;
Xend;
X
X`5Basynchronous`5D
Xfunction inventory_window:boolean;
Xbegin
X  if window_name = 'Inventory' then inventory_window := true
X  else inventory_window := false;
Xend;
X
X`5Basynchronous`5D
Xprocedure show_inventory(lognum:integer; purge:boolean := true);
Xvar
X  i:integer;
Xbegin
X  getplayer(lognum);
X  freeplayer;
X  x_label('Inventory');
X  if purge then purge_x;
X  for i := 1 to maxhold do
X  if player.equipment`5Bi`5D.num <> 0 then
X  begin
X    if purge then add_x(x_object(i))
X    else x_window`5Bi`5D := x_object(i);
X  end;
X  draw_x;
Xend;
X
Xprocedure do_inventory;
Xbegin
X  act_out(plr`5Bnow`5D.log,e_msg,pl`5Bnow`5D.where.x,pl`5Bnow`5D.where.y,nor
Vmal,,,,
X  name`5Bna_player`5D.id`5Bplr`5Bnow`5D.log`5D+' is taking inventory.');
X  show_inventory(plr`5Bnow`5D.log);
Xend;
X
Xfunction get_inv_slot(prompt:string := 'Object a..z ? '; var slot:integer):b
Voolean;
Xvar
X  s:string := ' ';
Xbegin
X  slot := 0;
X  get_inv_slot := false;
X  new_prompt(prompt);
X  repeat
X    s := lowcase(getkey);
X    if s`5B1`5D = '?' then do_inventory;
X  until not (s`5B1`5D in `5B' ','?'`5D);
X  if s`5B1`5D in `5B'a'..'z'`5D then
X  begin
X    slot := ord(s`5B1`5D) - 96;
X    if pl`5Bnow`5D.equipment`5Bslot`5D.num <> 0 then get_inv_slot := true
X    else slot := 0;
X  end
X  else if s`5B1`5D in `5B'0'`5D then
X  begin
X    slot := 0;
X    get_inv_slot := true;
X  end;
Xend;
X
Xprocedure show_spells;
Xvar
X  i:integer;
Xbegin
X  purge_x;
X  x_label('Spells known');
X  for i := 1 to indx`5Bi_spell`5D.top do
X  if pl`5Bnow`5D.spell`5Bi`5D then add_x(name`5Bna_spell`5D.id`5Bi`5D);
X  draw_x;
Xend;
X
Xfunction holding_object(lookingfor:integer):integer;
Xvar
X  i:integer := 1;
X  found:boolean := false;
Xbegin
X  holding_object := 0;
X  while (i <= maxhold) and (not found) do
X  if pl`5Bnow`5D.equipment`5Bi`5D.num = lookingfor then
X  begin
X    found := true;
X    holding_object := i;
X  end
X  else i := i + 1;
Xend;
X
Xprocedure hold_obj(theobject:uniqueobj; slot:integer);
Xbegin
X  wl('You are now holding the '+name`5Bna_obj`5D.id`5Btheobject.num`5D+'.');
X  read_object(theobject.num);
X  change_stat(at_mv_delay,pl`5Bnow`5D.attrib`5Bat_mv_delay`5D + obj.weight,t
Vrue);
X  change_stat(at_mv_delay,pl`5Bnow`5D.attrib`5Bat_mv_delay`5D + obj.weight,f
Valse);
X  pl`5Bnow`5D.equipment`5Bslot`5D := theobject;
X  save_player;
Xend;
X
Xprocedure show_obj(object:uniqueobj; eqp:boolean);
Xvar
X  s:string;
Xbegin
X  if object.num <> 0 then
X  begin
X    writev(s,name`5Bna_obj`5D.id`5Bobject.num`5D:20,show_condition(object.co
Vndition):15);
X    wr(s);
X    if eqp then wl(' `5B'+equipment`5Bobj.wear`5D+'`5D')
X    else wl;
X  end;
Xend;
X
Xfunction lookup_obj_parm(effect_type:integer; var mag:integer):boolean;
Xvar
X  i:integer := 1;
X  found:boolean := false;
Xbegin
X  lookup_obj_parm := false;
X  while (i < maxparm) and (not found) do
X  if obj.parm`5Bi`5D = effect_type then
X  begin
X    mag := obj.mag`5Bi`5D;
X    lookup_obj_parm := true;
X    found := true;
X  end
X  else i := i + 1;
Xend;
X
X`5Basynchronous`5D
Xprocedure change_stats(on:boolean := true);
Xvar
X  m,i:integer;
Xbegin
X  if on then m := 1
X  else m := -1;
X  for i := 1 to maxparm do
X  case obj.parm`5Bi`5D of
X1..10  :change_stat(obj.parm`5Bi`5D,pl`5Bnow`5D.attrib_max`5Bobj.parm`5Bi`5D
V`5D+obj.mag`5Bi`5D*m,
X        true);
X11..20 :pl`5Bnow`5D.proficiency`5Bobj.parm`5Bi`5D-10`5D :=`20
X`09pl`5Bnow`5D.proficiency`5Bobj.parm`5Bi`5D-10`5D + obj.mag`5Bi`5D*m;
X23..42 :if odd(obj.parm`5Bi`5D) then plr`5Bnow`5D.armor`5B(obj.parm`5Bi`5D-2
V1) div 2`5D.chance
X`09:= plr`5Bnow`5D.armor`5B(obj.parm`5Bi`5D-21) div 2`5D.chance + obj.mag`5B
Vi`5D*m
X        else plr`5Bnow`5D.armor`5B(obj.parm`5Bi`5D-22) div 2`5D.magnitude :=
X`09plr`5Bnow`5D.armor`5B(obj.parm`5Bi`5D-22) div 2`5D.magnitude + obj.mag`5B
Vi`5D*m;
X  end;
X  if obj.wear = ow_sword then
X  if m  = 1 then
X  begin
X    plr`5Bnow`5D.weapon_name := name`5Bna_obj`5D.id`5Bobj.valid`5D;
X    plr`5Bnow`5D.weapon := obj.spell;
X    if not human then
X    begin
X      getspell(obj.spell);
X      freespell;
X      plr`5Bnow`5D.range := (pl`5Bnow`5D.proficiency`5Bspell.element`5D * sp
Vell.parm`5B4`5D) div
X      100;
X    end;
X  end
X  else plr`5Bnow`5D.weapon := 0;
Xend;
X
X`5Basynchronous`5D
Xprocedure equip_prime(slot:integer; save,echo:boolean := true);
Xbegin
X  read_object(pl`5Bnow`5D.equipment`5Bslot`5D.num);
X  if obj.wear = 0 then wl('That object is not equippable.',echo)
X  else if pl`5Bnow`5D.attrib`5Bat_size`5D < obj_effect(ef_smallest) then
X`09wl('Your puny flabber body is too weak to use that object.',echo)
X  else if pl`5Bnow`5D.attrib`5Bat_size`5D > obj_effect(ef_largest) then
X`09wl('You are too magnificently pumped to use that object.',echo)
X  else
X  begin
X    plr`5Bnow`5D.wear`5Bobj.wear`5D := slot;
X    pl`5Bnow`5D.equipped`5Bslot`5D := true;
X    change_stats;
X    if save then save_player;
X    wl('You have equipped '+object_name(pl`5Bnow`5D.equipment`5Bslot`5D.num)
V+'.',echo);
X    act_out(plr`5Bnow`5D.log,e_msg,pl`5Bnow`5D.where.x,pl`5Bnow`5D.where.y,s
Vnd_normal,,,,
X    name`5Bna_player`5D.id`5Bplr`5Bnow`5D.log`5D+' has equipped '+
X    object_name(pl`5Bnow`5D.equipment`5Bslot`5D.num)+'.');
X    if inventory_window then show_inventory(plr`5Bnow`5D.log,false);
X  end;
Xend;
X
X`5Basynchronous`5D
Xprocedure unequip_prime(slot:integer := 0; save,echo:boolean := true);
Xbegin
X  if slot <> 0 then
X  begin
X    read_object(pl`5Bnow`5D.equipment`5Bslot`5D.num);
X    plr`5Bnow`5D.wear`5Bobj.wear`5D := 0;
X    pl`5Bnow`5D.equipped`5Bslot`5D := false;
X    change_stats(false);
X    if save then save_player;
X    wl('You have unequipped the '+name`5Bna_obj`5D.id`5Bobj.valid`5D+'.',ech
Vo);
X    if inventory_window then show_inventory(plr`5Bnow`5D.log,false);
X  end;
Xend;
X
Xprocedure do_unequip;
Xvar
X  slot:integer;
Xbegin
X  if get_inv_slot(,slot) then unequip_prime(slot);
Xend;
X
Xprocedure do_equip(slot:integer := 0);
X
X  procedure do_equip_prime;
X  begin
X    read_object(pl`5Bnow`5D.equipment`5Bslot`5D.num);
X    if obj.wear <> 0 then
X    begin
X      if plr`5Bnow`5D.wear`5Bobj.wear`5D > 0 then
X`09unequip_prime(plr`5Bnow`5D.wear`5Bobj.wear`5D);
X      equip_prime(slot);
X    end
X    else wl('You cannot equip that object.');
X  end;
X
Xbegin
X  if slot <> 0 then do_equip_prime
X  else if human then
X  if get_inv_slot(,slot) then do_equip_prime;
Xend;
X
X`5Bglobal,asynchronous`5D
Xprocedure equip_stats(save:boolean := true);
Xvar
X  slot:integer;
Xbegin
X  for slot := 1 to maxhold do
X  if (pl`5Bnow`5D.equipment`5Bslot`5D.num <> 0) then
X  begin
X    read_object(pl`5Bnow`5D.equipment`5Bslot`5D.num);
X    change_stat(at_mv_delay,pl`5Bnow`5D.attrib`5Bat_mv_delay`5D + obj.weight
V,true);
X    change_stat(at_mv_delay,pl`5Bnow`5D.attrib`5Bat_mv_delay`5D + obj.weight
V,false);
X    if pl`5Bnow`5D.equipped`5Bslot`5D then
X    begin
X      plr`5Bnow`5D.wear`5Bobj.wear`5D := slot;
X      change_stats;
X    end;
X  end;
Xend;
X
X`5Bglobal,asynchronous`5D
Xprocedure unequip_stats(save:boolean := true);
Xvar
X  slot:integer;
Xbegin
X  for slot := 1 to maxhold do
X  if pl`5Bnow`5D.equipment`5Bslot`5D.num <> 0 then
X  begin
X    read_object(pl`5Bnow`5D.equipment`5Bslot`5D.num);
X    change_stat(at_mv_delay,pl`5Bnow`5D.attrib`5Bat_mv_delay`5D - obj.weight
V,true);
X    change_stat(at_mv_delay,pl`5Bnow`5D.attrib`5Bat_mv_delay`5D - obj.weight
V,false);
X    if pl`5Bnow`5D.equipped`5Bslot`5D then
X    begin
X      plr`5Bnow`5D.wear`5Bobj.wear`5D := slot;
X      change_stats(false);
X    end;
X  end;
Xend;
X
X`5Basynchronous`5D
Xfunction find_object_layer(lookingfor:integer; var fg_slot:integer):boolean;
Xvar
X  i:integer;
X  found:boolean := false;
Xbegin
X  fg_slot := 0;
X  for i := 1 to obj_layers do
X  if (obj_map`5Bpl`5Bnow`5D.where.x,pl`5Bnow`5D.where.y,i`5D = lookingfor) a
Vnd (not found) then
X  begin
X    fg_slot := i;
X    found := true;
X  end;
X  find_object_layer := found;
Xend;
X
X`5Basynchronous`5D
Xfunction find_object_slot(lookingfor:integer; var obj_slot:integer):boolean;
Xvar
X  i:integer := 1;
X  found:boolean := false;
Xbegin
X  obj_slot := 0;
X  while (i <= maxobjs) and (not found) do
X  if fg.object`5Bi`5D.object.num = lookingfor then
X  begin
X    obj_slot := i;
X    found := true;
X  end
X  else i := i + 1;
X  find_object_slot := found;
Xend;
X
X`5Basynchronous`5D
Xfunction place_object(theobj:uniqueobj; x,y,obj_base:integer):integer;
Xvar
X  obj_slot,fg_slot:integer;
Xbegin
X  if find_object_layer(0,fg_slot) then
X  if find_object_slot(0,obj_slot) then
X  begin
X    place_object := obj_slot;
X    if theobj.num > 0 then read_object(theobj.num)
X    else
X    begin
X      obj.size := 1;
X      obj.icon := '$';
X      obj.rendition := 0;
X    end;
X    getfg(pl`5Bnow`5D.where.r);
X    with fg.object`5Bobj_slot`5D do
X    begin
X      base := obj_base;
X      altitude := obj.size;
X      object := theobj;
X      loc.x := x;
X      loc.y := y;
X      icon := obj.icon;
X      rendition := obj.rendition;
X    end;
X    putfg;
X    act_out(plr`5Bnow`5D.log,e_place,x,y,obj_slot,theobj.num,
X    compress(obj_base,obj.size),
X    compress(theobj.condition,obj.rendition),obj.icon);
X    map_objects(obj_slot);
X    fix_scenery(x,y);
X  end
X  else place_object := 0;
Xend;
X
X`5Basynchronous`5D
Xprocedure drop_object(slot:integer; echo:boolean := true);
Xbegin
X  if pl`5Bnow`5D.equipped`5Bslot`5D then unequip_prime(slot,false,echo);
X  pl`5Bnow`5D.equipment`5Bslot`5D.num := 0;
X  pl`5Bnow`5D.equipped`5Bslot`5D := false;
X  change_stat(at_mv_delay,pl`5Bnow`5D.attrib`5Bat_mv_delay`5D - obj.weight,t
Vrue);
X  change_stat(at_mv_delay,pl`5Bnow`5D.attrib`5Bat_mv_delay`5D - obj.weight,f
Valse);
X  save_player;
Xend;
X
X`5Basynchronous,global`5D
Xprocedure scatter_objects;
Xvar
X  fg_slot,i,x,y,obj_slot:integer;
Xbegin
X  for i := 1 to maxhold do
X  if pl`5Bnow`5D.equipment`5Bi`5D.num <> 0 then
X  begin
X    repeat
X      repeat
X`09x := -3 + rnum(6) + pl`5Bnow`5D.where.x;
X`09y := -3 + rnum(6) + pl`5Bnow`5D.where.y;
X      until (x in `5B1..here.size.x`5D) and (y in `5B1..here.size.y`5D);
X      if (not foreground_found(x,y,0,100,fg_normal,fg_slot)) and
X`09 (not block_background(here.background`5Bx,y`5D)) then
X      obj_slot := place_object(pl`5Bnow`5D.equipment`5Bi`5D,x,y,
X      pl`5Bnow`5D.attrib_ex`5Bst_base`5D)
X      else obj_slot := 0;
X    until obj_slot <> 0;
X    drop_object(i,false);
X  end;
Xend;
X
X`5Basynchronous,global`5D
Xprocedure drop_gold(quantity:integer; echo:boolean);
Xvar
X  a_obj:uniqueobj;
X  obj_slot:integer;
Xbegin
X  if quantity <> 0 then
X  begin
X    a_obj.condition := quantity;
X    a_obj.num := -1;
X    obj_slot := place_object(a_obj,pl`5Bnow`5D.where.x,pl`5Bnow`5D.where.y,
X    pl`5Bnow`5D.attrib_ex`5Bst_base`5D);
X    if obj_slot > 0 then
X    begin
X      change_stat(at_wealth,pl`5Bnow`5D.attrib`5Bat_wealth`5D - a_obj.condit
Vion);
X      if echo then save_player;
X      act_out(plr`5Bnow`5D.log,e_msg,pl`5Bnow`5D.where.x,pl`5Bnow`5D.where.y
V,,,
X      snd_normal,,name`5Bna_player`5D.id`5Bplr`5Bnow`5D.log`5D+' drops some
V gold to the ground.');
X    end;
X    wl('Welcome to the poor house.',echo);
X  end
X  else wl('A penny saved is a penny earned.',echo);
Xend;
X
Xprocedure do_drop(echo:boolean := true);
Xvar
X  n,obj_slot,fg_slot,slot:integer;
X  s:string;
X  ok:boolean := true;
Xbegin
X  if get_inv_slot(,slot) then
X  if slot = 0 then
X  begin
X    grab_num('Gold to drop: ',n,0,pl`5Bnow`5D.attrib`5Bat_wealth`5D);
X    drop_gold(n,true);
X  end
X  else
X  begin
X    if foreground_found(pl`5Bnow`5D.where.x,pl`5Bnow`5D.where.y,
X    pl`5Bnow`5D.attrib_ex`5Bst_base`5D,pl`5Bnow`5D.attrib`5Bat_size`5D,fg_sh
Vop,fg_slot) then
X    ok := (fg.effect`5Bfg_slot`5D.fparm1 = 0) or checkprivs(4);
X    if ok then
X    begin
X      obj_slot := place_object(pl`5Bnow`5D.equipment`5Bslot`5D,pl`5Bnow`5D.w
Vhere.x,pl`5Bnow`5D.where.y,pl`5Bnow`5D.attrib_ex`5Bst_base`5D);
X      if obj_slot > 0 then
X      begin
X        if foreground_found(pl`5Bnow`5D.where.x,pl`5Bnow`5D.where.y,pl`5Bnow
V`5D.attrib_ex`5Bst_base`5D,pl`5Bnow`5D.attrib`5Bat_size`5D,
X`09`09`09  fg_shop,fg_slot) then
X`09begin
X`09  writev(s,'Sold for ',obj.worth:0,'.');
X`09  wl(s,echo);
X`09  change_stat(at_wealth,pl`5Bnow`5D.attrib`5Bat_wealth`5D + obj.worth);
X`09  save_player;
X`09end;
X`09if inventory_window then remove_x(x_object(slot),true);
X`09act_out(plr`5Bnow`5D.log,e_drop,pl`5Bnow`5D.where.x,pl`5Bnow`5D.where.y,
X`09pl`5Bnow`5D.equipment`5Bslot`5D.num,obj_slot,normal,
X`09,name`5Bna_obj`5D.id`5Bpl`5Bnow`5D.equipment`5Bslot`5D.num`5D);
X`09wl('You have dropped the '+name`5Bna_obj`5D.id`5Bpl`5Bnow`5D.equipment`5B
Vslot`5D.num`5D);
X`09drop_object(slot);
X      end
+-+-+-+-+-+-+-+-  END  OF PART 5 +-+-+-+-+-+-+-+-