This page is under development. Comments are welcome, but please load any comments in the comments section at the middle of the page. Thanks,gold
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. I installed a version of the code in the Simple Canvas Demo for some pictures. Also I made a lengthy list of 60 line creations in TCLpaint,but we better rely on foreach or loop statements for compact code. http://wiki.tcl.tk/884 http://wiki.tcl.tk/15073
The characters are generally stamped on round wooden pieces,
which might be unicode characters in chinese.
babelfish gives
from
king general mandarin elephant horse chariot cannon soldier pawn
number english unicode (maybe) red blue\u23558; General (King) 1 K \u23558; 帅 将 Mandarin 2 A 仕 士 \u22763; u\35937; Elephant 2 E 象 相 \u30456; Horse 2 H \u39532; 马 马 Chariot 2 R \u36710; 车 车 Cannon 2 C \u30770; 砲 Soldier (Pawn) 5 P \u20853; 兵 卒 \u21330; ***国王一般普通话大象马运输车大炮战士典当***
卒
\u22269;\u29579;\u19968;\u33324;\u26222;\u36890;\u35805;\u22823;\u35937;\u39532;\u36816;\u36755;\u36710;\u22823;\u28846;\u25112;\u22763;\u20856;\u24403;
***国王一般普通话大象马运输车大炮战士典当*** http://pinyin.info/tools/converter/chars2uninumbers.html $c create text 25c 25.2c -text "\u263D moon " -font $font3 -tags item
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? 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:
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.
#start of deck#start of deck #start of deck #start of deck frame .f1 set oscwidth 1000 set oschorizontal 500 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 #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
#!/usr/bin/env wish #start of deck #start of deck #start of deck #start of deck 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 <B1-Motion> {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 ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?] set redpieces [list ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?] 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] 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 6 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
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.