This page uses TCL8/Expect 5.2 for windows to develop  
Refrigerator magnetic Poetry. 
For example, we are laying out tiles in random colors 
imprinted with text and symbols applied randomly.  
Would also like to develop a crude Mahjong program using some of these subroutines.

[http://mini.net/files/fridge.jpg]

'''Strengths'''
  test picture???
 [http://mini.net/files/balance.gif]
   

   ''Subroutine use whereever possible.'':   This one 
   [Refrigerator_Magnetic_Poetry]
----
 #Refrigerator_Magnetic_Poetry
    # Start of Deck
    #Refrigerator_Magnetic_Poetry
    # Start of Deck
     package require Tk
    proc down(reset) {w x y} {
   reset $w
   }
   proc move(reset) {w x y} {}
    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 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
   }
  proc luniq {L} {
     # removes duplicates without sorting the input list
     set t {}
     foreach i $L {if {[lsearch -exact $t $i]==-1} {lappend t $i}}
     return $t
  } ;# RS
   #-- 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 tile  [expr {int(rand()*1000000000.)}]
      set poof  "rectangle" ;
      set tagx [list $poof mv "obj_$tile" "colorit_$::Fill"  d-$x$y];
      set ::ID [$w create rect $x $y $x $y -tags $tagx -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 tile  [expr {int(rand()*1000000000.)}]
      set poof  "oval" ;
      set tagx [list $poof mv "obj_$tile" "colorit_$::Fill"  d-$x$y];
     set ::ID [$w create oval $x $y $x $y -tags $tagx -fill $::Fill]
   }
   proc move(Oval) {w x y} {
     $w coords $::ID [lreplace [$w coords $::ID] 2 3 $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 down(Poly) {w x y} {
     if [info exists ::Poly] {
      set tile  [expr {int(rand()*1000000000.)}]
      set poof  "poly" ;
      set tagx [list $poof mv "obj_$tile" "colorit_$::Fill"  d-$x$y];

         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 -tags "obj_[expr {int(rand()*1000000000.)}]" -fill $::Fill ]
     }
   }

   proc ? L {
     lindex $L [expr {int(rand()*[llength $L])}]
     #suchenwirth_subroutine;
     }
   proc move(Poly) {w x y} {#nothing}

   #-- 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} {}
    proc lcount list {
     foreach x $list {lappend arr($x) {}}
     set res {}
     foreach name [array names arr] {
        lappend res [list $name [llength $arr($name)]]
     }
     return $res
  }
  #lcount {yes no no present yes yes no no yes present yes no no yes yes}
  #{no 6} {yes 7} {present 2}
 proc translationx {string dictName} {
     #suchenwirth_subroutine;

   upvar 1 $dictName dict
    set res {}
    foreach word $string {
        if [info exists dict($word)] {set word $dict($word)}
        lappend res $word
    }
    set res
 }
   proc plural word {
    switch -- $word {
        man   {return men}
        foot  {return feet}
        goose {return geese}
        louse {return lice}
        mouse {return mice}
        ox    {return oxen}
        tooth {return teeth}
        calf - elf - half - hoof - leaf - loaf - scarf
        - self - sheaf - thief - wolf
              {return [string range $word 0 end-1]ves}
        knife - life - wife
              {return [string range $word 0 end-2]ves}
        auto - kangaroo - kilo - memo
        - photo - piano - pimento - pro - solo - soprano - studio
        - tattoo - video - zoo
              {return ${word}s}
        cod - deer - fish - offspring - perch - sheep - trout
        - species
              {return $word}
        genus {return genera}
        phylum {return phyla}
        radius {return radii}
        cherub {return cherubim}
        mythos {return mythoi}
        phenomenon {return phenomena}
        formula {return formulae}
    }
    switch -regexp -- $word {
      
      {[ei]x$}                  {return [string range $word 0 end-2]ices}
      {[sc]h$} - {[soxz]$}      {return ${word}es}
      {[bcdfghjklmnprstvwxz]y$} {return [string range $word 0 end-1]ies}
      {child$}                  {return ${word}ren}
      {eau$}                    {return ${word}x}
      {is$}                     {return [string range $word 0 end-2]es}
      {woman$}                  {return [string range $word 0 end-2]en}
      
    }
    return ${word}s
 }
  proc keyget {list key} {
    foreach {lkey value} $list {
        if [string equal $lkey $key] {return $value}
    }
 } ;# RS
 # % keyget {fnm John lnm Brown phone (123)456-7890 email john@brown.com} phone
 # (123)456-7890
 # % keyget {fnm John lnm Brown phone (123)456-7890 email john@brown.com} fax

 proc lswap list {
    set res {}
    foreach {a b} $list {lappend res $b $a}
    set res
 } ;# RS
 # % lswap {a b c d e f g h}
 # b a d c f e h g
 #Prepend elements to a list (add in front):

 proc lprepend {var args} {
    upvar 1 $var v
    set v [eval [list linsert $v 0] $args]
 } ;# DKF


 proc kvsearch {kvlist item} {
   set pos [lsearch $kvlist $item]
   if {$pos != -1} {
      lindex $kvlist [expr {$pos+1-2*($pos%2)}]
   }
 } ;# RS
 ## kvsearch {1 one 2 two 3 three} four ;# returns empty string/list
 # kvsearch {1 one 2 two 3 three} 1
 #one
 #% kvsearch {1 one 2 two 3 three} one
 #1
 
   #-- Building the UI
 
   set modes {Draw Move Clone Fill Rect Oval Poly circle canvas Poetry hairs zone help clear reset exit}
  set colors {
     blue3 white magenta brown red orange yellow green green3 green4
     cyan blue blue2 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 \
      }
       set colork [list seashell honeydew gainsboro floralwhite \
       oldlace linen antiquewhite papayawhip blanchedalmond \
      bisque  peachpuff navajowhite moccasin cornsilk ivory \
      lemonchiffon  seashell honeydew mintcream azure]

     global helpx
       global liner
       global ind
       set ind 0
      global   movesit
      set helpx 0
      set  movesit 1
      set colorground bisque
      global xhistory firstnode curnode
      set curnode ""
      set firstnode ""
      set xhistory [list aaa bbb ccc ddd eee fff ggg ]
     set xhistory [list  ]
     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 tilex tagx tagz
       set tilex "obj_66666test"
       set tagx "obj_77777test"
       set tagz "obj_55555test "
       global entries
       set counter 0
   grid [radio .1 Mode $modes]  -sticky nw
   grid [radio .2 Fill $colors 1]  -sticky nw
  
   grid [radio .3 Fill $colorx 2] -sticky nw
   grid [radio .4 Fill $colorz 3] -sticky nw
   grid [canvas .c -relief raised -borderwidth 1 -bg $colorground] - -sticky news
   
   grid rowconfig . 0 -weight 0
   grid rowconfig . 1 -weight 1
   grid rowconfig . 2 -weight 2
   grid rowconfig . 3 -weight 3
     button .b2 -text dismiss -command "destroy ."
      button .b3 -text exit -command "exit"
   button  .b5 -text "Del_tank" -width 2  -command { .wxx delete 1.0 end}

      button  .b6 -text "lt_bg" -bg gray -width 2 \
    -command { set colorground LightBlue1;
      .c configure -bg $colorground  }
      button  .b7 -text "bis_bg" -width 3 \
    -command { set colorground Bisque; \
      .c configure -bg $colorground  }

      grid .b2 .b3 .b5 .b6 .b7
   grid rowconfig . 0 -weight 0
   grid rowconfig . 1 -weight 1
   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 1.0  "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> {
        #set firstnode [.c find withtag green]
        set firstnode [.c find withtag current]
        set curnode [.c find withtag current]
        set tile [.c find withtag current]
        #set curnode [.c find withtag red]
        if {( $firstnode != "") && ($curnode != "")} {
       dualcheck $tile $firstnode $curnode }}
   proc move(Poetry) {w x y} {
    if [info exists ::X] {
   $w move $::ID [expr {$x-$::X}] [expr {$y-$::Y}]
     set ::X $x; set ::Y $y}
   }
   proc down(exit) {w x y} {
     exit
   }

  proc down(Poetry) {w x y} {
         global baseline
        global en_chinese
        set baseline  [list ]
        set baseline2  [list ]
        set baseline3  [list ]
        set dy 40
        set dx 40
        set dk 10
        set poof "tester";
        set looky "stringx";
        set tile "tile"
        set tagx  [list aaaa bbbb cccc dddd eeee fffff gggg hhhh ]
        set tagx  [list ]
    #set tags [list mv d-$val1$val2];

       #set tile  [expr {int(rand()*1000000000.)}]
      #set looky "stringx";
      #set poof  [xpop $looky ] ;
       #set tags [list $poof mv obj_$tile  d-$val1$val2];
   #set tags [list $poof mv "obj_$tile+1"   d-$val1$val2];
       #set tagx [list $poof mv "obj_$tile+1"   d-$x$y];
   for {set i 0; set y  [expr {4+$y}];set x  [expr {10+$dx}]; } {$i<5} {incr i; incr x $dx} {
     set state1 1;
   set tile  [expr {int(rand()*1000000000.)}]
      set looky "stringx";
      set poof  [xpop $looky ] ;
      lappend baseline $poof;
      set tagx [list $poof mv "obj_$tile"   d-$x$y];
        set ::ID [$w create text $x $y  -text $poof -tags $tagx -fill $::Fill ]
      }
       for {set i 0; set y [expr {8+$y}];set x [expr {10+$dx}] ;} {$i<7} {incr i; incr x $dx} {
     set state1 1;
   set tile  [expr {int(rand()*1000000000.)}]
      set looky "stringx";
      set poof  [xpop $looky ] ;
     lappend baseline2 $poof;
   set tagx [list $poof mv "obj_$tile"   d-$x$y];
        set ::ID [$w create text $x $y  -text $poof -tags $tagx -fill $::Fill ]
      }
     for {set i 0; set y  [expr {12+$y}];set x [expr {15+$dx}];} {$i<5} {incr i; incr x $dx} {
     set state1 1;
   set tile  [expr {int(rand()*1000000000.)}]
      set looky "stringx";
      set poof  [xpop $looky ] ;
       lappend baseline3 $poof;
      set tagx [list $poof mv "obj_$tile"   d-$x$y];
        set ::ID [$w create text $x $y  -text $poof -tags $tagx -fill $::Fill ]
      }
   set topa [stringxxx [concat $baseline $baseline2 $baseline3]] ;
    .wxx insert 1.0 $topa;
     .wxx insert 1.0 [lcount $topa];
      set topat [translationx $topa en_chinese];
     .wxx insert 1.0 [lcount $topat];
     .wxx insert 1.0 [concat $topa [lcount $topa] $topat [lcount $topat]  ];

   set k 20;
   set baseline [translationx $baseline en_chinese];
  set k  [expr {20+$y}];
   set ::ID [$w create text $x  $k  -text $baseline -tags $tagx -fill $::Fill ]
   set baseline [translationx $baseline2 en_chinese];
  set k  [expr {30+$y}];
   set ::ID [$w create text $x  $k  -text $baseline -tags $tagx -fill $::Fill ]
    set baseline [translationx $baseline3 en_chinese];
  set k  [expr {40+$y}];
   set ::ID [$w create text $x  $k  -text $baseline -tags $tagx -fill $::Fill ]

   }
   proc history {xhistory } {
   set xhistory [list object history @];
   global xhistory firstnode curnode
        global ind movesit
        set number 2
         set numberx 2

         set firstnode [.c find withtag current]
   lappend  $xhistory  $firstnode ;
   set ::ID [.c create text 100 200  -text $xhistory -tags " history " -fill $::Fill -fill black ]
   }
      proc dualcheck { tile firstnode curnode} {
       global match_id selected_tile tiles_left jack
       global newy oldy match oldx xhistory
      global selected_tile previous_tile
      global xhistory
      global tilex
      #global firstnode curnode
      set selected_tile "selected tile";
      set colorxxx "test"
      set colorzzz "test"
         #set previous_tile "previous tile";
         set numberx [.c  gettags current];
         regexp {obj_(\d+)} $numberx -> tilex
         regexp {colorit_(\d+)} $numberx -> colorxxx
         regexp {colorit_(\d+)} $numberx -> colorzzz
        set indexer [string first "mv" $numberx ];
         set indexer [ expr { $indexer - 1 } ]
        set new  [string range $numberx 0 $indexer ];
       set tags [.c  gettags current]
       #.c itemconfigure obj_$tilex -width 2 -outline red;
       #.c itemconfigure $previous_tile -width 2 -outline green;
       # .c itemconfigure obj_$tilex -width 3  ;
      # .c itemconfigure $previous_tile -width 3  ;
       set old "test"
       set kkk [.c  gettags $previous_tile ]
       set indexer [string first "mv" $kkk ]; ;
        set indexer [ expr { $indexer - 1 } ]
        set old  [string range $kkk 0 $indexer ];
      if {$old == ""} {set old "poof $previous_tile"}
     set tx [string range $tilex  0 end ];
      set rx [string range $previous_tile 4 end ];
       if { $tx !=  $rx } {
       .wxx delete 1.0 end;
       .wxx insert end  "  pair error identified, text not equal !!!"  ;
       }

     if { $old ==  $new } {
      set tx [string range $tilex  0 end ];
      set rx [string range $previous_tile 4 end ];
       if { $tx ==  $rx } {
       .wxx delete 1.0 end;
       .wxx insert end  "  pair error identified, double touch of same tile !!!"  ;
       }
       if { $tx !=  $rx } {
     #.c itemconfigure obj_$tilex -width 2 -outline blue;
     #.c itemconfigure $previous_tile -width 2 -outline blue;
     .wxx delete 1.0 end;
     .wxx insert end " xxx $tilex xxx $tx xxx $rx xxx $previous_tile xxxx  ";
     .wxx insert end  $previous_tile;
     .wxx insert end  "  old $old ";
     .wxx insert end  $old;
     .wxx insert end  " identical pair identified !!!"  ;
     .wxx insert end " xxx old $old xxx new xxx $new  ";
     .wxx insert end  $new;
     .wxx insert end "obj_tilex obj_$tilex "
         regexp {colorit_(\d+)} $numberx -> colorxxx
         regexp {colorit_(\d+)} $previous_tile -> colorzzz
     if { $colorxxx ==  $colorzzz } {
     .c delete "$previous_tile+1";
     .c delete "obj_$tilex+1" ;

     .c delete obj_$tilex ;
     .c delete $previous_tile;
     }
     }

     }
       #.wxx delete 1.0 end;
       set $selected_tile $tags;
       .wxx insert end $tags ;
       .wxx insert end " selected_tile equals $new ";
       if {  $previous_tile != $selected_tile  } {
        set previous_tile [.c  gettags current]
        set indexer [string first "mv" $previous_tile ];
         set indexer [ expr { $indexer - 1 } ]
        set old  [string range $previous_tile 0 $indexer ];
       .wxx insert end " previous_tile equals $old ";
       }
       #.c itemconfigure  $curnode -width 2 ;
       set previous_tile obj_$tilex
       set firstnode obj_$tilex;
       if { $firstnode != $curnode } {
       set curnode obj_$tilex;}
      .wxx insert end " current equals $curnode ";
      .wxx insert end " first equals $firstnode ";
     return }
     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];
       # this card deletes previous history in tank
       # reduces tank verbage but loses history      
       #  .wxx delete 1.0 end;
       # general reporting line
      .wxx insert 1.0 " 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

      }

      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 xpop { topper } {
     global liner
     global ind
     global baseline
     set poetsey aaaaa

     set liner [poemsorts $poetsey];

     set goofy [stringxxx $liner] ;

     set topper [ lindex $goofy $ind ];

     set ind [ expr { $ind + 1}]
     lappend $baseline $topper;
     return $topper;
     }
        proc helptext {stringxxx} {
       set text_texas {
       # Refrigerator magnet poetry
       # Refrigerator magnet poetry
       # program is mainly TCL8.0 and
       # Windows Expect5.2 offshoot of
       # Suchenwirth's Domino.tcl, circa 2004.
       # Tried to note which Suchenwirth subroutines
       # were mostly unchanged.
       # This was the first TCL canvas code I
       # saw that one could create easy gamepieces.
       # Writing grouped designs
       # on top of canvas shape, so basic canvas
       # shape and "grouped" design would move
       # by mouse. "grouped" design is used
       # extensively in Microsoft powerpoint
       # and Harvard Graphics, etc.
       # This first effort is refrigerator
       # magnet poetry in English.
       # Believe a similar select & die could
       # be used for a computer Mahjong game
       # or coin&card games.
       # Could use TCL8.4 chinese charactors
       # on top of tiles for Chinese magnetic
       # poetry or colored Mahjong tiles.
       # Various Esc and F-keys activate
       # to exit program or change background color.
       # Sliding right mouse across piece
       # should delete same.
       # Pick and Sliding left mouse across piece
       # should move same.
       # Selecting piece with middle mouse
       # should delete same piece.
       # Selecting pair of [same text] pieces
       # [in sequence] with right mouse
       # should delete same piece.
       # Right mouse uses initialization from
       # left mouse, so one has to pick
       # one tile with left mouse for
       # game start.
       # 5/7/5 words per line is
       # setting for Japanese Haiku poetry.
       # Other procedures working
       # on windows98 and old PC.
       # from goldshell7 on 10jun2006.}
       return $text_texas;}

     proc poemsorts {poetsey} {
      global liner
      #set liner [list q w e r]
      # alpha liner for test purposes
      set liner [list aaaa bbbb cccc dddd eeee fffff gggg hhhh ]
      set liner [list  ]
      set adjective_poetic {
        {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 noun_subject {
        cat  mouse  reed { pear }
        {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}
        mount  plum  storm  hill
      }
      set verb_transitive {falls
      {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 noun_objective {
         cloud {old home} flower { sky } rice {cricket}
      }
      set silly_propostion {
         for {by} towards { to } at {bygone}
         {to} {in} {in } {to }
         {to} {in} {fore } through
      }
     set poetsey "The , [? $adjective_poetic],[? $noun_subject], [? $verb_transitive], [? $silly_propostion], [? $adjective_poetic], [? $adjective_poetic], [? $noun_subject],The , [? $adjective_poetic],[? $noun_subject], [? $verb_transitive], [? $silly_propostion], [? $adjective_poetic], [? $adjective_poetic], [? $noun_subject],The , [? $adjective_poetic],[? $noun_subject], [? $verb_transitive], [? $silly_propostion], [? $adjective_poetic] , [? $adjective_poetic] ,[? $noun_subject],The , [? $adjective_poetic],[? $noun_subject], [? $verb_transitive], [? $silly_propostion], [? $adjective_poetic], [? $adjective_poetic], [? $noun_subject],The [? $adjective_poetic],[? $noun_subject], [? $verb_transitive], [? $silly_propostion], [? $adjective_poetic], [? $adjective_poetic], [? $noun_subject],"

      lappend liner $poetsey
      lappend liner $poetsey
      lappend liner $poetsey
     set poetsey $liner
     return $poetsey

     }
    #-- Activate F-keys (optional):

       bind . <Escape> { exit}
       bind . <F1> {destroy .}
       bind . <F2> { set colorground LightBlue1; \
      .c configure -bg $colorground}
       bind . <F3> {set colorground Bisque;.c \
      configure -bg $colorground }
       bind . <F4> {set backcolor [lpick {AntiqueWhite3
      Bisque1 Bisque2 Bisque3  Bisque4 \
      SlateBlue3 RoyalBlue1 SteelBlue2 \
      DeepSkyBlue3  LightBlue1 DarkSlateGray1 \
      Aquamarine2 DarkSeaGreen2 SeaGreen1 Bisque \
             Yellow1 IndianRed1 IndianRed2 Tan1 \
      Tan4 gray}];
      set colorground $backcolor;
      .c configure -bg $colorground }
      bind . <F4> {set backcolor [lpick {AntiqueWhite3
      Bisque1 Bisque2 Bisque3  Bisque4 \
      SlateBlue3 RoyalBlue1 SteelBlue2 \
      DeepSkyBlue3  LightBlue1 DarkSlateGray1 \
      Aquamarine2 DarkSeaGreen2 SeaGreen1 Bisque \
             Yellow1 IndianRed1 IndianRed2 Tan1 \
      Tan4 gray}];
      set colorground $backcolor;
      .c configure -bg $colorground }
      bind .  <F5> {set backcolor [lpick {
      Bisque Aquamarine  }];
      set colorground $backcolor;
      .c configure -bg $colorground }
      bind . <F6> {set backcolor [lpick {AntiqueWhite3
      Bisque}];
      set colorground $backcolor;
      .c configure -bg $colorground }
     bind . <F7> {set backcolor [lpick {SeaGreen1
      Bisque}];
      set colorground $backcolor;
      .c configure -bg $colorground }
     bind . <F8> {set backcolor [lpick {AntiqueWhite3
      Bisque}];
      set colorground $backcolor;
      .c configure -bg $colorground }
  # some words/meanings from 8th century poems
  # english articles dumped for asterisk

 array set en_chinese {
    bird   naio
    water   shui
    cloud     yun
    smoke    yan
    come      lai
    rain     yu
    he       ta
   she       ta
    it       ta
    cat      mao
    horse    ma
    girl     nuer
    two      lian
    one      yi
    above    shang
   add       jia
   admiral    haijunshang
   aches    tong
   hear     ting
   air      kongqi
   wind     feng
   airplane  feiji
   airport   feijichang
   alley hutong
   apple    pingguo
   apart    lu
   arm      gebo
   apricot xing
   armchair  fushiuyi
   atlas    dituji
   asparagus   lusun
   ask      wen
   arrow    jian
    arrive   daoda
    author  zuiozhe
   attic    gelou
   autumn   qiu
   axe futou
   axle  lunzhou
   ball   qiu
   ballet  baleiwu
   baby   yinger
   bag    bao
   barge  bochuan
   barley  damai
   barracks yingfang
    bank  yinhang
    bathtub  lahncheo
    bay  haiwan
    battery  dianchi
   bed chuang
   beautiful  meili 
   beard  huzi
   bean  dou
   bear  xlong
   beak  hui
   bead jhuzi
   beach haitan
   beehive  fengxiang
   bell leeng
   beer pijiu
   biscuit binggan
   big da
   bike zixingche
   blanket tanzi
   boat zhou
   blossom hua
   bloom hua
   blood xue
   blonde jinse
   bone gu
   bottle pingzi
   book shu
   branch shuzhi
   bow gong
   hill shan
   deer lu
   sea hai
   night ye
   sky tian
   tomarrow mingtian
   heart xin
   rock  shi
   song  ge
   year nian
   pine song
   rice mi
   door men
   gate men
   open kai
   moon yue
   dry gan
   dark hei
   black hei
   red hong
   field yuan
   yellow huang
   not bu
   carriage che
   bright ming
   guang shine
   frost shuang
   head tou
   white bai
   eve wan
   cup bei
   stove lu
   small xiao
   fire huo
   tear lei
   sit zuo
   first xian
   cut duan
   dream meng
   sand sha
   grass cao
   star xing
   shore an
   river jiang
   flat ping
   sun ri
   goose yan
   sound sheng
   duck ya
   lamp deng
   root gen
   by yu
   in zai
   pear li
   pearl zhenzhu
   path xiaodao
   wants yao
   wasp huangfeng
   watch kan
   see kan
   green luse
   The *
   the *
   hard ying
   blue lan
   dance tiaowu
   snow xue
   broad kuan
   brown zongse
   high gao
   long chang
   look kan
   wild yesheng
   wide kuan
   town zhen
   fall liu
   to ge
  rose meigui
  cave shandong
  cedar song
  lone dandu
  leaps tiao
  jumps tiao
  walk zou
   bygone yu
  tree shu
  dawn liming
 cool liang
  moth kunchong
 insect kunchong
 mouse laoshu
 mosquito wenzi
 moss lu
 gray cangbai
 pale cangbai
 moss lu
 before zai
 fore zai
 salt yan
 sail fan
 deep shen
 deer lu
 weed zhiwu
 plant zhiwu
 kelp haizhiwu
 thick hou
 shine zhaoyao
 shoe xie
 lush duo
 hears ting
 hear ting
 pond chitang
 pool chitang
 for wei
 far yuan
 at zai 
 pea xiaodou
 morn zaochen
 morning zaochen
 lost milu
 peace heping
 plum lizi
 sad nanguo
 grief nanguo
 storm fengbao
 sits zuo
 sleep shuimian
 sleeps shuimian
 mist wu
  wave bolang
 jade yu
 reed cao
 know zhu
 float piao
 takes you
 has you
 smile xiao
 cricket kunchong
 quince yingtao
 cherry yingtao
 burns huo
 roost chang
 mount shan
 slope shan
 ice xue
 fly fiji
 snail wongnui
 poor qiong
 silk si
 tea chai
 rough buping
 move zhou
 flys fiji
 move zhou
 road li
 strean he
 river he
 cry ti
 through zai
 drift zhou
 drifts zhou
 perch yu
 carp yu
 glad gaoxing
 falls liu
 thin shou
  soak shui
 loves ai
 ghost ti
 ant kunchong
 dusk heitian
 peach tao
 towards zai
 ink moshui
 fence liba
 lake he
 dove naio
 lies zhi
 is zhi
 soil du
 elm shu
 oak shu
 crane niao
 nest chang
 cheer guoxing
 worm wongnu
 rabbit tuzhu
 month yue
 flips zhou
 waits zhou
 grows sheng
 bark shu
 flower hua
 crest xia
 breeze xiaofeng
 leaves shu
 leaf shu
 hare tuzhu
 waits zho
 snake she
 serpent she
 shade si
 stone shi
 flow liu
                         zero  ling
                        0   ling      
                        1    yi   
                        one  yi
                        2   er  
                        3   san   
                        three san
                        4   si
                        four  si   
                        5   wu 
                        five wu  
                        6   liu  
                        six  liu 
                        7   ci 
                       seven ci  
                        8   ba  
                        eight ba 
                        9   jiu  
                        nine jiu 
                       10   shi 
                        ten  shi  
                       11   shi_yi 
                       eleven  shi_yi
                      twelve   shi_er
                       20   er_shi 
                       twenty  er_shi  
                       21   er_shi_yi 
                       twenty_two er_shi_yi    
                      100   bai_bye_yi_bai
                      hundred bai_bye_yi_bai  
                      300   san_bai 
                     three_hundred   san_bai
                      1000   cian  
                      thousand cian 
                      10000   yi_wan 
                      ten_thousand  yi_wan 
                      100000   shi_wan  
                      hundred_thousand shi_wan
                      1000000   yi_bai_wan  
                      thousand_thousand  yi_bai_wan 

 }


 proc phonesort2 { list } {
    #KBK (14 February 2001)
     foreach name $list {
	regsub {Ma?c ?([A-Z])} $name {M_\1} key
	lappend list2 [list $key $name]
    }
    foreach pair [lsort -index 0 -ascii $list2] {
	lappend list3 [lindex $pair 1]
    }
    return $list3
 }
 global baseline
 global en_chinese

 set topa [stringxxx [poemsorts "aaaaa"]] ;
 .wxx insert 1.0 $topa;
 .wxx insert 1.0 [lcount $topa];
 
 set baseline [list man goose foot woman dives];
 foreach oppie $baseline {
 set letter "string";
 set letter [string range $oppie  end end];
 set letterx "s";
 if { $letter != $letterx } {
 lappend baseline [plural $oppie]; 
 } else {
 lappend baseline $oppie; }
 }
 .wxx insert 1.0 " $baseline xxx";
 .wxx insert 1.0 "man xxx [plural "man"] xxx";
 set baseline [list water bird smoke come];
 .wxx insert 1.0 "xxx $baseline xxx";
 set stringj [list ];
 set stringj [translationx "water bird smoke come" en_chinese]
 .wxx insert 1.0 $stringj ;
 .wxx insert 1.0 "xxxx trans [translationx $baseline en_chinese]" ;
 set listxxx [list MacDonald McArthur McEwan Lyttle Mabbs Jones]
 .wxx insert 1.0 "xxxx sort xxxx $listxxx xxx [phonesort2 "$listxxx"]" ;
     proc down(canvas) {w x y} {global colorground; set colorground $::Fill; \
      .c configure -bg $colorground}
  proc move(canvas) {w x y} {}
  proc down(exit) {w x y} {
     exit;
   }
   proc move(exit) {w x y} {}
  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(clear) {w x y} {
    global helpx 
    $w delete "all"; 
    set helpx 0;
   }
 

 proc reset {w} {
   global helpx 
  $w delete "all" 
   set helpx 0;
 }

  proc down(hairs) {w x y} {
      global helpx
      if {$helpx > 0} {return}
      set tile  [expr {int(rand()*1000000000.)}]
      set poof  "cross hair" ;
     set maximumxxxx 400
     set maximumyyyy 400
     set middlexxxx [expr { (400 + $x)/ 2 }]
     set middleyyyy [expr { (400 + $y)/ 2 }]
     set xx1 20;
     set xx2 15;
     set yy1 20;
     set yy2 10;
      set tagx [list $poof mv "obj_$tile" "colorit_$::Fill"  d-$x$y];
     set base "help";
     set helpx 0;
     set baseline  $base;
     #if {![info exists L]} {set L {}}
     #set ::ID [$w create text $x  $y  -text $baseline -tags $tagx -fill $::Fill ]
      set ::ID [ $w create line $x     $middleyyyy $maximumxxxx  $middleyyyy -tags $tagx]
      set ::ID [$w create line $middlexxxx $y       $middlexxxx $maximumyyyy -tags tagx ]
      bind ::ID  [ $w create line $x     $middleyyyy $maximumxxxx  $middleyyyy -tags $tagx][$w create line $middlexxxx $y       $middlexxxx $maximumyyyy -tags tagx ]
      set helpx 1;

   }
   proc move(hairs) {w x y} {
   
      set ::ID [$w find withtag hair ]
     $w coords $::ID [lreplace [$w coords $::ID] 2 3 $x $y]
       set ::X $x; set ::Y $y
  
  }
   
    proc down(zone) {w x y} {
     global helpx 
     if {$helpx > 0} {return}
     set xx1 20;
     set xx2 15;
     set yy1 20;
     set yy2 10;
     set tile  [expr {int(rand()*1000000000.)}];
      set poof  "zone" ;
      set tagx [list $poof mv "obj_$tile" "colorit_$::Fill"  d-$x$y];
     set base "help";
     #$w create rect  50  10  100  60  -tags "box"
     #$w create rect $xx1 $yy1  $xx2 $yy2  -tags "box"
     set ::ID [$w create rect $x  $y [expr { $x + $xx1 }] [expr { $y + $yy1 }]   -tags $tagx -fill $::Fill ]
     set helpx 1
 }
   proc move(zone) {w x y} {}
   
    #end of deck

   #end of deck
   #end of deck
   #end of deck

 #end of deck
 #end of deck


   #end of deck
----


      ''Code Reuse'':   Tcl's package system makes it easy to write code that can be reused.
   Many  other people have made their 
 code available for reuse.
----
 ''Q. from goldshell7'':I am trying to load a feature or  
 subroutine "select&pair_then_die" ,
 where one selects two equal pieces in color,text, or 
 tags. If the two pieces are equal , both pairs disappear from
 the screen ( or to a hockey safety zone on the screen). 
 Kind of like the old Microsoft Mahjong game, which
 was an elimination process of equal pairs.
----
  ''A. received''
 You should make up unique tags 
 and assign them to both the rect   
 and the text inside it, and for convenience,
 another one for   the  text only.
 incr n 
 $w create rect ... -tags [list mv obj$n]
 $w create text ... -tags [list mv obj$n text$n]
 For moving, specify the obj.. tag so both move together.
 
 To get the tags of the current selection, try something like:
 set tags [$w gettags current]
 
 In the returned list, locate the tag with the obj number, 
  e.g.    like this
 regexp {obj(\d+)} $tags -> number
 
 You can retrieve the text by giving the tag
 set text [$w itemcget text$number -text]
 end of record.

----
 ''Q. from goldshell7'':28jul2006,would like
   selected tiles to have a red, blue, or   
   colored    outline. However

  commented ".c itemconfigure tile_number -outline
 red"  colored outine but reverts text font to 
  vertical arranged text.

  Maybe somebody can figure how to keep text 
  horizontal.
----
test vol
			above		shang
			aches		tong
			add		jia
			admiral		haijunshang
			air		kongqi
			airplane	feiji
			airport		feijichang
			alley		hutong
			alley		hutong
			american_person	meiguoren
			ant		kunchong
			apart		lu
			apple		pingguo
			apricot		xing
			arm		gebo
			armchair	fushiuyi
			arrive		daoda
			arrow		jian
			ask		wen
			asparagus	lusun
			at		zai
			atlas		dituji
			attic		gelou
			author		zuiozhe
			autumn		qiu
			axe		futou
			axle		lunzhou
			baby		yinger
			bag		bao
			ball		qiu
			ballet		baleiwu
			bank		yinhang
			barge		bochuan
			bark		shu
			barley		damai
			barracks	yingfang
			bathtub		lahncheo
			battery		dianchi
			bay		haiwan
			beach		haitan
			bead		jhuzi
			beak		hui
			bean		dou
			bear		xlong
			beard		huzi
			beautiful	meili
			bed		chuang
			beehive		fengxiang
			beer		pijiu
			before		zai
			bell		leeng
			big		da
			bike		zixingche
			bird		naio
			biscuit		binggan
			black		hei
			blanket		tanzi
			blonde		jinse
			blonde		huangtou
			blood		xue
			bloom		hua
			blossom		hua
			blue		lan
			boat		zhou
			bone		gu
			book		shu
			bottle		pingzi
			bow		gong
			branch		shuzhi
			breeze		xiaofeng
			bright		ming
			broad		kuan
			brown		zongse
			burns		huo
			by		yu
			bygone		yu
			carp		yu
			carriage	che
			cat		mao
			cave		shandong
			cedar		song
			cheer		guoxing
			cheers		ganbei
			cherry		yingtao
			china		zhongguo
			cloud		yun
			college         xueyuan
                        come		lai                      
			cool		liang
			costly		guo
			crane		niao
			crest		xia
			cricket		kunchong
			cry		ti
			cup		bei
			cut		duan
			dance		tiaowu
			dark		hei
			dawn		liming
			deep		shen
			deer		lu
			deer		lu
			door		men
			dove		naio
			dream		meng
			drift		zhou
			drifts		zhou
			drink		he
			drink		he
			driver		siji
			dry		gan
			duck		ya
			dusk		heitian
			east		dong
			eat		chi
			elm		shu
			eve		wan
			expensive	guo
			fall		liu
			falls		liu
			far		yuan
			fast		kuaidianr
			fence		liba
			field		yuan
			fire		huo
			first		xian
			flat		ping
			flips		zhou
			float		piao
			flow		liu
			flower		hua
			fly		fei
			flys		fei
			for		wei
			fore		zai
                        friend          pengyou
			frost		shuang
			gate		men
			ghost		ti
			girl		nuer
			glad		gaoxing
			goose		yan
                        goodby		zaijian
			grass		cao
			gray		cangbai
			green		luse
			grief		nanguo
			grows		sheng
			guang		shine
			half		ban
			hansome		haokan
			hard		ying
			hare		tuzhu
			has		you
			have_eaten      chi_le
                        he		ta
			head		tou
			hear		ting
			hear		ting
			hears		ting
			heart		xin
			hello		ni_hao
			high		gao
			hill		shan
			horse		ma
			ice		xue
			in		zai
			ink		moshui
			insect		kunchong
			is		zhi
			it		ta
			jade		yu
			jumps		tiao
			kelp		haizhiwu
			know		zhu
			lake		he
			lamp		deng
			lao		old
			leaf		shu
			leaps		tiao
			leaves		shu
			lies		zhi
			liquor		baijiu
			lone		dandu
			long		chang
			look		kan
			lost		milu
			loves		ai
			lush		duo
			many		duo
			mist		wu
                        miss            xiaojie
			monkey		houzi
			month		yue
			moon		yue
			moonshine	baijiu
			morn		zaochen
			morning		zaochen
			mosquito	wenzi
			moss		lu
			moss		lu
			moth		kunchong
			mount		shan
			mouse		laoshu
			move		zhou
			move		zhou
			much		duo
			nest		chang
			night		ye
			no_problem	meiwenti
			not		bu
			oak		shu
			old_boss	laoban
			old_foreigner   laowen
                        old_man		laoren
			old_teacher	laoshi
			once		tael
			one		yi
			open		kai
			pale		cangbai
			path		xiaodao
			pea		xiaodou
			peace		heping
			peach		tao
			pear		li
			pearl		zhenzhu
			perch		yu
			pine		song
			plant		zhiwu
			pluck           cai
                        plum		lizi
			pond		chitang
			pool		chitang
			poor		qiong
			quickly		kuaidianr
			quince		yingtao
			rabbit		tuzhu
			rain		yu
			rat		laoshu
			red		hong
			reed		cao
                        really          zhende
			rice		mi
			river		jiang
			river		he
			road		li
			rock		shi
			roost		chang
			root		gen
			rose		meigui
			rough		buping
			rugby		ganlanqiu
			rugby		ganlanqiu
			sad		nanguo
			sail		fan
			salt		yan
			sand		sha
			sea		hai
                        seat		zuowei
			see		kan
			serpent		she
			shade		si
			she		ta
			shine		zhaoyao
			shoe		xie
			shore		an
			silk		si
			sit		zuo
			sits		zuo
			sky		tian
			sleep		shuimian
			sleeps		shuimian
			slope		shan
			small		xiao
			smile		xiao
			smoke		yan
			snail		wongnui
			snake		she
			snow		xue
			so_so		mamahuhu
			soak		shui
			soft		rou
			soil		du
			song		ge
			sound		sheng
                        south           nan
			spear		qiang
                        speak           shuo
			star		xing
			stone		shi
			storm		fengbao
			stove		lu
			stream		he
                        subway          ditie
			sun		ri
			takes		you
			tea		chai
			tear		lei
			thank_you	xiexie
			The		*
			the		*
			thick		hou
			thin		shou
			through		zai
                        ticket		chepiao
			to		ge
			toilet		cesuo
			tomarrow	mingtian
			towards		zai
			town		zhen
			train		huoche
                        tree		shu
			two		lian
			usa		meiguo
			vehicle         che
                        very            tai
                        waits		zhou
			wait 		zho
			walk		zou
			wants		yao
			wants		yao
			wasp		huangfeng
			watch		kan
			water		shui
                        water_crane     shuihe
                        water_tower	shuita
			wave		bolang
			we		nimen
			weed		zhiwu
			west		xi
                        wheel		lun
			white		bai
			wide		kuan
			wild		yesheng
			wind		feng
			woman		nu_ren
			worm		wongnu
			year		nian
			yellow		huang
                        zero  ling
                        0   ling      
                        1    yi   
                        one  yi
                        2   er  
                        3   san   
                        three san
                        4   si
                        four  si   
                        5   wu 
                        five wu  
                        6   liu  
                        six  liu 
                        7   ci 
                       seven ci  
                        8   ba  
                        eight ba 
                        9   jiu  
                        nine jiu 
                       10   shi 
                        ten  shi  
                       11   shi_yi 
                       eleven  shi_yi
                      twelve   shi_er
                       20   er_shi 
                       twenty  er_shi  
                       21   er_shi_yi 
                       twenty_two er_shi_yi    
                      100   bai_bye_yi_bai
                      hundred bai_bye_yi_bai  
                      300   san_bai 
                     three_hundred   san_bai
                      1000   cian  
                      thousand cian 
                      10000   yi_wan 
                      ten_thousand  yi_wan 
                      100000   shi_wan  
                      hundred_thousand shi_wan
                      1000000   yi_bai_wan  
                      thousand_thousand  yi_bai_wan 


[Category Toys]