← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/gimp/intrepid-updates

« back to all changes in this revision

Viewing changes to plug-ins/script-fu/scripts/hsv-graph.scm

  • Committer: Bazaar Package Importer
  • Author(s): Steve Kowalik
  • Date: 2007-11-27 22:16:06 UTC
  • mfrom: (1.1.9 upstream)
  • Revision ID: james.westby@ubuntu.com-20071127221606-ceuabk1eqkjgtolv
Tags: 2.4.2-1ubuntu1
* Merge from Debian unstable.
* Remaining Ubuntu changes:
  - 02_help-message.patch, 03_gimp.desktop.in.in.patch: Distro changes.
  - Weave i18n magic in the rules file.
  - Remove the doc directory symlink in the preinst, and replace it with a
    directory.
  - Munge Maintainer field as per spec.
* Ubuntu changes dropped:
  - Since we aren't in a freeze, and we can make this change now, restore
    the Conflicts and Replaces against gimp-print and stop building with
    --without-print.
  - Re-add NEWS, README and README.Debian to gimp.docs.

Show diffs side-by-side

added added

removed removed

Lines of Context:
plug-ins/script-fu/scripts/hsv-graph.scm
1
 
;;; hsv-graph.scm -*-scheme-*-
2
 
;;; Author: Shuji Narazaki <narazaki@InetQ.or.jp>
3
 
;;; Time-stamp: <1998/01/18 05:25:03 narazaki@InetQ.or.jp>
4
 
;;; Version: 1.2
5
 
; ************************************************************************
6
 
; Changed on Feb 4, 1999 by Piet van Oostrum <piet@cs.uu.nl>
7
 
; For use with GIMP 1.1.
8
 
; All calls to gimp-text-* have been converted to use the *-fontname form.
9
 
; The corresponding parameters have been replaced by an SF-FONT parameter.
10
 
; ************************************************************************
11
 
;;; Code:
12
 
 
13
 
