----
       '''Random_Poetry_Chalkboard'''
----   
       This page is under development. Comments are
       welcome, but please load any comments
       at the bottom of the page. Thanks,[gold]
-----
This page uses [Tcl]8/[Expect] 5.2 for [windows] 
to develop random Poetry. 
(note: file is working in Expect5.2,
but i did not put in statement "require Expect5.2"
since lock with report error on some ports.) 
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.
             
horizontal bar code of 6 lines.

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.
                      
----
======
        #!/usr/bin/env wish
        #start of deck
        #Random Poetry Chalkboard
        # 5Jan2009, [gold]
     set goblins { gray60 gray70 gray80 gray85 gray90 gray95 \
    snow1 snow2 snow3 snow4 seashell1 seashell2 \
    seashell3 seashell4 AntiqueWhite1 AntiqueWhite2 AntiqueWhite3 \
    DarkSlateGray1 DarkSlateGray2 DarkSlateGray3 \
    aquamarine4 DarkSeaGreen1 DarkSeaGreen2 DarkSeaGreen3 \
    PaleGreen1 PaleGreen2 PaleGreen3 PaleGreen4 SpringGreen1 \
    green3 green4 chartreuse1 chartreuse2 chartreuse3 \
    chartreuse4 OliveDrab1 OliveDrab2 OliveDrab3 OliveDrab4 \
    coral2 coral3 coral4 tomato1 tomato2 tomato3 tomato4 \
    red4 DeepPink1 DeepPink2 DeepPink3 DeepPink4 HotPink1 \
    HotPink2 HotPink3 HotPink4 pink1 pink2 pink3 pink4 \
    PaleVioletRed2 PaleVioletRed3 PaleVioletRed4 maroon1 \
    VioletRed4 magenta1 magenta2 magenta3 magenta4 orchid1 \
    orchid2 orchid3 orchid4 plum1 plum2 plum3 plum4 \
    DarkOrchid1 DarkOrchid2 DarkOrchid3 DarkOrchid4 purple1 \
    MediumPurple3 MediumPurple4 thistle1 thistle2 thistle3 \

}
#    set testlist2 [split $goblins ]
#
# Example 30-1
# A text widget and two scrollbars.
#

        proc Scrolled_Text { f args } {
        frame $f
        eval {text $f.text -wrap word \
                -xscrollcommand [list $f.xscroll set] \
                -yscrollcommand [list $f.yscroll set]} $args
        scrollbar $f.xscroll -orient horizontal  \
                -command [list $f.text xview]
        scrollbar $f.yscroll -orient vertical  \
                -command [list $f.text yview]
        grid $f.text $f.yscroll -sticky news
        grid $f.xscroll -sticky news
        grid rowconfigure $f 0 -weight 1
        grid columnconfigure $f 0 -weight 1
        return $f.text
}


set t [Scrolled_Text .eval -width 5 -height 3 -bg bisque]
set x [Scrolled_Text .eval2 -width 5 -height 3 -bg bisque]
pack .eval .eval2 -fill both -expand true -side bottom
$t insert end  " identified1 !!!"  ;

$x insert end  " identified2 !!!"  ;

# $t insert end  $testlist2  ;

# $x insert end  $testlist2  ;
 variable bg black  fg white  
      
   set dx 50
   set dy 50
   set size 30
   set colorground bisque
  

proc ? L {
 lindex $L [expr {int(rand()*[llength $L])}]
}

 proc lpick L {lindex $L [expr int(rand()*[llength $L])]; \
  #suchenwirth_subroutine;}
  proc poetry jill {
  set jill [lpick { tree happy grass love swan home  \
      power loss dance rose joy hate juice kick deer}]
 
  return $jill;
  }

     proc xpoetry {w x y val1 val2} {
    global jack
    global jill
     variable bg; variable fg; variable size
      set jack [lpick {red yellow blue purple \
      pink green brown black  gray}]
   set jill rose
     #remaining doctered_suchenwirth_subroutine;
     set tags [list mv d-$val1$val2];
     #remaining doctered_suchenwirth_subroutine;
     set x1 [expr {$x+$size-0.5}]
     set y1 [expr {$y+$size}]
     $w create rect $x $y [expr {$x+2*$size}] $y1 \
         -fill $jack -tags [linsert $tags 0 bd-$val1$val2]
     $w create text [expr {$x+1*$size}]   [expr {$y+0.5*$size }] \
        -text   [eval poetry $jill] -fill $fg -tags $tags

  }
  proc xxxpoetry {w x y val1 val2 rose5} {
    global jack
    global jill
     variable bg; variable fg; variable size
      set jack [lpick {red yellow blue purple \
      pink green brown black  gray}]
   set jill rose
     #remaining doctered_suchenwirth_subroutine;
     set tags [list mv d-$val1$val2];
     #remaining doctered_suchenwirth_subroutine;
     set x1 [expr {$x+$size-0.5}]
     set y1 [expr {$y+$size}]
     $w create rect $x $y [expr {$x+2*$size}] $y1 \
         -fill $jack -tags [linsert $tags 0 bd-$val1$val2]
     $w create text [expr {$x+1*$size}]   [expr {$y+0.5*$size }] \
        -text   $rose5 -fill $fg -tags $tags

  }

proc recipe {} {
  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}
     
  }

   set word1 rose
   set dy 20
   set dx 20
 for {set i 0; set y 0} {$i<8} {incr i; incr y $dy} {
for {set j 0; set x 0} {$j<8} {incr j; incr x $dx}   {
         xxxpoetry .c [expr $i*65+10] [expr $j*35+100] $i $j "[? $a]."
   
    incr j
xxxpoetry .c [expr $i*65+10] [expr $j*35+100] $i $j "[? $b]."
  
 

    incr j
xxxpoetry .c [expr $i*65+10] [expr $j*35+100] $i $j "[? $c]."
  incr j
xxxpoetry .c [expr $i*65+10] [expr $j*35+100] $i $j "[? $d]."
 incr j
xxxpoetry .c [expr $i*65+10] [expr $j*35+100] $i $j "[? $a]."
  incr j
xxxpoetry .c [expr $i*65+10] [expr $j*35+100] $i $j "[? $b]."
  } 

 }




  return " [? $a] [? $b] [? $c] [? $d] [? $a] [? $b]. "
   
}



