[Richard Suchenwirth] 2003-10-05 - This game is famous under the
trademark Scrabble - here's a simple Tcl approximation which gives you
the board and the randomly drawn letter tiles. The rest you have to do
yourself, like judge whether a word is valid, and even compute the
scores. Tiles are "stacked" at top left corner, and can be drawn from there
to any place on the margin, and to board positions.

[WikiDbImage scrabble.jpg]

======
 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
======
----

Alastair Davies (21 October 2005) - I've taken the liberty of developing this code to deal seven tiles to each of up to four players, check turns are legal, score words etc etc.  (Beyond this, my unfinished interest is in exploring the possibility of playing against the computer.  At the moment, although the computer plays the first few turns satisfactorily, as the board becomes crowded it cannot find enough places to move.)  

Alastair Davies (22 November 2005) - A month later, I've finished this to a standard where it usually beats me.  It uses the 2of12inf.txt word list from the 12-dicts project [http://wordlist.sourceforge.net/12dicts-readme.html].  I've wrapped this in a Tcl procedure, so it is included in the source code, which I've submitted to the [Starkit Distribution Archive].  It's also available as an Windows executable from my website [http://aldavies.net/games/].  I've called it CrossWaysWords to avoid confusion with trademarks.

----
[Jeff Smith] 2020-08-17 : Below is an online demo using [CloudTk]. This demo runs CrossWaysWords in an Alpine Linux Docker Container. It is a 29.3MB image which is made up of Alpine Linux + tclkit + Mr-Eastons-Maths-Game.kit + libx11 + libxft + fontconfig + ttf-linux-libertine. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories. 

<<inlinehtml>>

<iframe height="650" width="650" src="https://cloudtk.tcl-lang.org/cloudtk/VNC?session=new&Tk=A-crossword-game" allowfullscreen></iframe>

<<inlinehtml>>

<<categories>> Games | Arts and crafts of Tcl-Tk programming