----
***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.
             

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.


                 
----
***Program Listing***
======
       

     #!/usr/bin/env wish
        #start of deck
        #start of deck
        #start of deck
        #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

   set tile  [ expr {int(rand()*1000000000.)}]
     #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 -outline blue -tags [list $tile ]
     $w create text [expr {$x+1*$size}]   [expr {$y+0.5*$size }] \
        -text   [eval poetry $jill] -fill $fg -tags [list $tile ]

  }
  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

  }
 
   
        global tile tile2
        global xhistory firstnode curnode secondnode
        global ind movesit
      set tile [.c find withtag current]
        set number 2
         set numberx 2
         global tile1
     proc starttalk {} {

  global x t
 $t delete 1.0 end 
    $x delete 1.0 end    
$t insert end " mahjong activated !!! tiles with same text should be filled/outlined in
    red"  ;

$x insert end  " mahjong activated !!! pick first tile with left mouse button!
   pick second tiles with right mouse button!! tiles with same text should 
red font before rapid destruction. 
picking third tile may (buggy) abandon choice of first tile.
unmatched tiles and or mismatched tiles will be in green (first pick)
  and blue fonts (second pick. "
}

        # set firstnode [.c find withtag current]
  proc pick2 {  } {
     global firstnode xictims x t previousselect
     set tclerror zero
     set secondnode loserloser
     catch { set secondnode [.c itemcget current -text] }  tclerror  
      set tile2 [.c itemcget current -tags ];
     set tile3 [ list 1 2 ]
    catch { set tile3   [eval .c find overlapping [.c bbox current] ] }
     set tile4  [lindex $tile3 1]
     $x delete 1.0 end 
      $x insert end  " mahjong tiles ided, n5 $tile3 n5 n7  possible_error_diagnostic  $tclerror  n7"
  
    if { $secondnode == $firstnode} { 
     .c itemconfigure  [.c find withtag current]  -fill red ;
     .c itemconfigure  [.c find withtag previous]  -fill red ;
 
    set id [.c find withtag current];
    set firstchance [lindex [.c gettags $id] 0];
    set fir   [.c find withtag $firstchance  ];     
    set lcoords [.c coords  [.c find withtag current]  ]
        set xx [lindex $lcoords 0];
        set yy [lindex $lcoords 1];
        set xxxx [expr {[lindex $lcoords 0] + 10} ] ;
        set yyyy [expr {[lindex $lcoords 1] + 10} ] ;
   

   $t delete 1.0 end ;
   $t insert end " tile location is $xx $yy $xxxx $yyyy n2";
 set victims [.c find overlapping  $xx $yy $xxxx $yyyy ];  
foreach element $victims { 

 .c delete  $element ;

   $t insert end " captured tile number is  $element  n2";
 }      
       foreach element $xictims { 

 .c delete  $element ;

   $t insert end " captured tile number is  $element  n2";
 }    

  #.c delete [.c find withtag $firstchance ];
   #.c delete [.c find withtag $chancy];  
  #  .c delete [.c find withtag -fill red]; 
    
   $t insert end " tile location is $xx $yy $xxxx $yyyy n2 n3 targeted tiles $victims n3";
   $t insert end " tile  n3 targeted tiles $xictims n3";
  } 


      if { $secondnode != $firstnode} {

      
  .c itemconfigure  $tile4  -fill blue ;
 .c itemconfigure [.c find withtag previous] -tag previous2; }    




     return
      }
    
      proc pick1 { t } {
     global firstnode xictims previousselect x
    set firstnode "rose10";
     set secondnode "rose20";   
         set tclerror zero
   set tile3    [ list  1 2 ]  
     catch { set firstnode [.c itemcget current -text] }  tclerror  
catch {  set tile3   [eval .c find overlapping [.c bbox current] ] } tclerror 
     set tile4  [lindex $tile3 1]
     $x delete 1.0 end 
      $x insert end  " mahjong tiles ided, n5 $tile3 n5 n7  possible_error_diagnostic  $tclerror  n7"
   
    set id [.c find withtag current]
    set chancy [lindex [.c gettags $id] 0]
    set tile1 [ .c itemcget current -tags ]
    #.c itemconfigure  [.c find withtag current]  -tag previous; 
     # .c itemconfigure  [.c find withtag current]  -fill green ;
    .c itemconfigure  $tile4  -fill green ;
    set previousselect 1
   set lcoords [.c coords  [.c find withtag current]  ]

    if { [lindex $lcoords 0] == ""} {
      $t delete 1.0 end ;
      $t insert end "___warning, picked outside mahjong window";
      $t insert end "___causing exit from mahjong processes. bye bye!"
      movetiles ;return};
        set xx [lindex $lcoords 0];
        set yy [lindex $lcoords 1];
        set xxxx [expr {[lindex $lcoords 0] + 10} ] ;
        set yyyy [expr {[lindex $lcoords 1] + 10} ] ;
   set xictims [.c find overlapping  $xx $yy $xxxx $yyyy ]; 

   $t delete 1.0 end ;
   $t insert end " tile location is $xx $yy $xxxx $yyyy n2";
   return 
 }     
    


   set number  [ .c gettags current]
   proc movetiles {} {
   bind . <1> {}
   bind . <3> {}
  .c bind mv <1>         {mv'1 %W %x %y} ;
  .c bind mv <B1-Motion> {mv'motion %W %x %y} ;
    }
     global previousselect
    set previousselect 0
    proc mahjongstyle {} {
   starttalk
    global x t
   .c bind mv <1>         { } ;
  .c bind mv <B1-Motion> { } ;
    bind . <1>         {     
     pick1  $t
 
     }
      
   bind . <3>         { 
      pick2
     

      set previousselect 0
      }
  
   
  }

   #-- Little development helpers (optional):

   bind . <Escape> { exit}
   bind . <F1> {destroy .}  
   console hide 
  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 "move"  -command {movetiles }

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

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

  button  .b5 -text "mahjong"   -command {ClrCanvas .c ;poetryrandom .c; mahjongstyle }
  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
    
  
      #end of deck
      #end of deck      
      #end of deck
    #end of deck
======
----
**Screenshots**


[WikiDbImage Random_Poetry_Chalkboard.PNG]
**Comments**
Please place any comments here, Thanks.

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

    
----
**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***
======
======
***AUX program****

   #!/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

  }
 
   
        global tile
        global xhistory firstnode curnode secondnode
        global ind movesit
      set tile [.c find withtag current]
        set number 2
         set numberx 2
         global tile1
         set firstnode [.c find withtag current]
      set number  [ .c gettags current]
   proc movetiles {} {
   bind . <1> {}
   bind . <3> {}
  .c bind mv <1>         {mv'1 %W %x %y} ;
  .c bind mv <B1-Motion> {mv'motion %W %x %y} ;
    }

    proc mahjongstyle {} {
    global x t
    bind . <1>         { set firstnode [ .c itemcget current -text ] ;
      .c itemconfigure  [.c find withtag current]  -tag previous; 

    }

   bind . <3>         {  set secondnode [.c itemcget current -text];
    if { $secondnode == $firstnode} { .c itemconfigure  [.c find withtag current]  -fill red;
    
     .c itemconfigure  [.c find withtag previous]  -fill red ;
    
     .c delete  [.c find withtag current];
     .c delete  [.c find withtag previous]; 





     } }
  




    $t delete 1.0 end 
    $x delete 1.0 end    
$t insert end " mahjong activated !!! tiles with same text should be filled/outlined in
    red"  ;

$x insert end  " mahjong activated !!! pick first tile with left mouse button!
   pick second tiles with right mouse button!! tiles with same text should be outlined in
in red border. picking third tile may (buggy) abandon choice of first tile"
  }

   #-- Little development helpers (optional):

   bind . <Escape> { exit}
   bind . <F1> {destroy .}  
   console hide 
  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 "move"  -command {movetiles }

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

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

  button  .b5 -text "mahjong"   -command { mahjongstyle }
  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

======

     #!/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

  }
 
   
        global tile
        global xhistory firstnode curnode secondnode
        global ind movesit
      set tile [.c find withtag current]
        set number 2
         set numberx 2
         global tile1
         set firstnode [.c find withtag current]
      set number  [ .c gettags current]
   proc movetiles {} {
   bind . <1> {}
   bind . <3> {}
  .c bind mv <1>         {mv'1 %W %x %y} ;
  .c bind mv <B1-Motion> {mv'motion %W %x %y} ;
    }

    proc mahjongstyle {} {
    global x t
    bind . <1>         { set firstnode [ .c itemcget current -text ] ;
      .c itemconfigure  [.c find withtag current]  -tag previous; 

    }

   bind . <3>         {  set secondnode [.c itemcget current -text];
    if { $secondnode == $firstnode} { .c itemconfigure  [.c find withtag current]  -fill red;
    
     .c itemconfigure  [.c find withtag previous]  -fill red ;
    
     .c delete  [.c find withtag current];
     .c delete  [.c find withtag previous]; 





     } }
  




    $t delete 1.0 end 
    $x delete 1.0 end    
$t insert end " mahjong activated !!! tiles with same text should be filled/outlined in
    red"  ;

$x insert end  " mahjong activated !!! pick first tile with left mouse button!
   pick second tiles with right mouse button!! tiles with same text should be outlined in
in red border. picking third tile may (buggy) abandon choice of first tile"
  }

   #-- Little development helpers (optional):

   bind . <Escape> { exit}
   bind . <F1> {destroy .}  
   console hide 
  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 "move"  -command {movetiles }

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

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

  button  .b5 -text "mahjong"   -command { mahjongstyle }
  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
*** old program listing****

     #!/usr/bin/env wish
        #start of deck
        #start of deck
        #start of deck
        #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

   set tile  [ expr {int(rand()*1000000000.)}]
     #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 -outline blue -tags [list $tile ]
     $w create text [expr {$x+1*$size}]   [expr {$y+0.5*$size }] \
        -text   [eval poetry $jill] -fill $fg -tags [list $tile ]

  }
  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

  }
 
   
        global tile tile2
        global xhistory firstnode curnode secondnode
        global ind movesit
      set tile [.c find withtag current]
        set number 2
         set numberx 2
         global tile1
     proc starttalk {} {

  global x t
 $t delete 1.0 end 
    $x delete 1.0 end    
$t insert end " mahjong activated !!! tiles with same text should be filled/outlined in
    red"  ;

$x insert end  " mahjong activated !!! pick first tile with left mouse button!
   pick second tiles with right mouse button!! tiles with same text should 
red font before rapid destruction. 
picking third tile may (buggy) abandon choice of first tile.
unmatched tiles and or mismatched tiles will be in green (first pick)
  and blue fonts (second pick. "
}

        # set firstnode [.c find withtag current]
     proc pick2 {  } {
     global firstnode xictims x t previousselect
      set secondnode [.c itemcget current -text];
      set tile2 [.c itemcget current -tags ];
   
    if { $secondnode == $firstnode} { 
     .c itemconfigure  [.c find withtag current]  -fill red ;
     .c itemconfigure  [.c find withtag previous]  -fill red ;
 
    set id [.c find withtag current];
    set firstchance [lindex [.c gettags $id] 0];
    set fir   [.c find withtag $firstchance  ];     
    set lcoords [.c coords  [.c find withtag current]  ]
        set xx [lindex $lcoords 0];
        set yy [lindex $lcoords 1];
        set xxxx [expr {[lindex $lcoords 0] + 10} ] ;
        set yyyy [expr {[lindex $lcoords 1] + 10} ] ;
   

   $t delete 1.0 end ;
   $t insert end " tile location is $xx $yy $xxxx $yyyy n2";
 set victims [.c find overlapping  $xx $yy $xxxx $yyyy ];  
foreach element $victims { 

 .c delete  $element ;

   $t insert end " captured tile number is  $element  n2";
 }      
       foreach element $xictims { 

 .c delete  $element ;

   $t insert end " captured tile number is  $element  n2";
 }    

  #.c delete [.c find withtag $firstchance ];
   #.c delete [.c find withtag $chancy];  
  #  .c delete [.c find withtag -fill red]; 
    
   $t insert end " tile location is $xx $yy $xxxx $yyyy n2 n3 targeted tiles $victims n3";
   $t insert end " tile  n3 targeted tiles $xictims n3";
  } 


      if { $secondnode != $firstnode} {

      if { $previousselect != 1 } {return}

 .c itemconfigure [.c find withtag current] -fill blue; 
 .c itemconfigure [.c find withtag previous] -tag previous2; }    




     return
      }
    proc pick1 { t } {
     global firstnode xictims previousselect
    set firstnode "rose10";
     set secondnode "rose20";    
    set firstnode [ .c itemcget current -text ] ;
    set id [.c find withtag current]
    set chancy [lindex [.c gettags $id] 0]
    set tile1 [ .c itemcget current -tags ]
    #.c itemconfigure  [.c find withtag current]  -tag previous; 
      .c itemconfigure  [.c find withtag current]  -fill green ;
    set previousselect 1
   set lcoords [.c coords  [.c find withtag current]  ]

    if { [lindex $lcoords 0] == ""} {
      $t delete 1.0 end ;
      $t insert end "___warning, picked outside mahjong window";
      $t insert end "___causing exit from mahjong processes. bye bye!"
      movetiles ;return};
        set xx [lindex $lcoords 0];
        set yy [lindex $lcoords 1];
        set xxxx [expr {[lindex $lcoords 0] + 10} ] ;
        set yyyy [expr {[lindex $lcoords 1] + 10} ] ;
   set xictims [.c find overlapping  $xx $yy $xxxx $yyyy ]; 

   $t delete 1.0 end ;
   $t insert end " tile location is $xx $yy $xxxx $yyyy n2";
   return 
 }
   set number  [ .c gettags current]
   proc movetiles {} {
   bind . <1> {}
   bind . <3> {}
  .c bind mv <1>         {mv'1 %W %x %y} ;
  .c bind mv <B1-Motion> {mv'motion %W %x %y} ;
    }
     global previousselect
    set previousselect 0
    proc mahjongstyle {} {
   starttalk
    global x t
   .c bind mv <1>         { } ;
  .c bind mv <B1-Motion> { } ;
    bind . <1>         {     
     pick1  $t
 
     }
      
   bind . <3>         { 
      pick2
     

      set previousselect 0
      }
  
   
  }

   #-- Little development helpers (optional):

   bind . <Escape> { exit}
   bind . <F1> {destroy .}  
   console hide 
  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 "move"  -command {movetiles }

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

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

  button  .b5 -text "mahjong"   -command {ClrCanvas .c ;poetryrandom .c; mahjongstyle }
  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

======

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