Celtic Knot

Keith Vetter 2013-05-15 : Celtic Knots are an ornamental design of interlacing lines[1 ].

I was inspired by Celtic Knot Thingy but I wanted an interactive version that displayed the knot as you designed it, and that did not rely on postscript for its display. That web page links to a good description on how to create the knots, which ultimately derives from the paper Celtic Knotwork: Mathematical Art by Peter Cromwell [2 ].

One cool feature unique to this program is how the lines are drawn. The standard method is to do a tiling of five basic line segment images (with 21 more images when you count rotations and reflections).

This program, instead, draws each line as a one continuous line, with coordinates of the corners of the cells it traverses. The secret is to turn on TK's parabolic splines. This makes the line bend just right to get the effect we want. As a bonus, if you set -splinesteps to 1 or 2 you get a nice square or jagged look.

There are two drawbacks to my line drawing methods. First is that lines that exit out of the grid are not clipped nicely--they project off the edge. Second, you don't get the correct interlacing. I had to come up with a kludge to achieve correct interlacing (see proc FakeCrossing for details).


https://wiki.tcl-lang.org/_repo/images/CelticKnot.png


##+##########################################################################
#
# CelticKnot -- My version of Celtic Knot Thingy
# (see http://isotropic.org/celticknot/)
# by Keith Vetter 2013-05-10
#

package require Tk

set S(title) "Celtic Knot"

set S(w) 12
set S(h) 10
set S(boxSize) 100
set S(margin) 30
set S(center,left) 0
set S(center,top) 0

set S(lineWidth,off) 2
set S(lineWidth,on) 6
set S(color,bg) gray95
set S(color,even) red
set S(color,odd) green
set S(color,edge) black
set S(color,salt) .5
set S(cursor) iron_cross

set B(breaks) {}
set B(hiddenCells) {}
set B(braidWidth,perc) 40
set B(solid) 0
set B(monochrome) 0
set B(show,marker) 1
set B(show,break) 1
set B(show,line) 1
set B(show,braid) 1
set B(show,hidden) 1
set B(corners) 12
set B(sym,hor) 1
set B(sym,ver) 1

