# load this file with loader after stripping comments
# and running it through M4.

include(tiny.m4)

# Create standard types

maketype(tinymud_object, "Generic TinyMUD Object")
set tinymud_object.TOP to me

makemethod(tinymud_object, which, {
 tell $name "(" %id ") in " location.$name "(" location.%id ")" to you
 if $text then tell "Text: " $text to you endif
})

makemethod(tinymud_object, look, {
 if $text then
  tell "I don't see that here." to you
 else 
  if $description then
   tell $description to you
  else
   tell "You see nothing special." to you
  endif
  if %count > 1 or you.location != me and %count > 0 then
   set ?_1 to ?false
   in me do
    if next != you and next.$name then
     set ?_1 to ?true
     break
    endif
   end
   if ?_1 then
    tell "Contents:" to you
    in me do
     if next != you and next.$name then tell " " next.$name to you endif
    end
   endif
   clear ?_1
  endif
 endif
})
alias_method(tinymud_object, l, look)
alias_method(tinymud_object, read, look)

makemethod(tinymud_object, get, {
 if $text then
  tell "I don't see that here." to you
 elseif location = you then
  tell "You already have that!" to you
 elseif (you.owner = owner) and move me to you then
  tell "Taken." to you
 else 
  tell "You can't pick that up." to you
 endif
})
alias_method(tinymud_object, take, get)

makemethod(tinymud_object, drop, {
 if $text or location != you then
  tell "You don't have that." to you
 elseif move me to you.location then
  tell "Dropped." to you
 else
  tell "For some reason you can't drop that here." to you
 endif
})

alias_method(tinymud_object, put, drop)
alias_method(tinymud_object, throw, drop)

# to enter into something
makemethod(tinymud_object, pushin, {
 if you.owner != owner then
  tell $permission_denied to you
 else
  if location = you then
   move me to you.location
  endif
  if move you to me then
   tell "Pushed down into " me.$name "." to you
   tell "Use 'popout' to get out." to you
  else
   tell "Couldn't move you into " me.$name "." to you
  endif
 endif
})

makemethod(tinymud_object, popout, {
 if you.owner != owner then
  tell $permission_denied to you
 elseif move you to location then
  if location.$name then
   tell "Popped out to " location.$name "." to you
  else
   tell "Popped out to a nameless place." to you
  endif
 else 
  tell "For some reason you can't pop out of here." to you
 endif
})

makemethod(tinymud_object, help, {
 if $text then
  in TOP.@helpers matching $text do
   tell next.$help to you
   exit
  end
  tell "Sorry, no help for " $text to you
 elseif $help then
  tell $help to you
 else
  tell "Available help topics:" to you
  in TOP.@helpers do
   tell " " next.$aliases to you
  end
 endif
})

# TinyMUD variable setters
set tinymud_object.$permission_denied to "Permission denied."

define(set_command, {
 makemethod(tinymud_object, $1<is, {
  if you.owner != owner then
   tell $permission_denied to you
  else 
   set $$1 to $text
   tell "Set $1 to \"" $text "\"" to you
  endif
 })
 makemethod(tinymud_object, clear_$1, {
  if you.owner != owner then
   tell $permission_denied to you
  else 
   clear $$1
   tell "Cleared $1." to you
  endif
 })
})

set_command(name)
set_command(description)
alias_method(tinymud_object, describe<as, description<is)
set_command(success)
set_command(fail)
set_command(osuccess)
set_command(ofail)
set_command(help)

undefine({set_command})

makemethod(tinymud_object, vanish, {
 if you.owner != owner then
  tell $permission_denied to you
 elseif $text then
  tell "I don't see that here?" to you
 else 
  set $name to $null
  tell "Set name of " $aliases " to $null." to you
 endif
})

makemethod(tinymud_object, set>on, {
 if you.owner != owner then
  tell $permission_denied to you
 elseif $text = "sticky" or $text = "s" then
  set me.?sticky to ?true
  tell $name " is now sticky." to you
 elseif $text = "open" or $text = "o" then
  set me.?open to ?true
  tell $name " is now open." to you
 else
  tell "I don't recognize the flag \"" $text "\"" to you
 endif
})

