#!/usr/bin/wish -f
##+###########################################################################
##
## SCRIPT: createImages_withFunctions_wiki3523_chgButtonsToListbox_prefixFuncNames.tk
##
##    Based on a 'Functional Imaging' script published by Richard Suchenwirth,
##    circa 2002, at http://wiki.tcl.tk/3523
##
## DESCRIPTION OF ORIGINAL SCRIPT: (paraphrased from http://wiki.tcl.tk/3523)
##
## The original 'functional imaging' script shows predefined basic functions,
## and some 'function combinations', as text-labels on a stack of buttons on
## the left of the GUI window.
##
## Click on a 'function-button', have some patience (about 3 to 30 seconds),
## and the corresponding image will be displayed on the canvas to the right.
##
## You can also experiment with image operators in the entry widget at
## the bottom of the GUI.
##
## The text of sample buttons is copied to the entry widget, so you
## can play with the parameters, or rewrite the function or 'combination of
## functions' as you wish. Press <Return> to try the new entry.
##
## On 2002-06-15, Richard Suchenwirth said "Cameron Laird pointed me to
## Conal Elliott's 'Pan' project ('Functional Image Synthesis'), where
## images (of arbitrary size and resolution) are produced and manipulated 
## in an elegant functional way."
##
## A description of that project was posted at
##   http://research.microsoft.com/en-us/um/people/conal/papers/bridges2001/
##
##    [That link is now dead. Googling the keywords
##          'conal elliott pan functional image synthesis'
##     in 2012 August found: http://conal.net/papers/bridges2001/ ]
##
## The Haskell original could, with few modifications, be represented in Tcl.
## 'Functional composition' can be rewritten to Polish notation.
##
## Haskell's
##
##    foo 1 o bar 2 o grill
##
## (where "o" is the composition operator) would, in Polish notation, look like
##
##    o {foo 1} {bar 2} grill
##
## Additional arguments can be specified. Only the last argument is passed
## through the generated "function nest":
##
##   proc f {x} {foo 1 [bar 2 [grill $x]]}
##
##            [where $x is actually, in these functional imaging apps,
##                         typically an xy pair of values, corresponding to
##                         the coordinates of a pixel in an image canvas.]
##
## The name of the generated function can be much nicer than "f" ---
## namely, the complete "o" string can be used, so the example proc above
## can have the name
##
##   "o {foo 1} {bar 2} grill"
##
## which is pretty self-documenting.  See 'proc o' at http://wiki.tcl.tk/3523.
## It makes the 'o' names.
##
## Suchenwirth points out that "a well-formed 'funimj composition' consists of":
##
##    * the composition operator "o"
##    * zero or more "painters" (color -> color)           [color-map function]
##    * one "draw-er" (point -> color)             [geometry-to-color function]
##    * zero or more "transformers" (point -> point)    [geometry-map function]
##
## There should be at least one "draw-er" (point -> color).
## The "painters" [color-to-color mappers] and "transformers"
## [geometry-to-geometry mappers] are optional.
##
## The list above implies that
##   - a geometry-transformer(s), if present, is/are typically applied first
##   - the "draw-er' is applied next
##   - a color-transformer, if present, is typically applied next.
##
## Or, more generally, the output of one function should be of a type
## supported by the input of the next function. And the final output of
## the 'composite function' should be a color.
##+######################
## Tcl-Tk WIKI REFERENCES:
##   http://wiki.tcl.tk/3523 "Functional imaging" 
##   (downloaded the pieces and assembled them on 2012aug02)
##
##   Also see http://wiki.tcl.tk/2755, "Functional composition".
##
##   Also see http://wiki.tcl.tk/10861,
##            "Not Functional Imaging - Scripting Imaging".
##
##+########################################################################
## DESCRIPTION OF THIS NEW VERSION:
## The main difference is that I have replaced the buttons on the left side
## of the GUI with a scrolling listbox (with both vertical and horizontal
## scrollbars) --- so that many functions (including some donated by
## DFK = Donal Fellows, and others) can be added (vertically in the listbox)
## --- and so that descriptions (comments) can be added (horizontally in the
## listbox).
##
## The entry widget on the GUI is retained -- so that users can change
## parameter defaults of the functions that are provided with value(s)
## for parameter(s).
##
## The scrollbar at the bottom of the GUI provides zooming (regenerating
## the image in the same canvas area but with a magnification factor)
## via a single positive integer parameter.
##
## Another major change that I have made is to rename the 'mapper' procs
## with prefixes that indicate the type of input and output.  Examples:
##
##   'xyTOchex_'   - an xy point is mapped to a hex-color
##   'chexTOchex_' - a hex-color is mapped to a hex-color
##   'xyTOxy_'     - an xy point is  mapped to an xy point
##   'raTOxy_'     - a polar point (r,a - radius,angle) is mapped to an xy point
##   'fTOchex_'    - a floating point number is mapped to a hex-color
##   '0or1TOchex_' - a one-digit binary number (0 or 1) is mapped to a hex-color
##   'fgxyTOchex_' - 2 funcs, nicknamed f and g, evaluated at xy, map to a hex-color,
##                   i.e. the 'input' is 2 functions and an xy point.
##  
## The prefixes have the disadvantage of making the function names and
## composite-function names rather long --- but it was well worth it to
## me because it makes it much clearer to me what the functions and
## composite-functions are intended to do.  Furthermore, it really stands
## out if you are feeding improper output type from one function into
## another function in a composite-function. 
##+#######################################################################
## 'CANONICAL' STRUCTURE OF THIS CODE:
##
##  0) Set general window parms (name,position-size,color-scheme,fonts,etc.).
##  1) Define ALL frames (and sub-frames).  Pack them.
##  2) Define & pack all widgets in the frames.
##
##  3) Define key/mouse action BINDINGS, if needed.
##  4) Define PROCS, if needed.
##  5) Additional GUI initialization (typically with one or more of
##     the procs), if needed.
##
##+#################################
## Some detail of the code structure of this particular script:
##
##  1a) Define ALL frames:
## 
##   Top-level :
##       'fRleft'  - to contain a listbox and its scrollbars
##       'fRright' - to contain a canvas widget, with an entry widget below it
##
##   Sub-frames of 'fRleft': none, just one listbox widget with xy scrollbars
##
##   Sub-frames of 'fRright' (top to bottom):
##       'fRcan'       - to contain the canvas widget.
##       'fRinfo'      - to contain a label widget and a scale widget.
##       'fRcontrols'  - to contain an 'Exit' button,
##                       (a 'Help' button, someday?),
##                       and an entry widget to hold the selected
##                       (composite-)function, with its default parameter
##                       settings, if any.
##
##  1b) Pack ALL frames.
##
##  2) Define & pack all widgets in the frames -- basically going through
##     frames & their interiors in  left-to-right, top-to-bottom order:
##
##  3) Define bindings:
##         - Button1-release on the listbox
##         - Return key press on the entry widget
##         - Double-Button1-release on the entry widget
##
##  4) Define procs:
##        - a function-composition operator 'o'
##        - two procs to make and put an image on the canvas, from a given
##              composite-function
##        - about 20-plus 'transform'/'mapping' procs
##        - a load-the-listbox proc, for GUI initialization
##        - a put-a-selected-listbox-line-into-the-entry-field proc,
##            for the Button1-release binding on the listbox
##
##  5) Additional GUI initialization:
##        - run the load-the-listbox proc
##         
## ****
## NOTE: If a new composite-function is to be added to the listbox:
## ****
##       1) Any new procs needed should be added to the procs section.
##       2) The new (composite-)function, formed using the 'o'
##          operator/proc, should be added in a 'listbox-insert' command,
##          in the load-the-listbox proc.
##
##+#######################################################################
## DEVELOPED WITH: Tcl-Tk 8.5 on Ubuntu 9.10 (2009-october, 'Karmic Koala')
##
##   $ wish
##   % puts "$tcl_version $tk_version"
##
##   showed
##         8.5 8.5
##   but this script should work in most previous 8.x versions, and
##   probably even in some 7.x versions.
##+#######################################################################
## MAINTENANCE HISTORY:
## Started by: Blaise Montandon 2010aug11 Started development, on Ubuntu 9.10,
##                                        based on the code and comments at
##                                        http://wiki.tcl.tk/3523 -
##                                        "Functional imaging".
## Changed by: Blaise Montandon 2012aug13 Added a 'catch' for execution of
##                                        'eval $bracketsSTRING'.
##                                        Chg proc names 'fim_show' & 'fim'
##                                        to 'fim_put' and 'fim_make'.
##+########################################################################


