package require Tk
 proc main {{tilesize 20}} {
    set bg green4
    set width [expr {$tilesize*17}]
    pack [canvas .c -bg $bg -height $width -width $width]
    foreach {row col color} [specials] {
        set x0 [expr {$col*$tilesize}]
        set y0 [expr {$row*$tilesize}]
        .c create rect $x0 $y0 [incr x0 $tilesize] [incr y0 $tilesize] \
            -fill $color -outline $bg
    } ;#-- Draw grid
    set x0 $tilesize
    set x1 [expr {$width-$tilesize}]
    set y0 $tilesize
    set y1 [expr {$width-$tilesize}]
    for {set x $x0} {$x<$width} {incr x $tilesize} {
        .c create line $x $y0 $x $y1 -fill yellow -width 2
    }
    for {set y $y0} {$y<$width} {incr y $tilesize} {
        .c create line $x0 $y $x1 $y -fill yellow -width 2
    }
    button .c.b -text Reset -command [list reset .c $tilesize] -bg $bg
    .c create window $width 2 -window .c.b -anchor ne
    reset .c $tilesize
 }
 proc reset {w tilesize} {
    $w delete mv
    #-- Make a list of all tiles
    set ts {}
    foreach {letter value number} [tilelist] {
        for {set i 0} {$i<$number} {incr i} {
            lappend ts [list $letter $value]
        }
    }
    #-- Create tiles in random order
    while {[llength $ts]} {
        foreach {letter value} [ldraw ts] break        
        tile $w $letter $value $tilesize
    }
    #---------------------- bindings for moving tiles
    $w bind mv <1> {
        set X %X; set Y %Y
        set id [lindex [%W gettags current] 0]
        %W raise $id
    }
    $w bind mv <B1-Motion> {
        %W move $id [expr %X-$X] [expr %Y-$Y]
        set X %X; set Y %Y
    }
    $w bind mv <ButtonRelease-1> {
        foreach {x0 y0 x1 y1} [%W bbox $id] break
        set sz [expr {$x1-$x0}]
        set s2 [expr {$sz/2}]
        if {$x0>=$sz && $y0>=$sz} {
            %W move $id [expr $s2-(($x0+$s2)%%$sz)] \
                [expr $s2-(($y0-$s2)%%$sz)]
        }
    }
 }
 
 #-- Positions and colors of special fields 
 proc specials {} {
    string map {lbl lightblue} {
        1 1 red   1 4 lbl   1 8 red    1 12 lbl  1 15 red
        2 2 pink  2 6 blue  2 10 blue  2 14 pink
        3 3 pink  3 7 lbl   3 9 lbl    3 13 pink
        4 1 lbl   4 4 pink  4 8 lbl    4 12 pink 4 15 lbl
        5 5 pink  5 11 pink
        6 2 blue  6 6 blue  6 10 blue  6 14 blue
        7 3 lbl   7 7 lbl   7 9 lbl    7 13 lbl
        8 1 red   8 4 lbl   8 8 pink   8 12 lbl  8 15 red
        9 3 lbl   9 7 lbl   9 9 lbl    9 13 lbl
        10 2 blue 10 6 blue 10 10 blue 10 14 blue
        11 5 pink 11 11 pink
        12 1 lbl  12 4 pink 12 8 lbl   12 12 pink 12 15 lbl
        13 3 pink 13 7 lbl  13 9 lbl   13 13 pink
        14 2 pink 14 6 blue 14 10 blue 14 14 pink
        15 1 red  15 4 lbl  15 8 red   15 12 lbl  15 15 red
    }
 }
 #-- "Constructor" for a tile
 proc tile {w letter value tilesize} {
    set id    [$w create rect 2 2 $tilesize $tilesize -fill beige]
    set tags  [list t$id mv]
    $w itemconfigure $id -tag $tags
    set font1 [list Helvetica [expr $tilesize/2]]
    set pos   [expr $tilesize/2]
    $w create text $pos $pos -text $letter -font $font1 -tag $tags
    set font2 [list Helvetica [expr $tilesize/4]]
    set pos   [expr $tilesize*5/6]
    $w create text $pos $pos -text $value -font $font2 -tag $tags
 }
 #-- Tiles distribution (Germany): letter - value - occurrence
 proc tilelist {} {
    return {
        A 1 5  Ą 6 1  B 3 2  D 1 4  E 1 15  F 4 2  G 2 3  H 2 4 
        I 1 6  J 6 1  K 4 2  L 2 3  M 3 4   N 1 9  O 2 3  \ud6 8 1
        P 4 1  Q 10 1 R 1 6  S 1 7  T 1 6   U 1 6 \udc 1 6 V 6 1 
        W 3 1  X 8 1  Y 10 1 Z 3 1  * "" 2
    }
 }
 proc ldraw listName {
    upvar 1 $listName list
    set pos [expr {int(rand()*[llength $list])}]
    K [lindex $list $pos] [set list [lreplace $list $pos $pos]]
 }
 proc K {a b} {set a}

 main
 bind . <Escape> {exec wish $argv0 &; exit} ;# dev helper