[Keith Vetter] 2003-11-12 : Babelfish is sorely missing a key language, one known to many school kids, and that's Pig Latin. Luckily tcl can come to the rescue. Everything you type into the left text box will be automatically translated into Pig Latin in the right text box. It only works with ASCII characters and is not the smartest about deciding what exactly is a word but that's left as an exercise for the reader. ---- ##+########################################################################## # # piglatin.tcl -- translates english text into pig latin # by Keith Vetter, Nov 12, 2003 # package require Tk package require textutil proc PigLatinizeWord {word} { if {! [regexp -nocase {^[a-z]} $word]} { return $word } ;# Not alpha # Tricky part is keeping case consistent set case tolower if {[regexp {^[A-Z]} $word]} {set case totitle} if {[regexp {^[A-Z]{2,}} $word]} {set case toupper} if {[regexp -nocase {^[aeiou]} $word]} { set word "w$word"} ;# Initial vowel regexp -nocase {^([^aeiou][^aeiouy]*)(.*)} $word => head body set piglatin "$body${head}ay" return [string $case $piglatin] } proc DoText {} { set txt [string trimright [.tplain_org get 1.0 end]] # Not the smartest way to split into words but simple and good enough set words [::textutil::splitx $txt {(\W)}] ;# Split into words .tpig config -state normal .tpig delete 1.0 end foreach word $words { .tpig insert end [PigLatinizeWord $word] } .tpig config -state disabled } proc DoDisplay {} { wm title . "English to Pig Latin Translation" label .lplain -text "Plain Text" .lplain configure -font "[font actual [.lplain cget -font]] -weight bold" label .lpig -text "Pig Latin Text" .lpig configure -font "[font actual [.lpig cget -font]] -weight bold" text .tplain -width 50 -height 30 -wrap word text .tpig -width 50 -height 30 -wrap word -bg #dbe1ff -state disabled canvas .plain2pig -width 40 -height 20 -bd 0 -highlightthickness 0 .plain2pig create line 5 10 35 10 -tag z -arrow last -width 5 grid .lplain x .lpig -row 0 grid .tplain x .tpig -sticky news grid config .plain2pig -row 1 -column 1 -padx 5 grid columnconfig . {0 2} -weight 1 grid rowconfig . 1 -weight 1 focus .tplain rename .tplain .tplain_org proc .tplain {cmd args} { set rval [eval .tplain_org $cmd $args] if {$cmd == "insert" || $cmd == "delete"} { DoText } return $rval } } DoDisplay set sample {NAME Tcl - Tool Command Language SYNOPSIS Summary of Tcl language syntax. DESCRIPTION The following rules define the syntax and semantics of the Tcl language: [1] Commands. A Tcl script is a string containing one or more commands. Semi-colons and newlines are command separators unless quoted as described below. Close brackets are command terminators during command substitution (see below) unless quoted. ... } .tplain insert end $sample ---- [RS]: Super-cute! ---- [Tcl and other languages]