makemethod(tinymud_object, reset>on, {
 if you.owner != owner then
  tell $permission_denied to you
 elseif $text = "sticky" or $text = "s" then
  set me.?sticky to ?false
  tell $name " is no longer sticky." to you
 elseif $text = "open" or $text = "o" then
  set me.?open to ?false
  tell $name " is no longer open." to you
 else
  tell "I don't recognize the flag \"" $text "\"" to you
 endif
})


# aliases are funny, since #id always works
makemethod(tinymud_object, aliases<are, {
 if you.owner != owner then
  tell $permission_denied to you
 else 
  set $aliases to $text | "|#" | %id
  tell "Set aliases to \"" $aliases "\"" to you
 endif
})

makemethod(tinymud_object, clear_aliases, {
 if you.owner != owner then
  tell $permission_denied to you
 else 
  set $aliases to "#" | %id
  tell "Cleared all aliases except \"" $aliases "\"" to you
 endif
})

alias_method(tinymud_object, alias<to, aliases<are)


# links and such
makemethod(tinymud_object, link<to, {
 if you.owner != owner then
  tell $permission_denied to you
 else 
  do_match(you, _1)
  if ! _1 then 
   tell "Link " $name " to what?" to you
  else 
   set link to _1
   tell $name " linked to " _1.$name to you
  endif
  clear _1
 endif
})
makemethod(tinymud_object, unlink, {
 if you.owner != owner then
  tell $permission_denied to you
 else 
  clear link
  tell "Unlinked." to you
 endif
})


# locks
makemethod(tinymud_object, lock<to, {
 if you.owner != owner then
  tell $permission_denied to you
 else
  do_match(you, _1)
  if !_1 then
   tell "Lock " $name " to what?" to you
  else
   add _1 to @keys
   tell "Added " _1.$name " to list of keys for " $name "." to you
  endif
  clear _1
 endif
})

makemethod(tinymud_object, lock<against, {
 if you.owner != owner then
  tell $permission_denied to you
 else
  do_match(you, _1)
  if !_1 then
   tell "Lock " $name " to what?" to you
  else
   add _1 to @antikeys
   tell "Added " _1.$name " to list of antikeys for " $name "." to you
  endif
  clear _1
 endif
})

makemethod(tinymud_object, unlock, {
 if you.owner != owner then
  tell $permission_denied to you
 else
  clear @keys
  clear @antikeys
  tell "Unlocked " $name "." to you
 endif
})

# puts status in variable named by $1
define(can_doit, { set $1 to ?true
 if @keys.%count != 0 then
  set $1 to ?false
  in @keys do
   if next = you or next.location = you then
    set $1 to ?true
    break
   endif
  end
 endif
 if $1 and @antikeys.%count != 0 then
  in @antikeys do
   if next = you or next.location = you then
    set $1 to ?false
    break
   endif
  end
 endif })

define(spit_success_message, { if $success then
  tell $success to you
 else
  tell $1 to you
 endif
 if $osuccess then
  in $2 do
   if next.?player and next != you then
    tell you.$name " " $osuccess to next
   endif
  end
 endif })

define(spit_fail_message, { if $fail then
  tell $fail to you
 else
  tell $1 to you
 endif
 if $ofail then
  in $2 do
   if next.?player and next != you then
    tell you.$name " " $ofail to next
   endif
  end
 endif })

# examine method
# this auxiliary is only used in examine
define(tellflag, { if ?$1 then tell "?$1: ?true" to you endif })
makemethod(tinymud_object, examine, {
 if $text then
  tell "Examine what?" to you
 elseif owner = you.owner or you.?wizard then
  tell "%id: " me.%id to you
  tell "parent: " parent.$name "(" parent.%id ")" to you
  tell "owner: " owner.$name "(" owner.%id ")" to you
  tellflag(open)
  tellflag(connected)
  tellflag(paranoid)
  tellflag(player)
  tellflag(builder)
  tellflag(programmer)
  tellflag(wizard)
  tellflag(admin)
  if @keys.%count > 0 then
   tell "Keys:" to you
   in @keys do
    tell " " next.$name "(" next.%id ")" to you
   end
  endif
  if @antikeys.%count > 0 then
   tell "Antikeys:" to you
   in @keys do
    tell " " next.$name "(" next.%id ")" to you
   end
  endif
  syscall 1
 else
  tell "You can't examine that." to you
 endif
})                         
undefine({tellflag})

