@prog muffle.muf
1 99999 d
1 i
( Muffle by Warwick on FurryMUCK. Requested by SquirtJr.
  ------
  Randomly replaces letters in the said string with a specified character.
`
  sayfilter prob [prob]  {maximum desired probability as a %age}
  sayfilter char [char]  {{single} char to replace}
)
: makeprop ( n db ch "prop/ch/n/???" -- n db ch "prop/<ch>/<n>/???" )
  over "*ch*" subst
  4 pick intostr "*n*" subst
;
: probability ( n db ch message cmd -- n notify "" )
  "_say/*ch*/*n*/" swap strcat swap
  -5 rotate makeprop
  5 rotate dup " " instr dup if       ( Command has a parameter )
    strcut swap pop
( n db ch "_say/ch/n/cmd" "param" )
    atoi intostr
( n db ch "_say/ch/n/cmd" "param" )
    4 pick 3 pick rot 0 addprop
  else pop pop then
( n db ch "_say/ch/n/cmd" )
  swap pop getpropstr
( n prop )
  "Muffle: Probability is nnn%" swap "nnn" subst ""
;
: character ( n db ch message cmd -- n notify "" )
  "_say/*ch*/*n*/" swap strcat swap
  -5 rotate makeprop
  5 rotate dup " " instr dup if       ( Command has a parameter )
    strcut swap pop
( n db ch "_say/ch/n/cmd" "param" )
    1 strcut pop
( n db ch "_say/ch/n/cmd" "param" )
    4 pick 3 pick rot 0 addprop
  else pop pop then
( n db ch "_say/ch/n/cmd" )
  swap pop getpropstr
( n prop )
  "Muffle: Character is 'ch'" swap "ch" subst ""
;
: cmd-try ( n db ch message 'cmd cmd -- n db ch message 0 )
          ( n db ch message 'cmd cmd -- n notify "" 1 1   )
  dup 4 pick tolower over strlen strncmp if pop pop 0 exit then
  swap execute 1 1
;
: start ( n db ch message -- n db ch message 0 )
        (                 -- n notify "" 1     )
  command @ "sayfilter" stringcmp not if
    'probability "prob" cmd-try if exit then
    'character   "char" cmd-try if exit then
    0 exit
  then
( n db ch mess )
  -4 rotate
( mess n db ch )
  "_say/*ch*/*n*/char" makeprop 3 pick swap getpropstr
  dup not if pop "." then
  -4 rotate
  "_say/*ch*/*n*/prob" makeprop 3 pick swap getpropstr
  dup not if pop 25 else atoi then
  5 rotate 6 rotate "" swap
( n db ch prob "c" "" mess )
  begin
    dup while
    1 strcut swap
( n db ch prob "c" "" ess m )
    dup tolower "etaoinshrdluckgymfbwpvjqxz" swap instr if
( n db ch prob "c" "" ess m )
      random 100 % 6 pick < if pop 3 pick then
    then
    rot swap strcat swap
  repeat
( n db ch prob "c" mess "" )
  pop swap pop swap pop 0
( n db ch message 0 )
;
77 lines displayed.
.
c
q
@register #me muffle.muf=tmp/prog1
@set $tmp/prog1=L
@set $tmp/prog1=2
@propset $tmp/prog1=str:/_/de:A scroll containing a spell called muffle.muf
@propset $tmp/prog1=str:/_help/1#:19
@propset $tmp/prog1=str:/_help/1#/1:------------------------------------------------------------------------------
@propset $tmp/prog1=str:/_help/1#/10: sayfilter <ch> prob[.n] 23   sets the replace probability on <ch>.n to 23
@propset $tmp/prog1=str:/_help/1#/11:`
@propset $tmp/prog1=str:/_help/1#/12: Typically, you would use this on a room, and would only need to issue
@propset $tmp/prog1=str:/_help/1#/13:`
@propset $tmp/prog1=str:/_help/1#/14: sayfilter here fadd muffle
@propset $tmp/prog1=str:/_help/1#/15: sayfilter here char -
@propset $tmp/prog1=str:/_help/1#/16: sayfilter here prob 23
@propset $tmp/prog1=str:/_help/1#/17: (to remove) sayfilter here ftake muffle
@propset $tmp/prog1=str:/_help/1#/18:`
@propset $tmp/prog1=str:/_help/1#/19:-----------------------------------------------------------------------------
@propset $tmp/prog1=str:/_help/1#/2:Muffle can replace every letter in a string with a given character, on a given
@propset $tmp/prog1=str:/_help/1#/3: probability. That is,
@propset $tmp/prog1=str:/_help/1#/4:`
@propset $tmp/prog1=str:/_help/1#/5: This is a test.   -->  T..s .. a ..st.
@propset $tmp/prog1=str:/_help/1#/6:`
@propset $tmp/prog1=str:/_help/1#/7: Note that only letters are replaced. Punctuation and numbers are unaffected.
@propset $tmp/prog1=str:/_help/1#/8:`
@propset $tmp/prog1=str:/_help/1#/9: sayfilter <ch> char[.n] -    sets the replace character on <ch>.n to '-'