##+####################################################################
#
# 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 RedrawCategory graphics