( Throw.Muf v. 1.0          ---    clone by Ginger@FurToonia   11-7-95 )
(                                                                      )
( Allows objects to be 'thrown' between players in separate rooms.     )
( Thrower, receiver, and object must be JUMP_OK.  Thrower must be set  )
( _throw_ok:y, receiver must be _receive_ok:y, and object and env must )
( not be set _throw_allowed?:n.  Receiver must not be HAVEN.           )
lvar dest lvar obj lvar entry lvar curname lvar proploc
: help
"*****Throw.MUF*by*Ginger@FurToonia**********************Main Help*****" 
.tell
"* Syntax:             throw <object> to/at <player>                  *" 
.tell
"*         throw #ok        - Allow yourself to throw/receive objects *" 
.tell
"*         throw #!ok       - Disallow yourself from the above        *" 
.tell
"*         throw #help      - This screen                             *" 
.tell
"*         throw #help2     - How to set custom messages on objects   *" 
.tell
"*         throw #help3     - Info on pronoun substitution in mesgs   *" 
.tell
"*         throw #help4     - Special properties                      *" 
.tell
"*         throw #ignore [<player> <player>] | '#all' ...             *" 
.tell
"*                          - Disallow <player>s from throwing to you *" 
.tell
"*         throw #!ignore [<player> <player>] | '#all' ...            *" 
.tell
"*                          - Reallow <player>s to throw to you       *" 
.tell
"**********************************************************************" 
.tell
;
: help2
"*****Throw.MUF*by*Ginger@FurToonia***Custom*Messages*<objects>*****" .tell
"* Syntax:       @set <object>=<propname>:<value>                  *" .tell
"*          ex.  @set ball=_throw/succ:You toss the ball to &n.    *" .tell
"* Properties:                                                     *" .tell
"*   _throw/succ:You throw %obj far away to &n.                    *" .tell
"*          osucc:%n throws %obj far away to &n.                   *" .tell
"*          drop:%obj lands in your hands, thrown by %n.           *" .tell
"*          odrop:%obj lands in &n's hands, thrown by %n.          *" .tell
"*          same:You throw %obj to &n, just a few feet away.       *" .tell
"*          osame:%n throws %obj across the room to &n.            *" .tell
"* Succ:  Seen by you when you throw to someone in another room    *" .tell
"* Osucc: Seen by others in the same room with you                 *" .tell
"* Drop:  Seen by the receiver when you throw to another room      *" .tell
"* Odrop: Seen by others in the same room with the receiver        *" .tell
"* Same:  Seen by you when you throw to someone in the same room   *" .tell
"* Osame: Seen by others/receiver when you throw to the same room  *" .tell
"* Set these properties on >yourself< to have personalised messag- *" .tell
"*   es show when you throw/receive an object.  Messages on an ob- *" .tell
"*   ject override personal messages set on a player.              *" .tell
"*******************************************************************" .tell
;
: help3
"*****Throw.MUF*by*Ginger@FurToonia*******Pronoun*Substitutions*****" .tell
"* You may use expressions like %n, %a, %obj, and %p to stand for  *" .tell
"* the name or gender of the thrower/receiver or the name of the   *" .tell
"* object.  Type 'help subs' for help on usage.                    *" .tell
"* Pronouns for the THROWER are:      %n, %s, %a, %o, %p, and %r   *" .tell
"* Pronouns for the RECEIVER are:     &n, &s, &a, &o, &p, and &r   *" .tell
"* %obj will be replaced with the name of the OBJECT being thrown. *" .tell
"*******************************************************************" .tell
;
: help4
"*****Throw.MUF*by*Ginger@FurToonia**********Special*Properties*****" .tell
"* The receiver may set the following properties to evaluate which *" .tell
"* furries may throw to him/her:                                   *" .tell
"* _receive_ok:n                  Allows no-one to throw to you    *" .tell
"* _sleep_throw:<name> [<name>]   Lets <name>s throw to you if you *" .tell
"*                                  are asleep                     *" .tell
"* _throw_allowed:<name> [<name>] Lets <name>s throw to you if you *" .tell
"*                                  are set _receive_ok:n          *" .tell
"* An object set _throw_allowed?:n cannot be thrown.               *" .tell
"*******************************************************************" .tell
;
: setok
  me @ "_throw_ok" "yes" 1 addprop
  me @ "_receive_ok" "yes" 1 addprop
  "You can now throw and receive objects." .tell