makemethod(tinymud_object, verify, {
 if $text then
  tell "Verify what?" to you
 elseif owner = you.owner or you.?wizard then
  syscall 6
  tell "---" to you
 else
  tell "You can't verify that." to you
 endif
})                         

makemethod(tinymud_object, _invoke, {
 tell "But what do you want to do with " $name "?" to you
})

makemethod(tinymud_object, _default, {
 tell "You can't do that." to you
 if owner.?debugging then
  tell "HUH from " you.$name "(" you.%id ") in " $name "(" %id "): " $text
   to owner
 endif
})

maketype(tinymud_thing, "Generic TinyMUD Thing", tinymud_object)

makemethod(tinymud_thing, get, {
 if location = you then
  tell "You already have that!" to you
 else
  can_doit(?_1)
  if ?_1 and move me to you then
   spit_success_message("Taken.", you.location)
  else
   spit_fail_message("You can't pick that up.", you.location)
  endif
  clear ?_1
 endif
})

makemethod(tinymud_thing, drop, {
 if location != you then
  tell "You don't have that." to you
 elseif ?sticky and link then
  if move me to link then
   tell "Dropped." to you
  else
   tell "For some reason you can't drop that." to you
  endif
 elseif move me to you.location then
  tell "Dropped." to you
  in you.location do 
   if next.?player and next != you then
    tell you.$name " dropped " $name "." to next
   endif
  end
 else
  tell "For some reason you can't drop that here." to you
 endif
})

alias_method(tinymud_thing, put, drop)
alias_method(tinymud_thing, throw, drop)

# Player type

maketype(tinymud_player, "Generic TinyMUD Player", tinymud_object)

# default commands
makemethod(tinymud_player, say, {
 if $text and you = me then
  tell "You say \"" $text "\"" to you
  in location do
   if next.?player and next != you then
    if you.$name then
     tell you.$name " says \"" $text "\"" to next
    else
     tell "A disembodied voice says \"" $text "\"" to next
    endif
   endif
  end
 elseif $name then
  tell "But what do you want to say to " $name "?" to you
 else
  tell "You sense that you are talking to a ghost." to you
 endif
})

makemethod(tinymud_player, emote, {
 if me != you then
  tell "And just how do you plan to emote " me.$name "?" to you
 elseif !$text then
  tell "Emote what?" to you
 else
  in location do
   if next.?player then
    tell $name " " $text to next
   endif
  end
 endif
})

makemethod(tinymud_player, whisper>to, {
 if $text then
  if me.?connected then
   tell "You whisper \"" $text "\" to " $name "." to you
   tell you.$name " whispers \"" $text "\"" to me
  else
   tell $name " appears to be asleep." to you
  endif
 else
  tell "But what do you want to whisper to " $name "?" to you
 endif
})

makemethod(tinymud_player, inventory, {
 if me = you then
  if %count > 0 then
   tell "You are carrying:" to me
   in me do
    if next.$name then
     tell " " next.$name to me
    else
     tell "A nameless object with number " next.%id to me
    endif
   end
  else
   tell "You aren't carrying anything." to me
  endif
 else
  tell "Try 'look'" to you
 endif
})
alias_method(tinymud_player, i, inventory)
alias_method(tinymud_player, inv, inventory)

makemethod(tinymud_player, news, {
 tell TOP.$news to you
})

makemethod(tinymud_player, home, {
 if you != me then
  tell "You can't send someone else home." to you
 elseif move me to TOP.player_start_location then
  tell "There's no place like home..." to you
 else
  tell "For some reason you can't go home." to you
 endif
})

# players are noisy when they change their names 
# and can only change their own
makemethod(tinymud_player, name<is, {
 if you != me then
  tell $permission_denied to you
 else
  in TOP.@connected_players do
   if next != you then
    tell "Name change: " $name " to " $text "." to next
   endif
  end
  set $name to $text
  tell "Name changed to " $name "." to you
 endif
})

