Nonogram

Keith Vetter 2008-07-28 : While reading Reddit yesterday, I came across a logic puzzle called Nonogram that I'd never seen before.

What is a nonogram anyway? Quoting Wikipedia[1 ]:

Nonograms are picture logic puzzles in which cells in a grid have to be colored or left blank according to numbers given at the side of the grid to reveal a hidden picture. In this puzzle type, the numbers measure how many unbroken lines of filled-in squares there are in any given row or column. For example, a clue of "4 8 3" would mean there are sets of four, eight, and three filled squares, in that order, with at least one blank square between successive groups.

Here's a little program I wrote to help me learn how to solve these puzzles. Right now it doesn't have many features but I'll be adding to it (if these puzzle capture my interest). Others are more than welcome to extend it.

It has 12 canned puzzles to choose from, ranging from trivial to easy.


KPV 2008-08-02 : Here's an update of the nonogram program. I included over 30 more built in puzzles, a way to load arbitrary puzzles and a solver.

I had a lot of fun solving 10x10 puzzles, but for larger puzzles I got stuck. I don't know how humans can figure out that 7 3 3 3 on a 20 wide board has some fixed positions.

So I wrote a routine that will solve any row or column. The algorithm it uses is to enumerate all legal moves for a set of pips and a given strip, then loop through all cells looking for ones which are either on or off in every legal move. Those cells must therefore be on or off.

It turns out AK had similar ideas and he sent me his version of the solver.

The GUI lets you invoke this solve algorithm in three ways: clicking on an arrow next to a row or column will try to solve it. One Pass on the hint menu runs the algorithm once on each row and column. Solve runs the One Pass routine repeatedly until the puzzle is solved or no progress is made.

Note, some puzzles are not solvable by this technique--they require what they call advanced reasoning or searching for contradictions; more charitably you could call it backtracking; I call it guessing. The soccer puzzle in this program requires such techniques.


KPV 2008-08-05 : Third iteration of this program and I finally got it to where I like playing it--in fact I've found I've wasted a too much time playing it.

For me, 10x10 is the most fun size to play: 5x5 is trivial and 15x15 is just too hard.

I've added code to create new puzzles of various size. It simple fills in a board with random positions at about 60% density. A few of these random puzzles are not solvable, but most are.


##+##########################################################################
#
# Nonogram -- plays several different stored nonogram puzzles
# by Keith Vetter, July 2008
#
# http://www.comp.lancs.ac.uk/~ss/nonogram/
# http://www.puzzle-nonograms.com/
# http://activityworkshop.net/puzzlesgames/nonograms/puzzle1.html
# http://www.nonogrid.com/download.php
# http://twan.home.fmf.nl/blog/haskell/Nonograms.details
#

# Todo:
#  turn into full solver
#  read from file
#  titles for puzzle
#

package require Tk
package require tile

array set S {title "Tk Nonogram"
    sz .25i
    sz2 .2i
    state go
    delay 100
    delay2 200
}
array set COLORS {-1 red 0 white 1 green}
catch {font delete lblFont}
font create lblFont -family "Times Roman" -size 8 -weight bold