;
: setnotok
  me @ "_throw_ok" "no" 1 addprop
  me @ "_receive_ok" "yes" 1 addprop
  "You can no longer throw or receive objects." .tell
;
: show_ignore
  "You are currently ignoring: "
  me @ "_throw_ignore" getpropstr dup "*[a-z]*" smatch not if pop
  "*no-one*" then strcat .tell
;
: ignore
  entry @ " " instr entry @ swap strcut swap pop " " strcat
  me @ "_throw_ignore" getpropstr dup "" stringcmp 0 = if " " strcat then
     swap strcat me @ swap "_throw_ignore" swap 1 addprop
  "Done." .tell
;
: unignore
  entry @ " " instr entry @ swap strcut swap pop
  " " explode begin dup 0 = not while
                  1 - swap " " swap strcat " " strcat curname !
                  me @ "_throw_ignore" getpropstr curname @ instr
                  dup 0 = if pop continue then
                  me @ "_throw_ignore" getpropstr swap 1 - strcut
                  curname @ strlen strcut swap pop " " swap strcat strcat
                  dup "*[a-z]*" smatch not if pop " " then
                  dup "  " stringpfx if 1 strcut swap pop then
                  dup "  " stringpfx if 1 strcut swap pop then
                  me @ swap "_throw_ignore" swap 1 addprop repeat
  "Done." .tell
;
: parse_string ( s - s )
  me @ name "%N" subst
  dest @ name "&N" subst
  dest @ name "&n" subst
  obj @ name "%obj" subst
  me @ swap pronoun_sub
  dest @ "sex" getpropstr "female" stringcmp 0 = if
  "hers" "&a" subst    "Hers" "&A" subst
  "her" "&o" subst     "Her" "&O" subst
  "her" "&p" subst     "Her" "&P" subst
  "she" "&s" subst     "She" "&S" subst
  "herself" "&r" subst "Herself" "&R" subst
       then
  dest @ "sex" getpropstr "male" stringcmp 0 = if
  "his" "&a" subst      "His" "&A" subst
  "him" "&o" subst      "Him" "&O" subst
  "his" "&p" subst      "His" "&P" subst
  "he" "&s" subst       "He" "&S" subst
  "himself" "&r" subst  "Himself" "&R" subst
        else
   "its" "&a" subst     "Its" "&A" subst
   "it" "&o" subst      "It" "&O" subst
   "its" "&p" subst     "Its" "&P" subst
   "it" "&s" subst      "It" "&S" subst
   "itself" "&r" subst  "Itself" "&R" subst
     then
;
: throw_same
  obj @ "_throw/osame" getpropstr "" stringcmp 0 = not if
  obj @ "_throw/osame" getpropstr parse_string
      me @ location swap me @ swap notify_except
  else me @ "_throw/osame" getpropstr "" stringcmp 0 = not if
  me @ "_throw/osame" getpropstr parse_string
      me @ location swap me @ swap notify_except
  else dest @ "%N tosses %obj to you." parse_string notify 
      me @ "%N tosses %obj to &N." pronoun_sub parse_string
      me @ location swap me @ swap dest @ swap 2 swap notify_exclude
  then then
  obj @ "_throw/same" getpropstr "" stringcmp 0 = not if
  obj @ "_throw/same" getpropstr parse_string .tell
     else me @ "_throw/same" getpropstr "" stringcmp 0 = not if
  me @ "_throw/same" getpropstr parse_string .tell
     else "You toss %obj to &N." parse_string .tell then then
  obj @ dest @ moveto
;
: throw_object
  me @ location dest @ location dbcmp if throw_same exit then
  obj @ "_throw/succ" getpropstr "" stringcmp 0 = not if
  obj @ "_throw/succ" getpropstr parse_string .tell
     else me @ "_throw/succ" getpropstr "" stringcmp 0 = not if
  me @ "_throw/succ" getpropstr parse_string .tell
     else "You throw %obj to &N." parse_string .tell then then
  obj @ "_throw/osucc" getpropstr "" stringcmp 0 = not if
  obj @ "_throw/osucc" getpropstr parse_string
     me @ location swap me @ swap notify_except
     else me @ "_throw/osucc" getpropstr "" stringcmp 0 = not if
     me @ "_throw/osucc" getpropstr parse_string
     me @ location swap me @ swap notify_except
     else "%N throws %obj to &N." parse_string
     me @ location swap me @ swap notify_except then then
  obj @ "_throw/drop" getpropstr "" stringcmp 0 = not if
  obj @ "_throw/drop" getpropstr parse_string
        dest @ swap notify
    else me @ "_throw/drop" getpropstr "" stringcmp 0 = not if
    me @ "_throw/drop" getpropstr parse_string
        dest @ swap notify
    else "%N throws %obj to you from afar." parse_string
        dest @ swap notify then then
   obj @ "_throw/odrop" getpropstr "" stringcmp 0 = not if
   obj @ "_throw/odrop" getpropstr parse_string
        dest @ location swap dest @ swap notify_except
    else me @ "_throw/odrop" getpropstr "" stringcmp 0 = not if
      me @ "_throw/odrop" getpropstr parse_string
        dest @ location swap dest @ swap notify_except
    else "%N throws %obj to &N from afar." parse_string
        dest @ location swap dest @ swap notify_except then then
  obj @ dest @ moveto
