   is a script for The GIMP
;
; Description: converts the color temperature of an image 
;
  Last changed : Feb 26 , 2009
;
  Copyright ( C ) 2006 - 2009    <  >
;
  With many thanks to   <  > ,
; from whose grey-point script this is inspired. 
;
; --------------------------------------------------------------------
; 
; This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation ; either version 2 of the License , or
; (at your option) any later version.  
; 
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
; 
  You should have received a copy of the GNU General Public License
; along with this program; if not, write to the Free Software
  Foundation , Inc. , 675 Mass Ave , Cambridge ,   , USA .
;

(define (script-fu-whitebalance image drawable mode amount intensmult satura)

  (define (floor x) (- x (fmod x 1)))

  Converts from linear to gamma - corrected sRGB [ 0,1 ]
  (define (togamma x)
    (if (<= x 0.00304)
	(* x 12.92)
	(let* ((exponent (/ 1 2.4)))
	  (- (* 1.055 (pow x exponent)) 0.055))))
	       
  Converts from linear to gamma - corrected sRGB [ 0,255 ]
  (define (togamma255 x)
    (max (min (floor (* 256 (togamma x))) 255) 0))

  Converts from gamma - corrected sRGB [ 0,1 ] to linear
  (define (tolinear y)
    (if (<= y 0.0392768)
	(/ y 12.92)
	(let* ((ratio (/ (+ y 0.055) 1.055)))
	  (pow ratio 2.4))))

  Converts from gamma - corrected sRGB [ 0,255 ] to linear
  (define (to255linear y)
    (tolinear (/ y 255)))

; Applies a ratio (in linear space) to sRGB values, where the sRGB
  values are scaled 0 .. 255 .
  (define (lin-mult-in-gamma-space y255 r)
    (togamma255 (* r (to255linear y255))))

; Multiplication in the gamma space
  (define (linemult y r)
    (max (min (floor (* y r)) 255) 0))

; Makes the target be the average of the foreground, for gamma-colors
  (define (makegreyg r g b)
    (let* ((avg (/ (+ r (+ g b)) 3)))
      (list avg avg avg)))

; Makes the target be the average of the foreground, for linear colors
; Goal: keep the intensity constant 
  (define (makegrey r g b)
    (let* ((avg (+ (+ (* 0.2125 r) (* 0.7154 g)) (* 0.0721 b))))
      (list avg avg avg)))

; Makes the target be the linear colors of the background
  (define (linearcols l)
    (let* ((r (to255linear (car   l)))
	   (g (to255linear (cadr  l)))
	   (b (to255linear (caddr l))))
      (list r g b)))

; This is the color table, taken from
;  
	(let* (
  Foreground and background
         (fg (car (gimp-context-get-foreground)))
         (bg (car (gimp-context-get-background)))
	 ; Conversion amount
	 (a (/ amount 100))

	 ; LINEAR PORTION

  Source colors , 0 .. 255
	 (sbr (car   fg))
	 (sbg (cadr  fg))
	 (sbb (caddr fg))
	 ; Source colors, linear
	 (sr (to255linear sbr))
	 (sg (to255linear sbg))
	 (sb (to255linear sbb))
	 ; Finds the target colors, linear 
	            ; average of fg colors 
	 (tcs (cond ((= mode 0) (makegrey sr sg sb))
		    ; taken from background
		    ((= mode 1) (linearcols bg))))
	 ; Extracts the target colors
	 (tr (car   tcs))
	 (tg (cadr  tcs))
	 (tb (caddr tcs))
	 ; computes the ratios.  If the source is 0, no conversion happens.
	 (rra (if (= sbr 0) 1 (/ tr sr)))
	 (rga (if (= sbg 0) 1 (/ tg sg)))
	 (rba (if (= sbb 0) 1 (/ tb sb)))
	 ; Takes into account the conversion amount. 
	 (rr  (+ 1 (* a (- rra 1))))
	 (rg  (+ 1 (* a (- rga 1))))
	 (rb  (+ 1 (* a (- rba 1))))
  Multiplies them by the intensity modification
	 (m (/ intensmult 100))
  And these are the real ratios , linear
	 (rratio (* rr m))
	 (gratio (* rg m))
	 (bratio (* rb m))

         (i 0)
         (num_bytes 256)
         (red-curve   (cons-array num_bytes 'byte))
         (green-curve (cons-array num_bytes 'byte))
         (blue-curve  (cons-array num_bytes 'byte)))

    (gimp-image-undo-group-start image)

    (while (< i num_bytes)
	   (aset red-curve   i (lin-mult-in-gamma-space i rratio))
	   (aset green-curve i (lin-mult-in-gamma-space i gratio))
	   (aset blue-curve  i (lin-mult-in-gamma-space i bratio))
	   (set! i (+ i 1)))

    (gimp-curves-explicit drawable RED-LUT   num_bytes red-curve  )
    (gimp-curves-explicit drawable GREEN-LUT num_bytes green-curve)
    (gimp-curves-explicit drawable BLUE-LUT  num_bytes blue-curve )

    (gimp-hue-saturation drawable 0 0.0 0.0 satura)

    (gimp-image-undo-group-end image)
    (gimp-displays-flush)
))

(script-fu-register
  "script-fu-whitebalance"
  _"_White balance"
  "White Balance 2.1\n\nFor help, go to "
  "Luca de Alfaro <>"
  "Luca de Alfaro"
  "2006-2008"
  "RGB*"
  SF-IMAGE    "Image"         0
  SF-DRAWABLE "Drawable"      0
  SF-OPTION      "Mode" '("Make foreground gray" "Convert foreground to background")
  SF-ADJUSTMENT _"Conversion amount (%)" '(100 0 100 1 10 0 0)
  SF-ADJUSTMENT _"New intensity (%)" '(100 0 200 1 10 0 0)
  SF-ADJUSTMENT _"Saturation change (%)" '(0 -100 100 1 10 0 0)
)

(script-fu-menu-register "script-fu-whitebalance"
			 _"<Image>/Filters/Colors")



 Description: converts the color temperature of an image 



 from whose grey-point script this is inspired. 

 --------------------------------------------------------------------
 
 This program is free software; you can redistribute it and/or modify
 either version 2 of the License , or
 (at your option) any later version.  
 
 This program is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 GNU General Public License for more details.
 
 along with this program; if not, write to the Free Software

 Applies a ratio (in linear space) to sRGB values, where the sRGB
 Multiplication in the gamma space
 Makes the target be the average of the foreground, for gamma-colors
 Makes the target be the average of the foreground, for linear colors
 Goal: keep the intensity constant 
 Makes the target be the linear colors of the background
 This is the color table, taken from
  
 Conversion amount
 LINEAR PORTION
 Source colors, linear
 Finds the target colors, linear 
 average of fg colors 
 taken from background
 Extracts the target colors
 computes the ratios.  If the source is 0, no conversion happens.
 Takes into account the conversion amount. 
   is a script for The GIMP
  Last changed : Feb 26 , 2009
  Copyright ( C ) 2006 - 2009    <  >
  With many thanks to   <  > ,
  it under the terms of the GNU General Public License as published by
  You should have received a copy of the GNU General Public License
  Foundation , Inc. , 675 Mass Ave , Cambridge ,   , USA .

(define (script-fu-whitebalance image drawable mode amount intensmult satura)

  (define (floor x) (- x (fmod x 1)))

  Converts from linear to gamma - corrected sRGB [ 0,1 ]
  (define (togamma x)
    (if (<= x 0.00304)
	(* x 12.92)
	(let* ((exponent (/ 1 2.4)))
	  (- (* 1.055 (pow x exponent)) 0.055))))
	       
  Converts from linear to gamma - corrected sRGB [ 0,255 ]
  (define (togamma255 x)
    (max (min (floor (* 256 (togamma x))) 255) 0))

  Converts from gamma - corrected sRGB [ 0,1 ] to linear
  (define (tolinear y)
    (if (<= y 0.0392768)
	(/ y 12.92)
	(let* ((ratio (/ (+ y 0.055) 1.055)))
	  (pow ratio 2.4))))

  Converts from gamma - corrected sRGB [ 0,255 ] to linear
  (define (to255linear y)
    (tolinear (/ y 255)))

  values are scaled 0 .. 255 .
  (define (lin-mult-in-gamma-space y255 r)
    (togamma255 (* r (to255linear y255))))

  (define (linemult y r)
    (max (min (floor (* y r)) 255) 0))

  (define (makegreyg r g b)
    (let* ((avg (/ (+ r (+ g b)) 3)))
      (list avg avg avg)))

  (define (makegrey r g b)
    (let* ((avg (+ (+ (* 0.2125 r) (* 0.7154 g)) (* 0.0721 b))))
      (list avg avg avg)))

  (define (linearcols l)
    (let* ((r (to255linear (car   l)))
	   (g (to255linear (cadr  l)))
	   (b (to255linear (caddr l))))
      (list r g b)))

	(let* (
  Foreground and background
         (fg (car (gimp-context-get-foreground)))
         (bg (car (gimp-context-get-background)))
	 (a (/ amount 100))


  Source colors , 0 .. 255
	 (sbr (car   fg))
	 (sbg (cadr  fg))
	 (sbb (caddr fg))
	 (sr (to255linear sbr))
	 (sg (to255linear sbg))
	 (sb (to255linear sbb))
	 (tcs (cond ((= mode 0) (makegrey sr sg sb))
		    ((= mode 1) (linearcols bg))))
	 (tr (car   tcs))
	 (tg (cadr  tcs))
	 (tb (caddr tcs))
	 (rra (if (= sbr 0) 1 (/ tr sr)))
	 (rga (if (= sbg 0) 1 (/ tg sg)))
	 (rba (if (= sbb 0) 1 (/ tb sb)))
	 (rr  (+ 1 (* a (- rra 1))))
	 (rg  (+ 1 (* a (- rga 1))))
	 (rb  (+ 1 (* a (- rba 1))))
  Multiplies them by the intensity modification
	 (m (/ intensmult 100))
  And these are the real ratios , linear
	 (rratio (* rr m))
	 (gratio (* rg m))
	 (bratio (* rb m))

         (i 0)
         (num_bytes 256)
         (red-curve   (cons-array num_bytes 'byte))
         (green-curve (cons-array num_bytes 'byte))
         (blue-curve  (cons-array num_bytes 'byte)))

    (gimp-image-undo-group-start image)

    (while (< i num_bytes)
	   (aset red-curve   i (lin-mult-in-gamma-space i rratio))
	   (aset green-curve i (lin-mult-in-gamma-space i gratio))
	   (aset blue-curve  i (lin-mult-in-gamma-space i bratio))
	   (set! i (+ i 1)))

    (gimp-curves-explicit drawable RED-LUT   num_bytes red-curve  )
    (gimp-curves-explicit drawable GREEN-LUT num_bytes green-curve)
    (gimp-curves-explicit drawable BLUE-LUT  num_bytes blue-curve )

    (gimp-hue-saturation drawable 0 0.0 0.0 satura)

    (gimp-image-undo-group-end image)
    (gimp-displays-flush)
))

(script-fu-register
  "script-fu-whitebalance"
  _"_White balance"
  "White Balance 2.1\n\nFor help, go to "
  "Luca de Alfaro <>"
  "Luca de Alfaro"
  "2006-2008"
  "RGB*"
  SF-IMAGE    "Image"         0
  SF-DRAWABLE "Drawable"      0
  SF-OPTION      "Mode" '("Make foreground gray" "Convert foreground to background")
  SF-ADJUSTMENT _"Conversion amount (%)" '(100 0 100 1 10 0 0)
  SF-ADJUSTMENT _"New intensity (%)" '(100 0 200 1 10 0 0)
  SF-ADJUSTMENT _"Saturation change (%)" '(0 -100 100 1 10 0 0)
)

(script-fu-menu-register "script-fu-whitebalance"
			 _"<Image>/Filters/Colors")

