@program #95
1 10000 d
i
$include $lib/lmgr
$include $lib/case
$include $lib/editor

( loxstuff )
$include $lib/loxorion
$def notify parse_ansi_fb6 \notify

: DoEditLoop  ( listname dbref {rng} mask currline cmdstring  --  )
                                        (* read input for list editor *)
  EDITORloop
  dup "save" stringcmp not if
    pop pop pop pop
    3 pick 3 + -1 * rotate
    over 3 + -1 * rotate
    dup 5 + pick over 5 + pick
    over over LMGR-DeleteList
    1 rot rot LMGR-PutRange
    4 pick 4 pick LMGR-GetList
    dup 3 + rotate over 3 + rotate
    ">>  List saved." .tell
    "" DoEditLoop exit
  then
  dup "abort" stringcmp not if
    ">>  List not saved." .tell
    pop pop pop pop pop pop pop pop pop exit
  then
  dup "end" stringcmp not if
    pop pop pop pop pop pop
    dup 3 + rotate over 3 + rotate
    over over LMGR-DeleteList
    1 rot rot LMGR-PutRange
    ">>  List saved." .tell exit
  then
;

: DoEditList  ( d s --  )                         (* edit list s on d *)

  swap
">>  Welcome to the description editor.  This is where you type up   " .tell
">>  your character description.  This is a multi-line editor so your" .tell
">>  description can be as long as you want.  You can Get help on the" .tell
">>  use of this editor by typing .h on a line of its own.  To save  " .tell
">>  description and exit, type .end or .save to store your work and " .tell
">>  continue editing.                                               " .tell
  over over LMGR-GetList
  "save" 1 ".i $" DoEditLoop
;

: do-desc-list
 me @ "redesc" DoEditList
;

: do-desc-simple
 "List format descs allow your desc to cover multiple lines/paragraphs, and be as long as you want." .tell
 "Would you like to convert your desc to list format? (yes/no)" .tell
 read tolower "y" 1 strncmp not if
  me @ desc var! mydesc
  me @ "{eval:{list:redesc}{look-notify}}" setdesc
  me @ "redesc" { mydesc }list array_put_proplist
  "Desc converted." .tell
  do-desc-list
  exit
 then
 "Enter your desc or . to abort" .tell
 read var! arg
 arg @ "." strcmp not if "Aborted." .tell exit then
 me @ arg @ setdesc
;

: do-desc
 me @ desc "redesc" instr if
  do-desc-list
 else
  do-desc-simple
 then
;

: do-sex
 "Enter your sex or . to abort" .tell
 read var! arg
 arg @ "." strcmp not if "Aborted." .tell exit then
 me @ "sex" arg @ setprop
;

: do-spec
 "Enter your species or . to abort" .tell
 read var! arg
 arg @ "." strcmp not if "Aborted." .tell exit then
 me @ "species" arg @ setprop
;

: do-toy-animcon
 me @ "_unanim/consent" getprop var! prop
 prop @ if
  prop @ "yes" stringcmp not if
   me @ "_unanim/consent" remove_prop
   "You can no longer be unanimated." .tell exit
  then then
 me @ "_unanim/consent" "yes" setprop
 "You can now be unanimated." .tell
;

: do-toy-pickup
 me @ "_pickup_ok?" getprop var! prop
 prop @ if
  prop @ "yes" stringcmp not if
   me @ "_pickup_ok?" remove_prop
   "You can no longer be picked up." .tell exit
  then then
 me @ "_pickup_ok?" "yes" setprop
 "You can now be picked up." .tell
 "You can specify particular players who are the only ones allowed to pick you up, or allow anyone to pick you up." .tell
 "Do you want anyone to be able to pick you up? (yes/no)" .tell
 read tolower "y" 1 strncmp not if
  "Allowing anyone to pick you up.  See 'pickup #help' for more info." .tell
  me @ "prefs/pickuplock" 1 setprop
  me @ "prefs/pickuplock/all" 1 setprop
 else
  "Type 'pickup #help' to see how to allow specific players." .tell
 then
;

: do-toy-leash
 me @ "_leash_ok?" getprop var! prop
 prop @ if
  prop @ "yes" stringcmp not if
   me @ "_leash_ok?" remove_prop
   "You can no longer be leashed." .tell exit
  then then
 me @ "_leash_ok?" "yes" setprop
 "You can now be leashed." .tell
 "You can specify particular players who are the only ones allowed to leash you, or allow anyone to pick you up." .tell
 "Do you want anyone to be able to leash you? (yes/no)" .tell
 read tolower "y" 1 strncmp not if
  "Allowing anyone to leash you.  See 'leash #help' for more info." .tell
  me @ "prefs/leashlock" 1 setprop
  me @ "prefs/leashlock/all" 1 setprop
 else
  "Type 'leash #help' to see how to allow specific players." .tell
 then
;

