"tkMOO-light is Copyright (c) Andrew Wilson 1994,1995,1996,1997,1998,1999
"
"	All Rights Reserved
"
"Permission is hereby granted to use this software for private, academic
"and non-commercial use. No commercial or profitable use of this
"software may be made without the prior permission of the author.
"
"THIS SOFTWARE IS PROVIDED BY ANDREW WILSON ``AS IS'' AND ANY
"EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
"THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
"PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL ANDREW WILSON BE LIABLE
"FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
"CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
"OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
"BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
"WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
"OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
"EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
@create $thing named Generic Desktop Manager (gd):Generic Desktop Manager (gd),gd
@prop gd."hashes" {} r
@prop gd."times" {} r
@prop gd."clock" 0 r
@prop gd."update" 10 r
@prop gd."user" #-1 r
@prop gd."dispenser" #<not used> r
@prop gd."generic_desktop" #<this object> r
@prop gd."whiteboard" #<generic whiteboard> r
@prop gd."windowed_objects" {} r
@prop gd."items" {} r
@prop gd."synthesise_callbacks" 1 rc
@prop gd."driver" #<XMCP/1.1 driver> rc
;gd.("description") = "Generic Desktop Manager informs the client of interesting state changes in objects that are 'on' the desktop, and takes the place of an active event system.  Helps to keep opened windows up to date client-side.  There isn't *meant* to be a VR interface to this object, but it carries a few useful admin verbs that I can use when the client itself is br0ken."

@verb gd:"hash" this none this
@program gd:hash
":hash( <object> ) => HASH_VALUE";
"  a change in the hash value indicates some notable state in the object has been modified and the client should be informed.";
object = args[1];
return {object.name, $list_utils:sort(object.contents), object.location, parent(object)};
.

@verb gd:"watch" this none this
@program gd:watch
":watch( <object> )";
"  keep an eye on this object";
object = args[1];
if (caller != this)
  return E_PERM;
endif
object = toobj(object);
cu = $command_utils;
this:itemise(object);
this.windowed_objects = setadd(this.windowed_objects, object);
if (!this.clock)
  fork tick (0)
    this.clock = tick;
    while (1)
      if (!(player in connected_players()))
        this:_tidy();
      endif
      suspend(this.update);
      now = time();
      foo = {};
      for item in (this.items)
        cu:suspend_if_needed(0);
        if (this:has_changed(item))
          this:update_hash(item);
          if (item in this.windowed_objects)
            foo = setadd(foo, item);
          endif
          if (item.location in this.windowed_objects)
            foo = setadd(foo, item.location);
          endif
        endif
        if (!this:object_visible(dobj))
          this:unitemise(dobj);
        endif
      endfor
      for item in (foo)
        this:notify_regardless(item);
      endfor
    endwhile
  endfork
endif
.

@verb gd:"tidy" this none none
@program gd:tidy
if (!this:can_be_used_by(player))
  player:tell(E_PERM);
  return E_PERM;
endif
this:_tidy();
.

@verb gd:"put" any on this
@program gd:put
if (!this:can_be_used_by(player))
  player:tell(E_PERM);
  return E_PERM;
endif
dobj = player:my_match_object(dobjstr);
if (!$command_utils:object_match_failed(dobj, dobjstr))
  this:watch(dobj);
  this:notify_regardless(dobj);
endif
.

@verb gd:"client_update" this none this
@program gd:client_update
what = args[1];
if (caller != this)
  return E_PERM;
endif
su = $string_utils;
ou = $object_utils;
lu = $list_utils;
contents = what:contents();
name = what.name;
type = "object";
if (ou:isa(what, $player))
  type = "player";
endif
if (ou:isa(what, $container))
  type = "folder";
endif
if (ou:isa(what, $room))
  type = "room";
endif
kv = {};
kv = {@kv, {"object", tostr(what)}};
kv = {@kv, {"type", type}};
kv = {@kv, {"name", name}};
kv = {@kv, {"location", tostr(what.location)}};
kv = {@kv, {"parent", tostr(parent(what))}};
if ($object_utils:has_property(player, "window") && player.window)
  kv = {@kv, {"window", tostr(player.window)}};
endif
lines = {};
"hack to allow container to be in first icon position";
container = valid(what.location) ? {what.location} | {};
"...presently disabled";
"container = {};";
if (0 && container)
  item = container[1];
  name = item.name;
  location = item.location;
  parent = parent(item);
  extra = " ";
  line = tostr(item, " ", location, " ", parent, " ", "folder", " \"", "IN: " + name, "\"");
  line = line + extra;
  lines = {@lines, line};