proc DoDisplay {} {
    global S
    wm title . $S(title)

    set cw [expr {2*$S(margin) + $S(w)*$S(boxSize)}]
    set cw [expr {max(500,$cw)}]
    set ch [expr {2*$S(margin) + $S(h)*$S(boxSize)}]
    canvas .c -width $cw -height $ch -bd 0 -highlightthickness 0 \
        -bg $S(color,bg)
    bind .c <Configure> {ResizeCanvas %w %h}
    frame .ctrl -bd 2 -relief ridge
    frame .ctrl.buttons
    ::ttk::button .ctrl.buttons.reset -text Reset -command Reset
    ::ttk::button .ctrl.buttons.resize -text Resize -command NewSize
    ::ttk::button .ctrl.buttons.screen -text "Screen Shot" -command ScreenShot
    ::ttk::button .ctrl.buttons.about -text "About" -command About

    ::ttk::labelframe .ctrl.hide -text Show
    set who {line Cells break Breaks braid Braid}
    foreach {var lbl} $who {
        set W .ctrl.hide.$var
        ::ttk::checkbutton $W -text $lbl -variable ::B(show,$var) -command Hide
        pack $W -side top -fill x -padx .1i
    }

    ::ttk::labelframe .ctrl.corners -text Corners
    ::ttk::radiobutton .ctrl.corners.round -text Round -variable ::B(corners) \
        -value 12 -command Hide
    ::ttk::radiobutton .ctrl.corners.jagged -text Jagged \
        -variable ::B(corners) -value 2 -command Hide
    ::ttk::radiobutton .ctrl.corners.square -text Square \
        -variable ::B(corners) -value 1 -command Hide
    pack .ctrl.corners.round .ctrl.corners.jagged .ctrl.corners.square \
        -side top -fill x -padx .1i

    ::ttk::labelframe .ctrl.colors -text Colors
    set who {solid "Solid Colors" monochrome Monochrome}
    foreach {var lbl} $who {
        set W .ctrl.colors.$var
        ::ttk::checkbutton $W -text $lbl -variable ::B($var) -command DrawBraid
        pack $W -side top -fill x -padx .1i
    }
    ::ttk::button .ctrl.colors.new -text "New Colors" -command NewColorSalt
    pack .ctrl.colors.new -side top -fill x -padx .1i

    ::ttk::labelframe .ctrl.symmetry -text Symmetry
    set who {sym,hor "Left-Right" sym,ver "Top-Bottom"}
    foreach {var lbl} $who {
        set W .ctrl.symmetry.$var
        ::ttk::checkbutton $W -text $lbl -variable ::B($var)
        pack $W -side top -fill x -padx .1i
    }

    ::ttk::labelframe .ctrl.fat -text "Line Width"
    scale .ctrl.fat.s -from 10 -to 100 -variable B(braidWidth,perc) \
        -orient h -length 80 -command {apply {{val} {DrawBraid}}}
    pack .ctrl.fat.s -side top -fill x -pady .1i -padx .05i

    pack .ctrl.hide -side left -fill y
    pack .ctrl.corners -side left -fill y
    pack .ctrl.colors -side left -fill y
    pack .ctrl.symmetry -side left -fill y
    pack .ctrl.fat -side left -fill y
    pack .ctrl.buttons -side top -expand 1

    grid forget .ctrl.buttons.resize .ctrl.buttons.screen \
        .ctrl.buttons.reset .ctrl.buttons.about
    grid .ctrl.buttons.reset .ctrl.buttons.screen -padx .1i -pady .05i
    grid .ctrl.buttons.resize .ctrl.buttons.about -padx .1i -pady .05i

    pack .ctrl -side bottom -fill x
    pack .c -side top -fill both -expand 1

    SetWallBreaks

    # canvas will get drawn on <Configure> event
}
##+##########################################################################
#
# DoCanvas -- Draws all the knoxel stuff on a canvas
#
proc DoCanvas {} {
    global S

    set S(dotSize) [expr {max($S(boxSize) / 6, 10)}]

    .c delete all
    .c create rect 0 0 999999 999999 -fill $S(color,bg) -width 0 -tag bg

    for {set row 0} {$row < $S(h)} {incr row} {
        for {set col 0} {$col < $S(w)} {incr col} {
            set xy [CellToXY $row $col]
            set tag hidden,$row,$col
            .c create rect $xy -tag [list $tag hidden] -fill $S(color,bg) \
                -stipple gray75 -width 0
            .c bind $tag <1> [list HideCell $tag]
        }
    }

    for {set row 0} {$row <= $S(h)} {incr row} {
        for {set col [expr {$row % 2}]} {$col <= $S(w)} {incr col 2} {
            DrawKnoxel $row $col
        }
    }
    ShowAllBreaks
    ShowAllHiddenCells
}
##+##########################################################################
#
# HideKnoxel -- Hide or unhide the 4 cells around a marker
#
proc HideKnoxel {row1 col1} {
    if {$row1 == 0 || $row1 == $::S(h) || $col1 == 0 || $col1 == $::S(w)} return

    set row0 [expr {$row1-1}]
    set col0 [expr {$col1-1}]
    set row2 [expr {$row1+1}]
    set col2 [expr {$col1+1}]
    set cells [list $row0 $col0 $row0 $col1 $row1 $col0 $row1 $col1]

    set alreadyHidden 0
    foreach {r c} $cells {
        set tag hidden,$r,$c
        set n [lsearch $::B(hiddenCells) $tag]
        incr alreadyHidden [expr {$n == -1 ? 0 : 1}]
    }
    if {$alreadyHidden == 4} {
        foreach {r c} $cells {
            set tag hidden,$r,$c
            set n [lsearch $::B(hiddenCells) $tag]
            set ::B(hiddenCells) [lreplace $::B(hiddenCells) $n $n]
        }
        if {$row0 > 0} {
            AddRemoveBreak off $row0 $col0 $row0 $col2
            ShowBreak $row0 $col0 $row0 $col2
        }
        if {$col0 > 0} {
            AddRemoveBreak off $row0 $col0 $row2 $col0
            ShowBreak $row0 $col0 $row2 $col0
        }
        if {$row2 < $::S(h)} {
            AddRemoveBreak off $row2 $col0 $row2 $col2
            ShowBreak $row2 $col0 $row2 $col2
        }
        if {$col2 < $::S(w)} {
            AddRemoveBreak off $row0 $col2 $row2 $col2
            ShowBreak $row0 $col2 $row2 $col2
        }
    } else {
        foreach {r c} $cells {
            set tag hidden,$r,$c
            set n [lsearch $::B(hiddenCells) $tag]
            if {$n == -1} {
                lappend ::B(hiddenCells) $tag
            }
        }
        AddRemoveBreak on $row0 $col0 $row0 $col2
        AddRemoveBreak on $row0 $col0 $row2 $col0
        AddRemoveBreak on $row2 $col0 $row2 $col2
        AddRemoveBreak on $row0 $col2 $row2 $col2
    }
    ShowAllBreaks
    ShowAllHiddenCells
    DrawBraid
}
##+##########################################################################
#
# HideCell -- Called when user clicks to toggle a cell's visibility
#
proc HideCell {tag} {
    global B S

    set n [lsearch $B(hiddenCells) $tag]
    if {$n > -1} {
        set B(hiddenCells) [lreplace $B(hiddenCells) $n $n]
        .c itemconfig $tag -fill $S(color,bg)
    } else {
        lappend B(hiddenCells) $tag
        .c itemconfig $tag -fill black
    }
    DrawBraid
}
##+##########################################################################
#
# ResizeCanvas -- Resize knoxel to best fit window, and computes centering info
#
proc ResizeCanvas {w h} {
    global S

    set dx [expr {($w - 2*$S(margin)) / $S(w)}]
    set dy [expr {($h - 2*$S(margin)) / $S(h)}]
    set S(boxSize) [expr {max(10,min($dx,$dy))}]
    set S(center,left) [expr {($w - 2*$S(margin) - $S(w)*$S(boxSize))/2}]
    set S(center,top) [expr {($h - 2*$S(margin) - $S(h)*$S(boxSize))/2}]

    DoCanvas
    DrawBraid
}
##+##########################################################################
#
# CellToXY -- Converts from row,col knoxel address to 2 pairs of x,y
# values: top left, bottom right
#
proc CellToXY {row col} {
    global S
    set x0 [expr {$S(margin) + $S(center,left) + $col * $S(boxSize)}]
    set y0 [expr {$S(margin) + $S(center,top) + $row * $S(boxSize)}]
    set x1 [expr {$x0 + $S(boxSize)}]
    set y1 [expr {$y0 + $S(boxSize)}]
    return [list $x0 $y0 $x1 $y1]
}
##+##########################################################################
#
# DrawKnoxel -- Draws all the compenents of a knoxel: the knots and the lines
#
proc DrawKnoxel {row col} {
    global S

    lassign [CellToXY $row $col] x0 y0 x1 y1
    lassign [CellToXY [expr {$row+1}] [expr {$col+1}]] . . x2 y2
    lassign [CellToXY [expr {$row-1}] [expr {$col-1}]] x3 y3
    set type [expr {($row % 2) == 0 ? "even" : "odd"}]
    set row1 [expr {$row+2}]
    set col1 [expr {$col+2}]

    # Top bar
    if {$col == $S(w)-1} {
        .c create line $x0 $y0 $x1 $y0 -fill gray80 \
            -width $S(lineWidth,off) -tag line
    } elseif {$col < $S(w)-1} {
        .c create line $x0 $y0 $x2 $y0 -fill $S(color,$type) \
            -width $S(lineWidth,off) \
            -tag [list line top$row,$col]
        .c bind top$row,$col <Enter> [list .c config -cursor $S(cursor)]
        .c bind top$row,$col <Leave> [list .c config -cursor {}]
        .c bind top$row,$col <1> [list DoClick toggle $row $col $row $col1]
    }
    if {$col == 1} {
        .c create line $x0 $y0 $x3 $y0 -fill gray80 -width $S(lineWidth,off) \
            -tag line
    }
    # Left bar
    if {$row == $S(h)-1} {
        .c create line $x0 $y0 $x0 $y1 -fill gray80 -width $S(lineWidth,off) \
            -tag line
    } elseif {$row < $S(h)-1} {
        .c create line $x0 $y0 $x0 $y2 -fill $S(color,$type) \
            -width $S(lineWidth,off) \
            -tag [list line left$row,$col]
        .c bind left$row,$col <Enter> [list .c config -cursor $S(cursor)]
        .c bind left$row,$col <Leave> [list .c config -cursor {}]
        .c bind left$row,$col <1> [list DoClick toggle $row $col $row1 $col]
    }
    if {$row == 1} {
        .c create line $x0 $y0 $x0 $y3 -fill gray80 -width $S(lineWidth,off) \
            -tag line
    }
    Marker $row $col
}
##+##########################################################################
#
# Diamond -- Returns xy of a diamond around a point
#
proc Diamond {x y d} {
    set r [expr {$d/2}]
    set x0 $x
    set y0 [expr {$y - $r}]
    set x1 [expr {$x + $r}]
    set y1 $y
    set x2 $x
    set y2 [expr {$y + $r}]
    set x3 [expr {$x - $r}]
    set y3 $y
    return [list $x0 $y0 $x1 $y1 $x2 $y2 $x3 $y3 $x0 $y0]
}
##+##########################################################################
#
# Marker -- Draws a marker at the top left of a given knoxel
#
proc Marker {row col} {
    set type [expr {($row % 2) == 0 ? "even" : "odd"}]
    lassign [CellToXY $row $col] x y
    set xy [Diamond $x $y $::S(dotSize)]
    set id [.c create poly $xy -fill $::S(color,$type) -outline black -width 2 \
                -tag marker]
    .c bind $id <1> [list HideKnoxel $row $col]
}
##+##########################################################################
#
# Reset -- Resets back to starting configuration
#
proc Reset {} {
    set ::B(braidWidth,perc) 40
    set ::B(show,marker) 1
    set ::B(show,break) 1
    set ::B(show,line) 1
    set ::B(show,braid) 1
    set ::B(show,hidden) 1

    ResetBreaks
    ShowAllBreaks
    ResetHiddenCells
    ShowAllHiddenCells
    DrawBraid
}
##+##########################################################################
#
# ResetBreaks -- Removes all but the outside breaks
#
proc ResetBreaks {} {
    global B S
    foreach break $B(breaks) {
        lassign [split $break ","] row0 col0 row1 col1
        DoClick off $row0 $col0 $row1 $col1
    }
    SetWallBreaks
}
##+##########################################################################
#
# SetWallBreaks -- Add breaks along the outer walls
#
proc SetWallBreaks {} {
    global S

    foreach row [list 0 $S(h)] {
        for {set col [expr {$row % 2}]} {$col < $S(w)} {incr col 2} {
            AddRemoveBreak on $row $col $row [expr {$col+2}]
        }
    }
    foreach col [list 0 $S(w)] {
        for {set row [expr {$col % 2}]} {$row < $S(h)} {incr row 2} {
            AddRemoveBreak on $row $col [expr {$row+2}] $col
        }
    }
}
##+##########################################################################
#
# ShowAllBreaks -- Displays all breaks in $B(breaks)
#
proc ShowAllBreaks {} {
    foreach break $::B(breaks) {
        lassign [split $break ","] row0 col0 row1 col1
        ShowBreak $row0 $col0 $row1 $col1
    }
}
##+##########################################################################
#
# ResetHiddenCells -- Removes all hidden cells
#
proc ResetHiddenCells {} {
    set ::B(hiddenCells) {}
}
##+##########################################################################
#
# ShowAllHiddenCells -- Hides all cells in $B(hiddenCells)
#
proc ShowAllHiddenCells {} {
    global B S
    .c itemconfig hidden -fill $S(color,bg)
    foreach tag $B(hiddenCells) {
        .c itemconfig $tag -fill black
    }
}
##+##########################################################################
#
# DoClick -- Handles clicking to create or remove a break
# NB. how == "toggle" is for user initiated events
#
proc DoClick {how row0 col0 row1 col1} {
    set showBraid 0
    if {$how eq "toggle"} {
        set how [expr {[BreakExists $row0 $col0 $row1 $col1] ? "off" : "on"}]
        set showBraid 1
    }
    AddRemoveBreak $how $row0 $col0 $row1 $col1
    ShowBreak $row0 $col0 $row1 $col1
    if {! $showBraid} return

    set h [expr {2 * int(($::S(h)+1)/2)}]
    set xrow0 [expr {$h - $row0}]
    set xrow1 [expr {$h - $row1}]
    lassign [lsort -integer [list $xrow0 $xrow1]] xrow0 xrow1
    set w [expr {2 * int(($::S(w)+1)/2)}]
    set xcol0 [expr {$w - $col0}]
    set xcol1 [expr {$w - $col1}]
    lassign [lsort -integer [list $xcol0 $xcol1]] xcol0 xcol1

    if {$::B(sym,hor)} {
        DoClick $how $row0 $xcol0 $row1 $xcol1
    }
    if {$::B(sym,ver)} {
        DoClick $how $xrow0 $col0 $xrow1 $col1
    }
    if {$::B(sym,hor) && $::B(sym,ver)} {
        DoClick $how $xrow0 $xcol0 $xrow1 $xcol1
    }
    DrawBraid
}
##+##########################################################################
#
# AddRemoveBreak -- Adds or removes a break, checking for crossing an
# existing break
#
proc AddRemoveBreak {action row0 col0 row1 col1} {
    global B

    set break "$row0,$col0,$row1,$col1"
    set n [lsearch $B(breaks) $break]
    if {$action eq "on"} {
        if {$n == -1} {
            lappend B(breaks) $break
        }
        RemoveCrossingBreak $row0 $col0 $row1 $col1
    } else {
        if {$n != -1} {
            set B(breaks) [lreplace $B(breaks) $n $n]
        }
    }
}
##+##########################################################################
#
# RemoveCrossingBreak -- Removes a crossing break if it exists
#
proc RemoveCrossingBreak {row0 col0 row1 col1} {
    global B
    if {$row0 == $row1} {
        set xrow0 [expr {$row0-1}]
        set xcol0 [expr {$col0+1}]
        set xrow1 [expr {$row0+1}]
        set xcol1 $xcol0
    } else {
        set xrow0 [expr {$row0+1}]
        set xcol0 [expr {$col0-1}]
        set xrow1 $xrow0
        set xcol1 [expr {$col0+1}]
    }
    set xbreak "$xrow0,$xcol0,$xrow1,$xcol1"
    set n [lsearch $B(breaks) $xbreak]
    if {$n > -1} {
        set B(breaks) [lreplace $B(breaks) $n $n]
        ShowBreak $xrow0 $xcol0 $xrow1 $xcol1
    }
}
##+##########################################################################
#
# BreakExists -- true if a given break exists
#
proc BreakExists {row0 col0 row1 col1} {
    global B

    set break "$row0,$col0,$row1,$col1"
    set n [lsearch $B(breaks) $break]
    return [expr {$n > -1}]
}
##+##########################################################################
#
# ShowBreak -- Draws a given break on the screen
#
proc ShowBreak {row0 col0 row1 col1} {
    global B

    set break "$row0,$col0,$row1,$col1"
    set n [lsearch $B(breaks) $break]
    set how [expr {$n > -1 ? "on" : "off"}]
    set which [expr {$row0 == $row1 ? "top" : "left"}]

    set type [expr {($row0 % 2) == 0 ? "even" : "odd"}]
    set clr [expr {$how == "on" ? "black" : $::S(color,$type)}]

    set tag $which$row0,$col0
    .c itemconfig $tag -fill $clr -width $::S(lineWidth,$how)
    if {$how eq "on"} {
        .c addtag break withtag $tag
        .c dtag $tag line
    } else {
        .c dtag $tag break
        .c addtag line withtag $tag
    }
    .c raise $tag line
    .c raise marker
}
##+##########################################################################
#############################################################################
#
# Color stuff
#