##+#######################################################################
## Set general window parms (title,position,size,color-scheme,fonts,etc.).
##+#######################################################################

wm title    . "'Functional Imaging' - in a Canvas"
wm iconname . "ImgCanvas"

wm geometry . +15+30

## We allow the window to be resizable and we pack the canvas with
## '-fill both' so that the canvas can be enlarged by enlarging the
## window.
##
## Just hit the double-click on the entry field (or press the
## Enter key) to re-fill the canvas according to the
## the user-specified composite-function.

## If you want to make the window un-resizable, 
## you can use the following statement.
# wm resizable . 0 0


##+######################################################
## Set the color scheme for the window and its widgets ---
## such as entry field background color.
##+######################################################

tk_setPalette "#e0e0e0"

set entryBKGD "#ffffff"
set listboxBKGD "#ffffff"


##+########################################################
## Use a VARIABLE-WIDTH font for text on label and
## button widgets.
##
## Use a FIXED-WIDTH font for the listbox list and for
## the text in the entry field.
##+########################################################

font create fontTEMP_varwidth \
   -family {comic sans ms} \
   -size -14 \
   -weight bold \
   -slant roman

## Some other possible (similar) variable width fonts:
##  Arial
##  Bitstream Vera Sans
##  DejaVu Sans
##  Droid Sans
##  FreeSans
##  Liberation Sans
##  Nimbus Sans L
##  Trebuchet MS
##  Verdana

font create fontTEMP_fixedwidth  \
   -family {liberation mono} \
   -size -14 \
   -weight bold \
   -slant roman

## Some other possible fixed width fonts (esp. on Linux):
##  Andale Mono
##  Bitstream Vera Sans Mono
##  Courier 10 Pitch
##  DejaVu Sans Mono
##  Droid Sans Mono
##  FreeMono
##  Nimbus Mono L
##  TlwgMono


##+###########################################################
## SET GEOM VARS FOR THE VARIOUS WIDGET DEFINITIONS.
## (e.g. width and height of canvas, and padding for Buttons)
##+###########################################################

set initCanWidthPx 300
set initCanHeightPx 300

set minCanWidthPx 24
set minCanHeightPx 24

# set BDwidthPx_canvas 2
  set BDwidthPx_canvas 0


## BUTTON widget geom settings:

set PADXpx_button 0
set PADYpx_button 0
set BDwidthPx_button 2


## ENTRY widget geom settings:

set BDwidthPx_entry 2
set initEntryWidthChars 50


## LISTBOX geom settings:

set BDwidthPx_listbox 2
set initListboxWidthChars 50
set initListboxHeightChars 8


##+######################################################
## Set a minsize of the window according to the
## approx min width of the listbox and entry widgets
## (about 20 chars each)
## --- and according to the approx min height of the
## listbox widget, about 8 lines.
##+######################################################

set charWidthPx [font measure fontTEMP_fixedwidth "0"]

## Use the init width of the listbox and entry widgets, in chars,
## to calculate their total width in pixels. Then add some
## pixels to account for right-left-size of window-manager decoration,
## frame/widget borders, and the vertical listbox scrollbar.
set minWinWidthPx [expr 20 + ( $initListboxWidthChars * $charWidthPx ) + \
      ( $initEntryWidthChars * $charWidthPx )]

set charHeightPx [font metrics fontTEMP_fixedwidth -linespace]

## Get the height of the init number of lines in the listbox
## and add about 20 pixels for top-bottom window decoration --
## and about 8 pixels for frame/widget borders.
set minWinHeightPx [expr 28 + ( $initListboxHeightChars * $charHeightPx ) ]

## FOR TESTING:
#   puts "minWinWidthPx = $minWinWidthPx"
#   puts "minWinHeightPx = $minWinHeightPx"

wm minsize . $minWinWidthPx $minWinHeightPx