makemethod(tinymud_player, clear_name, {
 tell $permission_denied to you
})

makemethod(tinymud_player, paranoid, {
 if me != you or $text then
  tell "Sorry, this command takes no arguments." to you
 else
  set ?paranoid to !?paranoid   
  if ?paranoid then
   tell "Paranoid mode ON." to you
  else
   tell "Paranoid mode OFF." to you
  endif
 endif
})

# auxiliary for WHO
define(who_next, { if next.~last_command_time then
  tell next.$name " idle " (~time - next.~last_command_time) " seconds" to you
 else
  tell next.$name to you
 endif })

makemethod(tinymud_player, WHO, {
 if you != me then
  tell $name " say \"Me " $name ", who you?\"" to you
 else
  tell "Server started at " TOP.~startup_time to you
  if $text then
   in TOP.@connected_players matching $text do
    who_next
   end
  else
   in TOP.@connected_players do
    who_next
   end
  endif
  tell "---" to you
 endif
})
undefine({who_next})

alias_method(tinymud_player, who, WHO)

makemethod(tinymud_player, _before, {
 set before_location to location
})

makemethod(tinymud_player, _after, {
 if me = you then
  set ~last_command_time to ~time
  if location != before_location then
   in before_location do
    tell me.$name " has left." to next
   end
   in location do
    if next.?connected and next != me then
     tell me.$name " has arrived." to next
    endif
   end
  endif
 endif
})

makemethod(tinymud_player, _connect, {
 in location do
  if next.?player and next != me then
   tell me.$name " has connected." to next
  endif
 end
})

makemethod(tinymud_player, _disconnect, {
 in location do
  if next.?player and next != me then
   tell me.$name " has disconnected." to next
  endif
 end
})

makemethod(tinymud_player, find, {
 if me != you then
  tell me.$name " is right here!" to you
 else                          
  in @creations matching $text do
   tell next.$aliases to you
  end
  tell "---that is all---" to you
 endif
})

makemethod(tinymud_player, recover, {
 if me != you then
  tell me.$name " is already here!" to you
 else
  in @creations matching $text do
   move next to you
   tell "Recovered " next.$name to you
  end
  tell "---that is all---" to you
 endif
})

maketype(tinymud_room, "Generic TinyMUD Room", tinymud_object)

maketype(tinymud_exit, "Generic TinyMUD Exit", tinymud_object)

makemethod(tinymud_exit, _invoke, {
 set _1 to you.location         
 can_doit(?_1)
 if ?_1 and move you to link then
  spit_success_message(link.$name, _1)
 else 
  spit_fail_message("You can't go that way.", _1)
 endif
 clear _1
 clear ?_1
})
alias_method(tinymud_exit, go, _invoke)
alias_method(tinymud_exit, goto, _invoke)

maketype(tinymud_bigbag, "Generic TinyMUD Big Bag", tinymud_thing)

set tinymud_bigbag.contents to tinymud_object
set tinymud_bigbag.?wizard to ?true

makemethod(tinymud_bigbag, get>from, {
 set _1 to create
 if move _1 to you then
  set _1.$aliases to $text | "|#" | _1.%id
  set _1.$name to $text
  set _1.parent to contents
  set _1.owner to you.owner
  add _1 to contents.@instances
  add _1 to you.@creations
  set you.last_creation to _1
  if $create_success then
   tell $create_success to you
  else
   tell "Taken." to you
  endif
  if $create_osuccess then
   in you.location do
    if next.?player and next != you then
     tell you.$name " " $create_osuccess to next
    endif
   end
  endif
 else
  destroy _1
  if $create_fail then
   tell $create_fail to you
  else
   tell "You can't find one in there." to you
  endif
  if $create_ofail then
   in you.location do
    if next.?player and next != you then
     tell you.$name " " $create_ofail to next
    endif
   end
  endif
 endif
 clear _1
})
alias_method(tinymud_bigbag, take>from, get>from)

maketype(tinymud_dumpster, "Generic TinyMUD Dumpster", tinymud_thing)

set tinymud_dumpster.$destroyed to "Returned."

