( This program written by Sjade of HoloMUCK.  It is considered )
( shareware under the provisions in README.  This program will )
( run without alteration on all MUCK systems, but be warned it )
( does not handle punctuation effectively.  The best way this  )
( program works is to set it up as a macro called impede_str   )
( of the format [ s -- s ].                                    )
()
: say
exit
;
: do_lisp
"th" "ss" subst
"th" "s" subst
"Th" "S" subst
say
;
: dipthong?
"/" strcat "/" swap strcat
"/wh//th//sh//ph//ch//cz//tr//sp//sm/" swap instr
;
: do_repair
dup 0 = if pop exit then
swap " " strcat rot strcat -2 rotate
1 - do_repair
;
: prefix_stutter
dup 0 = if pop exit then
swap dup 2 strcut pop dipthong? if
2 strcut else 1 strcut then
swap dup "-" strcat swap strcat
swap strcat swap 1 - prefix_stutter
;
: do_stutter
dup 0 = if
pop depth rotate 1 - do_repair say exit then
random 2 % if
dup 1 + rotate
random 3 % 1 + prefix_stutter
over 1 + 0 swap - rotate
then
1 - do_stutter
;
: do_elmer
"w" "rr" subst
"w" "r" subst
"W" "R" subst
say
;
: do_backwards_loop
dup 0 = if pop pop exit then
swap over 1 - strcut
4 rotate swap strcat
swap rot 1 - do_backwards_loop
;
: do_backwards
dup strlen "" rot rot do_backwards_loop
say
;
: do_wacky_loop
dup 0 = if pop exit then
random over % 2 + rotate
over 2 + rotate swap strcat " " strcat
over 1 + 0 swap - rotate
1 - do_wacky_loop
;
: do_wacky
" " explode dup 0 = if pop say exit then
"" over 2 + 0 swap - rotate
do_wacky_loop
dup strlen 1 - strcut pop
say
;
: prefix_piglatin
dup 1 strcut pop "aeiouAEIOU" swap instr
over strlen 1 = or if
"-bay" strcat exit then
dup 2 strcut pop dipthong? if
2 strcut else 1 strcut then
swap "-" swap strcat "ay" strcat strcat
;
: do_piglatin
dup 0 = if
pop depth rotate 1 - do_repair say exit then
dup 1 + rotate
prefix_piglatin
over 1 + 0 swap - rotate
1 - do_piglatin
;
: do_mixedcase_loop
dup 0 = if pop exit then
over over strcut
1 strcut swap
random 2 % not if toupper else tolower then
swap strcat strcat rot pop swap 1 - do_mixedcase_loop
;
: do_mixedcase
dup strlen do_mixedcase_loop
say
;
: main
me @ "_impediment" getpropstr
dup "lisp" stringcmp not if pop do_lisp exit then
dup "stutter" stringcmp not if pop
" " explode
dup 0 = if pop say exit then
dup dup 2 + 0 swap - rotate do_stutter exit then
dup "elmer" stringcmp not if pop do_elmer exit then
dup "backwards" stringcmp not if pop do_backwards exit then
dup "wacky" stringcmp not if pop do_wacky exit then
dup "piglatin" stringcmp not if pop
" " explode
dup 0 = if pop say exit then
dup dup 2 + 0 swap - rotate do_piglatin exit then
dup "mixedcase" stringcmp not if pop do_mixedcase exit then
pop
;