Version 3 of Mathematics jewels

ulis, 2003-11-19. Mathematics contains hidden treasures.

Maybe do you remember the reduced (and elegant) equation of an ellipse: (x/a)^2 + (y/b)^2 = 1?

Constraining a & b: with a = b = R you obtain a circle: (x/R)^2 + (y/R)^2 = 1 or, simpler, x^2 + y^2 = R^2

On the other side, the power can be generalized: |x/a|^n + |x/b|^n = 1

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.

Below is a proc to play with the power (of mathematics).

  # build a jewel image
  # (global parms below)
  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)}]
    }
    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)}]
    }
    foreach {x y} $points { puts "$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
  }

A little demo:

  # 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 $hh
  set x 2
  set y 2
  foreach (shapefactor) {1 2 3 10} \
  { 
    .c create image $x $y -anchor nw -image [jewel]
    incr x $ww
  }
  pack .c

KPV The construct array set {} { width 150 } fails for me, and likewise so does $(width), and foreach (shapefactor).... I'm using 8.4.4. ulis I don't understand why: these are legal construsts I use from 8.3. Maybe you defined a global variable scalar variable with an empty name?

Category Mathematics

Category Example