[Arjen Markus] ( 23 april 2003) I needed a break and decided to browse around at Mathworld [http://mathworld.wolfram.com]. I stumbled on the page describing ''Strang's strange figures'' and found a few nice figures. After reading the text I thought that it would be very easy to do this in Tcl. And indeed, it is very easy. See for yourself.

(So easy in fact, that I did bother breaking the script down into procs ...)

Note, the patterns are akin to Moire patterns

[WikiDbImage strang.jpg]
----
 # Strang's strange patterns ...

 canvas .c -width 600 -height 450 -background white
 pack   .c -fill both

 for { set i 0 } { $i < 3600 } { incr i } {
    set sini [expr {225+200.0*sin($i)}]
    set tani [expr {225+100.0*tan($i)}]
    set i2   [expr {$i/6}]
    .c create rectangle $i2 $sini [expr {$i2+1}] [expr {$sini+1}] -outline red
    .c create rectangle $i2 $tani [expr {$i2+1}] [expr {$tani+1}] -outline blue
 }

----
[AM] (22 september 2009) Here is a short program that produces Moire patterns in a slightly hypnotic way - just for fun.

======
# moire.tcl --
#     Experiment with Moire patterns
#
pack [canvas .c -bg white -width 500 -height 500]

set xcentre 250
set ycentre 250

for {set i 1} {$i < 20} {incr i} {
    set xul [expr {$xcentre - $i * 10}]
    set yul [expr {$ycentre - $i * 10}]
    set xbr [expr {$xcentre + $i * 10}]
    set ybr [expr {$ycentre + $i * 10}]

    .c create oval $xul $yul $xbr $ybr -width 3             -outline blue
    .c create oval $xul $yul $xbr $ybr -width 3 -tag moving  -outline green
    .c create oval $xul $yul $xbr $ybr -width 3 -tag moving2 -outline red
}

set time 0.0
set dtime 0.02

proc position {time} {
    set twopi [expr {8.0*atan(1.0)}]

    # Note: incommensurable periods - so the pattern is not exactly repeating ...
    set x [expr {4.0 * cos($twopi*$time)}]
    set y [expr {4.0 * sin(1.4*$time)}]

    return [list $x $y]
}

proc moveCircles {} {

    global time
    global dtime

    foreach {xold yold}   [position  $time] {break}
    foreach {xold2 yold2} [position -$time] {break}
    set time [expr {$time + $dtime}]
    foreach {xnew ynew}   [position  $time] {break}
    foreach {xnew2 ynew2} [position -$time] {break}

    .c move moving  [expr {$xnew-$xold}]   [expr {$ynew-$yold}]
    .c move moving2 [expr {$xnew2-$xold2}] [expr {$ynew2-$yold2}]

    after 10 moveCircles
}

moveCircles 
======
----
[[
[Category Mathematics] |
[Category Graphics]
]]