##+##########################################################################
#
# GetNColors -- Returns n colors evenly spaced around the HLS color model
#
proc GetNColors {n} {
    set inc [expr {1.0/$n}]
    set s 1.0
    set l 1.0

    set colors {}
    for {set i 0} {$i < $n} {incr i} {
        set h [expr {$::S(color,salt) + $i*$inc}]
        set h [expr {$h - int($h)}] ;# Normalize
        set rgb [hls2tk $h $l $s]
        lappend colors $rgb
    }
    return $colors
}
##+##########################################################################
#
# hls2rgb -- converts hls to float rgb
#
proc hls2rgb {h l s} {
    # h, l and s are floats between 0.0 and 1.0, ditto for r, g and b
    # h = 0   => red
    # h = 1/3 => green
    # h = 2/3 => blue

    set h6 [expr {($h-floor($h))*6}]
    set r [expr {  $h6 <= 3 ? 2-$h6
                            : $h6-4}]
    set g [expr {  $h6 <= 2 ? $h6
                            : $h6 <= 5 ? 4-$h6
                            : $h6-6}]
    set b [expr {  $h6 <= 1 ? -$h6
                            : $h6 <= 4 ? $h6-2
                            : 6-$h6}]
    set r [expr {$r < 0.0 ? 0.0 : $r > 1.0 ? 1.0 : double($r)}]
    set g [expr {$g < 0.0 ? 0.0 : $g > 1.0 ? 1.0 : double($g)}]
    set b [expr {$b < 0.0 ? 0.0 : $b > 1.0 ? 1.0 : double($b)}]

    set r [expr {(($r-1)*$s+1)*$l}]
    set g [expr {(($g-1)*$s+1)*$l}]
    set b [expr {(($b-1)*$s+1)*$l}]
    return [list $r $g $b]
}
##+##########################################################################
#
# hls2tk -- Converts hls to rgb format that tk understands
#
proc hls2tk {h l s} {
    set rgb [hls2rgb $h $l $s]
    set init "#"
    foreach c $rgb {
       set intc [expr {int($c * 256)}]
       if {$intc == 256} { set intc 255 }
       set c1 [format %02X $intc]
       append init $c1
    }
    return $init
}
##+##########################################################################
#
# NewColorSalt -- changes our color salt randomly for a new color scheme
#
proc NewColorSalt {} {
    set ::S(color,salt) [expr {$::S(color,salt) + .2 + .6*rand()}]
    set ::S(color,salt) [expr {$::S(color,salt) - int($::S(color,salt))}]
    DrawBraid
}