makemethod(tinymud_dumpster, drop>in, {
 do_match(you, _1)
 if ! _1 then
  tell "I don't see that here." to you
 elseif _1.owner = you.owner then
  take _1 from _1.parent.@instances
  take _1 from you.@creations
  if destroy _1 then
   tell $destroyed to you
  else
   tell "It won't fit!" to you
  endif
 else
  tell "The owner will get mad at you if you destroy that." to you
 endif
 clear _1
})
alias_method(tinymud_dumpster, drop>into, drop>in)
alias_method(tinymud_dumpster, put>in, drop>in)
alias_method(tinymud_dumpster, put>into, drop>in)
alias_method(tinymud_dumpster, throw>in, drop>in)
alias_method(tinymud_dumpster, throw>into, drop>in)

# Make helpers
# make_helper(aliases, string) makes a helper
define(make_helper, {  tell "Helper: " $1 to you
 set _1 to create
 set _1.$aliases to $1
 set _1.$help to $2
 add _1 to @helpers
 clear _1})

make_helper("help",{
[help command --- get help on a command
help object -- get help on a particular object
help help -- print this message]})

make_helper("which", "which name -- tell which object matches name")

make_helper("look", [look -- look around
look object -- look at object])

make_helper("get|take", "get object -- pick up an object")

make_helper("drop|put|throw", "drop object -- drop an object")

make_helper("pushin", "pushin object -- jump into an object you control")

make_helper("popout", "popout object -- jump out of an object you control")

make_helper("name", "name object is string -- set the name of an object")
make_helper("clear_name", "clear_name object -- clear the name on an object")

make_helper("vanish",
"vanish object -- make an object invisible by setting its name to $null")

make_helper("description",
"description object is string -- set the description of an object")

make_helper("success",
"success object is string -- set the success message of object to string")
make_helper("clear_success",
"clear_success object -- clear the success message on object")

make_helper("fail",
"fail object is string -- set the fail message of object to string")
make_helper("clear_fail",
"clear_fail object -- clear the fail message on object")

make_helper("osuccess",
"osuccess object is string -- set the osuccess message of object to string")
make_helper("clear_osuccess",
"clear_osuccess object -- clear the osuccess message on object")

make_helper("ofail",
"ofail object is string -- set the ofail message of object to string")
make_helper("clear_ofail",
"clear_ofail object -- clear the ofail message on object")

make_helper("help",
"help object is string -- set the help message of object to string")
make_helper("clear_help",
"clear_help object -- clear the help message on object")

make_helper("describe",
"describe object as string -- set the description of object to string")
make_helper("clear_description",
"clear_description object -- clear the description message on object")

make_helper("set", 
{"set [open or sticky] on object -- make an object open or sticky"})

make_helper("reset", 
 "reset [open or sticky] on object -- make an object not open or not sticky")

