; Whitebalance is a script for The GIMP
;
; Description: converts the color temperature of an image 
;
; Last changed: 30 July 2022
;
; Copyright (C) 2006-2009 Luca de Alfaro <lda@dealfaro.org>
;
; With many thanks to Martin Rogge <marogge@onlinehome.de>, 
; 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, MA 02139, 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
; http://www.vendian.org/mncharity/dir3/blackbody/UnstableURLs/bbr_color.html 
  (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 HISTOGRAM-RED   num_bytes red-curve  )
    (gimp-curves-explicit drawable HISTOGRAM-GREEN num_bytes green-curve)
    (gimp-curves-explicit drawable HISTOGRAM-BLUE  num_bytes blue-curve )
    
    (gimp-hue-saturation drawable 0 0.0 0.0 satura)
    
    (gimp-image-undo-group-end image)
    (gimp-displays-flush)
    (gc) ; garbage cleanup ; memory cleanup; array was used
 )
)

(script-fu-register
    "script-fu-whitebalance"
    "White balance Color Temperature"
    "Changes the color temperature. White Balance 2.1\nFor help, go to http://luca.dealfaro.org/Whitebalance \nfile:whitebalance.scm"
    "Luca de Alfaro <lda@dealfaro.org>"
    "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"
    "<Toolbox>/Script-Fu/Colors")

