1
numguests
0
/
connect
(method () (var onum
	      (begin
		(echo welcome-message)
		(set onum (#2:copy))
		(tell-all (+ (tostr onum) " has connected."))
		(set connected-list (set-add onum connected-list))
		(echo (+ "Connecting you to Object "
			 (tostr onum) "\n"))
		(echo "Objects currently connected:")
		(foreach (i connected-list)
			(echo (+ " " (tostr i))))
		(echo "\n")
		(echo "Have a swell time.\n")
		(reconnect #0 onum)
		(onum:tell "Successfully reconnected\n"))))
/
welcome-message
"You are now connecting to the doodle core.\n"
/
boot
(method () (set connected-list '()))
/
connected-list
'()
/
remove-connection
(method () (set connected-list (set-remove caller connected-list)))
/
tell-all
(method (instring)
	(foreach (con connected-list)
	   (con:tell (+ (tostr caller) " says, \"" instring "\"\n"))))
/
parse
(method (instring)
	(echo "Please wait while your connection is transfered.\n"))
/
shutdown-method
(method ()
	(begin
	 (tell-all (+ "Server shutdown by " (tostr caller)))
	 (set connected-list '())
	 (shutdown)))
/
pose-all
(method (instring)
	(foreach (con connected-list)
	   (con:tell (+ (tostr caller) " " instring "\n"))))
/
/
/+++++++++ Object 1:  Generic Root ++++++++

after-cut
(method (divider instring)
	(var found-at
	(begin	(set found-at (search divider instring))
		(if  (and found-at (< found-at (length instring)))
			(range 	(+ found-at 1)
				(length instring) instring)
			""))))
/
set-add
(method (elem inlist)
	(if (not (search elem inlist)) (insert elem inlist 1) inlist))
/
set-remove
(method (elem inlist)
	(var i (begin
		(set i (search elem inlist))
		(if (or (not i) (not inlist)) inlist
			(if (= 1 (length inlist)) '()
			(if (= i (length inlist))
				(range 1 (- i 1) inlist)
			(if (= i 1)
				(range 2 (length inlist) inlist)
			(+ (range 1 (- i 1) inlist)
			   (range (+ i 1) (length inlist) inlist)))))))))
				
/
copy
(method () (clone))
/
~test-priv
(method () (player:tell "testing"))
/
list-variables
(method () (vars))
/
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))))
/
dump-to-string
(method () (+ (+ "Object ID: " (tostr this) "\n")
              (+ "Parents:   " (tostr (parents)) "\n")
              (if (not (= caller this))
		 "The rest of the object is not available\n"
	         (+ "Vars:      " (tostr (vars)) "\n"
                    "Commands:  " (tostr (commands)) "\n"))))
/
tell
(method (instring) (ignore 26 (or (echo instring) "")))
/
add-variable
(method (symbol value) (addvar symbol value))
/
/
/++++++++++ Object 2:       ++++++++++++++++
0 1
parse
;; the parse method must be on EVERY connectable object
(method (instring)
	(if (not (foreach (i (matchcmd instring))
		     (if ((car i) (index 2 i))
                        (return 1))))
			(echo "I don't understand that\n")))
/
quit
;; the quit method must also be on EVERY connectable object
(method () (begin (#0:remove-connection)
		  (#0:tell-all (+ (tostr this) " has disconnected"))
		  (disconnect)))
/
quit-command
(method (unused) (quit))
/
say-method
(method (inline) (tell-all (index 2 inline)))
/
short-pose
(method (inline) (pose-all (index 2 inline)))
/
shutdown-command
(method (unused) (#0:shutdown-method))
/
eval-command
(method (inline)
	(player:tell (+ "--> "
			(tostr ((compile (+ "(method () "
					    (index 3 inline)
					    ")\n"))))
			"\n")))
/
page-command
(method (inline)
  (if (= (tostr this) (index 3 inline))
     (tell (+ (tostr this) " pages: " (index 5 inline) "\n"))))
/
test-cmd
(method (inline)
  (tell (+ (tostr inline) "\n")))
/
/
'("t" (or " " "est") REST)
test-cmd
'("p" (or "age" "") (or (before "=") (before "with") WORD) (or "=" "with" "") REST)
page-command
'(":" REST)
short-pose
'("\"" REST)
say-method
'("say" REST)
say-method
'("quit")
quit-command
'("shutdown")
shutdown-command
'("eval" (or "uate" "") REST)
eval-command
'(";" "" REST)
eval-command
/
/