1
pose-all
(method (INSTRING) (foreach (CON CONNECTED-LIST) (call CON TELL (+ (tostr CALLER) " " INSTRING "\n"))))
/
numguests
0
/
shutdown-method
(method () (begin (TELL-ALL (+ "Server shutdown by " (tostr CALLER))) (set CONNECTED-LIST '()) (shutdown)))
/
remove-connection
(method () (set CONNECTED-LIST (SET-REMOVE CALLER CONNECTED-LIST)))
/
welcome-message
"You are now connecting to the doodle core.\n"
/
boot
(method () (set CONNECTED-LIST '()))
/
parse
(method (INSTRING) (echo "Please wait while your connection is transfered.\n"))
/
tell-all
(method (INSTRING) (foreach (CON CONNECTED-LIST) (call CON TELL (+ (tostr CALLER) " says, \"" INSTRING "\"\n"))))
/
connect
(method () (var ONUM (begin (echo WELCOME-MESSAGE) (set ONUM (call #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) (call ONUM TELL "Successfully reconnected\n"))))
/
connected-list
'()
/
/
/+++++++++++++ end of object #0 +++++++++++++

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)))))))))
/
~test-priv
(method () (call PLAYER TELL "testing"))
/
tell
(method (INSTRING) (ignore 26 (or (echo INSTRING) "")))
/
add-variable
(method (SYMBOL VALUE) (ADDVAR SYMBOL VALUE))
/
list-variables
(method () (vars))
/
descends-from?
(method (ANC) (foreach (PARENT (parents)) (if (or (= PARENT ANC) (call 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"))))
/
copy
(method () (clone))
/
/
/+++++++++++++ end of object #1 +++++++++++++
0 1
short-pose
(method (INLINE) (POSE-ALL (index 2 INLINE)))
/
eval-command
(method (INLINE) (call PLAYER TELL (+ "--> " (tostr ((compile (+ "(method () " (index 3 INLINE) ")\n")))) "\n")))
/
shutdown-command
(method (UNUSED) (call #0 SHUTDOWN-METHOD))
/
say-method
(method (INLINE) (TELL-ALL (index 2 INLINE)))
/
parse
(method (INSTRING) (if (not (foreach (I (matchcmd INSTRING)) (if ((car I) (index 2 I)) (return 1)))) (echo "I don't understand that\n")))
/
test-cmd
(method (INLINE) (TELL (+ (tostr INLINE) "\n")))
/
page-command
(method (INLINE) (if (= (tostr THIS) (index 3 INLINE)) (TELL (+ (tostr THIS) " pages: " (index 5 INLINE) "\n"))))
/
quit
(method () (begin (call #0 REMOVE-CONNECTION) (call #0 TELL-ALL (+ (tostr THIS) " has disconnected")) (disconnect)))
/
quit-command
(method (UNUSED) (QUIT))
/
/
'("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
/+++++++++++++ end of object #2 +++++++++++++