endif
time = time();
for item in (contents)
  item = toobj(item);
  "add the item to the list of objects we know about...";
  this:itemise(item);
  events = "";
  type = "object";
  "events are optional.  The form '<event>: -' is equivalent to not";
  "mentioning the event at all!  Here for back-compatibility";
  "It could change to meaning explicitly ignore this event if sent";
  "rather than applying any client-side heuristic to determine a";
  "suitable event";
  if (ou:isa(item, $note))
    type = "note";
    events = " 1: \"read this\" 3: \"@edit this\"";
  endif
  if (ou:isa(item, $container))
    type = "folder";
    events = " 1: \"put this on desk\" drop: \"put that in this\"";
  endif
  if (ou:isa(item, $player))
    type = "player";
    events = " 1: \"put this on desk\"";
  endif
  if (ou:isa(item, $room))
    type = "room";
  endif
  if (ou:isa(item, $exit))
    type = "exit";
  endif
  if (ou:isa(item, this.whiteboard))
    type = "whiteboard";
    events = " 1: \"watch this\" 3: \"ignore this\"";
  endif
  if (this.synthesise_callbacks == 0)
    if (has = ou:has_callable_verb(item, "desktop_event_callback"))
      aevents = has[1]:desktop_event_callback();
      events = "";
      for e in (aevents)
        events = (events + (((" " + e[1]) + ": \"") + e[2])) + "\"";
      endfor
    endif
  endif
  name = item.name;
  location = item.location;
  parent = parent(item);
  line = tostr("object: ", item, " location: ", location, " parent: ", parent, " type: ", type, " name: ", $string_utils:print(name));
  line = line + events;
  lines = {@lines, line};
endfor
if (valid(this.driver))
  this.driver:client_notify(player, "desktop", kv, lines);
else
  "use MCP";
  this:client_notify(player, "desktop", kv, lines);
endif
.

@verb gd:"notify_if_changed" this none this
@program gd:notify_if_changed
":notify_if_changed( <object > )";
"  if this object is on the Desktop then check to see if the client needs to be notified about a state change, otherwise don't do anything.";
object = args[1];
if (caller != this)
  return E_PERM;
endif
foo = {};
if (this:has_changed(object))
  this:update_hash(object);
  if (object in this.windowed_objects)
    foo = setadd(foo, object);
  endif
  if (object.location in this.windowed_objects)
    foo = setremove(foo, object);
    foo = setadd(foo, object.location);
  endif
endif
for item in (foo)
  this:notify_regardless(item);
endfor
.

@verb gd:"check" any on this
@program gd:check
if (!this:can_be_used_by(player))
  player:tell(E_PERM);
  return E_PERM;
endif
foo = {};
items = $string_utils:explode(dobjstr, " ");
for item in (items)
  dobj = player:my_match_object(item);
  if (!$command_utils:object_match_failed(dobj, item))
    if (this:has_changed(dobj))
      this:update_hash(dobj);
      if (dobj in this.windowed_objects)
        foo = setadd(foo, dobj);
      endif
      if (valid(dobj.location) && (dobj.location in this.windowed_objects))
        foo = setadd(foo, dobj.location);
      endif
    endif
    if (!this:object_visible(dobj))
      this:unitemise(dobj);
    endif
  endif
endfor
for item in (foo)
  this:notify_regardless(item);
endfor
.

@verb gd:"_tidy" this none this rx
@program gd:_tidy
"if (!this:can_be_used_by(player))";
"  player:tell(E_PERM)";
"  return E_PERM";
"endif";
for object in (this.windowed_objects)
  this:_remove(object);
endfor
this.times = {};
this.windowed_objects = {};
this.items = {};
this.hashes = {};
if (this.clock)
  kill_task(this.clock);
endif
this.clock = 0;
.

@verb gd:"notify_regardless" this none this
@program gd:notify_regardless
":notify_regardless( <object > )";
"  if this object is on the Desktop then notify the client.";
object = args[1];
if (caller != this)
  return E_PERM;
endif
if (psn = object in this.items)
  this:update_hash(object);
  this:client_update(object);
endif
.

@verb gd:"remove" any from this
@program gd:remove
if (!this:can_be_used_by(player))
  player:tell(E_PERM);
  return E_PERM;
endif
dobj = player:my_match_object(dobjstr);
if (!$command_utils:object_match_failed(dobj, dobjstr))
  this:_remove(dobj);
  if (!this.windowed_objects)
    this:_tidy();
  endif
