Index: doc/example-scripts/tk-ludo.html =================================================================== diff -u -rc08415f59c4ce753f976d0513d6208426772ef2a -rc8cc440e978deb40fd40436aa72a9d41e86532ba --- doc/example-scripts/tk-ludo.html (.../tk-ludo.html) (revision c08415f59c4ce753f976d0513d6208426772ef2a) +++ doc/example-scripts/tk-ludo.html (.../tk-ludo.html) (revision c8cc440e978deb40fd40436aa72a9d41e86532ba) @@ -3,7 +3,7 @@ - + Listing of doc/example-scripts/tk-ludo.tcl -
::nx::Slot method type=expr {name value} {return [expr $value]}
+
::nx::Slot method type=expr {name value} {return [expr $value]}

Class Figure

-
proc random:select L {lindex $L [expr int(rand()*[llength $L].)]}
+
proc random:select L {lindex $L [expr int(rand()*[llength $L].)]}
 proc lexpr {term L} {
-    # map an expr term to each element \$i of a list
+    # map an expr term to each element \$i of a list
     set res [list]
-    foreach i $L {lappend res [eval expr $term]}
+    foreach i $L {lappend res [eval expr $term]}
     set res
 }

Class Die

@@ -992,76 +994,76 @@ :require trait nx::traits::callback :method set {n} { - # - # Set the eyes of the die. - # - ${:canvas} itemconfig ${:grouptag} -fill ${:bg} -outline ${:bg} + # + # Set the eyes of the die. + # + ${:canvas} itemconfig ${:grouptag} -fill ${:bg} -outline ${:bg} foreach i [lindex [list \ {} {d5} [random:select {{d3 d7} {d1 d9}}] \ [random:select {{d1 d5 d9} {d3 d5 d7}}] \ {d1 d3 d7 d9} {d1 d3 d5 d7 d9} \ [random:select {{d1 d3 d4 d6 d7 d9} {d1 d2 d3 d7 d8 d9}}] \ - ] $n] { - ${:canvas} itemconfig ${:id}$i -fill ${:fg} -outline ${:fg} + ] $n] { + ${:canvas} itemconfig ${:id}$i -fill ${:fg} -outline ${:fg} } - set :eyes $n + set :eyes $n } :public method invalidate {} { - # - # Invalidate the eyes to avoid double uses of the eyes. - # + # + # Invalidate the eyes to avoid double uses of the eyes. + # set :eyes 0 } :public method roll {} { - # - # Roll the dice and animate rolling - # - # wiggle: amount, pick one of eight wiggle directions - set dwig [expr ${:size}/5] - for {set i 10} {$i<100} {incr i 10} { + # + # Roll the dice and animate rolling + # + # wiggle: amount, pick one of eight wiggle directions + set dwig [expr {${:size}/5}] + for {set i 10} {$i<100} {incr i 10} { :set [expr {int(rand() * 6) + 1}] set wig [random:select {0,1 0,-1 1,0 -1,0 1,1 -1,1 1,-1 -1,-1}] - set wig [lexpr \$i*$dwig [split $wig ,]] - ${:canvas} move group${:id} {*}$wig + set wig [lexpr \$i*$dwig [split $wig ,]] + ${:canvas} move group${:id} {*}$wig update - set wig [lexpr \$i*-1 $wig] ;# wiggle back - ${:canvas} move group${:id} {*}$wig - after $i + set wig [lexpr \$i*-1 $wig] ;# wiggle back + ${:canvas} move group${:id} {*}$wig + after $i } } :method init {} { - # - # initialize the widgets with tags interactions - # - set x [expr {${:x} - ${:size}/2.0}] - set y [expr {${:y} - ${:size}/2.0}] - set :id [${:canvas} create rect $x $y \ - [expr {$x+${:size}}] [expr {$y+${:size}}] \ - -fill ${:bg} -tags mvg] - set :grouptag group${:id} - ${:canvas} addtag ${:grouptag} withtag ${:id} - set ex [expr {$x+${:size}/10.}] - set ey [expr {$y+${:size}/10.}] - set d [expr {${:size}/5.}];# dot diameter - set dotno 1 ;# dot counter - foreach y [list $ey [expr {$ey+$d*1.5}] [expr {$ey+$d*3}]] { - foreach x [list $ex [expr {$ex+$d*1.5}] [expr {$ex+$d*3}]] { - ${:canvas} create oval $x $y [expr {$x+$d}] [expr {$y+$d}] \ - -fill ${:bg} -outline ${:bg} \ - -tags [list mvg ${:grouptag} ${:id}d$dotno] + # + # initialize the widgets with tags interactions + # + set x [expr {${:x} - ${:size}/2.0}] + set y [expr {${:y} - ${:size}/2.0}] + set :id [${:canvas} create rect $x $y \ + [expr {$x+${:size}}] [expr {$y+${:size}}] \ + -fill ${:bg} -tags mvg] + set :grouptag group${:id} + ${:canvas} addtag ${:grouptag} withtag ${:id} + set ex [expr {$x+${:size}/10.}] + set ey [expr {$y+${:size}/10.}] + set d [expr {${:size}/5.}];# dot diameter + set dotno 1 ;# dot counter + foreach y [list $ey [expr {$ey+$d*1.5}] [expr {$ey+$d*3}]] { + foreach x [list $ex [expr {$ex+$d*1.5}] [expr {$ex+$d*3}]] { + ${:canvas} create oval $x $y [expr {$x+$d}] [expr {$y+$d}] \ + -fill ${:bg} -outline ${:bg} \ + -tags [list mvg ${:grouptag} ${:id}d$dotno] incr dotno } } :set [expr {int(rand()*6)+1}] :invalidate - # - # To dice, let people click on the die, or press <d> on the - # board - # - ${:canvas} bind mvg <1> [:callback roll] + # + # To dice, let people click on the die, or press <d> on the + # board + # + ${:canvas} bind mvg <1> [:callback roll] bind . <d> [:callback roll] } } @@ -1087,274 +1089,274 @@ :require trait nx::traits::callback :method lookup {var idx} { - # - # Convenience lookup function for arbitrary instance - # variables. - # + # + # Convenience lookup function for arbitrary instance + # variables. + # set key "${var}($idx)" - if {[info exists $key]} {return [set $key]} + if {[info exists $key]} {return [set $key]} return "" } - :public method getPointCenter {nr} {:lookup :pointCenter $nr} - :public method getPointId {nr} {:lookup :pointId $nr} + :public method getPointCenter {nr} {:lookup :pointCenter $nr} + :public method getPointId {nr} {:lookup :pointId $nr} :method line { x0:expr,convert y0:expr,convert x1:expr,convert y1:expr,convert {-width 1} {-arrow none} } { - # - # Convenience function for line drawing, evaluates passed - # expressions. - # - ${:canvas} create line $x0 $y0 $x1 $y1 -width $width -arrow $arrow + # + # Convenience function for line drawing, evaluates passed + # expressions. + # + ${:canvas} create line $x0 $y0 $x1 $y1 -width $width -arrow $arrow } :method point {x:expr,convert y:expr,convert d {-number:switch false} -fill} { - # - # Draw a point (a position on the game board) and keep its - # basic data in instance variables. We could as well turn the - # positions into objects. - # - if {![info exists fill]} {set fill ${:fg}} + # + # Draw a point (a position on the game board) and keep its + # basic data in instance variables. We could as well turn the + # positions into objects. + # + if {![info exists fill]} {set fill ${:fg}} incr :pointCounter - set id [${:canvas} create oval \ - [expr {$x-$d/2.}] [expr {$y-$d/2.}] \ - [expr {$x+$d/2.}] [expr {$y+$d/2.}] \ - -fill $fill -tags [list point] -outline brown -width 2] - #${:canvas} create text $x $y -text ${:pointCounter} -fill grey - set :pointNr($id) ${:pointCounter} - set :pointCenter(${:pointCounter}) [list $x $y] - set :pointId(${:pointCounter}) $id - return ${:pointCounter} + set id [${:canvas} create oval \ + [expr {$x-$d/2.}] [expr {$y-$d/2.}] \ + [expr {$x+$d/2.}] [expr {$y+$d/2.}] \ + -fill $fill -tags [list point] -outline brown -width 2] + #${:canvas} create text $x $y -text ${:pointCounter} -fill grey + set :pointNr($id) ${:pointCounter} + set :pointCenter(${:pointCounter}) [list $x $y] + set :pointId(${:pointCounter}) $id + return ${:pointCounter} } :method fpoint {x:expr,convert y:expr,convert psize fsize color no} { - # - # Draw a point with a figure, note the position in the board - # in the figure - # - set nr [:point $x $y $psize -fill $color] - Figure new -board [self] -canvas ${:canvas} \ - -x $x -y [expr {$y-$fsize/2.0}] \ - -size $fsize -color $color -no $no -position $nr - return $nr + # + # Draw a point with a figure, note the position in the board + # in the figure + # + set nr [:point $x $y $psize -fill $color] + Figure new -board [self] -canvas ${:canvas} \ + -x $x -y [expr {$y-$fsize/2.0}] \ + -size $fsize -color $color -no $no -position $nr + return $nr } :method pnest {x:expr,convert y:expr,convert d colorNr xf yf} { - # - # Draw the nest with the figures in it - # - set fsize [expr {$d/0.75}] - set color [lindex ${:colors} $colorNr] - lappend :nest($colorNr) [:fpoint $x-$d $y-$d $d $fsize $color 0] - lappend :nest($colorNr) [:fpoint $x-$d $y+$d $d $fsize $color 1] - lappend :nest($colorNr) [:fpoint $x+$d $y-$d $d $fsize $color 2] - lappend :nest($colorNr) [:fpoint $x+$d $y+$d $d $fsize $color 3] - set :buttonPos($colorNr) [list [expr $x+($xf*$d)] [expr $y+($yf*$d)]] + # + # Draw the nest with the figures in it + # + set fsize [expr {$d/0.75}] + set color [lindex ${:colors} $colorNr] + lappend :nest($colorNr) [:fpoint $x-$d $y-$d $d $fsize $color 0] + lappend :nest($colorNr) [:fpoint $x-$d $y+$d $d $fsize $color 1] + lappend :nest($colorNr) [:fpoint $x+$d $y-$d $d $fsize $color 2] + lappend :nest($colorNr) [:fpoint $x+$d $y+$d $d $fsize $color 3] + set :buttonPos($colorNr) [list [expr $x+($xf*$d)] [expr $y+($yf*$d)]] } :method pline { x0:expr,convert y0:expr,convert x1:expr,convert y1:expr,convert d {-width 1} {-arrow none} } { - # - # Draw a path of the play-field with points (potential player - # positions) on it. - # - set id [${:canvas} create line $x0 $y0 $x1 $y1 \ - -width $width -arrow $arrow -fill brown] - if {$x0 eq $x1} { - # vertical - set f [expr {$y1<$y0 ? -1.25 : 1.25}] - for {set i 0} {$i < [expr {int(abs($y1-$y0)/($d*1.25))}]} {incr i} { - :point $x0 $y0+$i*$d*$f $d + # + # Draw a path of the play-field with points (potential player + # positions) on it. + # + set id [${:canvas} create line $x0 $y0 $x1 $y1 \ + -width $width -arrow $arrow -fill brown] + if {$x0 eq $x1} { + # vertical + set f [expr {$y1<$y0 ? -1.25 : 1.25}] + for {set i 0} {$i < int(abs($y1-$y0)/($d*1.25))} {incr i} { + :point $x0 $y0+$i*$d*$f $d } } else { - # horizontal - set f [expr {$x1<$x0 ? -1.25 : 1.25}] - for {set i 0} {$i < [expr {int(abs($x1-$x0)/($d*1.25))}]} {incr i} { - :point $x0+$i*$d*$f $y0 $d -number + # horizontal + set f [expr {$x1<$x0 ? -1.25 : 1.25}] + for {set i 0} {$i < int(abs($x1-$x0)/($d*1.25))} {incr i} { + :point $x0+$i*$d*$f $y0 $d -number } } - ${:canvas} lower $id + ${:canvas} lower $id } :method draw {m} { - # - # Draw board and create figures - # - set d ${:size} - set u [expr {$d * 1.25}] - # - # Major positions: p0 .. p1 ..m.. p2 .. p3 - # - set p0 [expr {$u-$d/2.0}] - set p1 [expr {$m-$u}] - set p2 [expr {$m+$u}] - set p3 [expr {2*$m-$u+$d/2}] + # + # Draw board and create figures + # + set d ${:size} + set u [expr {$d * 1.25}] + # + # Major positions: p0 .. p1 ..m.. p2 .. p3 + # + set p0 [expr {$u-$d/2.0}] + set p1 [expr {$m-$u}] + set p2 [expr {$m+$u}] + set p3 [expr {2*$m-$u+$d/2}] - :pline $p0 $p1 $p1 $p1 $d -width 4 - :pline $p1 $p1 $p1 $p0 $d -width 4 - :pline $p1 $p0 $p2 $p0 $d -width 4 ;# horizonal short line - :pline $p2 $p0 $p2 $p1 $d -width 4 - :pline $p2 $p1 $p3 $p1 $d -width 4 - :pline $p3 $p1 $p3 $p2 $d -width 4 ;# vertical short line - :pline $p3 $p2 $p2 $p2 $d -width 4 - :pline $p2 $p2 $p2 $p3 $d -width 4 - :pline $p2 $p3 $p1 $p3 $d -width 4 ;# horizonal short line - :pline $p1 $p3 $p1 $p2 $d -width 4 - :pline $p1 $p2 $p0 $p2 $d -width 4 - :pline $p0 $p2 $p0 $p1 $d -width 4 ;# vertical short line - :line $m+5*$d $m+2*$d $m+6*$d $m+2*$d -arrow first - :line $m-2*$d $m+5*$d $m-2*$d $m+6*$d -arrow first - :line $m-5*$d $m-2*$d $m-6*$d $m-2*$d -arrow first - :line $m+2*$d $m-5*$d $m+2*$d $m-6*$d -arrow first + :pline $p0 $p1 $p1 $p1 $d -width 4 + :pline $p1 $p1 $p1 $p0 $d -width 4 + :pline $p1 $p0 $p2 $p0 $d -width 4 ;# horizonal short line + :pline $p2 $p0 $p2 $p1 $d -width 4 + :pline $p2 $p1 $p3 $p1 $d -width 4 + :pline $p3 $p1 $p3 $p2 $d -width 4 ;# vertical short line + :pline $p3 $p2 $p2 $p2 $d -width 4 + :pline $p2 $p2 $p2 $p3 $d -width 4 + :pline $p2 $p3 $p1 $p3 $d -width 4 ;# horizonal short line + :pline $p1 $p3 $p1 $p2 $d -width 4 + :pline $p1 $p2 $p0 $p2 $d -width 4 + :pline $p0 $p2 $p0 $p1 $d -width 4 ;# vertical short line + :line $m+5*$d $m+2*$d $m+6*$d $m+2*$d -arrow first + :line $m-2*$d $m+5*$d $m-2*$d $m+6*$d -arrow first + :line $m-5*$d $m-2*$d $m-6*$d $m-2*$d -arrow first + :line $m+2*$d $m-5*$d $m+2*$d $m-6*$d -arrow first - set d2 [expr {$d*0.75}] - set d15 $d2*2 - set o [expr {$u*5}] - :pnest $m+$o-$d $m-$o+$d $d2 0 -1 3 - :pnest $m+$o-$d $m+$o-$d $d2 1 -1 -2.5 - :pnest $d15 $m+$o-$d $d2 2 1 -2.5 - :pnest $d15 $m-$o+$d $d2 3 1 3 - for {set i 0;set y [expr $d*2]} {$i<4} {incr i;set y [expr {$y+$d}]} { - lappend p(0) [:point $m $y $d2 -fill [lindex ${:colors} 0]] - lappend p(1) [:point $m*2-$y $m $d2 -fill [lindex ${:colors} 1]] - lappend p(2) [:point $m $m*2-$y $d2 -fill [lindex ${:colors} 2]] - lappend p(3) [:point $y $m $d2 -fill [lindex ${:colors} 3]] + set d2 [expr {$d*0.75}] + set d15 $d2*2 + set o [expr {$u*5}] + :pnest $m+$o-$d $m-$o+$d $d2 0 -1 3 + :pnest $m+$o-$d $m+$o-$d $d2 1 -1 -2.5 + :pnest $d15 $m+$o-$d $d2 2 1 -2.5 + :pnest $d15 $m-$o+$d $d2 3 1 3 + for {set i 0; set y [expr $d*2]} {$i<4} {incr i;set y [expr {$y+$d}]} { + lappend p(0) [:point $m $y $d2 -fill [lindex ${:colors} 0]] + lappend p(1) [:point $m*2-$y $m $d2 -fill [lindex ${:colors} 1]] + lappend p(2) [:point $m $m*2-$y $d2 -fill [lindex ${:colors} 2]] + lappend p(3) [:point $y $m $d2 -fill [lindex ${:colors} 3]] } - # - # Setup the path per player and color the starting points - # - for {set i 1} {$i < 41} {incr i} {lappend path $i} + # + # Setup the path per player and color the starting points + # + for {set i 1} {$i < 41} {incr i} {lappend path $i} foreach c {0 1 2 3} pos {11 21 31 1} o {11 21 31 1} { - ${:canvas} itemconfig [:getPointId $pos] -fill [lindex ${:colors} $c] - set :path($c) [concat [lrange $path $o-1 end] [lrange $path 0 $o-2] $p($c)] + ${:canvas} itemconfig [:getPointId $pos] -fill [lindex ${:colors} $c] + set :path($c) [concat [lrange $path $o-1 end] [lrange $path 0 $o-2] $p($c)] } } :public method msg {text} { - # - # Report a message to the user. - # - ${:canvas} itemconfig ${:msgId} -text $text + # + # Report a message to the user. + # + ${:canvas} itemconfig ${:msgId} -text $text return 0 } :public method wannaGo {obj pos {-path ""}} { - # - # We know that we can move the figure in principle. We have - # to check, whether the target position is free. If the target - # is occupied by our own player, we give up, otherwise we - # through the opponent out. - # - if {$pos eq ""} {return [:msg "beyond path"]} - set other [Figure lookup $pos] + # + # We know that we can move the figure in principle. We have + # to check, whether the target position is free. If the target + # is occupied by our own player, we give up, otherwise we + # through the opponent out. + # + if {$pos eq ""} {return [:msg "beyond path"]} + set other [Figure lookup $pos] set afterCmd "" - if {$other ne ""} { - if {[$obj cget -color] eq [$other cget -color]} { - # On player can't have two figure at the same place. + if {$other ne ""} { + if {[$obj cget -color] eq [$other cget -color]} { + # On player can't have two figure at the same place. return [:msg "My player is already at pos $pos"] } else { - # Opponent is at the target position. Find a free - # position in the opponents nest and though her out. - set opponent [$other cget -color] - foreach p [set :nest([lsearch ${:colors} $opponent])] { - if {[Figure lookup $p] eq ""} { - set afterCmd [list $other gotoNr $p] + # Opponent is at the target position. Find a free + # position in the opponents nest and though her out. + set opponent [$other cget -color] + foreach p [set :nest([lsearch ${:colors} $opponent])] { + if {[Figure lookup $p] eq ""} { + set afterCmd [list $other gotoNr $p] break } } } } :msg "[$obj cget -color]-[$obj cget -no] went to $pos" - $obj gotoNr $pos -path $path -afterCmd $afterCmd - ${:die} invalidate + $obj gotoNr $pos -path $path -afterCmd $afterCmd + ${:die} invalidate } :public method moveFigure {obj} { - # - # Move the provided figure by the diced eyes according to the - # rules. First we check, if we are allowed to move this - # figure, which might be in the nest or on the run. - # - set currentColor [lindex ${:colors} ${:player}] - if {[$obj cget -color] ne $currentColor} { + # + # Move the provided figure by the diced eyes according to the + # rules. First we check, if we are allowed to move this + # figure, which might be in the nest or on the run. + # + set currentColor [lindex ${:colors} ${:player}] + if {[$obj cget -color] ne $currentColor} { return [:msg "figure is not from the current player"] } - set eyes [${:die} cget -eyes] - if {$eyes == 0} { + set eyes [${:die} cget -eyes] + if {$eyes == 0} { return [:msg "Must dice first"] } - set position [$obj cget -position] - if {$position in [set :nest(${:player})]} { - # Figure is in the nest, just accept eyes == 6 - if {$eyes == 6} { - :wannaGo $obj [lindex [set :path(${:player})] 0] + set position [$obj cget -position] + if {$position in [set :nest(${:player})]} { + # Figure is in the nest, just accept eyes == 6 + if {$eyes == 6} { + :wannaGo $obj [lindex [set :path(${:player})] 0] } else { return [:msg "Need 6 to move this figure"] } } else { - # - # Check, if we have still figures in the nest - # + # + # Check, if we have still figures in the nest + # set inNest "" - foreach p [set :nest(${:player})] { - set inNest [Figure lookup $p] - if {$inNest ne ""} break + foreach p [set :nest(${:player})] { + set inNest [Figure lookup $p] + if {$inNest ne ""} break } - # - # Check, if the actual figure is at the start position. - # - set startPos [lindex [set :path(${:player})] 0] - set atStart [Figure lookup $startPos] - if {$eyes == 6} { - if {$inNest ne ""} { - # Move a figure out from the nest, if we can - if {$atStart ne ""} { - if {[$atStart cget -color] eq $currentColor} { - set path [set :path(${:player})] - set current [lsearch $path $position] - set targetPos [expr {$current + [${:die} cget -eyes]}] - :wannaGo $obj [lindex $path $targetPos] \ - -path [lrange $path $current+1 $targetPos] + # + # Check, if the actual figure is at the start position. + # + set startPos [lindex [set :path(${:player})] 0] + set atStart [Figure lookup $startPos] + if {$eyes == 6} { + if {$inNest ne ""} { + # Move a figure out from the nest, if we can + if {$atStart ne ""} { + if {[$atStart cget -color] eq $currentColor} { + set path [set :path(${:player})] + set current [lsearch $path $position] + set targetPos [expr {$current + [${:die} cget -eyes]}] + :wannaGo $obj [lindex $path $targetPos] \ + -path [lrange $path $current+1 $targetPos] return 1 } } return [:msg "You have to move the figures from your nest first"] } } - if {$atStart ne "" && $inNest ne "" && $obj ne $atStart} { + if {$atStart ne "" && $inNest ne "" && $obj ne $atStart} { return [:msg "You have to move the figures from the start first"] } - set path [set :path(${:player})] - set current [lsearch $path $position] - set targetPos [expr {$current + [${:die} cget -eyes]}] - :wannaGo $obj [lindex $path $targetPos] \ - -path [lrange $path $current+1 $targetPos] + set path [set :path(${:player})] + set current [lsearch $path $position] + set targetPos [expr {$current + [${:die} cget -eyes]}] + :wannaGo $obj [lindex $path $targetPos] \ + -path [lrange $path $current+1 $targetPos] } return 1 } :public method nextPlayer {} { - # - # Switch to the next player. - # - set :player [expr {(${:player}+1) % 4}] - ${:canvas} coords ${:buttonWindow} {*}[set :buttonPos(${:player})] + # + # Switch to the next player. + # + set :player [expr {(${:player}+1) % 4}] + ${:canvas} coords ${:buttonWindow} {*}[set :buttonPos(${:player})] } :method init {} { - set hw [expr {14 * ${:size}}] - set center [expr {$hw / 2}] - canvas ${:canvas} -bg ${:bg} -height $hw -width $hw - :draw $center - set :die [Die new -canvas ${:canvas} -x $center -y $center -size ${:size}] - set :msgId [${:canvas} create text [expr {${:size}*4}] 10 -text ""] - # - # Player management (signal which player is next, etc.) - # + set hw [expr {14 * ${:size}}] + set center [expr {$hw / 2}] + canvas ${:canvas} -bg ${:bg} -height $hw -width $hw + :draw $center + set :die [Die new -canvas ${:canvas} -x $center -y $center -size ${:size}] + set :msgId [${:canvas} create text [expr {${:size}*4}] 10 -text ""] + # + # Player management (signal which player is next, etc.) + # set :player 2 button .b1 -text "Done" -command [:callback nextPlayer] set :buttonWindow [.p create window 22 14 -window .b1] @@ -1382,7 +1384,7 @@