"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 Whiteboard (gw):Generic Whiteboard (gw),gw
@prop gw."watchers" {} rc
@prop gw."scene" {} rc
@prop gw."gallery" {} rc
@prop gw."generic" #276 rc
@prop gw."driver" #275 rc
@prop gw."unique_id" 0 rc

@verb gw:"clean" this none none
@program gw:clean
this.scene = {};
this:inform_watchers("whiteboard-clean", {{"object", tostr(this)}});
.

@verb gw:"line" any on this
@program gw:line
if (!(player in this.watchers))
  player:tell("You can only draw on ", this:name(), " if you're watching it.");
  return;
endif
match = match(dobjstr, "%([a-z]*%) %(-*[0-9]*%) %(-*[0-9]*%) %(-*[0-9]*%) %(-*[0-9]*%)");
colour = dobjstr[match[3][1][1]..match[3][1][2]];
sx1 = dobjstr[match[3][2][1]..match[3][2][2]];
sy1 = dobjstr[match[3][3][1]..match[3][3][2]];
sx2 = dobjstr[match[3][4][1]..match[3][4][2]];
sy2 = dobjstr[match[3][5][1]..match[3][5][2]];
graphic = {"line", colour, sx1, sy1, sx2, sy2};
this.scene = {@this.scene, graphic};
xmcp = tostr("$#$whiteboard-line object: ", this, " colour: ", colour, " x1: ", sx1, " y1: ", sy1, " x2: ", sx2, " y2: ", sy2);
this:inform_watchers({xmcp});
.

@verb gw:"show" this none none
@program gw:show
this.driver:client_notify(player, "whiteboard-show", {{"object", tostr(this)}, {"name", this:title()}});
xmcp_scene = this:xmcp_scene();
player:tell_lines(xmcp_scene);
.

@verb gw:"watch" this none none
@program gw:watch
this.watchers = setadd(this.watchers, player);
this.driver:client_notify(player, "whiteboard-show", {{"object", tostr(this)}, {"name", this.name}});
xmcp_scene = this:xmcp_scene();
this:draw_scene(player, xmcp_scene);
player:tell("You're now watching ", this.name, ".");
.

@verb gw:"ignore" this none none
@program gw:ignore
this:_ignore(player);
player:tell("You're ignoring ", this.name, ".");
.

@verb gw:"xmcp_scene" this none this
@program gw:xmcp_scene
tmp = {};
for graphic in (this.scene)
  id = graphic[1];
  pl = graphic[2];
  type = graphic[3];
  colour = graphic[4];
  sx1 = graphic[5];
  sy1 = graphic[6];
  kv = {};
  kv = {@kv, {"object", tostr(this)}};
  kv = {@kv, {"id", tostr(id)}};
  kv = {@kv, {"colour", colour}};
  kv = {@kv, {"pen", type}};
  kv = {@kv, {"x1", tostr(sx1)}};
  kv = {@kv, {"y1", tostr(sy1)}};
  if ((type == "line") || (type == "arrow"))
    sx2 = graphic[7];
    sy2 = graphic[8];
    kv = {@kv, {"x2", tostr(sx2)}};
    kv = {@kv, {"y2", tostr(sy2)}};
  endif
  if (type == "rectangle")
    sx2 = graphic[7];
    sy2 = graphic[8];
    kv = {@kv, {"x2", tostr(sx2)}};
    kv = {@kv, {"y2", tostr(sy2)}};
  endif
  if (type == "oval")
    sx2 = graphic[7];
    sy2 = graphic[8];
    kv = {@kv, {"x2", tostr(sx2)}};
    kv = {@kv, {"y2", tostr(sy2)}};
  endif
  if (type == "text")
    text = graphic[7];
    kv = {@kv, {"text", text}};
  endif
  tmp = {@tmp, kv};
endfor
return tmp;
.

@verb gw:"inform_watchers" this none this
@program gw:inform_watchers
for person in (this.watchers)
  "possible problem :watching has the side effect of altering this.watchers";
  if (this:watching(person))
    this.driver:client_notify(person, @args);
  endif
endfor
.

@verb gw:"possessor" this none this
@program gw:possessor
if (this == this.generic)
  return 0;
endif
return this.owner;
.

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

@verb gw:"init" this none none
@program gw:init
if (!$perm_utils:controls(player, this))
  player:tell(E_PERM);
  return E_PERM;
