fails, and shows as http://wiki.tcl.tk/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 [1], 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 2013jul29In 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:
