Slideshow of words for teaching reading

Brian Theado 2003-10-16: Glenn and Janet Doman's How To Teach Your Baby To Read [1] 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}

RS: My daughters are out of that age now, but my 13yo still enjoys teaching programs I hack for her in Tcl (vocabulary trainer, math trainer), even more if I add multimedial elements: play sounds (applause or short phrases), or display images. In this case it might be extremely didactic if large images of the object in question are shown (use Img for JPEGs), the word spelled out, and even the pronunciation played as sound clip... I do that on Win 95 with

   exec sndrec32 /play /close [file nativename $f] &

Why call sndrec and not use the snack package?

Category Application

Category Multimedia