# Pretty Print version from autoindent and ased editor
    # Random Poetry Chalkboard
    # written on Windows XP on eTCL
    # working under TCL version 8.5.6 and eTCL 1.0.1
    # gold on TCL WIKI , 10Jul2009
    package require Tk
    # proc ?, suchenworth routine
    proc ? L {
        lindex $L [expr {int(rand()*[llength $L])}]
    }
    proc poetry {} {
        set a {
            {red} {sad} {blue} {blue}
            {glad} {glad} {deep} {black}
            {wild } { green } {pale } {bright}
            {rough } {gray } {brown } {long}
            {high } {thin} {brown } {lush}
            {dry } {poor} {lone } {far}
            {flat } {broad} {thick } {hard}
            {flat } {broad} {cool} {hard}
        }
        set b {
            {quince } { peach } {hare } {bird}
            { smoke } { rain} { ice} {snow}
            {cloud} { home} { flower } {sky}
            {rice} { pine} { mist} {door}
            {wind} { cricket} { year } {moon}
            {crane } {grass } {rose} {ink}
            {thaw} { bloom } {lake} { cedar }
            {dusk} { autumn } {stone} { dawn}
            {stream} { tree } {heart} { boat}
            {grief} { tree } {boat} {boat}
            {rock} {town} {tear} {pool}
            {silk} {deer} {song} {barge}
            {moss} {night} {gate} {fence}
            {dove} {dream} {frost} {peace}
            {shade} {ghost} {road} {path}
            {root} {horse} {eve } {sound}
            {sleep} {leaves} {sea } {sail}
            {peak} {stem} {field} {wave}
            {slope} {bark} {crest} {weed}
            {moth} {wasp} {pond} {soil}
            {snail} {worm} {ant} {kelp}
            {cave} {month} {head} {jade}
            {branch} {bone} {head} {smile}
            {pea} {bone} {head} {smile}
            {elm} { morn} {carp} {nest}
            {oak} { bone} {perch} {breeze}
        }
        set c {
            {snow} { burns} {flips} {flys}
            {lies} { walk } {flow } {fall} {fly}
            {know } {come}  {meet } {drift}
            {shine } {soak} { cry } {dance}
            { lost} {cheer} {float} {dance}
            {roost} { move} { fade} {loves}
            {sleeps} {move} {takes} {sail}
            {sits} {leaps} {sits }  {sit}
            {sits} {leaps} {grows } {waits}
            {loses} {hears} {wants} {watch}
        }
        set d {
            {for} {by} {towards} { to } {at} {bygone}
            {to} {in} {in } {to }
            {to} {in} {fore } {through}
        }
        return [list [? $a] [? $b] [? $c] [? $d] [? $a] [? $b]]
    }
    proc populateCanvas {canvas cols rows} {
        variable ids ;# links text ids with respective rect ids
        variable boxes ;# lists text id and text associated with each rect id
        catch {unset ids boxes}
        # parameters for drawing boxes
        set boxwidth 50
        set boxheight 20
        set padx 3
        set pady 3
        set colors {red orange yellow green blue purple}
        # draw the boxes
        for {set row 0} {$row < $rows} {incr row} {
            set texz [poetry]
            for {set col 0} {$col < $cols} {incr col} {
                # calculate coordinates
                set x1 [expr {$col * ($boxwidth + $padx) +$padx}]
                set x2 [expr {$x1 + $boxwidth}]
                set x3 [expr {$x1 + ($boxwidth / 2)}]
                set y1 [expr {$row * ($boxheight + $pady) + $pady}]
                set y2 [expr {$y1 + $boxheight}]
                set y3 [expr {$y1 + ($boxheight / 2)}]
                # choose color and text
                set color [lindex $colors [expr {int (rand() * [llength $colors])}]]
                set text [ lindex $texz $col]
                
                # create the boxes
                set boxid [$canvas create rectangle $x1 $y1 $x2 $y2 \
                        -fill $color \
                        -outline black]
                set textid [$canvas create text $x3 $y3 \
                        -text $text]
                # remember which text item goes with which box and what the text says
                set boxes($boxid) [list $textid $text]
                set ids($textid) $boxid
                set ids($boxid) $boxid
            }
        }
    }
    proc clearSelection {canvas} {
        # if there is an existing currently selected box, change its border back to
        # black; set variables selectedid and selectedtext to empty strings
        variable selectedid
        variable selectedtext
        if {$selectedid ne "" && [$canvas find withtag $selectedid] ne ""} {
            $canvas itemconfigure $selectedid -outline black
        }
        set selectedid ""
        set selectedtext ""
    }
    proc handleSelection {canvas id} {
        # determine the "next step" by comparing the newly selected box id and text
        # to the box id and text of the previously selected box (contained in
        # the variables $selectedid and $selectedtext)
        variable ids
        variable boxes
        variable selectedid
        variable selectedtext
        set boxid $ids($id)
        lassign $boxes($boxid) textid text
        if {$boxid eq $selectedid} {
            # user has selected the same box twice; deselect the box
            clearSelection $canvas
            return
        } elseif {$text eq $selectedtext} {
            # user has selected two boxes with the same text; delete both boxes
            $canvas delete $boxid $textid $selectedid [lindex $boxes($selectedid) 0]
            clearSelection $canvas
            return
        } else {
            # user has selected a box when there is no selection, or user has
            # selected a box with different text than the previously selected box;
            # try to deselect the previous box, then select the new box
            
            clearSelection $canvas
            set selectedid $boxid
            set selectedtext $text
            $canvas itemconfigure $boxid -outline white
            return
        }
    }
    proc processClick {canvas x y} {
        # determine whether the user has clicked on something; if so, call
        # proc handleSelection
        set id [$canvas find overlapping $x $y $x $y]
        if {[llength $id] > 0} {
            handleSelection $canvas [lindex $id 0]
        }
    }
    set win [toplevel .demo]
    wm title $win "Random Poetry Chalkboard"
    set canvas [canvas $win.canvas]
    pack $canvas  -expand 1 -fill both
    bind $canvas <Button-1> [list processClick %W %x %y]
    set state 1
    proc mahjongstyle { state } {
        global coloritem canvas details
        set coloritem darkgreen
        set details {
            Mahjong-style deletion.
            press in succession two tiles
            with the same text.
            both tiles should be deleted.
            The Mahjong-style deletion is for
            the right mouse press.}}
    console hide
    mahjongstyle { $state }
    populateCanvas $canvas 6 10
    set selectedid ""
    set selectedtext ""
    set maxX 320
    set maxY 240
    set y      0
    set x1 120
    set x2 150
    set y1  50
    set y2  80
    canvas  .cv -width $maxX -height $maxY  -bg darkgreen
    # end of deck

invalid command name "respective"
    while executing
"respective rect ids"
    (procedure "populateCanvas" line 4)
    invoked from within
"populateCanvas $canvas 6 10"
    (file "wikitest" line 223)