##+##########################################################################
#############################################################################
#
# Drawing Braid code
#

##+##########################################################################
#
# DrawBraid -- Draws all the braids
#
proc DrawBraid {} {
    .c delete braid
    InitKnoxels

    set paths {}
    while {1} {
        set start [FindAStart]
        if {$start eq ""} break
        set path [Walk $start]
        lappend paths $path
    }
    if {$::B(monochrome)} {
        set clr [lindex [GetNColors 1] 0]
        set colors [lrepeat [llength $paths] $clr]
    } else {
        set colors [GetNColors [llength $paths]]
    }

    set braidWidth [expr {$::S(boxSize) * $::B(braidWidth,perc) / 100}]
    set innerWidth [expr {$braidWidth/2}]
    foreach path $paths clr $colors {
        lassign $path xy vlist
        SaveKnoxelColor $vlist $clr
        if {! $::B(solid)} {
            .c create line $xy -tag braid -fill $::S(color,edge) \
                -width $braidWidth -smooth 1 -capstyle round
            .c create line $xy -tag braid -fill $clr \
                -width $innerWidth -smooth 1 -capstyle round
        } else {
            .c create line $xy -tag braid -fill $clr \
                -width $braidWidth -smooth 1 -capstyle projecting
        }
    }
    FixCrossings
    Hide
}
##+##########################################################################
#
# Walk -- Walks our knoxels from a given starting point. Handles braid
# leaving the board
#
proc Walk {start} {
    array set OPP {nw se  ne sw  sw ne  se nw}

    lassign [Walk2 $start] xy vlist
    lassign [lindex $vlist end] row col dir
    # See if off the board. If so, reverse from last good position and
    # double the first and last spline control points
    #if {$row < 0 || $row >= $::S(h) || $col < 0 || $col >= $::S(w)} {}
    if {$::K($row,$col,visited) == 2} {
        Unvisit $vlist

        lassign [lindex $vlist end-1] row col dir
        set newStart [list $row $col $OPP($dir)]
        lassign [Walk2 $newStart] xy vlist
        set pre [lrange $xy 0 1]
        set post [lrange $xy end-1 end]
        set xy [concat $pre $xy $post]
    }
    return [list $xy $vlist]
}

