##+##########################################################################
 #
 # CanYouReadThis.tcl -- Mixes up all but the first and last letter in a word
 # by Keith Vetter, December 18, 2004
 #
 package require Tk
 package require textutil
 
 set S(title) "Can You Read This?"
 
 set txt "According to research at Cambridge University, it doesn't matter \
 what order the letters in a word are, the only important thing is that the \
 first and last letters are at the right place. The rest can be a total mess \
 and you can still read it without a problem. This is because we do not read \
 every letter by itself but the word as a whole."
    
 proc DoDisplay {} {
    global S
 
    wm title . $S(title)
    text .ptext -wrap word
    .ptext configure -font "[font actual [.ptext cget -font]] -size 10 -weight bold"
    text .mtext -wrap word -font [.ptext cget -font]
    button .mix -text " ==> " -command Mix
    .mix configure -font "[font actual [.mix cget -font]] -weight bold"
 
    frame .buttons
    button .quit -text "Quit" -command exit
    button .about -text About -command About
    
    grid .ptext .mix .mtext
    grid .buttons - - -sticky ew
    grid x .about .quit -in .buttons -padx 10 -pady 5
    grid columnconfigure .buttons 0 -weight 1
    grid columnconfigure .buttons {1 2} -uniform a
    
    bind all <Key-F2> {console show}
    .ptext insert end $::txt
    Mix
 }
 proc About {} {
    set pre "$::S(title)\nby Keith Vetter\nDecember 2004\n\n"
    set txt "Folklore says that you can understand text even if all\n"
    append txt "the letters in the words are mixed up provided that the\n"
    append txt "first and last letters are correct."
    set txt [MixWords $txt]
    tk_messageBox -message "$pre$txt" -title "About $::S(title)"
 }
 
 proc Mix {} {
    set txt [.ptext get 0.0 end]
    set mix [MixWords $txt]
    .mtext delete 0.0 end
    .mtext insert end $mix
 }
 proc MixWords {txt} {
    set result ""
    
    # Not the smartest way to split into words but simple and good enough
    set words [::textutil::splitx $txt {(\W)}]  ;# Split into words
    foreach word $words {
        set mword [MixWord $word]
        append result $mword
    }
    return $result
 }
 proc MixWord {word} {
    set len [string length $word]
    if {$len == 0 || [string match " *" $word]} {
        return $word
    }
    set txt [string range $word 1 end-1]
    set mix [shuffle $txt]
    set new [string replace $word 1 end-1 $mix]
    return $new
 }
 proc shuffle {str} {
    set llist [split $str ""]
    set len [llength $llist]
    set len2 $len
    for {set i 0} {$i < $len-1} {incr i} {
        set n [expr {int($i + $len2 * rand())}]
        incr len2 -1
        
        # Swap elements at i & n
        set temp [lindex $llist $i]
        lset llist $i [lindex $llist $n]
        lset llist $n $temp
    }
    return [join $llist ""]
 }
 DoDisplay