Version 8 of Møiré Patterns

Updated 2002-11-15 14:37:58

Keith Vetter 2002-11-14 - This program lets you generate and see various M�ir� patterns. These are interference patterns produced by overlaying similar but slightly offset templates. They also arise from the descrete nature of computer screens. The word M�ir� was first used by weavers and comes from the word mohair, a kind of cloth made from the fine hair of an Angora goat.

This program lets you choose the base and foreground template to be one of parallel lines, radial lines or concentric circles along with the color, lines size and line spacing. When you press the start button, the foregroung pattern rotates or shifts producing changing M�ir� patterns. You can also grab and drag the hour hand in clock face to control the orientation.

Enjoy.

AM Just a few comments: I think the proper spelling is Moir�, as the French language has no "�" :)

Another, more frequent, mistake is to categorise the patterns as "interference" patterns, this term is reserved for waves cancelling and enhancing each other due to phase difference. Moir� patterns are examples of diffraction. But, apart from that, they are beautiful, fascinating and sometimes annoying. I like this application.

15nov02 jcw - But it's good to see that extended characters are now working properly in wikit/tclkit, both in titles and in the pages themselves. Unfortunately, searches do not yet seem to work, i.e. http://mini.net/tcl/M�ir� fails, and shows as http://mini.net/tcl/M%BFir%8E once the search returns. Or maybe that's just my Mac OSX setup? Agree on spelling being "Moir�", btw.

15nov02 NEM - Added "interp alias {} = {} expr" to make this work.

15nov02 KPV - I based both the spelling and the definition on what it said at Mathworld [L1 ], namely that it's spelt M�ir� and that it's an interference pattern. Unfortunately, the OED says it's Moir�. But, while it's definetion says nothing about interference or diffraction, it's first usage citation reads: Chambers's Techn. Dict. (1940) says arising from interference between two line-screens.

CL asserts that Mathworld is simply wrong, and that the patterns can be achieved as interference, diffraction, or through other phenomena. Moreover, ...