##+################################################################
## DEFINE *ALL* THE FRAMES:
##
##   Top-level : '.fRleft' , '.fRright'
##
##   Sub-frames: '.fRright.fRcan' and '.fRright.fRinfo' and
##               '.fRright.fRcontrols'
##+################################################################

# set BDwidth_frame 0
  set BDwidth_frame 2

# set RELIEF_frame raised
  set RELIEF_frame flat

frame .fRleft    -relief $RELIEF_frame  -borderwidth $BDwidth_frame
frame .fRright   -relief $RELIEF_frame  -borderwidth $BDwidth_frame

frame .fRright.fRcan       -relief raised         -bd $BDwidth_frame
frame .fRright.fRinfo      -relief $RELIEF_frame  -bd $BDwidth_frame
frame .fRright.fRcontrols  -relief $RELIEF_frame  -bd $BDwidth_frame


##+##############################
## PACK the FRAMES. 
##+##############################

pack .fRleft \
      -side left \
      -anchor nw \
      -fill y \
      -expand 0

pack .fRright \
      -side left \
      -anchor nw \
      -fill both \
      -expand 1


## Pack the sub-frames.

pack .fRright.fRcan \
      -side top \
      -anchor nw \
      -fill both \
      -expand 1

pack .fRright.fRinfo \
     .fRright.fRcontrols \
      -side top \
      -anchor nw \
      -fill x \
      -expand 0


##+###############################
## DEFINE-and-PACK LISTBOX WIDGET:
##+######################################################
## Originally, Suchenwirth's code used buttons instead
## of a listbox. He made the button stack (on the
## left side of the GUI) as follows.
##      (This uses the $c var to represent the canvas.)
##+######################################################
##
## set n 0
## foreach imf [lsort [info procs "o *"]] {
##    button .f.b[incr n] -text $imf -anchor w -pady 0 \
##        -command [list fim_put $c $imf]
## }
##+######################################################

listbox .fRleft.listbox \
      -width $initListboxWidthChars \
      -height $initListboxHeightChars \
      -font fontTEMP_fixedwidth \
      -relief raised \
      -borderwidth $BDwidthPx_listbox \
      -state normal \
      -yscrollcommand ".fRleft.scrbary set" \
      -xscrollcommand ".fRleft.scrbarx set"

## Could experiment with
##     -width 0 \
##     -height 0 \
## and the -'fill' & 'expand' pack parms for '.fRleft'.

scrollbar .fRleft.scrbary \
   -orient vertical \
   -command ".fRleft.listbox yview"

scrollbar .fRleft.scrbarx \
   -orient horizontal \
   -command ".fRleft.listbox xview"


## Pack the listbox and its scrollbars.

pack .fRleft.scrbary \
      -side right \
      -anchor e \
      -fill y \
      -expand 0

pack .fRleft.scrbarx \
      -side bottom \
      -anchor s \
      -fill x \
      -expand 0

## We need to pack the listbox AFTER
## the scrollbars, to get the scrollbars
## positioned properly --- BEFORE
## the listbox FILLS the pack area.

pack .fRleft.listbox \
      -side top \
      -anchor nw \
      -fill both \
      -expand 1


##+###############################
## DEFINE-and-PACK CANVAS WIDGET:
##+###############################

canvas .fRright.fRcan.can \
   -width $initCanWidthPx \
   -height $initCanHeightPx \
   -relief raised \
   -borderwidth $BDwidthPx_canvas

pack .fRright.fRcan.can \
   -side top \
   -anchor nw \
   -fill both \
   -expand 1


##+#########################################
## DEFINE-and-PACK 'INFO' WIDGETS
## --- a label widget --- and a scale widget
## (for changing the 'magnification' of the
## image in the current canvas area).
##+#########################################

## Label Widget on which to write the number of composite-functions
## read in by the 'loadfuncs2listbox' proc. See that proc for
## a statement to set the text in this label.

label .fRright.fRinfo.labelFNUM \
      -font fontTEMP_varwidth \
      -justify left \
      -anchor w \
      -relief flat \
      -bd 0

#      -text "" \

label .fRright.fRinfo.labelZOOM \
      -text "\
Zoom
img
on
canvas:" \
      -font fontTEMP_varwidth \
      -justify right \
      -anchor w \
      -relief flat \
      -bd 0

set zoom 25

scale .fRright.fRinfo.scaleZOOM \
      -from 1 -to 100 \
      -variable zoom \
      -ori hori \
      -width 5

## Pack the '.fRinfo' frame's widgets.

pack  .fRright.fRinfo.labelFNUM \
      -side left \
      -anchor w \
      -fill none \
      -expand 0

pack  .fRright.fRinfo.scaleZOOM \
      .fRright.fRinfo.labelZOOM \
      -side right \
      -anchor e \
      -fill none \
      -expand 0


##+#################################
## DEFINE-and-PACK 'CONTROL' WIDGETS
## --- button(s), entry field.
##+#################################

button .fRright.fRcontrols.buttEXIT \
   -text "Exit" \
   -font fontTEMP_varwidth \
   -padx $PADXpx_button \
   -pady $PADYpx_button \
   -relief raised \
   -bd $BDwidthPx_button \
   -command {exit}


set ENTRYstring ""

entry .fRright.fRcontrols.entCMD \
   -textvariable ENTRYstring \
   -bg $entryBKGD \
   -font fontTEMP_fixedwidth \
   -width $initEntryWidthChars \
   -relief sunken \
   -bd $BDwidthPx_entry


## Pack the control widgets.

pack  .fRright.fRcontrols.buttEXIT \
      -side left \
      -anchor w \
      -fill none \
      -expand 0

pack .fRright.fRcontrols.entCMD \
      -side left \
      -anchor w \
      -fill x \
      -expand 1


##+##################################################
## END OF DEFINITION of the GUI widgets.
##+##################################################
## Start of BINDINGS, PROCS, Added-GUI-INIT sections.
##+##################################################

##+#######################################################################
##+#######################################################################
##  BINDINGS SECTION:
##   - For MB1 click on a listbox line,
##             put that line (function) in ENTRYstring.
##   - For Enter-key-press in the entry field,
##             use the ENTRYstring to draw in the canvas.
##   - For MB1-click in the entry field,
##             use the ENTRYstring to draw in the canvas.
##+#######################################################################