: do-toy-anim
 "Type what you want to see when someone animates you, or . to abort." .tell
 "%N in the message will be replaced by their name, and other pronoun substitutions will use their info" .tell
 read var! arg
 arg @ "." strcmp not if "Aborted." .tell exit then
 me @ "_unanim/anim" arg @ setprop
;

: do-toy-oanim
 "Type what you want others to see when someone animates you, or . to abort." .tell
 "Your name will be added at the beginning of the message.  Don't type it yourself." .tell
 "%N in the message will be replaced by the name of the one animating you, and other pronoun substitutions will use their info"  .tell
 read var! arg
 arg @ "." strcmp not if "Aborted." .tell exit then
 me @ "_unanim/oanim" arg @ setprop
;

: do-toy-unanim
 "Type what you want to see when someone unanimates you, or . to abort." .tell
 "%N in the message will be replaced by their name, and other pronoun substitutions will use their info" .tell
 read var! arg
 arg @ "." strcmp not if "Aborted." .tell exit then
 me @ "_unanim/unanim" arg @ setprop
;

: do-toy-ounanim
 "Type what you want others to see when someone unanimates you, or . to abort." .tell
 "Your name will be added at the beginning of the message.  Don't type it yourself." .tell
 "%N in the message will be replaced by the name of the one unanimating you, and other pronoun substitutions will use their info"  .tell
 read var! arg
 arg @ "." strcmp not if "Aborted." .tell exit then
 me @ "_unanim/ounanim" arg @ setprop
;

: do-toy-morph
 "Type the morph command you want to happen when you're animated or unanimated (whichever you're not, now).  You'll change back to your current morph when you're animated again." .tell
 "If it's unset, you'll still be animated/unanimated, your desc just won't change."
 "Type . to abort, or .. to unset."
 read var! arg
 arg @ "." strcmp not if "Aborted." .tell exit then
 arg @ ".." strcmp not if me @ "_unanim/morph" remove_prop "Cleared." .tell exit then
 me @ "_unanim/morph" arg @ setprop
;

: get-toy-anim
 me @ "_unanim/anim" getprop dup not if pop "-unset-" then
;

: get-toy-oanim
 me @ "_unanim/oanim" getprop var! prop
 prop @ not if
  "-unset-"
 else
  me @ name " " prop @ strcat strcat
 then
;

: get-toy-unanim
 me @ "_unanim/unanim" getprop dup not if pop "-unset-" then
;

: get-toy-ounanim
 me @ "_unanim/ounanim" getprop var! prop
 prop @ not if
  "-unset-"
 else
  me @ name " " prop @ strcat strcat
 then
;

: get-toy-morph
 me @ "_unanim/morph" getprop var! prop
 prop @ not if
  "-unset-"
 else
  prop @
 then
;

: do-toy-msgs
 begin
  " " .tell
  "Editing animation options" .tell
  "1. When you're animated, you see:" .tell get-toy-anim .tell
  "2. When you're animated, others see:" .tell get-toy-oanim .tell
  "3. When you're unanimated, you see:" .tell get-toy-unanim .tell
  "4. When you're unanimated, others see:" .tell get-toy-ounanim .tell
  "5. When you're animated/unanimated, you'll change to this morph:" .tell
  get-toy-morph .tell
  " " .tell
  "Choose 1-5 to edit, or Q to quit. Your choice?" .tell read var! opt
  " " .tell
  opt @ "q" stringcmp not if
   "Done." .tell exit then
  opt @ atoi case
   1 = when do-toy-anim    end
   2 = when do-toy-oanim   end
   3 = when do-toy-unanim  end
   4 = when do-toy-ounanim end
   5 = when do-toy-morph end
   default "Please pick a menu option, or Q to quit." .tell end
  endcase
 repeat
;

: get-unanim
 me @ "_unanim/consent" getprop var! prop
 prop @ not if "You cannot be unanimated." exit then
 prop @ "yes" stringcmp not if
  "You can be unanimated."
 else
  "You cannot be unanimated."
 then
;

: get-pickup
 me @ "_pickup_ok?" getprop var! prop
 prop @ not if "You cannot be picked up." exit then
 prop @ "yes" stringcmp not if
  "You can be picked up."
 else
  "You cannot be picked up."
 then
;

: get-leash
 me @ "_leash_ok?" getprop var! prop
 prop @ not if "You cannot be leashed." exit then
 prop @ "yes" stringcmp not if
  "You can be leashed."
 else
  "You cannot be leashed."
 then
;

: do-toy
 begin
  " " .tell
  "Editing toy options" .tell
  "1. " get-pickup strcat .tell
  "2. " get-leash  strcat .tell
  "3. " get-unanim strcat .tell
  "4. Edit animation/unanimation messages" .tell
  " " .tell
  "Choose 1-4 to edit, or Q to quit. Your choice?" .tell read var! opt
  " " .tell
  opt @ "q" stringcmp not if
   "Done." .tell exit then
  opt @ atoi case
   1 = when do-toy-pickup  end
   2 = when do-toy-leash   end
   3 = when do-toy-animcon end
   4 = when do-toy-msgs    end
   default "Please pick a menu option, or Q to quit." .tell end
  endcase
 repeat
