1 8
admins
'(#13)
/
players
'(#13)
/
guests
'()
/
init
0
/
destroy
0
/
boot
;; this method is called at every restart of the server ... just once.
(method ()
	(if (private-ok? caller)
	    (begin
	      (set connected '())
	      (foreach (i guests) (i:destroy))
              (if (not (#13:is-password-set?))
                 (#13:set-password "trauma"))
	      (set guests '()))
	    (raise E_PERM "only #0 can call 'boot'")))
/
list-admins
(method () admins)
/
add-admin
(method (new-wiz)
  (if (not (write-ok? caller))
     (raise E_PERM "only administrators can call add-admin")
     (begin (setparents new-wiz (tolist $admin))
        (set admins ($utils:set-add new-wiz admins)))))
/
remove-admin
(method (ex-wiz)
   (if (not (write-ok? caller))
      (raise E_PERM "only administrators can call remove-admin")
      (begin (setparents ex-wiz (tolist $coder))
          (set admins ($utils:set-remove ex-wiz admins)))))
/
intersize
(method ()
   (+ "Interlude code is now " (before "\n" (run-script "intersize"))
      " lines\n"))
/
create-guest
(method () (var i
	      (begin (set i ($guest:copy))
	             (set guests ($utils:set-add i guests))
		     i)))
/
remove-guest
(method () (set guests ($utils:set-remove caller guests)))
/
remove-player
(method () (set players ($utils:set-remove caller players)))
/
connect
;; whenever a socket hits the MU*, this gets called and the socket connects
;; to #0.  this has to figure out where to reconnect it to.
(method () (var i
	       (begin (set i (create-guest))
		      (set connected ($utils:set-add i connected))
	              (reconnect #0 i)
                      (i:welcome))))
/
reconnect-me
;; reconnects the caller to the object in the first parameter.
(method (to-obj pass-string)
	(if (to-obj:accept-connect caller pass-string)
	   (begin
	     (reconnect caller to-obj)
	     (to-obj:welcome))
	   (raise E_PERM
              (+ "object " (tostr to-obj)
                 " rejects a connection from " (tostr caller)))))
/
remove-connection
(method () (set connected ($utils:set-remove caller connected)))
/
list-connected
(method () connected)
/
log-message
(method (msg)
  (if (write-ok? caller)
    (log msg)))
/
call-me-out
(method (addr)
  (if (not (search caller connected))
    (connect-out caller addr)))
/
parse
;; sometimes output gets sent before the server has reconnected to a
;; guest... the danger of multi-threading.
(method (unused) (echo "Sorry ... waiting for reconnect.\n"))
/
list-players
(method () players)
/
find-player
(method (instring)
	  (or (foreach (p players)
	         (if (p:name-match instring) (return p)))
              (foreach (p guests)
		 (if (p:name-match instring) (return p)))))
/
find-connected-player
(method (instring)
   (foreach (c connected)
     (if (p:name-match instring) (return p))))
/
guest-to-player
(method (pname ppass)
  (if (caller:has-parent? $guest)
    (if (find-player pname)
      (player:tell (+ "Sorry, the name " pname " is already in use.\n"))
      (begin
	(player:tell (+ "Creating player " pname " with password " ppass "\n"))
	(set guests ($utils:set-remove caller guests))
	(set players ($utils:set-add caller players))
	(setparents caller (tolist $builder))
	(caller:set-password ppass)
	(call (caller:get-location) announce
	  (+ (caller:get-name) " creates a new player: " pname "\n"))
	(caller:set-name pname)
	(player:tell "Creation successful.\n")
        (player:welcome)))
      (player:tell "Sorry, only a guest can create a new player.\n")))
/
recycle-this
;; when an object wants to delete itself, it should call ($system:recycle-this)
(method () (begin
	      (setparents caller (tolist $recycler))
	      ($recycler:add-recycled caller)
	      (caller:~wipe-clean)))
/
force-recycle
;; kind of the hammer of god destroying offending objects.
(method (obj)
   (if (write-ok? player)
       (begin
          (setparents obj (tolist $recycler))
          ($recycler:add-recycled obj)
          (obj:~wipe-clean))))
/
addparent
(method (new-p) (if (new-p : accept-child caller)
	          (setparents caller (cons new-p (caller:list-parents)))
	          (raise E_PERM
                     (+ (tostr new-p) " doesn't accept child "
                        (tostr caller)))))
/
rmparent
(method (new-p) (setparents caller
	           ($utils : set-remove new-p (caller:list-parents))))
/
set-parents
(method (obj new-p)
   (if (and (obj:write-ok? caller) (new-p:read-ok? caller))
      (setparents obj (tolist new-p))
      (raise E_PERM
         (+ "cannot parent " (tostr obj) " to " (tostr new-p)))))
/
force-shutdown
(method ()
    (if (write-ok? caller)
       (shutdown)))
/
connect-me-to
(method (to passwd)
   (if (to:accept-connection caller passwd)
     (begin	
       (reconnect caller to)
       (set connected ($utils:set-add to ($utils:set-remove caller connected)))
       (to:welcome))
     (begin
       (player:tell (+ (to:get-name) " didn't accept connection.\n"))
       0)))
/
/
/+++++++++ end of object #0 ... no lines after this ++++++++++