bind .fRleft.listbox <ButtonRelease-1>  { listboxSelectionTOentryString }

bind .fRright.fRcontrols.entCMD <Return>  { fim_put }
bind .fRright.fRcontrols.entCMD <Double-ButtonRelease-1>   { fim_put }


##+##################################################################
##+##################################################################
## DEFINE PROCS SECTION:
##    - the function-composition proc 'o'
##    - image rendering procs:  'fim_make' , 'fim_put'
##      ('fim_put' calls 'fim_make', then puts the made image on the canvas.)
##      ('fim' short for 'functional image' --- duh.)
##
##  Then
##    - about 20-plus 'transform'/'mapping' procs
##
##  Then
##    - 'loadfuncs2listbox' - to load the listbox (for GUI initialization).
##    - 'listboxSelectionTOentryString'  -
##                          to put a selected listbox line into the
##                          entry widget var, ENTRYstring.
##
##+#################################################################
## Description of the 'transform' procs:
##
## Most of the 'transform' procs are of 3 types:
##    - point-to-color
##    - color-to-color
##    - point-to-point
##
## In function composition, like f(g(args)), it is essential that
## the output of g is of a type compatible with the input type of f.
## In fact, it is essential that we know both the input type and
## the output type of f and g.
##
## To make the input and output types of the following procs/functions
## clear, the name of each proc is prefixed by an input-TO-output
## indicator. Example prefixes:
##   'xyTOchex_'   - an xy point is mapped to a hex-color
##   'chexTOchex_' - a hex-color is mapped to a hex-color
##   'xyTOxy_'     - an xy point is  mapped to an xy point
##   'raTOxy_'     - a polar point (r,a - radius,angle) is mapped to an xy point
##   'fTOchex_'    - a floating point number is mapped to a hex-color
##   '0or1TOchex_' - a one-digit binary number (0 or 1) is mapped to a hex-color
##   'fgxyTOchex_' - 2 funcs, f and g, evaluated at xy, map to a hex-color
##
## Example:
##    Proc 'xyTOchex_bwCheckers' maps an xy point to a hex-color, to
##    make a black-and-white checkerboard pattern.
##+############################################################################

##+#########################################################################
## Proc 'o' - combines the functions=procs (and parameters, if any) in input
##           'args' to make a left-and-right brackets-separated string.
##                  Puts the string into global var 'bracketsSTRING'.
##+#########################################################################

proc o args {

   global bracketsSTRING

   ## FOR TESTING:
   #  puts "ENTERING 'o' proc."

   ########################################################################
   ## The next statement
   ## puts a left-bracket to the left of each of the function arguments,
   ## except the first one. Example output if 'args' is
   ##
   ##   xyTOchex_grayCheckers {xyTOxy_rippleRad 8 0.3} {rxyTOxy_swirl 16}
   ##
   ## should be
   ##
   ##   xyTOchex_grayCheckers [xyTOxy_rippleRad 8 0.3 [rxyTOxy_swirl 16 $xy
   ##
   ## Note the 2 left-brackets --- and note the addition of '$xy' to the
   ## end of the string.
   ########################################################################

   set body "[join $args " \["] \$xy"

   ## FOR TESTING:
   #  puts "body: $body"

   ###########################################################################
   ## The next statement
   ## adds N-1 right-brackets to the end of the string of function arguments,
   ## where N is the number of arguments. Example output 
   ##
   ##   xyTOchex_grayCheckers [xyTOxy_rippleRad 8 0.3 [rxyTOxy_swirl 16 $xy]]
   ##
   ## Note the 2 right-brackets at the end of the string.
   ##########################################################################

   append body [string repeat \] [expr {[llength $args]-1}]]

   ## FOR TESTING:
   #   puts "body: $body"


   ## Save the string in a global var.

   set bracketsSTRING "$body"

   ## Alternatively, the string could be passed from this script with
   ## a 'set' statement as the last statement of this proc.
   # set "$body"


   ## FOR TESTING:
   #  puts "EXITING 'o' proc."
}
## END OF proc 'o'


##+######################################################################
## proc 'fim_put':
##   Put an image --- created by a call to proc 'fim_make',
##   whose code is below --- on the canvas.  Input is 'f'.
##  'f' is ENTRYstring which contains the 'o'-format (composite-)function.
##+######################################################################

proc fim_put {} {

   global ENTRYstring

   wm title . "*BUSY* ...... Calculating using:   $ENTRYstring"

   ## Clear the canvas.
   .fRright.fRcan.can delete all

   ## Set the current time, for determining execution
   ## time for building the photo image, below.
   set t0 [clock seconds]

   ## Put an image in the canvas, using proc 'fim_make' to make the image.
   .fRright.fRcan.can create image 0 0 -anchor nw -image [fim_make]

   ## Change the title of the window to show execution time.
   wm title . "DONE.  [expr [clock seconds]-$t0] seconds elapsed using:   $ENTRYstring"

}
## END OF proc 'fim_put'


##+######################################################################
## Proc 'fim_make':
##  Make a Tk image for a given (composite-)function and
##  for given zoom and the current canvas width and height.
##
##  Uses var ENTRYstring, from the entry widget,
##       which contains the 'o'-format (composite-)function.
##  Uses var zoom, from the scale widget.
##  Uses var bracketsSTRING, which is made from ENTRYstring by
##       evaluating the 'o' proc.
##
##  Produces a photo image by applying the (composite-)function to xy
##  positions corresponding to pixels in the canvas, with an xy origin
##  in the middle of the canvas.
##     The output of the (composite-)function should be a color.
##+######################################################################