endif
this.watchers = {};
this.scene = {};
this.unique_id = 0;
.

@verb gw:"draw" any on this rxd
@program gw:draw
if (!(player in this.watchers))
  player:tell("You can only draw on ", this:name(), " if you're watching it.");
  return;
endif
id = this:unique_id();
match = match(dobjstr, "%([a-z]*%) %([a-z]*%) %(-*[0-9]*%) %(-*[0-9]*%) %(.*%)");
col = dobjstr[match[3][1][1]..match[3][1][2]];
pen = dobjstr[match[3][2][1]..match[3][2][2]];
sx1 = dobjstr[match[3][3][1]..match[3][3][2]];
sy1 = dobjstr[match[3][4][1]..match[3][4][2]];
xtr = dobjstr[match[3][5][1]..match[3][5][2]];
if (pen == "text")
  mtext = match(xtr, "%(.*%)");
  text = xtr[mtext[3][1][1]..mtext[3][1][2]];
  graphic = {id, player, pen, col, sx1, sy1, text};
  kv = {};
  kv = {@kv, {"object", tostr(this)}};
  kv = {@kv, {"id", tostr(id)}};
  kv = {@kv, {"colour", col}};
  kv = {@kv, {"pen", pen}};
  kv = {@kv, {"x1", tostr(sx1)}};
  kv = {@kv, {"y1", tostr(sy1)}};
  kv = {@kv, {"text", text}};
  "redundant";
  xmcp = tostr("$#$whiteboard-draw object: ", this, " id: ", id, " colour: ", col, " pen: ", pen, " x1: ", sx1, " y1: ", sy1, " text: \"", text, "\"");
else
  match = match(xtr, "%(-*[0-9]*%) %(-*[0-9]*%)");
  sx2 = xtr[match[3][1][1]..match[3][1][2]];
  sy2 = xtr[match[3][2][1]..match[3][2][2]];
  graphic = {id, player, pen, col, sx1, sy1, sx2, sy2};
  kv = {};
  kv = {@kv, {"object", tostr(this)}};
  kv = {@kv, {"id", tostr(id)}};
  kv = {@kv, {"colour", col}};
  kv = {@kv, {"pen", pen}};
  kv = {@kv, {"x1", tostr(sx1)}};
  kv = {@kv, {"y1", tostr(sy1)}};
  kv = {@kv, {"x2", tostr(sx2)}};
  kv = {@kv, {"y2", tostr(sy2)}};
  "redundant";
  xmcp = tostr("$#$whiteboard-draw object: ", this, " id: ", id, " colour: ", col, " pen: ", pen, " x1: ", sx1, " y1: ", sy1, " x2: ", sx2, " y2: ", sy2);
endif
this.scene = {@this.scene, graphic};
this:inform_watchers("whiteboard-draw", kv);
.

@verb gw:"save" this as any
@program gw:save
gallery = this.gallery;
for item in (gallery)
  title = item[1];
  scene = item[2];
  if (title == iobjstr)
    player:tell("There is already a scene named '", iobjstr, "' in ", this.name, ".");
    return;
  endif
endfor
this.gallery = {@this.gallery, {iobjstr, this.scene}};
player:tell("Saving current scene in ", this.name, " with the title '", iobjstr, "'.");
.

@verb gw:"load" any in this
@program gw:load
gallery = this.gallery;
for item in (gallery)
  title = item[1];
  scene = item[2];
  if (title == dobjstr)
    player:tell("Loading saved scene named '", dobjstr, "' in ", this.name, ".");
    this.scene = scene;
    for watcher in (this.watchers)
      this.driver:client_notify(watcher, "whiteboard-show", {{"object", tostr(this)}, {"name", this:title()}});
    endfor
    xmcp_scene = this:xmcp_scene();
    for watcher in (this.watchers)
      this:draw_scene(watcher, xmcp_scene);
    endfor
    return;
  endif
endfor
player:tell("There is no scene named '", dobjstr, "' in ", this.name, ".");
.

@verb gw:"gallery" this none none
@program gw:gallery
if (!this.gallery)
  player:tell("There are no saved scenes.");
  return;
endif
player:tell("Scenes saved on ", this.name, ":");
for item in (this.gallery)
  title = item[1];
  scene = item[2];
  player:tell(title, " (", length(scene), " objects)");
endfor
player:tell("---");
.

