[Refrigerator_Pinyin_Poetry] This page uses TCL8/Expect 5.2 for windows to develop Refrigerator Pinyin 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 [test] ---- #Refrigerator_Pinyin_Poetry # Start of Deck #Refrigerator_Pinyin_Poetry # Start of Deck #Refrigerator_Pinyin_Poetry #Refrigerator_Pinyin_Poetry # Start of Deck #Refrigerator_Pinyin_Poetry # Start of Deck # 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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " draw item on left mouse & screen touch "; set ::ID [$w create line $x $y $x $y -fill $::Fill] } proc move(Draw) {w x y} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " move item on left mouse & screen touch "; $w coords $::ID [concat [$w coords $::ID] $x $y] } #-- Movement of an item proc down(Move) {w x y} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " move item on left mouse & screen touch "; set ::ID [$w find withtag current] set ::X $x; set ::Y $y } proc move(Move) {w x y} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " move item on left mouse & screen touch "; $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 proc uniswap {L} { # removes duplicates without sorting the input list # swap asterisk with haiku poetic "cutting" words global v t set t {} set v {} foreach i $L {if {[lsearch -exact $t $i]==-1} {lappend t $i}} foreach i $L {if { $i != "*" } {lappend v $i} if { $i == "*" } {lappend v [lpick { ya kana zo yo keri}] } } return $v } ;# RS #-- Clone an existing item proc serializeCanvasItem {c item} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " create clone on left mouse & screen touch "; 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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " create clone on left mouse & screen touch "; 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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " create rectangle on left mouse & screen touch "; 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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " move rectangle on left mouse & screen touch "; $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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " create circle on left mouse & screen touch " 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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " create polygon on left mouse & screen touch "; 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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " color fill on left mouse & screen touch "; $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 metal 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 baseline global baseline2 global baseline3 set baseline [list] set baseline2 [list] set baseline3 [list] global v t set v [list ] set t [list ] global helpx global liner global loaderx global ind set ind 0 global movesit set helpx 0 set loaderx 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 count 0 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 set count 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 rowconfig . 1 -weight 0 grid rowconfig . 2 -weight 1 grid rowconfig . 3 -weight 2 grid rowconfig . 4 -weight 3 set widthx 100; set heightx 200; set height 300 set width 200 set borderwidth 2 set hscroll .hscroll set vscroll .vscroll set canvas .c scrollbar $hscroll -orient horiz -ori hori -command "$canvas xview" scrollbar $vscroll -ori vert -command "$canvas yview" grid [canvas .c -relief raised -width $widthx - xscrollcommand "$hscroll set" -height $heightx -yscrollcommand "$vscroll set" -borderwidth 1 -bg $colorground] - -sticky news grid $vscroll -row 4 -column 2 -sticky sw grid $hscroll -row 4 -column 2 -sticky sw grid rowconfig . 4 -weight 1 grid columnconfig . 4 -weight 1 button .b2 -text dismiss -command "destroy ." button .b10 -text "copy " -underline 1 -command {tk_textCopy .wxx } button .b9 -text "paste " -width 5 -borderwidth 3 -underline 1 -command {tk_textPaste .wxx} button .b8 -text pan -width 5 -borderwidth 3 -command { bind .c {%W scan mark %x %y}; bind .c {%W scan dragto %x %y 1 ;} } 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 } button .b14 -text "open" -borderwidth 3 -command { file:open .c } button .b15 -text "html" -borderwidth 3 -command { htm_print .c } button .b16 -text "print" -borderwidth 3 -width 5 -command { file:save .c } grid [ label .wcc -text "list of selection history " ] grid [entry .wxxccc -textvar e -just left -bg beige -width 100 ] #.wxxccc insert end "$liner" set wow [.c find withtag current]; set rooky 1; .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 " ] # Mix old pack with new grid #grid .menubar.edit -side left text .wxx -width 20 -height 3 -bg beige -xscrollcommand ".x set" -yscrollcommand ".y set" scrollbar .x -command ".wxx xview" -ori hori scrollbar .y -command ".wxx yview" -ori vert grid .wxx .y -sticky news grid .x -sticky ew grid rowconf . 0 -weight 1 grid columnconf . 0 -weight 1 button .k14 -text "open" -borderwidth 3 -command { file:open .c } button .k15 -text "html" -borderwidth 3 -command { htm_print .c } button .k16 -text "print" -borderwidth 3 -width 5 -command { file:save .c } set i 1; foreach color {AntiqueWhite3 Bisque1 Bisque2 Bisque3 Bisque4 SlateBlue3 RoyalBlue1 SteelBlue2 DeepSkyBlue3 LightBlue1 DarkSlateGray1 Aquamarine2 DarkSeaGreen2 SeaGreen1 Yellow1 IndianRed1 IndianRed2 Tan1 Tan4} { button .wxx.color$i -text $color -cursor top_left_arrow -command \ ".wxxccc insert 1 \" xxx change background color \";.wxx configure -bg $color;.c configure -bg $color;" .wxx window create end -window .wxx.color$i -padx 3 -pady 2 incr i } set k 99; foreach color {pan2 copy2 paste2 del_tank2 html2 open2 save2 exit2 dismiss2 } { button .wxx.color$k -text $color -cursor top_left_arrow -command \ " $color $k w x y width height " .wxx window create end -window .wxx.color$k -padx 3 -pady 2 incr k } if { 1 == 0 } { for {set i 0} {$i<5} {incr i} { grid [button .b$i -text "Button $i" -command {runMyProc $i}] }} for {set i 10000} {$i<10005} {incr i} { button .wxx.color$i -text "Button $i" -cursor top_left_arrow -command {runMyProc $i} .wxx window create end -window .wxx.color$i -padx 3 -pady 2 } focus .wxx set wow [.c find withtag current]; set pap 1; .wxx insert end "xxx starter xxx $wow xxx "; #-- The current mode is retrieved at runtime from the global Mode variable: bind .c <1> {set firstnode [.c find withtag current];initialize %W %x %y ;down($Mode) %W %x %y} bind .c {move($Mode) %W %x %y} bind .c <2> { .wxxccc insert 1 "xxx delete object on middle mouse " %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] .wxxccc insert 1 "xxx duplicate check & delete on right mouse " #set curnode [.c find withtag red] if {( $firstnode != "") && ($curnode != "")} { dualcheck $tile $firstnode $curnode }} proc move(Poetry) {w x y} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " move poetry on left mouse & screen touch "; 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 upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " create poetry on left mouse & screen touch "; global baseline global baseline2 global baseline3 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 baseline [uniswap $baseline]; 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 baseline [uniswap $baseline]; 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 baseline [uniswap $baseline]; 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 baseline [uniswap $baseline] 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 baseline [uniswap $baseline] 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 baseline [uniswap $baseline] 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 set boo 1; .wxx insert end " xxx $number xxx $numberx xxx \ indexer xxx $indexer xxx number of tiles xxxx \ $ind xxxx object xxx $tile xxx $ind xxx number of \ straight moves xxx $movesit xxx "; #.wxxccc delete 1.0 end; set coo 1; # general reporting line .wxxccc insert end " xxx $number xxx \ $numberx xxx [.c find withtag current] 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 goldmine global baseline global loaderx set poetsey aaaaa #if {![info exists L]} {set L {}} set liner [poemsorts $poetsey]; if {$loaderx > 0} { set liner $goldmine } 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. # 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. # 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 . { .wxxccc insert 1 " F-4 light_blue background "; set colorground LightBlue1; \ .c configure -bg $colorground} bind . {.wxxccc insert 1 " F-4 bisque background "; set colorground Bisque;.c \ configure -bg $colorground } bind . {.wxxccc insert 1 " F-4 random background "; 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 . {.wxxccc insert 1 " F-4 change background "; 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 . {.wxxccc insert 1 " F-5 change background "; set backcolor [lpick { Bisque Aquamarine }]; set colorground $backcolor; .c configure -bg $colorground } bind . {.wxxccc insert 1 " F-6 change background "; set backcolor [lpick {AntiqueWhite3 Bisque}]; set colorground $backcolor; .c configure -bg $colorground } bind . {.wxxccc insert 1 " F-7 change background "; set backcolor [lpick {SeaGreen1 Bisque}]; set colorground $backcolor; .c configure -bg $colorground } bind . {.wxxccc insert 1 " F-8 change background "; 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 cedar song 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 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 } array set en_romanji { The * the * red aka sad kanashii blue aoi_ao glad ureshii deep fukai black kuroi wild yasee green midori-iro pale usui bright akarui_taiyoo rough zara_zara_sur gray guree brown chairo long nagai high takai thin hosoi lush subishii dry kawaite_iru poor bimboo lone subishii far tooi flat taira broad haba thick futoi hard katai cool tsumetai_mizu cat neko mouse hatsuka reed ashi pear nashi quince marumero_no_mi peach momo hare no_usagi bird tori smoke hebi rain ame_ga_furu ice aisu snow yuki cloud kumo home ie flower hana sky sora rice gohan pine matsu mist kiri door doa wind kaze cricket koorogi year toshi moon tsuki crane tsuru grass kusa rose bara ink inku thaw koori_ga_tokeru bloom hana lake mizuumi cedar ki dusk yugure autumn aki stone ishi dawn yoake stream ogawa tree ki heart shinzo boat fune grief kanashimi rock iwa town machi tear namida pool koke silk si deer shika song uta barge unkasen moss koke night yoru gate mon fence saku dove hato dream yume frost shimo peace heiwa shade kage ghost obake ghost yuuree road michi path michi root ne horse uma eve zenya sound oto sleep nemuru leaves happa sea umi sail ho peak choojoo stem kuki field hatahe wave wave slope suropu bark ki_no_kawa crest itadaki weed zassoo moth ga wasp suzume_bachi pond ike soil tsuchi snail katatsumuri worm mimizu ant ari kelp kaiso cave hora_ana month tsuki head atama jade hisui branch eda bone hone smile hohoemi pea endomane elm ki morn asa carp sakana nest su oak ki perch suzuki breeze soyokaze mount yama plum puramu storm arashi hill oka falls ochiru burns moeru flips hajiku flys tobu lies aru walk aruku flow nagareru fall kao fly tobu know shiite_iru come kuru meet au drift hyoryu_suru shine hikaru soak tsukaru cry kiki dance dansu lost nakusu cheer kansei float ukaba roost yasumu move ugoku fade kieru loves ai sleeps nemuru takes toru sits suwaru leaps choyaku sit suwaru falls ochiru grows sodatsu waits matsu loses nakusu hears kiku wants iru watch miru old furui for no_tami_ni by ni_yotte towards no_ho_ni to ni at de bygone sugita in no The * the * acorn donguri add tasu afraid kowai africa afurika agate menou ain_t jyanai airplane hikooki alley roji alligator arigeta alphabet arufabetto also mo always itsumo ambulance kyukyusha anchor ikari angel tenshi angelfish enzerufisshu angle kakudo angry_mad ikatte_iru angry_mad okotte_iru animal doubutsu ankle ashikubi ant ari antartica nankyoku_tairiku antelope kamoshika ape saru apple ringo apron epuron aquarium suiso arch aachi archer syasyu are_you _ok arithmetic_problem sansu_no_mondai arm ude armchair hijikake_isu arrow ya art e artichoke aatichooku artist gaka asia ajia asleep nemuru assasin hitokiri asteroid showakusei astronaut uchuu_hikushi at ni athlete supotsuman atom genshi attention kiyo_tsuke australia osutoraria autumn_fall aki avacado abocado awesome saiko ax ono baby akanbo baddie mazui bag fukuro ball buru ballerina bareriina balloon gomu_fuusen bamboo_shoots takenoko bamboo_sword shinai banana banana barley mugi barn naya barrel taru baseball yakyu_boru baseball_bat batto baseball_cap boushi basket basuketto basket zaru bat_animal kumori bathing_swimming_s mizugi bathroom mitarai bathroom otearai bathtub yubune beach hama beach kaigan beak kuchibushi bear kuma beautiful kirei beautiful utsukushii beaver biiba bed beddo bee hachi bee_hive mitsubachi_no_su beehive hachi_no_su beetle kabutomushi begin_start hajime bell kane bellflower kikyo bicycle jitensha bird tori black kuro_kuroi blackbird burakku_berii blocks tsumiki bloomers bulma blouse burausu boat buto boat fune body karada bon_appetite itadakimasu bone hone book hon bookcase honbako boots butsu bottle bin bouquet hanataba bow chomusubi bowl boru box hako boy shonen boy bozu bracelet buresuretto brain nu brat gaki bread pan breakfast choshoku breast oppai bright ake broccoli burokkorii broom hoki brown chairo bucket baketsu buckwhe soba buffalo buffaru bug mushi building tatemono bull ushi bulldozer buruduzaa bun ban burdockroot gobo burn moeru bus basu but demo butter bataa butterfly cho button botan bye_parting_greeti ja_ne_ja cab takushii cabbage kyabetsu cactus saboten cake keeki calender karenda camel rakuda camera kamera camp kyampu_suru camper kyanpingu_ka can kanzume canary kanaria candle rusoku candy kyande cane tsue canoe kanue canyon kureyon car jidusha car kuruma carnation kaaniishon carpet kaapeto carrot ninjin cart niguruma castle shiro cat neko caterpiller kemushi cave hora_ana cave drawings celary serori cell_anatomy saibu chain kusari chair isu cheap chinke cheek_anatomy hoho cheese chiizu cherry sakurambo cherry_blossom flower chest mune chick hiyoko chicken niwatori child kodomo chimpanzee chimpanjii chin ago chopstick hashi church kyokai circle maru circus sakasu city toshi clam hamaguri claw tsume clay nendo clock tokei clothes fuku cloud kumo clown piero coat uwagi cobweb kumo coffin hitsugi coin koka color iro comb kushi comet suisei compass konpasu computer konpyuta cone ensuikei cookie kukkii cool kakoii cool suge coral sango corn tomorokoshi corner katsumi cotton_candy watagashi couch sofa cow meushi crab kani crane tsuru crap kuso crater kureta crazy_insane reijuu crop_land sakumotsu crow karasu crown ookan cry naku crystal suishu cube ripputai cuckoo kakkoo cucumber kyuuri cucumber_and_rice kappa_maki cup kappu cupboard shokkidana curtain_drape katen cute kawaii cylinder enchu daisy hinagiku dance odoru dancer odorite danger kiken dangerous abunai dark sky day nichi deep fukai deer shika demon mazoku desert sabaku desk tsukue dessert dezaato devil akuma devil oni diamond daiyamondo dice saikoro die shin dinner yushoku dinosaur kyoryu dirt tsuchi dish sara doctor isha does_have nai dog aiken dog aikenka dog inu doll ningyo dollhouse ningyo_no_ie dolphin dorufin dolphin iruka donkey roba door doa dough kiji dove hato down shita dozen daasu dragon ryu dragonfly tombo draw kaku dream yume drill_tool doriru drum doramu duck ahiru duckling ahiru_no_go dude toko dump_truck dampu_kaa eagle washi ear mimi earmuffs mimiate earring iyaringu earth chikyuu easel iizeru eclipse nisshoku eel unagi egg tamago eggplant nasu elbow hiji elegant kotan elephant zo elevator erebeta elk shoyosei elk ujika elm nire emotion_feeling kanji energetic genki energy _power envelope fuutu equal byudu equalivent onaji equator sekidu eraser keshigomu europe yoroppa everyday mainichi everything subete evil_fortune akkun exclamation_mark kantanfu exercise undu_suru express tsutawaru eye hitomi eye me eyebrow mayu face kao family kazoku family_tree ikka_no_keizu far away farm nuju feather hane feeling kimochi fence kakoi fern shida feudal_era sengoku_jidai final saigo finger yubi fingernail yubi_no_tsume fire hi fire_hydrant shokasen firefighter shoboshi firetruck shobosha fireworks hanabi fish sakana fishbowl suizokukan fishing tsuri flag hata flame hono flame recca flamingo furamingo flashlight kaichuu flipper ashihire flour komugiko flour kona flower hana flower flower flower_stalk miki flowerbed kaden flute furuto fly tobu fly_insect hae food shokumotsu fool aho foot_feet ashi football amerikan_futtoboru footprint ashiato footstool sutsuru forehead hitai forest mori fossil kaeseki four yon fox kitsune friend tomodachi frog kaeru fruit furuutsu fruit kudamono fruit_juice furuutsu_jusu full_demon youkai funnel ruto furniture kagu future mirai galaxy gingakei game gemmu garbage gomi gate geto gem huseki geography chiri gerbil jaabiru ghost obake gift okurimono gill era giraffe kirin girl shojo glass_cutlery gurasu glass_cutlery koppu glasses_optical megane globe chikyugi glove tebukuro go_away ache_kaere goat yagi goldfish kingyo good_evening konbanwa good_fortune un good_morning ohayo_u_gozaimasu_gozaimash goodbye sayonara goose_geese gacho gorilla gorira grandfather_inform jijii grape budo grapefruit gurepufurutsu grass kusa grasshopper kirigirisu grasshopper batta gray haiiro green midori green_tea ocha greenhouse gurin_hausu guest kyaku guitar gita haiku haiku hair kaminoke hairbrush burashi half hanyo ham hamu hamburger hanbaga hammer kanazuchi hamster hamusutaa hand te handsome bishounen hanger hangaa happy shiawase happy ureshii harbor wave harp haapu hat bushi hate kirai hay hoshikusa haze moyatta head atama hear kikoeru heart_emotional kokoro heart_organ shinzou hedgehog harinezumi heel kakato hell naraku hello moshi_moshi helmet herumetto hemisphere hankyuu hen mendori hexagon shichikaki hey ne hi_hello konnichiwa hill oka hip koshi hippotomous kaba hire fin holly_plant hiragi home xx horn kiteki horse uma horseshoe titetsu hot_spring onsen hot_tub furo hour ji how do how ikaga how_are_you hajimemashite how_are_you o_genki)desu_ka how_many ikutsu how_much ikura human ningen hummingbird hachidori hungry onaka_ga_suiteiru hurricane harikiin hut koya i_ll_kill_you omae_o_korosu i_me_feminine watashi i_me_masculine ore i_me_masculine boku i_me_you_feminine anata iamfeminine watashi_wa ice kori ice_cream aisu_kuriimu ice_skate suketo_gutsu iceberg kyozan icicle tsurara idiot baka if to iloveyou daisuki iloveyou_formal aishiteru iloveyou_informal boku_ai ink inku insect konchuu international kokusai iris_flower ayame iron airon island shima ivy tsuta japanese_type kotatsu jerk bakayaro jewel tama leaf yoh letter tegami light yukata light denkyuu light hikari like konomi little_wolf syaoran lonely sabashii lord tono lotus root magic moho man otoko martial_arts_train dojo mat_mattress futon midnight mayonaka military_ruler shogun minute fun miracle kiseki mist kasumi monk houshi monster kaijuu moon usa moonlight gekko morning asa mountain yama my wa mysterious fushigi oops totto_totto passionate_love ai robe kimono rock_garden kare_san_sui romantic_love koi sexual_love seiai sorry sumimasen red aka brown chairo orange daidaiiro grey haiiro yellow kiiro black kuro black kuroi green midori sky_blue mizuiro pink momoiro purple murasaki white shiro good_evening kombawa hello konichiwa good_morning ohayou_goziaimasu welcome_home okaeri_nasai good_night oyasumi_nasai I_am_back tadaima goodbye sayonara } 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 if {1 == 1 } { 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"]" ; } set commontest "In Tcl everything is represented as a string. Lists don't escape this fundamental rule of the language, instead the string representation of lists is very direct to think for humans. " set ropa [split $commontest]; set ropa [stringxxx $ropa]; foreach name [stringxxx [lcount $ropa]] { .wxx insert end " rating $name [kvsearch { 1 the 2 be 3 to 4 of 5 and 6 a 7 in 8 that 9 have 10 I 11 it 12 for 13 not 14 on 15 with 16 he 17 has 18 you 19 do 20 at 21 this 22 but 23 his 24 by 25 from 26 they 27 we 28 say 29 her 30 she 31 or 32 an 33 will 34 my 35 one 36 all 37 would 38 there 39 their 40 what 41 so 42 up 43 out 44 if 45 about 46 who 47 get 48 which 49 go 50 me 51 when 52 make 53 can 54 like 55 time 56 no 57 just 58 him 59 know 60 take 61 people 62 into 63 year 64 your 65 good 66 some 67 could 68 them 69 see 70 other 71 than 72 then 73 now 74 look 75 only 76 come 77 its 78 over 79 think 80 also 81 back 82 after 83 use 84 two 85 how 86 our 87 work 88 first 89 well 90 way 91 even 92 new 93 want 94 because 95 any 96 these 97 give 98 day 99 most 100 us 1 time 2 person 3 year 4 way 5 day 6 thing 7 man 8 world 9 life 10 hand 11 part 12 child 13 eye 14 woman 15 place 16 work 17 week 18 case 19 point 20 government 21 company 22 number 23 group 24 problem 25 fact 1 be 2 have 3 do 4 say 5 get 6 make 7 go 8 know 9 take 10 see 11 come 12 think 13 look 14 want 15 give 16 use 17 find 18 tell 19 ask 20 work 21 seem 22 feel 23 try 24 leave 25 call 1 good 2 new 3 first 4 last 5 long 6 great 7 little 8 own 9 other 10 old 11 right 12 big 13 high 14 different 15 small 16 large 17 next 18 early 19 young 20 important 21 few 22 public 23 bad 24 same 25 able } $name]" } proc down(canvas) {w x y} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " chamge background by select color & screen touch of left mouse "; global colorground; set colorground $::Fill; \ .c configure -bg $colorground} proc move(canvas) {w x y} {} proc dismiss2 {s w x y width height } { upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " destroy function activated " destroy .; } proc exit2 {s w x y width height } { upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " exit function activated " exit; } proc del_tank2 {s w x y width height } { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " delete holding tank function activated " .wxx delete 1.0 end ; } proc copy2 {s w x y width height } { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " copy function activated on left mouse " tk_textCopy .wxx; } proc paste2 {s w x y width height } { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " paste function activated on left mouse" tk_textPaste .wxx; } proc pan2 {s w x y width height } { upvar 1 .c .c; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " pan function on right mouse " bind .c {%W scan mark %x %y}; bind .c {%W scan dragto %x %y 1} ; } proc down(exit) {w x y} { upvar 1 .c .c; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " exit on left mouse & touch screen " exit; } proc move(exit) {w x y} {} proc runMyProc counter5 { upvar 1 .wxxccc .wxxccc .wxxccc insert 1 "xxx button $counter5 activated xxx" if { $counter5 == 10005 } { exit;} if { $counter5 != 10000 } { exit;} } proc down(metal) {w x y} { global count set xwidth 200; set xheight 200; .wxxccc insert 1 " metal processing time substantial "; if { $count == 0 } { .wxxccc insert 1 " metal processing time substantial "; heavymetal w x y $xwidth $xheight } if {$count == 1 } { .wxxccc insert 1 " metal style 2 on left mouse & touch screen " make_gradient $w 50 50 } if { $count == 2 } { .wxxccc insert 1 " metal style 3 on left mouse & touch screen " make_gradient $w 30 15} if { $count == 3 } { make_gradient $w 15 15} .wxxccc insert 1 " metal style 4 on left mouse & touch screen " incr count 1; if { $count == 4 } { set count 0} } proc move(metal) {w x y} {} proc down(help) {w x y} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " help screen on left mouse & touch screen"; 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 upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " clear screen on left mouse & touch screen"; $w delete "all"; set helpx 0; } proc reset {w} { global goldmine; global loaderx 0; upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " reset screen on left mouse & touch screen"; set gold [list]; set loaderx 1; set helpa [list reset processing may take considerable time ]; set helpb [list reset, processing of holding tank, ]; lappend helpa $helpb; global helpx #$w delete .wxxccc; set innn 1; .wxxccc insert end $helpa; set goldmine [.wxx get 1.0 end] ; set goldmine [ string tolower $goldmine ] ; set goldmine [ split $goldmine ] ; set goldmine [ luniq $goldmine ] ; set res {} foreach {a } $goldmine { set rook [string length $a] ; if {$rook > 3} {lappend res $a}} set goldmine $res set res {} foreach {a } $goldmine { set rook [string length $a] ; if {$rook > 3} {lappend res [? $goldmine]}} set goldmine [ lappend $helpa $res]; #set goldmine [ smoothxxx $goldmine ] ; } proc down(hairs) {w x y} { global helpx upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " move cross hairs on left mouse & touch screen"; 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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " move cross hairs on left mouse & touch screen"; 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 upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " create zone on left mouse & touch screen"; 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} {} proc html2 {k w x y width height } { #suchenwirth_subroutine from taiku; # this works only on Windows 95..ME... global baseline global baseline2 global baseline3 global liner global v t upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " lot of time, opening browser "; set filename [file join $::env(TEMP) taiku.html] set fp [open $filename w] #puts $fp [s2html [$w get 1.0 end]] puts $fp "holding tank contents"; puts $fp [s2html [.wxx get 1.0 end]] puts $fp "history contents"; set tags [.c gettags all] puts $fp $tags; set tags [.c gettags current] puts $fp $tags; #puts $fp [.wxxccc get end] puts $fp $liner; puts $fp $baseline; puts $fp $baseline2; puts $fp $baseline3; puts $fp [.c find withtag obj] global v t puts $fp $v puts $fp $t close $fp exec $::env(COMSPEC) /c start [file nativename $filename] & } proc s2html s { #suchenwirth_subroutine from taiku; upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " lot time, opening browser "; set res "" foreach line [split $s \n] { append res
foreach c [split $line ""] { set uc [scan $c %c] append res [expr {$uc>127? "&#$uc;" : $c}] } } set res } proc open2 {k w x y width height } { #suchenwirth_subroutine from taiku; upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " open file on left mouse "; set fn [tk_getOpenFile] if [string length $fn] { $w delete 1.0 end set f [open $fn] #fconfigure $f -encoding euc-cn fconfigure $f foreach line [split [read $f] \n] {$w insert end $line\n} close $f } } proc save2 { k w x y width height } { #suchenwirth_subroutine; upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " save file on left mouse "; set fn [tk_getSaveFile] if [string length $fn] { set f [open $fn w] #fconfigure $f -encoding euc-cn fconfigure $f puts $f [$w get 1.0 end-2c] close $f } } proc heavymetal { w x y width height } { set width 400 set height 200 .wxxccc insert 1 " metal > processing time substantial "; upvar 1 .wxx .wxx; .wxxccc insert 1 " create metal background on left mouse & screen touch "; for {set row 0} {$row < $height} {incr row 1} { set line_color [expr {45000+int(1000000*rand())%3000}] .c create line 0 $row $width $row -width 1 \ -fill [format "#%04x%04x%04x" \ $line_color $line_color $line_color] } } proc make_gradient { canvas N M } { set width [$canvas cget -width] set height [$canvas cget -height] set dx [expr {double($width)/double($N)}] set dy [expr {double($height)/double($M)}] set a [expr {pow(double($N)/2.0,2)+pow(double($M)/2.0,2)}] for {set i 0} {$i <= $N} {incr i} { for {set j 0} {$j <= $M} {incr j} { set x1 [expr {$dx*double($i)}] set x2 [expr {$x1+$dx}] set y1 [expr {$dy*double($j)}] set y2 [expr {$y1+$dy}] set k [expr {int(30000+25000*(1.0 - \ 0.8*(pow(double($i-$N/2.0),2) + \ pow(double($j-$M/2.0),2))/$a))}] $canvas create rectangle $x1 $y1 $x2 $y2 \ -fill [format "#%04x%04x%04x" $k $k $k] \ -width 0 } } } #Refrigerator_Pinyin_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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " draw item on left mouse & screen touch "; set ::ID [$w create line $x $y $x $y -fill $::Fill] } proc move(Draw) {w x y} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " move item on left mouse & screen touch "; $w coords $::ID [concat [$w coords $::ID] $x $y] } #-- Movement of an item proc down(Move) {w x y} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " move item on left mouse & screen touch "; set ::ID [$w find withtag current] set ::X $x; set ::Y $y } proc move(Move) {w x y} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " move item on left mouse & screen touch "; $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 proc uniswap {L} { # removes duplicates without sorting the input list # swap asterisk with haiku poetic "cutting" words global v t set t {} set v {} foreach i $L {if {[lsearch -exact $t $i]==-1} {lappend t $i}} foreach i $L {if { $i != "*" } {lappend v $i} if { $i == "*" } {lappend v [lpick { ya kana zo yo keri}] } } return $v } ;# RS #-- Clone an existing item proc serializeCanvasItem {c item} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " create clone on left mouse & screen touch "; 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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " create clone on left mouse & screen touch "; 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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " create rectangle on left mouse & screen touch "; 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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " move rectangle on left mouse & screen touch "; $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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " create circle on left mouse & screen touch " 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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " create polygon on left mouse & screen touch "; 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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " color fill on left mouse & screen touch "; $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 metal 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 baseline global baseline2 global baseline3 set baseline [list] set baseline2 [list] set baseline3 [list] global v t set v [list ] set t [list ] global helpx global liner global loaderx global ind set ind 0 global movesit set helpx 0 set loaderx 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 count 0 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 set count 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 rowconfig . 1 -weight 0 grid rowconfig . 2 -weight 1 grid rowconfig . 3 -weight 2 grid rowconfig . 4 -weight 3 set widthx 100; set heightx 200; set height 300 set width 200 set borderwidth 2 set hscroll .hscroll set vscroll .vscroll set canvas .c scrollbar $hscroll -orient horiz -ori hori -command "$canvas xview" scrollbar $vscroll -ori vert -command "$canvas yview" grid [canvas .c -relief raised -width $widthx -xscrollcommand "$hscroll set" -height $heightx -yscrollcommand "$vscroll set" -borderwidth 1 -bg $colorground] - -sticky news grid $vscroll -row 4 -column 2 -sticky sw grid $hscroll -row 4 -column 2 -sticky sw grid rowconfig . 4 -weight 1 grid columnconfig . 4 -weight 1 button .b2 -text dismiss -command "destroy ." button .b10 -text "copy " -underline 1 -command {tk_textCopy .wxx } button .b9 -text "paste " -width 5 -borderwidth 3 -underline 1 -command {tk_textPaste .wxx} button .b8 -text pan -width 5 -borderwidth 3 -command { bind .c {%W scan mark %x %y}; bind .c {%W scan dragto %x %y 1 ;} } 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 } button .b14 -text "open" -borderwidth 3 -command { file:open .c } button .b15 -text "html" -borderwidth 3 -command { htm_print .c } button .b16 -text "print" -borderwidth 3 -width 5 -command { file:save .c } grid [ label .wcc -text "list of selection history " ] grid [entry .wxxccc -textvar e -just left -bg beige -width 100 ] #.wxxccc insert end "$liner" set wow [.c find withtag current]; set rooky 1; .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 " ] # Mix old pack with new grid #grid .menubar.edit -side left text .wxx -width 20 -height 3 -bg beige -xscrollcommand ".x set" -yscrollcommand ".y set" scrollbar .x -command ".wxx xview" -ori hori scrollbar .y -command ".wxx yview" -ori vert grid .wxx .y -sticky news grid .x -sticky ew grid rowconf . 0 -weight 1 grid columnconf . 0 -weight 1 button .k14 -text "open" -borderwidth 3 -command { file:open .c } button .k15 -text "html" -borderwidth 3 -command { htm_print .c } button .k16 -text "print" -borderwidth 3 -width 5 -command { file:save .c } set i 1; foreach color {AntiqueWhite3 Bisque1 Bisque2 Bisque3 Bisque4 SlateBlue3 RoyalBlue1 SteelBlue2 DeepSkyBlue3 LightBlue1 DarkSlateGray1 Aquamarine2 DarkSeaGreen2 SeaGreen1 Yellow1 IndianRed1 IndianRed2 Tan1 Tan4} { button .wxx.color$i -text $color -cursor top_left_arrow -command \ ".wxxccc insert 1 \" xxx change background color \";.wxx configure -bg $color;.c configure -bg $color;" .wxx window create end -window .wxx.color$i -padx 3 -pady 2 incr i } set k 99; foreach color {pan2 copy2 paste2 del_tank2 html2 open2 save2 exit2 dismiss2 } { button .wxx.color$k -text $color -cursor top_left_arrow -command \ " $color $k w x y width height " .wxx window create end -window .wxx.color$k -padx 3 -pady 2 incr k } if { 1 == 0 } { for {set i 0} {$i<5} {incr i} { grid [button .b$i -text "Button $i" -command {runMyProc $i}] }} for {set i 10000} {$i<10005} {incr i} { button .wxx.color$i -text "Button $i" -cursor top_left_arrow -command {runMyProc $i} .wxx window create end -window .wxx.color$i -padx 3 -pady 2 } focus .wxx set wow [.c find withtag current]; set pap 1; .wxx insert end "xxx starter xxx $wow xxx "; #-- The current mode is retrieved at runtime from the global Mode variable: bind .c <1> {set firstnode [.c find withtag current];initialize %W %x %y ;down($Mode) %W %x %y} bind .c {move($Mode) %W %x %y} bind .c <2> { .wxxccc insert 1 "xxx delete object on middle mouse " %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] .wxxccc insert 1 "xxx duplicate check & delete on right mouse " #set curnode [.c find withtag red] if {( $firstnode != "") && ($curnode != "")} { dualcheck $tile $firstnode $curnode }} proc move(Poetry) {w x y} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " move poetry on left mouse & screen touch "; 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 upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " create poetry on left mouse & screen touch "; global baseline global baseline2 global baseline3 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 baseline [uniswap $baseline]; 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 baseline [uniswap $baseline]; 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 baseline [uniswap $baseline]; 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 baseline [uniswap $baseline] 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 baseline [uniswap $baseline] 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 baseline [uniswap $baseline] 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 set boo 1; .wxx insert end " xxx $number xxx $numberx xxx \ indexer xxx $indexer xxx number of tiles xxxx \ $ind xxxx object xxx $tile xxx $ind xxx number of \ straight moves xxx $movesit xxx "; #.wxxccc delete 1.0 end; set coo 1; # general reporting line .wxxccc insert end " xxx $number xxx \ $numberx xxx [.c find withtag current] 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 goldmine global baseline global loaderx set poetsey aaaaa #if {![info exists L]} {set L {}} set liner [poemsorts $poetsey]; if {$loaderx > 0} { set liner $goldmine } 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. # 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 Pinyin # 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. # 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 . { .wxxccc insert 1 " F-4 light_blue background "; set colorground LightBlue1; \ .c configure -bg $colorground} bind . {.wxxccc insert 1 " F-4 bisque background "; set colorground Bisque;.c \ configure -bg $colorground } bind . {.wxxccc insert 1 " F-4 random background "; 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 . {.wxxccc insert 1 " F-4 change background "; 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 . {.wxxccc insert 1 " F-5 change background "; set backcolor [lpick { Bisque Aquamarine }]; set colorground $backcolor; .c configure -bg $colorground } bind . {.wxxccc insert 1 " F-6 change background "; set backcolor [lpick {AntiqueWhite3 Bisque}]; set colorground $backcolor; .c configure -bg $colorground } bind . {.wxxccc insert 1 " F-7 change background "; set backcolor [lpick {SeaGreen1 Bisque}]; set colorground $backcolor; .c configure -bg $colorground } bind . {.wxxccc insert 1 " F-8 change background "; 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 cedar song 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 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 } array set en_romanji { The * the * red aka sad kanashii blue aoi_ao glad ureshii deep fukai black kuroi wild yasee green midori-iro pale usui bright akarui_taiyoo rough zara_zara_sur gray guree brown chairo long nagai high takai thin hosoi lush subishii dry kawaite_iru poor bimboo lone subishii far tooi flat taira broad haba thick futoi hard katai cool tsumetai_mizu cat neko mouse hatsuka reed ashi pear nashi quince marumero_no_mi peach momo hare no_usagi bird tori smoke hebi rain ame_ga_furu ice aisu snow yuki cloud kumo home ie flower hana sky sora rice gohan pine matsu mist kiri door doa wind kaze cricket koorogi year toshi moon tsuki crane tsuru grass kusa rose bara ink inku thaw koori_ga_tokeru bloom hana lake mizuumi cedar ki dusk yugure autumn aki stone ishi dawn yoake stream ogawa tree ki heart shinzo boat fune grief kanashimi rock iwa town machi tear namida pool koke silk si deer shika song uta barge unkasen moss koke night yoru gate mon fence saku dove hato dream yume frost shimo peace heiwa shade kage ghost obake ghost yuuree road michi path michi root ne horse uma eve zenya sound oto sleep nemuru leaves happa sea umi sail ho peak choojoo stem kuki field hatahe wave wave slope suropu bark ki_no_kawa crest itadaki weed zassoo moth ga wasp suzume_bachi pond ike soil tsuchi snail katatsumuri worm mimizu ant ari kelp kaiso cave hora_ana month tsuki head atama jade hisui branch eda bone hone smile hohoemi pea endomane elm ki morn asa carp sakana nest su oak ki perch suzuki breeze soyokaze mount yama plum puramu storm arashi hill oka falls ochiru burns moeru flips hajiku flys tobu lies aru walk aruku flow nagareru fall kao fly tobu know shiite_iru come kuru meet au drift hyoryu_suru shine hikaru soak tsukaru cry kiki dance dansu lost nakusu cheer kansei float ukaba roost yasumu move ugoku fade kieru loves ai sleeps nemuru takes toru sits suwaru leaps choyaku sit suwaru falls ochiru grows sodatsu waits matsu loses nakusu hears kiku wants iru watch miru old furui for no_tami_ni by ni_yotte towards no_ho_ni to ni at de bygone sugita in no The * the * acorn donguri add tasu afraid kowai africa afurika agate menou ain_t jyanai airplane hikooki alley roji alligator arigeta alphabet arufabetto also mo always itsumo ambulance kyukyusha anchor ikari angel tenshi angelfish enzerufisshu angle kakudo angry_mad ikatte_iru angry_mad okotte_iru animal doubutsu ankle ashikubi ant ari antartica nankyoku_tairiku antelope kamoshika ape saru apple ringo apron epuron aquarium suiso arch aachi archer syasyu are_you _ok arithmetic_problem sansu_no_mondai arm ude armchair hijikake_isu arrow ya art e artichoke aatichooku artist gaka asia ajia asleep nemuru assasin hitokiri asteroid showakusei astronaut uchuu_hikushi at ni athlete supotsuman atom genshi attention kiyo_tsuke australia osutoraria autumn_fall aki avacado abocado awesome saiko ax ono baby akanbo baddie mazui bag fukuro ball buru ballerina bareriina balloon gomu_fuusen bamboo_shoots takenoko bamboo_sword shinai banana banana barley mugi barn naya barrel taru baseball yakyu_boru baseball_bat batto baseball_cap boushi basket basuketto basket zaru bat_animal kumori bathing_swimming_s mizugi bathroom mitarai bathroom otearai bathtub yubune beach hama beach kaigan beak kuchibushi bear kuma beautiful kirei beautiful utsukushii beaver biiba bed beddo bee hachi bee_hive mitsubachi_no_su beehive hachi_no_su beetle kabutomushi begin_start hajime bell kane bellflower kikyo bicycle jitensha bird tori black kuro_kuroi blackbird burakku_berii blocks tsumiki bloomers bulma blouse burausu boat buto boat fune body karada bon_appetite itadakimasu bone hone book hon bookcase honbako boots butsu bottle bin bouquet hanataba bow chomusubi bowl boru box hako boy shonen boy bozu bracelet buresuretto brain nu brat gaki bread pan breakfast choshoku breast oppai bright ake broccoli burokkorii broom hoki brown chairo bucket baketsu buckwhe soba buffalo buffaru bug mushi building tatemono bull ushi bulldozer buruduzaa bun ban burdockroot gobo burn moeru bus basu but demo butter bataa butterfly cho button botan bye_parting_greeti ja_ne_ja cab takushii cabbage kyabetsu cactus saboten cake keeki calender karenda camel rakuda camera kamera camp kyampu_suru camper kyanpingu_ka can kanzume canary kanaria candle rusoku candy kyande cane tsue canoe kanue canyon kureyon car jidusha car kuruma carnation kaaniishon carpet kaapeto carrot ninjin cart niguruma castle shiro cat neko caterpiller kemushi cave hora_ana cave drawings celary serori cell_anatomy saibu chain kusari chair isu cheap chinke cheek_anatomy hoho cheese chiizu cherry sakurambo cherry_blossom flower chest mune chick hiyoko chicken niwatori child kodomo chimpanzee chimpanjii chin ago chopstick hashi church kyokai circle maru circus sakasu city toshi clam hamaguri claw tsume clay nendo clock tokei clothes fuku cloud kumo clown piero coat uwagi cobweb kumo coffin hitsugi coin koka color iro comb kushi comet suisei compass konpasu computer konpyuta cone ensuikei cookie kukkii cool kakoii cool suge coral sango corn tomorokoshi corner katsumi cotton_candy watagashi couch sofa cow meushi crab kani crane tsuru crap kuso crater kureta crazy_insane reijuu crop_land sakumotsu crow karasu crown ookan cry naku crystal suishu cube ripputai cuckoo kakkoo cucumber kyuuri cucumber_and_rice kappa_maki cup kappu cupboard shokkidana curtain_drape katen cute kawaii cylinder enchu daisy hinagiku dance odoru dancer odorite danger kiken dangerous abunai dark sky day nichi deep fukai deer shika demon mazoku desert sabaku desk tsukue dessert dezaato devil akuma devil oni diamond daiyamondo dice saikoro die shin dinner yushoku dinosaur kyoryu dirt tsuchi dish sara doctor isha does_have nai dog aiken dog aikenka dog inu doll ningyo dollhouse ningyo_no_ie dolphin dorufin dolphin iruka donkey roba door doa dough kiji dove hato down shita dozen daasu dragon ryu dragonfly tombo draw kaku dream yume drill_tool doriru drum doramu duck ahiru duckling ahiru_no_go dude toko dump_truck dampu_kaa eagle washi ear mimi earmuffs mimiate earring iyaringu earth chikyuu easel iizeru eclipse nisshoku eel unagi egg tamago eggplant nasu elbow hiji elegant kotan elephant zo elevator erebeta elk shoyosei elk ujika elm nire emotion_feeling kanji energetic genki energy _power envelope fuutu equal byudu equalivent onaji equator sekidu eraser keshigomu europe yoroppa everyday mainichi everything subete evil_fortune akkun exclamation_mark kantanfu exercise undu_suru express tsutawaru eye hitomi eye me eyebrow mayu face kao family kazoku family_tree ikka_no_keizu far away farm nuju feather hane feeling kimochi fence kakoi fern shida feudal_era sengoku_jidai final saigo finger yubi fingernail yubi_no_tsume fire hi fire_hydrant shokasen firefighter shoboshi firetruck shobosha fireworks hanabi fish sakana fishbowl suizokukan fishing tsuri flag hata flame hono flame recca flamingo furamingo flashlight kaichuu flipper ashihire flour komugiko flour kona flower hana flower flower flower_stalk miki flowerbed kaden flute furuto fly tobu fly_insect hae food shokumotsu fool aho foot_feet ashi football amerikan_futtoboru footprint ashiato footstool sutsuru forehead hitai forest mori fossil kaeseki four yon fox kitsune friend tomodachi frog kaeru fruit furuutsu fruit kudamono fruit_juice furuutsu_jusu full_demon youkai funnel ruto furniture kagu future mirai galaxy gingakei game gemmu garbage gomi gate geto gem huseki geography chiri gerbil jaabiru ghost obake gift okurimono gill era giraffe kirin girl shojo glass_cutlery gurasu glass_cutlery koppu glasses_optical megane globe chikyugi glove tebukuro go_away ache_kaere goat yagi goldfish kingyo good_evening konbanwa good_fortune un good_morning ohayo_u_gozaimasu_gozaimash goodbye sayonara goose_geese gacho gorilla gorira grandfather_inform jijii grape budo grapefruit gurepufurutsu grass kusa grasshopper kirigirisu grasshopper batta gray haiiro green midori green_tea ocha greenhouse gurin_hausu guest kyaku guitar gita haiku haiku hair kaminoke hairbrush burashi half hanyo ham hamu hamburger hanbaga hammer kanazuchi hamster hamusutaa hand te handsome bishounen hanger hangaa happy shiawase happy ureshii harbor wave harp haapu hat bushi hate kirai hay hoshikusa haze moyatta head atama hear kikoeru heart_emotional kokoro heart_organ shinzou hedgehog harinezumi heel kakato hell naraku hello moshi_moshi helmet herumetto hemisphere hankyuu hen mendori hexagon shichikaki hey ne hi_hello konnichiwa hill oka hip koshi hippotomous kaba hire fin holly_plant hiragi home xx horn kiteki horse uma horseshoe titetsu hot_spring onsen hot_tub furo hour ji how do how ikaga how_are_you hajimemashite how_are_you o_genki)desu_ka how_many ikutsu how_much ikura human ningen hummingbird hachidori hungry onaka_ga_suiteiru hurricane harikiin hut koya i_ll_kill_you omae_o_korosu i_me_feminine watashi i_me_masculine ore i_me_masculine boku i_me_you_feminine anata iamfeminine watashi_wa ice kori ice_cream aisu_kuriimu ice_skate suketo_gutsu iceberg kyozan icicle tsurara idiot baka if to iloveyou daisuki iloveyou_formal aishiteru iloveyou_informal boku_ai ink inku insect konchuu international kokusai iris_flower ayame iron airon island shima ivy tsuta japanese_type kotatsu jerk bakayaro jewel tama leaf yoh letter tegami light yukata light denkyuu light hikari like konomi little_wolf syaoran lonely sabashii lord tono lotus root magic moho man otoko martial_arts_train dojo mat_mattress futon midnight mayonaka military_ruler shogun minute fun miracle kiseki mist kasumi monk houshi monster kaijuu moon usa moonlight gekko morning asa mountain yama my wa mysterious fushigi oops totto_totto passionate_love ai robe kimono rock_garden kare_san_sui romantic_love koi sexual_love seiai sorry sumimasen red aka brown chairo orange daidaiiro grey haiiro yellow kiiro black kuro black kuroi green midori sky_blue mizuiro pink momoiro purple murasaki white shiro good_evening kombawa hello konichiwa good_morning ohayou_goziaimasu welcome_home okaeri_nasai good_night oyasumi_nasai I_am_back tadaima goodbye sayonara } 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 if {1 == 1 } { 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"]" ; } set commontest "In Tcl everything is represented as a string. Lists don't escape this fundamental rule of the language, instead the string representation of lists is very direct to think for humans. " set ropa [split $commontest]; set ropa [stringxxx $ropa]; foreach name [stringxxx [lcount $ropa]] { .wxx insert end " rating $name [kvsearch { 1 the 2 be 3 to 4 of 5 and 6 a 7 in 8 that 9 have 10 I 11 it 12 for 13 not 14 on 15 with 16 he 17 has 18 you 19 do 20 at 21 this 22 but 23 his 24 by 25 from 26 they 27 we 28 say 29 her 30 she 31 or 32 an 33 will 34 my 35 one 36 all 37 would 38 there 39 their 40 what 41 so 42 up 43 out 44 if 45 about 46 who 47 get 48 which 49 go 50 me 51 when 52 make 53 can 54 like 55 time 56 no 57 just 58 him 59 know 60 take 61 people 62 into 63 year 64 your 65 good 66 some 67 could 68 them 69 see 70 other 71 than 72 then 73 now 74 look 75 only 76 come 77 its 78 over 79 think 80 also 81 back 82 after 83 use 84 two 85 how 86 our 87 work 88 first 89 well 90 way 91 even 92 new 93 want 94 because 95 any 96 these 97 give 98 day 99 most 100 us 1 time 2 person 3 year 4 way 5 day 6 thing 7 man 8 world 9 life 10 hand 11 part 12 child 13 eye 14 woman 15 place 16 work 17 week 18 case 19 point 20 government 21 company 22 number 23 group 24 problem 25 fact 1 be 2 have 3 do 4 say 5 get 6 make 7 go 8 know 9 take 10 see 11 come 12 think 13 look 14 want 15 give 16 use 17 find 18 tell 19 ask 20 work 21 seem 22 feel 23 try 24 leave 25 call 1 good 2 new 3 first 4 last 5 long 6 great 7 little 8 own 9 other 10 old 11 right 12 big 13 high 14 different 15 small 16 large 17 next 18 early 19 young 20 important 21 few 22 public 23 bad 24 same 25 able } $name]" } proc down(canvas) {w x y} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " chamge background by select color & screen touch of left mouse "; global colorground; set colorground $::Fill; \ .c configure -bg $colorground} proc move(canvas) {w x y} {} proc dismiss2 {s w x y width height } { upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " destroy function activated " destroy .; } proc exit2 {s w x y width height } { upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " exit function activated " exit; } proc del_tank2 {s w x y width height } { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " delete holding tank function activated " .wxx delete 1.0 end ; } proc copy2 {s w x y width height } { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " copy function activated on left mouse " tk_textCopy .wxx; } proc paste2 {s w x y width height } { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " paste function activated on left mouse" tk_textPaste .wxx; } proc pan2 {s w x y width height } { upvar 1 .c .c; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " pan function on right mouse " bind .c {%W scan mark %x %y}; bind .c {%W scan dragto %x %y 1} ; } proc down(exit) {w x y} { upvar 1 .c .c; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " exit on left mouse & touch screen " exit; } proc move(exit) {w x y} {} proc runMyProc counter5 { upvar 1 .wxxccc .wxxccc .wxxccc insert 1 "xxx button $counter5 activated xxx" if { $counter5 == 10005 } { exit;} if { $counter5 != 10000 } { exit;} } proc down(metal) {w x y} { global count set xwidth 200; set xheight 200; .wxxccc insert 1 " metal processing time substantial "; if { $count == 0 } { .wxxccc insert 1 " metal processing time substantial "; heavymetal w x y $xwidth $xheight } if {$count == 1 } { .wxxccc insert 1 " metal style 2 on left mouse & touch screen " make_gradient $w 50 50 } if { $count == 2 } { .wxxccc insert 1 " metal style 3 on left mouse & touch screen " make_gradient $w 30 15} if { $count == 3 } { make_gradient $w 15 15} .wxxccc insert 1 " metal style 4 on left mouse & touch screen " incr count 1; if { $count == 4 } { set count 0} } proc move(metal) {w x y} {} proc down(help) {w x y} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " help screen on left mouse & touch screen"; 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 upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " clear screen on left mouse & touch screen"; $w delete "all"; set helpx 0; } proc reset {w} { global goldmine; global loaderx 0; upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " reset screen on left mouse & touch screen"; set gold [list]; set loaderx 1; set helpa [list reset processing may take considerable time ]; set helpb [list reset, processing of holding tank, ]; lappend helpa $helpb; global helpx #$w delete .wxxccc; set innn 1; .wxxccc insert end $helpa; set goldmine [.wxx get 1.0 end] ; set goldmine [ string tolower $goldmine ] ; set goldmine [ split $goldmine ] ; set goldmine [ luniq $goldmine ] ; set res {} foreach {a } $goldmine { set rook [string length $a] ; if {$rook > 3} {lappend res $a}} set goldmine $res set res {} foreach {a } $goldmine { set rook [string length $a] ; if {$rook > 3} {lappend res [? $goldmine]}} set goldmine [ lappend $helpa $res]; #set goldmine [ smoothxxx $goldmine ] ; } proc down(hairs) {w x y} { global helpx upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " move cross hairs on left mouse & touch screen"; 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} { upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " move cross hairs on left mouse & touch screen"; 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 upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " create zone on left mouse & touch screen"; 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} {} proc html2 {k w x y width height } { #suchenwirth_subroutine from taiku; # this works only on Windows 95..ME... global baseline global baseline2 global baseline3 global liner global v t upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " lot of time, opening browser "; set filename [file join $::env(TEMP) taiku.html] set fp [open $filename w] #puts $fp [s2html [$w get 1.0 end]] puts $fp "holding tank contents"; puts $fp [s2html [.wxx get 1.0 end]] puts $fp "history contents"; set tags [.c gettags all] puts $fp $tags; set tags [.c gettags current] puts $fp $tags; #puts $fp [.wxxccc get end] puts $fp $liner; puts $fp $baseline; puts $fp $baseline2; puts $fp $baseline3; puts $fp [.c find withtag obj] global v t puts $fp $v puts $fp $t close $fp exec $::env(COMSPEC) /c start [file nativename $filename] & } proc s2html s { #suchenwirth_subroutine from taiku; upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " lot time, opening browser "; set res "" foreach line [split $s \n] { append res
foreach c [split $line ""] { set uc [scan $c %c] append res [expr {$uc>127? "&#$uc;" : $c}] } } set res } proc open2 {k w x y width height } { #suchenwirth_subroutine from taiku; upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " open file on left mouse "; set fn [tk_getOpenFile] if [string length $fn] { $w delete 1.0 end set f [open $fn] #fconfigure $f -encoding euc-cn fconfigure $f foreach line [split [read $f] \n] {$w insert end $line\n} close $f } } proc save2 { k w x y width height } { #suchenwirth_subroutine; upvar 1 .wxx .wxx; upvar 1 .wxxccc .wxxccc; .wxxccc insert 1 " save file on left mouse "; set fn [tk_getSaveFile] if [string length $fn] { set f [open $fn w] #fconfigure $f -encoding euc-cn fconfigure $f puts $f [$w get 1.0 end-2c] close $f } } proc heavymetal { w x y width height } { set width 400 set height 200 .wxxccc insert 1 " metal > processing time substantial "; upvar 1 .wxx .wxx; .wxxccc insert 1 " create metal background on left mouse & screen touch "; for {set row 0} {$row < $height} {incr row 1} { set line_color [expr {45000+int(1000000*rand())%3000}] .c create line 0 $row $width $row -width 1 \ -fill [format "#%04x%04x%04x" \ $line_color $line_color $line_color] } } proc make_gradient { canvas N M } { set width [$canvas cget -width] set height [$canvas cget -height] set dx [expr {double($width)/double($N)}] set dy [expr {double($height)/double($M)}] set a [expr {pow(double($N)/2.0,2)+pow(double($M)/2.0,2)}] for {set i 0} {$i <= $N} {incr i} { for {set j 0} {$j <= $M} {incr j} { set x1 [expr {$dx*double($i)}] set x2 [expr {$x1+$dx}] set y1 [expr {$dy*double($j)}] set y2 [expr {$y1+$dy}] set k [expr {int(30000+25000*(1.0 - \ 0.8*(pow(double($i-$N/2.0),2) + \ pow(double($j-$M/2.0),2))/$a))}] $canvas create rectangle $x1 $y1 $x2 $y2 \ -fill [format "#%04x%04x%04x" $k $k $k] \ -width 0 } } } #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 #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. ---- problem with "insert statement" in subroutine procedures resolved through upvar statements. -goldshell7 ---- [MG] With your second - you don't use ''$widget insert'' for a label widget. It's something like: label .l .l configure -text "Text goes here" If you then want to prepend, you can use .l configure -text "Before -> [.l cget -text]" Assuming you actually meant an [entry] widget, not a [label]: entry .e .e insert end "Last words." .e insert 1 "First words. " seems to work fine for me. For a text widget, your code looks fine: text .t .t insert end "This is at the end" .t insert 1.0 "This is at the start\n" ---- # Refrigerator_Pinyin_Poetry ---- [Category Toys]