##+##########################################################################
#
# DoDisplay -- Makes our display
#
proc DoDisplay {} {
    global S

    wm title . $S(title)
    DoMenus
    label .title -font {Helvetica 24 bold} -justify c -textvariable ::B(title)
    frame .buttons -bd 2 -relief ridge
    frame .buttons2 -bd 0
    label .msg -textvariable ::S(msg)

    pack .title -side top -fill x
    pack .buttons -side bottom -fill x
    pack .buttons2 -side bottom -fill x -padx .2i -pady {0 .2i}
    pack .msg -in .buttons2 -side bottom

    ::ttk::button .buttons.new -text "New" -command NewGame
    ::ttk::button .buttons.restart -text Restart -command Restart
    set values [GetTitles]
    ::ttk::combobox .buttons.cb -values $values -textvariable ::S(puzzle) \
        -state readonly -exportselection 0 -justify center -height 12
    eval pack [winfo child .buttons] -side left -expand 1 -pady .1i

    foreach tr [trace vinfo ::S(puzzle)] {
        eval trace vdelete ::S(puzzle) $tr
    }
    trace variable ::S(puzzle) w PickPuzzle
    #set ::S(puzzle) [lindex $values [expr {int(rand()*([llength $values]-10))}]]
    update
    bind all <Control-Key-z> Undo
    bind all <Control-Key-o> ReadFile
    bind all <Control-Key-h> OneHint
    bind all <Control-Key-a> OnePass
    bind all <Control-Key-s> SolveIt
    bind all <Key-Escape> FillSpaces
    bind all <Key-n> NewGame
    bind all <F2> {console show}
}
##+##########################################################################
#
# DoMenus -- isn't installing menus really verbose and clunky?
#
proc DoMenus {} {
    option add *Menu.tearOff 0

    . config -menu [menu .menu]

    menu .menu.game
    .menu add cascade -label "Game" -underline 0 -menu .menu.game
    .menu.game add command -label "Restart" -command Restart -underline 0
    .menu.game add command -label "Undo" -command Undo -underline 0 \
        -accelerator "Ctrl+Z"
    .menu.game add separator
    .menu.game add command -label "Open..." -command ReadFile -underline 0 \
        -accelerator "Ctrl+O"
    .menu.game add separator
    .menu.game add command -label "Exit" -underline 1 -command exit

    menu .menu.cheat
    .menu add cascade -label "Hint" -underline 0 -menu .menu.cheat
    .menu.cheat add command -label "Hint" -command OneHint -underline 0 \
        -accelerator "Ctrl+H"
    .menu.cheat add command -label "One Pass" -command OnePass -underline 0 \
        -accelerator "Ctrl+A"
    .menu.cheat add command -label "Solve" -command SolveIt -underline 0 \
        -accelerator "Ctrl+S"

    menu .menu.help
    .menu add cascade -label "Help" -underline 0 -menu .menu.help
    .menu.help add command -label "About" -underline 0 -command About
}
##+##########################################################################
#
# PickPuzzle -- Changes current puzzle
#
proc PickPuzzle {var1 var2 op} {
    set n [scan $::S(puzzle) "Random %dx%d" width height]
    if {$n == 2} {
        Random $width $height
        return
    }
    set n [lsearch $::S(titles) $::S(puzzle)]
    if {$n != -1} {
        CreateBoard [expr {$n - 5}]
    }
}
##+##########################################################################
#
# NewGame -- Starts a new game. If we're doing a random puzzle,
# pick another random puzzle, otherwise pick a random stored
# puzzle.
#
proc NewGame {} {
    global S

    set n [scan $::S(puzzle) "Random %dx%d" width height]
    if {$n == 2} {
        Random $width $height
        return
    }
    set names [array names P]
    set who [lindex $names [expr {int(rand()*[llength $names])}]]
    CreateBoard $who
}
##+##########################################################################
#
# CreateBoard -- Creates the actual game board
#
proc CreateBoard {{n ""}} {
    global S B

    if {$n ne ""} { ReadBoard $n }
    destroy .b
    frame .b -bd 2 -relief solid -pady .125i -padx .125i
    pack .b -side top -expand 1 -padx .2i

    set colSpan [expr {$B(width) + 1 + $B(width)/5}]
    set rowSpan [expr {$B(height) + 1 + $B(height)/5}]

    # Draw the top 2 header rows
    set gCol 1
    for {set col 0} {$col < $B(width)} {incr col} {
        incr gCol
        if {$col > 0 && ($col % 5) == 0} {
            frame .b.xx$gCol -bd 2 -relief solid -bg black
            grid .b.xx$gCol -row 1 -column $gCol -rowspan $rowSpan -sticky ns
            incr gCol
        }

        set w .b.a_,$col
        button $w -image ::bmp::darrow -bd 0 -command [list SolveCol $col]
        grid $w -row 0 -column $gCol -sticky ew

        set w .b.h_,$col
        set txt [lindex $B(columns) $col]
        set txt [join [split $txt] \n]
        label $w -text $txt -anchor s -relief solid -bd 1 -padx 3 -bg white \
            -font lblFont
        bind $w <3> [list SolveCol $col]
        grid $w -row 1 -column $gCol -sticky news
        grid columnconfigure .b $gCol -minsize $S(sz)
    }
    grid columnconfigure .b 1 -minsize $S(sz)

    # Draw the left 2 header columns
    set gRow 1
    for {set row 0} {$row < $B(height)} {incr row} {
        incr gRow
        if {$row > 0 && ($row % 5) == 0} {
            frame .b.rr$gRow -bd 2 -relief solid -bg black
            grid .b.rr$gRow -row $gRow -column 1 -columnspan $colSpan -sticky ew
            incr gRow
        }

        set w .b.a$row,_
        button $w -image ::bmp::rarrow -bd 0 -command [list SolveRow $row]
        grid $w -row $gRow -column 0 -sticky ns


        set w .b.h$row,_
        set txt [lindex $B(rows) $row]
        label $w -text " $txt" -anchor e -bd 1 -relief solid -bg white \
            -font lblFont
        bind $w <3> [list SolveRow $row]
        grid $w -row $gRow -column 1 -sticky news
        grid rowconfigure .b $gRow -minsize $S(sz)
    }
    grid columnconfigure .b 0 -minsize $S(sz2)

    # Draw the actual cells
    set gRow 1
    for {set row 0} {$row < $B(height)} {incr row} {
        incr gRow
        if {$row > 0 && ($row % 5) == 0} {
            incr gRow
        }
        set gCol 1
        for {set col 0} {$col < $B(width)} {incr col} {
            incr gCol
            if {$col > 0 && ($col % 5) == 0} {
                incr gCol
            }
            set w .b.c$gRow,$gCol
            canvas $w -bd 1 -relief solid -highlightthickness 0 \
                -width 0 -height 0 -bg white
            bind $w <Button-1> [list LeftClick $row $col]
            bind $w <Button-2> [list MiddleClick $row $col]
            bind $w <Button-3> [list RightClick $row $col]
            bind $w <Enter> [list DoTooltip $row $col]
            grid $w -row $gRow -column $gCol -sticky news
            set B(b,$row,$col) 0
            set B(w,$row,$col) $w
        }
    }

    set S(state) go
    set B(undo) {}
}
##+##########################################################################
#
# LeftClick -- Handles mouse left click
#
proc LeftClick {row col} {
    global B
    if {$::S(state) ne "go"} return

    lappend B(undo) [list $row $col $B(b,$row,$col)]
    set B(b,$row,$col) [expr {$B(b,$row,$col) > 0 ? 0 : 1}]
    DrawCell $row $col
    IsSolved
    DoTooltip $row $col
}
##+##########################################################################
#
# RightClick -- Handles mouse right click
#
proc RightClick {row col} {
    global B
    if {$::S(state) ne "go"} return

    lappend B(undo) [list $row $col $B(b,$row,$col)]
    set B(b,$row,$col) [expr {$B(b,$row,$col) < 0 ? 0 : -1}]
    DrawCell $row $col
    IsSolved
    DoTooltip $row $col
}
##+##########################################################################
#
# MiddleClick -- Handles mouse middle click -- clear entry
#
proc MiddleClick {row col} {
    global B
    if {$::S(state) ne "go"} return

    if {$B(b,$row,$col) != 0} {
        lappend B(undo) [list $row $col $B(b,$row,$col)]
    }

    set B(b,$row,$col) 0
    DrawCell $row $col
    IsSolved
    DoTooltip $row $col
}
##+##########################################################################
#
# Undo -- Undo last moves
#
proc Undo {} {
    global B

    if {$B(undo) eq ""} return
    if {$::S(state) ne "go"} return

    set move [lindex $B(undo) end]
    set B(undo) [lrange $B(undo) 0 end-1]

    foreach {row col val} $move break
    set B(b,$row,$col) $val

    DrawCell $row $col
    IsSolved
}
##+##########################################################################
#
# DrawCell -- Draws one cell on/off/empty
#
proc DrawCell {row col} {
    global B

    set w $B(w,$row,$col)
    set cw [winfo width $w]
    set ch [winfo height $w]
    set x0 3
    set y0 3
    set x1 [expr {$cw - $x0 - 1}]
    set y1 [expr {$ch - $y0 - 1}]

    $w delete all
    if {$B(b,$row,$col) > 0} {
        set x0 3
        set y0 3
        set x1 [expr {$cw - $x0 - 1}]
        set y1 [expr {$ch - $y0 - 1}]
        $w create rect $x0 $y0 $x1 $y1 -fill black
    } elseif {$B(b,$row,$col) < 0} {
        set x0 8
        set y0 8
        set x1 [expr {$cw - $x0 - 1}]
        set y1 [expr {$ch - $y0 - 1}]
        $w create line $x0 $y0 $x1 $y1 -width 2 -fill red
        $w create line $x0 $y1 $x1 $y0 -width 2 -fill red
    }
}
##+##########################################################################
#
# IsSolved -- Checks if puzzle is solved. Also highlights
# solved rows
#
proc IsSolved {{autoFill 0}} {
    global B S

    set solved 1
    for {set row 0} {$row < $B(height)} {incr row} {
        set n [Validate row $row]
        if {$n != 1} { set solved 0 }
        if {$n == 1 && $autoFill} {
            AutoFill row $row
        }
    }
    for {set col 0} {$col < $B(width)} {incr col} {
        set n [Validate column $col]
        if {$n != 1} { set solved 0 }
        if {$n == 1 && $autoFill} {
            AutoFill col $col
        }
    }
    if {$solved} {
        set S(state) solved
        foreach w [info commands .b.c*] {
            $w config -bg yellow
        }
    }
}
##+##########################################################################
#
# Validate -- Checks && highlights if a given row/column is done
#
proc Validate {what who} {
    set valid [IsValid $what $who]

    if {$what eq "row"} {
        set w .b.h$who,_
    } else {
        set w .b.h_,$who
    }
    $w config -bg $::COLORS($valid)
    return $valid
}
##+##########################################################################
#
# IsValid -- Checks if a row/column is done
#  1 if done; -1 if bad; 0 otherwise
#
proc IsValid {what who} {
    global B

    set a {}
    if {$what eq "row"} {
        for {set col 0} {$col < $B(width)} {incr col} {
            lappend a [expr {$B(b,$who,$col) > 0}]
        }
        set toMatch [lindex $B(rows) $who]
    } else {
        for {set row 0} {$row < $B(height)} {incr row} {
            lappend a [expr {$B(b,$row,$who) > 0}]
        }
        set toMatch [lindex $B(columns) $who]
    }
    set cnt1 [expr [join $a +]]
    set cnt2 [expr [join $toMatch +]]
    if {$cnt1 < $cnt2} { return 0 }
    if {$cnt1 > $cnt2} { return -1 }

    set b {}
    set last 0
    set cnt 0
    foreach item $a {
        if {$item == 1} {
            incr cnt
        } elseif {$last == 1} {
            lappend b $cnt
            set cnt 0
        }
        set last $item
    }
    if {$cnt > 0 || $b eq {}} {
        lappend b $cnt
    }
    if {$b eq $toMatch} { return 1}
    return 0
}
##+##########################################################################
#
# Restart -- Can you guess?
#
proc Restart {} {
    global B
    for {set row 0} {$row < $B(height)} {incr row} {
        for {set col 0} {$col < $B(width)} {incr col} {
            set B(b,$row,$col) 0
            DrawCell $row $col
            $B(w,$row,$col) config -bg white
        }
    }
    set ::S(state) go
    IsSolved
}
##+##########################################################################
#
#FillSpaces -- Puts in all empty spaces on valid lines
#
proc FillSpaces {} {
    global B

    for {set row 0} {$row < $B(height)} {incr row} {
        if {[IsValid row $row] == 1} {
            for {set col 0} {$col < $B(width)} {incr col} {
                if {$B(b,$row,$col) == 0} {
                    RightClick $row $col
                }
            }
        }
    }
    for {set col 0} {$col < $B(width)} {incr col} {
        if {[IsValid col $col] == 1} {
            for {set row 0} {$row < $B(height)} {incr row} {
                if {$B(b,$row,$col) == 0} {
                    RightClick $row $col
                }
            }
        }
    }

}
##+##########################################################################
#
# ReadBoard -- Stub for now, later we can read a file
#
proc ReadBoard {n} {
    unset -nocomplain ::B
    array set ::B $::P($n)
}
##+##########################################################################
#
# ReadFile -- Read and load a nonogram file
#
proc ReadFile {{fname ""}} {
    if {$fname eq ""} {
        set types {{{Nonogram Files} {.non}} {{All Files} *}}
        set fname [tk_getOpenFile -defaultextension [lindex $types 0 1] \
                       -title "Nonogram Open File" -filetypes $types]
        if {$fname eq ""} return
    }
    set arr [_ReadFile $fname]
    unset -nocomplain ::B
    array set ::B $arr
    set ::S(puzzle) ""
    CreateBoard
}
##+##########################################################################
#
# _ReadFile -- Reads and parses a nonogram file
# format: http://www.comp.lancs.ac.uk/~ss/nonogram/fmt2
#
proc _ReadFile {fname} {
    set fin [open $fname r]
    set lines [split [read $fin] \n]; list
    close $fin

    unset -nocomplain BB
    set BB(width) -1
    set BB(height) -1
    set BB(rows) {}
    set BB(columns) {}
    set BB(title) [file rootname [file tail $fname]]

    set state normal
    foreach line $lines {
        set line [string trim $line]
        if {$line eq ""} {
            set state normal
            continue
        }
        if {$state eq "normal"} {
            if {$line eq "rows"} {
                set state rows
            } elseif {$line eq "columns"} {
                set state columns
            } else {
                regexp {^(.*?)\s+(.*?)\s*$} "$line " => name value
                set BB($name) [string trim $value {""}]
            }
        } else {
            lappend BB($state) [split $line ","]
        }
    }
    if {[llength $BB(rows)] != $BB(height)} {
        error "row data is wrong: got [llength $BB(rows)], wanted $BB(height)"
    }
    if {[llength $BB(columns)] != $BB(width)} {
        error "column data is wrong: got [llength $BB(columns)], wanted $BB(width)"
    }
    return [array get BB]
}
##+##########################################################################
#
# UnRead -- Turns board into our internal dictionary format. Used so
# that we can open a nonogram file, call this routine and embed the
# puzzle into the program.
#
proc UnRead {} {
    global B

    set result "set P(\[incr idx]) \{ "
    append result "width $B(width) height $B(height)\n"
    if {[info exists B(title)] && $B(title) ne ""} {
        append result "    title $B(title)\n"
    }
    append result "    rows \{" $B(rows) "\}\n"
    append result "    columns \{" $B(columns) "\}\n"
    append result "\}\n"
    clipboard clear
    clipboard append $result

    return $result
}

