[Keith Vetter] 2009-10-10 -- several years ago I was an avid cryptogram
solver. I used a program called CryptoAid that helped in solving the
puzzle--not by any fancy solving logic but simply by doing the tedious
grunt work enabling you to try different possible solutions.

Recently I wanted to try my hand again at cryptograms but when I dug
out CryptoAid it wouldn't run anymore (missing some VB libraries). A
cursory Google check lead only to dead links. So I thought it would
be fun to spend a few hours and rewrite it in tcl. (A later, deeper
check reveals that the program is still maintained and available
at http://www.rrufer.com.)

You can type in a cryptogram puzzle from, say, the local paper or
can use one of the 500 built-in puzzles. There's also an option
to scrap the day's puzzle from my cryptogram website, 
Cryptogram Corner [http://www.geocities.com/cryptogramcorner/].

----
[WikiDbImage cryptoAid_screen.png]
----
======
##+##########################################################################
#
# CryptoAid -- tcl port of VB CryptoAid program
# by Keith Vetter, Oct 2009
#

package require Tcl 8.5
package require Tk
package require textutil
package require http

set C(title) CryptoAid
set C(height) 300
set C(undo) {}
set C(CipherLines) 4

set AB {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
if {"myFont" in [font names]} { font delete myFont }
font create myFont -family Courier -size 12 -weight bold

proc DoDisplay {} {
    global C

    wm title . $C(title)
    . config -padx .1i -pady .1i
    ::ttk::frame .txt
    canvas .c -width 0 -height $C(height) -highlightthickness 0
    ::ttk::frame .ctrl
    DoCanvas

    pack .txt -side top -fill both
    pack .c -side left -fill both
    pack .ctrl -side bottom -padx {.1i 0} -fill y -expand 1

    # Control panel
    ::ttk::label .ctrl.info -textvariable ::C(sample,info)
    ::ttk::button .ctrl.retype -text Edit -command GetCipherText
    ::ttk::button .ctrl.help -text Help -command Help
    ::ttk::button .ctrl.erase -text Erase -command Erase
    ::ttk::label .ctrl.l1 -text "Type-In\nFields" -font myFont
    entry .ctrl.key1 -width 2 -font myFont -textvariable C(key1) -justify center
    entry .ctrl.key0 -width 2 -font myFont -textvariable C(key0) -justify center
    focus .ctrl.key1
    foreach var {key0 key1} {
        foreach tr [trace vinfo C($var)] {
            eval trace vdelete C($var) $tr
        }
        trace variable C($var) w KeyTrace
    }

    pack .ctrl.key0 -side bottom
    pack .ctrl.key1 -side bottom -pady {0 5}

    set pady .01i
    pack .ctrl.l1 -side bottom -pady {.1i 0}
    pack .ctrl.erase -side bottom -pady $pady
    pack .ctrl.help -side bottom -pady $pady
    pack .ctrl.retype -side bottom -pady $pady
    pack .ctrl.info -side top

    # Solution window
    set opts "-font myFont"
    append opts " -relief sunken -bd 1"
    append opts " -width 0"
    append opts " -state disabled"

    for {set row 0} {$row < $C(CipherLines)} {incr row} {
        set w .txt.f$row
        text ${w}plain {*}$opts -height 1 -foreground red
        text ${w}cipher {*}$opts -height 1
        ${w}cipher tag config highlightLetter -background cyan
        pack ${w}plain -side top -fill x
        pack ${w}cipher -side top -fill x -pady {0 .05i}
    }

    bind all <Key-F1> Help
    bind all <Key-F2> {console show}
    bind all <Control-h> Hint
    bind all <Control-s> Solution
    bind all <Control-c> CheatSheet
    bind all <Control-z> Undo
}
##+##########################################################################
#
# DoCanvas -- draws histogram and cipher/deciphered letters chart
#
proc DoCanvas {} {
    global C XY

    entry .c.c -width 2 -relief sunken -justify center -font myFont
    set eWidth [winfo reqwidth .c.c]
    set eHeight [winfo reqheight .c.c]
    set opts "-width 2 -justify center -state disabled -font myFont"
    append opts " -disabledbackground [.c.c cget -background]"
    append opts " -disabledforeground [.c.c cget -foreground]"
    destroy .c.c

    set x [expr {$eWidth/2}]
    set y0 $C(height)
    set y1 [expr {$y0 - $eHeight - 5}]
    set y2 [expr {$y1 - $eHeight - 5}]
    set XY(bottom) $y2

    foreach ch $::AB {
        set XY($ch) $x
        entry .c.c$ch {*}$opts -textvariable C(key,$ch)
        set C(key,$ch) ""
        .c create window $x $y0 -window .c.c$ch -anchor s

        entry .c.p$ch -width 2 -font myFont -justify center -relief flat \
            -disabledforeground blue -disabledbackground [.c cget -bg]
        .c.p$ch insert end $ch
        .c.p$ch config -state disabled
        bind .c.p$ch <1> [list FauxKey $ch]
        .c create window $x $y1 -window .c.p$ch -anchor s
        incr x $eWidth

    }
    .c config -width $x
}
##+##########################################################################
#
# KeyTrace -- Handles key presses in type-in fields
#
proc KeyTrace {var1 var2 op} {
    global C ch

    set ch [string toupper $C($var2)]
    if {! [string is alpha $ch]} { set ch "" }
    set C($var2) $ch

    if {$var2 eq "key1"} {                      ;# In top, focus to bottom
        if {$ch ne ""} {tk::TabToWindow .ctrl.key0}
        HighlightCipherLetter $C(key1)
        return
    }

    if {$var2 eq "key0" && $C(key1) eq ""} {    ;# In bottom, empty top : refocus
        set C(key0) ""
        tk::TabToWindow .ctrl.key1
        return
    }

    DecipherLetter $C(key1) $C(key0)
    set C(key0) ""
    set C(key1) ""
    Decipher
    tk::TabToWindow .ctrl.key1
    HighlightCipherLetter $C(key1)
    IsSolved
}
##+##########################################################################
#
# DecipherLetter -- substitutes deciphered letter for the ciphered letter
#
proc DecipherLetter {ciphered deciphered {addUndo 1}} {
    global C

    if {$C(key,$ciphered) eq $deciphered} return

    set undo {}

    foreach arr [array names C key,*] { ;# Check for already in use
        if {$C($arr) eq $deciphered && $deciphered ne ""} {
            set txt "The letter '$deciphered' has already been choosen -- Replace?"
            set n [tk_messageBox -icon question -message $txt -type yesno \
                       -title $C(title) -parent .]
            if {$n eq "no"} return

            set ch [lindex [split $arr ","] 1]
            lappend undo $ch $deciphered
            set C($arr) ""
        }
    }

    if {$addUndo} {
        set undo [list $ciphered $C(key,$ciphered) {*}$undo]
        set C(undo) [concat [list $undo] $C(undo)]
    }
    set C(key,$ciphered) $deciphered
}
##+##########################################################################
#
# Undo -- Undoes the last change
#
proc Undo {} {
    global C

    set C(undo) [lassign $C(undo) this]
    foreach {ciphered deciphered} $this {
        DecipherLetter $ciphered $deciphered 0
    }
    Decipher
    set C(key0) ""
    set C(key1) ""
    tk::TabToWindow .ctrl.key1
}
##+##########################################################################
#
# FauxKey -- Produce fake key presses based on mouse clicks
#
proc FauxKey {ltr} {
    global C
    set w [focus]
    if {$w eq ".ctrl.key1"} {
        set C(key1) $ltr
    } elseif {$w eq ".ctrl.key0"} {
        set C(key0) $ltr
    }
}
##+##########################################################################
#
# PrepCipherText -- Turns cipher text into workable format
#
proc PrepCipherText {cipher {plain ""} {hint ""}} {
    global C

    set C(solved) 0
    set C(undo) ""
    set C(cipher) [string trim [string toupper $cipher]]
    regsub -all {\s+} $C(cipher) " " C(cipher)
    set C(plain) [string trim [string toupper $plain]]
    regsub -all {\s+} $C(plain) " " C(plain)
    set C(hint) $hint

    Highlight 0
    set txt [::textutil::adjust $C(cipher) -length 60 -strictlength true]
    set lines [split $txt \n]

    for {set i 0} {$i < $C(CipherLines)} {incr i} {
        set C($i,cipher) [lindex $lines $i]
        regsub -all {[A-Z]} $C($i,cipher) " " C($i,plain)
        foreach who {plain cipher} {
            set w .txt.f${i}$who
            $w config -state normal
            $w delete 1.0 end
            $w insert end $C($i,$who)
            $w config -state disabled
        }
    }
    Histogram
}
##+##########################################################################
#
# Histogram -- Draws histogram of letter usage
#
proc Histogram {} {
    global C XY cnt

    unset -nocomplain cnt

    regsub -all {[^A-Z]} $C(cipher) "" txt
    set max 0
    foreach ch [split $txt ""] {
        incr cnt($ch)
        if {$cnt($ch) > $max} { set max $cnt($ch) }
    }

    set sc [expr {($XY(bottom)-5) / double($max)}]
    .c delete histogram
    foreach ch [array names cnt] {
        set y [expr {$XY(bottom) - $cnt($ch) * $sc}]
        .c create line $XY($ch) $XY(bottom) $XY($ch) $y -tag histogram \
            -width 5 -fill magenta -capstyle round
    }
}
##+##########################################################################
#
# Decipher -- Applies current cipher/deciphered pairings
#
proc Decipher {} {
    global C

    set mapping {}
    foreach ltr $::AB {
        set ltr2 [expr {$C(key,$ltr) eq "" ? " " : $C(key,$ltr)}]
        lappend mapping $ltr $ltr2
    }
    for {set i 0} {$i < $C(CipherLines)} {incr i} {
        if {! [info exists C($i,cipher)]} break
        set C($i,plain) [string map $mapping $C($i,cipher)]
        .txt.f${i}plain config -state normal
        .txt.f${i}plain delete 1.0 end
        .txt.f${i}plain insert end $C($i,plain)
        .txt.f${i}plain config -state disabled
    }
    InUse
}
##+##########################################################################
#
# InUse -- Marks all letters currently used
#
proc InUse {} {
    global C

    array set RC [lreverse [array get C key,*]]
    foreach ch $::AB {
        set clr [expr {[info exists RC($ch)] ? "green" : [.c cget -bg]}]
        .c.p$ch config -disabledbackground $clr
    }
}
##+##########################################################################
#
# Hint -- Shows hint if we have one
#
proc Hint {} {
    global C
    set msg $C(hint)
    if {$C(hint) eq ""} {
        set msg "No hint available"
    }
    tk_messageBox -icon info -message $msg -title "$C(title) Hint" -parent .
}
##+##########################################################################
#
# Solution -- Shows solution if we have one
#
proc Solution {} {
    global C
    set msg [::textutil::adjust $C(plain) -length 60 -strictlength true]
    if {$C(plain) eq ""} {
        set msg "No solution available"
    }
    tk_messageBox -icon info -message $msg -title "$C(title) Solution" -parent .
}
##+##########################################################################
#
# Erase -- Erase current cipher/deciphered letter pairings
#
proc Erase {} {
    global C

    set undo {}
    foreach ch $::AB {
        if {$C(key,$ch) ne ""} {
            lappend undo $ch $C(key,$ch)
            set C(key,$ch) ""
        }
    }
    if {$undo eq {}} {                          ;# Double erase clears undo
        set C(undo) {}
    } else {
        set C(undo) [concat [list $undo] $C(undo)]
    }
    Decipher
    focus .ctrl.key1
}
proc Shuffle {llist} {
    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 $llist
}
##+##########################################################################
#
# GetCipherText -- Puts up dialog for getting cipher text
#
proc GetCipherText {} {
    set W .get
    destroy $W
    toplevel $W -padx .1i -pady .1i
    wm title $W "Enter Cryptogram"
    catch {wm attribute $W -toolwindow 1}
    wm protocol $W WM_DELETE_WINDOW DoneCipherText
    wm transient $W .
    wm withdraw $W

    ::ttk::label $W.l -text "Enter cryptogram here" -font {Times 14 bold}
    text $W.t -wrap word -height 13

    ::ttk::button $W.sample -text Sample -command GrabSample
    ::ttk::button $W.solve -text Solve -command DoneCipherText
    ::ttk::button $W.cryptocorner -text "Cryptogram\nCorner" \
        -command GetTodaysCryptogramCorner

    grid $W.l -columnspan 2 -sticky w
    grid $W.t -columnspan 2
    grid $W.sample $W.solve -pady .1i
    grid $W.cryptocorner

    ::ttk::label $W.lsample -textvariable ::C(sample,info)
    place $W.lsample -in $W.sample -relx 1 -y 0 -anchor nw

    update idletasks
    scan [wm geom .] "%dx%d+%d+%d" . . x y
    wm geom $W +[incr x 20]+[incr y 20]
    #RightWindow $W .
    wm deiconify $W

    grab $W
    $W.t insert end $::C(cipher)
    focus $W.t
}
##+##########################################################################
#
# DoneCipherText -- Exits GetCipherText dialog
#
proc DoneCipherText {} {
    global C

    set txt [string trim [.get.t get 1.0 "end - 1 char"]]
    if {$txt eq ""} return
    destroy .get

    set plain [set hint ""]
    if {[info exists C(sample,cipher)] && $txt eq $C(sample,cipher)} {
        set plain $C(sample,plain)
        set hint [GetHint $txt $plain]
    } else {
        set C(sample,info) ""
    }
    PrepCipherText $txt $plain $hint
    Decipher
    raise .
    focus .ctrl.key1
}
proc GetRandom {{idx ""}} {
    if {$idx eq ""} {
        set idx [expr {int(rand() * [llength $::samples])}]
    }
    set plain [lindex $::samples $idx]
    set cipher [Encrypt $plain]
    set hint [GetHint $cipher $plain]

    set ::C(sample,idx) $idx
    set ::C(sample,cipher) $cipher
    set ::C(sample,plain) $plain
    set ::C(sample,info) "#$idx of [llength $::samples]"

    PrepCipherText $cipher $plain $hint
    Decipher
    raise .
    focus .ctrl.key1
}
##+##########################################################################
#
# GrabSample -- Gets a sample from our built in list
#
proc GrabSample {} {
    set idx [expr {int(rand() * [llength $::samples])}]
    set plain [lindex $::samples $idx]
    set cipher [Encrypt $plain]

    .get.t delete 1.0 end
    .get.t insert end $cipher

    set ::C(sample,idx) $idx
    set ::C(sample,cipher) $cipher
    set ::C(sample,plain) $plain
    set ::C(sample,info) "#$idx of [llength $::samples]"
}
##+##########################################################################
#
# Encrypt -- Encrypts plain text with a random substitution key
#
proc Encrypt {plain} {
    while {1} {
        set key [Shuffle $::AB]
        set ok 1
        set mapping {}
        foreach a $::AB b $key {
            lappend mapping $a $b
            if {$a == $b} {                     ;# Letter can't map to itself
                set ok 0
                break
            }
        }
        if {$ok} break
    }
    set cipher [string map $mapping $plain]
    return $cipher
}
##+##########################################################################
#
# GetHint -- Grabs a random hint from plain/cipher text
#
proc GetHint {cipher plain} {
    regsub -all {[^A-Z]} $cipher "" cipher
    regsub -all {[^A-Z]} $plain "" plain
    set idx [expr {int(rand() * [string length $cipher])}]
    set hint "[string index $cipher $idx]=[string index $plain $idx]"
    return $hint
}
##+##########################################################################
#
# GetTodaysCryptogramCorner -- Scraps todays cryptogram from
# Cryptogram Corner web site.
#
proc GetTodaysCryptogramCorner {} {
    destroy .get

    set url http://www.geocities.com/cryptogramcorner/
    set html [DownloadPage $url]
    set month [ScrapCryptogramCorner $html]

    set thisDay [clock format [clock seconds] -format %d]
    set thisDay [expr {$thisDay > 0 ? $thisDay-1 : $thisDay}]
    lassign [lindex $month $thisDay] cipher plain hint
    PrepCipherText $cipher $plain $hint
    set ::C(sample,info) ""
    set ::C(sample,index) ""
}
proc GetYearOfCryptogramCorner {year} {
    if {$year < 2000} { error "year must be 2000 or greater" }

    set samples {}
    foreach month {jan feb mar apr may jun jul aug sep oct nov dec} {
        set date "$month[string range $year end-1 end]"
        puts "fetching $date"
        set url "http://www.geocities.com/cryptogramcorner/${date}.htm"
        if {[catch {set html [DownloadPage $url]}]} {
            puts "  error: skipping $date"
            continue
        }
        set all [ScrapCryptogramCorner $html]
        set samples [concat $samples $all]
    }
    set plainSamples ""
    set cnt 0
    foreach sample $samples {
        set plain [lindex $sample 1]
        if {$plain ne ""} {
            append plainSamples "    {$plain}\n"
            incr cnt;
        }
    }

    puts "total: $cnt"
    return $plainSamples
}
##+##########################################################################
#
# ScrapCryptogramCorner -- Scraps all cryptograms puzzle from the
# html for Cryptogram Corner.
#
proc ScrapCryptogramCorner {html} {
    global SAMPLES

    set re "if\\s*?\\(\\s*?thisday\\s*?==\\s*?\\d+?.*?\}"

    foreach match [regexp -all -inline $re $html] {
        set n [regexp {thisday\s*==\s*(\d+)} $match . thisDay]
        if {! $n} { error "can't extract thisDay" }

        set all [regexp -all -inline {VAR[123]="(.*?)"} $match]
        if {$all ne ""} {
            lassign $all . var1 . var2 . var3
            set SAMPLES(cipher,$thisDay) "$var1 $var2 $var3"
            set n [regexp {msg\s*?=\s*?"(.=.)"} $match . SAMPLES(hint,$thisDay)]
            if {! $n} { error "can't extract hint for $thisDay" }
        } else {
            regsub -all {"<.*?>"} $match "" match
            regsub -all {"Keyword:.*?"} $match "" match
            set txt [join [regexp -inline -all {".*?"} $match]]
            set txt [string map {\" ""} $txt]
            set SAMPLES(plain,[expr {$thisDay-1}]) $txt
        }
    }
    set all {}
    foreach arr [lsort -dictionary [array names SAMPLES cipher,*]] {
        set thisDay [lindex [split $arr ","] 1]
        set plain [expr {[info exists SAMPLES(plain,$thisDay)] \
                             ? $SAMPLES(plain,$thisDay) : ""}]
        set hint [expr {[info exists SAMPLES(hint,$thisDay)] \
                            ? $SAMPLES(hint,$thisDay) : ""}]
        lappend all [list $SAMPLES($arr) $plain $hint]
    }
    return $all
}
proc ValidateSample {thisDay cipher plain hint} {
    if {$plain eq ""} {
        if {$thisDay != 31} {
            puts "  no plain text: $thisDay"
        }
        return 0
    }
    regsub -all {[^A-Z ]} $cipher "" cipher
    regsub -all {[A-Z]} $cipher "@" cipher
    regsub -all {\s+} $cipher " " cipher
    regsub -all {[^A-Z ]} $plain "" plain
    regsub -all {[A-Z]} $plain "@" plain
    regsub -all {\s+} $plain " " plain
    if {$cipher ne $plain} {
        puts "  bad text: $thisDay"
        return 0
    }
    if {$hint eq ""} {
        puts "  no hint: $thisDay"
        return 0
    }
    return 1
}
##+##########################################################################
#
# DownloadPage -- fetches a web page
#
proc DownloadPage {url} {
    set token [::http::geturl $url]
    ::http::wait $token
    if {[::http::ncode $token] != 200} {
        error "cannot download $url: [::http::ncode $token]"
    }
    set html [::http::data $token]
    ::http::cleanup $token
    return $html
}
##+##########################################################################
#
# IsSolved -- Determines if we've solved the cryptogram
#
proc IsSolved {} {
    global C

    if {$C(solved)} return
    if {$C(plain) eq ""} return

    set plain [string trim "$C(0,plain) $C(1,plain) $C(2,plain) $C(3,plain)"]
    if {$plain ne $C(plain)} return
    set C(solved) 1
    Highlight 1
    catch {
        set fname [file join [pwd] [file dirname $::argv0] solved.txt]
        set fout [open $fname a]
        puts $fout "$C(sample,idx) [clock format [clock seconds]]"
        close $fout
    }
}
##+##########################################################################
#
# Highlight -- Highlights display for victory
#
proc Highlight {onOff} {
    set clr [expr {$onOff ? "yellow" : "white"}]
    foreach w [winfo child .txt] {
        $w config -background $clr
    }
}
##+##########################################################################
#
# HighlightCipherLetter -- Highlights a letter in the cryptogram
#
proc HighlightCipherLetter {ltr} {
    global C

    for {set row 0} {$row < $C(CipherLines)} {incr row} {
        set w .txt.f${row}cipher
        ${w} config -state normal
        $w tag remove highlightLetter 1.0 end
        if {$ltr ne ""} {
            foreach idxs [regexp -all -inline -indices $ltr $C($row,cipher)] {
                set idx [lindex $idxs 0]
                $w tag add highlightLetter 1.$idx 1.[expr {$idx+1}]
            }
        }
        ${w} config -state disabled
    }
}
##+##########################################################################
#
# RightWindow -- Positions window on right edge of the main window
#
proc RightWindow {w {W .}} {
    update idletasks

    set W [winfo toplevel $W]
    set y [expr {3 + [winfo y $W]}]              ;# Top of main window
    set x [expr {15 + [winfo x $W] + [winfo width $W]}] ;# Right side

    set right [expr {$x + [winfo reqwidth $w]}]
    if {$right > [winfo screenwidth $W] + 20} {
        wm geom $w -0+$y
    } else {
        wm geom $w +$x+$y
    }
}
##+##########################################################################
#
# CheatSheet -- Some hints I've collected over time
#
proc CheatSheet {} {
    set data {LETTER FREQUENCY
    ETAOIN SHRDL CUMWF GYPBV KJZQZ

COMMON UNIQUE LETTER COMBINATIONS
    AB/AC       : it/is  be/by
    AB/BC       : no/of
    AB/BA       : no/on
    AB/CB       : to do   to go  in an
    AB/CA       : o[fnr]/[dgnst]o my/am me/am no/anan
                  no/in so/[aiu]s to/at to/it

    ABC/AB      : not/no  and/an  its/it  one/no
    ABC/AC      : two/to  its/is  own/on
    ABC/BA      : not/on  for/of  one/no
    ABC/BC      : the/he  has/as  his/is  man/an
    ABC/CA      : out/to
    ABC/CB      : got/to  not/to
    ABC/BCA     : who/how
    ABC/ABCD'EC : the/they're
    AB'C/ADC    : he'd/his
    AB/ACD'B    : it/isn't
    ABCDC/ABC   : there/the
    ABCD/CDB    : know/own
    ABCD/ABC    : the[nmy]/the your/you

    ABCA        : that  died  else high
    ABAC        : ever  even  away
    ABCDC       : there
    ABCADC      : people
    ABCCAD      : little
    ABth        : with

TWO LETTER WORDS        CONTRACTIONS
    am     be          I'd       I've
    an     he          I'm       o'er
    as     me          he'd      he'll
    at     we          he's      we'll
    be     if          it's      we're
    by     of          we'd      we've
    do     am          can't     she'll
    go     an          don't     you'll
    he     in          isn't     you're
    if     on          one's     you've
    in     do          she'd     they're
    is     go          you'd     could've
    it     no          won't     might've
    me     so          aren't    would've
    my     to          didn't
    no     up          hasn't
    of     or          wasn't
    on     as          doesn't
    or     is          haven't
    so     us          couldn't
    to     at          wouldn't
    up     it
    us     by
    we     my

MOST COMMON THREE LETTER WORDS
    the and for not you but his say
    her she one all out who get man
}

    destroy .cheat
    toplevel .cheat
    wm title .cheat "$::C(title) Cheat Sheet"
    wm transient .cheat .
    wm withdraw .cheat
    text .cheat.t -width 60 -relief raised -wrap word \
        -padx 10 -pady 10 -cursor {} -yscrollcommand {.cheat.sb set}
    ::ttk::scrollbar .cheat.sb -orient vertical -command [list .cheat.t yview]
    ::ttk::button .cheat.dismiss -text Dismiss -command {destroy .cheat}
    pack .cheat.dismiss -side bottom -pady 10
    pack .cheat.sb -side right -fill y
    pack .cheat.t -side top -expand 1 -fill both

    .cheat.t insert end $data
    .cheat.t config -state disabled
    RightWindow .cheat .
    wm deiconify .cheat

    focus .ctrl.key1
}

##+##########################################################################
#
# Help -- a simple help screen
#
proc Help {} {
    catch {destroy .help}
    toplevel .help
    wm title .help "$::C(title) Help"
    wm transient .help .
    wm withdraw .help

    set t .help.t
    text $t -relief raised -wrap word -width 70 -height 33 \
        -padx 10 -pady 10 -cursor {} -yscrollcommand {.help.sb set}
    ::ttk::scrollbar .help.sb -orient vertical -command [list $t yview]
    ::ttk::button .help.dismiss -text Dismiss -command {destroy .help}
    pack .help.dismiss -side bottom -pady 10
    pack .help.sb -side right -fill y
    pack $t -side top -expand 1 -fill both

    set bold "[font actual [$t cget -font]] -weight bold"
    set italic "[font actual [$t cget -font]] -slant italic"
    $t tag config title -justify center -foregr red -font "Times 20 bold"
    $t tag configure title2 -justify center -font "Times 12 bold"
    $t tag configure header -font $bold -spacing3 5
    $t tag configure bold -font $bold
    $t tag configure italic -font $italic
    $t tag configure n -lmargin1 10 -lmargin2 10
    $t tag configure bullet -lmargin1 20 -lmargin2 35 -tabs 35

    $t delete 1.0 end
    $t insert end "$::C(title)\n" title "by Keith Vetter, Oct. 2009\n\n" title2

    set txt "$::C(title) is a tool to aid in solving cryptograms. "
    append txt "It does not solve the cipher, but "
    append txt "instead it has the computer do all the dirty work thus "
    append txt "allowing you to concentrate on solving the puzzle. "
    append txt "It is based "
    append txt "on a similarly named program by Mike Kaplan and "
    append txt "Dick Rufer (see www.rrufer.com).\n\n"
    $t insert end "Introduction\n" header $txt

    set txt "The first step in using $::C(title) is to get a "
    append txt "cryptogram to solve. You can either type in one "
    append txt "your own, use one of the 300 plus built it puzzles, "
    append txt "or extract today's puzzle from the web site "
    append txt "Cryptogram Corner "
    append txt "(http://www.geocities.com/cryptogramcorner/)\n\n"
    $t insert end "Getting Started\n" header $txt

    set txt "After selecting the puzzle, $::C(title) displays the cryptogram "
    append txt "in four rows with a blank line above each row for the solution. "
    append txt "Also displayed is a histogram of letter usage. "
    append txt "As you solve the puzzle, the letters you've already solved are "
    append txt "marked.\n\n"
    $t insert end $txt

    set txt "Using $::C(title)\n"
    $t insert end $txt header
    set txt "Enter ciphered letter in top 'Type-In Field'\n"
    $t insert end \u25cf\t$txt bullet
    set txt "Enter deciphered letter in bottom 'Type-In Field'\n"
    $t insert end \u25cf\t$txt bullet
    set txt "Press Ctrl-Z for undo\n\n"
    $t insert end \u25cf\t$txt bullet

    set txt "How to Cheat\n"
    $t insert end $txt header
    set txt "Press Ctrl-H for hint (if known)\n"
    $t insert end \u25cf\t$txt bullet
    set txt "Press Ctrl-S for solution (if known)\n"
    $t insert end \u25cf\t$txt bullet
    set txt "Press Ctrl-C for a helpful cheat sheet\n"
    $t insert end \u25cf\t$txt bullet

    $t config -state disabled
    RightWindow .help .
    wm deiconify .help

    focus .ctrl.key1
}

################################################################

DoDisplay
GetRandom
return


======

----
!!!!!!
%| [Category Games] | [Category Application] |%
!!!!!!