Keith Vetter 2003-01-30 - this little program draws a rosette figure. I originally wrote it over 8 years ago for a graphics class. Mathematically, the challenge was to make the junction between lobes smooth (I believe it was to the 2nd derivative but can't remember exactly).
One thing I changed from the original version was the logic of when to draw the figure. 8 years ago computers were a bit slower and drawing a rosette figure took a few seconds. Now on my machine it's almost instantaneous. So I removed a "redraw" button and just redraw the figure whenever any of the parameters change.
uniquename 2013aug17
Here is a picture showing what the following code creates. You can click in the trough on either side of a slider-button in any of the several scale widgets --- and hold the mouse button down. The scale will auto-advance a scale-resolution-unit at a time --- and the entire image updates immediately, repeatedly --- even on my little 'weak' netbook computer.
2017-10-29: Online demo at [L1 ]
#################################################################
#
# Tkrose.tcl -- draws a rosette with various number of lobes.
# Each lobe has 2nd derivative smoothness with the next lobe.
# Keith Vetter
#
# KPV Oct 14, 1994 - original version for class UCB CS285
# KPV Jan 29, 2003 - cleaned up, rewrote display logic for faster machines
#
package require Tk
array set S {lobes 12 next 2 power 100 lwidth 5 color black}
proc DoDisplay {} {
global S
wm title . TkRose
option add *Scale.highlightThickness 0
option add *Scale.relief ridge
option add *Scale.orient horizontal
pack [frame .top -relief raised -bd 2] -side top -fill x
pack [frame .bottom] -side bottom -fill x
canvas .c -relief raised -borderwidth 4 -height 700 -width 612
pack .c -side top -expand 1 -fill both
set colors {red orange yellow green blue cyan purple violet white}
lappend colors [.c cget -bg] black
foreach color $colors {
radiobutton .top.b$color -width 1 -padx 0 -pady 0 -bg $color \
-variable S(color) -value $color \
-command [list .c itemconfig rose -fill $color]
bind .top.b$color <3> [list .c config -bg $color]
}
eval pack [winfo children .top] -side left -fill y
scale .sLobes -from 3 -to 50 -label "Lobes" -variable S(lobes) \
-command DrawRosette
scale .sLWidth -from 1 -to 40 -label "Line Width" -variable S(lwidth) \
-command {.c itemconfig rose -width }
scale .sNext -from 1 -to [expr {($S(lobes)-1)/2}] -label Interval \
-variable S(next) -command DrawRosette
scale .sPower -from 1 -to 100 -label "Power (%)" -variable S(power) \
-command DrawRosette
pack .sLobes .sNext .sPower .sLWidth -in .bottom -side left
catch {image create photo ::img::blank -width 1 -height 1}
button .about -image ::img::blank -highlightthickness 0 -command {
tk_messageBox -title "About" -message "by Keith Vetter\nJanuary, 2003"}
place .about -in .bottom -relx 1 -rely 0 -anchor ne
update
bind .c <Configure> DrawRosette
}
#+###############################################################
#
# DrawRosette -- routine that actually draws the rosette.
#
proc DrawRosette {args} {
global S
.c delete rose ;# Erase old picture
set cx [expr {[winfo width .c] / 2}] ;# Center of the canvas
set cy [expr {[winfo height .c] / 2}]
set sc [expr {.8 * ($cx < $cy ? $cx : $cy)}];# Scaling factor
set pow [expr {$S(power) / 100.0}]
set n $S(lobes) ;# How mnay lobes
set k $S(next) ;# Number of lobes over
set beta [expr 360.0 / $n] ;# Center of each lobe
set gamma [expr 180 - $k*360.0/$n] ;# Arc area of each lobe
set r2d [expr 3.14159/180] ;# Degrees into radians factor
.sNext config -to [expr {($S(lobes)-1)/2}]
for {set l 0} {$l < $n} {incr l} { ;# For each lobe
set xy [list $cx $cy] ;# Coordinates for the lobe
for {set theta 0} {$theta < $gamma} {incr theta} { ;# Polar angle
set a [expr {$theta * 180.0 / $gamma}] ;# Angle in 0-180 range
set a1 [expr {$theta + $l*$beta - $gamma/2}]
set r [expr {sin ($a * $r2d)}] ;# Distance from center
if {$pow != 1} {
set r [expr {pow($r,$pow)}] ;# Adjust the distance
}
set x [expr {$r * cos ($a1 * $r2d)}] ;# Cartesian coordinates
set y [expr {$r * sin ($a1 * $r2d)}]
set x [expr {$x * $sc + $cx}] ;# Scale and shift
set y [expr {-$y * $sc + $cy}]
lappend xy $x $y
}
lappend xy $cx $cy
.c create line $xy -fill $S(color) -tag rose -width $S(lwidth)
}
}
DoDisplay
DrawRosette