8 5
init
(method ()
(begin
(set contents '())
(set home #17)
(set name (+ "guest_" (tostr this)))
(go-home)))
/
name
"generic guest"
/
core-nicks
'("$system" "$root" "$located" "$exit" "$thing" "$container" "$area"
"$room" "$connected" "$guest" "$player" "$builder" "$coder"
"$admin" "$utils" "$recycler" "$editor")
/
destroy
(method ()
(if (write-ok? caller)
(begin
(if (has-parent? $guest)
(#0:remove-guest))
(pass))
(raise E_PERM "cannot destroy this object")))
/
announce
(method (instring)
(tell instring))
/
get-home
(method () home)
/
get-description
(method ()
(if contents
(var desc
(set desc (+ (pass) "\nCarrying:")
(foreach (con contents)
(set desc (+ desc "\n" (con:get-name))))))
(pass)))
/
look-at
(method ()
(player:tell-line (get-description)))
/
say-method
(method (inline)
(if (write-ok? player)
(location:announce (+ name " says, \"" (index 2 inline) "\"\n"))))
/
pose-method
(method (inline)
(if (write-ok? player)
(location:announce (+ name " " (index 2 inline) "\n"))))
/
welcome
(method ()
(if (write-ok? caller)
(begin
(tell (+ "Welcome to Interlude.\n"
"Connecting you to " name ".\n"
"Have an interesting time.\n\n"))
(location:announce-but (+ name " has connected\n") this)
(tell (+ (location:get-name) "\n"
(location:get-internal-description) "\n"
(location:get-contents-string) "\n")))))
/
parse
(method (instring)
(if (write-ok? player)
(if (search $editor (parents))
(edit-parse instring)
(if (not
(or (not instring)
(foreach (i (matchcmd instring))
(if ((car i) (index 2 i)) (return 1)))
(foreach (i contents)
(if (i:try-command instring) (return 1)))
(location:try-command-in instring)
(var pair
(and (set pair (reg-split "#[0-9]+" instring)
(call (compile (index 2 pair)) try-command instring))))))
(echo "I don't understand that\n")))))
/
quit
(method ()
(if (write-ok? player)
(begin (#0:remove-guest)
(disconnect)
(#0:remove-connection)
(location:announce (+ name " has disconnected.\n"))
(destroy))))
/
quit-command
(method (unused)
(if (write-ok? player)
(quit)))
/
inventory-command
(method (unused)
(if (read-ok? caller)
(tell
(if contents
(var cntstring
(set cntstring "You are carrying:\n"
(foreach (cnt contents)
(set cntstring (+ cntstring (cnt:get-name) "\n")))))
"You are not carrying anything\n"))))
/
look-cmd
(method (inline)
(if (= player this)
(if (index 4 inline) ;; empty string "" is logically false
(var match
(if (set match (std-match (index 4 inline)))
(match:look-at)
(tell "I don't see that here\n")))
(location:look-at))))
/
help-command
(method (inline)
(if (index 2 inline)
(ignore E_BAD_FILE
(tell (or (filetext (+ "help/" (index 2 inline)))
"There is no help available on that topic.\n")))
(tell (filetext "help/help"))))
/
who-command
(method (ignored)
(if (write-ok? player)
(foreach (c (#0:list-connected))
(tell (+ (c:get-name) " "
(call (c:get-location) get-name) " "
(c:get-address) "\n")))))
/
home-command
(method (unused)
(if (or (search player (location:list-owners)) (write-ok? player))
(begin (go-home)
(location:look-at))))
/
editor-alias
"$$"
/
send-whisper-method
(method (sym)
(if (write-ok? caller)
(whisper-to whispering-to (eval sym))))
/
whisper-method
(method (to msg)
(if (write-ok? player)
(if (= msg editor-alias)
(begin
(tell-line ">> Editing the text of the message to whisper...")
(set whispering-to to)
(enter-edit
'whisper-txt
'send-whisper-method
'()))
(whisper-to to msg))))
/
whisper-to
(method (to msg)
(if (write-ok? player)
(if (search "\n" msg)
(begin
(tell-line (+ "You whisper your message to " (to:get-name)))
(if (to:tell-line (+ name " whispers to you:"))
(tell-line (+ " " (implode "\n " (explode "\n" msg))))
(tell-line (+ (to:get-name) " isn't awake, though."))))
(begin
(tell-line (+ "You whisper, \"" msg "\" to " (to:get-name)))
(if (to:tell-line (+ name " whispers, \"" msg "\" to you."))
name
(tell-line (+ (to:get-name) " isn't awake, though.")))))))
/
whisper-to-command
(method (inline)
(if (write-ok? player)
(var w-to
(if (= (index 4 inline) "to") ;; then it's Moo syntax
(if (set w-to (std-match (index 5 inline)))
(whisper-method w-to (index 3 inline))
(tell (+ "I don't see " (index 5 inline) " here\n")))
(if (set w-to (std-match (index 3 inline)))
(whisper-method w-to (index 5 inline))
(tell (+ "I don't see " (index 3 inline) " here\n")))))))
/
whisper-syntax
(method (unused)
(if (write-ok? player)
(tell "Syntax: whisper <msg> to <player>\n")))
/
connect-syntax
(method (unused)
(if (write-ok? player)
(tell "Syntax: connect <player name> <password>\n")))
/
connect-command
(method (inline)
(if (write-ok? player)
(var play-to
(if (search " " (index 4 inline))
(connect-syntax inline)
(if (set play-to (#0:find-player (index 3 inline)))
(if (#0:connect-me-to play-to (index 4 inline))
(quit)
1)
(tell "Can't locate that player\n"))))))
/
move-to
(method (dest)
(if (or (write-ok? caller)
(caller:descends-from? $exit)
(= player this))
(pass dest)))
/
get-cmd
(method (inline)
(if (= player this)
(var match
(if (set match (location:match-non-exit (index 2 inline)))
(if (match:move-to this)
(begin
(location:announce-but
(+ name " gets " (match:get-name) "\n") this)
(tell (+ "You get " (match:get-name) "\n")))
(tell "You can't get that!\n"))
(get-syntax)))))
/
get-syntax
(method (unused)
(if (= this player)
(tell "I don't see that here\n")))
/
drop-syntax
(method (unused)
(if (= player this)
(tell "You are not carrying that.\n")))
/
drop-cmd
(method (inline)
(if (= player this)
(var match
(if (set match (match-content (index 2 inline)))
(if (match:move-to location)
(begin
(location:announce-but
(+ name " drops " (match:get-name) "\n") this)
(tell (+ "You drop " (match:get-name) "\n")))
(tell "You can't drop that here!\n"))
(drop-syntax inline)))))
/
create-syntax
(method (unused)
(if (write-ok? player)
(tell "Syntax: create <player name> <password>\n")))
/
create-command
(method (inline)
(if (write-ok? player)
(if (search " " (index 3 inline))
(create-syntax inline)
(#0:guest-to-player (index 2 inline) (index 3 inline)))))
/
enter-edit
(method (prop after-call starting-list)
(begin (tell ">> type '.help' to get help on the editor\n")
(#0:addparent $editor)
(set editing-list starting-list)
(set edit-insert-at 1)
(set edit-save-prop prop)
(set edit-after-call after-call)))
/
leave-edit
(method () (#0:rmparent $editor))
/
quit-save
(method (saved-to)
(tell (+ ">> quitting editor, saving to property "
(tostr saved-to) "\n")))
/
/
'("say" REST)
say-method
'("\"" REST)
say-method
'("pose" REST)
pose-method
'(":" REST)
pose-method
'("quit")
quit-command
'("@quit")
quit-command
'("QUIT")
quit-command
'("l" (or "ook" "") (or " at " "") REST)
look-cmd
'("help" REST)
help-command
'("who" REST)
who-command
'("@who" REST)
who-command
'("WHO" REST)
who-command
'("home" REST)
home-command
'("HOME" REST)
home-command
'("wh" (or "isper" " ") (or (before "=") (before " to ") WORD) (or "=" "to" "") REST)
whisper-to-command
'("wh" (or "isper" ""))
whisper-syntax
'("con" (or "nect" " ") WORD REST)
connect-command
'("con" (or "nect" ""))
connect-syntax
'("create" WORD REST)
create-command
'("create")
create-syntax
'("i" (or "nventory" ""))
inventory-command
'("get" REST)
get-cmd
'("drop")
drop-syntax
'("drop" REST)
drop-cmd
/+++++++++ end of object #9 ... no lines after this ++++++++++