Functional Imaging with a High-Capacity GUI
uniquename 2012-08-13:
I am interested in making nice images for 'toolchest' and 'drawer' backgrounds, as I have indicated at Experiments in making embellished GUI's and at A color-gradient-button-maker GUI.
In doing some searches on this wiki, I ran across the Functional imaging page of Suchenwirth. I assembled the code from that page and was impressed by how quickly it could generate images from one or more functions that work singly or together to map the pixels in a rectangular canvas into colors or shades of gray.
There were over 40 (composite-)functions on that page (from Suchenwirth, DKF, and one or two others) that I might like to try out --- someday.
I am using '(composite-)function' to indicate either a single function f(x,y) or a compound function, like f(g(x,y)), f(g(h(x,y))), ...
The demo GUI at Functional imaging used a stack of buttons on the left of the GUI to present (composite-)functions that will draw into a canvas on the right side of the GUI. But that stack of buttons limits the number of (composite-)functions, that can be conveniently and quickly run, to about 15 or 20.
So I decided to change the GUI to use a listbox instead of buttons, and to put all 40-plus donated (composite-)functions into the GUI.
Here is an image (slightly reduced from actual size) that indicates the GUI that resulted.
_____________________________________________________________________
Below is the code that produced this GUI --- including ALL the donated procs and (composite-)functions from the Functional imaging page.
The procs are used to make the (composite-)functions.
There are comments at the top and bottom of this sample code that describe how anyone could add to the procs and the (composite-)functions.
If anyone has enough free time to do such a wacky thing, they could use a copy of this code to test their new (composite-)function --- and any new 'mapping' procs that they had to add, to implement their (composite-)function.
Contributors can change their copy of this code however they like. Just keep the code on this page relatively unchanged --- except for inserting new (composite-)functions in the listbox-loading proc --- and inserting new procs in the PROCS section --- with a dated-note at the bottom of the page telling what was added.
That is, all I ask is that people preserve the basic 'canonical' structure of this code:
0) Set general window parms (win-name, win-position, win-color-scheme,
fonts, widget-geom-parameters, win-size-control).
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.This structure is discussed in more detail on the page A Canonical Structure for Tk Code --- and variations.
____________________________________________________________________
I should point out one other major change that I made, compared to the Functional imaging page code (besides the change from buttons to a listbox): I changed the names of the procs used to make the (composite-)functions.
Most of the 'transform'/'mapping' procs are of 3 types:
- point-to-color
- color-to-color
- point-to-pointIn 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 procs (presented to the user in the listbox) 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 'dTOchex_' - a decimal number (scalar) is mapped to a hex-color '0or1TOchex_' - a one-digit binary number (0 or 1) is mapped to a hex-color 'fgxyTOchex_' - 2 funcs, indicated by 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.
(Note to myself: I need to sweep through the procs to see if I should should change 'chex' and 'hex-color' in some proc names and their descriptions to 'rgb255' and 'rgb255-color'.)
________________________________________________________________________
That said, here's the code --- with plenty of comments to describe what most of the code-sections are doing. Since some of the coding techniques here are rather esoteric, the comments might help Tcl-Tk coding 'newbies' who might just give up if the code looked too cryptic.
Code for the Tk script 'createImages_withFunctions.tk' :
#!/usr/bin/wish -f
##+###########################################################################
##
## SCRIPT: createImages_withFunctions_wiki3523_chgButtonsToListbox_prefixFuncNames.tk
##
## Based on a 'Functional Imaging' script published by Richard Suchenwirth,
## circa 2002, at https://wiki.tcl-lang.org/3523
##
## DESCRIPTION OF ORIGINAL SCRIPT: (paraphrased from https://wiki.tcl-lang.org/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 https://wiki.tcl-lang.org/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:
## https://wiki.tcl-lang.org/3523 "Functional imaging"
## (downloaded the pieces and assembled them on 2012aug02)
##
## Also see https://wiki.tcl-lang.org/2755, "Functional composition".
##
## Also see https://wiki.tcl-lang.org/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
## 'dTOchex_' - a decimal number (scalar) 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 (win-name, win-position, win-size-control,
## win-color-scheme, fonts, widget-goom-parms, 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
## https://wiki.tcl-lang.org/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'.
## Changed by: Poor Yorick 2014-04-11 use apply instead of `eval`. Break
## up fin_make to be more event-oriented.
## In functions,b` use {*} instead of
## `eval`. Eliminate bracketsSTRING by
## modifying o to return an anonymous proc.
##+########################################################################
##+#######################################################################
## Set general window parms (title,position,size,color-scheme,fonts,etc.).
##+#######################################################################
package require Tk
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 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
namespace export {[a-z]*}
namespace ensemble create
variable entryBKGD #ffffff
variable 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
proc gui {id} {
namespace eval $id {
## FOR TESTING:
# puts "minWinWidthPx = $minWinWidthPx"
# puts "minWinHeightPx = $minWinHeightPx"
##+################################################################
## DEFINE *ALL* THE FRAMES:
##
## Top-level : '.fRleft' , '.fRright'
##
## Sub-frames: '.fRright.fRcan' and '.fRright.fRinfo' and
## '.fRright.fRcontrols'
##+################################################################
frame $w.fRleft -relief $RELIEF_frame -borderwidth $BDwidth_frame
frame $w.fRright -relief $RELIEF_frame -borderwidth $BDwidth_frame
frame $w.fRright.fRcan -relief raised -bd $BDwidth_frame
frame $w.fRright.fRinfo -relief $RELIEF_frame -bd $BDwidth_frame
frame $w.fRright.fRcontrols -relief $RELIEF_frame -bd $BDwidth_frame
##+##############################
## PACK the FRAMES.
##+##############################
pack $w.fRleft \
-side left \
-anchor nw \
-fill y \
-expand 0
pack $w.fRright \
-side left \
-anchor nw \
-fill both \
-expand 1
## Pack the sub-frames.
pack $w.fRright.fRcan \
-side top \
-anchor nw \
-fill both \
-expand 1
pack $w.fRright.fRinfo \
$w.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 $w.fRleft.listbox \
-width $initListboxWidthChars \
-height $initListboxHeightChars \
-font fontTEMP_fixedwidth \
-relief raised \
-borderwidth $BDwidthPx_listbox \
-state normal \
-yscrollcommand [list $w.fRleft.scrbary set] \
-xscrollcommand [list $w.fRleft.scrbarx set]
## Could experiment with
## -width 0 \
## -height 0 \
## and the -'fill' & 'expand' pack parms for '.fRleft'.
scrollbar $w.fRleft.scrbary \
-orient vertical \
-command [list $w.fRleft.listbox yview]
scrollbar $w.fRleft.scrbarx \
-orient horizontal \
-command [list $w.fRleft.listbox xview]
## Pack the listbox and its scrollbars.
pack $w.fRleft.scrbary \
-side right \
-anchor e \
-fill y \
-expand 0
pack $w.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 $w.fRleft.listbox \
-side top \
-anchor nw \
-fill both \
-expand 1
##+###############################
## DEFINE-and-PACK CANVAS WIDGET:
##+###############################
canvas $w.fRright.fRcan.can \
-width $initCanWidthPx \
-height $initCanHeightPx \
-relief raised \
-borderwidth $BDwidthPx_canvas
pack $w.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 $w.fRright.fRinfo.labelFNUM \
-font fontTEMP_varwidth \
-justify left \
-anchor w \
-relief flat \
-bd 0
# -text {} \
label $w.fRright.fRinfo.labelZOOM \
-text "\
Zoom
img
on
canvas:" \
-font fontTEMP_varwidth \
-justify right \
-anchor w \
-relief flat \
-bd 0
scale $w.fRright.fRinfo.scaleZOOM \
-from 1 -to 100 \
-variable [namespace current]::zoom \
-ori hori \
-width 5
## Pack the '.fRinfo' frame's widgets.
pack $w.fRright.fRinfo.labelFNUM \
-side left \
-anchor w \
-fill none \
-expand 0
pack $w.fRright.fRinfo.scaleZOOM \
$w.fRright.fRinfo.labelZOOM \
-side right \
-anchor e \
-fill none \
-expand 0
##+#################################
## DEFINE-and-PACK 'CONTROL' WIDGETS
## --- button(s), entry field.
##+#################################
button $w.fRright.fRcontrols.buttEXIT \
-text Exit \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command exit
entry $w.fRright.fRcontrols.entCMD \
-textvariable [namespace current]::ENTRYstring \
-bg $entryBKGD \
-font fontTEMP_fixedwidth \
-width $initEntryWidthChars \
-relief sunken \
-bd $BDwidthPx_entry
## Pack the control widgets.
pack $w.fRright.fRcontrols.buttEXIT \
-side left \
-anchor w \
-fill none \
-expand 0
pack $w.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 $w.fRleft.listbox <<ListboxSelect>> [namespace code [
list [namespace current] listboxSelectionTOentryString]]
bind $w.fRleft.listbox <Return> [
list [namespace current] fim_put]
bind $w.fRright.fRcontrols.entCMD <Return> [
list [namespace current] fim_put]
bind $w.fRright.fRcontrols.entCMD <Double-ButtonRelease-1> [
list [namespace current] fim_put]
}
$id loadfuncs2listbox
}
proc new {id w} {
set id [namespace eval $id {
namespace export *
namespace ensemble create
namespace path [namespace parent]
#quickest object system in The West!
namespace ensemble configure [namespace current] -unknown [
list apply [list args {
set args [lassign $args[set args {}] ns cmd]
list [namespace current] $cmd $ns
} [namespace parent]]]
variable running {}
# var of the scale widget
variable zoom 25
##+###########################################################
## SET GEOM VARS FOR THE VARIOUS WIDGET DEFINITIONS.
## (e.g. width and height of canvas, and padding for Buttons)
##+###########################################################
variable initCanWidthPx 300
variable initCanHeightPx 300
variable minCanWidthPx 24
variable minCanHeightPx 24
# variable BDwidthPx_canvas 2
variable BDwidthPx_canvas 0
## BUTTON widget geom settings:
variable PADXpx_button 0
variable PADYpx_button 0
variable BDwidthPx_button 2
## ENTRY widget geom settings:
variable BDwidthPx_entry 2
variable initEntryWidthChars 50
## LISTBOX geom settings:
variable BDwidthPx_listbox 2
variable initListboxWidthChars 50
variable 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.
##+######################################################
variable 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.
variable minWinWidthPx [expr {20
+ ($initListboxWidthChars * $charWidthPx)
+ ($initEntryWidthChars * $charWidthPx)}]
variable 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.
variable minWinHeightPx [expr {28 + ($initListboxHeightChars * $charHeightPx)}]
wm minsize . $minWinWidthPx $minWinHeightPx
# set BDwidth_frame 0
variable BDwidth_frame 2
# set RELIEF_frame raised
variable RELIEF_frame flat
namespace current
}]
set ${id}::w $w
$id gui
set id
}
##+##################################################################
##+##################################################################
## 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
## 'dTOchex_' - a decimal number (scalar) 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.
## Returns an anonymous procedure implementing the function
## combination.
##+#########################################################################
proc o args {
## 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"
##rather than returning the name of an 'o *' proc,
##return an anonymous procedure that implements the (composite-)
##function in the in left-and-right-bracket form,
return [list apply [list xy $body [namespace current]]]
## 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 id {
foreach varname {ENTRYstring running w t0} {
upvar 0 ${id}::$varname $varname
}
wm title . "*BUSY* ...... Calculating using: $ENTRYstring"
## Clear the canvas.
after cancel $running
$w.fRright.fRcan.can delete all
## Set the current time, for determining execution
## time for building the photo image, below.
set t0 [clock clicks]
## Put an image in the canvas, using proc 'fim_make' to make the image.
after idle [list $id fim_make]
}
## END OF proc 'fim_put'
proc fim_putfinish id {
foreach varname {im ENTRYstring t0} {
upvar 0 ${id}::$varname $varname
}
## Reset the cursor from a 'watch' cursor.
. config -cursor {}
## Change the title of the window to show execution time.
wm title . "DONE. [
expr {[clock clicks]-$t0}] clicks elapsed using: $ENTRYstring"
}
##+######################################################################
## 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 an 'o' command, which in turn returns an anonymous function
## implementing the fuctions.
## Uses var zoom, from the scale widget.
## Applies the anonymous procedure returned by evaluating ENTRYstring
##
## 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 id {
foreach name {ENTRYstring im w zoom} {
upvar 0 ${id}::$name $name
}
## Change the cursor to a 'watch' cursor.
. config -cursor watch
## Get the current width & height of the canvas (in pixels).
set width [winfo width $w.fRright.fRcan.can]
set height [winfo height $w.fRright.fRcan.can]
## Initialize an image structure.
set im [image create photo -height $height -width $width]
$w.fRright.fRcan.can create image 0 0 -anchor nw -image $im
set function [{*}$ENTRYstring]
## Make the x values for the x argument of the (composite-)function
## --- relative to an origin in the middle of the canvas.
for {set j 0} {$j < $width} {incr j} {
lappend xs [expr {($j-$width/2.)/$zoom}]
## FOR TESTING:
# if {$j == 30} {puts "xs: $xs"}
}
$id fim_making $im $function $xs 0 $width $height
}
## END OF proc 'fim_make'
proc fim_making {id im function xs i width height} {
#############################################################
## 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 image data row by row.
#############################################################
upvar 0 ${id}::zoom zoom
upvar 0 ${id}::running running
variable ENTRYstring
if {$i >= $height} {
after idle [list $id fim_putfinish]
return
}
set y [expr {($i-$height/2.)/$zoom}]
foreach x $xs {
## FOR TESTING:
# puts "i: $i y: $y"
## FOR TESTING:
# if {$i == 30} {puts "row: $row"}
set xy [list $x $y]
## apply the function and attach the color result
## to var 'row'. (Note that the function was returned by evaluating
## $ENTRYstring (a call to 'o'), and takes one argument: $xy
if [catch {lappend row [{*}$function $xy]} cres copts] {
.fRright.fRcan.can create text 10 10 -anchor nw -text $::errorInfo
## Reset the cursor from a 'watch' cursor.
. config -cursor {}
return
}
}
$im put [list $row[set row {}]] -to 0 $i
incr i
set running [after idle [list $id fim_making $im $function $xs $i $width $height]]
}
##+######################################################################
##+######################################################################
## 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 dTOchex_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 eq "#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] ne [eval $f2]}]
}
proc fgxyTOchex_and {f1 f2 p} {
lappend f1 $p; lappend f2 $p
0or1TOchex_whiteORblack [expr {[eval $f1] eq "#000" && [eval $f2] eq "#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
dTOchex_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
dTOchex_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 [{*}$f1 $p]
set b [{*}$f2 $p]
expr {
$a eq "#000" ?
$b eq "#000" ? "green"
: "yellow"
: $b eq "#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 [{*}[{*}$f1] $p]] {break}
foreach {r2 g2 b2} [rgb [{*}[{*}$f2] $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 [{*}[{*}$f1] $p]] {break}
foreach {r2 g2 b2} [rgb [{*}[{*}$f2] $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 [{*}[{*}$f1] $p]]] {break}
foreach {r2 g2 b2} [rgb [{*}[{*}$f2] $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 https://wiki.tcl-lang.org/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 id {
upvar 0 ${id}::w w
## Make sure the listbox is empty.
$w.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.
#############################################################
$w.fRleft.listbox insert end {o xyTOchex_bwRings }
$w.fRleft.listbox insert end {o xyTOchex_colorGradient }
$w.fRleft.listbox insert end {o xyTOchex_bwCheckers }
$w.fRleft.listbox insert end {o xyTOchex_grayRings }
$w.fRleft.listbox insert end {o xyTOchex_bwVstrip }
$w.fRleft.listbox insert end {o xyTOchex_bwXpos-neg }
$w.fRleft.listbox insert end {o {0or1TOchex_binaryPaint brown beige} xyTOchex_bwCheckers }
$w.fRleft.listbox insert end {o xyTOchex_bwCheckers {nraTOra_slice 10} xyTOra }
$w.fRleft.listbox insert end {o xyTOchex_bwCheckers {axyTOxy_rotate 0.1} }
$w.fRleft.listbox insert end {o xyTOchex_bwVstrip {rxyTOxy_swirl 1.5} }
$w.fRleft.listbox insert end {o xyTOchex_bwCheckers {rxyTOxy_swirl 16} }
$w.fRleft.listbox insert end {o {expr-xyTOchex_bwPlot {$y + exp($x)}} }
$w.fRleft.listbox insert end {o xyTOchex_bwCheckers xyTOxy_radInvert }
$w.fRleft.listbox insert end {o xyTOchex_grayRings {xyTOxy_rippleRad 8 0.3} }
$w.fRleft.listbox insert end {o xyTOchex_bwXpos-neg {rxyTOxy_swirl .75} }
$w.fRleft.listbox insert end {o xyTOchex_grayCheckers }
$w.fRleft.listbox insert end {o {grayTOchex_gPaint red} xyTOchex_grayRings }
$w.fRleft.listbox insert end {o {fgxyTOcname_bin2 {nxyTOchex_bwWedges 7} xyTOchex_udisk} }
############################################################################
## DKF (Donal Fellow) pointed out some of his favourite function combinations:
############################################################################
$w.fRleft.listbox insert end {o xyTOchex_grayRings {xyTOxy_rippleRad 8 0.3} {rxyTOxy_swirl 16} }
$w.fRleft.listbox insert end {o xyTOchex_grayCheckers {xyTOxy_rippleRad 8 0.3} {rxyTOxy_swirl 16} }
$w.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 }
$w.fRleft.listbox insert end {o xyTOchex_colorGradient {rxyTOxy_swirl 8} {nraTOra_slice 110} xyTOxy_radInvert }
## Toothpaste:
$w.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:
#############################################################################
$w.fRleft.listbox insert end {o {grayTOchex_gPaint yellow} xyTOchex_grayCheckers raTOxy {xyTOxy_rippleRad 6 0.2} {rxyTOxy_swirl 26} xyTOra }
$w.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?)
##########################################################################
$w.fRleft.listbox insert end {o {fgxyTOcname_bin2 xyTOchex_bwCheckers xyTOchex_bwRings} {rxyTOxy_swirl 5} xyTOxy_radInvert }
$w.fRleft.listbox insert end {o xyTOchex_colorGradient {xyTOxy_rippleRad 8 .3} {rxyTOxy_swirl 8} }
$w.fRleft.listbox insert end {o xyTOchex_bwVstrip {rxyTOxy_swirl 1.5} {xyTOxy_rippleRad 8 .3} }
$w.fRleft.listbox insert end {o {expr-xyTOchex_bwPlot {($x*$x-$y*$y)/10}} {rxyTOxy_swirl 15} {xyTOxy_rippleRad 8 .3} }
## Two kissing fish:
$w.fRleft.listbox insert end {o xyTOchex_grayCheckers {axyTOxy_rotate .1} {nraTOra_slice 10} xyTOxy_radInvert} ;# two kissing fish
## Neon galaxy:
$w.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.
##############################################################################
$w.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:
##########################################################################
$w.fRleft.listbox insert end {o {fxyTOcname_contour {($x+$y)*$y}} }
$w.fRleft.listbox insert end {o {fxyTOcname_contour {sin($x)/cos($y)}} }
$w.fRleft.listbox insert end {o {fxyTOcname_contour {exp($y)-exp($x)}} }
$w.fRleft.listbox insert end {o {fxyTOcname_contour {exp($y)-cos($x)}} }
$w.fRleft.listbox insert end {o {fxyTOcname_contour {exp($x)*tan($x*$y)}} }
$w.fRleft.listbox insert end {o {fxyTOcname_contour {sin($y)-tan($x)}} }
# at zoom 20, a weird tropical fish
$w.fRleft.listbox insert end {o {fxyTOcname_contour {exp($x)-tan($x*$y)}} xyTOra}
$w.fRleft.listbox insert end {o xyTOchex_colorGradient xyTOxy_radInvert }
$w.fRleft.listbox insert end {o xyTOchex_colorGradient {rxyTOxy_swirl 8} }
############################################################################
## DKF (Donal Fellow) pointed out the following function
## combinations that provide some pretty demos...
############################################################################
$w.fRleft.listbox insert end {o chexTOchex_invert {grayTOchex_gPaint red} xyTOchex_grayRings }
$w.fRleft.listbox insert end {o {fgxyTOchex_g2 {o xyTOchex_grayRings} {o xyTOchex_grayRings {xyTOxy_rippleRad 8 0.3}}}}
$w.fRleft.listbox insert end {o {fgxyTOchex_g+ {o {grayTOchex_gPaint red} xyTOchex_grayRings} {o xyTOchex_grayRings {xyTOxy_rippleRad 8 0.3}}} }
$w.fRleft.listbox insert end {o {fgxyTOchex_g+ {o {grayTOchex_gPaint red} xyTOchex_grayCheckers {rxyTOxy_swirl 16}} {o xyTOchex_grayRings {xyTOxy_rippleRad 8 0.3}}} }
$w.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}}} }
$w.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 [$w.fRleft.listbox index end]
$w.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 id {
upvar 0 ${id}::w w
set sel_index [$w.fRleft.listbox curselection]
if {$sel_index ne {}} {
set ${id}::ENTRYstring [$w.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 'up-front' 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.
##+###################################################################
set myframe [frame .[info cmdcount]]
pack $myframe -expand 1 -fill both
new [info cmdcount] $myframe
#multiple widget instances!
#set myframe2 [frame .[info cmdcount]]
#pack $myframe2 -expand 1 -fill both
#new [info cmdcount] $myframe2
Now I have a tool to do some experimenting to see what kinds of functions --- or function combinations --- make nice color-gradient images --- to use in decorating Tk GUI's.
Thanks, Suchenwirth, for your many contributions to this site. I hope you don't mind my building on your code and the techniques that you provided in your code sample. (I really had to look at some of those code statements for quite a while, and do some code testing, and re-read your comments a few times, to figure out some of the 'tricks' that you were using.)
Here is one more image with which to end this page. Nice swirl.
Note that you can use this utility to test the performance of your computers --- desktops, laptops, netbooks. Choose one of these (composite-)functions from the listbox and run it on each of your computers. Record the run time, shown in the title bar, for each run.
Change Log
PYK 2014-04-12: While playing with this program, I noticed that the changes uniquename made to o broke the functions contributed to Functional imaging by DKF (and included in this program). I saw what uniquename was trying to accomplish with the change, and decided to carry it through to make all the currently-available function compositions operational. o now returns a function which can be executed via {*}$function. DKF's _g* functions were modified accordingly, resulting in some wonderful (:/) syntax:
[{*}[{*}$f1] $p]Could it be done in a more straight-forward manner? Yes, and that's probably the most logical thing to do next. It's interesting to note the progression:
- RS' Functional imaging presents some novel techniques
- uniquename notices some missing functionality, and tries to add it
- PYK continues the progression, while trying to maintain some semblence of what was interesting about the Functional imaging methods
- The clear way forward is to drop the code generation trick and go with a more standard pattern of passing a sequence of commands
While making these changes, I also made a few others:
- make program more event-loop friendly by replacing the tight loop with a proc that reschedules itself.
- add data directly to the image instead of collecting it into another variable and updating at the end. This is not quite as dramatic visually, but serves double duty as a progress indicator.
- replace eval with apply, improving performance quite a bit
- widgetize so that multiple instances can be created
PYK: uniquename, if you would rather see these changes on a different page, go ahead and revert this edit, and I'll find a new home for the modified code.