proc fim_make {} {

   global ENTRYstring

   ## bracketsSTRING holds the (composite-) function in the
   ## left-and-right-bracket form, rather than the 'o' form.
   ##      bracketsSTRING is set by 'eval $ENTRYstring' below.
   global bracketsSTRING

   global zoom  ;# var of the scale widget

   ## Change the cursor to a 'watch' cursor.
   . config -cursor watch
   update  ;# to make the cursor visible

   ## Get the current width & height of the canvas (in pixels).
   set width  [winfo width .fRright.fRcan.can]
   set height [winfo height .fRright.fRcan.can]

   ## Initialize an image structure.
   set im [image create photo -height $height -width $width]

   ## Initialize the data var, empty.
   set data {}

   ## NEEDED.
   ## Runs the 'o' proc to make the global var bracketsSTRING ---
   ## the left-and-right-brackets form of the (composite-)function
   ## --- from the current ENTRYstring.
   eval $ENTRYstring

   ## Make the x values for the x argument of the (composite-)function
   ## --- relative to an origin in the middle of the canvas.
   set xs {}
   for {set j 0} {$j<$width} {incr j} {
      lappend xs [expr {($j-$width/2.)/$zoom}]

      ## FOR TESTING:
      #  if { $j == 30 } { puts "xs: $xs" }
   }


   #############################################################
   ## For x and y values, relative to an origin in the middle of
   ## the canvas, use the current (composite-)function to compute
   ## the color values of the pixels.
   ## Build up the 'data' var row by row.
   #############################################################

   for {set i 0} {$i<$height} {incr i} {

      set row {}
      set y [expr {($i-$height/2.)/$zoom}]

      ## FOR TESTING:
      #   puts "i: $i   y: $y"

      foreach x $xs {

         ## Set var xy.
         set xy [list $x $y]

         ## Evaluate $bracketsSTRING and attach the color result
         ## to var 'row'. (Note that bracketsSTRING was created
         ## by the 'o' proc to have $xy at the end of the string.)
         ##
         ## In case there is a syntax error in bracketsSTRING,
         ## we put the following statement
         ##    lappend row [eval $bracketsSTRING]
         ## in an error catching routine.

         if [catch {lappend row [eval $bracketsSTRING]}] {
            .fRright.fRcan.can create text 10 10 -anchor nw -text $errorInfo
            ## Reset the cursor from a 'watch' cursor.
            . config -cursor {}
            return
         }

      }
      ## END OF 'foreach x' LOOP.

      ## FOR TESTING:
      #  if { $i == 30 } { puts "row:  $row" }

      lappend data $row
   }
   ## END OF 'foreach i/y' LOOP.

   ## Put the data in the image structure.
   $im put $data

   ## Reset the cursor from a 'watch' cursor.
   . config -cursor {}

   ## Return the image ID.
   set im
}
## END OF proc 'fim_make'


##+######################################################################
##+######################################################################
## TRANSFORM/MAPPING PROCS :
##+######################################################################
## Typical arguments (inputs) and outputs are points and/or colors. Examples:
## - a  Cartesian 2D point - a pair of integer or floating point numbers {x y}
## - a polar 2D point - a pair of floating point numbers {r a} (radius,angle)
## - a Tk color name, like "green"
## - a hex color value, like #010203
##
## Other argument (input) examples:
## - 0 or 1
## - a number between 0.0 and 1.0
## - a color expressed as 3 integers, between 0 and 255
## - two functions and an xy point
## - an integer and an xy point
##+######################################################################

## This first group of procs/mappings was provided by Suchenwirth.

proc 0or1TOchex_whiteORblack {binarydigit} {
    ## 0 -> white, 1 -> black
    expr {$binarydigit? "#000" : "#FFF"}
}

proc fTOchex_0to1TOgrays {greylevel} {
    ## convert 0..1 to #000000..#FFFFFF
    set hex [format %02X [expr {round($greylevel*255)}]]
    return #$hex$hex$hex
}

proc c255TOchex {r g b} {
    ## make Tk color name: {0 128 255} -> #0080FF
    format #%02X%02X%02X $r $g $b
}

proc 0or1TOchex_binaryPaint {color0 color1 pixel} {
    ## convert a binary pixel to one of two specified colors
    expr {$pixel=="#000"? $color0 : $color1}
}

proc  xyTOchex_bwVstrip p {
    ## Makes a simple vertical bar:
    ## xy points where x is between -0.5 and 0.5 map to black.
    0or1TOchex_whiteORblack [expr {abs([lindex $p 0]) < 0.5}]
}

proc xyTOchex_udisk p {
    ## Makes a unit disk, radius 1, black on white bkgnd.
    foreach {x y} $p break
    0or1TOchex_whiteORblack [expr {hypot($x,$y) < 1}]
}

proc fgxyTOchex_xor {f1 f2 p} {
    lappend f1 $p; lappend f2 $p
    0or1TOchex_whiteORblack [expr {[eval $f1] != [eval $f2]}]
}

proc fgxyTOchex_and {f1 f2 p} {
    lappend f1 $p; lappend f2 $p
    0or1TOchex_whiteORblack [expr {[eval $f1] == "#000" && [eval $f2] == "#000"}]
}

proc xyTOchex_bwCheckers p {
    ## Makes a black and white checkerboard.
    foreach {x y} $p break
    0or1TOchex_whiteORblack [expr {int(floor($x)+floor($y)) % 2 == 0}]
}

proc xyTOchex_grayCheckers p {
    ## Makes greylevels corresponding to fractional part of x,y.
    foreach {x y} $p break
    fTOchex_0to1TOgrays [expr {(fmod(abs($x),1.)*fmod(abs($y),1.))}]
}

proc xyTOchex_bwRings p {
    ## Makes binary (black or white) concentric rings.
    foreach {x y} $p break
    0or1TOchex_whiteORblack [expr {round(hypot($x,$y)) % 2 == 0}]
}

proc xyTOchex_grayRings p {
    ## Makes grayscale concentric rings.
    foreach {x y} $p break
    fTOchex_0to1TOgrays [expr {(1 + cos(3.14159265359 * hypot($x,$y))) / 2.}]
}

proc nxyTOchex_bwWedges {n p} {
    ## Makes n wedge slices (black/white) starting at (0,0).
    foreach {r a} [xyTOra $p] break
    0or1TOchex_whiteORblack [expr {int(floor($a*$n/3.14159265359))%2 == 0}]
}

proc xyTOchex_bwXpos-neg p {
   ## Makes left/right halves of xy plane white/black.
   0or1TOchex_whiteORblack [expr {[lindex $p 0]>0}]
}

proc xyTOchex_colorGradient p {
    ## color gradients - best watched at zoom=100
    foreach {x y} $p break
    if {abs($x)>1.} {set x 1.}
    if {abs($y)>1.} {set y 1.}
    set r [expr {int((1.-abs($x))*255.)}]
    set g [expr {int((sqrt(2.)-hypot($x,$y))*180.)}]
    set b [expr {int((1.-abs($y))*255.)}]
    c255TOchex $r $g $b
}


