Version 53 of Chinese Xiangqi Chessboard

Chinese Xianqi Chessboard

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 red and blue on round wooden pieces,

which might be unicode characters in chinese.

 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

♔','♕','♖','♗','♘','♙','♚','♛','♜','♝','♞','♟'

Screenshots Section

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? 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:

Initialization script. This is executed before the loop begins. It's normally used to create the iteration variable.
Termination test. This expression is tested before each iteration, and if it's false, the loop stops.
Advancement script. This is executed after each iteration of the loop. It's normally used to increment the iteration variable.
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*

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

http://wiki.tcl.tk/884 http://wiki.tcl.tk/9493 http://wiki.tcl.tk/14255 http://99.237.250.152/xq/book/xiangqi_printset.pdfunicode

http://play.chessvariants.org/pbm/presets/chinese_chess.html http://www.yutopian.com/chinesechess/chrules.pdf

appendix TCL programs

FIRST VERSION

 #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

*SECOND VERSION WITH ADDED HACKS

       #!/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 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.

gold# not sure script/Etcl addressed ch. characters correctly.

  May just use English letters initially and switch for 
 option of simplified or traditional characters.

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.

test on chess and xiangqi fonts

 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

♔','♕','♖','♗','♘','♙','♚','♛','♜','♝','♞','♟'

 ('','\u2654','\u2655','\u2656','\u2657','\u2658','\u2659',            '\u265A','\u265B','\u265C','\u265D','\u265E','\u265F'),       =('','\u2654','\u2655','\u2656','\u2657','\u2658','\u2659',            '\u265A','\u265B','\u265C','\u265D','\u265E','\u265F'),        c ENUM('','\u2654','\u2655','\u2656','\u2657','\u2658','\u2659',            '\u265A','\u265B','\u265C','\u265D','\u265E','\u265F'),