Random Poetry Chalkboard

Random Poetry Chalkboard

This page is under development. Comments are welcome, but please load any comments in the comments section at the bottom of the page. Please include your wiki MONIKER and date in your comment with the same courtesy that I will give you. Aside from your courtesy, your wiki MONIKER and date as a signature and minimal good faith of any internet post are the rules of this TCL-WIKI. Its very hard to reply reasonably without some background of the correspondent on his WIKI bio page. Thanks, gold 12Dec2018

Introduction Section

gold Here is an eTCL script to develop random poetry. For example, we are laying out tiles in random colors imprinted with text and symbols applied randomly. Would also like to develop a crude Mahjong program using some of these subroutines.

In developing a computer program or application,it is helpful to develop analogs for the individual tasks of the application.

In the process of designing the basic subroutine tasks, we could throw in some canned errors ( stored in subroutines). Such rule breaking helps keep the finished program more flexible.

Note: This program has routines that change mouse bindings on command events, which make for difficult constructions.

gold 2Mar2017. filtered blank lines out of code and used pretty print of Ased editor. Code has better cosmetics.

Screenshots Section

figure 1.

WikiDbImage Random_Poetry_Chalkboard.PNG


Random Divination (non-Iching)

Programming References ( TCL & C# )

Appendix Code

appendix TCL programs and scripts

Program Listing

    # 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
        } 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
        } 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
    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



 if 0 { iching hexagrams and trigrams }
  The names of the trigrams
 I Ching Trigram Name Translations
     Pinyin   Wade-Giles (Wilhelm/Baynes) associations
 1.  Qian     Ch'ien   the creative, heaven, Father,northwest,head,lungs
 2.  Kun      K'un     the receptive, earth,Mother,southwest,abdomen,reproductive_organs
 3.  Zhen     Chên     the arousing, thunder,Eldest_Son,east,throat
 4.  Kan      K'an     the abysmal, water,Middle_Son,north,liver,kidneys,inner_ear
 5.  Gen      Kên      keeping still, mountain, Youngest_Son,northeast,hands,spine,bones
 6.  Xun      Sun      the gentle, wind, Eldest Daughter,southeast,hips,buttocks
 7.  Li       Li       the clinging, flame,Middle_Daughter,south,eyes,heart
 8.  Dui      Tui      the joyous, lake,Youngest_Daughter,west,mouth }

Comments Section

gold Troubles : if you pick on a rectangle without centering on a text postion, there maybe an error calling "text unknown option".

RLE (2013-07-14): The source of the program as placed on the wiki is broken. Attempting to copy/paste it and run it results in this error message:

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

This error is the result of numerous extraneous newline characters that have been inserted into the code that is present on the wiki.

As for your "text unknown option", that may be the result of your using the event %x/%y values to a global canvas bind to "find" which box on the canvas was clicked. You may want to look into the canvas bind command (a command internal to the canvas itself) which would allow you to associate bindings (and parameters) directly to each box on the canvas rather than globally to the canvas as a whole.

gold2mar2017. Loaded last version on my Acer machine. Program appears to be working as originally conceived. Didn't know that Ased editor (of that time) would not handle extra long comments. The older Ased editor would bust comments into more than one line or ignore continuation. Eventually with the troubles of extra long comments and interpreters firing on commented out code, about stopped putting comments in my wiki code. Comment on numerous extraneous newline characters not completely understood here, but usually use windows txt editor. Thanks for the feedback. PS. ( Is backslash \ not a line extension?, thought newline was \n )

Hidden Comments Section

Please place any comments here with your wiki MONIKER and date, Thanks.gold12Dec2018