Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: df8b37c783
Fetching contributors…

Cannot retrieve contributors at this time

executable file 168 lines (144 sloc) 5.397 kB
; Whitebalance is a script for The GIMP
;
; Description: converts the color temperature of an image
;
; Last changed: Feb 26, 2009
;
; 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 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 http://luca.dealfaro.org/Whitebalance"
"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"
_"<Image>/Filters/Colors")
Jump to Line
Something went wrong with that request. Please try again.