##+##########################################################################
#
# Walk2 -- Walks our knoxels from a given starting point
#
proc Walk2 {start} {
    global K

    set vector $start
    set xy [Visit $vector]
    set vlist [list $vector]
    while {1} {
        set next [NextKnoxel $vector]
        lappend vlist $next
        if {! [OkToVisit $next]} {
            break
        }
        lassign [Visit $next] x0 y0 x1 y1
        lappend xy $x1 $y1
        set vector $next
    }

    return [list $xy $vlist]
}
##+##########################################################################
#
# OkToVisit -- true if knoxel hasn't been visited yet. NB, outside K
# will be undefined
#
proc OkToVisit {vector} {
    global K
    lassign $vector row col
    if {! [info exists K($row,$col,visited)] || $K($row,$col,visited) > 0} {
        return false
    }
    return true
}
##+##########################################################################
#
# NextKnoxel -- walks to next knoxel cell bouncing off breaks as needed
#
proc NextKnoxel {vector} {
    global K

    array set DELTA {
        nw {-1 -1}
        ne {-1 1}
        sw {1 -1}
        se {1 1}
    }

    lassign $vector row col dir
    lassign $DELTA($dir) drow dcol
    set newDir $dir
    if {$dir in {nw ne} && ($K($row,$col) & 2)} { ;# Upper wall
        set drow 0
        set newDir [string replace $dir 0 0 "s"]
    }
    if {$dir in {sw se} && ($K($row,$col) & 8)} { ;# Lower wall
        set drow 0
        set newDir [string replace $dir 0 0 "n"]
    }
    if {$dir in {nw sw} && ($K($row,$col) & 1)} { ;# Left wall
        set dcol 0
        set newDir [string replace $dir 1 1 "e"]
    }
    if {$dir in {ne se} && ($K($row,$col) & 4)} { ;# Right wall
        set dcol 0
        set newDir [string replace $dir 1 1 "w"]
    }
    set row1 [expr {$row + $drow}]
    set col1 [expr {$col + $dcol}]
    return [list $row1 $col1 $newDir]
}
##+##########################################################################
#
# Visit -- Mark knoxel visited and return xy path through it
#
proc Visit {vector} {
    global K
    lassign $vector row col dir
    set K($row,$col,visited) 1
    lassign [CellToXY $row $col] x0 y0 x1 y1
    if {$dir eq "nw"} {
        set xy [list $x1 $y1 $x0 $y0]
    } elseif {$dir eq "ne"} {
        set xy [list $x0 $y1 $x1 $y0]
    } elseif {$dir eq "sw"} {
        set xy [list $x1 $y0 $x0 $y1]
    } elseif {$dir eq "se"} {
        set xy [list $x0 $y0 $x1 $y1]
    } else {
        puts stderr "bad dir: $dir"
        return
    }

    return $xy
}
##+##########################################################################
#
# Unvisit -- Removes visited bit for all cells on a path
#
proc Unvisit {vlist} {
    foreach knoxel $vlist {
        lassign $knoxel row col .
        if {[info exists ::K($row,$col,visited)] \
                && $::K($row,$col,visited) != 2} {
            set ::K($row,$col,visited) 0
        }
    }
}
##+##########################################################################
#
# FindAStart -- Find an unvisited knoxel as a starting point
#
proc FindAStart {} {
    global K S

    foreach knoxel [array names K *,visited] {
        if {$K($knoxel)} continue

        lassign [split $knoxel ","] row col
        set dir [expr {(($row+$col) % 2) == 0 ? "ne" : "nw"}]
        return [list $row $col $dir]
    }
    return [list]
}
##+##########################################################################
#
# SaveKnoxelColor -- Save color of braid through cell for later fake crossing
#
proc SaveKnoxelColor {vlist clr} {
    foreach cell $vlist {
        lassign $cell row col
        set ::K($row,$col,color) $clr
    }
}
##+##########################################################################
#
# InitKnoxels -- Initializes the K (knoxel) array needed for braid walking
#
proc InitKnoxels {} {
    global S B K

    unset -nocomplain K
    for {set row 0} {$row < $S(h)} {incr row} {
        for {set col 0} {$col < $S(w)} {incr col} {
            set K($row,$col) 0
            set K($row,$col,visited) 0
        }
    }
    # Mark outside boxes
    foreach row [list -1 $S(h)] {
        for {set col -1} {$col <= $S(w)} {incr col} {
            set K($row,$col,visited) 2
        }
    }
    foreach col [list -1 $S(w)] {
        for {set row -1} {$row <= $S(h)} {incr row} {
            set K($row,$col,visited) 2
        }
    }

    foreach hidden $B(hiddenCells) {
        lassign [split $hidden ","] . row col
        set K($row,$col,visited) 2
    }

    foreach break $B(breaks) {
        lassign [split $break ","] row0 col0 row1 col1
        if {$row0 == $row1} {
            set above [expr {$row0 - 1}]
            set below $row0
            set left $col0
            set right [expr {$col0 + 1}]
            incr K($above,$left) 8
            incr K($below,$left) 2
            incr K($above,$right) 8
            incr K($below,$right) 2
        } else {
            set above $row0
            set below [expr {$row0 + 1}]
            set left [expr {$col0 - 1}]
            set right $col0

            incr K($above,$left) 4
            incr K($below,$left) 4
            incr K($above,$right) 1
            incr K($below,$right) 1
        }
    }
}
##+##########################################################################
#
# Hide -- Hides or shows various knoxel elements
#
proc Hide {} {
    global B
    set B(show,marker) $B(show,line)
    set B(show,hidden) $B(show,break)
    set who {hidden line break marker braid}
    .c raise bg
    foreach type $who {
        if {$B(show,$type)} {
            .c raise $type
        }
    }
    .c itemconfig braid -splinesteps $B(corners)
}
##+##########################################################################
#
# FixCrossings -- Fix up interleave line crossings
#
proc FixCrossings {} {
    global S K

    for {set row 0} {$row < $S(h)-1} {incr row} {
        set row1 [expr {$row+1}]
        for {set col [expr {($row+1) % 2}]} {$col < $S(w)-1} {incr col 2} {
            # Check if this cell has no right or bottom walls
            if {($K($row,$col) & (4 + 8)) == 0} {
                FakeCrossing $row $col
            }
        }
    }
}
##+##########################################################################
#
# FakeCrossing -- Draw the crossing from this cell to the one down and
# right.  We fake it by overlaying a short line segment in the correct
# color and direction.
#
proc FakeCrossing {row col} {
    lassign [CellToXY $row $col] . . x y

    set braidWidth [expr {$::S(boxSize) * $::B(braidWidth,perc) / 100}]
    set innerWidth [expr {$braidWidth/2}]

    set delta [expr {($braidWidth+1)/2}]
    set x0 [expr {$x - $delta}]
    set y0 [expr {$y - $delta}]
    set x1 [expr {$x + $delta}]
    set y1 [expr {$y + $delta}]
    set row1 [expr {$row+1}]
    set col1 [expr {$col+1}]

    if {($col % 2) == 0} {
        # NE crossing
        set xy [list $x0 $y1 $x1 $y0]
        set row1 [expr {$row+1}]
        set cells [list $row1 $col $row $col1]
    } else {
        # NW crossing
        set xy [list $x0 $y0 $x1 $y1]
        set cells [list $row $col $row1 $col1]
    }

    foreach {r c} $cells {
        if {$::K($r,$c,visited) == 2} {
            return
        }
    }

    foreach {r c} $cells {
        if {[info exists ::K($r,$c,color)]} {
            set clr $::K($r,$c,color)
            break
        }
    }
    if {$clr eq ""} {
        puts stderr "ERROR: no color found for crossing $row,$col ($cells)"
        return
    }

    if {! $::B(solid)} {
        .c create line $xy -tag {braid crossing} -fill $::S(color,edge) \
            -width $braidWidth
        .c create line $xy -tag {braid crossing} -fill $clr -width $innerWidth
    } else {
        .c create line $xy -tag {braid crossing} -fill $clr -width $braidWidth
    }
}