proc expr-xyTOchex_bwPlot {expr p} {
   ##########################################################################
   ## Another point->color(black-white) proc:
   ## Beyond the examples in Conal Elliott's paper "Functional Image Synthesis",
   ## Suchenwirth found out that function imaging can also be 'abused' for a
   ## (slow and imprecise) function plotter, which displays the graph for
   ## y = f(x) if you call it with $y + f($x) as first argument:
   ###########################################################################
   foreach {x y} $p break
   0or1TOchex_whiteORblack [expr abs($expr)<=0.04] ;# double eval required here!
}


##+########################################################################
## Arjen Markus provided the following 2 contour (point -> color) procs
## for a little extension to the repertoire.
##+########################################################################

proc fxyTOcname_contour {expr p} {
    foreach {x y} $p break
    colourClass {-10 -5 0 5 10} [expr $expr] ;# double eval required here!
}

proc colourClass { classbreaks value } {
    set nobreaks [llength $classbreaks]
    set colour   [lindex  {darkblue blue green yellow orange red magenta} end ]

    for { set i 0 } { $i < $nobreaks} { incr i } {
       set break [lindex $classbreaks $i]
       if { $value <= $break } {
          set colour \
             [lindex  {darkblue blue green yellow orange red magenta} $i ]
          break
       }
    }
    return $colour
}


proc fgxyTOcname_bin2 {f1 f2 p} {
   #########################################################################
   ## A combinator for two binary images that shows in different
   ## colors for which point both or either are "true" - nice but slow.
   #########################################################################
    set a [eval $f1 [list $p]]
    set b [eval $f2 [list $p]]
    expr {
        $a == "#000" ?
            $b == "#000" ? "green"
            : "yellow"
        : $b == "#000" ? "blue"
        : "black"
    }
}


proc grayTOchex_gPaint {color pixel} {
   ###################################################################
   ## This painter colors a grayscale image in hues of the given color.
   ## It normalizes the given color through dividing by the corresponding
   ## values for "white", but appears pretty slow too.
   ## This uses the 'rgb' proc right after this proc, below.
   #####################################################################
   set abspixel [lindex [rgb $pixel] 0]
   set rgb [rgb $color]
   set rgbw [rgb white]
   foreach var {r g b} in $rgb ref $rgbw {
      set $var [expr {round(double($abspixel)*$in/$ref/$ref*255.)}]
   }
   c255TOchex $r $g $b
}


proc rgb {color} {
   #############################################################################
   ## This proc caches the results of [winfo rgb] calls, because these
   ## are quite expensive, especially on remote X displays. - rmax (Reinhard Max)
   ############################################################################
   upvar "#0" rgb($color) rgb
   if {![info exists rgb]} {set rgb [winfo rgb . $color]}
   set rgb
}


##+#############################################################
## DKF (Donal Fellow) offers some fancier operators for working
## with gradients ... g2 , g+ , g- , invert
##+#############################################################

proc fgxyTOchex_g2 {f1 f2 p} {
    foreach {r1 g1 b1} [rgb [eval $f1 [list $p]]] {break}
    foreach {r2 g2 b2} [rgb [eval $f2 [list $p]]] {break}
    set r3 [expr {($r1+$r2)/2/256}]
    set g3 [expr {($g1+$g2)/2/256}]
    set b3 [expr {($b1+$b2)/2/256}]
    c255TOchex $r3 $g3 $b3
}

proc fgxyTOchex_g+ {f1 f2 p} {
    foreach {r1 g1 b1} [rgb [eval $f1 [list $p]]] {break}
    foreach {r2 g2 b2} [rgb [eval $f2 [list $p]]] {break}
    set r3 [expr {($r1>$r2?$r1:$r2)/256}]
    set g3 [expr {($g1>$g2?$g1:$g2)/256}]
    set b3 [expr {($b1>$b2?$b1:$b2)/256}]
    c255TOchex $r3 $g3 $b3
}

proc fgxyTOchex_g- {f1 f2 p} {
    foreach {r1 g1 b1} [rgb [eval $f1 [list $p]]] {break}
    foreach {r2 g2 b2} [rgb [eval $f2 [list $p]]] {break}
    set r3 [expr {($r1<$r2?$r1:$r2)/256}]
    set g3 [expr {($g1<$g2?$g1:$g2)/256}]
    set b3 [expr {($b1<$b2?$b1:$b2)/256}]
    c255TOchex $r3 $g3 $b3
}

proc chexTOchex_invert {c} {
    foreach {r1 g1 b1} [rgb $c] {break}
    set r3 [expr {0xff-$r1/256}]
    set g3 [expr {0xff-$g1/256}]
    set b3 [expr {0xff-$b1/256}]
    c255TOchex $r3 $g3 $b3
}

proc raTOxy p {
   ## ra to xy conversion. Was called 'fromPolars'.
   foreach {r a} $p break
   list [expr {$r*cos($a)}] [expr {$r*sin($a)}]
}

proc xyTOra p {
   ## xy to ra conversion. Was called 'toPolars'. 
   foreach {x y} $p break
   # for Sun, we have to make sure atan2 gets no two 0's
   list [expr {hypot($x,$y)}] [expr {$x||$y? atan2($y,$x): 0}]
}

proc xyTOxy_radInvert p {
   ## Inverts the radius of xy points.
   foreach {r a} [xyTOra $p] break
   raTOxy [list [expr {$r? 1/$r: 9999999}] $a]
}

proc xyTOxy_rippleRad {n s p} {
   ## Ripples the radius (sinusoidally) of xy points.
   foreach {r a} [xyTOra $p] break
   raTOxy [list [expr {$r*(1.+$s*sin($n*$a))}] $a]
}

proc nraTOra_slice {n p} {
   ## desc?
   foreach {r a} $p break
   list $r [expr {$a*$n/3.14159265359}]
}

proc axyTOxy_rotate {angle p} {
   ## Rotates xy points thru a given angle.
   foreach {x y} $p break
   set x1 [expr {$x*cos(-$angle) - $y*sin(-$angle)}]
   set y1 [expr {$y*cos(-$angle) + $x*sin(-$angle)}]
   list $x1 $y1
}

