Commit 9a740afc authored by Sven Neumann's avatar Sven Neumann Committed by Sven Neumann

removed this script. Fixes bug #491311.

2007-11-01  Sven Neumann  <sven@gimp.org>

	* plug-ins/script-fu/scripts/Makefile.am (scripts):
	* plug-ins/script-fu/scripts/hsv-graph.scm: removed this script.
	Fixes bug #491311.

svn path=/trunk/; revision=24030
parent 5226c660
......@@ -62,7 +62,6 @@ scripts = \
guides-new.scm \
guides-new-percent.scm \
guides-remove-all.scm \
hsv-graph.scm \
i26-gunya2.scm \
land.scm \
lava.scm \
......
;;; hsv-graph.scm -*-scheme-*-
;;; Author: Shuji Narazaki <narazaki@InetQ.or.jp>
;;; Time-stamp: <1998/01/18 05:25:03 narazaki@InetQ.or.jp>
;;; Version: 1.2
; ************************************************************************
; Changed on Feb 4, 1999 by Piet van Oostrum <piet@cs.uu.nl>
; For use with GIMP 1.1.
; All calls to gimp-text-* have been converted to use the *-fontname form.
; The corresponding parameters have been replaced by an SF-FONT parameter.
; ************************************************************************
;;; Code:
(if (not (symbol-bound? 'script-fu-hsv-graph-scale (current-environment)))
(define script-fu-hsv-graph-scale 1))
(if (not (symbol-bound? 'script-fu-hsv-graph-opacity (current-environment)))
(define script-fu-hsv-graph-opacity 100))
(if (not (symbol-bound? 'script-fu-hsv-graph-bounds? (current-environment)))
(define script-fu-hsv-graph-bounds? TRUE))
(if (not (symbol-bound? 'script-fu-hsv-graph-left2right? (current-environment)))
(define script-fu-hsv-graph-left2right? FALSE))
(if (not (symbol-bound? 'script-fu-hsv-graph-beg-x (current-environment)))
(define script-fu-hsv-graph-beg-x 0))
(if (not (symbol-bound? 'script-fu-hsv-graph-beg-y (current-environment)))
(define script-fu-hsv-graph-beg-y 0))
(if (not (symbol-bound? 'script-fu-hsv-graph-end-x (current-environment)))
(define script-fu-hsv-graph-end-x 1))
(if (not (symbol-bound? 'script-fu-hsv-graph-end-y (current-environment)))
(define script-fu-hsv-graph-end-y 1))
(define (script-fu-hsv-graph img drawable scale opacity bounds?
left2right? beg-x beg-y end-x end-y)
(define (floor x) (- x (fmod x 1)))
(define *pos* #f)
(define (set-point! fvec index x y)
(aset fvec (* 2 index) x)
(aset fvec (+ (* 2 index) 1) y)
fvec
)
(define (plot-dot img drawable x y)
(gimp-pencil drawable 1 (set-point! *pos* 0 x y))
)
(define (rgb-to-hsv rgb hsv)
(let* (
(red (floor (nth 0 rgb)))
(green (floor (nth 1 rgb)))
(blue (floor (nth 2 rgb)))
(h 0.0)
(s 0.0)
(minv (min red (min green blue)))
(maxv (max red (max green blue)))
(v maxv)
(delta 0)
)
(if (not (= 0 maxv))
(set! s (/ (* (- maxv minv) 255.0) maxv))
(set! s 0.0)
)
(if (= 0.0 s)
(set! h 0.0)
(begin
(set! delta (- maxv minv))
(cond ((= maxv red)
(set! h (/ (- green blue) delta)))
((= maxv green)
(set! h (+ 2.0 (/ (- blue red) delta))))
((= maxv blue)
(set! h (+ 4.0 (/ (- red green) delta)))))
(set! h (* 42.5 h))
(if (< h 0.0)
(set! h (+ h 255.0)))
(if (< 255 h)
(set! h (- h 255.0))))
)
(set-car! hsv (floor h))
(set-car! (cdr hsv) (floor s))
(set-car! (cddr hsv) (floor v))
)
)
;; segment is
;; filled-index (integer)
;; size as number of points (integer)
;; vector (which size is 2 * size)
(define (make-segment length x y)
(if (< 64 length) (set! length 64))
(if (< length 5) (set! length 5))
(let (
(vec (cons-array (* 2 length) 'double)))
(aset vec 0 x)
(aset vec 1 y)
(list 1 length vec)
)
)
;; accessors
(define (segment-filled-size segment) (car segment))
(define (segment-max-size segment) (cadr segment))
(define (segment-strokes segment) (caddr segment))
(define (fill-segment! segment new-x new-y)
(define (shift-segment! segment)
(let ((base 0)
(size (cadr segment))
(vec (caddr segment))
(offset 2))
(while (< base offset)
(aset vec (* 2 base)
(aref vec (* 2 (- size (- offset base)))))
(aset vec (+ (* 2 base) 1)
(aref vec (+ (* 2 (- size (- offset base))) 1)))
(set! base (+ base 1)))
(set-car! segment base))
)
(let ((base (car segment))
(size (cadr segment))
(vec (caddr segment)))
(if (= base 0)
(begin
(shift-segment! segment)
(set! base (segment-filled-size segment))))
(if (and (= new-x (aref vec (* 2 (- base 1))))
(= new-y (aref vec (+ (* 2 (- base 1)) 1))))
#f
(begin
(aset vec (* 2 base) new-x)
(aset vec (+ (* 2 base) 1) new-y)
(set! base (+ base 1))
(if (= base size)
(begin
(set-car! segment 0)
#t)
(begin
(set-car! segment base)
#f))))
)
)
(define (draw-segment img drawable segment limit rgb)
(gimp-context-set-foreground rgb)
(gimp-airbrush drawable 100 (* 2 limit) (segment-strokes segment))
)
(define red-color '(255 10 10))
(define green-color '(10 255 10))
(define blue-color '(10 10 255))
(define hue-segment #f)
(define saturation-segment #f)
(define value-segment #f)
(define red-segment #f)
(define green-segment #f)
(define blue-segment #f)
(define border-size 10)
(define (fill-dot img drawable x y segment color)
(if (fill-segment! segment x y)
(begin
(gimp-context-set-foreground color)
(draw-segment img drawable segment (segment-max-size segment) color)
#t)
#f)
)
(define (fill-color-band img drawable x scale x-base y-base color)
(gimp-context-set-foreground color)
(gimp-rect-select img (+ x-base (* scale x)) 0 scale y-base CHANNEL-OP-REPLACE FALSE 0)
(gimp-edit-bucket-fill drawable FG-BUCKET-FILL NORMAL-MODE 100 0 FALSE 0 0)
(gimp-selection-none img)
)
(define (plot-hsv img drawable x scale x-base y-base hsv)
(let ((real-x (* scale x))
(h (car hsv))
(s (cadr hsv))
(v (caddr hsv)))
(fill-dot img drawable (+ x-base real-x) (- y-base h)
hue-segment red-color)
(fill-dot img drawable (+ x-base real-x) (- y-base s)
saturation-segment green-color)
(if (fill-dot img drawable (+ x-base real-x) (- y-base v)
value-segment blue-color)
(gimp-displays-flush)))
)
(define (plot-rgb img drawable x scale x-base y-base hsv)
(let ((real-x (* scale x))
(h (car hsv))
(s (cadr hsv))
(v (caddr hsv)))
(fill-dot img drawable (+ x-base real-x) (- y-base h)
red-segment red-color)
(fill-dot img drawable (+ x-base real-x) (- y-base s)
green-segment green-color)
(if (fill-dot img drawable (+ x-base real-x) (- y-base v)
blue-segment blue-color)
(gimp-displays-flush)))
)
(define (clamp-value x minv maxv)
(if (< x minv)
(set! x minv))
(if (< maxv x)
(set! x maxv))
x
)
;; start of script-fu-hsv-graph
(if (= TRUE bounds?)
(if (= TRUE (car (gimp-selection-bounds img)))
(let ((results (gimp-selection-bounds img)))
(set! beg-x (nth (if (= TRUE left2right?) 1 3) results))
(set! beg-y (nth 2 results))
(set! end-x (nth (if (= TRUE left2right?) 3 1) results))
(set! end-y (nth 4 results)))
(let ((offsets (gimp-drawable-offsets drawable)))
(set! beg-x (if (= TRUE left2right?)
(nth 0 offsets)
(- (+ (nth 0 offsets)
(car (gimp-drawable-width drawable)))
1)))
(set! beg-y (nth 1 offsets))
(set! end-x (if (= TRUE left2right?)
(- (+ (nth 0 offsets)
(car (gimp-drawable-width drawable)))
1)
(nth 0 offsets)))
(set! end-y (- (+ (nth 1 offsets)
(car (gimp-drawable-height drawable)))
1))))
(let ((offsets (gimp-drawable-offsets drawable)))
(set! beg-x (clamp-value beg-x 0
(+ (nth 0 offsets)
(car (gimp-drawable-width drawable)))))
(set! end-x (clamp-value end-x 0
(+ (nth 0 offsets)
(car (gimp-drawable-width drawable)))))
(set! beg-y (clamp-value beg-y 0
(+ (nth 1 offsets)
(car (gimp-drawable-height drawable)))))
(set! end-y (clamp-value end-y 0
(+ (nth 1 offsets)
(car (gimp-drawable-height drawable)))))))
(set! opacity (clamp-value opacity 0 100))
(let* ((x-len (- end-x beg-x))
(y-len (- end-y beg-y))
(limit (pow (+ (pow x-len 2) (pow y-len 2)) 0.5))
(gimg-width (* limit scale))
(gimg-height 256)
(gimg (car (gimp-image-new (+ (* 2 border-size) gimg-width)
(+ (* 2 border-size) gimg-height) RGB)))
(bglayer (car (gimp-layer-new gimg
(+ (* 2 border-size) gimg-width)
(+ (* 2 border-size) gimg-height)
1 "Background" 100 NORMAL-MODE)))
(hsv-layer (car (gimp-layer-new gimg
(+ (* 2 border-size) gimg-width)
(+ (* 2 border-size) gimg-height)
RGBA-IMAGE "HSV Graph" 100 NORMAL-MODE)))
(rgb-layer (car (gimp-layer-new gimg
(+ (* 2 border-size) gimg-width)
(+ (* 2 border-size) gimg-height)
RGBA-IMAGE "RGB Graph" 100 NORMAL-MODE)))
(clayer (car (gimp-layer-new gimg gimg-width 40 RGBA-IMAGE
"Color Sampled" opacity NORMAL-MODE)))
(rgb '(255 255 255))
(hsv '(254 255 255))
(x-base border-size)
(y-base (+ gimg-height border-size))
(index 0))
(gimp-context-push)
(gimp-image-undo-disable gimg)
(gimp-image-add-layer gimg bglayer -1)
(gimp-selection-all gimg)
(gimp-context-set-background '(255 255 255))
(gimp-edit-fill bglayer BACKGROUND-FILL)
(gimp-image-add-layer gimg hsv-layer -1)
(gimp-edit-clear hsv-layer)
(gimp-image-add-layer gimg rgb-layer -1)
(gimp-drawable-set-visible rgb-layer FALSE)
(gimp-edit-clear rgb-layer)
(gimp-image-add-layer gimg clayer -1)
(gimp-edit-clear clayer)
(gimp-layer-translate clayer border-size 0)
(gimp-selection-none gimg)
(set! red-segment (make-segment 64 x-base y-base))
(set! green-segment (make-segment 64 x-base y-base))
(set! blue-segment (make-segment 64 x-base y-base))
(set! hue-segment (make-segment 64 x-base y-base))
(set! saturation-segment (make-segment 64 x-base y-base))
(set! value-segment (make-segment 64 x-base y-base))
(gimp-context-set-brush "Circle (01)")
(gimp-context-set-paint-mode NORMAL-MODE)
(gimp-context-set-opacity 70)
(gimp-display-new gimg)
(while (< index limit)
(set! rgb (car (gimp-image-pick-color img drawable
(+ beg-x (* x-len (/ index limit)))
(+ beg-y (* y-len (/ index limit)))
TRUE FALSE 0)))
(fill-color-band gimg clayer index scale x-base 40 rgb)
(rgb-to-hsv rgb hsv)
(plot-hsv gimg hsv-layer index scale x-base y-base hsv)
(plot-rgb gimg rgb-layer index scale x-base y-base rgb)
(set! index (+ index 1)))
(mapcar
(lambda (segment color)
(if (< 1 (segment-filled-size segment))
(begin
(gimp-context-set-foreground color)
(draw-segment gimg hsv-layer segment (segment-filled-size segment)
color))))
(list hue-segment saturation-segment value-segment)
(list red-color green-color blue-color))
(mapcar
(lambda (segment color)
(if (< 1 (segment-filled-size segment))
(begin
(gimp-context-set-foreground color)
(draw-segment gimg rgb-layer segment (segment-filled-size segment)
color))))
(list red-segment green-segment blue-segment)
(list red-color green-color blue-color))
(gimp-context-set-foreground '(255 255 255))
(let ((text-layer (car (gimp-text-fontname gimg -1 0 0
"Red: Hue, Green: Sat, Blue: Val"
1 1 12 PIXELS
"Sans")))
(offset-y (- y-base (car (gimp-drawable-height clayer)))))
(gimp-layer-set-mode text-layer DIFFERENCE-MODE)
(gimp-layer-translate clayer 0 offset-y)
(gimp-layer-translate text-layer border-size (+ offset-y 15)))
(gimp-image-set-active-layer gimg bglayer)
(gimp-image-clean-all gimg)
(gimp-image-undo-enable gimg)
(set! script-fu-hsv-graph-scale scale)
(set! script-fu-hsv-graph-opacity opacity)
(set! script-fu-hsv-graph-bounds? bounds?)
(set! script-fu-hsv-graph-left2right? left2right?)
(set! script-fu-hsv-graph-beg-x beg-x)
(set! script-fu-hsv-graph-beg-y beg-y)
(set! script-fu-hsv-graph-end-x end-x)
(set! script-fu-hsv-graph-end-y end-y)
(gimp-displays-flush)
(gimp-context-pop)
)
)
(script-fu-register "script-fu-hsv-graph"
_"Draw _HSV Graph..."
_"Create a graph of the Hue, Saturation, and Value distributions"
"Shuji Narazaki <narazaki@InetQ.or.jp>"
"Shuji Narazaki"
"1997"
"RGB*"
SF-IMAGE "Image to analyze" 0
SF-DRAWABLE "Drawable to analyze" 0
SF-ADJUSTMENT _"Graph scale" '(1 0.1 5 0.1 1 1 1)
SF-ADJUSTMENT _"BG opacity" '(100 0 100 1 10 0 1)
SF-TOGGLE _"Use selection bounds instead of values below" TRUE
SF-TOGGLE _"From top-left to bottom-right" FALSE
SF-ADJUSTMENT _"Start X" '(0 0 5000 1 10 0 1)
SF-ADJUSTMENT _"Start Y" '(0 0 5000 1 10 0 1)
SF-ADJUSTMENT _"End X" '(1 0 5000 1 10 0 1)
SF-ADJUSTMENT _"End Y" '(1 0 5000 1 10 0 1)
)
(script-fu-menu-register "script-fu-hsv-graph"
"<Image>/Colors/Info")
2007-11-01 Sven Neumann <sven@gimp.org>
* POTFILES.in: removed hsv-graph.scm.
2007-10-31 Jovan Naumovski <jovan@lugola.net>
* mk.po: Updated Macedonian translation.
......
......@@ -63,7 +63,6 @@ plug-ins/script-fu/scripts/guides-from-selection.scm
plug-ins/script-fu/scripts/guides-new-percent.scm
plug-ins/script-fu/scripts/guides-new.scm
plug-ins/script-fu/scripts/guides-remove-all.scm
plug-ins/script-fu/scripts/hsv-graph.scm
plug-ins/script-fu/scripts/i26-gunya2.scm
plug-ins/script-fu/scripts/land.scm
plug-ins/script-fu/scripts/lava.scm
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment