Møiré Patterns
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. https://wiki.tcl-lang.org/Møiré fails, and shows as https://wiki.tcl-lang.org/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, ...
[It originally named a mohair-based fabric.]
[Do non-USAicans "get" "When the Loom Hits Your Eye, That's a Moiré!"?]
Only if-a it's a big-a pizza pie... =)
15nov02 kpv - I emailed the Mathworld folks and they acknowledged their mistake and they're going to change the spelling on their web site in the next release.
##+####################################################################
#
# 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 Redrawuniquename 2013jul29
In case the image above disappears from the 'imageshack' site at which it is hosted, here is a 'locally stored' image of Vetter's Moire Pattern GUI:
(Thanks to 'gnome-screenshot', 'mtpaint', and ImageMagick 'convert' on Linux for, respectively, capturing the image to a PNG file, cropping the image, and converting the PNG file to a JPEG file that was about 25% smaller. Thanks to FOSS developers everywhere.)
This image is how the GUI looks when it first starts up --- i.e. this is the Moire pattern that is shown before any fiddling with the control widgets.
Jeff Smith 2021-07-14 : Below is an online demo using CloudTk. This demo runs "Møiré Patterns" in an Alpine Linux Docker Container. It is a 27.4MB image which is made up of Alpine Linux + tclkit + Moire-Patterns.kit + libx11 + libxft + fontconfig + ttf-linux-libertine. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories.