#!/usr/bin/wish -f ##+########################################################################### ## ## SCRIPT: photoFile_editing_viaFunctions.tk ## ## PURPOSE: This script serves to edit image files via functions. The image ## files may be GIF files --- and PNG eventually, using 8.6.x ## versions of the 'wish' interpreter. ## ## This script provides a Tk GUI with the following widgets. ## ## 1) There is a FILENAME-ENTRY FIELD and 'Browse ...' BUTTON with ## which to get an image file to place on the canvas widget of ## this GUI. ## ## 2) There is a LISTBOX (on the left of the GUI) which provides a ## list of (composite-)functions that can be applied to the x,y ## locations of the pixels of the retrieved image. ## ## The functions --- or composite of functions --- map an ## x,y pixel location to a color. ## ## In other words, given a user-selected (composite-)function: ## For each x,y location in a new image (of the same size as ## the current image in the canvas), the color of the pixel ## at that x,y location is calculated by applying the ## (composite-)function --- and any of its parameters --- ## to whatever information we can glean via the x,y value ## passed into the (composite-)function. ## ## Note that we are not restricted to mapping a color at ## a given x,y location to a new color based on the original ## color at that location in the original image. ## ## For example, we could simply set the color of ## an xy pixel in the new image according to a math function ## independent of the current color at xy in the original image. ## This would mean that this utility can function like an ## image creation utility, like the 'Functional imaging' ## utility demo-ed by Suchenwirth at http://wiki.tcl.tk/3523. ## ## Ideally, we could, for example, create a function to 'flip' ## the original image around a horizontal axis by mapping ## the colors in rows at the top of the image to the bottom ## of the new image -- and proceeding with the 'flip' over ## all the rows of the new image. ## ## In fact, we can probably do various kinds of 'blur' operation, ## by devising functions that use colors at neighboring pixels as ## parameters/variables in the mapping to a new color. That is, ## colors at x+n,x-n,y+n,y-n, where n=1,2,3,... , as well as the ## color at x and y in the original image, can serve to determine ## a color at x,y in the new image. ## ## Hopefully, we can do operations like 'flip' and 'blur' ## without overhauling the 'fimg_make' proc that calls ## the specified (composite-)function --- row by row (i.e. ## varying x faster than y --- and passing only the values x,y at ## each point x,y in the double-loop. ## ## Since the entire 'img1' structure is available to the ## given (composite-)function --- and since we are putting the ## new color values in a separate 'img2' image structure/buffer ## in memory, hopefully, we can accomplish almost any ## kind of image transformation --- with the current double-loop ## implementation of the 'fimg_make' proc. ## ## If necessary, we could make a function that makes the ## entire image in the 'img2' buffer when x,y=0,0. And then ## the function would do nothing for the other values of x and y. ## ## There is more on the nature of the (composite)-functions ## in a 'DESCRIPTION OF THE COMPOSITE-FUNCTIONS' section below.) ## ## 3) a FUNCTION-ENTRY FIELD which holds a (composite-)function ## that was selected from the listbox. (The user double-clicks ## on the entry field --- or presses the Return/Enter key --- to ## cause the selected (composite-)function to be applied to ## the current image in the canvas. And the user may change ## any parameter values that appear in the entry field.) ## ########################### ## REFERENCES (and credits): ## ## - The 'Functional Imaging' script published by Richard Suchenwirth, ## circa 2002, at http://wiki.tcl.tk/3523. ## ## - The 'Functional Imaging' script was enhanced/generalized in the script ## published by Blaise Montandon 2012aug, at http://wiki.tcl.tk/36786 - ## 'Functional Imaging with a High-Capacity GUI'. ## ## - Various photo-image processing scripts by 'ulis' (French, died circa 2008) ## such as the script at 'Coloring a gray image' - http://wiki.tcl.tk/9666, ## posted circa 2003. ## ## See other posts by 'ulis'- some with improvements by others: ## - http://wiki.tcl.tk/10521 - Blurring an image ## - http://wiki.tcl.tk/10543 - Embossing an image ## - http://wiki.tcl.tk/10523 - Crisping an image ## - http://wiki.tcl.tk/10520 - Expanding an image ## - http://wiki.tcl.tk/10524 - Image Processing with HSV ## - http://wiki.tcl.tk/10504 - Shrinking an image ## These give ideas for new functions to add to this script. ## ## Related posts by Richard Suchenwirth: ## - http://wiki.tcl.tk/8448 - Image scaling ## - http://wiki.tcl.tk/4022 - Photo image rotation ## - http://wiki.tcl.tk/9521 - TkPhotoLab ## - http://wiki.tcl.tk/15163 - Drawing lines in photo images ## ## Related posts by David Easton: ## - http://wiki.tcl.tk/11196 - Fast image resizing ## ## Related posts by 'kroc': ## - http://wiki.tcl.tk/9045 - Canvas2Image ## ## Related posts by 'elfo': ## - http://wiki.tcl.tk/1155 - Canvas pixel painting ## ## Related posts by 'SRIV': ## - http://wiki.tcl.tk/14633 - Enhancing Satellite Weather Images ## ################################################################### ## DESCRIPTION OF THE COMPOSITE-FUNCTIONS: ## ## (Some of this description is paraphrased from Suchenwirth's description ## of the (composite-)functions at the 'Functional Imaging' web page, at ## http://wiki.tcl.tk/3523.) ## ## 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 the 'proc o' below in this code.) ## ## 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. ## ## I follow a standard in naming the 'mapper' procs. I use function names ## with prefixes that indicate the type of input and output. Examples: ## ## 'rgb255-xyTOchex_' - an xy point (and rgb color, 0-255) is mapped to a hex-color ## 'chex-xyTOchex_' - an xy point (and hex color) is mapped to a hex-color ## 'xyTOchex_' - an xy point is mapped to a hex-color (this would ignore ## the color at the xy pixel; this could result in new ## image generation rather than editing of the 'photo' img) ## 'chexTOchex_' - a hex-color is mapped to a hex-color ## 'rgb255TOchex_' - an rgb-color (0-255) 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. ## ############################# ## THE FUNCTION-ENTRY WIDGET: ## ## The (function-)ENTRY widget on the GUI is provided so that users can change ## parameter defaults of the functions that are provided with value(s) ## for parameter(s). ## ##+####################################################################### ## '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 ## and a file-selection entry-button pair above the canvas ## ## Sub-frames of 'fRleft': none, just one listbox widget with xy scrollbars ## ## Sub-frames of 'fRright' (top to bottom): ## 'fRfile' - to contain a triplet: label-entry-button widgets ## 'fRcan' - to contain the canvas widget. ## 'fRinfo' - to contain a label widget (for info). ## '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 filename entry field ## - Button1-release on the listbox ## - Return key press on the function-entry widget ## - Double-Button1-release on the function-entry widget ## ## 4) Define procs: ## - a proc to get the image filename ## - a function-composition operator 'o' ## - two procs to make and put an image on the canvas, from a given ## composite-function --- 'fimg_put', 'fimg_make' ## - about 20-plus 'transform'/'mapping' procs, eventually ## - a load-the-listbox proc, for GUI initialization ## - a put-a-selected-listbox-line-into-the-function-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 MAPPING PROCS ## section below. ## 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 (if font handling is made 'old-style'). ##+####################################################################### ## MAINTENANCE HISTORY: ## Started by: Blaise Montandon 2010aug20 Started development, on Ubuntu 9.10, ## based on my code at ## http://wiki.tcl.tk/36786 - ## "Functional Imaging with a ## High-Capacity GUI". ## Changed by: Blaise Montandon 2012aug21 Add 'Stop' button. ##+######################################################################## ##+####################################################################### ## Set general window parms (title,position,size,color-scheme,fonts,etc.). ##+####################################################################### wm title . "Image Editing by Functions" wm iconname . "ImgFuncEdit" 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" 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 20 ## LISTBOX geom settings: set BDwidthPx_listbox 2 set initListboxWidthChars 30 set initListboxHeightChars 8 ##+###################################################### ## Set a minsize of the window according to the ## approx min width of the listbox and function-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 '.fRfile' 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.fRfile -relief $RELIEF_frame -bd $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 both \ -expand 1 pack .fRright \ -side left \ -anchor nw \ -fill both \ -expand 1 ## Pack the sub-frames. pack .fRright.fRfile \ -side top \ -anchor nw \ -fill x \ -expand 0 pack .fRright.fRcan \ -side top \ -anchor nw \ -fill both \ -expand 1 pack .fRright.fRinfo \ .fRright.fRcontrols \ -side top \ -anchor nw \ -fill x \ -expand 0 ##+############################### ## In FRAME '.fRleft' - ## DEFINE-and-PACK a LISTBOX WIDGET, ## with scrollbars: ##+###################################################### ## 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 ##+############################### ## In FRAME '.fRright.fRfile' - ## DEFINE-and-PACK 3 widgets - ## LABEL, ENTRY, BUTTON: ##+############################### label .fRright.fRfile.labelFILE \ -text "ImgFilename (GIF/PNG):" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd 0 set ENTRYfilename "" entry .fRright.fRfile.entFILENAME \ -textvariable ENTRYfilename \ -bg $entryBKGD \ -font fontTEMP_fixedwidth \ -width $initEntryWidthChars \ -relief sunken \ -bd $BDwidthPx_entry button .fRright.fRfile.buttBROWSE \ -text "Browse ..." \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {get_img_filename} ## Pack the control widgets. pack .fRright.fRfile.labelFILE \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRright.fRfile.entFILENAME \ -side left \ -anchor w \ -fill x \ -expand 1 pack .fRright.fRfile.buttBROWSE \ -side left \ -anchor w \ -fill none \ -expand 0 ##+############################### ## In FRAME '.fRright.fRcan' - ## DEFINE-and-PACK a 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 ##+######################################### ## In FRAME '.fRright.fRinfo' - ## 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 "" \ ## Pack the '.fRinfo' frame's widgets. pack .fRright.fRinfo.labelFNUM \ -side left \ -anchor w \ -fill none \ -expand 0 ##+################################# ## In FRAME '.fRright.fRcontrols' - ## 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 STOPflag 0 button .fRright.fRcontrols.buttSTOP \ -text "Stop" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {set STOPflag 1} # button .fRright.fRcontrols.buttHELP \ # -text "Help" \ # -font fontTEMP_varwidth \ # -padx $PADXpx_button \ # -pady $PADYpx_button \ # -relief raised \ # -bd $BDwidthPx_button \ # -command {help} set ENTRYfunc "" entry .fRright.fRcontrols.entCMD \ -textvariable ENTRYfunc \ -bg $entryBKGD \ -font fontTEMP_fixedwidth \ -width $initEntryWidthChars \ -relief sunken \ -bd $BDwidthPx_entry ## Pack the control widgets. pack .fRright.fRcontrols.buttEXIT \ .fRright.fRcontrols.buttSTOP \ -side left \ -anchor w \ -fill none \ -expand 0 ## .fRright.fRcontrols.buttHELP \ 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-release on a listbox line, ## put that line (function) in ENTRYfunc. ## ## - For Enter-key-press in the entry field, ## use the ENTRYfunc to draw in the canvas. ## - For MB1-release in the entry field, ## use the ENTRYfunc to draw in the canvas. ##+####################################################################### bind .fRright.fRfile.entFILENAME { # image create photo img1 -file "$ENTRYfilename" set img1 [image create photo -file "$ENTRYfilename"] .fRright.fRcan.can create image 0 0 -anchor nw -image $img1 } bind .fRleft.listbox { listboxSelectionTOentryString } bind .fRright.fRcontrols.entCMD { fim_put } bind .fRright.fRcontrols.entCMD { fim_put } ##+################################################################## ##+################################################################## ## DEFINE PROCS SECTION: ## ## - 'get_img_filename' - to get the filename of an image (GIF/PNG) file ## and place the image on the canvas ## ## - 'o' - the function-composition proc ## ## - 'fim_put' - calls 'fim_make' to make the new image, in ## an image-holding instance, img2 say, then clears ## the canvas and puts the new image in img1, ## which is put on the canvas. ## ## (So img1 holds the currently displayed image, ## and img2 holds the in-process image. This ## is essentially a 'double-buffering' technique.) ## ## ('fim' short for 'functional image' --- duh.) ## ## - 'fim_make' - applies the selected (composite-)function ## to the pixels in img1, putting the result in img2. ## ## - 'stop' - sets the STOPflag var to 1. (That global var is ## checked in 'fim_make' at each row, and, if it is ## 1, 'fim_make' resets it to 0 and issues 'return'.) ## ## 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, ENTRYfunc. ## ##+################################################################# ## 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 'get_img_filename' - ## ## To get the name of an image file (GIF/PNG) and put the ## filename into global var 'ENTRYfilename'. ## ## Used by: the '-command' option of the 'Browse ...' button. ##+######################################################################### # set curDIR "$env(HOME)" set curDIR [pwd] proc get_img_filename {} { global ENTRYfilename env curDIR img1 ## Load data from an OBJ file set fName [tk_getOpenFile -parent . -title "Select GIF/PNG file to load" \ -initialdir "$curDIR" ] ## FOR TESTING: # puts "fName : $fName" if {[file exists $fName]} { set ENTRYfilename "$fName" set CURdir [ get_chars_before_last / in "$ENTRYfilename" ] # image create photo img1 -file "$ENTRYfilename" set img1 [image create photo -file "$ENTRYfilename"] ## FOR TESTING: # puts "get_img_filename - img1: $img1" .fRright.fRcan.can create image 0 0 -anchor nw -image $img1 } } ## END OF proc 'get_img_filename' ######################################################################### ## Proc 'get_chars_before_last' - ######################################################################### ## INPUT: A character and a string. ## Note: The "in" parameter is there only for clarity. ## ## OUTPUT: Returns all of the characters in the string "strng" that ## are BEFORE the last occurence of the characater "char". ## ## EXAMPLE CALL: To extract the directory from a fully qualified file name: ## ## set directory [ get_chars_before_last "/" in "/home/abc01/junkfile" ] ## ## $directory will now be the string "/home/abc01" ## ######################################################################### proc get_chars_before_last { char in strng } { set end [ expr [string last $char $strng ] - 1 ] # set start 0 # set output [ string range $strng $start $end ] set output [ string range $strng 0 $end ] ## FOR TESTING: # puts "From 'get_chars_before_last' proc:" # puts "STRING: $strng" # puts "CHAR: $char" # puts "RANGE up to LAST CHAR - start: 0 end: $end" return $output } ## END OF 'get_chars_before_last' PROCEDURE ##+######################################################################### ## 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 ENTRYfunc which contains the 'o'-format (composite-)function. ##+###################################################################### proc fim_put {} { global ENTRYfunc img1 ## FOR TESTING: # puts "fim_put - img1: $img1" wm title . "*BUSY* ...... Calculating using: $ENTRYfunc" ## 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. set img1 [fim_make] ## Do we need this to put the new image on the canvas? .fRright.fRcan.can create image 0 0 -anchor nw -image $img1 ## Delete the in-memory-hold-area for the 'work-area' image, whose size ## is the current canvas size. (The canvas could be re-sized and the ## next image function-edit pass might need a different size work area.) ## Perhaps this should go at the top of the 'fim_make' proc. (?) # image delete $img2 ## Change the title of the window to show execution time. wm title . \ "DONE. [expr [clock seconds]-$t0] seconds elapsed using: $ENTRYfunc" } ## END OF proc 'fim_put' ##+###################################################################### ## Proc 'fim_make' - ######################################################################### ## PURPOSE: ## ## For a given (composite-)function and for the current image/canvas ## width and height (in pixels), the (composite-)function is applied ## to each x,y pixel of the current image --- typically using the ## color at a location in the image to compute a new color. ## ## The double loop over y and x is put in this proc instead of in ## each of the function procs that are used to construct a ## (composite-)function. ## ## METHOD: ## ## Uses var ENTRYfunc, from the (composite-)function-entry widget, ## which contains the 'o'-format (composite-)function. ## ## Sets var bracketsSTRING, which is made from ENTRYfunc by ## evaluating the 'o' proc --- creating a string of procs in ## left and right brackets. ## ## Produces a photo image by applying the (composite-)function in ## $bracketsSTRING to xy positions corresponding to pixels in the canvas. ## ## The output of the (composite-)function should be a color. ## ## That color is appended to a list-of-colors-in-an-image-row var. ## For each y, the row var is appended to a data var that is ## loaded into an 'img2' work-area image with an 'img2 put' command. ########################################################################## ## The loops here over x and y --- and the retrieval of the current color ## at pixel location x,y --- are based on a combination of the ## 'fim_make' proc of Suchenwirth's 'Functional imaging' page at ## http://wiki.tcl.tk/3523---and the 'colorize' proc at the ## 'Coloring a gray image' page at http://wiki.tcl.tk/9666 - ## by 'ulis'. (French, died circa 2008. May he R.I.P. Thanks, 'ulis'.) ##+###################################################################### proc fim_make {} { global ENTRYfunc img1 STOPflag ## FOR TESTING: # puts "fim_make - img1: $img1" ## Var 'ENTRYfunc' is used to make the var 'bracketsSTRING', ## which holds the (composite-) function in the ## left-and-right-bracket form, rather than the 'o' form. ## bracketsSTRING is set by 'eval $ENTRYfunc' below. ## 'img1' holds the current image that is being displayed in ## the canvas. We build the new image in a 'work-area' ## image we call 'img2'. ## 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] ## OR use width & height of the img1 structure. set width [image width $img1] set height [image height $img1] ## Initialize a 'work-area' image structure at the current canvas size. set img2 [image create photo -height $height -width $width] ## Run the 'o' proc to make the global var bracketsSTRING --- ## the left-and-right-brackets form of the (composite-)function ## --- from the current ENTRYfunc. set bracketsSTRING [eval $ENTRYfunc] ## Initialize the 'listColors4allXY' local list-var, empty. ## Also initialize the 'listTranspAlphaALLxy' local list-var, empty. set listColors4allXY {} # set processTransparency 0 set processTransparency 1 set listTranspAlphaALLxy {} ## Start incrementing over the height of the image. ## In other words, set a row of the image to process. .fRright.fRcan.can create text 10 10 -anchor nw \ -text "starting processing." -tag canmsg for {set y 0} {$y < $height} {incr y} { if { $STOPflag == 1} { set STOPflag 0 .fRright.fRcan.can create image 0 0 -anchor nw -image $img1 return $img1 } .fRright.fRcan.can delete tag canmsg .fRright.fRcan.can create text 10 10 -anchor nw \ -font fontTEMP_fixedwidth \ -text "Processing row y: [expr $y + 1] of $height rows" -tag canmsg update ;# to make the msg visible ## Initialize the 'listRowOFcolors' local list-var. ## This var is to hold colors at pixels in the current row. set listRowOFcolors {} ## Start incrementing over the width of the image, ## to set colors at pixels in the current row. for {set x 0} {$x < $width} {incr x} { if { $processTransparency == 1} { ## Save each transparency (alpha value) in the row ## as a triplet: $x $y $t set t [$img1 transparency get $x $y] ## FOR TESTING: if { $x == 0 && $y == 0} { puts "t: $t" } lappend listTransAlphaALLxy $x $y $t } ## Compute the new color using the composite function in ## $bracketsSTRING. (Note that bracketsSTRING was created ## by the 'o' proc to have $xy at the end of the string. ## So we need to create var xy with $x and $y.) ## ## In case there is a syntax error in bracketsSTRING, ## we put the following statement ## lappend listRowOFcolors [eval $bracketsSTRING] ## in an error catching routine. set xy [list $x $y] lappend listRowOFcolors [eval $bracketsSTRING] # if [catch {lappend listRowOFcolors [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 loop over x ## Append the row of colors to the ALL-xy-colors data var. lappend listColors4allXY $listRowOFcolors } ## END OF loop over y ## Put the colors of the data var into the 'work-area' image structure. $img2 put $listColors4allXY ## Restore transparency. if { $processTransparency == 1} { foreach {x y t} $listTranspAlphaALLxy { $img2 transparency set $x $y $t } } ## Reset the cursor from a 'watch' cursor. . config -cursor {} ## Return the image ID. set img2 } ## END OF proc 'fim_make' ##+###################################################################### ##+###################################################################### ## TRANSFORM/MAPPING PROCS : ## In the following mapping procs that map from an x,y location, ## the argument 'p' is used where p is to be a 2-element list --- ## generally given by passing [list $x $y] as the p argument of the proc. ##+###################################################################### ## 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) or output 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 ##+###################################################################### ######################################################################### ## PROC to 'Contract' the color of each pixel away from black and white ## by a linear mapping of range (0,255) to range (n,255-n). ######################################################################### proc nxyTOchex_contractColorsAwayFromBlackAndWhite { n p } { global img1 ## Put the 2 components of p into x and y. foreach {x y} $p break ## Get the current rgb color at x,y. ## These will be decimal integer values (0-255) --- NOT hex. foreach {r g b} [$img1 get $x $y] break ## FOR TESTING: # if {$x == 0 && $y == 0} { # puts "row y: $y" # puts "x: $x r: $r g: $g b: $b" # } ## Map the RGB values from range (0,255) to range (n, 255-n). set newr [expr ((255 - (2 * $n)) * $r / 255) + $n] set newg [expr ((255 - (2 * $n)) * $g / 255) + $n] set newb [expr ((255 - (2 * $n)) * $b / 255) + $n] ## FOR TESTING: # if {$x == 0 && $y == 0} { # puts "row y: $y n: $n" # puts "x: $x newr: $newr newg: $newg newb: $newb" # } ## Return the hex color value --- to be appended to the ## current row-of-colors variable. set hexcolor [format #%2.2x%2.2x%2.2x $newr $newg $newb] ## FOR TESTING: # if {$x == 0} { # puts "hexcolor: $hexcolor" # } return $hexcolor } ## END OF proc nxyTOchex_contractColorsAwayFromBlackAndWhite ##################################################################### ## PROC to 'colorize' the color of each pixel with a given ## RGB color. Example: 0,0,255 makes the image bluish. ## ## Based on the 'colorize' proc at the 'Coloring a gray image' page ## at http://wiki.tcl.tk/9666 --- by 'ulis'. (French, died circa 2008) ##################################################################### proc rgb255xyTOchex_colorize { r255 g255 b255 p } { global img1 ## Put the 2 components of p into x and y. foreach {x y} $p break ## Get the current rgb color at x,y. ## These will be decimal integer values (0-255) --- NOT hex. foreach {r g b} [$img1 get $x $y] break ## FOR TESTING: # if {$x == 0} { # puts "row y: $y" # puts "x: $x r: $r g: $g b: $b" # } ## Bias the RGB values of the image by multiplying ## r by r255, g by g255, b by b255 --- i.e. multiply ## the image RGB's by the RGB's passed into this routine. ## ## Note that after the multiplication, the range (0,255) ## goes to range (0,255*255) = (0,65025). set newr [expr {round($r * $r255 / 256.)}] set newg [expr {round($g * $g255 / 256.)}] set newb [expr {round($b * $b255 / 256.)}] ## FOR TESTING: # if {$x == 0} { # puts "row y: $y" # puts "x: $x newr: $newr newg: $newg newb: $newb" # } ## Return the hex color value --- to be appended to the ## current row-of-colors variable. # set hexcolor [format #%4.4x%4.4x%4.4x $newr $newg $newb] set hexcolor [format #%2.2x%2.2x%2.2x $newr $newg $newb] ## FOR TESTING: # if {$x == 0} { # puts "hexcolor: $hexcolor" # } return $hexcolor } ## END OF proc rgb255xyTOchex_colorize ##################################################################### ## PROC i255-rgb1-rgb2-xyTO2chex_luminance - ## ## to set pixels to one of 2 colors depending on ## 'luminance' of the color of each pixel. ## ## Inputs: ## i255 represents an integer between 0 and 255. ## rgb1 represents 3 integers in 0-255. ## rgb2 represents 3 integers in 0-255. ## ## Example:For 150 255 0 255 0 255 255, if the luminance of ## the pixel at xy is less than 250, its color is changed to ## (255,0,255)=magenta --- and if the luminance of the ## pixel at xy is greater than 250, its color is changed to ## (0,255,255)=cyan. ## ## See the formula for 'luminance' below. ##################################################################### proc i255-rgb255-rgb255-xyTOchex_luminance_low-hi-to-2colors { icutoff r1 g1 b1 r2 g2 b2 p } { global img1 ## Put the 2 components of p into x and y. foreach {x y} $p break ## Get the current rgb color at x,y. ## These will be decimal integer values (0-255) --- NOT hex. foreach {r g b} [$img1 get $x $y] break ###################################################### ## Compute the 'Luminance' (Y) of the zy pixel, ## is given by a weighted average of RGB values, ## according to the formula: ## ## Y = .299*R + .587*G + .114*B ##################################################### set LUMval [ expr .299*$r + .587*$g + .114*$b ] ## FOR TESTING: # if {$x == 0} { # puts "row y: $y" # puts "x: $x r: $r g: $g b: $b" # } if { $LUMval < $icutoff } { set newr $r1 set newg $g1 set newb $b1 } else { set newr $r2 set newg $g2 set newb $b2 } ## FOR TESTING: # if {$x == 0} { # puts "row y: $y" # puts "x: $x newr: $newr newg: $newg newb: $newb" # } ## Return the hex color value --- to be appended to the ## current row-of-colors variable. # set hexcolor [format #%4.4x%4.4x%4.4x $newr $newg $newb] set hexcolor [format #%2.2x%2.2x%2.2x $newr $newg $newb] ## FOR TESTING: # if {$x == 0} { # puts "hexcolor: $hexcolor" # } return $hexcolor } ## END OF proc i255-rgb255-rgb255-xyTOchex_luminance_low-hi-to-2colors ################################################################# ## This first group of procs/mappings was provided by Suchenwirth ## for the 'Functional imaging' page. ## NOTE: ## We may be able to use some of these 'Functional imaging' procs ## for this 'photo/image-file editing via functions' utility. ################################################################# 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=="#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 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 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: other-GUI-initialization section at bottom of this Tk script ##+##################################################################### proc loadfuncs2listbox {} { ## Make sure the listbox is empty. .fRleft.listbox delete 0 end ############################################################# ## Insert each composite-function into the listbox list. ############################################################# ## NOTE: We can change the order of funcs in the list by ## moving these 'insert' statements around. ############################################################# .fRleft.listbox insert end {o {nxyTOchex_contractColorsAwayFromBlackAndWhite 80} } .fRleft.listbox insert end {o {rgb255xyTOchex_colorize 120 120 255} } .fRleft.listbox insert end {o {i255-rgb255-rgb255-xyTOchex_luminance_low-hi-to-2colors 150 0 0 0 255 255 255} } ################################################################ ## 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 click there and press Enter, to (re)execute the composite-function. Processing takes about 5 to 120 seconds. To reload the img-file, click the file entry field. Note that you may want to reload the img-file to try a parameter change." } ## END of 'loadfuncs2listbox' proc ## Deactivate the following insert statements. ## ## These statements could be movied into the ## 'loadfuncs2listbox' proc above ## if they prove to be useful. if { 1 == 0 } { ############################################################################ ## Suchenwirth-contributed function combinations: ## NOTE: ## As we/I find which ones of these 'Functional imaging' procs are of use ## in this 'photo/image-file editing with functions' utility. ############################################################################ .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} } } if { 2 == 0 } { ############################################################################ ## 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 } .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} } ############################################################################# ## 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 } } if { 3 == 0 } { ########################################################################## ## 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 } ## Neon galaxy: .fRleft.listbox insert end {o xyTOchex_colorGradient raTOxy {rxyTOxy_swirl 16} } } if { 4 == 0 } { ############################################################################## ## 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 } .fRleft.listbox insert end {o xyTOchex_colorGradient xyTOxy_radInvert } .fRleft.listbox insert end {o xyTOchex_colorGradient {rxyTOxy_swirl 8} } } if { 5 == 0 } { ############################################################################ ## 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}]}} } } ## END OF 'if { 1 == 0 }' section to deactivate insert statements. ##+##################################################################### ## PROC listboxSelectionTOentryString ## ## Purpose: Puts the selected listbox line into the ENTRYfunc var. ## ## Called by: binding on button1-release on the listbox ##+##################################################################### proc listboxSelectionTOentryString {} { global ENTRYfunc set sel_index [ .fRleft.listbox curselection ] if { $sel_index != "" } { set ENTRYfunc [ .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. ##+################################################################### ## 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 MAPPING PROCS section ## of this script. ## 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