if {[file tail [info script]]==[file tail $argv0]} {
  package require Tk
  
  pack [canvas .c -background darkgreen] -fill both -expand 1
  pack [label .ww -text "holding tank, version 2 "] 
   pack [text .t -width 40 -height 2]
   pack [label .wx -text "activate w/ mouse down "] 
   proc poetryrandom {w} {
   set dx 50
   set dy 50
   set size 30
   set word5 roset 
     for {set i 0; set y 0} {$i<8} {incr i; incr y $dy} {
     for {set j 0; set x 0} {$j<8} {incr j; incr x $dx}   {
         xpoetry .c [expr $i*65+10] [expr $j*35+100] $i $j
     }
  }
   }

   proc poetrypoetry {w} {
    set dx 50
   set dy 50
   set size 30
   set word5 roset
  recipe
   }
 bind .t <1> {showRecipe %W;$x insert end "$keeper" ;$t insert end "$keeper" ; break}
  proc showRecipe w {
    global keeper
    $w delete 1.0 end
    set keeper [recipe]
    $w insert end $keeper
    #set liner [split [$w get 1.0 end]]
    #lappend liner "/n"
    #lappend liner "rat"
    #$w insert end $liner 
    
    
    
  }
  showRecipe .t
}
  
   proc ClrCanvas {w} {

    $w delete "all"

  }




    
   #motion section
 if 0 {Clicking on a piece records \
  the click position, and its "catch-all"  tag, \
  in global variables:}
  proc mv'1 {w x y} {
     set ::_x $x; set ::_y $y;#suchenwirth subroutine;
     foreach tag [$w gettags current] {
         if [regexp ^(d-.+) $tag -> ::_tag] break
     }
  }
   if 0 {Moving the mouse with button 1 down \
  moves the items with the  "catch-all" tag \
  with the mouse pointer:}
   proc mv'motion {w x y} {
     $w raise $::_tag;#suchenwirth subroutine;
     $w move $::_tag [expr {$x-$::_x}] [expr {$y-$::_y}]

     set ::_x $x; set ::_y $y

  }
  .c bind mv <1>         {mv'1 %W %x %y}
   .c bind mv <B1-Motion> {mv'motion %W %x %y}
  
   #-- Little development helpers (optional):

   bind . <Escape> { exit}
   bind . <F1> {destroy .}
 
  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 white

  







  button  .b0 -text "clear" -command {  ClrCanvas .c }

  button  .b1 -text "poetry"  -command {ClrCanvas .c ;poetrypoetry .c }

  button  .b2 -text "exit"  -command {exit   }

  button  .b3 -text "ra. words"   -command {ClrCanvas .c ;poetryrandom .c }

  button  .b4 -text "exit"   -command {exit   }

  button  .b5 -text "exit"   -command { exit }
  button  .b6 -text "exit"   -command { exit }
  
  button  .b7 -text "exit"   -command { exit }
  button  .b8 -text "exit"   -command { exit }
  button  .b9 -text "exit"   -command { exit }
  button  .b10 -text "exit"   -command { exit }

  pack .b0 .b1 .b2 .b3 .b4 .b5  .b6 .b7 .b8 .b9 .b10   -side left -padx 2


      #end of deck
      #end of deck      
      #end of deck
    #end of deck
======
----
**Screenshots**

[http://img175.imageshack.us/img175/5109/ichinggenerator5ab5.jpg]

**Comments**
Please place any comments here, Thanks.

[gold] Change:Redundant procedure ? deleted. 

    
----
**References**
   * http://en.wikipedia.org/wiki/I_Ching
   * http://www.kheper.net/topics/I_Ching/hexagrams.htm
   * http://www.peaceloveandme.com/images/trigrams.gif
   * http://www.anton-heyboer.org/i_ching/choose.htm
   * Search on google.com for "site:www.sipp.org ching hexagrams"
   * http://www.beatrice.com/TAO.txt
   * http://members.aol.com/IChing1/index.html
   * http://www.sacred-texts.com/ich/index.htm
   * http://www.meritbadge.com/mb/notes/064.htm
   * http://home.hccnet.nl/vd.heijdt/sub-division.htm
   * Search on google.com for "Navaho game stick dice"
   * Search on google.com for "native america stick dice"
   * http://hearstmuseum.berkeley.edu/../gallery_3_5_5.html
   * http://www.biroco.com/yijing/stick.htm
   * http://mathcentral.uregina.ca/.../treptau1/game3.html
   * Search on google.com for "counting rods"
   * Search on Wikipedia for "Bagua ching trigram hexagram"
   * http://www.math.sfu.ca/histmath/China/Beginning/Rod.html
   * http://mathforum.org/library/drmath/view/52557.html
   * http://members.iimetro.com.au/~lofting/myweb/icmaths.html
   * http://www.research.att.com/~njas/sequences/A116586
   * http://www.circadianacupuncture.com/CAT/iching.html
   * Dirk Gently's Holistic I-ching Calculator [http://www.thateden.co.uk/dirk/]
   * http://www.bodhitree.com/booklists/i-ching.html
   * http://hexadecimal.uoregon.edu/ching/ching.html

***Random Divination (non-Iching)***
   * Search on google.com & wikipedia  for keywords :Limyran, Lycia, Sortes Astrampsych, thomas oracle, Bibliomancy"
   * http://www.thing.de/projekte/7:9%23/dream_book.html
   * http://www.cs.utk.edu/~mclennan/BA/GAO.html
   * http://essenes.net/greekalpha.htm
   * http://www.cs.utk.edu/%7Emclennan/BA/LAO.txt

***Programming References ( TCL & C# )***
   * http://www.alanwood.net/unicode/yijing_hexagram_symbols.html
   * http://www.unicode.org/charts/PDF/U4DC0.pdf
   * http://www.wazu.jp/gallery/Test_AncientChineseSymbols.html
   * http://www.unicode.org/charts/PDF/U1D360.pdf
   * c# based program as http://hexadecimal.uoregon.edu/ching/src.html
   * java  http://mason.gmu.edu/~swingo/
   * [Base conversion]
   * Syntax or sin tax:[I love foreach] [use while to iterate over a list]
   * [additional list functions], [string reverse],
   * [split], [list]
   * [recursive list searching]
   * Search on google.com for "haiku.tcl by Futon thefuton.com"

---- 
**Appendices**
***Tables***
 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 }
----    
***TCL program***
======
  #!/usr/bin/wish
     # Ka_ching.tcl , test for random binary numbers scheme,
     # goldshell7 ,14Mar2007, working on XP at TCL wiki
     #!/usr/bin/wish
     # Ka_ching.tcl , test for random binary numbers scheme,
     # goldshell7 ,14Mar2007, working on XP at TCL wiki
   #Used drawing tool by suchenwirth as starter code
   # added colors and report text windows.
       global count
       set count 0;
       proc whitelist {a} {return [lreplace $a 0 -1];#take string,return list without blanks}
       proc plainsub {text item replacewith} {
     set text [string map [list $item $replacewith] $text]
      }
   proc radio {w var values {col 0}} {
   frame $w
   set type [expr {$col? "-background" : "-text"}]
   foreach value $values {
       radiobutton $w.v$value $type $value -variable $var -value $value \
        -indicatoron 0
       if $col {$w.v$value config -selectcolor $value -borderwidth 3}
   }
   eval pack [winfo children $w] -side left
   set ::$var [lindex $values 0]
   set w
    }

    proc lpick L {lindex $L [expr int(rand()*[llength $L])]; \
    #suchenwirth_subroutine;}
    proc stringxxx s {
       #suchenwirth_subroutine;
       set res {}
      foreach line [split $s \n] {
         for {set i 0} {$i<[string length $line]} {incr i} {
            if {$i==[string wordstart $line $i]} {
               set w [string range $line $i [expr {[string wordend $line $i]-1}]]
               #if {$w!=" "} {lappend res $w}
               #if {$w!=" " && $w!="\{" && $w!="\}"} {lappend res $w}
               if {$w!=" " && $w!="\{" && $w!="\}" && $w!="\," && $w!="\\" && $w!="\/"} {lappend res $w}
               #if {$w!="\}"} {lappend res $w}
               #if {$w!="\{"} {lappend res $w}
               incr i [expr {[string length $w]-1}];

               # always loop incr
            }
         }
      }
      set res

   }

   proc down(Draw) {w x y} {
   set ::ID [$w create line $x $y $x $y -fill $::Fill]
   }
   proc move(Draw) {w x y} {
   $w coords $::ID [concat [$w coords $::ID] $x $y]
   }

   #-- Movement of an item
   proc down(Move) {w x y} {
   set ::ID [$w find withtag current]
   set ::X $x; set ::Y $y
   }
   proc move(Move) {w x y} {
   $w move $::ID [expr {$x-$::X}] [expr {$y-$::Y}]
   set ::X $x; set ::Y $y
   }

   #-- Clone an existing item
   proc serializeCanvasItem {c item} {
   set data [concat [$c type $item] [$c coords $item]]
   foreach opt [$c itemconfigure $item] {
       # Include any configuration that deviates from the default
       if {[lindex $opt end] != [lindex $opt end-1]} {
           lappend data [lindex $opt 0] [lindex $opt end]
           }
       }
   return $data
   }
   proc down(Clone) {w x y} {
   set current [$w find withtag current]
   if {[string length $current] > 0} {
       set itemData [serializeCanvasItem $w [$w find withtag current]]
       set ::ID [eval $w create $itemData]
       set ::X $x; set ::Y $y
      }
     }
        interp alias {} move(Clone) {} move(Move)

     #-- Drawing a rectangle
    proc down(Rect) {w x y} {
   set ::ID [$w create rect $x $y $x $y -fill $::Fill]
   }
    proc move(Rect) {w x y} {
   $w coords $::ID [lreplace [$w coords $::ID] 2 3 $x $y]
   }

    #-- Drawing an oval (or circle, if you're careful)
    proc down(Oval) {w x y} {
   set ::ID [$w create oval $x $y $x $y -fill $::Fill]
    }
    proc move(Oval) {w x y} {
   $w coords $::ID [lreplace [$w coords $::ID] 2 3 $x $y]
    }

   proc down(Poly) {w x y} {
   if [info exists ::Poly] {
       set coords [$w coords $::Poly]
       foreach {x0 y0} $coords break
       if {hypot($y-$y0,$x-$x0)<10} {
           $w delete $::Poly
           $w create poly [lrange $coords 2 end] -fill $::Fill
           unset ::Poly
       } else {
           $w coords $::Poly [concat $coords $x $y]
       }
   } else {
       set ::Poly [$w create line $x $y $x $y -fill $::Fill]
   }
   }
   
    proc down(canvas) {w x y} {global colorground; set colorground $::Fill; \
      .c configure -bg $colorground}
     proc move(canvas) {w x y} {}
   proc down(circle) {w x y} {
      set tile  [expr {int(rand()*1000000000.)}]
      set poof  "oval" ;
      set tagx [list $poof mv "obj_$tile" "colorit_$::Fill"  d-$x$y];
      set dx 50
      set dy 50

     set ::ID [$w create oval [expr {$x+2}] [expr {$y+2}] [expr {$x+$dx-3}] [expr {$y+$dy-3}]  -tags $tagx -fill $::Fill]
      }
   proc move(circle) {w x y} {
     #$w coords $::ID [lreplace [$w coords $::ID] 2 3 $x $y]
   }

   proc ? L {
   lindex $L [expr {int(rand()*[llength $L])}]
   #suchenwirth_subroutine;
   }
    proc move(Poly) {w x y} {#nothing}
    proc down(clear) {w x y} {
    global helpx
    $w delete "all";
    set helpx 0;
   }
     #-- With little more coding, the Fill mode allows changing an item's fill color:
    proc down(Fill) {w x y} {$w itemconfig current -fill $::Fill}
    proc move(Fill) {w x y} {}
  # touch right mouse, then use middle mouse to pan;
  proc down(pan) {w x y} {}
    proc move(pan) {w x y} {}

    #-- Building the UI
    set modes {Draw Move Clone Fill Rect Oval Poly  exit}
   set modez {canvas circle metal weave pan help binary clear  }
   set colors {
   black white magenta brown red orange yellow green green3 green4
   cyan blue blue4 purple
      }
       set colorz {black brown2 LightGoldenrod1 LightGoldenrod2
       LightGoldenrod3 LightGoldenrod4
      LightYellow2 LightYellow3 LightYellow4 yellow2 yellow3 yellow4
      gold2 gold3 gold4 goldenrod1 goldenrod2 goldenrod3 goldenrod4
      DarkGoldenrod1 DarkGoldenrod2 DarkGoldenrod3
      orange3 orange4 DarkOrange1 DarkOrange2 DarkOrange3 DarkOrange4
      coral1 coral2 coral3 coral4 tomato2 tomato3 tomato4 OrangeRed2
      OrangeRed3 OrangeRed4 red2 red3 red4 DeepPink2 DeepPink3 DeepPink4
      HotPink1 HotPink2 HotPink3 HotPink4 pink1 pink2
   }
      set colorx { blue4 AntiqueWhite3 \
      Bisque1 Bisque2 Bisque3  Bisque4 \
      SlateBlue3 RoyalBlue1 SteelBlue2 \
      DeepSkyBlue3  LightBlue1 DarkSlateGray1 \
      Aquamarine2 DarkSeaGreen2 SeaGreen1 Bisque \
             Yellow1 IndianRed1 IndianRed2 Tan1 \
      lemonchiffon  seashell honeydew mintcream azure \
       peachpuff navajowhite moccasin cornsilk \
       IndianRed3 IndianRed4 sienna1 sienna2 sienna3 sienna4 burlywood1 \
      burlywood2 burlywood3 burlywood4 wheat1 wheat2 wheat3 wheat4 \
      tan2 tan4 chocolate1 chocolate2 chocolate3 firebrick1 firebrick2 \
      firebrick3 firebrick4 \
      }
    global liner
     global ind
     set ind 0
    global   movesit
    set  movesit 1
    set helpx 0
      set loaderx 0
     global xhistory firstnode curnode
    set curnode ""
    set firstnode ""
    set xhistory [list aaa bbb ccc ddd eee fff ggg ]
    set colorground bisque
    global selected_tile previous_tile
    set selected_tile "selected tile";
    set previous_tile "previous tile";
     global counter
     global liner
     global ind
     set ind 0
     set liner [list a b c d e f g ]

     global entries
     set counter 0
     grid [radio .1 Mode $modes]   -sticky nw
     grid [radio .2 Mode $modez ]  -sticky nw

   grid [radio .3 Fill $colors 1]  -sticky nw

   grid [radio .4 Fill $colorx 2] -sticky nw
   grid [radio .5 Fill $colorz 3] -sticky nw
   grid [canvas .c -relief raised -borderwidth 1] - -sticky news

   grid rowconfig . 0 -weight 0
   grid rowconfig . 1 -weight 1
   grid rowconfig . 3 -weight 2
   grid rowconfig . 4 -weight 3
   grid rowconfig . 5 -weight 3
   grid [ label .wcc -text "list of selection history " ]
   grid [entry .wxxccc -textvar e -just left -bg beige -width 50]
   #.wxxccc insert end  "$liner"
   set wow [.c find withtag current];
   .wxxccc insert end  "xxx starter xxx $wow xxx"
   focus .wxxccc           ;# allow keyboard input
   set labelx  [info tclversion];
   grid [ label .ww -text "holding tank, version $labelx " ]
   set txt [text .wxx -width 20 -height 3 -bg beige]
   grid  $txt -sticky news
   focus .wxx           ;# allow keyboard input
   set wow [.c find withtag current];
   .wxx insert end  "xxx starter xxx $wow xxx ";

   #-- The current mode is retrieved at runtime from the global Mode variable:
    bind .c <1> {set firstnode [.c find withtag current];
    initialize %W %x %y ;down($Mode) %W %x %y}
      bind .c <B1-Motion> {move($Mode) %W %x %y}
      bind .c <2>         {%W delete current}
      bind .c <3> {bind .c <2> [bind Text <2>]
      bind .c <B2-Motion> [bind Text <B2-Motion>]
      }
       proc binaryexchange {gualisting} {
       # converts gualisting as a list
       # to binary & decimal numbers.
       global dx dy colors color
       global guabinary guadecimal guatransform
       set guabinary [ whitelist $gualisting ];
       set guabinary [ join [ split $guabinary " "]];
       set guabinary [ plainsub $guabinary 0 0 ];
       set guabinary [ plainsub $guabinary 1 0 ];
       set guabinary [ plainsub $guabinary 2 0 ];
       set guabinary [ plainsub $guabinary 3 1 ];
       set guabinary [ plainsub $guabinary 4 0 ];
       set guabinary [ plainsub $guabinary 5 1 ];
       set guabinary [ plainsub $guabinary 6 0 ];
       set guabinary [ plainsub $guabinary 7 1 ];
       set guabinary [ plainsub $guabinary 8 0 ];
       set guabinary [ plainsub $guabinary 9 1 ];
       set guabinary [ plainsub $guabinary " " "" ];
       return $guabinary;
       }
   proc iching {} {
   .wxx insert 1.0 ""
   set tile  [ expr {int(rand()*1000000000.)}]
   set tile  [ binaryexchange $tile ]
   #set quote [lpick {1 2 3 4 5 6 7 8 9}]
   set binaryfill $tile;
   .wxx insert 1.0 "$binaryfill \n\n\n"
    }
     proc down(binary) {w x y} {
     iching
     }

     proc down(exit) {w x y} {
     exit
     }
       proc helptext {stringxxx} {
       set text_texas {
     # Ka_ching.tcl , test for random binary numbers scheme,
     # goldshell7 ,14Mar2007, working on XP at TCL wiki
     #Used drawing tool by suchenwirth as starter code
     # added colors and report text windows.
       # Tried to note which Suchenwirth subroutines
       # were mostly unchanged.
       #The Iching is the ancient fortune telling
       #book of China. The Iching literature mentions
       #various methods for casting fortune patterns
       #of Iching. The various methods include
       #hot ironing of turtle shells (-t.),
       #manipulations of yarrow sticks, flipping coins,
       #throwing shaman bones, and dice.
       #One analogy from North America
       #is a shaman throwing or
       #shuffling stick dice.

       #I made three stick dice for
       #Iching by cutting a dowel of square cross section
       #into three sticks.
       #For the three stick dice, the flat sides are marked or
       #burned with 2 or 3 holes alternately.
       #Two sticks are marked
       #with {3 2 3 2} dots on the sides. One stick is marked
       #with {3 3 3 2} dots on the sides.
       #In casting such three dice,
       #the possible sums are 6,7,8, or 9. Further, the
       #stick dice are cast six times to obtain whole lines
       #or broken lines in a pattern or set of six lines.
       #A set of six Iching lines is called a gua
       #in the orient or a hexagram in some translations
       #of the Chinese.
       }
       return $text_texas;}
      proc reset {w} {
      global goldmine;
       global loaderx 0;
      upvar 1 .wxx .wxx;
      upvar 1 .wxxccc .wxxccc;
     .wxxccc insert 1 " reset screen  on left mouse & touch screen";
     set gold [list];
     set loaderx 1;
      set helpa  [list reset processing may take considerable time ];

 set helpb  [list reset, processing of holding tank, ];
 lappend helpa $helpb;
 global helpx
 #$w delete .wxxccc;
  set innn 1;
 .wxxccc insert end  $helpa;
 set goldmine [.wxx get 1.0 end] ;

 set goldmine [ string tolower $goldmine ] ;
   set goldmine [ split $goldmine ] ;
    set goldmine [ luniq  $goldmine ] ;
   set res {}
    foreach {a } $goldmine {
 set rook [string length $a] ;
    if {$rook > 3} {lappend res $a}}
 set goldmine $res
    set res {}
    foreach {a } $goldmine {
 set rook [string length $a] ;
   if {$rook > 3} {lappend res [? $goldmine]}}

    set goldmine [ lappend $helpa $res];
    set goldmine [plainsub $goldmine # ""];
    set goldmine [plainsub $goldmine \) ""];
    set goldmine [plainsub $goldmine \( ""];
    set goldmine [plainsub $goldmine \} ""];
    set goldmine [plainsub $goldmine \{ ""];

    set goldmine [stringxxx $goldmine ];
     set goldmine [ luniq  $goldmine ] ;
     printstuff $goldmine ;

     #set goldmine [ smoothxxx $goldmine ] ;
 }
      proc printstuff { bigstring } {
      set i 0;
      foreach {a b} $bigstring {

       puts stdout "      $a $b                               #$i   \n

     ";
      incr i;
      }

       }
  proc down(weave) {w x y} {
     global count
     set xwidth 200;
     set xheight 200;
   .wxxccc insert 1 " weave  processing time substantial ";
    if  { $count  == 0 } {
    .wxxccc insert 1 " weave 1 processing time substantial ";

    colorweave  w x y $xwidth $xheight 1 }

       if  { $count  == 1 } {
     .wxxccc insert 1 " weave style 10  processing time substantial ";

 colorweave  w x y $xwidth $xheight 5  }

    if {$count == 2 } {
   .wxxccc insert 1 " weave style 3 on left mouse & touch screen "

 colorweave  w x y $xwidth $xheight 2   }
   if { $count == 3 } {

  .wxxccc insert 1 " weave style 4   on left mouse & touch screen "
    colorweave  w x y $xwidth $xheight 1 }
  if { $count == 4 } {

     .wxxccc insert 1 " weave style 5   on left mouse & touch screen "
    colorweave  w x y $xwidth $xheight 3 }
 incr count 1;
    if { $count == 5 } {
 set count 0}

 }

    proc move(weave) {w x y} {}
    proc stringinsert {string pos char} {
    set original [string index $string $pos]
    string replace $string $pos $pos $char$original
 } ;# RS
    proc colortalk { w x y $width $height colorgroundx } {
    global colorvalue1 colorvalue2
    global rbg1 rbg2 colorvalue1 colorvalue2
    global colorground
     upvar 1 .wxx .wxx;
     upvar 1 .wxxccc .wxxccc;

         set n [catch {winfo rgb . $::Fill} rgb];
          if {$n} continue;
          # Convert to HSV and get the V value to determine fill color;
          set colorvalue1 [lindex [lsort -integer $rgb] end];
          set colorvalue1 [expr {$colorvalue1 / double(65535)}];
          set rgb2 [eval format #%04X%04X%04X [winfo rgb . $::Fill]];
          set n [catch {winfo rgb . $colorground} rgb];

          set colorvalue2 [lindex [lsort -integer $rgb] end];
          set colorvalue2 [expr {$colorvalue2 / double(65535)}];
          set rgb3 [eval format #%04X%04X%04X [winfo rgb . $colorground]];

        set rgb3 [eval format #%04X%04X%04X [winfo rgb . $colorground]];
        .wxxccc insert end " canvas_color 33 $colorground \( rgb $rgb3 \) $colorvalue2 pen_color $::Fill $colorvalue1 $::Fill \(rgb $rgb2 \) \n";

    .wxx insert end " canvas_color 22 $colorground \( rgb $rgb3 \) $colorvalue2   pen_color  $::Fill  $colorvalue1 $::Fill \(rgb $rgb2  \) \n";
     set colorvalue1 [expr { int ($colorvalue1 * 100000)} ] ;
     set rgb5 [winfo rgb . $colorground];
     set colorvalue5 [lindex [lsort -integer $rgb5] end];
    .wxx insert end " test metal_colors  44 $colorground    $rgb5 $colorvalue5 \n";
      #[lpick [list "\#054505" "\#058505" "\#057505"]]  return "\#054505";

}

   # set testererer [ colortalk w x y $width $height $colorground  ];

   proc  colorweave { w x y width height rownumber} {
 set width   400
      set height  200
  global colorground
  .wxxccc insert 1 " metal > processing time substantial ";
     upvar 1 .wxx .wxx;
  .wxxccc insert 1 " create metal background on left mouse & screen touch  ";
     set testererer 45000;
   set testererer [ colortalk w x y $width $height $colorground  ];
    for {set row 0} {$row < $height} {incr row $rownumber} {
      # set line_color [expr {450000+int(1000000*rand())%3000}];
      set line_color [expr { int(45000 ) +int(1000000*rand())%3000}];
     if { $rownumber > 3 } { set line_color [expr { int(500 ) +int(1000000*rand())%3000}];}
    set testererer [winfo rgb . $colorground];
    set rgb3 [eval format #%04X%04X%04X [winfo rgb . $colorground]];
            #"\#057505";#099999957505
     set n [catch {winfo rgb . $colorground} rgb];

    if {$n} continue;
          # Convert to HSV and get the V value to determine fill color;
          set colorvalue1 [lindex [lsort -integer $rgb] end];
          set colorvalue1 [expr {$colorvalue1 / double(65535)}];
          set rgb2 [eval format #%04X%04X%04X [winfo rgb . $::Fill]];
          set n [catch {winfo rgb . $colorground} rgb];
   #.wxx insert end "  special test metal background $testererer real n $n \n"
   set testa  [split [winfo rgb . $::Fill ]];
  set testr [join [split [winfo rgb . $::Fill ]]];
  #.wxx insert end "  special test metal background $testa   \n"
 set test1 [ stringinsert $testr 2 "99" ];
 set test2 [ stringinsert $testr 2 "88" ];
 set test3 [ stringinsert $testr 2 "77" ];
 set testi [ concat $test1 $test2 $test3 ];
 set testi [ stringinsert $test1 2 "" ];
 set testi "\#654535";
 catch {set testi [eval format #%04X%04X%04X [winfo rgb . $::Fill]];}
 set test1 [ stringinsert $testi 12 "9" ];
 set test2 [ stringinsert $testi 8 "8" ];
 set test3 [ stringinsert $testi 4 "7" ];
 set test4 $testi;
 set xlength [string length $testi];
 set xlength [expr { $xlength - 1 }];
 set test1 [ string range   $test1  0  $xlength  ];
 set test2 [ string range   $test2  0  $xlength  ];
 set test3 [ string range   $test3  0  $xlength  ];
  #.wxx insert end "  special test metal background $testererer  \n"
       .c create line 0 $row $width $row -width 1 \
         -fill [ lpick [list $test1 $test2 $test3 $test4]]
   #  \#654545

      }
      }
     proc down(help) {w x y} {
      set tile  [expr {int(rand()*1000000000.)}]
      set poof  "help" ;
      global helpx
     if {$helpx > 0} {return}
      set tagx [list $poof mv "obj_$tile" "colorit_$::Fill"  d-$x$y];
     set base "help";
     set helpx 0;
     set baseline [helptext $base];
     #if {![info exists L]} {set L {}}
     set ::ID [$w create text $x  $y  -text $baseline -tags $tagx -fill $::Fill ]
     set helpx 1;

   }
   proc move(help) {w x y} {}
  proc down(metal) {w x y} {
     set xwidth 200;
     set xheight 200;
 heavymetal  w x y $xwidth $xheight
  make_gradient $w 50 50
    make_gradient $w 30 15
    make_gradient $w 15 15 }
   proc move(metal) {w x y} {}
   proc down(metal) {w x y} {
     set xwidth 200;
     set xheight 200;
 heavymetal  w x y $xwidth $xheight
  make_gradient $w 50 50
    make_gradient $w 30 15
    make_gradient $w 15 15 }

    proc heavymetal { w x y width height } {
 set width   400
      set height  200
  .wxxccc insert 1 " metal processing substantial ";
          for {set row 0} {$row < $height} {incr row 1} {
          set line_color [expr {45000+int(1000000*rand())%3000}]
          .c create line 0 $row $width $row -width 1 \
                  -fill [format "#%04x%04x%04x" \
                  $line_color $line_color $line_color]
      }
      }

    proc make_gradient { canvas N M } {
    set width [$canvas cget -width]
    set height [$canvas cget -height]

    set dx [expr {double($width)/double($N)}]
    set dy [expr {double($height)/double($M)}]
    set a [expr {pow(double($N)/2.0,2)+pow(double($M)/2.0,2)}]

    for {set i 0} {$i <= $N} {incr i} {
        for {set j 0} {$j <= $M} {incr j} {
            set x1 [expr {$dx*double($i)}]
            set x2 [expr {$x1+$dx}]
            set y1 [expr {$dy*double($j)}]
            set y2 [expr {$y1+$dy}]

            set k [expr {int(30000+25000*(1.0 - \
                    0.8*(pow(double($i-$N/2.0),2) + \
                    pow(double($j-$M/2.0),2))/$a))}]

            $canvas create rectangle $x1 $y1 $x2 $y2 \
                    -fill [format "#%04x%04x%04x" $k $k $k] \
                    -width 0
        }
    }
 }
   proc move(metal) {w x y} {}
   proc initialize {w x y} {
      global tile
      global xhistory firstnode curnode
      global ind movesit
    set tile [.c find withtag current]
      set number 2
       set numberx 2
       set ::_x $x; set ::_y $y;
       set firstnode [.c find withtag current]
    set number  [$w gettags current]
     set indexer [string first "mv" $number ];
     set numberx  [string range $number 0 $indexer];
       .wxx delete 1.0 end;
     # general reporting line
    .wxx insert end " xxx $number xxx $numberx xxx \
   indexer  xxx  $indexer xxx number of tiles xxxx \
   $ind xxxx object xxx $tile xxx $ind xxx number of \
    straight moves xxx $movesit xxx ";
     #.wxxccc delete 1.0 end;
     # general reporting line
    .wxxccc insert end " xxx $number xxx $numberx xxx \
   indexer  xxx  $indexer xxx number of tiles xxxx \
   $ind xxxx object xxx $tile xxx $ind xxx number of \
    straight moves xxx $movesit xxx ";
     incr movesit

    }
   #endofdeck
======
---- AUX program
======
#
# Example 30-1
# A text widget and two scrollbars.
#

proc Scrolled_Text { f args } {
        frame $f
        eval {text $f.text -wrap none \
                -xscrollcommand [list $f.xscroll set] \
                -yscrollcommand [list $f.yscroll set]} $args
        scrollbar $f.xscroll -orient horizontal  \
                -command [list $f.text xview]
        scrollbar $f.yscroll -orient vertical  \
                -command [list $f.text yview]
        grid $f.text $f.yscroll -sticky news
        grid $f.xscroll -sticky news
        grid rowconfigure $f 0 -weight 1
        grid columnconfigure $f 0 -weight 1
        return $f.text
}


set t [Scrolled_Text .eval -width 30 -height 10 -bg bisque]
set x [Scrolled_Text .eval2 -width 30 -height 10 -bg bisque]
pack .eval .eval2 -fill both -expand true -side right
$t insert end  "  identified !!!"  ;

$x insert end  " second identified !!!"  ;

proc uniswap {L} {
     # removes duplicates without sorting the input list
     # swap asterisk with haiku poetic "cutting" words 
     global v t
     set t {}
     set v {}
     foreach i $L {if {[lsearch -exact $t $i]==-1} {lappend t $i}}
     foreach i $L {if { $i != "*" } {lappend v $i}
     if { $i == "*" } {lappend v   [lpick { 
 
      ya  kana zo yo keri}]     }

      }
     return $v
     } ;# RS

 proc plainsub {text item replacewith} {
set text [string map [list $item $replacewith] $text] 
}   

 variable bg black  fg white  
      
   set dx 50
   set dy 50
   set size 30
   set colorground bisque
  

proc ? L {
 lindex $L [expr {int(rand()*[llength $L])}]
}

 proc lpick L {lindex $L [expr int(rand()*[llength $L])]; \
  #suchenwirth_subroutine;}
  proc poetry jill {
  set jill [lpick { tree happy grass love swan home  \
      power loss dance rose joy hate juice kick deer}]
 
  return $jill;
  }

     proc xpoetry {w x y val1 val2} {
    global jack
    global jill
     variable bg; variable fg; variable size
      set jack [lpick {red yellow blue purple \
      pink green brown black  gray}]
   set jill rose
     #remaining doctered_suchenwirth_subroutine;
     set tags [list mv d-$val1$val2];
     #remaining doctered_suchenwirth_subroutine;
     set x1 [expr {$x+$size-0.5}]
     set y1 [expr {$y+$size}]
     $w create rect $x $y [expr {$x+2*$size}] $y1 \
         -fill $jack -tags [linsert $tags 0 bd-$val1$val2]
     $w create text [expr {$x+1*$size}]   [expr {$y+0.5*$size }] \
        -text   [eval poetry $jill] -fill $fg -tags $tags

  }
  proc xxxpoetry {w x y val1 val2 rose5} {
    global jack
    global jill
     variable bg; variable fg; variable size
      set jack [lpick {red yellow blue purple \
      pink green brown black  gray}]
   set jill rose
     #remaining doctered_suchenwirth_subroutine;
     set tags [list mv d-$val1$val2];
     #remaining doctered_suchenwirth_subroutine;
     set x1 [expr {$x+$size-0.5}]
     set y1 [expr {$y+$size}]
     $w create rect $x $y [expr {$x+2*$size}] $y1 \
         -fill $jack -tags [linsert $tags 0 bd-$val1$val2]
     $w create text [expr {$x+1*$size}]   [expr {$y+0.5*$size }] \
        -text   $rose5 -fill $fg -tags $tags

  }

proc recipe {} {
  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}
     
  }

   set word1 rose
   set dy 20
   set dx 20
 for {set i 0; set y 0} {$i<8} {incr i; incr y $dy} {
for {set j 0; set x 0} {$j<8} {incr j; incr x $dx}   {
         xxxpoetry .c [expr $i*65+10] [expr $j*35+100] $i $j "[? $a]."
   
    incr j
xxxpoetry .c [expr $i*65+10] [expr $j*35+100] $i $j "[? $b]."

    incr j
xxxpoetry .c [expr $i*65+10] [expr $j*35+100] $i $j "[? $c]."
  incr j
xxxpoetry .c [expr $i*65+10] [expr $j*35+100] $i $j "[? $d]."
 incr j
xxxpoetry .c [expr $i*65+10] [expr $j*35+100] $i $j "[? $a]."
  incr j
xxxpoetry .c [expr $i*65+10] [expr $j*35+100] $i $j "[? $b]."
  } 

 }

  return "    
   [? $a].
   [? $b].
   [? $c].
   [? $d].
   [? $a]. 
 [? $b].      "
   
}



if {[file tail [info script]]==[file tail $argv0]} {
  package require Tk
  pack [text .t -width 40 -height 20]
  pack [canvas .c -background darkgreen] -fill both -expand 1
 

   proc poetryrandom {w} {
   set dx 50
   set dy 50
   set size 30
   set word5 roset 
     for {set i 0; set y 0} {$i<8} {incr i; incr y $dy} {
     for {set j 0; set x 0} {$j<8} {incr j; incr x $dx}   {
         xpoetry .c [expr $i*65+10] [expr $j*35+100] $i $j
     }
  }
   }

   proc poetrypoetry {w} {
    set dx 50
   set dy 50
   set size 30
   set word5 roset
  recipe
   }
 bind .t <1> {$x insert end  " $keeper" ; $t insert end " $keeper"  ; ;showRecipe %W; break}
  proc showRecipe w {
    global keeper
    $w delete 1.0 end
    $w insert end [recipe]
    set keeper [recipe]
  }
  showRecipe .t
}
  
   proc ClrCanvas {w} {

    $w delete "all"

  }
    
   #motion section
 if 0 {Clicking on a piece records \
  the click position, and its "catch-all"  tag, \
  in global variables:}
  proc mv'1 {w x y} {
     set ::_x $x; set ::_y $y;#suchenwirth subroutine;
     foreach tag [$w gettags current] {
         if [regexp ^(d-.+) $tag -> ::_tag] break
     }
  }
   if 0 {Moving the mouse with button 1 down \
  moves the items with the  "catch-all" tag \
  with the mouse pointer:}
   proc mv'motion {w x y} {
     $w raise $::_tag;#suchenwirth subroutine;
     $w move $::_tag [expr {$x-$::_x}] [expr {$y-$::_y}]

     set ::_x $x; set ::_y $y

  }
  .c bind mv <1>         {mv'1 %W %x %y}
   .c bind mv <B1-Motion> {mv'motion %W %x %y}
  .c bind mv <B3-Motion> {select&die %W %x %y}
  .c bind mv <B2-Motion> {move&die %W %x %y}
   #-- Little development helpers (optional):

   bind . <Escape> { exit}
   bind . <F1> {destroy .}
 
  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 white

  button  .b0 -text "clear" -command {  ClrCanvas .c }
  button  .b1 -text "poetry"  -command {ClrCanvas .c ;poetrypoetry .c }
  button  .b2 -text "exit"  -command {exit   }
  button  .b3 -text "ra. words"   -command {ClrCanvas .c ;poetryrandom .c }
  button  .b4 -text "exit"   -command {exit   }
  button  .b5 -text "exit"   -command { exit }
  button  .b6 -text "exit"   -command { exit }
  button  .b7 -text "exit"   -command { exit }
  button  .b8 -text "exit"   -command { exit }
  button  .b9 -text "exit"   -command { exit }
  button  .b10 -text "exit"   -command { exit }

  pack .b0 .b1 .b2 .b3 .b4 .b5  .b6 .b7 .b8 .b9 .b10   -side left -padx 2
======

----
!!!!!!
%| [Category Toys] |%
!!!!!!