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

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