(if (not (symbol-bound? 'script-fu-hsv-graph-scale (current-environment)))
14
 
    (define script-fu-hsv-graph-scale 1))
15
 
(if (not (symbol-bound? 'script-fu-hsv-graph-opacity (current-environment)))
16
 
    (define script-fu-hsv-graph-opacity 100))
17
 
(if (not (symbol-bound? 'script-fu-hsv-graph-bounds? (current-environment)))
18
 
    (define script-fu-hsv-graph-bounds? TRUE))
19
 
(if (not (symbol-bound? 'script-fu-hsv-graph-left2right? (current-environment)))
20
 
    (define script-fu-hsv-graph-left2right? FALSE))
21
 
(if (not (symbol-bound? 'script-fu-hsv-graph-beg-x (current-environment)))
22
 
    (define script-fu-hsv-graph-beg-x 0))
23
 
(if (not (symbol-bound? 'script-fu-hsv-graph-beg-y (current-environment)))
24
 
    (define script-fu-hsv-graph-beg-y 0))
25
 
(if (not (symbol-bound? 'script-fu-hsv-graph-end-x (current-environment)))
26
 
    (define script-fu-hsv-graph-end-x 1))
27
 
(if (not (symbol-bound? 'script-fu-hsv-graph-end-y (current-environment)))
28
 
    (define script-fu-hsv-graph-end-y 1))
29
 
 
30
 
(define (script-fu-hsv-graph img drawable scale opacity bounds?
31
 
                           left2right? beg-x beg-y end-x end-y)
32
 
  (define (floor x) (- x (fmod x 1)))
33
 
  (define *pos* #f)
34
 
  (define (set-point! fvec index x y)
35
 
    (aset fvec (* 2 index) x)
36
 
    (aset fvec (+ (* 2 index) 1) y)
37
 
    fvec
38
 
  )
39
 
 
40
 
  (define (plot-dot img drawable x y)
41
 
    (gimp-pencil drawable 1 (set-point! *pos* 0 x y))
42
 
  )
43
 
 
44
 
  (define (rgb-to-hsv rgb hsv)
45
 
    (let* (
46
 
          (red (floor (nth 0 rgb)))
47
 
          (green (floor (nth 1 rgb)))
48
 
          (blue (floor (nth 2 rgb)))
49
 
          (h 0.0)
50
 
          (s 0.0)
51
 
          (minv (min red (min green blue)))
52
 
          (maxv (max red (max green blue)))
53
 
          (v maxv)
54
 
          (delta 0)
55
 
          )
56
 
      (if (not (= 0 maxv))
57
 
          (set! s (/ (* (- maxv minv) 255.0) maxv))
58
 
          (set! s 0.0)
59
 
      )
60
 
      (if (= 0.0 s)
61
 
          (set! h 0.0)
62
 
          (begin
63
 
            (set! delta (- maxv minv))
64
 
            (cond ((= maxv red)
65
 
                   (set! h (/ (- green blue) delta)))
66
 
                  ((= maxv green)
67
 
                   (set! h (+ 2.0 (/ (- blue red) delta))))
68
 
                  ((= maxv blue)
69
 
                   (set! h (+ 4.0 (/ (- red green) delta)))))
70
 
            (set! h (* 42.5 h))
71
 
            (if (< h 0.0)
72
 
                (set! h (+ h 255.0)))
73
 
            (if (< 255 h)
74
 
                (set! h (- h 255.0))))
75
 
      )
76
 
      (set-car! hsv (floor h))
77
 
      (set-car! (cdr hsv) (floor s))
78
 
      (set-car! (cddr hsv) (floor v))
79
 
    )
80
 
  )
81
 
 
82
 
  ;; segment is
83
 
  ;;   filled-index (integer)
84
 
  ;;   size as number of points (integer)
85
 
  ;;   vector (which size is 2 * size)
86
 
  (define (make-segment length x y)
87
 
    (if (< 64 length) (set! length 64))
88
 
    (if (< length 5)  (set! length 5))
89
 
    (let (
90
 
         (vec (cons-array (* 2 length) 'double)))
91
 
         (aset vec 0 x)
92
 
         (aset vec 1 y)
93
 
         (list 1 length vec)
94
 
    )
95
 
  )
96
 
 
97
 
  ;; accessors
98
 
  (define (segment-filled-size segment) (car segment))
99
 
  (define (segment-max-size segment) (cadr segment))
100
 
  (define (segment-strokes segment) (caddr segment))
101
 
 
102
 
  (define (fill-segment! segment new-x new-y)
103
 
 
104
 
    (define (shift-segment! segment)
105
 
      (let ((base 0)
106
 
            (size (cadr segment))
107
 
            (vec (caddr segment))
108
 
            (offset 2))
109
 
        (while (< base offset)
110
 
               (aset vec (* 2 base)
111
 
                     (aref vec (* 2 (- size (- offset base)))))
112
 
               (aset vec (+ (* 2 base) 1)
113
 
                     (aref vec (+ (* 2 (- size (- offset base))) 1)))
114
 
               (set! base (+ base 1)))
115
 
        (set-car! segment base))
116
 
    )
117
 
 
118
 
    (let ((base (car segment))
119
 
          (size (cadr segment))
120
 
          (vec (caddr segment)))
121
 
      (if (= base 0)
122
 
          (begin
123
 
            (shift-segment! segment)
124
 
            (set! base (segment-filled-size segment))))
125
 
      (if (and (= new-x (aref vec (* 2 (- base 1))))
126
 
               (= new-y (aref vec (+ (* 2 (- base 1)) 1))))
127
 
          #f
128
 
          (begin
129
 
            (aset vec (* 2 base) new-x)
130
 
            (aset vec (+ (* 2 base) 1) new-y)
131
 
            (set! base (+ base 1))
132
 
            (if (= base size)
133
 
                (begin
134
 
                  (set-car! segment 0)
135
 
                  #t)
136
 
                (begin
137
 
                  (set-car! segment base)
138
 
                  #f))))
139
 
    )
140
 
  )
141
 
 
142
 
  (define (draw-segment img drawable segment limit rgb)
143
 
    (gimp-context-set-foreground rgb)
144
 
    (gimp-airbrush drawable 100 (* 2 limit) (segment-strokes segment))
145
 
  )
146
 
 
147
 
  (define red-color '(255 10 10))
148
 
  (define green-color '(10 255 10))
149
 
  (define blue-color '(10 10 255))
150
 
  (define hue-segment #f)
151
 
  (define saturation-segment #f)
152
 
  (define value-segment #f)
153
 
  (define red-segment #f)
154
 
  (define green-segment #f)
155
 
  (define blue-segment #f)
156
 
  (define border-size 10)
157
 
 
158
 
  (define (fill-dot img drawable x y segment color)
159
 
    (if (fill-segment! segment x y)
160
 
        (begin
161
 
          (gimp-context-set-foreground color)
162
 
          (draw-segment img drawable segment (segment-max-size segment) color)
163
 
          #t)
164
 
        #f)
165
 
  )
166
 
 
167
 
  (define (fill-color-band img drawable x scale x-base y-base color)
168
 
    (gimp-context-set-foreground color)
169
 
    (gimp-rect-select img (+ x-base (* scale x)) 0 scale y-base CHANNEL-OP-REPLACE FALSE 0)
170
 
    (gimp-edit-bucket-fill drawable FG-BUCKET-FILL NORMAL-MODE 100 0 FALSE 0 0)
171
 
    (gimp-selection-none img)
172
 
  )
173
 
 
174
 
  (define (plot-hsv img drawable x scale x-base y-base hsv)
175
 
    (let ((real-x (* scale x))
176
 
          (h (car hsv))
177
 
          (s (cadr hsv))
178
 
          (v (caddr hsv)))
179
 
      (fill-dot img drawable (+ x-base real-x) (- y-base h)
180
 
                hue-segment red-color)
181
 
      (fill-dot img drawable (+ x-base real-x) (- y-base s)
182
 
                saturation-segment green-color)
183
 
      (if (fill-dot img drawable (+ x-base real-x) (- y-base v)
184
 
                    value-segment blue-color)
185
 
          (gimp-displays-flush)))
186
 
  )
187
 
 
188
 
  (define (plot-rgb img drawable x scale x-base y-base hsv)
189
 
    (let ((real-x (* scale x))
190
 
          (h (car hsv))
191
 
          (s (cadr hsv))
192
 
          (v (caddr hsv)))
193
 
      (fill-dot img drawable (+ x-base real-x) (- y-base h)
194
 
                red-segment red-color)
195
 
      (fill-dot img drawable (+ x-base real-x) (- y-base s)
196
 
                green-segment green-color)
197
 
      (if (fill-dot img drawable (+ x-base real-x) (- y-base v)
198
 
                    blue-segment blue-color)
199
 
          (gimp-displays-flush)))
200
 
  )
201
 
 
202
 
  (define (clamp-value x minv maxv)
203
 
    (if (< x minv)
204
 
        (set! x minv))
205
 
    (if (< maxv x)
206
 
        (set! x maxv))
207
 
    x
208
 
  )
209
 
 
210
 
  ;; start of script-fu-hsv-graph
211
 
  (if (= TRUE bounds?)
212
 
      (if (= TRUE (car (gimp-selection-bounds img)))
213
 
          (let ((results (gimp-selection-bounds img)))
214
 
            (set! beg-x (nth (if (= TRUE left2right?) 1 3) results))
215
 
            (set! beg-y (nth 2 results))
216
 
            (set! end-x (nth (if (= TRUE left2right?) 3 1) results))
217
 
            (set! end-y (nth 4 results)))
218
 
          (let ((offsets (gimp-drawable-offsets drawable)))
219
 
            (set! beg-x (if (= TRUE left2right?)
220
 
                            (nth 0 offsets)
221
 
                            (- (+ (nth 0 offsets)
222
 
                                  (car (gimp-drawable-width drawable)))
223
 
                               1)))
224
 
            (set! beg-y (nth 1 offsets))
225
 
            (set! end-x (if (= TRUE left2right?)
226
 
                            (- (+ (nth 0 offsets)
227
 
                                  (car (gimp-drawable-width drawable)))
228
 
                               1)
229
 
                            (nth 0 offsets)))
230
 
            (set! end-y (- (+ (nth 1 offsets)
231
 
                              (car (gimp-drawable-height drawable)))
232
 
                           1))))
233
 
      (let ((offsets (gimp-drawable-offsets drawable)))
234
 
        (set! beg-x (clamp-value beg-x 0
235
 
                                 (+ (nth 0 offsets)
236
 
                                    (car (gimp-drawable-width drawable)))))
237
 
        (set! end-x (clamp-value end-x 0
238
 
                                 (+ (nth 0 offsets)
239
 
                                    (car (gimp-drawable-width drawable)))))
240
 
        (set! beg-y (clamp-value beg-y 0
241
 
                                 (+ (nth 1 offsets)
242
 
                                    (car (gimp-drawable-height drawable)))))
243
 
        (set! end-y (clamp-value end-y 0
244
 
                                 (+ (nth 1 offsets)
245
 
                                    (car (gimp-drawable-height drawable)))))))
246
 
  (set! opacity (clamp-value opacity 0 100))
247
 
  (let* ((x-len (- end-x beg-x))
248
 
         (y-len (- end-y beg-y))
249
 
         (limit (pow (+ (pow x-len 2) (pow y-len 2)) 0.5))
250
 
         (gimg-width (* limit scale))
251
 
         (gimg-height 256)
252
 
         (gimg (car (gimp-image-new (+ (* 2 border-size) gimg-width)
253
 
                                    (+ (* 2 border-size) gimg-height) RGB)))
254
 
         (bglayer (car (gimp-layer-new gimg
255
 
                                       (+ (* 2 border-size) gimg-width)
256
 
                                       (+ (* 2 border-size) gimg-height)
257
 
                                       1 "Background" 100 NORMAL-MODE)))
258
 
         (hsv-layer (car (gimp-layer-new gimg
259
 
                                       (+ (* 2 border-size) gimg-width)
260
 
                                       (+ (* 2 border-size) gimg-height)
261
 
                                      RGBA-IMAGE "HSV Graph" 100 NORMAL-MODE)))
262
 
         (rgb-layer (car (gimp-layer-new gimg
263
 
                                       (+ (* 2 border-size) gimg-width)
264
 
                                       (+ (* 2 border-size) gimg-height)
265
 
                                      RGBA-IMAGE "RGB Graph" 100 NORMAL-MODE)))
266
 
         (clayer (car (gimp-layer-new gimg gimg-width 40 RGBA-IMAGE
267
 
                                       "Color Sampled" opacity NORMAL-MODE)))
268
 
         (rgb '(255 255 255))
269
 
         (hsv '(254 255 255))
270
 
         (x-base border-size)
271
 
         (y-base (+ gimg-height border-size))
272
 
         (index 0))
273
 
 
274
 
    (gimp-context-push)
275
 
 
276
 
    (gimp-image-undo-disable gimg)
277
 
    (gimp-image-add-layer gimg bglayer -1)
278
 
    (gimp-selection-all gimg)
279
 
    (gimp-context-set-background '(255 255 255))
280
 
    (gimp-edit-fill bglayer BACKGROUND-FILL)
281
 
    (gimp-image-add-layer gimg hsv-layer -1)
282
 
    (gimp-edit-clear hsv-layer)
283
 
    (gimp-image-add-layer gimg rgb-layer -1)
284
 
    (gimp-drawable-set-visible rgb-layer FALSE)
285
 
    (gimp-edit-clear rgb-layer)
286
 
    (gimp-image-add-layer gimg clayer -1)
287
 
    (gimp-edit-clear clayer)
288
 
    (gimp-layer-translate clayer border-size 0)
289
 
    (gimp-selection-none gimg)
290
 
    (set! red-segment (make-segment 64 x-base y-base))
291
 
    (set! green-segment (make-segment 64 x-base y-base))
292
 
    (set! blue-segment (make-segment 64 x-base y-base))
293
 
    (set! hue-segment (make-segment 64 x-base y-base))
294
 
    (set! saturation-segment (make-segment 64 x-base y-base))
295
 
    (set! value-segment (make-segment 64 x-base y-base))
296
 
    (gimp-context-set-brush "Circle (01)")
297
 
    (gimp-context-set-paint-mode NORMAL-MODE)
298
 
    (gimp-context-set-opacity 70)
299
 
    (gimp-display-new gimg)
300
 
    (while (< index limit)
301
 
      (set! rgb (car (gimp-image-pick-color img drawable
302
 
                                            (+ beg-x (* x-len (/ index limit)))
303
 
                                            (+ beg-y (* y-len (/ index limit)))
304
 
                                            TRUE FALSE 0)))
305
 
      (fill-color-band gimg clayer index scale x-base 40 rgb)
306
 
      (rgb-to-hsv rgb hsv)
307
 
      (plot-hsv gimg hsv-layer index scale x-base y-base hsv)
308
 
      (plot-rgb gimg rgb-layer index scale x-base y-base rgb)
309
 
      (set! index (+ index 1)))
310
 
    (mapcar
311
 
     (lambda (segment color)
312
 
       (if (< 1 (segment-filled-size segment))
313
 
        (begin
314
 
          (gimp-context-set-foreground color)
315
 
          (draw-segment gimg hsv-layer segment (segment-filled-size segment)
316
 
                        color))))
317
 
     (list hue-segment saturation-segment value-segment)
318
 
     (list red-color green-color blue-color))
319
 
    (mapcar
320
 
     (lambda (segment color)
321
 
       (if (< 1 (segment-filled-size segment))
322
 
        (begin
323
 
          (gimp-context-set-foreground color)
324
 
          (draw-segment gimg rgb-layer segment (segment-filled-size segment)
325
 
                        color))))
326
 
     (list red-segment green-segment blue-segment)
327
 
     (list red-color green-color blue-color))
328
 
    (gimp-context-set-foreground '(255 255 255))
329
 
    (let ((text-layer (car (gimp-text-fontname gimg -1 0 0
330
 
                            "Red: Hue, Green: Sat, Blue: Val"
331
 
                            1 1 12 PIXELS
332
 
                            "Sans")))
333
 
          (offset-y (- y-base (car (gimp-drawable-height clayer)))))
334
 
      (gimp-layer-set-mode text-layer DIFFERENCE-MODE)
335
 
      (gimp-layer-translate clayer 0 offset-y)
336
 
      (gimp-layer-translate text-layer border-size (+ offset-y 15)))
337
 
    (gimp-image-set-active-layer gimg bglayer)
338
 
    (gimp-image-clean-all gimg)
339
 
    (gimp-image-undo-enable gimg)
340
 
 
341
 
    (set! script-fu-hsv-graph-scale scale)
342
 
    (set! script-fu-hsv-graph-opacity opacity)
343
 
    (set! script-fu-hsv-graph-bounds? bounds?)
344
 
    (set! script-fu-hsv-graph-left2right? left2right?)
345
 
    (set! script-fu-hsv-graph-beg-x beg-x)
346
 
    (set! script-fu-hsv-graph-beg-y beg-y)
347
 
    (set! script-fu-hsv-graph-end-x end-x)
348
 
    (set! script-fu-hsv-graph-end-y end-y)
349
 
    (gimp-displays-flush)
350
 
 
351
 
    (gimp-context-pop)
352
 
  )
353
 
)
354
 
 
355
 
(script-fu-register "script-fu-hsv-graph"
356
 
  _"Draw _HSV Graph..."
357
 
  _"Create a graph of the Hue, Saturation, and Value distributions"
358
 
  "Shuji Narazaki <narazaki@InetQ.or.jp>"
359
 
  "Shuji Narazaki"
360
 
  "1997"
361
 
  "RGB*"
362
 
  SF-IMAGE       "Image to analyze"    0
363
 
  SF-DRAWABLE    "Drawable to analyze" 0
364
 
  SF-ADJUSTMENT _"Graph scale"         '(1 0.1 5 0.1 1 1 1)
365
 
  SF-ADJUSTMENT _"BG opacity"          '(100 0 100 1 10 0 1)
366
 
  SF-TOGGLE     _"Use selection bounds instead of values below" TRUE
367
 
  SF-TOGGLE     _"From top-left to bottom-right"                FALSE
368
 
  SF-ADJUSTMENT _"Start X"             '(0 0 5000 1 10 0 1)
369
 
  SF-ADJUSTMENT _"Start Y"             '(0 0 5000 1 10 0 1)
370
 
  SF-ADJUSTMENT _"End X"               '(1 0 5000 1 10 0 1)
371
 
  SF-ADJUSTMENT _"End Y"               '(1 0 5000 1 10 0 1)
372
 
)
373
 
 
374
 
(script-fu-menu-register "script-fu-hsv-graph"
375
 
                         "<Image>/Colors/Info")