http://perso.wanadoo.fr/maurice.ulis/tcl/jewels.gif

• With n = 1 you obtain a rhomb.
• With n = 2 you already got an ellipse.
• With n > 2 you obtain a rounded rectangle! The more the power, the more the rectangle.
• With n = 2/3 you obtain an astroid.

http://wfr.tcl.tk/Rosace

• Image link to http://www.sbk.stockholm.se/Bilder/3bild.gif goes to a password protected page on 2012-05-31.
• But you can still see it at http://web.archive.org/web/20070208100448/http://www.sbk.stockholm.se/Bilder/3bild.gif due to Internet's general lack of forgetfulness.

• Ellipse at Wikipedia: http://en2.wikipedia.org/wiki/Ellipse
• Ellipsoid at Wikipedia: http://en2.wikipedia.org/wiki/Ellipsoid
• Spheroid at Wikipedia: http://en2.wikipedia.org/wiki/Spheroid
• Super ellipse at Wikipedia: http://en2.wikipedia.org/wiki/Super_ellipse
• Sergels torg: http://www.sbk.stockholm.se/SergelT/Index.htm
• Superformula, a more powerful formula

  package require Tk
  # build a jewel image
  proc jewel {} {
    global {}
    # build outline
    set shapefactor $(shapefactor)
    #if {$shapefactor < 1} { set shapefactor 1.0 }
    if {$shapefactor > 100} { set shapefactor 100.0 }
    set width [expr {$(width) / $(granularity)}]
    set height [expr {$(height) / $(granularity)}]
    if {$width % 2 == 1} { incr width }
    if {$height % 2 == 1} { incr height }
    set a [expr {$width / 2}]
    set alpha [expr {pow($a,$shapefactor)}]
    set b [expr {$height / 2}]
    set beta [expr {pow($b,$shapefactor)}]
    set kx [expr {double($alpha) / $beta}]
    set ky [expr {double($beta) / $alpha}]
    set _y $b
    set oldy $_y
    set points {}
    for {set x 0} {$x < $a} {incr x} {
      set y [expr {round($_y)}]
      if {$y < $oldy - 1} { break }
      set oldy $y
      lappend points $x $y
      set _y [expr {pow(abs($ky * ($alpha - pow($x + 1,$shapefactor))),1.0/$shapefactor)}]
      for {set Y [expr {$y - 1}]} {$Y > $_y} {incr Y -1} {
        lappend points $x $Y
      }
    }
    set _x $x
    for {incr y} {$y >= 0} {incr y -1} {
      set x [expr {round($_x)}]
      lappend points $x $y
      set _x [expr {pow(abs($kx * ($beta - pow(abs($y - 1),$shapefactor))),1.0/$shapefactor)}]
      for {set X [expr {$x + 1}]} {$X < $_x} {incr X} {
        lappend points $X $y
      }
    }
    # fill
    set a2 [expr {1.0 / pow($width,$shapefactor) * $(lightcoef)}]
    set b2 [expr {1.0 / pow($height,$shapefactor) * $(lightcoef)}]
    set oldy $b
    set image [image create photo -width $(width) -height $(height)]
    foreach {(R) (G) (B)} [winfo rgb . $(color)] break
    foreach c {R G B} { set ($c) [expr {$($c) / 256.0}] }
    foreach {X Y} $points {
      if {$Y > $oldy} { continue }
      set oldy $Y
      set pixels1 {}
      set pixels2 {}
      set x2 [expr {pow($X,$shapefactor) * $a2}]
      for {set y 0} {$y < $Y} {incr y} {
        set _c [expr {1.0 - pow(2,$shapefactor) * ($x2 + (pow($y,$shapefactor) * $b2))}]
        if {$_c < 0} { set _c 0.0 }
        set color #
        foreach c {R G B} { append color [format %02x [expr {int($_c * $($c))}]] }
        for {set i 0} {$i < $(granularity)} {incr i} { lappend pixels1 $color }
        for {set i 0} {$i < $(granularity)} {incr i} { set pixels2 [linsert $pixels2 0 $color] }
      }
      set x1 [expr {($a + $X) * $(granularity)}]
      set x2 [expr {($a - $X) * $(granularity)}]
      set y1 [expr {$b * $(granularity)}]
      set y2 [expr {($b - $Y) * $(granularity)}]
      for {set i 0} {$i < $(granularity)} {incr i} {
        $image put $pixels1 -to $x1 $y1
        $image put $pixels1 -to $x2 $y1
        $image put $pixels2 -to $x1 $y2
        $image put $pixels2 -to $x2 $y2
        incr x1
        incr x2
      }
    }
    return $image
  }

  # parameters
  array set {} {
    width       150
    height      100
    color       gold
    granularity 1
    lightcoef   0.5
  }
  
  wm title . "Mathematics jewels"
  set ww [expr {$(width) + 4}]
  set hh [expr {$(height) + 4}]
  canvas .c -bd 0 -highlightt 0 -insertwidth 0 -width [expr {$ww * 4}] -height [expr {$hh * 2}]
  set x 2
  set y 2
  foreach (shapefactor) {1 2 4 10} { 
    .c create image $x $y -anchor nw -image [jewel]
    incr x $ww
  }
  set x 2
  incr y $hh
  foreach (shapefactor) {0.8 0.6 0.4 0.2} { 
    .c create image $x $y -anchor nw -image [jewel]
    incr x $ww
  }
  pack .c

  set Width 150
  ...
  ... $(width) replaced by $::Width
  ...
  foreach Shapefactor ...

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References