##+##########################################################################
#
# AutoFill -- Fills in blanks w/ X's on complete rows
#
proc AutoFill {what who} {
    global B

    if {$what eq "row"} {
        set row $who
        for {set col 0} {$col < $B(width)} {incr col} {
            if {$B(b,$row,$col) == 0} {
                set B(b,$row,$col) -1
                DrawCell $row $col
            }
        }
    } else {
        set col $who
        for {set row 0} {$row < $B(height)} {incr row} {
            if {$B(b,$row,$col) == 0} {
                set B(b,$row,$col) -1
                DrawCell $row $col
            }
        }
    }
}
##+##########################################################################
#
# Solve -- Brute force try all possible solutions for this
# combination of pips and this strip of the board. Returns
# new strip w/ forced on and forced off locations set.
#
proc Solve {pips board} {
    set all [AllLegal $pips $board]
    if {$all eq ""} { return "" }

    set cnt [llength $all]
    array unset CNTS
    ;# For each position, count how many moves have pip there
    foreach sln $all {
        foreach pip $pips pos $sln {
            for {set i 0} {$i < $pip} {incr i} {
                set n [expr {$pos + $i}]
                incr CNTS($n)
            }
        }
    }
    # Find all positions w/ 0 or $cnt on
    set result {}
    set progress {}
    for {set i 0} {$i < [llength $board]} {incr i} {
        set there [lindex $board $i]
        if {! [info exists CNTS($i)]} {
            set now -1
        } elseif {$CNTS($i) == $cnt} {
            set now 1
        } else {
            set now 0
        }
        lappend result $now
        if {$there != $now} { lappend progress $i }
    }
    return [list $result $progress]
}