#############################################################################
#############################################################################

##+##########################################################################
#
# NewSize -- Displays a dialog to resize the grid
#
proc NewSize {} {
    if {[winfo exists .sizer]} return

    set ::S(new,width) $::S(w)
    set ::S(new,height) $::S(h)

    ::ttk::labelframe .sizer -text Resize
    ::ttk::labelframe .sizer.w -text "Width" -relief flat
    scale .sizer.w.s -from 2 -to 30 -variable ::S(new,width) -orient h \
        -showvalue 0 \
        -command {apply {{val} { .sizer.w config -text "Width: $val" }}}
    pack .sizer.w.s -fill both -expand 1
    ::ttk::labelframe .sizer.h -text "Height" -relief flat
    scale .sizer.h.s -from 2 -to 30 -variable ::S(new,height) -orient h \
        -showvalue 0 \
        -command {apply {{val} { .sizer.h config -text "Height: $val" }}}
    pack .sizer.h.s -fill both -expand 1
    pack .sizer.w .sizer.h -side top -fill x

    ::ttk::button .sizer.ok -text "Go" -command [list NewSizeDone .sizer 1]
    ::ttk::button .sizer.cancel -text "Cancel" \
        -command [list NewSizeDone .sizer 0]
    pack .sizer.ok .sizer.cancel -side left -pady .2i -expand 1

    place .sizer -in . -relx 1 -rely 1 -anchor se
    button .sizer.kill -image ::img::chi -command [list NewSizeDone .sizer 0]
    place .sizer.kill -relx 1 -rely 0 -anchor ne -bordermode outside
}
##+##########################################################################
#
# NewSizeDone -- Called when user is done with the resize dialog
#
proc NewSizeDone {w how} {
    destroy $w
    if {$how} {
        set ::S(w) $::S(new,width)
        set ::S(h) $::S(new,height)
        ResetBreaks
        ResetHiddenCells
        ResizeCanvas [winfo width .c] [winfo height .c]

        .ctrl.symmetry.sym,hor config -state \
            [expr {($::S(w) % 2) == 0 ? "normal" : "disabled"}]
        .ctrl.symmetry.sym,ver config -state \
            [expr {($::S(h) % 2) == 0 ? "normal" : "disabled"}]
        set ::B(sym,hor) [expr {$::B(sym,hor) && ($::S(w) % 2) == 0}]
        set ::B(sym,ver) [expr {$::B(sym,ver) && ($::S(h) % 2) == 0}]
    }
}
##+##########################################################################
#
# ScreenShot -- Takes and saves a screenshot of the braid
#
proc ScreenShot {} {
    catch {image delete ::img::screen}
    image create photo ::img::screen -data .c
    set fname [tk_getSaveFile -defaultextension .png \
                   -title "Save $::S(title) As" \
                   -filetypes {{"PNG Files" .png} {"All Files" .*}}]
    if {$fname ne ""} {
        ::img::screen write $fname -format png
    }
    image delete ::img::screen
}
if {[lsearch [image names] ::img::chi] == -1} {
    image create bitmap ::img::chi -data {
        #define x_width 7
        #define x_height 7
        static char x_bits = {
            0x63, 0x77, 0x3e, 0x1c, 0x3e, 0x77, 0x63
        }
    }
}
proc About {} {
    set title "$::S(title)\n"
    append title "by Keith Vetter, May, 2013\n"
    append title "\n"

    set msg ""
    append msg "This program draws a web of interlacing lines forming a\n"
    append Msg "Celtic Knot.\N"
    append msg "\n"
    append msg "To create a new Celtic Knot, click on a red or green line\n"
    append msg "to create breaks. The breaks alter the paths of the lines\n"
    append msg "forming the knot\n"
    append msg "\n"
    append msg "You can also click in a cell to exclude it from the Celtic\n"
    append msg "Knot. Visually this works best if you surround excluded cells\n"
    append msg "with breaks. Clicking again restores it.\n"
    append msg "\n"
    append msg "For details for how the knot is created, checkout\n"
    append msg "http://isotropic.org/celticknot/."

    if {$::tcl_platform(platform) eq "unix"} {
        set msg [string map {\n\n \x01} $msg]
        regsub -all { *\n *} $msg " " msg
        set msg [string map {\x01 \n\n} $msg]
    }
    tk_messageBox -title $::S(title) -icon info -message "$title$msg"
}

################################################################

DoDisplay

return