## Celtic Braid

Keith Vetter 2007-11-17 : Here's a little program that draws one of my favorite doodle patterns. Someone taught me the 4-sided version a long time ago, and I've been tinkering with it ever since, generalizing to any number of sides.

It may seem quite complicated but it's actually quite easy to draw if one knows the correct sequence. The Single Step option shows that correct sequence. It now highlights each step in drawing this pattern.

At higher number of sides, space gets quite limited and you need to carefully adjust the parameters to keep lines from overlapping. I leave it as an exercise to the reader to write the code that detects overlap and automatically adjusts the numbers.

kpv 2014-04-16: I just found out the proper name for this shape is Solomon's knot

``` ##+##########################################################################
#
# CelticBraid.tcl -- draws an intertwined latice pattern
# by Keith Vetter, November 2007
#

package require Tk
array set SZ {title "Celtic Braid" N 4 l 100 w 50 c 50 a 0 stepping 0 pos 0
ready 0 clr,0 black clr,1 red width,0 2 width,1 4}
3 0.57735026919  4 0.707106781187 5 0.850650808352 6 1.0
7 1.15238243548  8 1.30656296488  9 1.46190220008 10 1.61803398875
11 1.77473276644 12 1.93185165258 13 2.08929073443 14 2.24697960372
15 2.40486717237 16 2.56291544774 17 2.72109557588 18 2.87938524157
19 3.03776691049 20 3.19622661075 21 3.35475306990 22 3.51333709167
23 3.67197109805 24 3.83064878777 25 3.98936487778 26 4.14811490528
27 4.30689507424 28 4.46570213519 29 4.62453329015 30 4.78338611675
}
set LINES {
{{1 0 0}} {{0 0 1}} {{1 1 2}}
{{0 1 3} {1 3 5} {0 4 5}}
{{0 2 7} {1 6 7} {0 2 6}}
}
set SZ(numSteps) [llength \$LINES]

proc DoDisplay {} {
wm title . \$::SZ(title)
pack [frame .buttons] -side bottom
pack [canvas .c -width 600 -height 600] -side top -fill both -expand 1
.c create text 0 0 -anchor n -text \$::SZ(title) -font {Helvetica 24 bold} -tag title

scale .sN -var ::SZ(N) -orient h -relief ridge -command Config -from 3 -to 15 -label Sides
scale .sL -var ::SZ(l) -orient h -relief ridge -command Config -from 1 -to 200 -label Length
scale .sW -var ::SZ(w) -orient h -relief ridge -command Config -from 1 -to 100 -label Width
scale .sC -var ::SZ(c) -orient h -relief ridge -command Config -from 0 -to 100 -label Gap
scale .sA -var ::SZ(a) -orient h -relief ridge -command Config -from -180 -to 180 -label Rotation

checkbutton .stepping -text "Single Step" -variable ::SZ(stepping) \
-relief raised -command {DoStep toggle}
button .step -text "Next Step" -command {DoStep step} -state disabled

pack .sN .sL .sW .sC .sA -side left -in .buttons
pack .about -side right -fill y -in .buttons
pack .stepping .step -side top -in .buttons -fill x -expand 1 -padx 10
bind .c <Configure> {ReCenter %W %h %w}
update
}
proc ReCenter {W h w} {                         ;# Called by configure event
set h2 [expr {\$h / 2}] ; set w2 [expr {\$w / 2}]
\$W config -scrollregion [list -\$w2 -\$h2 \$w2 \$h2]
\$W coords title 0 -\$h2
}
proc VAdd {A B {scalar 1}} {
foreach {ax ay} \$A {bx by} \$B break
return [list [expr {\$ax + \$scalar * \$bx}] [expr {\$ay + \$scalar * \$by}]]
}
proc VRescale {A len} {
foreach {x y} \$A break
set n [expr {hypot(\$x,\$y)}]
return [list [expr {\$x * \$len / \$n}] [expr {\$y * \$len / \$n}]]
}
set msg "\$::SZ(title)\nby Keith Vetter, November 2007\n\n"
append msg "These are some of my favorite doodling shapes for\n"
append msg "boring meetings. Someone taught me a long time\n"
append msg "ago how to draw the 4-sided version and I quickly\n"
append msg "generalized it to any number of sides.\n\n"
append msg "This seemingly complicated pattern is actually quite\n"
append msg "easy to draw if you proceed by a series of simple\n"
append msg "steps. The 'Single Step' option shows you those\n"
append msg "simple steps.\n\n"
append msg "For higher number of sides, you have to carefully\n"
append msg "adjust the parameters to keep lines from overlapping."
tk_messageBox -title "About \$::SZ(title)" -message \$msg
}
proc Debug {{filter *}} {
foreach p [array names ::P \$filter] {
foreach {x y} \$::P(\$p) break
set xy [list [expr {\$x-2}] [expr {\$y-2}] [expr {\$x+2}] [expr {\$y+2}]]
.c create oval \$xy -fill yellow
.c create text \$x \$y -text \$p -anchor se
}
}
proc GetCenterPoly {} {
global SZ P

if {\$SZ(N) == 4} { set adj -45 }
if {\$SZ(N) == 5} { set adj 18 }
set a [expr {\$SZ(a) + \$adj}]
set da [expr {360. / \$SZ(N)}]
set SZ(r) [expr {\$SZ(l) * \$::LEN2RADIUS(\$SZ(N))}]
for {set i 0} {\$i < \$SZ(N)} {incr i} {
set rad [expr {(\$a + \$i*\$da) * acos(-1) / 180}]
set x [expr {\$SZ(r) * cos(\$rad)}]
set y [expr {\$SZ(r) * sin(\$rad)}]
set P(\$i,0) [list \$x \$y]
}
}
proc GetPoints {} {
global V P SZ

GetCenterPoly
for {set i 0} {\$i < \$SZ(N)} {incr i} {
set V(\$i) [VRescale [VAdd \$P(\$i,0) \$P([expr {(\$i-1) % \$SZ(N)}],0) -1] 1]
}
set V(\$SZ(N)) \$V(0)

for {set i 0} {\$i < \$SZ(N)} {incr i} {
set i1 [expr {\$i+1}]
set P(\$i,1) [VAdd \$P(\$i,0) \$V(\$i) \$SZ(w)]
set P(\$i,2) [VAdd \$P(\$i,1) \$V(\$i1) -\$SZ(w)]
set P(\$i,3) [VAdd \$P(\$i,1) \$V(\$i) \$SZ(c)]
set P(\$i,4) [VAdd \$P(\$i,0) \$V(\$i1) -\$SZ(w)]
set P(\$i,5) [VAdd \$P(\$i,4) \$V(\$i1) -\$SZ(c)]
set P(\$i,6) [VAdd \$P(\$i,2) \$V(\$i) [expr {\$SZ(c) + \$SZ(w)}]]
set P(\$i,7) [VAdd \$P(\$i,2) \$V(\$i1) [expr {-(\$SZ(c) + \$SZ(w))}]]
}
}
proc DoOneLine {lines} {
foreach line \$lines {
foreach {di p1 p2} \$line break
for {set i 0} {\$i < \$::SZ(N)} {incr i} {
set i2 [expr {(\$i + \$di) % \$::SZ(N)}]
set xy [concat \$::P(\$i,\$p1) \$::P(\$i2,\$p2)]
.c create line \$xy -width \$::SZ(width,\$::SZ(stepping)) \
-fill \$::SZ(clr,\$::SZ(stepping)) -tag line
}
}
}
proc DoLines {last} {
.c itemconfig line -width \$::SZ(width,0) -fill \$::SZ(clr,0)
for {set i \$::SZ(pos)} {\$i < \$last} {incr i} {
DoOneLine [lindex \$::LINES \$i]
}
set ::SZ(pos) \$i
}
proc Clear {} { .c delete line ; set ::SZ(pos) 0 }

proc DoStep {how} {
if {\$how eq "toggle"} {
Clear
DoLines [expr {\$::SZ(stepping) ? 1 : \$::SZ(numSteps)}]
.step config -state [expr {\$::SZ(stepping) ? "normal" : "disabled"}]
} else {
set last [expr {\$::SZ(pos) + 1}]
if {\$last > 1+\$::SZ(numSteps)} {
Clear
set last 1
}
DoLines \$last
}
}
proc Config {args} {

set pos \$::SZ(pos)
Clear
GetPoints
if {\$::SZ(stepping)} {
DoLines [expr {\$pos-1}]
DoLines \$pos
} else {
DoLines \$::SZ(numSteps)
}
}

DoDisplay
Config
return
```

### Screenshots Section

`   #!/usr/bin/wish`