;
: setup_for_throw
  me @ "_throw_ok" getpropstr "y" stringpfx not if
     "You are not set _throw_ok:y." .tell exit then
  me @ "J" flag? not if "You are not set Jump_ok." .tell exit then
  me @ location "_throw_allowed?" envprop swap pop
     dup int? if pop "" then "n" stringpfx 1 = if
     "The environment does not permit throwing." .tell exit then
  entry @ " at " instr 0 = if entry @ " to " else entry @ " at " then
     explode 2 = not if
     "Ack!  >gag<  >splutter<  >cough<" .tell
     "Syntax:   throw <object> to/at <player>" .tell exit
     else pop pop then
  entry @ " at " instr 0 = if entry @ " to " else entry @ " at " then
     explode pop obj ! dest !
  obj @ match dup #-1 dbcmp if pop "I don't see " obj @ strcat " here."
      strcat .tell exit then
      dup #-2 dbcmp if pop "I don't know which object you mean." .tell
      exit then obj !
  obj @ player? me @ "W" flag? not and if
      "You cannot throw a player." .tell exit then
  obj @ location me @ dbcmp not obj @ player? not and if
      "You aren't holding that." .tell exit then
  obj @ "_throw_allowed?" getpropstr dup int? if pop "" then "n" 
      stringpfx 1 = if "You cannot throw that." .tell exit then
  obj @ "J" flag? not if obj @ name " is not set jump_ok." strcat .tell
      exit then
  obj @ "Z" flag? if "You cannot throw zombie objects." .tell exit then
  obj @ "V" flag? if "You cannot throw vehicle objects." .tell exit then
  dest @ .pmatch dup #-1 dbcmp if pop "I don't know who that is." .tell
      exit then
      dup #-2 dbcmp if pop "Throw it to whom?" .tell exit then
      dest !
  dest @ "_throw_ignore" getpropstr " #all " instr if
      dest @ name " is currently ignoring all throws." strcat .tell exit then
  dest @ "_throw_ignore" getpropstr tolower
    me @ name " " strcat " " swap strcat tolower
      instr 0 = not if
      dest @ name " does not want you throwing to %o." strcat
      dest @ swap pronoun_sub .tell exit then
  dest @ awake? not dest @ "_sleep_throw" getpropstr me @ name instr
      0 = and if
      dest @ name " is asleep and can't catch objects." strcat .tell
      exit then
  dest @ "_throw_ok" getpropstr "y" stringpfx not if
      dest @ name " is not using this program." strcat .tell exit then
  dest @ "J" flag? not if dest @ name " is not set jump_ok."
      strcat .tell exit then
  dest @ "H" flag? if
      dest @ name " does not wish to be disturbed." strcat .tell exit then
  dest @ "_throw_allowed" getpropstr me @ name " " strcat " " swap strcat
      instr if throw_object exit then
  dest @ "_receive_ok" getpropstr "y" stringpfx not if
      dest @ name " is not set _receive_ok:y." strcat .tell exit then
  throw_object
;
: main
  entry !
  entry @ "" stringcmp 0 = if help exit then
  entry @ "#help" stringcmp 0 = if help exit then
  entry @ "#help2" stringcmp 0 = if help2 exit then
  entry @ "#help3" stringcmp 0 = if help3 exit then
  entry @ "#help4" stringcmp 0 = if help4 exit then
  entry @ "#ok" stringcmp 0 = if setok exit then
  entry @ "#!ok" stringcmp 0 = if setnotok exit then
  entry @ "#ignore" stringcmp 0 = if show_ignore exit then
  entry @ "#ignore" stringpfx if ignore exit then
  entry @ "#!ignore" stringpfx if unignore exit then
  setup_for_throw
;