public
;; whether the object is readable to all
1
/
owners
;; generally, the owner of an object is usually allowed to change it.
;; #13 is the generic wizard parent.
'( #13 )
/
~write-ok?
(method (who) (or (= who this)
	          (= who #0)
	          (search who owners)
	          (search who (#0:list-admins))))
/
write-ok?
(method (who) (~write-ok? who))
/
~read-ok?
(method (who) (or public
	         (write-ok? who)))
/
read-ok?
(method (who) (~read-ok? who))
/
private-ok?
(method (who) (= caller this))
/
publish
(method () (set public 1))
/
unpublish
(method () (set public 0))
/
public?
(method () public)
/
~wipe-clean
;; once an object is parented to the recycler, this method is used to
;; remove all vestiges of what it once was:  variables and commands.
;; notice, you can't use this method on any core object.
(method () 
  (if (~write-ok? caller)
    (if (< (tonum this) 17)
       (raise E_PERM "cannot wipe a core object clean")
       (var s
	 (begin (purge-cmds)
            (foreach (i (vars))
	      (rmvar i)))))))
/
init
(method () (if (not (or (search caller (parents)) (write-ok? caller)))
             (raise E_PERM "cannot call 'init' on that object")
	     (begin
	        (set owners (tolist player))
                this)))
/
copy
(method () (if (not (read-ok? caller))
             (raise E_PERM "cannot copy objects that you can't read")
	     (var i
	       (begin
	          (set i (or ($recycler:get-free this) (clone)))
	          (call i init)
                  i))))
/
destroy
(method () (if (write-ok? caller)
	      ($system:recycle-this)
	      (raise E_PERM "cannot destroy objects that you can't write to")))
/
add-parent
(method (new-parent) (if (write-ok? caller)
              (#0:addparent new-parent)
	      (raise E_PERM "cannot change parents on that object")))
/
add-command
(method (regex sym)
  (if (write-ok? caller)
     (addcmd regex sym)))
/
remove-command
(method (instring)
  (if (write-ok? caller)
     (rmcmd instring)))
/
accept-child
(method (child) (or (read-ok? caller)
		    (search player owners)
	            (search player (#0:admins))))
/
remove-parent
(method (the-parent) (if (or (write-ok? caller) (= caller the-parent))
	     (#0:rmparent the-parent)
	     (raise E_PERM)))
/
set-variable
;; asks 'this' to add a variable whose name is passed in as the first
;; parameter, and value in the second.
(method (sym val)  (if (not (write-ok? caller))
                      (raise E_PERM "cannot set a variable on that object")
	              (sets sym val)))
/
rm-variable
;; asks 'this' to permanently remove a variable
(method (sym) (if (not (write-ok? caller))
                 (raise E_PERM "cannot write to that object")
	         (rmvar sym)))
/
list-variables
(method () (if (not (read-ok? caller))
              (raise E_PERM "cannot read this object")
	      (vars)))
/
list-owners
(method () owners)
/
list-parents
(method () (parents))
/
list-method
(method (symname)
   (if (read-ok? player)
      (ignore E_VAR_NOT_FOUND
        (if (and (= (typeof (typeof (eval symname))) 'SYMBOL)
                 (= (typeof (eval symname)) 'ERROR))
          (+ (tostr this) " doesn't have that variable")
          (format (eval symname) 78)))
      "You don't have permission to view that."))
/
add-owner
(method (new-owner)
   (if (not (write-ok? caller))
      (raise E_PERM "cannot write to this object")
      (set owners ($utils : set-add new-owner owners))))
/
remove-owner
(method (old-owner)  (if (not (write-ok? caller))
                        (raise E_PERM "cannot write to this object")
	                (set owners ($utils : set-remove old-owner owners))))
/
dump-to-string
(method () (+ (+ "Object ID: " (tostr this) "\n")
              (+ "Parents:   " (tostr (parents)) "\n")
              (if (not (read-ok? caller))
		 "The rest of the object is not available\n"
	         (+ "Vars:      " (tostr (vars)) "\n"
                    "Commands:  " (tostr (commands)) "\n"))))
/
~show-this
(method ()
   (begin
      (player:tell (+ "Object   " (tostr this) ":\n"))
      (player:tell (+ "Parents: "
          (after "'(" (before ")" (tostr (parents)))) "\n"))
      (if (not (~read-ok? caller))
        (player:tell "The rest of the object is not available\n")
        (begin
           (player:tell "Variables:\n")
           (foreach (v (vars))
              (player:tell (+ "  " (tostr v) "\n")))
           (player:tell "Commands:\n")
           (foreach (c (commands))
	      (player:tell (+ "  \"" (tostr (index 2 c)) "\"      --> "
                              (tostr (car c)) "\n")))
           (player:tell "------ end of object ------\n")))))
/
has-parent?
(method (anc) (foreach (parent (parents))
	         (if (= parent anc) (return 1))))
/
descends-from?
;; returns whether 'this' descends from the argument given as a parent
(method (anc) (foreach (parent (parents))
		(if (or (= parent anc) (parent:descends-from? anc))
		   (return 1))))
/
E_INVALID_REGEXP
10
/
E_OVERRIDE
11
/
E_TYPE
12
/
E_INCOMPATIBLE_TYPES
13
/
E_RANGE
14
/
E_VAR_NOT_FOUND
15
/
E_TOO_MANY_ARGUMENTS
16
/
E_TOO_FEW_ARGUMENTS
17
/
E_INVALID_FUNCTION
18
/
E_DIV_BY_ZERO
19
/
E_SYSTEM_ONLY
20
/
E_INVALID_OBJECT
21
/
E_PARSE_ERROR
22
/
E_INVALID_PAIR
23
/
E_UNINITIALIZED
24
/
E_CMD_NOT_FOUND
25
/
E_NOT_CONNECTED
26
/
E_BAD_SEPARATOR
27
/
E_CANNOT_PASS
28
/
E_PERM
29
/
E_BAD_FILE
30
/
E_NO_MATCH
31
/
E_SEMAPHORE
32
/
$root
#1
/
$system
#0
/
$located
#2
/
$exit
#3
/
$thing
#4
/
$container
#5
/
$area
#6
/
$room
#7
/
$connected
#8
/
$guest
#9
/
$player
#10
/
$builder
#11
/
$coder
#12
/
$admin
#13
/
$utils
#14
/
$recycler
#15
/
$editor
#16
/
/
/+++++++++ end of object #1 ... no lines after this ++++++++++