1
name
"Generic Located, Described Object"
/
aliases
'()
/
description
"You see nothing special."
/
location
#7
/
x-coordinate
;; the user is, of course, free to use these as
;; polar values.
1
/
y-coordinate
1
/
init
(method () (if (not (read-ok? caller)) (raise E_PERM)
	      (begin (set home player)
		     (set owners (tolist player))
	             (go-home))))
/
go-home
(method () (if (or (write-ok? caller)
                   (= caller location)
                   (= player (location:get-owner)))
              (begin
	        (location:announce (+ name " goes home.\n"))
	        (move-to home)
                (home:announce (+ name " has arrived.\n")))
	      (raise E_PERM
                 (+ (tostr caller) " cannot force " (tostr this) " to move"))))
/
tell
;; default behavior is to ignore things you are told
(method (instring) 0)
/
destroy
(method () (begin
		(location:announce (+ name " disappears\n"))
		(location:remove this)
		(pass)))
/
get-name
(method () name)
/
set-name
(method (newname)
	(if (write-ok? caller)
	    (set name newname)
	    (raise E_PERM "cannot write to this object")))
/
set-description
(method (newdesc)
    (if (write-ok? caller)
       (set description newdesc)
       (raise E_PERM "cannot write to this object")))
/
get-location
(method () location)
/
get-description
(method () description)
/
contained-by?
(method (container) (or (= container location)
                        (contained-by? (container:get-location))))
/
full-name-match
(method (instring)
    (if	(or (= name instring)
	    (= (tostr this) instring)
	    (and (= player this) (= instring "me"))
	    (and (= (player:get-location) this) (= instring "here"))
	    (foreach (nm aliases)
	        (if (= nm instring) (return this))))
       this))
/
partial-name-match
(method (instring)
  (var loc
     (if (and (set loc (search instring name))
              (or (= loc 1)
                  (= " " (range (- loc 1) (- loc 1) name))))
        this)))     
/
name-match
(method (instring)
  (or (full-name-match instring)
      (if (partial-name-match instring)
         (begin
	    (foreach (c (location:get-contents))
               (if (c:full-name-match instring) (return '())))
            this))))
/
alias-list
(method ()
    (if (= (player:get-location) this)
       (cons "here" (cons name aliases))
       (if (= player this)
          (cons "me" (cons name aliases))
          (cons name aliases))))
/
add-alias
(method (new-alias)
   (if (write-ok? caller)
      (if (= (typeof new-alias) 'STRING)
         (set aliases ($utils:set-add new-alias aliases))
         (player:tell "Aliases must be STRING to be added\n"))
      (raise E_PERM "cannot write to this object")))
/
rm-alias
(method (old-alias)
  (if (write-ok? caller)
    (if (= (typeof old-alias) 'STRING)
      (if (search old-alias aliases)
        (begin (set aliases ($utils:set-remove old-alias aliases))
               old-alias)))
    (raise E_PERM "cannot write to this object")))
/
move-to
;; used to move an object from one location to another.
;; either returns the object number of the destination or a false value.
(method (dest)
      (ignore E_VAR_NOT_FOUND
	(if (dest:accept-move)
	   (if (not (= location dest))
  	     (begin (location:remove this)
		    (set location dest)))
           '())))
/
std-match
(method (mname)
  (set mname ($utils:strip-spaces mname)
    (or (and (reg-split "^#[0-9]+$" mname)
             (compile mname))
        (name-match mname)
	(location:match-content mname)
        (location:name-match mname)
        (foreach (conick core-nicks)
          (if (= conick mname)
             (return (toobj (- (search conick core-nicks) 1)))))
	($system:find-player mname))))
/
try-command
;; allows objects to try to do some command on this
(method (instring)
	(foreach (i (matchcmd instring))
	   (if ((car i) (index 2 i)) (return 1))))
/
look-at
(method ()
    (player:tell-line (get-description)))
/
/
/+++++++++ end of object #2 ... no lines after this ++++++++++