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. test picture & screen shot [http://mini.net/files/fridge.jpg] '''Strengths''' ''Subroutine use whereever possible.'': This one [Refrigerator_Magnetic_Poetry] ---- #Refrigerator_Magnetic_Poetry # Start of Deck #Refrigerator_Magnetic_Poetry # Start of Deck #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 \ } 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 {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 global en_romanji 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; lappend caseline $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; lappend caseline2 $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; lappend caseline3 $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 ] set k 30; set j 20; set baseline [translationx $caseline en_romanji]; set k [expr {60+$y}]; set j [expr {20+$x}]; set ::ID [$w create text $j $k -text $baseline -tags $tagx -fill $::Fill ] set baseline [translationx $caseline2 en_romanji]; set k [expr {70+$y}]; set j [expr {20+$x}]; set ::ID [$w create text $j $k -text $baseline -tags $tagx -fill $::Fill ] set baseline [translationx $caseline3 en_romanji]; set k [expr {80+$y}]; set j [expr {20+$x}]; set ::ID [$w create text $j $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. # 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 . { exit} bind . {destroy .} bind . { set colorground LightBlue1; \ .c configure -bg $colorground} bind . {set colorground Bisque;.c \ configure -bg $colorground } bind . {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 . {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 . {set backcolor [lpick { Bisque Aquamarine }]; set colorground $backcolor; .c configure -bg $colorground } bind . {set backcolor [lpick {AntiqueWhite3 Bisque}]; set colorground $backcolor; .c configure -bg $colorground } bind . {set backcolor [lpick {SeaGreen1 Bisque}]; set colorground $backcolor; .c configure -bg $colorground } bind . {set backcolor [lpick {AntiqueWhite3 Bisque}]; set colorground $backcolor; .c configure -bg $colorground } # some words/meanings from 8th century poems # english articles dumped for asterisk # reduced volcabulary array set en_chinese { The * the * bird naio water shui cloud yun smoke yan come lai rain yu red hong sad nanguo blue lan glad gaoxing deep shen black hei wild yesheng green luse pale cangbai bright ming rough buping gray cangbai brown zongse long chang high gao thin shou lush duo dry gan poor qiong lone dandu far yuan flat ping broad kuan thick hou hard ying cool liang cat mao mouse laoshu reed cao pear li quince yingtao peach tao hare tuzhu bird naio smoke yan rain yu ice xue snow xue cloud yun home home flower hua sky tian rice mi pine song mist wu door men wind feng cricket kunchong year nian moon yue crane niao grass cao rose meigui ink moshui thaw thaw bloom hua lake he cedar song dusk heitian autumn qiu stone shi dawn liming stream he tree shu heart xin boat zhou grief nanguo rock shi town zhen tear lei pool chitang silk si deer lu song cedar barge bochuan moss lu night ye gate men fence liba dove naio dream meng frost shuang peace heping shade si ghost ti road li path xiaodao root gen horse ma eve wan sound sheng sleep shuimian leaves shu sea hai sail fan peak peak stem stem field yuan wave bolang slope shan bark shu crest xia weed zhiwu moth kunchong wasp huangfeng pond chitang soil du snail wongnui worm wongnu ant kunchong kelp haizhiwu cave shandong month yue head tou jade yu branch shuzhi bone gu smile xiao pea xiaodou elm shu morn zaochen carp yu nest chang oak shu perch yu breeze xiaofeng mount shan plum lizi storm fengbao hill shan falls liu burns huo flips zhou flys fei lies zhi walk zou flow liu fall liu fly fei know zhu come lai meet meet drift zhou shine guang soak shui cry ti dance tiaowu lost milu cheer guoxing float piao roost chang move zhou fade fade loves ai sleeps shuimian takes you sits zuo leaps tiao sit zuo grows sheng waits zhou loses loses hears ting wants yao watch kan old lao for wei by yu towards zai to ge at zai bygone yu in zai } array set en_romanji { The * the * red aka sad kanashii blue aoi_ao glad glad deep deep black kuroi wild yasee green midori-iro pale usui bright akarui_taiyoo rough rough gray guree brown chairo long long high takai thin thin lush subishii dry kawaite_iru poor bimboo lone subishii far far flat flat broad broad thick thick hard hard cool cool cat cat mouse mouse reed reed pear pear quince quince peach peach hare hare bird bird smoke smoke rain rain ice ice snow snow cloud cloud home home flower flower sky sky rice rice pine pine mist mist door door wind wind cricket cricket year year moon moon crane crane grass grass rose rose ink ink thaw thaw bloom bloom lake lake cedar cedar dusk dusk autumn autumn stone stone dawn dawn stream stream tree tree heart heart boat boat grief grief rock rock town town tear tear pool pool silk silk deer deer song song barge barge moss moss night night gate gate fence fence dove dove dream dream frost frost peace peace shade shade ghost ghost road road path path root root horse horse eve eve sound sound sleep sleep leaves leaves sea sea sail sail peak peak stem stem field field wave wave slope slope bark bark crest crest weed weed moth moth wasp wasp pond pond soil soil snail snail worm worm ant ant kelp kelp cave cave month month head head jade jade branch branch bone bone smile smile pea pea elm elm morn morn carp carp nest nest oak oak perch perch breeze breeze mount mount plum plum storm storm hill hill falls falls burns burns flips flips flys flys lies lies walk walk flow flow fall fall fly fly know know come come meet meet drift drift shine shine soak soak cry cry dance dance lost lost cheer cheer float float roost roost move move fade fade loves loves sleeps sleeps takes takes sits sits leaps leaps sit sit grows grows waits waits loses loses hears hears wants wants watch watch old old for for by by towards towards to to at at bygone bygone in in The * the * } 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 #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 & extra chinese pinyin volcabulary # acrobatics zájì # acting yanchu # advance jìn # after ránhòu # after yihòu # afternoon xiàwu # again zài # all dou # also ye # although sui # always zongshì # among mínjian # and hé # appearance xiàng # appearance xiàng # approximately dàyue # army yíng # as rú # ask ràng # ask wèn # aspect guo # assist bang # assistance bangzhù # automatic zìdòng # autumn qiutian # axle zhóu # ballast_trackbed_ suìshí # ban shàng # ban yì # bank yínháng # banker_fire buji # basketball lánqiú # be shì # be_able huì # beat da # because yinwèi # beef niúròu # before qián # begin kaishi # between jian # bill dan # bill fapiào # birthday shengrì # blow gua # blow gua # bó Shànghai # board ban # bogie zhuanxiàngjià # book shu # book shu # both liang # both liang # box xiang # boxcar péngche # brake zhá # branch_line zhixiàn # bridge qiáo # bridge qiáo # bridge qiáo # bright cai # bright cai # brilliant jingcai # brother_younger dìdi # brothers xiongdì # bu duì # bù pao # builder_plate míngpái # bus gonggòngqìche # business míngpiàn # business shengyì # business yè # business_card míngpiàn # busy máng # but dànshì # but keshì # buy mai # caboose shouche # call jiào # can hòu # can ke # can néng # capacity dù # carriage kèche # carriage kèche # cash duì # category shu # catenary jiàkongshì_jiechùwang # certainly bì # chinese chén # chinese hànyu # chinese hànzì # class xiàkè # classics jing # clear qing # clear qingchu # climate qìhòu # clip jia # clock zhong # close jìnnear # coal méi_tàn # coalmine méikuàng # cold leng # college dàgài # colour_light_signal sèdeng_xìnhàoji # come lái # commerce shang # company gongsi # compare bijiào # competition bisài # complete zhou # continue jìxù # convenient fangbiàn # conveniently shùnbiàn # convert duìhuàn # cordial rèqíng # correct búcuò # correct rán # country guó # craft shouyì # cross_tie guizhen # curve quxiàn # cutting lùqiàn # dance wu # dance wudao # daughter nuér # day tian # deep shen # deliver jiao # depot jiwùduàn # device zhuangzhì # dialect yu # dictionary cídian # diesel cháiyóu # diesel_electric_locomotiv diànchuándòng_nèirán_jiche # diesel_hydraulic_locomoti yèlìchuándòng_nèirán_jiche # diesel_locomotive nèirán_jiche # different chà # difficult nán # difficult nán # dining_car canche # direct zhíjie # dish cài # display bai # distinct chu # divide fen # do duànliàn # do yíngyè # do zuò # domestic guónèi # double_track fùxiàn # dragon lóng # draw chou # drink he # driver siji # dumplings jiaozi # dynasty yuán # early xian # early xian # east dong # east # eat bao # eat chi # elder gege # elder jiejie # electric_locomotive diànlì_jiche # electricity diàn # electrification diànqìhuà # embankment lùdi # empty kong # end mò # energy jing # English yingyu # enter jìnadvance # especially tèbié # etween jian # even entirely # evening bàngwan # every mei # every meitian # everyday jingcháng # express_train gaosù # express_train kuàisù # express_train tèkuài # express_train kuàiche # extremely jí # eye mù # family jia # far yuan # fast kuài # father bàba # father fùmu # festival jié # fill man # Finland Fenlán # fire huo # first xiàn # fish yú # fishplate yúweiban # flat píng # fluent liúlì # football zúqiú # for gei # for gei # forecast yùbào # foreign wàiyu # fowl ji # frame jià # freight_car huòche # freight_train huòche # French fayu # friend péngyou # from cóng # from zì # fruit guo # fruit shuiguo # fuel cháiyóu # gas qì # gauge biao # generous dàfang # German déyu # Germany déguó # get jiéhun # gether yìqi # give qingkè # glut chán # go chu # go chuqù # go dào # go shàngban # go wang # gondola changche # gong bàn # gong gù # good hao # goodbye zàijiàn # goods_train huòche # goods_van péngche # gradient podù # graduation bìyè # guai kidnap # guan can # guàn xí # guards_van shouche # guest kèrén # habit xíguàn # half bàn # ham huotui # happy gaoxìng # happy kuàilè # happy lè # hard_sleeper yìngwò # have you # heat rè # heat rè # heater nuanqì # helper buji # high gao # hill shan # hog zhu # hot là # hot rè # house lóu # how duodà # how ji # how zenmeshuo # how_old duodà # however dànshì # hundred bai # I wo # ice bingqiú # if rúguo # if yàoshì # import jìnchukou # impression yìnxiàng # inn diàn # joyous huan # kick ti # kidnap guai # kind zhong # know liao # language wén # last shànggeyuè # leave lí # leave líkai # leave liú # length cháng # letter xìn # level_crossing dàokou # library túshuguan # light_rail qinggui # like xihuan # listen ting # loco_shed jiwùduàn # locomotive huochetóu # long jiu # look canguan # look see # lose yí # lóu Zhong # lower di # lunch wufàn # machine ji # machine ji # máfan trouble # main_line ganxiàn # make dadiànhuà # manager jingli # map dìtú # marshalling_yard bianzuchang # may keyi # may qingwèn # measure mi # meat ròu # mechanism qì # mechanism jigòu # medical yi # metering_device biao # middle zhong # might kenéng # minute fenzhong # mister xiansheng # mixed zá # mixed_train kèhuòhùnhé_lièche # money bì # month yuè # more yuèláiyuè # morrow míngtian # mother mama # mother ma # mountain shan # move gandòng # movement yùndòng # Mr. xiansheng # Mrs. tàitai # multiple_track fùxiàn # multiple_unit_train dòngchezu # my wode # name_personal míngzi # narrow_gauge_railway xiaohuoche # narrow_gauge_railway zhaigui_tielù # near jìn # necessary bìyào # negative méi # next míngnián # nice liángkuai # no búguò # no nali # Nokia Nuòjíyà # noon zhongwu # north bei # not bù # not bùshao # now xiànzài # number hào # observe obey # office bàngongshì # often cháng # oil yóu # one yi # one's xìng # only shiyou # only zhi # open_wagon changche # opportunity jihuì # ordinary píngcháng # ordinary_passenger_train putongche # ordinary_stopping_train putongche # ought gai # outside wài # overhead_wires jiàkongshì_jiechùwang # overpraise guòjiang # ox niú # pair duì # panfry chaosaute # pang ping # pantograph shòudiàngong # pass chuán # passenger lukè # passenger_train kèche # people mín # person rén # physical tiyù # pipe guan # plan dasuàn # plate ban # platform zhàntái # play wán # please qing # please qingbiàn # plural men # points dàochà # porch láng # pork zhuròu # present jièshào # profound shenkè # program jiémù # pronunciation fayin # quarterhour kè # question ne # rail ganggui # railroad tielù # railway tiedào # railway_track guidào # rain xiàyu # rank deng # read niàn # real zhen # really shízài # receipt fapiào # receive shou # receive zhaodài # regard suàn # regard suàn # regiment tuán # regret hàn # regret yíhàn # release fàng # release fàng # rén kè # rest xiuxi # return huí # return zhao # ride qí # right yòubian # road_formation dàochuáng # roadbed lùji # roadbed dàochuáng # roughly dàgài # roughly dàgài # route lù # run paobù # safety anquán # salad sèla # same yìban # saute chao # school xuéxiào # seat zuòwei # seat_hard yìngzuò # seat_soft ruanzuò # section kuan # see jiàn # self zìji # sell mài # semaphore_signal bìban_xìnhàoji # send fa # should gai # shrimp xia # shutter chuang # si gong # Sichuan Sìchuan # side cè # signal xìnhào_ji # silk sichóu # single_track danxiàn # sister_younger mèimei # sisters jiemèi # sit zuò # skill jì # sleeper tie_guizhen # sleeping_berth wòpù # slow màn # smoke chouyan # smoke yan # snow xiàxue # soft_sleeper ruanwò # son érzi # sorry_I_am duìbuqi # south nán # spare kòngr # speak shuo # spicey là # spoken kouyu # spring chuntian # stamp yìn # standard biaozhun # standard_gauge biaozhun_guijù # start chufa # station zhàn # station zhàntái # station huoche_zhàn # stay dai # steam zhengqì # steam_locomotive zhengqì_jiche # straight zhí # streetcar yougui_diànche # structual de # student xuésheng # study xué # suàn da # suburban_train shìjiao_lièche # subway dìtie # summer xiàtian # sunny qíngtian # Sweden Ruìdian # swim yóuyong # switch dàochà # table zhuozi # take qu # talk tán # talk tán # tank_car guànche # tanker guànche # taste cháng # tasty haochi # tasty haochi # tea chá # teach jiao # teacher laoshi # temple tiantán # tennis wangqiú # terms search # thank_you xièxie # that nà # the zuì # there have # this jinnián # this zhè # through_train zhídá # through_train zhítong_che # ticket chepiào # time shíhou # timetable shíkèbiao # train huoche # train huoche # train lièche # tram yougui_diànche # tread dao # trip luyóu # trolley_bus wúgui_diànche # truck_rail changche # tunnel suìdào # turntable zhuanpán # unable bùliao # underground_railway dìtie # understand dong # understand dong # unit kuàiyuan # university dàxué # useful youyòng # vacation jià # valve fá # vegetables shucài # vehicle che # very hen # volleyball páiqiú # wagon_car huòche # walk yóu # walk zou # want yào # warm nuan # water shui # water shui # water_crane shuihè # water_tower shuita # we women # we zánmen # weather tianqì # week xingqi # weekend zhoumò # welcome huanyíng # welcome yíng # west xi # west xi # Western-style xican # what shénme # what shénmeshíhou # what's guìxìng # wheel lún # where nali # which na # whistle míng # why wèishénme # wind feng # window chuangkou # wine jiu # wish zhù # with gen # word huà # work gongzuò # worksplate míngpái # write xie # year nián # yesterday zuótian # you_formal nín # zero líng # zhuangzhì # above shang # arrive daoda # author zuiozhe # bank yinhang # bathtub lahncheo # battery dianchi # bay haiwan # cat mao # cloud yun # come lai # girl nuer # he ta # horse ma # it ta # one yi # rain yu # smoke yan # two lian # water shui # aches tong # add jia # admiral haijunshang # air kongqi # airplane feiji # airport feijichang # alley hutong # apart lu # apple pingguo # apricot xing # arm gebo # armchair fushiuyi # arrow jian # ask wen # asparagus lusun # atlas dituji # attic gelou # autumn qiu # axe futou # axle lunzhou # baby yinger # bag bao # ball qiu # ballet baleiwu # barge bochuan # barley damai # barracks yingfang # beach haitan # bead jhuzi # beak hui # bean dou # bear xlong # beard huzi # beautiful meili # bed chuang # beehive fengxiang # beer pijiu # bell leeng # big da # bike zixingche # bird naio # biscuit binggan # black hei # blanket tanzi # blonde jinse # blood xue # bloom hua # blossom hua # blue lan # boat zhou # bone gu # book shu # bottle pingzi # bow gong # branch shuzhi # bright ming # broad kuan # brown zongse # by yu # bygone yu # carriage che # cup bei # cut duan # dance tiaowu # dark hei # deer lu # door men # dream meng # dry gan # duck ya # eve wan # fall liu # field yuan # fire huo # first xian # flat ping # frost shuang # gate men # goose yan # grass cao # green luse # guang shine # hard ying # head tou # hear ting # heart xin # high gao # hill shan # in zai # lamp deng # long chang # look kan # moon yue # night ye # not bu # open kai # path xiaodao # pear li # pearl zhenzhu # pine song # red hong # rice mi # river jiang # rock shi # root gen # sand sha # sea hai # see kan # she ta # shore an # sit zuo # sky tian # small xiao # snow xue # song ge # sound sheng # star xing # stove lu # sun ri # tear lei # The * # the * # to ge # tomarrow mingtian # town zhen # wants yao # wasp huangfeng # watch kan # white bai # wide kuan # wild yesheng # wind feng # year nian # yellow huang # cave shandong # cedar song # dawn liming # jumps tiao # leaps tiao # lone dandu # moth kunchong # rose meigui # soak shui # tree shu # walk zou # wave bolang # ant kunchong # at zai # bark shu # before zai # breeze xiaofeng # burns huo # carp yu # cheer guoxing # cherry yingtao # cool liang # crane niao # crest xia # cricket kunchong # cry ti # deep shen # deer lu # dove naio # drift zhou # drifts zhou # dusk heitian # elm shu # falls liu # far yuan # fence liba # flips zhou # float piao # flow liu # flower hua # fly fiji # flys fiji # for wei # fore zai # ghost ti # glad gaoxing # gray cangbai # grief nanguo # grows sheng # hare tuzhu # has you # hear ting # hears ting # ice xue # ink moshui # insect kunchong # is zhi # jade yu # kelp haizhiwu # know zhu # lake he # leaf shu # leaves shu # lies zhi # lost milu # loves ai # lush duo # mist wu # month yue # morn zaochen # morning zaochen # mosquito wenzi # moss lu # moss lu # mount shan # mouse laoshu # move zhou # move zhou # nest chang # oak shu # pale cangbai # pea xiaodou # peace heping # peach tao # perch yu # plant zhiwu # plum lizi # pond chitang # pool chitang # poor qiong # quince yingtao # rabbit tuzhu # reed cao # river he # road li # roost chang # rough buping # sad nanguo # sail fan # salt yan # serpent she # shade si # shine zhaoyao # shoe xie # silk si # sits zuo # sleep shuimian # sleeps shuimian # slope shan # smile xiao # snail wongnui # snake she # soil du # stone shi # storm fengbao # strean he # takes you # tea chai # thick hou # thin shou # through zai # towards zai # waits zho # waits zhou # weed zhiwu # worm wongnu # 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 # above shang # aches tong # add jia # admiral haijunshang # air kongqi # airplane feiji # airport feijichang # alley hutong # 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 # 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 # cherry yingtao # cloud yun # come lai # cool liang # 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 # dry gan # duck ya # dusk heitian # elm shu # eve wan # fall liu # falls liu # far yuan # fence liba # field yuan # fire huo # first xian # flat ping # flips zhou # float piao # flow liu # flower hua # fly fiji # flys fiji # for wei # fore zai # frost shuang # gate men # ghost ti # girl nuer # glad gaoxing # goose yan # grass cao # gray cangbai # green luse # grief nanguo # grows sheng # guang shine # hard ying # hare tuzhu # has you # he ta # head tou # hear ting # hear ting # hears ting # heart xin # 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 # leaf shu # leaps tiao # leaves shu # lies zhi # lone dandu # long chang # look kan # lost milu # loves ai # lush duo # mist wu # month yue # moon yue # morn zaochen # morning zaochen # mosquito wenzi # moss lu # moss lu # moth kunchong # mount shan # mouse laoshu # move zhou # move zhou # nest chang # night ye # not bu # oak shu # one yi # open kai # pale cangbai # path xiaodao # pea xiaodou # peace heping # peach tao # pear li # pearl zhenzhu # perch yu # pine song # plant zhiwu # plum lizi # pond chitang # pool chitang # poor qiong # quince yingtao # rabbit tuzhu # rain yu # red hong # reed cao # rice mi # river jiang # river he # road li # rock shi # roost chang # root gen # rose meigui # rough buping # sad nanguo # sail fan # salt yan # sand sha # sea hai # 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 # soak shui # soil du # song ge # sound sheng # star xing # stone shi # storm fengbao # stove lu # strean he # sun ri # takes you # tea chai # tear lei # The * # the * # thick hou # thin shou # through zai # to ge # tomarrow mingtian # towards zai # town zhen # tree shu # two lian # waits zho # waits zhou # walk zou # wants yao # wasp huangfeng # watch kan # water shui # wave bolang # weed zhiwu # white bai # wide kuan # wild yesheng # wind feng # worm wongnu # year nian # yellow huang # optional japanese romanji words array set en_romanji { red aka sad kanashii blue aoi_ao glad glad deep deep black kuroi wild yasee green midori-iro pale usui bright akarui_taiyoo rough rough gray guree brown chairo long long high takai thin thin lush subishii dry kawaite_iru poor bimboo lone subishii far far flat flat broad broad thick thick hard hard cool cool cat cat mouse mouse reed reed pear pear quince quince peach peach hare hare bird bird smoke smoke rain rain ice ice snow snow cloud cloud home home flower flower sky sky rice rice pine pine mist mist door door wind wind cricket cricket year year moon moon crane crane grass grass rose rose ink ink thaw thaw bloom bloom lake lake cedar cedar dusk dusk autumn autumn stone stone dawn dawn stream stream tree tree heart heart boat boat grief grief rock rock town town tear tear pool pool silk silk deer deer song song barge barge moss moss night night gate gate fence fence dove dove dream dream frost frost peace peace shade shade ghost ghost road road path path root root horse horse eve eve sound sound sleep sleep leaves leaves sea sea sail sail peak peak stem stem field field wave wave slope slope bark bark crest crest weed weed moth moth wasp wasp pond pond soil soil snail snail worm worm ant ant kelp kelp cave cave month month head head jade jade branch branch bone bone smile smile pea pea elm elm morn morn carp carp nest nest oak oak perch perch breeze breeze mount mount plum plum storm storm hill hill falls falls burns burns flips flips flys flys lies lies walk walk flow flow fall fall fly fly know know come come meet meet drift drift shine shine soak soak cry cry dance dance lost lost cheer cheer float float roost roost move move fade fade loves loves sleeps sleeps takes takes sits sits leaps leaps sit sit grows grows waits waits loses loses hears hears wants wants watch watch old old for for by by towards towards to to at at bygone bygone in in } # optional help notes 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.} [Category Toys]