Updated 2013-08-18 03:12:38 by RLE

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.

 #################################################################
 #
 # 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