**Chinese Xianqi Chessboard** ---- This page is under development. Comments are welcome, but please load any comments in the comments section at the bottom of the page. Please include your wiki MONIKER and date in your comment with the same courtesy that I will give you. Aside from your courtesy, your wiki MONIKER and date as a signature and minimal good faith of any internet post are the rules of this TCL-WIKI. Its very hard to reply reasonably without some background of the correspondent on his WIKI bio page. Thanks, gold 12Dec2018 ---- <> ---- **Introduction** [gold] Here is some starter code for Chinese Xiangqi Chessboard. There are several avenues for a Xianqi chessboard. Literature search showed many chess programs relying on a gif of the Chinese chessboard. Primarily looking at [RS]'s checkers.tcl on the wiki to get some primary movable pieces with the board. An version of the code was installed in the Simple Canvas Demo for some pictures. Also, TCLpaint made a lengthy list of 60 line creations in TCLpaint,but the final code should rely on foreach or loop statements for compact code. ---- The characters are generally stamped red and blue on round wooden pieces, which might be unicode characters in chinese. Given the purpose to display an Xiangqi board, a wish list is dreamed up. Probably need an if switch option for TCL lists of different character sets. Both the oval and the text character are tagged with a random object name like obj_$tiilename. On selection of a chess piece, the code finds the common name tag of the oval and text piece, and moves both at the same time. Probably should add a color outline during selection and movement with the mouse. Also should be able to center or pin the game pieces at the cross points. Probably could use an exit button. ---- Using the Simple Canvas Demo framework, the code has installed buttons for switching to traditional Chinese pieces, Western pieces, and alphabetic characters. Probably the buttons could select a color scheme. Xiangqi usually uses a gridded board. Western chess uses brown and white squares. Using the random names for the objects to lock ovals and text together. This works, but additional operations on the gamepieces like the moving outline are gumming up. Also the code is outputting the mouse up and down coordinates for the screen. ---- With the buttons in the little canvas demo, one can call up separate routines to lay out the different boards and install the various options of chesspieces. In a teamwork situation, programming teams could divide up the several tasks with the framework. In many cases, it is advantageous to have or write little demo programs for the separate subroutines. Some of the demo code decks are included below. In the button call up of the canvas demo, separate tasks can laid in successive statements to clear board, set states, layout the board, and populate the chesspieces. Loading four statements in the button might be ClrCanvas .cv; set state3 3;board .cv;populateCanvas .cv 6 6 3; This gets a little lengthy for a button line, so these statements could be stacked in a separate subroutine. With some global statements for any constants and passing the canvas name as $w, the subroutine could be written like ====== proc stackedlist {w} { global state3 ClrCanvas $w set state3 3 board $w populateCanvas $w 6 6 3 } ====== ---- ***Screenshots Section*** ****figure 1.**** [Chinese Xianqi Chessboard test1.png%|% width=800 height=400] ****figure 2.**** [Chinese Xianqi Chessboard test2.png%|% width=800 height=400] ****figure 3.**** [Chinese Xianqi Chessboard test3.png%|% width=800 height=400] ****figure 4.**** [Chinese Xianqi Chessboard test4.png%|% width=800 height=400] ---- **Comments Section** Please place any comments here, Thanks. [gold] Changes. [AMG]: I suggest using a [for] loop to make [[chessboard]] more concise. [gold] Is there some way to multiply all numbers in a create statement, leaving the alpha characters unchanged? Perl can do this. I tried but kept bombing, and wound up with this code. ====== set bee1 [ list .c create poly -8 10 -8 7 -5 7 -2 -1 -4 -5 -2 -10 2 -10 4 -5 2 -1 5 7 8 7 8 10 ] set bee2 [ list -8 10 -8 7 -5 7 -2 -1 -4 -5 -2 -10 2 -10 4 -5 2 -1 5 7 8 7 8 10 ] set check "1" foreach factor [list 10 12 14 16 18 20] { set cat [list ] foreach item $bee1 { if { [catch {expr {1 * $item}}] >> 0} {lappend cat $item } if { [catch {expr {1 * $item}}] == 0 } {lappend cat [ expr 200*$factor*.1 + $item * log($factor) ]} } eval $cat -outline gray -fill [lpick $randomcolor ] } ====== [AMG]: Yes, but it's very complex. You'd have to use [[[regexp] -indices -all {\d+} $string]] to find the start and end indices corresponding to the numbers, then you'd extract each number, multiply it, and replace it back into the string using [[[string replace]]]. I don't recommend this approach, especially since it's liable to modify numbers you didn't intend to modify. Also, that regular expression I gave only works for integers; detecting floating point numbers is even harder. What you need to do is have each creation parameter be a function of your [for] loop iterators. You say you have a [Fortran] background; this concept should be familiar to you, except that Fortran says "DO" instead of "for". :^) More seriously, Tcl for loops are weird (in the same way that [C] for loops are weird). They take four arguments: 1. Initialization script. This is executed before the loop begins. It's normally used to create the iteration variable. 1. Termination test. This expression is tested before each iteration, and if it's false, the loop stops. 1. Advancement script. This is executed after each iteration of the loop. It's normally used to increment the iteration variable. 1. Iteration body script. This is executed each time the loop iterates, just before the advancement script. Your main code goes here. Here's code to make a grid similar to the one your program creates. It shows both for and [foreach]. To be honest, foreach is simpler than for when there are a very small number of iterations. Here, replace the first for with "`foreach i {1 2 3 4 5 6 7} {...}`" and the second for with "`foreach i {0 1 2 3 4 5 6 7 8 9} {...}`". ====== set dx 20 ;# pixels between adjacent vertical grid lines set dy 20 ;# pixels between adjacent horizontal grid lines set x0 30 ;# pixels between left of canvas and left of grid set y0 30 ;# pixels between top of canvas and top of grid set win .c ;# name of canvas widget foreach i {0 8} { $win create line [expr {$i * $dx + $x0}] $y0\ [expr {$i * $dx + $x0}] [expr {9 * $dy + $y0}] } for {set i 1} {$i < 8} {incr i} { $win create line [expr {$i * $dx + $x0}] $y0\ [expr {$i * $dx + $x0}] [expr {4 * $dy + $y0}] $win create line [expr {$i * $dx + $x0}] [expr {5 * $dy + $y0}]\ [expr {$i * $dx + $x0}] [expr {9 * $dy + $y0}] } for {set i 0} {$i < 10} {incr i} { $win create line $x0 [expr {$i * $dy + $y0}]\ [expr {8 * $dx + $x0}] [expr {$i * $dy + $y0}] } ====== There's more work to be done, though. Hopefully this will get you started. ---- **References*** * [Simple Canvas Demo] * http://www.goddesschess.com/chessays/gaddbabylon.html * http://skookumpete.com/chess_intro.htm * http://rishida.net/tools/conversion/, outstanding unicode conversion online!!! * http://mayoneez.1g.fi/hiddenlynx/index.html * http://www.chessvariants.org/graphics.dir/big5/index.html * http://geert.vanderkelen.org/2009/12/chessboard-in-mysql.html * http://pinyin.info/tools/converter/chars2uninumbers.html * http://en.wikipedia.org/wiki/Miscellaneous_Symbols_Unicode_block * [A little checker game] * [Simple Canvas Demo] * [Things Chinese] * [Pinyin, ASCII to Unicode Converter] * http://99.237.250.152/xq/book/xiangqi_printset.pdfunicode * http://www.yutopian.com/chinesechess/chrules.pdf **appendix TCL programs** ***FIRST DEMO*** ====== # first demo code from [AMG] # pretty print version from autoindent and ased # Xiangqi chessboard with little frills. # Crosspatch program, dated 3JUL2010. #TCL WIKI contribution package require Tk proc crosspatch {w} { set dx 20 ;# pixels between adjacent vertical grid lines set dy 20 ;# pixels between adjacent horizontal grid lines set x0 30 ;# pixels between left of canvas and left of grid set y0 30 ;# pixels between top of canvas and top of grid set win $w ;# name of canvas widget foreach i {0 8} { $w create line [expr {$i * $dx + $x0}] $y0\ [expr {$i * $dx + $x0}] [expr {9 * $dy + $y0}] } for {set i 1} {$i < 8} {incr i} { $w create line [expr {$i * $dx + $x0}] $y0\ [expr {$i * $dx + $x0}] [expr {4 * $dy + $y0}] $w create line [expr {$i * $dx + $x0}] [expr {5 * $dy + $y0}]\ [expr {$i * $dx + $x0}] [expr {9 * $dy + $y0}] } for {set i 0} {$i < 10} {incr i} { $w create line $x0 [expr {$i * $dy + $y0}]\ [expr {8 * $dx + $x0}] [expr {$i * $dy + $y0}] }} pack [ canvas .cx -width 400 -height 400 ] crosspatch .cx ====== ***SECOND DEMO*** ***minimal example of linked movement on canvas*** ====== # second demo code # pretty print from autoindent and ased editor # Xiangqi chessboard with little frills. # Linked oval and text movement on TCL canvas program, dated 3JUL210. #TCL WIKI contribution #***minimal example of linked movement on canvas*** package require Tk proc grab { xx yy } { global currentx currenty set currentx $xx set currenty $yy } proc move {w xx yy } { global currentx currenty set dx [expr {$xx - $currentx}] set dy [expr {$yy - $currenty}] $w move movable $dx $dy $w raise movable set currentx $xx set currenty $yy } canvas .cv -width 200 -height 200 pack .cv .cv create oval 10 10 30 30 -fill red -tag movable .cv create text 20 20 -text @ -fill blue -tag movable .cv create rect 110 10 130 50 -fill green -tag stationary .cv create rect 10 110 50 90 -fill yellow -tag stationary .cv bind movable {grab %x %y } .cv bind movable {move .cv %x %y } ====== ***THIRD DEMO*** ***pegboard DEMO with little frills *** ====== # pretty print from autoindent and ased editor # pegboard DEMO with little frills. # PEGBOARD program, dated 3JUL210. #TCL WIKI contribution package require Tk proc pegboard {w} { console show set max 400 set may 400 for {set r 50} {$r < $max} {incr r 45} { for {set c 50} {$c < $max} {incr c 45} { set tilename [expr {int(rand()*1000000000.)}] $w create oval $r $c [expr $r+5] [expr $c+5] -outline gray -fill green -width 1 \ -tags [concat mv xdat_[expr $r+5] ydat_[expr $c+5] obj_$tilename] puts " xdat_[expr $r+5] ydat_[expr $c+5] obj_$tilename" set texter " [expr $r+5] [expr $c+5] " $w create text [expr $r+5] [expr $c+20] \ -text $texter -fill green -tags " [expr $r+5] [expr $c+20]" }}} pack [ canvas .cx -width 400 -height 400 ] pegboard .cx ====== ***FIRST VERSION*** ***m*** ====== #start of deck#start of deck #start of deck #start of deck # written on Windowws XP on eTCL # working under TCL version 8.5.6 and eTCL 1.0.1 # gold on TCL WIKI , 17Jul2010 set oscwidth 1000 set oschorizontal 500 proc loop {from to body} { upvar 1 i i ;# make index visible in body for {set i $from} {$i<$to} {incr i} {uplevel 1 $body} } #-- And likewise, a shortcut for addition: proc + {a b} {expr {$a+$b}} pack [canvas .cv -width 400 -height 500 ] focus .cv set state2 1 proc refreshgrid { .cv state2} { global oscwidth oschorizontal colorite global grid set colorite blue for {set x 10} {$x<$oscwidth} {incr x 50} {.cv create line $x 0 $x $oschorizontal -fill blue -tag grid - width 4} for {set y 20} {$y<$oschorizontal} {incr y 50} {.cv create line 0 $y $oschorizontal $y -fill blue -tag grid -width 4} .cv itemconfigure grid -fill blue if { $state2 == 1 } { .cv raise grid ;} if { $state2 == 2 } { .cv lower grid ;} } refreshgrid .cv $state2 # next lines start withn periods, but hard to see . configure -borderwidth 0 -highlightthickness 0 -takefocus 0 -background aquamarine4 . configure -background palegreen -highlightcolor DarkOliveGreen -relief raised -border 30 . configure -width 1000 -height 2000 .cv bind all <1> {set p(X) [.cv canvasx %x]; set p(Y) [.cv canvasy %y]} .cv bind mv {mv .cv %x %y} proc mv {w x y} { global p set x [$w canvasx $x] set y [$w canvasy $y] set id [$w find withtag current] set numberx [$w gettags current] regexp {obj_(\d+)} $numberx -> tilex puts "1" puts $numberx puts $tilex puts " with tag [$w find withtag obj_$tilex ]" foreach item [$w find withtag obj_$tilex ] { $w move $item [expr {$x-$p(X)}] [expr {$y-$p(Y)}] #$w raise $id } puts " x y $x $y" #$w raise $id # $w move [$w find withtag "$tilex"] [expr {$x-$p(X)}] [expr {$y-$p(Y)}] #set numberx [$w gettags current] #regexp {obj_(\d+)} $numberx -> tilex set p(X) $x; set p(Y) $y } set bluepieces [list K A A E E H H R R C C P P P P P] set redpieces [list K A A E E H H R R C C P P P P P] #black western set bluepieces { \u265A \u265B \u265C \u265C \u265D \u265D \u265E \u265E \u265F \u265F \u265F \u265F \u265F \u265F \u265F \u265F} #white western set redpieces { \u2654 \u2655 \u2655 \u2656 \u2656 \u2657 \u2657 \u2658 \u2658 \u2659 \u2659 \u2659 \u2659 \u2659 \u2659 \u2659 \u2659} set bluepieces {\u5C07 \u58EB \u58EB \u8C61 \u8C61 \u99AC \u99AC \u8ECA \u8ECA \u7832 \u7832 \u5352 \u5352 \u5352 \u5352 \u5352} set redpieces { 0 \u5E25 \u4ED5 \u4ED5 \u76F8 \u76F8 \u99AC \u99AC \u8ECA \u8ECA \u70AE \u70AE \u5175 \u5175 \u5175 \u5175 \u5175 } set ind 0 set indx 0 set baseline {list 1} proc K { x y } { set x } proc xpop { topper } { global liner global ind indx global bluepieces redpieces global baseline set topper [ lindex $bluepieces $ind ]; if { $topper == "" } { set topper [ lindex $redpieces $indx ] set indx [ expr { $indx + 1}] } set ind [ expr { $ind + 1}] lappend $baseline $topper; return $topper; } proc populateCanvas {w cols rows args} { global ind indx variable ids ;# links text ids with respective rect ids variable boxes ;# lists text id and text associated with each rect id catch {unset ids boxes} set canvas $w # parameters for drawing boxes set boxwidth 50 set boxheight 50 set padx 3 set pady 3 set colors { orange yellow green gray} set labels {one two three four} # draw the boxes for {set row 0} {$row < $rows} {incr row} { for {set col 0} {$col < $cols} {incr col} { # calculate coordinates set x1 [expr {$col * ($boxwidth + $padx) + $padx}] set x2 [expr {$x1 + $boxwidth}] set x3 [expr {$x1 + ($boxwidth / 2)}] set y1 [expr {$row * ($boxheight + $pady) + $pady}] set y2 [expr {$y1 + $boxheight}] set y3 [expr {$y1 + ($boxheight / 2)}] # choose color and text set color [lindex $colors [expr {int(rand() * [llength $colors])}]] #set text [lindex $labels [expr {int(rand() * [llength $labels])}]] # set text [xpop topper] set font2 [list Helvetica [expr $boxwidth/2]] #set text "0" #set text "K" set text [xpop 1 ] set tilename [expr {int(rand()*1000000000.)}] # create the boxes set boxid [$canvas create oval $x1 $y1 $x2 $y2 \ -fill $color -tags [concat mv rect $args obj_$tilename]\ -outline black] set colorfo blue if { $indx > 1 } {set colorfo red} set textid [$canvas create text $x3 $y3 -font $font2 -fill $colorfo \ -text $text -tags [concat mv $args obj_$tilename] ] # remember which text item goes with which box and what the text says set boxes($boxid) [list $textid $text] set ids($textid) $boxid set ids($boxid) $boxid } } } populateCanvas .cv 6 7 console show #end of deck #end of deck #end of deck #end of deck #end of deck #statements for random names of objects #set numberx [.c gettags current]; # regexp {obj_(\d+)} $numberx -> tilex #.c delete "obj_$tilex+1" ; #set tilename [expr {int(rand()*1000000000.)}] #.c delete obj_$tilex ; #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 ====== ****SECOND VERSION WITH ADDED HACKS *** ====== #start of deck #start of deck #start of deck #!/bin/sh # Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \ exec wish $0 ${1+"$@"} # demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073 #: CanvasDemo: On button-click, draw something on the canvas # gold used canvas demo as base for TCL chess display board. package require Tk proc ClrCanvas {w} { $w delete "all" $w configure -bg white } proc DrawAxis {w} { set midX [expr { $::maxX / 2 }] set midY [expr { $::maxY / 2 }] $w create line 0 $midY $::maxX $midY -tags "axis" $w create line $midX 0 $midX $::maxY -tags "axis" } proc PaintText {w Txt} { global y incr y 10 $w create text 100 $y -text $Txt -tags "text" } proc DrawBox {w} { global x1 y1 x2 y2 $w create rect 50 50 100 90 -tags "box" $w create rect $x1 $y1 $x2 $y2 -tags "box" incr x1 15 incr x2 15 incr y1 10 incr y2 10 } proc DrawFn1 {w} { $w create line 0 100 50 200 100 50 150 70 200 155 250 50 300 111 350 222\ -tags "Fn1" -smooth bezier } proc DrawFn2 {w} { set offY 0 ;# [expr { $::maxY / 2 }] for { set x 0 } { $x <= $::maxX } { incr x 5 } { set y [expr { rand() * $::maxY + $offY }] #puts "$x $y" if {$x>0} { $w create line $x0 $y0 $x $y -tags "Fn2" } set x0 $x set y0 $y } } #: Main : frame .f1 frame .f2 pack .f1 .f2 set maxX 400 set maxY 400 set y 0 set x1 120 set x2 150 set y1 50 set y2 80 canvas .cv -width $maxX -height $maxY -bg tan pack .cv -in .f1 button .a0 -text "xiangqi" -command {set state2 1;set state3 1;board .cv;populateCanvas .cv 6 6 1 } button .a1 -text "west*" -command {unset state3;set state3 3;board .cv;populateCanvas .cv 6 6 3 } button .a2 -text "@" -command {unset state3;set state3 3;board .cv;populateCanvas .cv 6 6 2 } button .b0 -text "C" -command { ClrCanvas .cv } button .b1 -text "Text" -command { PaintText .cv "Chinese Xiangqi Chess" } button .b2 -text "+" -command { DrawAxis .cv } button .b3 -text "\[\]" -command { DrawBox .cv } button .b6 -text "#dn" -command { refreshgrid .cv 2 } button .b7 -text "#up" -command { refreshgrid .cv 1 } button .b8 -text "#^" -command {.cv scale all 0 0 1.1 1.1 } button .b9 -text "#<" -command {.cv scale all 0 0 .9 .9 } button .b10 -text "x" -command { exit } set info "000 000" label .info -textvar info -just left pack .a0 .a1 .a2 .b0 .b1 .b2 .b3 .b6 .b7 .b8 .b9 .b10 .info -in .f2 -side left -padx 2 #catch {console show} set oscwidth 1000 set oschorizontal 500 proc loop {from to body} { upvar 1 i i ;# make index visible in body for {set i $from} {$i<$to} {incr i} {uplevel 1 $body} } #-- And likewise, a shortcut for addition: proc + {a b} {expr {$a+$b}} #pack [canvas .cv -width 400 -height 500 ] # focus .cv set state2 1 proc refreshgrid { .cv state2} { global oscwidth oschorizontal colorite global grid global ind indx set ind 0 set indx 0 set colorite blue for {set x 10} {$x<$oscwidth} {incr x 50} {.cv create line $x 0 $x $oschorizontal -fill blue -tag grid -width 4} for {set y 20} {$y<$oschorizontal} {incr y 50} {.cv create line 0 $y $oschorizontal $y -fill blue -tag grid -width 4} .cv itemconfigure grid -fill blue if { $state2 == 1 } { .cv raise grid ;} if { $state2 == 2 } { .cv lower grid ;} } refreshgrid .cv $state2 # next lines start withn periods, but hard to see . configure -borderwidth 0 -highlightthickness 0 -takefocus 0 -background aquamarine4 . configure -background palegreen -highlightcolor DarkOliveGreen -relief raised -border 30 . configure -background palegreen -highlightcolor DarkOliveGreen -relief raised -border 30 . configure -width 1000 -height 2000 .cv bind all <1> {set p(X) [.cv canvasx %x]; set p(Y) [.cv canvasy %y];set info " %x %y "} .cv bind mv {mv .cv %x %y} .cv bind mv {set info " %x %y "} #.cv bind moveable {item:move %W %x %y 1;set info " %x %y "} proc mv {w x y} { global p set x [$w canvasx $x] set y [$w canvasy $y] set id [$w find withtag current] set numberx [$w gettags current] regexp {obj_(\d+)} $numberx -> tilex puts "1" puts $numberx puts $tilex puts " with tag [$w find withtag obj_$tilex ]" foreach item [$w find withtag obj_$tilex ] { $w move $item [expr {$x-$p(X)}] [expr {$y-$p(Y)}] #$w raise $id } puts " x y $x $y" #$w raise $id # $w move [$w find withtag "$tilex"] [expr {$x-$p(X)}] [expr {$y-$p(Y)}] #set numberx [$w gettags current] #regexp {obj_(\d+)} $numberx -> tilex set p(X) $x; set p(Y) $y } proc board {w} { #set state3 1 set state2 1 ClrCanvas $w . configure -background orange -highlightcolor brown -relief raised -border 30 $w configure -bg tan refreshgrid .cv $state2 ; } proc gamepieces {state3} { global bluepieces redpieces if { $state3 == 2 } { set bluepieces [list K A A E E H H R R C C P P P P P] set redpieces [list 0 K A A E E H H R R C C P P P P P] } if { $state3 == 3 } { #black western set bluepieces { \u265A \u265B \u265C \u265C \u265D \u265D \u265E \u265E \u265F \u265F \u265F \u265F \u265F \u265F \u265F \u265F} #white western set redpieces { 0 \u2654 \u2655 \u2655 \u2656 \u2656 \u2657 \u2657 \u2658 \u2658 \u2659 \u2659 \u2659 \u2659 \u2659 \u2659 \u2659 \u2659} } if { $state3 == 1 } { set bluepieces {\u5C07 \u58EB \u58EB \u8C61 \u8C61 \u99AC \u99AC \u8ECA \u8ECA \u7832 \u7832 \u5352 \u5352 \u5352 \u5352 \u5352} set redpieces { 0 \u5E25 \u4ED5 \u4ED5 \u76F8 \u76F8 \u99AC \u99AC \u8ECA \u8ECA \u70AE \u70AE \u5175 \u5175 \u5175 \u5175 \u5175 } } } set ind 0 set indx 0 set baseline {list 1} proc K { x y } { set x } proc xpop { topper } { global liner global ind indx global bluepieces redpieces global baseline set topper [ lindex $bluepieces $ind ]; if { $topper == "" } { set topper [ lindex $redpieces $indx ] set indx [ expr { $indx + 1}] } set ind [ expr { $ind + 1}] lappend $baseline $topper; return $topper; } set state2 1 proc populateCanvas {w cols rows args} { global state2 state3 gamepieces $args #refreshgrid $w $state2 set state3 $args global ind indx variable ids ;# links text ids with respective rect ids variable boxes ;# lists text id and text associated with each rect id catch {unset ids boxes} set canvas $w # parameters for drawing boxes set boxwidth 50 set boxheight 50 set padx 3 set pady 3 set colors { orange yellow green gray} set labels {one two three four} # draw the boxes for {set row 0} {$row < $rows} {incr row} { for {set col 0} {$col < $cols} {incr col} { # calculate coordinates set x1 [expr {$col * ($boxwidth + $padx) + $padx}] set x2 [expr {$x1 + $boxwidth}] set x3 [expr {$x1 + ($boxwidth / 2)}] set y1 [expr {$row * ($boxheight + $pady) + $pady}] set y2 [expr {$y1 + $boxheight}] set y3 [expr {$y1 + ($boxheight / 2)}] # choose color and text set color [lindex $colors [expr {int(rand() * [llength $colors])}]] #set text [lindex $labels [expr {int(rand() * [llength $labels])}]] # set text [xpop topper] set font2 [list Helvetica [expr $boxwidth/2]] set text "0" #set text "K" set texter [xpop 1 ] set tilename [expr {int(rand()*1000000000.)}] # create the boxes set boxid [$w create oval $x1 $y1 $x2 $y2 \ -fill $color -tags [concat mv rect $args obj_$tilename]\ -outline black] set colorfo blue if { $indx > 1 } {set colorfo red} #set textid [$w create text $x3 $y3 -font $font2 -fill $colorfo \ # -text $text -tags [concat mv $args obj_$tilename] ] set textid [$w create text $x3 $y3 -font $font2 -fill $colorfo \ -text $texter -tags [concat mv $args obj_$tilename ] ] # remember which text item goes with which box and what the text says set boxes($boxid) [list $textid $text] set ids($textid) $boxid set ids($boxid) $boxid } } } populateCanvas .cv 6 6 1 #start of deck #end of deck #end of deck #end of deck #end of deck #end of deck #end of deck ====== ****Version with added hacks and pegboard**** ====== #start of deck #start of deck #start of deck #!/bin/sh #!/bin/sh # Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \ exec wish $0 ${1+"$@"} # demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073 #: CanvasDemo: On button-click, draw something on the canvas # gold used canvas demo as base for TCL chess display board. # written on Windowws XP on eTCL # working under TCL version 8.5.6 and eTCL 1.0.1 # gold on TCL WIKI , 17Jul2010 proc scr {w} { console show set max 400 set may 400 for {set r 50} {$r < $max} {incr r 45} { for {set c 50} {$c < $max} {incr c 45} { set tilename [expr {int(rand()*1000000000.)}] $w create oval $r $c [expr $r+5] [expr $c+5] -outline gray -fill green -width 1 \ -tags [concat mv xdat_[expr $r+5] ydat_[expr $c+5] obj_$tilename] puts " xdat_[expr $r+5] ydat_[expr $c+5] obj_$tilename" set texter " [expr $r+5] [expr $c+5] " $w create text [expr $r+5] [expr $c+20] \ -text $texter -fill green -tags " [expr $r+5] [expr $c+20]" }}} package require Tk proc ClrCanvas {w} { $w delete "all" $w configure -bg white } proc DrawAxis {w} { set midX [expr { $::maxX / 2 }] set midY [expr { $::maxY / 2 }] $w create line 0 $midY $::maxX $midY -tags "axis" $w create line $midX 0 $midX $::maxY -tags "axis" } proc PaintText {w Txt} { global y incr y 10 $w create text 100 $y -text $Txt -tags "text" } proc DrawBox {w} { global x1 y1 x2 y2 $w create rect 50 50 100 90 -tags "box" $w create rect $x1 $y1 $x2 $y2 -tags "box" incr x1 15 incr x2 15 incr y1 10 incr y2 10 } proc DrawFn1 {w} { $w create line 0 100 50 200 100 50 150 70 200 155 250 50 300 111 350 222\ -tags "Fn1" -smooth bezier } proc DrawFn2 {w} { set offY 0 ;# [expr { $::maxY / 2 }] for { set x 0 } { $x <= $::maxX } { incr x 5 } { set y [expr { rand() * $::maxY + $offY }] #puts "$x $y" if {$x>0} { $w create line $x0 $y0 $x $y -tags "Fn2" } set x0 $x set y0 $y } } #: Main : frame .f1 frame .f2 pack .f1 .f2 set maxX 400 set maxY 450 set y 0 set x1 120 set x2 150 set y1 50 set y2 80 canvas .cv -width $maxX -height $maxY -bg tan pack .cv -in .f1 button .a0 -text "xiangqi" -command {set state2 1;set state3 1;board .cv;populateCanvas .cv 6 6 1 } button .a1 -text "west*" -command {unset state3;set state3 3;board .cv;populateCanvas .cv 6 6 3 } button .a2 -text "@" -command {unset state3;set state3 3;board .cv;populateCanvas .cv 6 6 2 } button .a3 -text "&" -command { ClrCanvas .cv;scr .cv } button .a4 -text "?" -command { squarenames .cv; refreshgrid .cv 1 } button .b0 -text "C" -command { ClrCanvas .cv } button .b1 -text "Text" -command { PaintText .cv "Chinese Xiangqi Chess" } button .b2 -text "+" -command { DrawAxis .cv } button .b3 -text "\[\]" -command { DrawBox .cv } button .b6 -text "#dn" -command { refreshgrid .cv 2 } button .b7 -text "#up" -command { refreshgrid .cv 1 } button .b8 -text "#^" -command {.cv scale all 0 0 1.1 1.1 } button .b9 -text "#<" -command {.cv scale all 0 0 .9 .9 } button .b10 -text "x" -command { exit } set info "000 000" label .info -textvar info -just left pack .a0 .a1 .a2 .a3 .a4 .b0 .b1 .b2 .b3 .b6 .b7 .b8 .b9 .b10 .info -in .f2 -side left -padx 2 #catch {console show} set oscwidth 1000 set oschorizontal 500 proc loop {from to body} { upvar 1 i i ;# make index visible in body for {set i $from} {$i<$to} {incr i} {uplevel 1 $body} } #-- And likewise, a shortcut for addition: proc + {a b} {expr {$a+$b}} #pack [canvas .cv -width 400 -height 500 ] # focus .cv set state2 1 proc refreshgrid { w state2} { global oscwidth oschorizontal colorite global grid global ind indx set ind 0 set indx 0 set colorite blue set dx 45 ;# pixels between adjacent vertical grid lines set dy 45 ;# pixels between adjacent horizontal grid lines set x0 30 ;# pixels between left of canvas and left of grid set y0 30 ;# pixels between top of canvas and top of grid #set win $w ;# name of canvas widget foreach i {0 8} { $w create line [expr {$i * $dx + $x0}] $y0\ [expr {$i * $dx + $x0}] [expr {9 * $dy + $y0}] -width 2 -fill blue -tag grid } for {set i 1} {$i < 8} {incr i} { $w create line [expr {$i * $dx + $x0}] $y0\ [expr {$i * $dx + $x0}] [expr {4 * $dy + $y0}] -width 2 -fill blue -tag grid $w create line [expr {$i * $dx + $x0}] [expr {5 * $dy + $y0}]\ [expr {$i * $dx + $x0}] [expr {9 * $dy + $y0}] -width 2 -fill blue -tag grid } for {set i 0} {$i < 10} {incr i} { $w create line $x0 [expr {$i * $dy + $y0}]\ [expr {8 * $dx + $x0}] [expr {$i * $dy + $y0}] -width 2 -fill blue -tag grid } .cv itemconfigure grid -fill blue if { $state2 == 1 } { .cv raise grid ;} if { $state2 == 2 } { .cv lower grid ;} } refreshgrid .cv $state2 # next lines start withn periods, but hard to see . configure -borderwidth 0 -highlightthickness 0 -takefocus 0 -background aquamarine4 . configure -background palegreen -highlightcolor DarkOliveGreen -relief raised -border 30 . configure -background palegreen -highlightcolor DarkOliveGreen -relief raised -border 30 . configure -width 1000 -height 2000 .cv bind mv {set info " %x %y "; catch {.cv itemconfigure [lindex $id 0] -outline black -width 1 } } .cv bind all <1> {set p(X) [.cv canvasx %x]; set p(Y) [.cv canvasy %y];set info " %x %y "} set haloo 50 .cv bind mv {mv .cv %x %y} #.cv bind mv {set info " %x %y ";puts " nearest [.cv find closest %x %y $haloo ]"} #.cv bind moveable {item:move %W %x %y 1;set info " %x %y "} bind .cv {wm title . "Xiangqi Chessboard [expr int( [%W canvasx %x])],[expr int ([%W canvasy %y])]"} proc mv {w x y} { global p id set x [$w canvasx $x] set y [$w canvasy $y] set id [$w find withtag current] set numberx [$w gettags current] regexp {obj_(\d+)} $numberx -> tilex puts "1" puts $numberx puts $tilex puts " with tag [$w find withtag obj_$tilex ]" foreach item [$w find withtag obj_$tilex ] { $w move $item [expr {$x-$p(X)}] [expr {$y-$p(Y)}] catch {$w itemconfigure [lindex $id 0] -outline purple -width 5 } #$w raise $id } puts " x y $x $y" #$w raise $id # $w move [$w find withtag "$tilex"] [expr {$x-$p(X)}] [expr {$y-$p(Y)}] #set numberx [$w gettags current] #regexp {obj_(\d+)} $numberx -> tilex catch {$w itemconfigure [lindex $id 0] -outline purple -width 5 } set p(X) $x; set p(Y) $y } proc board {w} { #set state3 1 set state2 1 ClrCanvas $w . configure -background orange -highlightcolor brown -relief raised -border 30 $w configure -bg tan refreshgrid .cv $state2 ; } proc squarenames {l} { console show set result {} set i [llength $l] set cc 0 set rr 0 foreach row {8 7 6 5 4 3 2 1} { set rowscreen [expr {$rr*50.}] foreach column {A B C D E F G H} { set colscreen [expr {$cc*50.}] lappend result "$column$row $rowscreen $colscreen" incr cc 1 incr rr 1 }} puts $result return $result } #foreach row {8 7 6 5 4 3 2 1} { #foreach column {A B C D E F G H} { # lappend res [" " "$column$row"] #puts " $column$row " proc gamepieces {state3} { global bluepieces redpieces if { $state3 == 2 } { set bluepieces [list K A A E E H H R R C C P P P P P] set redpieces [list 0 K A A E E H H R R C C P P P P P] } if { $state3 == 3 } { #black western set bluepieces { \u265A \u265B \u265C \u265C \u265D \u265D \u265E \u265E \u265F \u265F \u265F \u265F \u265F \u265F \u265F \u265F} #white western set redpieces { 0 \u2654 \u2655 \u2655 \u2656 \u2656 \u2657 \u2657 \u2658 \u2658 \u2659 \u2659 \u2659 \u2659 \u2659 \u2659 \u2659 \u2659} } if { $state3 == 1 } { set bluepieces {\u5C07 \u58EB \u58EB \u8C61 \u8C61 \u99AC \u99AC \u8ECA \u8ECA \u7832 \u7832 \u5352 \u5352 \u5352 \u5352 \u5352} set redpieces { 0 \u5E25 \u4ED5 \u4ED5 \u76F8 \u76F8 \u99AC \u99AC \u8ECA \u8ECA \u70AE \u70AE \u5175 \u5175 \u5175 \u5175 \u5175 } } } set ind 0 set indx 0 set baseline {list 1} proc K { x y } { set x } proc xpop { topper } { global liner global ind indx global bluepieces redpieces global baseline set topper [ lindex $bluepieces $ind ]; if { $topper == "" } { set topper [ lindex $redpieces $indx ] set indx [ expr { $indx + 1}] } set ind [ expr { $ind + 1}] lappend $baseline $topper; return $topper; } set state2 1 proc populateCanvas {w cols rows args} { global state2 state3 gamepieces $args #refreshgrid $w $state2 set state3 $args global ind indx variable ids ;# links text ids with respective rect ids variable boxes ;# lists text id and text associated with each rect id catch {unset ids boxes} set canvas $w # parameters for drawing boxes set boxwidth 50 set boxheight 50 set padx 3 set pady 3 set colors { orange yellow green gray} set labels {one two three four} # draw the boxes for {set row 0} {$row < $rows} {incr row} { for {set col 0} {$col < $cols} {incr col} { # calculate coordinates set x1 [expr {$col * ($boxwidth + $padx) + $padx}] set x2 [expr {$x1 + $boxwidth}] set x3 [expr {$x1 + ($boxwidth / 2)}] set y1 [expr {$row * ($boxheight + $pady) + $pady}] set y2 [expr {$y1 + $boxheight}] set y3 [expr {$y1 + ($boxheight / 2)}] # choose color and text set color [lindex $colors [expr {int(rand() * [llength $colors])}]] #set text [lindex $labels [expr {int(rand() * [llength $labels])}]] # set text [xpop topper] set font2 [list Helvetica [expr $boxwidth/2]] set text "0" #set text "K" set texter [xpop 1 ] set tilename [expr {int(rand()*1000000000.)}] # create the boxes set boxid [$w create oval $x1 $y1 $x2 $y2 \ -fill $color -tags [concat mv rect $args obj_$tilename]\ -outline black] set colorfo blue if { $indx > 1 } {set colorfo red} #set textid [$w create text $x3 $y3 -font $font2 -fill $colorfo \ # -text $text -tags [concat mv $args obj_$tilename] ] set textid [$w create text $x3 $y3 -font $font2 -fill $colorfo \ -text $texter -tags [concat mv $args obj_$tilename ] ] # remember which text item goes with which box and what the text says set boxes($boxid) [list $textid $text] set ids($textid) $boxid set ids($boxid) $boxid } } } populateCanvas .cv 6 6 1 squarenames {1 2 3 } #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 ====== ---- ***test on chess and xiangqi fonts*** ***set bluepieces {將士 士將 象 象 馬 馬 車 車 砲 砲 卒 卒卒 卒卒 ]#trad. ***set redpieces { 帥 仕 象 象 相 相 馬 馬 車 車 砲 砲 兵炮 炮 兵 兵 兵 兵 ] #trad ***set bluepieces {王 王 王 象 象 马 马 车 车 炮 炮 典 典 典 典 典 典}***#simplified ***set redpieces {王 王 王 象 象 马 马 车 车 炮 炮 典 典 典 典 典 典}***simplified set bluepieces {K A A E E H H R R C C P P P P P]#english letters set redpieces {K A A E E H H R R C C P P P P P]#english letters babelfish gives炮 ***国王一般普通话大象马运输车大炮战士典当*** from king general mandarin elephant horse chariot cannon soldier pawn, # probably need an if switch option for TCL lists ***set bluepieces [list 將士 士將 象 象 馬 馬 車 車 砲, 砲, 卒 卒卒 卒卒 ]#trad. ***set redpieces [list 帥 仕, 象 象 相 相 馬 馬 車 車 砲 砲 兵炮 炮 兵 兵 兵 兵 ] #trad 將 King 士 士Adviser 車 車chaRiot   馬 馬Horse 炮 炮Cannon  象象 Elephant卒 卒 卒 卒 卒Pawn   帥 King  仕  仕 Adviser 車 車 chaRiot  馬  馬 Horse 炮 炮 Cannon 仕  仕 Elephant 兵 兵兵兵兵 Pawn ***set bluepieces [list 王 王 王 象 象 马 马 车 车 炮 炮 典 典 典 典 典 典]***#simplified ***set redpieces [list 王 王 王 象 象 马 马 车 车 炮 炮 典 典 典 典 典 典]***simplified set bluepieces [list K A A E E H H R R C C P P P P P]#english letters set redpieces [list K A A E E H H R R C C P P P P P]#english letters ***♔','♕','♖','♗','♘','♙','♚','♛','♜','♝','♞','♟'*** ***gummy version with purple highlights on moving pieces.*** ====== #start of deck #start of deck #start of deck #!/bin/sh #!/bin/sh # Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \ exec wish $0 ${1+"$@"} # demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073 #: CanvasDemo: On button-click, draw something on the canvas # gold used canvas demo as base for TCL chess display board. proc scr {w} { console show set max 400 set may 400 for {set r 50} {$r < $max} {incr r 45} { for {set c 50} {$c < $max} {incr c 45} { set tilename [expr {int(rand()*1000000000.)}] $w create oval $r $c [expr $r+5] [expr $c+5] -outline gray -fill green -width 1 \ -tags [concat mv xdat_[expr $r+5] ydat_[expr $c+5] obj_$tilename] puts " xdat_[expr $r+5] ydat_[expr $c+5] obj_$tilename" set texter " [expr $r+5] [expr $c+5] " $w create text [expr $r+5] [expr $c+20] \ -text $texter -fill green -tags " [expr $r+5] [expr $c+20]" }}} package require Tk proc ClrCanvas {w} { $w delete "all" $w configure -bg white } proc DrawAxis {w} { set midX [expr { $::maxX / 2 }] set midY [expr { $::maxY / 2 }] $w create line 0 $midY $::maxX $midY -tags "axis" $w create line $midX 0 $midX $::maxY -tags "axis" } proc PaintText {w Txt} { global y incr y 10 $w create text 100 $y -text $Txt -tags "text" } proc DrawBox {w} { global x1 y1 x2 y2 $w create rect 50 50 100 90 -tags "box" $w create rect $x1 $y1 $x2 $y2 -tags "box" incr x1 15 incr x2 15 incr y1 10 incr y2 10 } proc DrawFn1 {w} { $w create line 0 100 50 200 100 50 150 70 200 155 250 50 300 111 350 222\ -tags "Fn1" -smooth bezier } proc DrawFn2 {w} { set offY 0 ;# [expr { $::maxY / 2 }] for { set x 0 } { $x <= $::maxX } { incr x 5 } { set y [expr { rand() * $::maxY + $offY }] #puts "$x $y" if {$x>0} { $w create line $x0 $y0 $x $y -tags "Fn2" } set x0 $x set y0 $y } } #: Main : frame .f1 frame .f2 pack .f1 .f2 set maxX 400 set maxY 400 set y 0 set x1 120 set x2 150 set y1 50 set y2 80 canvas .cv -width $maxX -height $maxY -bg tan pack .cv -in .f1 button .a0 -text "xiangqi" -command {set state2 1;set state3 1;board .cv;populateCanvas .cv 6 6 1 } button .a1 -text "west*" -command {unset state3;set state3 3;board .cv;populateCanvas .cv 6 6 3 } button .a2 -text "@" -command {unset state3;set state3 3;board .cv;populateCanvas .cv 6 6 2 } button .a3 -text "&" -command { ClrCanvas .cv;scr .cv } button .b0 -text "C" -command { ClrCanvas .cv } button .b1 -text "Text" -command { PaintText .cv "Chinese Xiangqi Chess" } button .b2 -text "+" -command { DrawAxis .cv } button .b3 -text "\[\]" -command { DrawBox .cv } button .b6 -text "#dn" -command { refreshgrid .cv 2 } button .b7 -text "#up" -command { refreshgrid .cv 1 } button .b8 -text "#^" -command {.cv scale all 0 0 1.1 1.1 } button .b9 -text "#<" -command {.cv scale all 0 0 .9 .9 } button .b10 -text "x" -command { exit } set info "000 000" label .info -textvar info -just left pack .a0 .a1 .a2 .a3 .b0 .b1 .b2 .b3 .b6 .b7 .b8 .b9 .b10 .info -in .f2 -side left -padx 2 #catch {console show} set oscwidth 1000 set oschorizontal 500 proc loop {from to body} { upvar 1 i i ;# make index visible in body for {set i $from} {$i<$to} {incr i} {uplevel 1 $body} } #-- And likewise, a shortcut for addition: proc + {a b} {expr {$a+$b}} #pack [canvas .cv -width 400 -height 500 ] # focus .cv set state2 1 proc refreshgrid { .cv state2} { global oscwidth oschorizontal colorite global grid global ind indx set ind 0 set indx 0 set colorite blue for {set x 10} {$x<$oscwidth} {incr x 50} {.cv create line $x 0 $x $oschorizontal -fill blue -tag grid - width 4} for {set y 20} {$y<$oschorizontal} {incr y 50} {.cv create line 0 $y $oschorizontal $y -fill blue -tag grid -width 4} .cv itemconfigure grid -fill blue if { $state2 == 1 } { .cv raise grid ;} if { $state2 == 2 } { .cv lower grid ;} } refreshgrid .cv $state2 # next lines start withn periods, but hard to see . configure -borderwidth 0 -highlightthickness 0 -takefocus 0 -background aquamarine4 . configure -background palegreen -highlightcolor DarkOliveGreen -relief raised -border 30 . configure -background palegreen -highlightcolor DarkOliveGreen -relief raised -border 30 . configure -width 1000 -height 2000 .cv bind mv {set info " %x %y "; catch {.cv itemconfigure [lindex $id 0] -outline black -width 1 } } .cv bind all <1> {set p(X) [.cv canvasx %x]; set p(Y) [.cv canvasy %y];set info " %x %y "} set haloo 50 .cv bind mv {mv .cv %x %y} #.cv bind mv {set info " %x %y ";puts " nearest [.cv find closest %x %y $haloo ]"} #.cv bind moveable {item:move %W %x %y 1;set info " %x %y "} bind .cv {wm title . "Xiangqi Chessboard [expr int( [%W canvasx %x])],[expr int ([%W canvasy %y])]"} proc mv {w x y} { global p id set x [$w canvasx $x] set y [$w canvasy $y] set id [$w find withtag current] set numberx [$w gettags current] regexp {obj_(\d+)} $numberx -> tilex puts "1" puts $numberx puts $tilex puts " with tag [$w find withtag obj_$tilex ]" foreach item [$w find withtag obj_$tilex ] { $w move $item [expr {$x-$p(X)}] [expr {$y-$p(Y)}] catch {$w itemconfigure [lindex $id 0] -outline purple -width 5 } #$w raise $id } puts " x y $x $y" #$w raise $id # $w move [$w find withtag "$tilex"] [expr {$x-$p(X)}] [expr {$y-$p(Y)}] #set numberx [$w gettags current] #regexp {obj_(\d+)} $numberx -> tilex catch {$w itemconfigure [lindex $id 0] -outline purple -width 5 } set p(X) $x; set p(Y) $y } proc board {w} { #set state3 1 set state2 1 ClrCanvas $w . configure -background orange -highlightcolor brown -relief raised -border 30 $w configure -bg tan refreshgrid .cv $state2 ; } proc squarenames {l} { console show set result {} set i [llength $l] set cc 0 set rr 0 foreach row {8 7 6 5 4 3 2 1} { set rowscreen [expr {$rr*50.}] foreach column {A B C D E F G H} { set colscreen [expr {$cc*50.}] lappend result "$column$row $rowscreen $colscreen" incr cc 1 incr rr 1 }} puts $result return $result } #foreach row {8 7 6 5 4 3 2 1} { #foreach column {A B C D E F G H} { # lappend res [" " "$column$row"] #puts " $column$row " proc gamepieces {state3} { global bluepieces redpieces if { $state3 == 2 } { set bluepieces [list K A A E E H H R R C C P P P P P] set redpieces [list 0 K A A E E H H R R C C P P P P P] } if { $state3 == 3 } { #black western set bluepieces { \u265A \u265B \u265C \u265C \u265D \u265D \u265E \u265E \u265F \u265F \u265F \u265F \u265F \u265F \u265F \u265F} #white western set redpieces { 0 \u2654 \u2655 \u2655 \u2656 \u2656 \u2657 \u2657 \u2658 \u2658 \u2659 \u2659 \u2659 \u2659 \u2659 \u2659 \u2659 \u2659} } if { $state3 == 1 } { set bluepieces {\u5C07 \u58EB \u58EB \u8C61 \u8C61 \u99AC \u99AC \u8ECA \u8ECA \u7832 \u7832 \u5352 \u5352 \u5352 \u5352 \u5352} set redpieces { 0 \u5E25 \u4ED5 \u4ED5 \u76F8 \u76F8 \u99AC \u99AC \u8ECA \u8ECA \u70AE \u70AE \u5175 \u5175 \u5175 \u5175 \u5175 } } } set ind 0 set indx 0 set baseline {list 1} proc K { x y } { set x } proc xpop { topper } { global liner global ind indx global bluepieces redpieces global baseline set topper [ lindex $bluepieces $ind ]; if { $topper == "" } { set topper [ lindex $redpieces $indx ] set indx [ expr { $indx + 1}] } set ind [ expr { $ind + 1}] lappend $baseline $topper; return $topper; } set state2 1 proc populateCanvas {w cols rows args} { global state2 state3 gamepieces $args #refreshgrid $w $state2 set state3 $args global ind indx variable ids ;# links text ids with respective rect ids variable boxes ;# lists text id and text associated with each rect id catch {unset ids boxes} set canvas $w # parameters for drawing boxes set boxwidth 50 set boxheight 50 set padx 3 set pady 3 set colors { orange yellow green gray} set labels {one two three four} # draw the boxes for {set row 0} {$row < $rows} {incr row} { for {set col 0} {$col < $cols} {incr col} { # calculate coordinates set x1 [expr {$col * ($boxwidth + $padx) + $padx}] set x2 [expr {$x1 + $boxwidth}] set x3 [expr {$x1 + ($boxwidth / 2)}] set y1 [expr {$row * ($boxheight + $pady) + $pady}] set y2 [expr {$y1 + $boxheight}] set y3 [expr {$y1 + ($boxheight / 2)}] # choose color and text set color [lindex $colors [expr {int(rand() * [llength $colors])}]] #set text [lindex $labels [expr {int(rand() * [llength $labels])}]] # set text [xpop topper] set font2 [list Helvetica [expr $boxwidth/2]] set text "0" #set text "K" set texter [xpop 1 ] set tilename [expr {int(rand()*1000000000.)}] # create the boxes set boxid [$w create oval $x1 $y1 $x2 $y2 \ -fill $color -tags [concat mv rect $args obj_$tilename]\ -outline black] set colorfo blue if { $indx > 1 } {set colorfo red} #set textid [$w create text $x3 $y3 -font $font2 -fill $colorfo \ # -text $text -tags [concat mv $args obj_$tilename] ] set textid [$w create text $x3 $y3 -font $font2 -fill $colorfo \ -text $texter -tags [concat mv $args obj_$tilename ] ] # remember which text item goes with which box and what the text says set boxes($boxid) [list $textid $text] set ids($textid) $boxid set ids($boxid) $boxid } } } populateCanvas .cv 6 6 1 squarenames {1 2 3 } ====== ---- [gold] This page is copyrighted under the TCL/TK license terms, [http://tcl.tk/software/tcltk/license.html%|%this license]. **Comments Section** '''[arjen] - 2010-06-29 03:31:13''' Just a minor comment: the characters are simplified Chinese, I am not sure that is what you would encounter on a real chessboard. ---- [gold]# May just use English letters initially and switch for option of simplified or traditional characters. [gold] 1jul2010, There are Xiangqi sets with simplified characters made in PRC, but probably not common elsewhere. Really lacking though, are specific unicode fonts for Xiangqi. Meanwhile code will make do with language fonts. ---- [AMG]: A note concerning the [[[list]]] command: It's not necessary to use [[list]] if none of the elements are the product of substitution. In other words, if the list will always have the same elements, you don't need the [[list]] command to construct the list. Instead simply surround the list with {braces}. Its internal representation will become list when it gets used as a list, since Tcl has [duck typing]. Similar goes for [[[dict create]]]. I mean, when you want a number, you just type the number, even though its initial internal representation will be string. It "becomes" a number when context shows that it is a number. You never see code that does this: `set var [[expr 5]]`; only this: `set var 5`. <> Please place any comments here, Thanks. ---- ---- <> Numerical Analysis | Toys | Calculator | Mathematics| Example| Toys and Games | Games | Application | GUI ---- <> Development | Concept| Algorithm | Characters