[Do non-USAicans "get" "When the Loom Hits Your Eye, That's a Moir�!"?]


 ##+####################################################################
 #
 # moire.tcl
 #
 # M�ir� Pattern -- An interference pattern produced by overlaying
 # similar but slightly offset templates.
 # by Keith Vetter
 #
 # Revisions:
 # KPV Nov 14, 2002 - initial revision
 #
 ##+####################################################################
 #######################################################################

 set S(title) "M�ir� Pattern"
 set S(version) 1.0
 array set S {stop 0 angle -14 anim 0 speed Fastest step 1}
 array set SS {b,type "Radial Lines" b,spacing 3 b,color Red b,size 1}
 array set SS {f,type "Radial Lines" f,spacing 3 f,color Blue f,size 1}
 array set Speeds {Slowest 400 Slower 200 Medium 100 Faster 50 Fastest 1}
 array set fptr {"Parallel Lines" Parallel "Radial Lines" Radial \
                    Circles Circles}
 set Csz 500                                     ;# Canvas initial size
 set Csz2 [expr {round($Csz / 3)}]
 interp alias {} = {} expr
 set DEG2RAD [= {4*atan(1)*2/360}]

 ##+####################################################################
 #
 # Anim -- Animates our display
 #
 proc Anim {} {
    global S Speeds

    while {1} {
        if {[incr S(angle) $S(step)] > 360} {incr S(angle) -360}
        Show f $S(angle)
        ShowAngle $S(angle)
        update
        if {$S(anim) == 0} break
        after $Speeds($S(speed))
    }
 }
 ##+####################################################################
 #
 # Parallel -- Draws parallel lines at a given angle
 #
 proc Parallel {who angle} {
    global Csz2 SS

    .c delete $who
    foreach a {spacing size color} {set $a $SS($who,$a)}
    set x0 [expr {- $Csz2}]
    set y0 -4000
    set y1 4000
    set theta [expr {$::DEG2RAD * $angle}]

    for {set x $x0} {$x <= $Csz2} {incr x $spacing} {
        set xy [Twist $theta $x $y0 $x $y1]
        .c create line $xy -tag $who -fill $color -width $size
    }
 }
 ##+####################################################################
 #
 # Radial -- Draws a rayed figure, here angle equals x offset
 #
 proc Radial {who angle} {
    global Csz2 SS

    .c delete $who
    foreach a {spacing size color} {set $a $SS($who,$a)}
    for {set a 0} {$a <= 360} {incr a $spacing} {
        set xy [Twist [expr {$a * $::DEG2RAD}] 0 4000 0 -4000]
        set xy [eval Shift $angle $xy]
        .c create line $xy -tag $who -fill $color -width $size
    }
 }
 ##+####################################################################
 #
 # Circles -- draws expanding concentric circls, here angle equals x offset
 #
 proc Circles {who angle} {
    global Csz2 SS

    .c delete $who
    foreach a {spacing size color} {set $a $SS($who,$a)}
    for {set r 0} {$r <= 2*$Csz2} {incr r $spacing} {
        set xy [Shift $angle -$r -$r $r $r]
        .c create oval $xy -outline $color -tag $who -width $size
    }
 }
 ##+####################################################################
 #
 # Show -- draws the requested type of figure for $who at angle $angle
 #
 proc Show {who angle} {
    $::fptr($::SS($who,type)) $who $angle
 }
 ##+####################################################################
 #
 # Twist -- rotates x,y points by angle theta (in radians)
 #
 proc Twist {theta args} {
    set c [expr {cos($theta)}]
    set s [expr {sin($theta)}]
    set xy {}
    foreach {x y} $args {
        lappend xy [expr {$c*$x + $s*$y}] [expr {$s*$x - $c*$y}]
    }
    return $xy
 }
 ##+####################################################################
 #
 # Shift -- shifts in the x axis, angle runs from 0-360
 #
 proc Shift {n args} {
    set dx [expr {$n<=90 ? -$n : $n<=270 ? $n-180 : 360-$n}]

    set result {}
    foreach {x y} $args {
        lappend xy [expr {$x + $dx}] $y
    }
    return $xy
 }
 ##+####################################################################
 #
 # Recenter -- keeps 0,0 at the center of the canvas during resizing
 #
 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]
 }
 ##+####################################################################
 #
 # Go -- starts, stops or steps our animation
 #
 proc Go {how} {
    global S

    if {$S(anim)} {                             ;# Animating so stop it
        set S(anim) 0
        .go config -text "Start"
        .step config -state normal
        .stepb config -state normal
        return
    }
    if {$how == 0} {                            ;# Forever
        set S(anim) 1
        .go config -text "Stop"
        .step config -state disabled
        .stepb config -state disabled
    } elseif {$how == -1} {                     ;# Backwards
        incr S(angle) [expr {-2 * $S(step)}]
    }
    Anim
 }
 ##+####################################################################
 #
 # Redraw -- Erases and redraws our display
 #
 proc Redraw {args} {
    Show b 0
    Show f $::S(angle)
    ShowAngle $::S(angle)
 }
 ##+####################################################################
 #
 # DoDisplay -- puts up our GUI
 #
 proc DoDisplay {} {
    global Csz S

    wm title . $S(title)
    frame .f -bd 2 -relief ridge
    canvas .c -width $Csz -height $Csz -bd 2 -relief ridge -bg white \
        -highlightthickness 0
    .c xview moveto 0 ; .c yview moveto 0
    bind .c <Configure> {ReCenter %W %h %w}

    MakeClock
    catch {image create photo ::img::blank -width 1 -height 1}
    set colors {Red Orange Yellow Green Cyan Blue Purple Magenta White Black}
    set types [list "Parallel Lines" "Radial Lines" Circles]

    myOptMenu .f1 "Type 1"    SS(b,type) $types
    myOptMenu .f2 "Type 2"    SS(f,type) $types
    myOptMenu .f3 "Spacing 1" SS(b,spacing) 2 3 4 5 6 7 8 9
    myOptMenu .f4 "Spacing 2" SS(f,spacing) 2 3 4 5 6 7 8 9
    myOptMenu .f5 "Size 1"    SS(b,size) 1 2 3 4
    myOptMenu .f6 "Size 2"    SS(f,size) 1 2 3 4
    myOptMenu .f7 "Color 1"   SS(b,color) $colors
    myOptMenu .f8 "Color 2"   SS(f,color) $colors
    myOptMenu .f9 Speed       S(speed) Fastest Faster Medium Slower Slowest

    button .go -text Start -command {Go 0}
    button .step -text "Step Forward" -command {Go 1}
    button .stepb -text "Step Back" -command {Go -1}
    button .about -image ::img::blank -command About -highlightthickness 0

    pack .f -side right -fill y -ipadx 5 -ipady 5
    pack .c -side top -fill both -expand 1

    set row -1
    grid rowconfigure .f [incr row] -minsize 5
    grid .f1 - - -in .f -sticky ew -pady 1 -row [incr row]
    grid .f2 - - -in .f -sticky ew -pady 1 -row [incr row]
    grid .f3 - - -in .f -sticky ew -pady 1 -row [incr row]
    grid .f4 - - -in .f -sticky ew -pady 1 -row [incr row]
    grid .f5 - - -in .f -sticky ew -pady 1 -row [incr row]
    grid .f6 - - -in .f -sticky ew -pady 1 -row [incr row]
    grid .f7 - - -in .f -sticky ew -pady 1 -row [incr row]
    grid .f8 - - -in .f -sticky ew -pady 1 -row [incr row]
    grid .f9 - - -in .f -sticky ew -pady 20 -row [incr row]
    grid rowconfigure .f [incr row] -minsize 5
    grid x .go x    -in .f -sticky ew -pady 1 -row [incr row]
    grid x .step x  -in .f -sticky ew -pady 1 -row [incr row]
    grid x .stepb x -in .f -sticky ew -pady 1 -row [incr row]
    grid rowconfigure .f [incr row] -weight 1
    grid x .clock x -in .f -pady 5 -row [incr row]

    place .about -in .f -relx 1 -rely 1 -anchor se
 }
 ##+####################################################################
 #
 # myOptMenu - creates a label and optionMenu combination
 #
 proc myOptMenu {f lbl var args} {
    if {[llength $args] == 1} {set args [lindex $args 0]}

    frame $f -bd 2 -relief raised
    label $f.lbl -text " $lbl" -bd 0 -anchor w
    eval tk_optionMenu $f.opt $var $args
    $f.opt config -bd 0 -highlightthickness 0 -width 10
    pack $f.lbl -side left -fill x -expand 1
    pack $f.opt -side right
    return $f
 }
 proc About {} {
    tk_messageBox -icon info -parent . -title "About $::S(title)" \
        -message "$::S(title)\n\nby Keith Vetter\nNovember, 2002"
 }
 ##+####################################################################
 #
 # MakeClock -- draws our clock face that shows the angle
 #
 proc MakeClock {} {
    catch {destroy .clock}
    canvas .clock -width 81 -height 81 -highlightthickness 0 -bd 0
    .clock config -scrollregion {-40 -40 40 40}
    .clock create oval -40 -40 40 40
    .clock create oval -3 -3 3 3 -fill black
    .clock bind hand <B1-Motion> {MoveHand %x %y}
 }
 ##+####################################################################
 #
 # ShowAngle -- displays a clock hand at a given angle
 #
 proc ShowAngle {angle} {
    set xy [Twist [expr {$::DEG2RAD * $angle}] 0 0 0 40]
    .clock delete hand
    .clock create line $xy -tag hand -width 3 -arrow last
 }
 ##+####################################################################
 #
 # MoveHand -- binding to let user move clock and the animation angle
 #
 proc MoveHand {x y} {
    global S
    set x [.clock canvasx $x] ; set y [.clock canvasy $y]

    if {$x == 0 && $y == 0} return
    set theta [expr {round(atan2 ($x, -$y) / $::DEG2RAD)}]
    if {$theta < 0} {incr theta 360}
    set S(angle) $theta
    Show f $S(angle)

    set xy [Twist [expr {$theta * $::DEG2RAD}] 0 0 0 40]
    .clock coords hand $xy
 }
 ##########################################################
 ##########################################################
 ##########################################################
 DoDisplay
 Redraw
 trace variable SS w Redraw

Category graphics