GIMP Script-fu

Artifact Content
Login

Artifact e4cd952913533157c4f87c22b5f62bb7c6a19b8f:


; 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"
 )