@program libAnima.muf.i386.so.1.3
1 10000 d
i
$include $lib/loxorion
$pubdef :
$def FORCEWIZ #315
$libdef animate?
: animate?[ ref:target -- bool:result ]
target @ "_unanim/~inanimate" getprop if 0 else 1 then
; PUBLIC animate?

$libdef inanimate?
: inanimate?[ ref:target -- bool:result ]
target @ "_unanim/~inanimate" getprop if 1 else 0 then
; PUBLIC inanimate?

$libdef unanimate-refresh
: unanimate-refresh[ ref:target -- ] ( Refresh a deanimation after the toy moves )
var lexitoverride
( Make one big action out of the exits of this room )
{ "animate;unanimate;anim;unanim;"
  { target @ location exits_array foreach swap pop name repeat }array ";" array_join 
}cat lexitoverride !
( Get our override action -- and rename it -- if its valid )
target @ "_unanim/~dumbexit" getprop dbref? if
 target @ "_unanim/~dumbexit" getprop lexitoverride @ setname
 ( Damnit all, none of this stuff works! --- Wait for Proto )
 ( FORCEWIZ { "@set #" target @ "_unanim/~dumbexit" getprop int "=M1" }cat force )
then
; PUBLIC unanimate-refresh

$libdef unanimate
: unanimate[ ref:target -- ] ( Mark a toy as inanimate and set up deanimation )
var rexitoverride
( Set the mark )
target @ "_unanim/~inanimate" "yes" setprop
( Create our deanimation action )
target @ "animate;unanimate;anim;unanim;" newexit rexitoverride !
rexitoverride @ target @ setown
( link it to myself )
rexitoverride @ prog setlink
( and make the reference to the action )
target @ "_unanim/~dumbexit" rexitoverride @ setprop
( Then we add an arrive call to this program so we can update it )
target @ "~arrive/zztoy" prog setprop
( Now lets act like we just arrived in the room so that we can lock up the exits where we are )
target @ unanimate-refresh
; PUBLIC unanimate

$libdef animate
: animate[ ref:target -- ] ( Remove deanimation from a toy and remove the mark )
( Fix the old location of dumbexit which was insecure and could 
  allow an improper recycle here if edited )
target @ "_unanim/dumbexit" getprop dup dbref? not if pop else
 target @ owner me @ dbcmp if
  target @ "_unanim/~dumbexit" target @ "_unanim/dumbexit" getprop setprop
  target @ "_unanim/dumbexit" 0 setprop
 then
then
( Unset the mark )
target @ "_unanim/~inanimate" 0 setprop
( Remove the deanimation action -- if it belongs to us )
target @ "_unanim/~dumbexit" getprop me @ over controls if recycle else pop then
target @ "_unanim/~dumbexit" 0 setprop
( Remove our arrive queue entry )
target @ "~arrive/zztoy" 0 setprop
; PUBLIC animate

: joz.h33r
( Called by an inanimate moving from one room to another )
command @ "Queued event." smatch if "arrive" smatch if 
 me @ inanimate? if
  unanimate-refresh exit
 then
then then

( Called by an inanimate trying to move to another room. )
trig exit? if
 { "Inanimate toys can't move..." }tell exit
then
;
.
c
q
@reg libAnima=lib/anima
@program lock/anim.muf
1 1000 d
i
: anim-lock
me @ "_unanim/~inanimate" getprop if 0 else 1 then
;
.
c
q
@reg lock/anim=lock/anim
@program lock/unanim.muf
1 1000 d
i
: unanim-lock
me @ "_unanim/~inanimate" getprop if 1 else 0 then
;
.
c
q
@reg lock/unanim=lock/unanim
@program #166
1 10000 d
i
$include $lib/case
$include $lib/anima

( Commented out by Lox, call $lib/anima
: disable-say ( d -- )
 var! pdb
 pdb @ "morph;qmorph;animate;unanimate;anim;unanim;say;\"" newexit var! ~dumbexit
 pdb @ "_unanim/~dumbexit" ~dumbexit @ setprop
 ~dumbexit @ #114 ($nothing) setlink
 ~dumbexit @ "Inanimate toys can't do that..." setsucc
;
)

