# Listing of doc/example-scripts/tk-ludo.tcl

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::trait::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::trait::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::trait::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 ;# horizontal 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 ;# horizontal 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