endif
.

@verb gd:"look_self" this none this
@program gd:look_self
pass(@args);
if (this.windowed_objects)
  tmp = {};
  for object in (this.windowed_objects)
    tmp = {@tmp, ((object.name + " (") + tostr(object)) + ")"};
  endfor
  isare = (length(tmp) > 1) ? " are" | " is";
  player:tell($string_utils:english_list(tmp), isare, " on ", this.name);
else
  player:tell(this.name, " is empty.");
endif
.

@verb gd:"can_be_used_by" this none this
@program gd:can_be_used_by
who = args[1];
"Own it or pick it up";
if ($perm_utils:controls(who, this) || (who == this.location))
  return 1;
endif
return 0;
.

@verb gd:"_remove" this none this
@program gd:_remove
if (caller != this)
  return E_PERM;
endif
object = args[1];
object = toobj(object);
if (psn = object in this.items)
  this.windowed_objects = setremove(this.windowed_objects, object);
  this:unitemise(object);
  if (valid(this.driver))
    this.driver:client_notify(player, "desktop-remove", {{"object", tostr(object)}});
  else
    "use MCP";
    player:client_notify("desktop-remove", {{"object", tostr(object)}});
  endif
  "remove all objects no longer visible...";
  items = this.items;
  for i in (items)
    if (!this:object_visible(i))
      this:unitemise(i);
    endif
  endfor
endif
.

@verb gd:"moveto" this none this
@program gd:moveto
"If someone drops this desk then reset it";
"this is crude cuz it'll _tidy() if you move the desk into another object under your control or in your contents, or contents thereof";
this:_tidy();
return pass(@args);
.

@verb gd:"set_user" this none this
@program gd:set_user
if ((caller_perms() == this.generic_desktop.owner) || (caller == this.dispenser))
  this.user = args[1];
  this:moveto(args[1]);
  this:set_names();
  this.unique = 1;
endif
.

@verb gd:"set_names" this none this
@program gd:set_names
"Copied from nametag (#697):set_names by Ken (#897) Tue Apr 19 15:50:13 1994 EDT";
"set_names()";
"abbreviation for set_name() and set_aliases()";
"return this:set_name() && this:set_aliases();";
name = strsub(parent(this).name, "generic ", "");
return this:set_name(name);
"Copied from generic radio (#587):set_names by Networker (#266) Mon Nov 27 13:40:31 1995 CST";
.

@verb gd:"client_notify" this none this rxd #2
@program gd:client_notify
":client_notify(player, method, keyval-alist[, lines-of-text])";
pl = args[1];
me = args[2];
if (player != pl)
  return E_PERM;
endif
if (caller != this)
  return E_PERM;
endif
methods = {"desktop", "desktop-remove", "examine*", "display-url", "edit*"};
if (!(me in methods))
  return E_INVARG;
endif
return pl:client_notify(me, @args[3..length(args)]);
.

@verb gd:"has_changed" this none this
@program gd:has_changed
":has_changed( <object> ) => 0 | 1";
"  if the object's current hashable state is different to the recorded hash then things they are a changin'";
object = args[1];
object = toobj(object);
if (psn = object in this.items)
  hash = this.hashes[psn];
  newhash = this:hash(object);
  if (newhash != hash)
    return 1;
  else
    return 0;
  endif
endif
return 1;
.

@verb gd:"update_hash" this none this
@program gd:update_hash
item = args[1];
item = toobj(item);
if (psn = item in this.items)
  this.hashes[psn] = this:hash(item);
  this.times[psn] = time();
endif
.

@verb gd:"object_visible" this none this
@program gd:object_visible
item = args[1];
item = toobj(item);
if ((item in this.windowed_objects) || (valid(item.location) && (item.location in this.windowed_objects)))
  return 1;
endif
return 0;
.

@verb gd:"itemise" this none this
@program gd:itemise
":itemise(<object>)";
"  add this object to the list of items we're watching...";
object = args[1];
object = toobj(object);
if (psn = object in this.items)
  this.hashes[psn] = this:hash(object);
  this.times[psn] = time();
else
  this.items = {@this.items, object};
  this.hashes = {@this.hashes, this:hash(object)};
  this.times = {@this.times, time()};
endif
.

@verb gd:"unitemise" this none this
@program gd:unitemise
object = args[1];
object = toobj(object);
if (psn = object in this.items)
  this.items = listdelete(this.items, psn);
  this.hashes = listdelete(this.hashes, psn);
  this.times = listdelete(this.times, psn);
endif
.

"***finished***