: unanim ( d -- )
 var! pdb
 "Unanimating " pdb @ name "." strcat strcat .tell
 pdb @ me @ name " unanimates you!" strcat notify

 loc @ pdb @ me @ name " unanimates " pdb @ name "." strcat strcat strcat
  notify_except
 pdb @ "_unanim/unanim" getprop var! msg
 msg @ if
  me @ msg @ pronoun_sub msg !
  pdb @ msg @ notify
 then
 pdb @ "_unanim/ounanim" getprop var! msg
 msg @ if
  me @ msg @ pronoun_sub msg !
  loc @ pdb @ pdb @ name " " msg @ strcat strcat notify_except
 else
 then

 pdb @ "_unanim/morph" getprop var! morph
 morph @ if
  pdb @ "_unanim/morph" pdb @ "_lastmorph" getprop setprop
  pdb @ "qmorph " morph @ strcat force
 then

 ( Lox -- call $lib/anima
   pdb @ enable-say
   pdb @ "_unanim/~inanimate" "yes" setprop )
 pdb @ unanimate
;

(
: enable-say ( d -- )
 var! pdb
 pdb @ "_unanim/~dumbexit" getprop recycle
 pdb @ "_unanim/~dumbexit" remove_prop
;
)

: anim ( d -- )
 var! pdb

 "Animating " pdb @ name "." strcat strcat .tell
 pdb @ me @ name " animates you!" strcat notify

 ( Commented out by Lox, call $lib/anima
 pdb @ enable-say
 pdb @ "_unanim/~inanimate" remove_prop
 )
 pdb @ animate
 
 pdb @ "_unanim/morph" getprop var! morph
 morph @ if
  pdb @ "_unanim/morph" pdb @ "_lastmorph" getprop setprop
  pdb @ "qmorph " morph @ strcat force
 then

 loc @ pdb @ me @ name " animates " pdb @ name "." strcat strcat strcat
  notify_except
 pdb @ "_unanim/anim" getprop var! msg
 msg @ if
  me @ msg @ pronoun_sub msg !
  pdb @ msg @ notify
 then
 pdb @ "_unanim/oanim" getprop var! msg
 msg @ if
  me @ msg @ pronoun_sub msg !
  loc @ pdb @ pdb @ name " " msg @ strcat strcat notify_except
 else
 then
;

: unanim-check
 var! pdb
 pdb @ "_unanim/~inanimate" getprop if
  pdb @ name " is already inanimate!" strcat .tell
 else
  pdb @ unanim
 then
;

: anim-check
 var! pdb
 pdb @ "_unanim/~inanimate" getprop if
  pdb @ anim
 else
  pdb @ name " is already animate!" strcat .tell
 then
;

: do-player
 var! pdb
 command @ tolower case
  "unan" 4 strncmp not when pdb @ unanim-check end
  "anim" 4 strncmp not when pdb @   anim-check end
 endcase
;

: do-player-check ( s -- )
 pmatch var! pdb
 pdb @ #-1 = if
  "That's not a player!" .tell
 else
  loc @ contents_array pdb @ array_findval array_count not if
   pdb @ name " isn't here!" strcat .tell
  else
   pdb @ "_unanim/consent" getprop dup if
    "yes" stringcmp not if
     pdb @ do-player
    else
     pop pdb @ name " can't be unanimated by others." strcat .tell
    then
   else
    pop pdb @ name " can't be unanimated by others." strcat .tell
   then
  then
 then
( command @ case
  "unanimate" stringcmp not when "Unanimating..." .tell unanim end
  "animate" stringcmp not when "Animating..." .tell anim end
 endcase )
;

: do-help
 "-- Unanimate 0.1: Matrian@ToykinMuck ----------------------------------" .tell
 "This program lets your animation be controlled by others.  When you get" .tell
 "unanimated, you are unable to talk, and customized messages can be sent" .tell
 "to the room you're in, telling how the unanimation happens.            " .tell
 " " .tell
 "To unanimate someone: 'unanimate <name>'                               " .tell
 "To animate someone who's been unanimated: 'animate <name>'             " .tell
 "To let others unanimate you, type: '@set me=_unanim/consent:yes        " .tell
 " " .tell
 "Custom messages:                                                       " .tell
 "_unanim/unanim  - What you see when you're unanimated.                 " .tell
 "_unanim/ounanim - What others see when you're unanimated.              " .tell
 "_unanim/anim    - What you see when you're animated.                   " .tell
 "_unanim/oanim   - What others see when you're animated.                " .tell
 "The others messages are prepended with your name.                      " .tell
 "All the above can use pronoun substitutions, which are replaced by the " .tell
 "appropriate pronouns for the person unanimating you.                   " .tell
 "-----------------------------------------------------------------------" .tell
;

: main
 var! arg
 arg @ case
  ""      stringcmp not when
   "Do that to who? \(#help prints a help message\)" .tell end
  "#help" stringcmp not when
   do-help end
  default arg @ do-player-check end
 endcase
;
.
c
q