-
-
-
-
-
-
-
-
-A small Ludo/Mensch ärgere Dich nicht/Pachisie game, originally -developed by Richard Suchenwirth in plain Tcl (see -http://wiki.tcl.tk/956). The game was rewritten as a design study in -NX by Gustaf Neumann in July 2013.
Major changes:
-
-
-
-
-object-oriented design (no global variables) -
-
- -
-
-knowledge about the paths of the figures -
-
- -
-
-animated moves -
-
- -
-
-knowledge about the basic rules (e.g. need 6 to move out of the - nest, have to move figures from starting position) -
-
- -
-
-throw opponents out -
-
- -
-
-sanity checks -
-
- -
-
-user feedback -
-
-
-
-
-
-
-
-Short Instructions
-
-
-
-
-The active player (marked with the button) has to dice (click on - the die, or press somewhere on the board "d"). -
-
- -
-
-If all figures are in the nest (start position), the player needs - to dice a 6. The player is allowed to try three times, then the - player is done (press "done" button, or type "n") and the turn - moves to the next player. -
-
- -
-
-When a player got 6 eyes, he can move out of the nest. This is - done by clicking on the figure the player wants to move. -
-
- -
-
-After dicing 6, the player can dice again and move the player on - the field (always by clicking on the figure). -
-
-
-
-Implementation
-
-
-
-
-
-
-
-
-
-
-
-
package require Tk -package require nx::trait
Define an application specific converter "expr" that passes the -scalar result of the expression. Since the converter is defined on -nx::Slot, it is applicable to all method and configure arguments.
-
-
-
::nx::Slot method type=expr {name value} {return [expr $value]}
Class Figure
-
-
-
nx::Class create Figure { - :property canvas:required - :property x:double - :property y:double - :property size:double - :property position:integer - :property color - :property no:integer - :property board:object,required - :variable tag "" - - :require trait nx::traits::callback - - :method init {} { - # - # Draw figure and define interactions - # - set d [expr {${:size}/6.}] - set s [expr {${:size}/1.5}] - set y [expr {${:y}-$d*2.5}] - set :tag ${:color}${:no} - set id [${:canvas} create arc [expr {${:x}-$s}] [expr {${:y}-$s}] \ - [expr {${:x}+$s}] [expr {${:y}+$s}] -outline grey \ - -start 250 -extent 40 -fill ${:color} \ - -tags [list mv ${:tag}]] - ${:canvas} create oval \ - [expr {${:x}-$d}] [expr {${:y}-$d}] \ - [expr {${:x}+$d}] [expr {${:y}+$d}] \ - -fill ${:color} -outline grey -tags [list mv ${:tag}] - #${:board} figure set $id [self] - ${:canvas} bind ${:tag} <B1-ButtonRelease> [:callback go] - } - - :public method go {} { - # - # Start moving the figure if the draw is permitted. - # The board knows the die and the rules. - # - if {![${:board} moveFigure [self]]} { - # stay at old position - :gotoNr ${:position} - } - } - - :public method gotoNr {nr {-path ""} {-afterCmd ""}} { - # - # Move figure to the numbered position. If a path is given it - # moves stepwise from position to position. - # - set oldPos ${:position} - set :position $nr - if {$path eq ""} {set path $nr} - return [:move {*}[${:board} getPointCenter $oldPos] $path \ - -afterCmd $afterCmd] - } - - :protected method move {x0 y0 path:integer,1..n {-afterCmd ""}} { - # - # Move figure from old position (x0 y0) stepwise along the - # path using animation. At the end of the move, 'afterCmd' is - # issued. - # - set t 0 - foreach pos $path { - lassign [${:board} getPointCenter $pos] x y - set stepx [expr {($x-$x0)/50.0}] - set stepy [expr {($y-$y0)/50.0}] - for {set i 0} {$i < 50} {incr i} { - after [incr t 8] ${:canvas} move ${:tag} $stepx $stepy - } - lassign [list $x $y] x0 y0 - incr t 100 - } - after $t ${:canvas} raise ${:tag} - after $t $afterCmd - set :x $x; set :y $y - } - - :public object method lookup {position} { - # - # Return the figure at the provided position. This function - # could be made faster, but is efficient enough as it is. - # - foreach f [Figure info instances] { - if {[$f cget -position] == $position} { - return $f - } - } - return "" - } -}
Helper functions for the die
-
-
-
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 - set res [list] - foreach i $L {lappend res [eval expr $term]} - set res -}
Class Die
-
-
-
nx::Class create Die { - :property canvas:required - :property x:double - :property y:double - :property {size:double 25} - :property {fg gold} - :property {bg red} - :property {eyes 0} - - :require trait nx::traits::callback - - :method set {n} { - # - # 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} - } - set :eyes $n - } - - :public method invalidate {} { - # - # 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} { - :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 - update - 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] - 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] - bind . <d> [:callback roll] - } -}
Class Board
-
-
-
nx::Class create Board { - :property canvas:required - :property {size:integer 25} - :property {bg LightBlue1} - :property {fg white} - :property {colors:1..n {red green yellow blue}} - - :require trait nx::traits::callback - - :method lookup {var idx} { - # - # Convenience lookup function for arbitrary instance - # variables. - # - set key "${var}($idx)" - if {[info exists $key]} {return [set $key]} - return "" - } - - :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 - } - - :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}} - 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} - } - - :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 - } - - :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)]] - } - - :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 < 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 < int(abs($x1-$x0)/($d*1.25))} {incr i} { - :point $x0+$i*$d*$f $y0 $d -number - } - } - ${: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}] - - :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]] - } - # - # 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)] - } - } - - :public method msg {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] - set afterCmd "" - 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] - break - } - } - } - } - :msg "[$obj cget -color]-[$obj cget -no] went to $pos" - $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} { - return [:msg "figure is not from the current player"] - } - 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] - } else { - return [:msg "Need 6 to move this figure"] - } - } else { - # - # 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 - } - # - # 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} { - 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] - } - return 1 - } - - :public method nextPlayer {} { - # - # 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 :player 2 - button .b1 -text "Done" -command [:callback nextPlayer] - set :buttonWindow [.p create window 22 14 -window .b1] - :nextPlayer - bind . <n> [:callback nextPlayer] - } -}
Finally, create the board and pack it
-
-
-
Board new -canvas .p -bg beige -size 40
-pack .p