@verb gw:"unique_id" this none this
@program gw:unique_id
":unique_id() => key";
this.unique_id = this.unique_id + 1;
return this.unique_id;
.

@verb gw:"delete" any in this
@program gw:delete
if (!(player in this.watchers))
  player:tell("You can only delete from ", this:name(), " if you're watching it.");
  return;
endif
scene = this.scene;
for graphic in (scene)
  identifier = graphic[1];
  if (tostr(identifier) == dobjstr)
    this.scene = listdelete(this.scene, graphic in scene);
    xmcp = tostr("$#$whiteboard-delete object: ", this, " id: ", identifier);
    this:inform_watchers("whiteboard-delete", {{"object", tostr(this)}, {"id", tostr(identifier)}});
    return;
  endif
endfor
return;
"possible if user presses delete several times client-side";
player:tell("Error deleting identifier '", dobjstr, "'");
.

@verb gw:"move" any on this rxd
@program gw:move
"not at all sure about this, might be better to issue a delete followed by a draw instead?";
if (!(player in this.watchers))
  player:tell("You can only move items on ", this:name(), " if you're watching it.");
  return;
endif
match = match(dobjstr, "%(.*%) %(-*[0-9]*%) %(-*[0-9]*%)");
id = dobjstr[match[3][1][1]..match[3][1][2]];
dx = dobjstr[match[3][2][1]..match[3][2][2]];
dy = dobjstr[match[3][3][1]..match[3][3][2]];
scene = this.scene;
for graphic in (scene)
  identifier = graphic[1];
  pen = graphic[3];
  if (tostr(identifier) == id)
    "modify the graphical element";
    psn = graphic in this.scene;
    if (pen == "text")
      graphic[5] = tonum(graphic[5]) + tonum(dx);
      graphic[6] = tonum(graphic[6]) + tonum(dy);
    else
      graphic[5] = tonum(graphic[5]) + tonum(dx);
      graphic[6] = tonum(graphic[6]) + tonum(dy);
      graphic[7] = tonum(graphic[7]) + tonum(dx);
      graphic[8] = tonum(graphic[8]) + tonum(dy);
    endif
    this.scene[psn] = graphic;
    "ask the client to move the element";
    xmcp = tostr("$#$whiteboard-move object: ", this, " id: ", identifier, " dx: ", dx, " dy: ", dy);
    kv = {};
    kv = {@kv, {"object", tostr(this)}};
    kv = {@kv, {"id", tostr(id)}};
    kv = {@kv, {"dx", tostr(dx)}};
    kv = {@kv, {"dy", tostr(dy)}};
    this:inform_watchers("whiteboard-move", kv);
    return;
  endif
endfor
return;
"possible if user presses delete several times client-side";
player:tell("Error moving identifier '", dobjstr, "'");
.

@verb gw:"_ignore" this none this
@program gw:_ignore
who = args[1];
if (caller != this)
  return E_PERM;
endif
while (who in this.watchers)
  this.watchers = setremove(this.watchers, who);
endwhile
.

@verb gw:"watching" this none this
@program gw:watching
"this is inefficient, since it effectively calls c_p() for each";
"line of a picture but right now I don't care";
who = args[1];
if ((who in this.watchers) && (who in connected_players()))
  return 1;
else
  this:_ignore(who);
  return 0;
endif
.

@verb gw:"remove" any from this
@program gw:remove
gallery = this.gallery;
for item in (gallery)
  title = item[1];
  scene = item[2];
  if (title == dobjstr)
    this.gallery = setremove(this.gallery, item);
    player:tell("Removed scene named '", dobjstr, "' from ", this.name, ".");
    return;
  endif
endfor
player:tell("No scene named '", dobjstr, "' in ", this.name, ".");
.

@verb gw:"draw_scene" this none this
@program gw:draw_scene
who = args[1];
glyphs = args[2];
for glyph in (glyphs)
  $command_utils:suspend_if_needed(0);
  this.driver:client_notify(who, "whiteboard-draw", glyph);
endfor
.

@verb gw:"xmcp_gallery" this none none
@program gw:xmcp_gallery
kv = {};
kv = {@kv, {"object", tostr(this)}};
items = {};
for item in (this.gallery)
  title = item[1];
  length = length(item[2]);
  line = (("name: " + $string_utils:print(title)) + " length: ") + tostr(length);
  items = {@items, line};
endfor
this.driver:client_notify(player, "whiteboard-gallery", kv, items);
.

"***finished***