##+##########################################################################
#
# AllLegal -- Returns list of all legal moves for this combination
# of pips on this board strip. Works by placing first pip and recursively
# calling itself for the remainder. Not very optimized right now.
#
proc AllLegal {pips board} {
    # Optimization:
    #   start at first on cell - pip
    #   end at  boardLen - pip OR room for $rest
    #   if we hit a X we could skip forward more than 1

    set rest [lassign $pips pip]
    set boardLen [llength $board]
    set where {}
    for {set pos 0} {$pos + $pip <= $boardLen} {incr pos} {
        if {[WillFit $pos $pip $board]} {
            set start [expr {$pos+$pip+1}]
            set b [lrange $board $start end]
            if {$rest eq {}} {
                if {[lsearch $b 1] == -1} {
                    lappend where $pos
                }
            } else {
                set subs [AllLegal $rest $b]
                foreach sub $subs {
                    set sln $pos
                    foreach item $sub {
                        lappend sln [expr {$item + $start}]
                    }
                    lappend where $sln
                }
            }
        }
        if {[lindex $board $pos] == 1} break    ;# Can't leave pip to our left
    }
    return $where
}
##+##########################################################################
#
# WillFit -- Returns true if there is room to put $pip pips at $pos
#
proc WillFit {pos pip board} {
    if {[lindex $board $pos] == -1} { return 0} ;# Quick check on starting pos

    if {[lindex $board $pos-1] == 1} { return 0};# One before
    if {[lindex $board $pos+$pip] == 1} { return 0} ;# One after

    set b [lrange $board $pos [expr {$pos + $pip - 1}]]
    set n [lsearch $b -1]
    if {$n != -1} { return 0}
    return 1
}
proc OneHint {} {
    global B S

    if {$S(state) ne "go"} return

    unset -nocomplain all
    for {set row 0} {$row < $B(height)} {incr row} {
        set valid [IsValid row $row]
        if {$valid == 1} continue               ;# Solved already
        if {$valid < 0} { set ::S(msg) "Bad Board"; return }

        set all([expr {rand()}]) [list row $row]
    }
    for {set col 0} {$col < $B(width)} {incr col} {
        set valid [IsValid col $col]
        if {$valid == 1} continue               ;# Solved already
        if {$valid < 0} { set ::S(msg) "Bad Board"; return }

        set all([expr {rand()}]) [list col $col]
    }

    # Go through random list and try until ok
    foreach idx [array names all] {
        foreach {what who} $all($idx) break
        if {$what eq "row"} {
            set w .b.a${who},_
            set cmd SolveRow
        } else {
            set w .b.a_,${who}
            set cmd SolveCol
        }

        set clr [$w cget -bg]
        $w config -bg cyan
        set progress [$cmd $who]
        if {$progress eq "bad"} {
            set ::S(msg) "Bad board"
            $w config -bg $clr
            return
        }
        if {$progress ne {}} {
            $w config -bg $clr
            return
        }
        update
        after $::S(delay2) { set ::tick . }
        vwait ::tick
        $w config -bg $clr
    }
    set ::S(msg) "No progress"
}
##+##########################################################################
#
# OnePass -- Does one pass over every row/column trying to
# solve each one. Not very smart about skipping ones which
# are already solved or haven't changed from last time.
#
proc OnePass {} {
    if {$::S(state) ne "go"} {return 0}

    set changed 0
    for {set row [expr {$::B(height)-1}]} { $row >= 0} {incr row -1} {
        set valid [IsValid row $row]
        if {$valid == 1} continue
        if {$valid == -1} {
            set ::S(msg) "Bad board"
            return 0
        }

        set w .b.a${row},_
        set clr [$w cget -bg]
        $w config -bg cyan

        set progress [SolveRow $row]
        if {$progress eq "bad"} {
            set ::S(msg) "Bad board"
            $w config -bg $clr
            return 0
        }
        update
        after $::S(delay) { set ::tick . }
        vwait ::tick

        if {$progress ne {}} { incr changed }
        #if {$progress ne {}} {puts "progress at row $row => '$progress'"}
        $w config -bg $clr

    }
    for {set col 0} {$col < $::B(width)} {incr col} {
        set valid [IsValid col $col]
        if {$valid == 1} continue
        if {$valid == -1} {
            set ::S(msg) "Bad board"
            return 0
        }
        set w .b.a_,${col}
        set clr [$w cget -bg]
        $w config -bg cyan

        set progress [SolveCol $col]
        if {$progress eq "bad"} {
            set ::S(msg) "Bad board"
            $w config -bg $clr
            return 0
        }
        update
        after $::S(delay) { set ::tick . }
        vwait ::tick

        if {$progress ne {}} { incr changed }
        #if {$progress ne {}} {puts "progress at column $col => '$progress'"}
        $w config -bg $clr
    }
    if {! $changed} {
        set ::S(msg) "No progress"
    }
    return $changed
}
proc SolveIt {} {
    if {$::S(state) ne "go"} return

    while {1} {
        set n [OnePass]
        if {! $n} break
        if {$::S(state) ne "go"} return
    }
    puts "done w/ SolveIt"
}
##+##########################################################################
#
# SolveRow -- Gets solution to this row and puts in the new info
#
proc SolveRow {row} {
    foreach {sln progress} [_SolveRow $row] break
    if {! [info exists sln] || $sln eq {}} {    ;# BAD
        set w .b.h$row,_
        $w config -bg $::COLORS(-1)
        return bad
    }
    foreach col $progress {
        set want [lindex $sln $col]
        if {$want == 1} { LeftClick $row $col }
        if {$want == -1} { RightClick $row $col }
    }
    IsSolved 1
    return $progress
}
##+##########################################################################
#
# _SolveRow -- Returns solution for this row
#
proc _SolveRow {row} {
    global B

    set pips [lindex $B(rows) $row]
    set board {}
    for {set col 0} {$col < $B(width)} {incr col} {
        lappend board $B(b,$row,$col)
    }
    return [Solve $pips $board]
}
##+##########################################################################
#
# SolveCol -- Gets solution for this column and puts in the new info
#
proc SolveCol {col} {
    foreach {sln progress} [_SolveCol $col] break
    if {! [info exists sln] || $sln eq {}} {    ;# BAD
        set w .b.h_,$col
        $w config -bg $::COLORS(-1)
        return bad
    }

    foreach row $progress {
        set want [lindex $sln $row]
        if {$want == 1} { LeftClick $row $col }
        if {$want == -1} { RightClick $row $col }
    }
    IsSolved 1
    return $progress
}
##+##########################################################################
#
# _SolveCol -- Returns solution for this column
#
proc _SolveCol {col} {
    global B

    set pips [lindex $B(columns) $col]
    set board {}
    for {set row 0} {$row < $B(height)} {incr row} {
        lappend board $B(b,$row,$col)
    }
    return [Solve $pips $board]
}
##+##########################################################################
#
# DoTooltip -- Displays row and column of on blocks
#
proc DoTooltip {row col} {
    global S B

    set rowLen [set colLen 0]
    if {$B(b,$row,$col) == 1} {
        set rowLen 1
        for {set col2 [expr {$col+1}]} {$col2 < $B(width)} {incr col2} {
            if {$B(b,$row,$col2) != 1} break
            incr rowLen
        }
        for {set col2 [expr {$col-1}]} {$col2 >= 0} {incr col2 -1} {
            if {$B(b,$row,$col2) != 1} break
            incr rowLen
        }

        set colLen 1
        for {set row2 [expr {$row+1}]} {$row2 < $B(height)} {incr row2} {
            if {$B(b,$row2,$col) != 1} break
            incr colLen
        }
        for {set row2 [expr {$row-1}]} {$row2 >= 0} {incr row2 -1} {
            if {$B(b,$row2,$col) != 1} break
            incr colLen
        }

    }
    set ::S(msg) "($rowLen,$colLen)"
}
##+##########################################################################
#
# GetTitles -- Returns list of puzzle titles for our combobox
#
proc GetTitles {} {
    set values {"Random 5x5" "Random 10x10" "Random 15x15" "Random 20x20"
        "Random 25x25"}

    foreach v [lsort -dictionary [array names ::P]] {
        array set tmp $::P($v)
        if {! [info exists tmp(title)]} {
            set tmp(title) "Puzzle $v ($tmp(width)x$tmp(height))"
            lappend ::P($v) title $tmp(title)
        }
        lappend values $tmp(title)
        array unset tmp
    }
    set ::S(titles) $values
    return $values
}
##+##########################################################################
#
# ReverseBoard -- Takes current board state and turns it into
# our internal puzzle form, thereby letting you create your own
# puzzles. No user interface nor any way of setting size.
#
proc ReverseBoard {} {
    global B
    unset -nocomplain PP

    set rows [set cols {}]
    for {set row 0} {$row < $B(height)} {incr row} {
        lappend rows [Board2Pips row $row]
    }
    for {set col 0} {$col < $B(width)} {incr col} {
        lappend columns [Board2Pips col $col]
    }

    set result "set P(\[incr idx]) \{ "
    append result "width $B(width) height $B(height)\n"
    append result "    rows \{" $rows "\}\n"
    append result "    columns \{" $columns "\}\n"
    append result "\}\n"
    clipboard clear
    clipboard append $result
    return $result

}
##+##########################################################################
#
# Board2Pips -- Turns row or column into a pip count
#
proc Board2Pips {what who} {
    set strip {}
    if {$what eq "row"} {
        for {set col 0} {$col < $::B(width)} {incr col} {
            lappend strip [expr {$::B(b,$who,$col) > 0}]
        }
    } else {
        for {set row 0} {$row < $::B(height)} {incr row} {
            lappend strip [expr {$::B(b,$row,$who) > 0}]
        }
    }

    set pips {}
    set last 0
    set cnt 0
    foreach item $strip {
        if {$item == 1} {
            incr cnt
        } elseif {$last == 1} {
            lappend pips $cnt
            set cnt 0
        }
        set last $item
    }
    if {$cnt > 0} {lappend pips $cnt}
    if {$pips eq {}} {set pips 0}
    return $pips
}

