; 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.
(define (script-fu-sg-histogram-hue orig-image drawable)
(let* ((linear-mode? #t) ; else logarithmic
(final-width 360)
(width 256)
(height 256)
(image 0)
(layer 0)
(buffer 0)
(channel 0)
(floating-sel 0)
(hue-image 0)
(hue-layer 0)
(x 0)
(y 0)
(hist '())
(max-hue 0)
(min-hue 0)
(hues (map (lambda (x) (truncate (* 255 x)))
(vector->list
(cadr
(gimp-gradient-get-uniform-samples
"Full saturation spectrum CCW" 256 FALSE) ) ) ) )
)
(gimp-context-push)
(gimp-context-set-gradient "Full saturation spectrum CCW")
(set! image (car (gimp-image-new width height RGB)))
(gimp-image-undo-disable image)
(set! layer (car (gimp-layer-new image width height RGB "Hue" 100 NORMAL-MODE)))
(gimp-drawable-fill layer WHITE-FILL)
(gimp-image-add-layer image layer 0)
(set! hue-image (plug-in-decompose RUN-NONINTERACTIVE
orig-image
drawable
"HSL"
FALSE ) )
(gimp-image-delete (cadr hue-image))
(gimp-image-delete (caddr hue-image))
(set! hue-image (car hue-image))
(set! hue-layer (car (gimp-image-get-active-layer hue-image)))
(set! buffer (car (gimp-edit-named-copy (car (gimp-image-get-selection
orig-image ) )
"selection" ) ) )
(set! floating-sel (car (gimp-edit-named-paste
hue-layer ;; pasting directly to the selection
;; will crash GIMP if f-s is modified
buffer FALSE ) ) )
(gimp-context-set-background '(0 0 0))
(gimp-drawable-offset floating-sel
FALSE
OFFSET-BACKGROUND
(- (car (gimp-drawable-offsets drawable)))
(- (cadr (gimp-drawable-offsets drawable))) )
(gimp-layer-resize-to-image-size floating-sel)
(gimp-floating-sel-to-layer floating-sel)
(gimp-buffer-delete buffer)
(set! channel (car (gimp-channel-new-from-component hue-image RED-CHANNEL "Orig selection")))
(gimp-image-add-channel hue-image channel 0)
(gimp-selection-load channel)
(set! x 255)
(while (>= x 0)
(set! hist (cons (cadr (cddddr (gimp-histogram hue-layer
HISTOGRAM-VALUE
x
x ) ) ) hist ) )
(set! x (- x 1)) )
(if linear-mode?
(begin
(set! max-hue (apply max hist))
(set! hist (map (lambda (y) (truncate (/ (* height y) max-hue))) hist))
)
(begin
(set! min-hue (apply min (map (lambda (y) (if (zero? y) 1 y)) hist)))
(set! hist (map (lambda (y) (log (+ y min-hue))) hist))
(set! max-hue (apply max hist))
(set! min-hue (apply min hist))
(set! hist (map (lambda (y) (truncate (/ (* (- y min-hue) height) (- max-hue min-hue)))) hist))
)
)
(set! x 0)
(while (pair? hist)
(set! y (car hist))
(unless (zero? y)
(gimp-rect-select image x (- height y) 1 height CHANNEL-OP-REPLACE FALSE 0)
(gimp-context-set-foreground (list (car hues) (cadr hues) (caddr hues)))
(gimp-edit-fill layer FOREGROUND-FILL)
)
(set! hues (cddddr hues))
(set! x (+ x 1))
(set! hist (cdr hist))
)
(gimp-image-delete hue-image)
(gimp-image-scale-full image final-width height INTERPOLATION-CUBIC)
(gimp-display-new image)
(gimp-selection-none image)
(gimp-image-undo-enable image)
(gimp-image-clean-all image)
(gimp-displays-flush)
)
)
(script-fu-register "script-fu-sg-histogram-hue"
"Hue Histogram"
"Create an image displaying the hue distribution"
"Saul Goode"
"Saul Goode"
"November 2010"
"RGB*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Layer" 0
)
(script-fu-menu-register "script-fu-sg-histogram-hue"
"<Image>/Colors/Info"
)