6239dddda3
2006-10-15 Kevin Cozens <kcozens@cvs.gnome.org> With this commit we finally say goodbye to SIOD. This large set of changes updates the Script-Fu plug-in to use the TinyScheme Scheme interpreter. These changes originated with changes originally made to Script-Fu which created Tiny-Fu (aka. the gimp-tiny-fu module). * plug-ins/script-fu/Makefile.am * plug-ins/script-fu/script-fu-console.c * plug-ins/script-fu/script-fu-interface.c * plug-ins/script-fu/script-fu-scripts.c * plug-ins/script-fu/script-fu-scripts.h * plug-ins/script-fu/script-fu-server.c * plug-ins/script-fu/script-fu-text-console.c * plug-ins/script-fu/script-fu.c: Updated with the changes made to these files as part of the work on the Tiny-Fu project. * plug-ins/script-fu/scheme-wrapper.c * plug-ins/script-fu/scheme-wrapper.h: Renamed from siod-wrapper.[ch] and updated based on differences to ts-wrapper.[ch] from gimp-tiny-fu. * plug-ins/script-fu/ftx/* * plug-ins/script-fu/re/* * plug-ins/script-fu/tinyscheme/* * plug-ins/script-fu/scripts/script-fu.init * plug-ins/script-fu/scripts/script-fu-compat.init * plug-ins/script-fu/scripts/contactsheet.scm * plug-ins/script-fu/scripts/script-fu-set-cmap.scm * plug-ins/script-fu/scripts/script-fu-util-setpt.scm * plug-ins/script-fu/scripts/ts-helloworld.scm: Added all of these files and directories from Tiny-Fu. Updated the Makefile.am files of ftx, re, and tinyscheme now they are in the GIMP source tree. * plug-ins/script-fu/scripts/*.scm: All scripts have been updated as needed to ensure they will work with the TinyScheme interpreter. Most of the files have been reformatted making it easier to see the syntax of Scheme and making them easier to read. * plug-ins/script-fu/scripts/Makefile.am: Updated script file lists. * plug-ins/script-fu/siod-wrapper.c * plug-ins/script-fu/siod-wrapper.h * plug-ins/script-fu/siod/*: Removed obsolete files. * configure.in: Updated list of files in AC_CONFIG_FILES. Changed --disable-script-fu to --without-script-fu which it should have been when originally added. * INSTALL: Updated to show change to --without-script-fu.
378 lines
14 KiB
Scheme
378 lines
14 KiB
Scheme
;;; 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
|
|
"-*-helvetica-*-r-*-*-12-*-*-*-p-*-*-*")))
|
|
(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)
|
|
;; return back the state
|
|
(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 of the current drawable"
|
|
"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)
|
|
)
|
|
|
|
;;; hsv-graph.scm ends here
|
|
|
|
(script-fu-menu-register "script-fu-hsv-graph"
|
|
"<Image>/Colors/Info")
|