proc About {} {
    set txt "Nonograms\nby Keith Vetter, July 2008\n\n"
    append txt "Nonograms are picture logic puzzles in which cells\n"
    append txt "in a grid have to be colored or left blank\n"
    append txt "according to numbers given at the side of the grid\n"
    append txt "to reveal a hidden picture.\n\n"
    append txt "In this puzzle type, the numbers measure how many\n"
    append txt "unbroken lines of filled-in squares there are in\n"
    append txt "any given row or column. For example, a clue of '4\n"
    append txt "8 3' would mean there are sets of four, eight, and\n"
    append txt "three filled squares, in that order, with at least\n"
    append txt "one blank square between successive groups.\n"
    append txt "(from wikipedia)"

    tk_messageBox -message $txt -title "About $::S(title)"
}
proc Random {w h {density .6}} {
    global B

    unset -nocomplain B
    set B(width) $w
    set B(height) $h
    for {set row 0} {$row < $h} {incr row} {
        for {set col 0} {$col < $w} {incr col} {
            set B(b,$row,$col) [expr {rand() < $density}]
        }
    }
    set B(title) "Random"
    set B(rows) [set B(cols) {}]
    for {set row 0} {$row < $B(height)} {incr row} {
        lappend B(rows) [Board2Pips row $row]
    }
    for {set col 0} {$col < $B(width)} {incr col} {
        lappend B(columns) [Board2Pips col $col]
    }
    CreateBoard
}
#################################################################
#
# Static global data
#
image create bitmap ::bmp::rarrow -data {
    #define right_width 11
    #define right_height 11
    static char right_bits = {
        0x00, 0x00, 0x20, 0x00, 0x60, 0x00, 0xe0, 0x00, 0xfc, 0x01, 0xfc,
        0x03, 0xfc, 0x01, 0xe0, 0x00, 0x60, 0x00, 0x20, 0x00, 0x00, 0x00
    }
}
image create bitmap ::bmp::darrow -data {
    #define down_width 11
    #define down_height 11
    static char down_bits = {
        0x00, 0x00, 0x00, 0x00, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0xfe,
        0x03, 0xfc, 0x01, 0xf8, 0x00, 0x70, 0x00, 0x20, 0x00, 0x00, 0x00
    }
}
image create bitmap ::bmp::blank -data {
    #define blank_width 11
    #define blank_height 11
    static char right_bits = {
        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
    }
}
set idx -1
#_set P([incr idx]) {width 5 height 5 title Easy rows {3 4 1 3 2} columns {2 2 {2 2} 4 1}}
#_set P([incr idx]) {width 5 height 5 rows {{1 3} 3 3 1 2} columns {1 2 {3 1} 3 3}}
#_set P([incr idx]) {width 5 height 5 rows {3 {1 1 1} 3 {1 1} {1 1}} columns {{1 1} {1 2} 3 {1 2} {1 1}}}
#_set P([incr idx]) {width 5 height 5 rows {3 {3 1} 3 1 {1 1}} columns {{2 1} 2 {3 1} 1 3}}
#_set P([incr idx]) {width 5 height 5 rows {3 {3 1} 3 1 {1 1}} columns {{2 1} 2 {3 1} 1 3}}
#_set P([incr idx]) {width 5 height 5 rows {{1 2} 2 {1 1} {1 2} 3} columns {1 4 1 {1 3} {1 2}}}
#_set P([incr idx]) {width 5 height 5 rows {{2 2} {3 1} {1 2} 1 1} columns {4 {2 1} 1 {1 1} 3}}
#_set P([incr idx]) {width 10 height 10
#_    rows {{2 4} {7 2} {3 1} {3 1 1} {1 1 1} {3} {1 1 3} {7} {2 2} {3 1}}
#_    columns {{5 2} {4 1 2} {3 1} {1 2} {1 1} {1 1 1} {2 1} {1 5} {2 4} {3 6}}
#_}
#_set P([incr idx]) {width 10 height 10
#_    rows {{1 6} {1 4} {1 3} 2 1 2 {6 1} {4 4} {3 5} {1 5}}
#_    columns {1 2 {3 3} {1 5} {2 3} {3 1 1 2} {4 4} {4 4} 3 4}
#_}
#_set P([incr idx]) {width 10 height 10
#_    rows {5 {1 5} {2 2} {4 1 3} {4 1} 5 4 3 {3 2 1} {3 1}}
#_    columns {{1 1 5} 7 7 4 {2 2} {4 2} {3 1} {2 1} 4 {3 1}}
#_}
#_set P([incr idx]) {width 10 height 10
#_    rows {5 4 2 2 {7 2} {7 1} 9 6 {3 1} 1}
#_    columns {{2 2} {4 1} {1 4 1} {2 4} {2 4} {3 4} {3 4} 2 {1 3} 3}
#_}
#_set P([incr idx]) {width 10 height 10
#_    rows {{3 1} {3 1} {3 2 2} {3 2 2} {3 6} {1 1 4} {3 4} {2 1} 2 1}
#_    columns {5 {3 1} 5 {2 2} 9 8 3 4 3 5}
#_}
#_set P([incr idx]) {width 10 height 10
#_    rows {5 {5 1} {1 2} 3 {1 2} {1 2 1} {4 1} {5 3} {6 2} {4 1}}
#_    columns {1 2 {1 6} {2 4} {2 4} {2 4} {2 1} {2 1 4} {3 2} {5 1 1}}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {7 3 {1 2} 1 3 {4 2} {4 2} {5 4} {4 3} {2 1 2}}
#_    columns {{1 6} {1 6} {1 5} {1 1 5} {2 1} 3 {4 1} 2 5 5}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {4 5 2 3 {1 1} {3 6} {2 4} {3 4} {1 4} {3 4}}
#_    columns {{1 5} {1 1 3} {4 1 1 1} {4 1} {2 1 1} {1 1} 5 6 5 5}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {{1 3} {1 3} {1 4} {1 6} 3 3 {1 1 3} {3 3} {5 2} 6}
#_    columns {{4 1} 2 2 4 {1 3} {1 4} 2 8 9 9}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {{3 3} 3 5 {2 2} {1 5} 4 {6 1} 5 {4 1} {2 3}}
#_    columns {{5 4} {4 4} {3 3} {1 1 3} 6 4 {1 2} {1 3 1} {1 1} 2}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {{2 3} {1 5} 5 {4 2} 2 {3 4} {2 4} {2 4} {1 4} {1 1}}
#_    columns {{2 6} {1 4} 1 {1 1} 3 4 {4 5} {3 4} {2 4} {1 4}}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {{2 1 2} {2 1 1 2} {2 4} 2 {1 3} 8 {2 3} {3 2} {3 2} 4}
#_    columns {3 {3 1} {2 2} {2 5} 5 {1 1 1 1} {2 1} {3 3} {3 5} {1 5}}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {5 5 4 7 {1 4} 3 {3 2} {2 2} {2 3} {4 3}}
#_    columns {{2 1} {3 1 1} {3 4} {4 3} {5 1} 1 2 {3 2} 7 7}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {{3 2} {1 3 2} {3 1} 2 {3 3} {2 5} {2 6} {1 5} {1 3} {1 1}}
#_    columns {{4 4} 5 {3 2} 2 {2 3} 5 6 5 {2 3} {3 1}}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {{1 2} {1 2} {1 4} {1 3} {5 3} {5 1} {6 1} 5 {3 1} {4 1}}
#_    columns {{2 2 1} {3 1} 8 6 {1 1 5} {3 2} {3 2} 3 {2 2} 3}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {4 {1 1} 1 {1 3} {3 4} 8 8 {1 4} {3 3} {3 2}}
#_    columns {{4 2} {3 2} 6 2 6 {1 4} {2 5} {1 5} {1 3} 3}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {{5 2} {5 2} {2 2} {2 2} {1 3} {1 5} 5 {2 1 1 1} 4 4}
#_    columns {{2 3} {2 3} {4 2} {6 3} 2 3 2 4 7 7}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {{5 2} {4 1} 2 {3 2} {4 2} 9 {2 1 3} 3 {1 3} {1 2}}
#_    columns {{2 2} {2 1} {2 4} {2 4} {1 3} 3 {1 1} {1 4} 9 8}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {4 4 {4 1} {1 1 4} {1 4 1} {2 1} {1 2 2} {1 2} {1 1 4} 8}
#_    columns {4 {3 3} {5 1} {3 1} {3 2} {4 1} {3 1 2} {2 2} 4 6}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {1 {2 1} {1 2} {2 2 1} {2 2} {5 2} {7 1} {1 6} {6 1} {2 2 1}}
#_    columns {{4 3} {1 1 1 2} 4 4 8 9 3 3 2 {4 1}}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {{1 1} 1 {1 2 1} 6 7 7 6 {1 4} 5 7}
#_    columns {{1 1 1} 1 2 {2 2} 7 {5 2} 8 5 5 8}
#_}
#_set P([incr idx]) { width 10 height 10
#_    rows {4 4 {2 1} {3 3} {1 2} {4 2} 4 5 7 8}
#_    columns {5 5 7 {4 5} {4 3} {2 2} {2 2} {1 1} 4 3}
#_}
#_set P([incr idx]) { width 15 height 15
#_    rows {{1 1 2} {2 3 2} {3 1 1 3 2} {11 1} {4 4} {4 2} 4 {4 3} {4 3} {1 2 5} {1 7} {6 1} {5 1 3 1} {6 1 1} {6 1}}
#_    columns {{6 3} {7 3} {10 3} {8 1 3} {1 3} {2 2} {3 2} {4 4} {2 3} {5 4} {3 4} {2 7} 4 {3 3} {4 1 1 2}}
#_}
#_set P([incr idx]) {width 15 height 15
#_    rows {{1 3} {1 4} {3 3} {1 9} {2 6 3} {2 7 1} {11 1} {9 1} {11 1} {8 1 2} {6 3} {3 1 2} 1 2 {3 1}}
#_    columns {{2 4 1 2} {3 3 2} {6 1} 6 {2 7} {2 7 1 1} {12} 9 8 {6 1} 9 {2 1} 3 {2 1 1} {7 1}}
#_}
#_set P([incr idx]) {width 15 height 15
#_    rows {{2 1} {2 2} {4} {3} {5} {7 2} {2 8 1} {4 3 1} {3 2 1} {3 1} {3 1} {4} {3 1} {3 3} {2 4}}
#_    columns {{2} {3} {3} {5} {2 3} {2 3} {1 2 3} {1 10} {1 5 2} {7} {5} {4 1} {3 2 2} {1 3} {3 2}}
#_}
#_set P([incr idx]) { width 15 height 15
#_    rows {{4 3} {4 5} {3 7} {6 3} {5 3} {6 2} {3 5} {1 2 5} {3 1} {2 4 1} {2 5} {1 4} {1 8} {2 2 1} {4 4 1}}
#_    columns {{3 1 6} {6 2 2} {8 1} {2 4 1} 5 {3 1 1 1 1} {3 1 1 1} {3 5} {6 5} {6 4} {3 9} {1 5 1} {4 1} 2 4}
#_}
#_set P([incr idx]) {width 20 height 10
#_    rows {{3 3 2} {5 3 2} {2 2 2 2} {2 2 2 2} {3 2 2 1 2} {7 3 3 3} {7 10} {3 3 9} {2 2 3 3} {2 3 2 1}}
#_    columns {{3} {6} {7} {7} {2 2} {3 2} {7} {1 7} {2 3} {6 1} {7} {5} {4} {4} {4} {4} {4} {4} {8} {7}}
#_}
#_set P([incr idx]) {width 25 height 25
#_    rows { {1 1 7 4} {2 3 6 2} {2 12 2} {5 12} {1 8} {2 1 7} {2 1 1 1 4} {1 1 2 5} {7 5} {1 5 4} {5 6 5} {4 14} {13 2} {12 1} {12} {4 4 3} {1 1 2} {5 1 1} {5 3 6} {4 4 3 5} {4 3 3 3} {2 1 9} {2 10} {2 8 6} {3 4 3 2 4}}
#_    columns { {4 6 8} {3 3 6 8} {1 2 11 1} {1 2 6 4} {2 1 1 3 2} {1 1 4 1} {2 5 1} {1 1 1 5 2} {4 9 6} {3 10 1 3} {2 8 1 4} {1 2 7 7} {5 4 1 6} {6 2 6} {6 1 1 4} {6 2 2 4} {6 3 1 3} {6 2 7} {10 4 2} {10 2 2} {5 2 1} {1 5 2 2} {1 2 2} {3 1} {3 1}}
#_}
set P([incr idx]) { width 9 height 10
    title "Apple"
    rows {2 2 {2 1 2} {4 4} {1 7} {1 7} {1 7} {2 6} 7 {2 2}}
    columns {5 {2 2} {5 2} 7 {2 5} {2 7} {1 8} 7 5}
}
set P([incr idx]) { width 13 height 13
    title Seahorse
    rows {3 {1 2 2} 9 {1 5} 5 {5 1} {5 1} {3 6} {1 1 5} {1 1 1 3} {1 2 2} {1 2} 5}
    columns {3 {1 1} {3 1 1 1} {1 1 1 1} {1 3 1} {1 1} {3 4 2} 12 {1 9} 10 8 {1 1} 2}
}
set P([incr idx]) { width 15 height 10
    title "Sun"
    rows {{1 5 2} {2 5 2} {2 3 2 2} {2 3 2 3} {1 1 4} {2 3 3} {5 1} {1 7 5} 7 {2 5 6}}
    columns {{3 1 1 1} {3 1 1} {2 2} {2 4} {4 5} {4 5} {4 5} {2 4} {2 2} {3 1 1} {3 2 1 1} {1 2 1 1} {2 1 1} {3 1 1} {2 2 1}}
}
set P([incr idx]) { width 25 height 10
    title "Chopper"
    rows {{1 1} {1 19} {5 1} {2 5} {13 1} {12 1} {5 1} 6 {3 1} 10}
    columns {1 1 5 4 {1 2} 2 {1 2} {1 2} {1 2} {1 2} {1 2 1} {1 3 1} {1 3 1} {1 5 1} {1 7} {4 4} {1 1 3} {1 1 1 1} {1 1 1 1} {1 2 1} {1 1} 1 1 1 1}
}
set P([incr idx]) { width 22 height 29
    title "Cockroach"
    rows {{4 4} {2 2 2 2} {1 1 1 1} {1 4 1} {1 1 1 1} {1 1 6 1 1} {1 1 8 1 1} {3 8 3} {1 12 1} {2 1 6 1 2} {1 2 2 1} {1 6 5 1} {9 8} {2 7 5 2} {2 7 4 2} {2 7 4 2} {1 1 7 4 1 1} {1 8 3 1 1} {10 5} {11 6} {2 7 2 2} {2 7 2 2} {2 7 2 2} {2 6 1 2} {1 6 1 1} {2 5 2} {1 1 3 1 1} {1 1 1 1} {1 1}}
    columns {{2 1} {2 3 3} {1 8 7} {9 1 6} {2 1 2 2} {1 1 9} {1 15} {2 3 15 2} {2 6 15} {1 5 16} {1 5 16} {1 5 13} {1 5 3 9} {2 6 6} {2 3 15 2} {1 15} {1 1 9} {2 1 1 2} {9 1 6} {1 9 7} {2 3 3} {2 1}}
}
set P([incr idx]) { width 20 height 20
    title "Martini"
    rows {{2 1 4} {1 1 1 4} {2 1 6} {3 4 1 6} {5 1 2 1 1} {3 1 6} {3 1 1 4} {3 3 2} {2 1 3} {1 3 2 1} {2 1 1 1} {1 2 1 2} {3 2 1 2} {5 3 1 1} {6 5 1 1} {13 1 1} {3 3 7 1} {3 6 3 1} {3 3 2 3 1} {2 8 4}}
    columns {{4 5} {1 3 7} {1 3 7} {1 1 4 5 1} {1 6 1 8} {1 3 5 7} {4 6} {4 1 1 1 1 1} {3 1 1 2 6} {2 1 1 1 7} {3 3 6 1} {2 7} 6 4 {3 8 1} {1 2 2 1} {1 4 7} {1 4 2} {1 2 3} 3}
}
set P([incr idx]) { width 25 height 25
    title "Snow Flake"
    rows {{10 10} {9 3 9} {3 2 2 3} {2 4 2 2 4 2} {2 2 3 1 3 2 2} {2 1 1 2 3 2 1 1 2} {2 1 2 1 1 1 2 1 2} {2 2 6 6 2 2} {2 2 2 3 2 2 2} {1 5 2 2 5 1} {2 1 1 1 1 1 1 2} {2 1 11 1 2} {1 3 1 1 1 1 3 1} {2 1 11 1 2} {2 1 1 1 1 1 1 2} {1 5 2 2 5 1} {2 2 2 3 2 2 2} {2 2 6 6 2 2} {2 1 2 1 1 1 2 1 2} {2 1 1 2 3 2 1 1 2} {2 2 3 1 3 2 2} {2 4 2 2 4 2} {3 2 2 3} {9 3 9} {10 10}}
    columns {{10 10} {9 3 9} {3 2 2 3} {2 4 2 2 4 2} {2 2 3 1 3 2 2} {2 1 1 2 3 2 1 1 2} {2 1 2 1 1 1 2 1 2} {2 2 6 6 2 2} {2 2 2 3 2 2 2} {1 5 2 2 5 1} {2 1 1 1 1 1 1 2} {2 1 11 1 2} {1 3 1 1 1 1 3 1} {2 1 11 1 2} {2 1 1 1 1 1 1 2} {1 5 2 2 5 1} {2 2 2 3 2 2 2} {2 2 6 6 2 2} {2 1 2 1 1 1 2 1 2} {2 1 1 2 3 2 1 1 2} {2 2 3 1 3 2 2} {2 4 2 2 4 2} {3 2 2 3} {9 3 9} {10 10}}
}
set P([incr idx]) { width 30 height 34
    title "Brontosaurus"
    rows {{3 7} {1 3 7 2} {5 10 1} {4 13 1} {3 14 1} {3 15 1} {2 16 1} {20 1} {7 10 1} {6 11 1} {6 12 1} {6 12 1} {1 3 4 7 1} {1 2 4 6 1} {2 5 6 2} {2 5 7 1} {3 4 6 1} {4 5 6 2} {4 4 7 1} {4 7 1} {5 7 2} {5 7 2} {6 2} {4 2} {3 2} {3 2} {4 3} {6 5} {3 12} 20 20 8 4 2}
    columns {2 {1 2} 8 12 {5 6} {6 1 2} {9 2 3} {16 3} {17 3} {8 3 3} {7 6 3} {8 9 2 3} {22 4} {22 4} {12 8 3} {13 5 1 2} {1 14 1 2} {1 18 4} {1 18 4} {1 19 4} {1 17 4} {2 16 1 3} {2 8 1 3} {8 6 1 3} {4 7 3} {3 5 4} {1 4 4} {2 4} 9 6}
}
set P([incr idx]) { width 20 height 20
    title "Soccer Player"
    url http://en.wikipedia.org/wiki/Image:Paint_by_numbers_Animation.gif
    rows {3 5 {3 1} {2 1} {3 3 4} {2 2 7} {6 1 1} {4 2 2} {1 1} {3 1} 6 {2 7} {6 3 1} {1 2 2 1 1} {4 1 1 3} {4 2 2} {3 3 1} {3 3} 3 {2 1}}
    columns {2 {1 2} {2 3} {2 3} {3 1 1} {2 1 1} {1 1 1 2 2} {1 1 3 1 3} {2 6 4} {3 3 9 1} {5 3 2} {3 1 2 2} {2 1 7} {3 3 2} {2 4} {2 1 2} {2 2 1} {2 2} 1 1}
}
set P([incr idx]) { width 21 height 10
    title Me
    rows {{4 4 4 4} {2 2 2 2} {2 2 2 2} {2 2 2 2} {4 1 2} {4 2 2} {5 2 2} {2 2 2 2} {2 2 2 2} {4 4 3}}
    columns {{1 1} 10 10 {1 3 1} 4 {1 2 2 1} {3 3} {2 2} {1 1} 0 1 4 7 {1 4} 3 1 3 {1 5} 7 4 1}
}
set P([incr idx]) { width 15 height 15
    title House
    rows {{3 2} {5 2} {2 4} {2 3} {2 2} {2 3 3 2} {3 3 3 3} {3 3 3 3} {2 2} {2 2} {2 5 2} {2 5 2} {2 2 2 2} {2 2 2 2} {2 2 2 2}}
    columns {2 10 11 2 {2 3} {2 3 5} {2 3 5} {2 2} {2 3 5} {2 3 5} {2 3} 5 15 10 2}
}


################################################################
DoDisplay
set S(puzzle) "Random 10x10"
return