proc rxyTOxy_swirl {radius p} {
    ## Moves xy points thru an angle determined by the radius
    ## of the circle on which the point xy lies. Thus 'swirl'.
    foreach {x y} $p break
    set angle [expr {hypot($x,$y)*6.283185306/$radius}]
    axyTOxy_rotate $angle $p
}



##+#####################################################################
## PROCEDURE -- loadfuncs2listbox
##
## Purpose: Loads composite-functions to listbox.
##          Done once, at GUI initialization.
##
## Called by:  an instance at bottom of this Tk script
##+#####################################################################
## The original 'Functional imaging' code at http://wiki.tcl.tk/3523
## loaded the precursor to this listbox (buttons), using 'info procs ...',
## (see code below) creating a button for each proc --- AFTER executing
## the 'o' operator for each (composite-)function to create ALL the procs
## --- even if most of the (composite-)functions would not be used in
## most user sessions.
##+#####################################################################
##
## set n 0
## foreach imf [lsort [info procs "o *"]] {
##    button .f.b[incr n] -text $imf -anchor w -pady 0 \
##        -command [list fim_put $c $imf]
## }
##+#####################################################################

proc loadfuncs2listbox { } {

   ## Make sure the listbox is empty.
   .fRleft.listbox delete 0 end

   #############################################################
   ## Insert each composite-function into the listbox list.
   #############################################################
   ## Insert some of Suchenwirth's original functions first.
   #############################################################
   ## NOTE: We can change the order of funcs in the list by
   ##       moving these 'insert' statements around.
   #############################################################

   .fRleft.listbox insert end {o xyTOchex_bwRings }
   .fRleft.listbox insert end {o xyTOchex_colorGradient }
   .fRleft.listbox insert end {o xyTOchex_bwCheckers }
   .fRleft.listbox insert end {o xyTOchex_grayRings }
   .fRleft.listbox insert end {o xyTOchex_bwVstrip }
   .fRleft.listbox insert end {o xyTOchex_bwXpos-neg }
   .fRleft.listbox insert end {o {0or1TOchex_binaryPaint brown beige} xyTOchex_bwCheckers }
   .fRleft.listbox insert end {o xyTOchex_bwCheckers {nraTOra_slice 10} xyTOra }
   .fRleft.listbox insert end {o xyTOchex_bwCheckers {axyTOxy_rotate 0.1} }
   .fRleft.listbox insert end {o xyTOchex_bwVstrip {rxyTOxy_swirl 1.5} }
   .fRleft.listbox insert end {o xyTOchex_bwCheckers {rxyTOxy_swirl 16} }
   .fRleft.listbox insert end {o {expr-xyTOchex_bwPlot {$y + exp($x)}} }
   .fRleft.listbox insert end {o xyTOchex_bwCheckers xyTOxy_radInvert }
   .fRleft.listbox insert end {o xyTOchex_grayRings {xyTOxy_rippleRad 8 0.3} }
   .fRleft.listbox insert end {o xyTOchex_bwXpos-neg {rxyTOxy_swirl .75} }
   .fRleft.listbox insert end {o xyTOchex_grayCheckers }
   .fRleft.listbox insert end {o {grayTOchex_gPaint red} xyTOchex_grayRings }
   .fRleft.listbox insert end {o {fgxyTOcname_bin2 {nxyTOchex_bwWedges 7} xyTOchex_udisk} }


   ############################################################################
   ## DKF (Donal Fellow) pointed out some of his favourite function combinations:
   ############################################################################

   .fRleft.listbox insert end {o xyTOchex_grayRings {xyTOxy_rippleRad 8 0.3} {rxyTOxy_swirl 16} }
   .fRleft.listbox insert end {o xyTOchex_grayCheckers {xyTOxy_rippleRad 8 0.3} {rxyTOxy_swirl 16} }
   .fRleft.listbox insert end {o xyTOchex_grayCheckers {xyTOxy_rippleRad 6 0.2} {rxyTOxy_swirl 26} }
   ## Yellow Rose: (ill formed?)
   # .fRleft.listbox insert end {o {grayTOchex_gPaint yellow} xyTOchex_grayCheckers {xyTOxy_rippleRad 6 0.2} {rxyTOxy_swirl 26} xyTOra ;# Yellow Rose }
   .fRleft.listbox insert end {o xyTOchex_colorGradient {rxyTOxy_swirl 8} {nraTOra_slice 110} xyTOxy_radInvert }
    ## Toothpaste:
   .fRleft.listbox insert end {o xyTOchex_colorGradient {xyTOxy_rippleRad 8 0.3} {rxyTOxy_swirl 8} xyTOxy_radInvert {rxyTOxy_swirl 8} ;# Toothpaste }


   #############################################################################
   ## And DKF pointed out some stranger ones:
   #############################################################################

   .fRleft.listbox insert end {o {grayTOchex_gPaint yellow} xyTOchex_grayCheckers raTOxy {xyTOxy_rippleRad 6 0.2} {rxyTOxy_swirl 26} xyTOra }
   .fRleft.listbox insert end {o {grayTOchex_gPaint yellow} xyTOchex_grayCheckers xyTOra {xyTOxy_rippleRad 6 0.2} {rxyTOxy_swirl 26} raTOxy }


   ##########################################################################
   ## A few more to try: (Suchenwirth?)
   ##########################################################################

   .fRleft.listbox insert end {o {fgxyTOcname_bin2 xyTOchex_bwCheckers xyTOchex_bwRings} {rxyTOxy_swirl 5} xyTOxy_radInvert }
   .fRleft.listbox insert end {o xyTOchex_colorGradient {xyTOxy_rippleRad 8 .3} {rxyTOxy_swirl 8} }
   .fRleft.listbox insert end {o xyTOchex_bwVstrip {rxyTOxy_swirl 1.5} {xyTOxy_rippleRad 8 .3} }
   .fRleft.listbox insert end {o {expr-xyTOchex_bwPlot {($x*$x-$y*$y)/10}} {rxyTOxy_swirl 15} {xyTOxy_rippleRad 8 .3} }
   ## Two kissing fish:
   .fRleft.listbox insert end {o xyTOchex_grayCheckers {axyTOxy_rotate .1} {nraTOra_slice 10} xyTOxy_radInvert ;# two kissing fish }
   ## Neon galaxy:
   .fRleft.listbox insert end {o xyTOchex_colorGradient raTOxy {rxyTOxy_swirl 16} ;# neon galaxy }


   ##############################################################################
   ## Arjen Markus provided a 'contour' proc and pointed out that an implementation
   ## that will show you the contour plot (isoline-like) of the map f(x,y) = xy.
   ##############################################################################

   .fRleft.listbox insert end {o {fxyTOcname_contour {$x*$y}} }


   ##########################################################################
   ## RS (Suchenwirth) pointed out some 'cute variations' on using 'contour'
   ## --- and on using a 'colorGradient' proc:
   ##########################################################################

   .fRleft.listbox insert end {o {fxyTOcname_contour {($x+$y)*$y}} }
   .fRleft.listbox insert end {o {fxyTOcname_contour {sin($x)/cos($y)}} }
   .fRleft.listbox insert end {o {fxyTOcname_contour {exp($y)-exp($x)}} }
   .fRleft.listbox insert end {o {fxyTOcname_contour {exp($y)-cos($x)}} }
   .fRleft.listbox insert end {o {fxyTOcname_contour {exp($x)*tan($x*$y)}} }
   .fRleft.listbox insert end {o {fxyTOcname_contour {sin($y)-tan($x)}} }
   .fRleft.listbox insert end {o {fxyTOcname_contour {exp($x)-tan($x*$y)}} xyTOra ;# at zoom 20, a weird tropical fish }

   .fRleft.listbox insert end {o xyTOchex_colorGradient xyTOxy_radInvert }
   .fRleft.listbox insert end {o xyTOchex_colorGradient {rxyTOxy_swirl 8} }


   ############################################################################
   ## DKF (Donal Fellow) pointed out the following function
   ## combinations that provide some pretty demos...
   ############################################################################

   .fRleft.listbox insert end {o chexTOchex_invert {grayTOchex_gPaint red} xyTOchex_grayRings }
   .fRleft.listbox insert end {o {fgxyTOchex_g2 {{o xyTOchex_grayRings}} {{o xyTOchex_grayRings {xyTOxy_rippleRad 8 0.3}}}} }
   .fRleft.listbox insert end {o {fgxyTOchex_g+ {{o {grayTOchex_gPaint red} xyTOchex_grayRings}} {{o xyTOchex_grayRings {xyTOxy_rippleRad 8 0.3}}}} }
   .fRleft.listbox insert end {o {fgxyTOchex_g+ {[o {grayTOchex_gPaint red} xyTOchex_grayCheckers {rxyTOxy_swirl 16}]} {{o xyTOchex_grayRings {xyTOxy_rippleRad 8 0.3}}}} }
   .fRleft.listbox insert end {o {fgxyTOchex_g+ {[o {grayTOchex_gPaint red} xyTOchex_grayRings {xyTOxy_rippleRad 8 0.3} {rxyTOxy_swirl 19}]} {[o {grayTOchex_gPaint green} xyTOchex_grayRings {xyTOxy_rippleRad 8 0.3} {rxyTOxy_swirl 20}]}} }
   .fRleft.listbox insert end {o {fgxyTOchex_g+ {[o {grayTOchex_gPaint yellow} xyTOchex_grayRings {xyTOxy_rippleRad 8 0.9} {rxyTOxy_swirl 28}]} {[o {grayTOchex_gPaint blue} xyTOchex_grayRings {xyTOxy_rippleRad 6 1.5} {rxyTOxy_swirl 14}]}} }


   ################################################################
   ## Get the number of composite-functions loaded into the listbox.
   ##
   ## Then show the number of funcs, in a label in the GUI ---
   ## for users to know how many are in the listbox, out of sight.
   ## Also put some GUI usage help info in the label.
   ###############################################################

   set numfuncs [.fRleft.listbox index end]

   .fRright.fRinfo.labelFNUM configure -text "\
$numfuncs composite-functions. Pick one.
Double-click the entry field or press Enter
to (re)execute the composite-function.
Wait about 3 to 50 seconds."

}
## END of 'loadfuncs2listbox' proc



##+#####################################################################
## PROC  listboxSelectionTOentryString
##
## Purpose: Puts the selected listbox line into the ENTRYstring var.
##
## Called by:  binding on button1-release on the listbox
##+#####################################################################

proc listboxSelectionTOentryString {} {

   global ENTRYstring

   set sel_index [ .fRleft.listbox curselection ]

   if { $sel_index != "" } {
      set ENTRYstring  [ .fRleft.listbox get $sel_index ]
   }

}
## END of 'listboxSelectionTOentryString' proc


##+########################
## END of PROC definitions.
##+########################


##+######################################################
##+######################################################
## Additional GUI INITIALIZATION:
##  - Put the composite-function strings in the listbox,
##    by use of the 'loadfuncs2listbox' proc above.
##+######################################################

##+###################################################################
## Suchenwirth said:
## "Composed functions need only be mentioned once, which creates them.
## They can later be picked up by 'info' procs.
## The o looks nicely bullet-ish here."
##
## Executing the (composite-)functions here causes any parameter
## values to be 'hard-coded' into the function name (unless some
## pretty obtuse code is used to overcome that drawback).
##
## If the 'hard-coding' occurs, and you try to change
## a parameter value in the entry field and hit Return,
## you get an 'invalid command' error, because that command name
## (with that particular parameter value) has not been set/defined.
##
## We simply put (composite-)function strings into the
## listbox list, in the 'loadfuncs2listbox' above --- and
## we change Suchenwirth's 'o' (operator) proc slightly.
##+###################################################################
## See the code for proc 'loadfuncs2listbox' above.
##
## Here is an important note that was put in the 'CANONICAL Structure
## of This Code' comments section at the top of this script. The
## note is important enough to repeat here, to make it likely that
## users will see this.
##
## ****
## NOTE: If a new (composite-)function is to be added to the listbox:
## ****
##       1) Any new procs needed should be added to the procs section.
##       2) The new (composite-)function, formed using the 'o'
##          operator/proc, should be added in a 'listbox-insert' command,
##          in the load-the-listbox proc.
##+###################################################################

loadfuncs2listbox