make_helper("aliases",
"aliases object are string -- set the aliases on an object;
 different aliases are separated by vertical bars; e.g.
 aliases george are George | george | George the Magnificent")
make_helper("alias",
"alias object  string -- set the aliases on an object; see aliases")

make_helper("link",
{"link object1 to object2 -- set the link field on object1 to point to object2.
 The link field on an exit points to its destination,
 and tells a thing where to go when dropped."})

make_helper("clear_link",
"clear_link object -- remove the link field from object")

make_helper("lock",
{"lock object to key -- you must have key (or some other key) to use object.
 lock object against antikey -- you cannot use object if you have antikey."})

make_helper("unlock", {"unlock object -- clear all keys and antikeys on object,
 so that anybody can use it."})

make_helper("examine",
 "examine object -- print information about an object you control")

make_helper("verify",
 "verify object -- check all methods defined for object for errors")

make_helper("say", "say message -- speak a message")

make_helper("emote", {"emote message -- pretend to do something, e.g. 
 \"emote grins gleefully.\" tells everyone in your current location
 \"[Yourname] grins gleefully.\""})
 
make_helper("whisper",
 "whisper message to person -- whisper a private message to someone")

make_helper("inventory|inv|i", "inventory -- list your possessions")

make_helper("news", "news -- print current news")

make_helper("home", "home -- go back to your starting location")

make_helper("paranoid", "paranoid -- turn paranoid mode on or off")

make_helper("who|WHO", "who -- print list of current users")

make_helper("find",
 "find name -- print aliases for all objects you have created with name")

make_helper("recover",
{"recover object -- recover an object you have created, no matter where it is"})

make_helper("go", "go exit -- go through an exit")

# Create top_object methods

set me.$name to "TOP"
set me.$aliases to "TOP|top" | "|#" | me.%id
clear me.parent
set me.$permission_denied to "Sorry."
add me to @players
add me to @administrators
set me.$password to "foo"
syscall 5

# seconds between dumps
set %dump_interval to 3600

makemethod(me, Initialize, {
 set ~startup_time to ~time
 in @connected_players do
  clear next.?connected
 end
 clear @connected_players
 syscall 2
 delay %dump_interval
})

makemethod(me, _tick, {
 set ~last_checkpoint to ~time               
 syscall 3
 delay %dump_interval
})

# note that we have do an ugle hack here
makemethod(me, Password, {
 if me = you and $text then
  set $_1 to $password
  set $password to $text
  syscall 5
  set $default_password to $password
  tell "Encrypted default password is " $default_password "." to you
  set $password to $_1
  clear $_1
 else
  tell $permission_denied to you
 endif
})

makemethod(me, Make_Player, {
 if me = you and $text then
  set _1 to create
  set _1.$aliases to $text | "|#" | _1.%id
  set _1.$name to $text
  set _1.?player to ?true
  add _1 to @players
  set _1.parent to tinymud_player
  set _1.owner to _1
  set _1.$password to $default_password
  move _1 to player_start_location
  tell "Created player number " _1.%id " with aliases " _1.$aliases "." to you
  set last_player to _1
  clear _1
 else
  tell $permission_denied to you
 endif
})

define(system_function, {
 makemethod(me, $1, {
  if (me = you or @administrators contains you) and !$text and syscall $2 then
   tell $3 to you
  else
   tell $permission_denied to you
  endif
 })
})

system_function(Garbage_Collect, 2, "Garbage collecting...")
system_function(Checkpoint, 3, "Checkpointing...")
system_function(Shutdown, 4, "Shutting down...")

undefine({system_function})

#
# TEST OBJECTS
#

# create a test room
makeobj(room, "Test Room", tinymud_room)
move me to room
set player_start_location to room

# Verify everything now that we are somewhere and can execute commands

tell "Verifying Generic TinyMUD Object" to me

-verify Generic TinyMUD Object

tell "Verifying Generic TinyMUD Thing" to me

-verify Generic TinyMUD Thing

tell "Verifying Generic TinyMUD Player" to me

-verify Generic TinyMUD Player

tell "Verifying Generic TinyMUD Room" to me

-verify Generic TinyMUD Room

tell "Verifying Generic TinyMUD Exit" to me

-verify Generic TinyMUD Exit

tell "Verifying Generic TinyMUD Big Bag" to me

-verify Generic TinyMUD Big Bag

tell "Verifying Generic TinyMUD Dumpster" to me

-verify Generic TinyMUD Dumpster

tell "Verifying TOP" to me
set &verify to tinymud_object.&verify

-verify me

makeobj(foo, "Test Object", tinymud_thing)
move foo to room

makeobj(room_bag, "Bag of Rooms", tinymud_bigbag)
move room_bag to room
set room_bag.contents to tinymud_room
set room_bag.?wizard to ?true

makeobj(exit_bag, "Bag of Exits", tinymud_bigbag)
move exit_bag to room
set exit_bag.contents to tinymud_exit
set exit_bag.?wizard to ?true

makeobj(thing_bag, "Bag of Things", tinymud_bigbag)
move thing_bag to room
set thing_bag.contents to tinymud_thing
set thing_bag.?wizard to ?true

makeobj(dumpster, "Trash Dumpster", tinymud_dumpster)
move dumpster to room
set dumpster.?wizard to ?true

-Password foo

-Make_Player Fred

set last_player.?programmer to ?true
-Password foo

-Make_Player George

set last_player.?programmer to ?true
set last_player.?wizard to ?true


tell "Load finished at " ~time to me