* This TCL routine generates a TK photo Zone Plate test image.
   * Author [Greg Blair]
   * Date April 2006
----
  #/*******************************************************************************
  # * create a ZonePlate test pattern Image
  # *
  # * This a TK port of Ken Turkowski's ZonePlate.c 
  # *
  # * The orginal 1995 vintage C code can be found at:
  # * http://www.worldserver.com/turk/opensource/ZonePlate.c
  # *
  # * TK port by Greg Blair, Toronto, Ontario, Canada.
  # *
  # * The dependency on TK can be removed if one only wanted 
  # * to write out a .pgm file for example.
  # *
  # *******************************************************************************/
  #
  # Copyright legislation requires code derived from Ken Turkowski's 
  # code to include Ken's copyright notice:
  #
  #/* Copyright (C) 1978-1995 Ken Turkowski. <turk_at_computer.org>
  # *
  # *
  # * All rights reserved.
  # *
  # * Warranty Information
  # *  Even though I have reviewed this software, I make no warranty
  # *  or representation, either express or implied, with respect to this
  # *  software, its quality, accuracy, merchantability, or fitness for a
  # *  particular purpose.  As a result, this software is provided "as is,"
  # *  and you, its user, are assuming the entire risk as to its quality
  # *  and accuracy.
  # *
  # * This code may be used and freely distributed as long as it includes
  # * this copyright notice and the above warranty information.
  # */
  
  proc ZonePlate {width height scale} {
      # Richard Suchenwirth's tkPhotolab.tcl (http://wiki.tcl.tk/9521)
      # shows us:
      #  o - method for building up an image row
      #  o - method for inserting row into a photo object
      #  o - proc alias 
      #  o - rgb (which uses alias)
      proc  alias {name args} {eval [linsert $args 0 interp alias {} $name {}]} ;# local subroutine
      alias rgb   format #%02x%02x%02x ;# 8 bit color depth
  
      set   M_PI  3.14159265358979323846    ;# pi from gcc math.h
  
      set   maxValue 255 ;# 8 bit color depth
      set   midValue [expr {$maxValue / 2.0}]
      for {set i 0} {$i <= $maxValue} {incr i} {
          set sineTab($i) [expr {$midValue*sin($M_PI*($i-$midValue)/$midValue)+$midValue}]
      }
  
      set zpImage [image create photo -width $width -height $height]
  
      set cX [expr { $width  / 2} ]
      set cY [expr { $height / 2} ]
  
      set u 0 ; set row {}
      set v 0
      for {set i $height; set y [expr {-$cY}]} {$i} {incr i -1; incr y} {
      for {set j $width ; set x [expr {-$cX}]} {$j} {incr j -1; incr x} {
              set d [expr {(int(($x*$x+$y*$y) * $scale)>>8)&0xFF}] ;# 8 bit color depth
              set d [expr {int($sineTab($d))}]
              lappend row [rgb $d $d $d]
              incr u
              if {$u == $width} {
                  $zpImage put [list $row] -to 0 $v
                  set u 0 ; set row {}
                  incr v
              }
      }}
      return $zpImage
  } ;# end proc ZonePlate
  
  
  ########
  # TEST #
  ########
  
  set haveImg [expr {! [catch {package require Img}] } ]
  
  set width 512
  set height 512
  for {set scale 10} {$scale <= 50} {incr scale 10} \
  {
      set details [format %04d $width]x[format %04d $height]-[format %02d $scale]
      set zpImage [ZonePlate $width $height $scale]
      $zpImage write zp-$details.ppm -format PPM  ;# PPM image support included with TK
      if {$haveImg} {
          $zpImage write zp-$details.gif -format GIF  ;# requires Img extension
          $zpImage write zp-$details.bmp -format BMP  ;# requires Img extension
          $zpImage write zp-$details.tif -format TIFF ;# requires Img extension
          $zpImage write zp-$details.sgi -format SGI  ;# requires Img extension
          $zpImage write zp-$details.jpg -format JPEG ;# requires Img extension
      }
      destroy $zpImage ;# all done with image
  }
  exit