;

: show-desc
 me @ desc "redesc" instr if
  "1. Your description (list format):" .tell
  me @ "redesc" array_get_proplist
  foreach
   .tell
  repeat
 else
  "1. Your description (single-line format):" .tell
  me @ desc .tell
 then
;

: get-sex
 me @ "sex" getprop
 dup not if pop "-unset-" else then
;

: get-species
 me @ "species" getprop
 dup not if pop "-unset-" else then
;

( lox's section for color and say customs! )
: hello-kitty[ str:prop -- str:result ]
me @ prop @ getprop dup var! color if
 { "^" color @ "^" color @ toupper color.normal }cat
else
 { "DEFAULT" }cat
then
;

: do-color
var color
var option
begin
{
{ "0. ANSI color is " me @ "C" flag? if "ON" else "OFF" then "." }cat
{ "1. LOOK:    Player name color is       " "_prefs/color/player" hello-kitty }cat
{ "2. LOOK:    Room name color is         " "_prefs/color/room" hello-kitty }cat
{ "3. LOOK:    Exit name color is         " "_prefs/color/exit" hello-kitty }cat
{ "4. LOOK:    Status color is            " "_prefs/color/stat" hello-kitty }cat
{ "5. LOOK:    Other object color is      " "_prefs/color/obj" hello-kitty }cat
{ "Q. Return to main menu" }cat
}array atellme
{ "Please select an option: " }cat tellme read option !
option @ case
 "0" smatch when 
  me @ "C" flag? if
   me @ "!C" set
   { "You have turned ANSI color off.  Living in a monochrome world again." }tell
  else
   me @ "C" set
  { "You have turned ANSI color ^BRED^^YELLOW^on^NORMAL^. You will see the world in ^RED^c^YELLOW^o^GREEN^l^BLUE^o^CYAN^r^NORMAL^." }tell
  then
 end
 "{1|2|3|4|5}" smatch when 
  color-list
  option @ case
   "1" smatch when { "Please enter the color you would like players to show up as when you look at things:" }tell end
   "2" smatch when { "Please enter the color you would like rooms to show up as when you look at things:" }tell end
   "3" smatch when { "Please enter the color you would like exits to show up as when you look at things:" }tell end
   "4" smatch when { "Please enter the color you would like player statuses to show up as when you look at things:" }tell end
   "5" smatch when { "Please enter the color you would like other objects to show up as when you look at things:" }tell end
  endcase
  read dup color ! color-validate not if
   "That is not a valid color." tellme
  else
   me @ 
   option @ case
    "1" smatch when "_prefs/color/player" end
    "2" smatch when "_prefs/color/room" end
    "3" smatch when "_prefs/color/exit" end
    "4" smatch when "_prefs/color/stat" end
    "5" smatch when "_prefs/color/obj" end
   endcase
   color @ dup "." smatch if pop 0 then setprop 
  then
 end
 "Q" smatch when exit end
endcase
repeat
;

: do-say
var verb
var option
begin
{
{ "1. SAY: When you speak, you see    [You " me @ "_say/def/say" getprop dup not if pop "say" then ", \"<text>\"]" }cat
{ "2. SAY: When you speak, others see [" me @ " " me @ "_say/def/osay" getprop dup not if pop "says" then ", \"<text>\"]" }cat
{ "Q. Return to main menu" }cat
}array atellme
{ "Please select an option: " }cat tellme read option !
option @ case
 "{1|2}" smatch when 
  option @ case
   "1" smatch when { "Please enter the verb you want to see when you speak (example 'say') or '.' to clear:" }tell end
   "2" smatch when { "Please enter the verb you want others to see when you speak (example 'says') or '.' to clear:" }tell end
  endcase
  read verb ! me @ 
  option @ case
   "1" smatch when "_say/def/say" end
   "2" smatch when "_say/def/osay" end
  endcase
  verb @ dup "." smatch if pop 0 then setprop 
 end
 "Q" smatch when exit end
endcase
repeat
;

: main[ args -- ]
 begin
  " " .tell
  "EditToy.muf" .tell
  show-desc
  "2. Your sex is " get-sex "." strcat strcat .tell
  "3. Your species is " get-species "." strcat strcat  .tell
  "4. Edit toy/consent options" .tell
  "5. Edit color options" .tell
  "6. Edit say options" .tell
  " " .tell
  "Choose 1-6 to edit, or Q to quit. Your choice?" .tell read var! opt
  " " .tell
  opt @ "q" stringcmp not if
   "Done." .tell exit then
  opt @ atoi case
   1 = when do-desc   end
   2 = when do-sex    end
   3 = when do-spec   end
   4 = when do-toy    end
   5 = when do-color  end
   6 = when do-say    end
  default "Please pick a menu option, or Q to quit." .tell end
  endcase
 repeat
;
.
c
q