if 0 {
Brian Theado - 10/16/03 - Glenn and Janet Doman's How To Teach Your Baby To Read [L1 ] describes a method to teach infants and young children under 6 years old to read. The book suggests that since we start exposing infants to the spoken language as soon as they are born, then why not do the same with written words. Young children have a much greater capacity to learn than older children, so why not teach them to read when they are younger when they will have an easier time of it rather than wait until they enter school and their capacity to learn is less.
I have a 2 year old daughter and after reading this book decided to give it a try. In order to accomodate the underdeveloped visual pathway of infants and young children, the author suggests making flashcards out of posterboard using very large, red letters. Not keen on spending the time creating hundreds of such flashcards, I decided to write a Tk script to help display words as large as possible on the computer.
The resulting script below, displays the given list of words (or phrases) one at a time using the maximum font size that will still fit on the screen. Pressing <Return> will invoke the Next button. Pressing return on the last word closes the window.
The book has much more to say about how to do it and I recommend reading it. }
package require Tk
proc getBestFitFontSize {win fontFamilyName words} {
# Get the size of the screen. Allow some room on the sides to ensure
# the word doesn't wrap
set maxWidth [expr [winfo screenwidth $win] - 15]
# Initial size guess based on the number of letters in the given words.
# The -1 is to make sure the initial guess is too big
set avgLetters [expr [string length [join $words {}]] / [llength $words] - 1]
if {$avgLetters == 0} {incr avgLetters}
set sizeGuess [expr $maxWidth / $avgLetters]
set font [list $fontFamilyName $sizeGuess]
set sizes {}
# Find the word that takes the most space and find how much space it take
foreach word $words {
lappend sizes [font measure $font $word]
}
set maxSize [lindex [lsort -integer -decreasing $sizes] 0]
set maxIdx [lsearch $sizes $maxSize]
set biggestWord [lindex $words $maxIdx]
# Shrink the size until the width of the biggest word fits
while {$maxSize > $maxWidth} {
incr sizeGuess -10 ;# Binary search would be more efficient. Not interested in making the effort
set font [list $fontFamilyName $sizeGuess]
set maxSize [font measure $font $biggestWord]
}
# If all the words are short (3 letters or so), then the result will tend
# to be a bit too large height-wise. Adjust if needed.
set height [expr [font metrics $font -ascent] + [font metrics $font -descent]]
set maxHeight [expr [winfo screenheight .] - 100] ;# 100 was chosen without any investigation if it is reasonable
while {$height > $maxHeight} {
incr sizeGuess -10
set font [list $fontFamilyName $sizeGuess]
set height [expr [font metrics $font -ascent] + [font metrics $font -descent]]
}
return $sizeGuess
}
proc ::showNextWord {wordList} {
# Replace the text in the text widget with the next word on the list
.words.t delete 1.0 end
.words.t insert 1.0 [lindex $wordList 0] centered
# Remove that word from the list. Rewrite the button callback so it
# contains the updated word list. Give a hint of the next word in the
# button text
set newWordList [lrange $wordList 1 end]
if {[llength $newWordList] > 0} {
.words.next configure -text "Next: [lindex $newWordList 0]" -command [list showNextWord $newWordList]
} else {
.words.next configure -text Close -command {destroy .words}
}
}
proc showWordSlideShow {wordList} {
toplevel .words
focus -force .words
# Maximize the window. From http://wiki.tcl.tk/2233
wm overrideredirect .words 1; wm geometry .words [join [wm maxsize .] x]+0+0
# Pick the font and size and create widgets
set font {Times New Roman}
set fontSize [getBestFitFontSize .words $font $wordList]
pack [::text .words.t -font [list $font $fontSize] -foreground red -height 1]
pack [button .words.next]
# Convenient, mouse-free operation
bind .words <Return> {.words.next invoke}
.words.t tag configure centered -justify center
# Start the slideshow
showNextWord $wordList
}
# Some test code
wm withdraw .
showWordSlideShow {applesauce banana car house pig}