[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.

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.

======
 ##+##########################################################################
 #
 # 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 t 2 a 0 stepping 0 pos 0 ready 0}
 array set LEN2RADIUS {
     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 700 -height 700] -side top -fill both -expand 1

    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 .sT -var ::SZ(t) -orient h -relief ridge -command Config -from 1 -to 10 -label Thickness
    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}
    button .about -text "?" -font {Times 18 bold} -command About

    pack .sN .sL .sW .sC .sT .sA -side left -in .buttons
    pack forget .sT
    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]
 }
 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}]]
 }
 proc About {} {
    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

    set adj -90
    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(t)
        }
    }
 }
 proc DoLines {last} {
    for {set i $::SZ(pos)} {$i < $last} {incr i} {
        DoOneLine [lindex $::LINES $i]
    }
    set ::SZ(pos) $i
 }
 proc Clear {} { .c delete all ; set ::SZ(pos) 0 }

 proc DoStep {how} {
    if {$how eq "toggle"} {
        Clear
        DoLines [expr {$::SZ(stepping) ? 1 : $::SZ(numSteps)}]
    } else {
        set last [expr {$::SZ(pos) + 1}]
        if {$last > $::SZ(numSteps)} {
            Clear
            set last 1
        }
        DoLines $last
    }
 }
 proc Config {args} {
    if {! $::SZ(ready)} return

    set pos $::SZ(pos)
    Clear
    GetPoints
    DoLines [expr {$::SZ(stepping) ? $pos : $::SZ(numSteps)}]
 }

 DoDisplay
 set SZ(ready) 1
 Config
 return
======
!!!!!!
%| [Category Graphics] | [Category Application] |%
!!!!!!