Posted to tcl by kostix at Sun Aug 24 23:17:10 GMT 2008view raw

  1. proc foo text {
  2. set words [list]
  3. set pos 0
  4. while {[regexp -indices -start $pos {[^[:punct:]\s]+} $text match]} {
  5. lappend words $match
  6. lassign $match -> pos; incr pos
  7. }
  8. set nwords [llength $words]
  9. array set seen {}
  10. set out $text
  11. for {set i 0} {$i <= int(rand() * $nwords)} {incr i} {
  12. while 1 {
  13. set ix [expr {int(rand() * $nwords)}]
  14. if {![info exists seen($ix)]} break
  15. }
  16. set seen($ix) yo!
  17. lassign [lindex $words $ix] a b
  18. set out [string replace $out $a $b [string repeat * [expr {$b - $a + 1}]]]
  19. }
  20. set out
  21. }