← Back to branch summary

~ubuntu-branches/ubuntu/jaunty/gimp/jaunty-security

« back to all changes in this revision

Viewing changes to plug-ins/script-fu/scripts/image-structure.scm

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Holbach
  • Date: 2007-05-02 16:33:03 UTC
  • mfrom: (1.1.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20070502163303-bvzhjzbpw8qglc4y
Tags: 2.3.16-1ubuntu1
* Resynchronized with Debian, remaining Ubuntu changes:
  - debian/rules: i18n magic.
* debian/control.in:
  - Maintainer: Ubuntu Core Developers <ubuntu-devel@lists.ubuntu.com>
* debian/patches/02_help-message.patch,
  debian/patches/03_gimp.desktop.in.in.patch,
  debian/patches/10_dont_show_wizard.patch: updated.
* debian/patches/04_composite-signedness.patch,
  debian/patches/05_add-letter-spacing.patch: dropped, used upstream.

Show diffs side-by-side

added added

removed removed

Lines of Context:
plug-ins/script-fu/scripts/image-structure.scm
1
 
;;; image-structure.scm -*-scheme-*-
2
 
;;; Time-stamp: <1998/03/28 02:46:26 narazaki@InetQ.or.jp>
3
 
;;; Author: Shuji Narazaki <narazaki@InetQ.or.jp>
4
 
;;; Version 0.7
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-show-image-structure-new-image?
14
 
                        (the-environment)))
15
 
    (define script-fu-show-image-structure-new-image? TRUE))
16
 
(if (not (symbol-bound? 'script-fu-show-image-structure-space
17
 
                        (the-environment)))
18
 
    (define script-fu-show-image-structure-space 50))
19
 
(if (not (symbol-bound? 'script-fu-show-image-structure-shear-length
20
 
                        (the-environment)))
21
 
    (define script-fu-show-image-structure-shear-length 50))
22
 
(if (not (symbol-bound? 'script-fu-show-image-structure-border
23
 
                        (the-environment)))
24
 
    (define script-fu-show-image-structure-border 10))
25
 
(if (not (symbol-bound? 'script-fu-show-image-structure-apply-layer-mask?
26
 
                        (the-environment)))
27
 
    (define script-fu-show-image-structure-apply-layer-mask? TRUE))
28
 
(if (not (symbol-bound? 'script-fu-show-image-structure-with-layer-name?
29
 
                        (the-environment)))
30
 
    (define script-fu-show-image-structure-with-layer-name? TRUE))
31
 
(if (not (symbol-bound? 'script-fu-show-image-structure-with-pad?
32
 
                        (the-environment)))
33
 
    (define script-fu-show-image-structure-with-pad? TRUE))
34
 
(if (not (symbol-bound? 'script-fu-show-image-structure-padding-color
35
 
                        (the-environment)))
36
 
    (define script-fu-show-image-structure-padding-color '(255 255 255)))
37
 
(if (not (symbol-bound? 'script-fu-show-image-structure-padding-opacity
38
 
                        (the-environment)))
39
 
    (define script-fu-show-image-structure-padding-opacity 25))
40
 
(if (not (symbol-bound? 'script-fu-show-image-structure-with-background?
41
 
                        (the-environment)))
42
 
    (define script-fu-show-image-structure-with-background? TRUE))
43
 
(if (not (symbol-bound? 'script-fu-show-image-structure-background-color
44
 
                        (the-environment)))
45
 
    (define script-fu-show-image-structure-background-color '(0 0 0)))
46
 
 
47
 
(define (script-fu-show-image-structure img drawable new-image? space
48
 
                                        shear-length border apply-layer-mask?
49
 
                                        with-layer-name? with-pad? padding-color
50
 
                                        padding-opacity with-background?
51
 
                                        background-color)
52
 
  (if (eq? new-image? TRUE)
53
 
      (begin (set! img (car (gimp-image-duplicate img)))
54
 
             (gimp-display-new img)))
55
 
  (let* ((layers (gimp-image-get-layers img))
56
 
         (num-of-layers (car layers))
57
 
         (old-width (car (gimp-image-width img)))
58
 
         (old-height (car (gimp-image-height img)))
59
 
         (new-width (+ (* 2 border) (+ old-width (* 2 shear-length))))
60
 
         (new-height (+ (* 2 border) (+ old-height (* space (- num-of-layers 1)))))
61
 
         (new-bg #f)
62
 
         (layer-names '())
63
 
         (layer #f)
64
 
         (index 0))
65
 
 
66
 
    (gimp-context-push)
67
 
 
68
 
    (gimp-image-resize img new-width new-height 0 0)
69
 
    (set! layers (cadr layers))
70
 
    (gimp-selection-none img)
71
 
    (while (< index num-of-layers)
72
 
      (set! layer (aref layers index))
73
 
      (if (equal? "Background" (car (gimp-drawable-get-name layer)))
74
 
          (begin
75
 
            (gimp-layer-add-alpha layer)
76
 
            (gimp-drawable-set-name layer "Original Background")))
77
 
      (set! layer-names (cons (car (gimp-drawable-get-name layer)) layer-names))
78
 
      (if (not (= -1 (car (gimp-layer-get-mask layer))))
79
 
          (gimp-layer-remove-mask layer
80
 
                                  (if (= TRUE apply-layer-mask?)
81
 
                                      MASK-APPLY
82
 
                                      MASK-DISCARD)))
83
 
      (if (= TRUE with-pad?)
84
 
          (begin
85
 
            (gimp-selection-layer-alpha layer)
86
 
            (gimp-selection-invert img)
87
 
            (gimp-layer-set-preserve-trans layer FALSE)
88
 
            (gimp-context-set-foreground padding-color)
89
 
            (gimp-edit-bucket-fill layer FG-BUCKET-FILL NORMAL-MODE
90
 
                                   padding-opacity 0 0 0 0)
91
 
            (gimp-selection-none img)))
92
 
 
93
 
      (gimp-layer-translate layer
94
 
                            (+ border shear-length) (+ border (* space index)))
95
 
      (gimp-drawable-transform-shear-default layer ORIENTATION-HORIZONTAL
96
 
                                             (* (/ (car (gimp-drawable-height layer))
97
 
                                                   old-height)
98
 
                                                (* -2 shear-length))
99
 
                                             TRUE FALSE)
100
 
      (set! index (+ index 1)))
101
 
    (set! new-bg (- num-of-layers 1))
102
 
    (if (= TRUE with-background?)
103
 
        (begin
104
 
          (set! new-bg (car (gimp-layer-new img new-width new-height RGBA-IMAGE
105
 
                                            "New Background" 100 NORMAL-MODE)))
106
 
          (gimp-image-add-layer img new-bg num-of-layers)
107
 
          (gimp-context-set-background background-color)
108
 
          (gimp-edit-fill new-bg BACKGROUND-FILL)))
109
 
    (gimp-image-set-active-layer img (aref layers 0))
110
 
    (if (= TRUE with-layer-name?)
111
 
        (let ((text-layer #f))
112
 
          (gimp-context-set-foreground '(255 255 255))
113
 
          (set! index 0)
114
 
          (set! layer-names (nreverse layer-names))
115
 
          (while (< index num-of-layers)
116
 
            (set! text-layer (car (gimp-text-fontname img -1 (/ border 2)
117
 
                                             (+ (* space index) old-height)
118
 
                                             (car layer-names)
119
 
                                             0 TRUE 14 PIXELS "Sans")))
120
 
            (gimp-layer-set-mode text-layer NORMAL-MODE)
121
 
            (set! index (+ index 1))
122
 
            (set! layer-names (cdr layer-names)))))
123
 
 
124
 
    (gimp-image-set-active-layer img new-bg)
125
 
 
126
 
    (set! script-fu-show-image-structure-new-image? new-image?)
127
 
    (set! script-fu-show-image-structure-space space)
128
 
    (set! script-fu-show-image-structure-shear-length shear-length)
129
 
    (set! script-fu-show-image-structure-border border)
130
 
    (set! script-fu-show-image-structure-apply-layer-mask? apply-layer-mask?)
131
 
    (set! script-fu-show-image-structure-with-layer-name? with-layer-name?)
132
 
    (set! script-fu-show-image-structure-with-pad? with-pad?)
133
 
    (set! script-fu-show-image-structure-padding-color padding-color)
134
 
    (set! script-fu-show-image-structure-padding-opacity padding-opacity)
135
 
    (set! script-fu-show-image-structure-with-background? with-background?)
136
 
    (set! script-fu-show-image-structure-background-color background-color)
137
 
 
138
 
    (gimp-displays-flush)
139
 
 
140
 
    (gimp-context-pop)))
141
 
 
142
 
(script-fu-register "script-fu-show-image-structure"
143
 
                    _"Show Image _Structure..."
144
 
                    "Show the layer structure of the image"
145
 
                    "Shuji Narazaki <narazaki@InetQ.or.jp>"
146
 
                    "Shuji Narazaki"
147
 
                    "1997"
148
 
                    "RGB*, GRAY*"
149
 
                    SF-IMAGE       "image" 0
150
 
                    SF-DRAWABLE    "Drawable (unused)" 0
151
 
                    SF-TOGGLE     _"Create new image" script-fu-show-image-structure-new-image?
152
 
                    SF-ADJUSTMENT _"Space between layers" (cons script-fu-show-image-structure-space '(0 1000 1 10 0 1))
153
 
                    SF-ADJUSTMENT _"Shear length" (cons script-fu-show-image-structure-shear-length '(1 1000 1 10 0 1))
154
 
                    SF-ADJUSTMENT _"Outer border" (cons script-fu-show-image-structure-border '(0 250 1 10 0 1))
155
 
                    SF-TOGGLE     _"Apply layer mask (or discard)" script-fu-show-image-structure-apply-layer-mask?
156
 
                    SF-TOGGLE     _"Insert layer names" script-fu-show-image-structure-with-layer-name?
157
 
                    SF-TOGGLE     _"Padding for transparent regions" script-fu-show-image-structure-with-pad?
158
 
                    SF-COLOR      _"Pad color" script-fu-show-image-structure-padding-color
159
 
                    SF-ADJUSTMENT _"Pad opacity" (cons script-fu-show-image-structure-padding-opacity '(0 100 1 10 1 0))
160
 
                    SF-TOGGLE     _"Make new background" script-fu-show-image-structure-with-background?
161
 
                    SF-COLOR      _"Background color" script-fu-show-image-structure-background-color)
162
 
 
163
 
(script-fu-menu-register "script-fu-show-image-structure"
164
 
                         _"<Image>/Script-Fu/Utils")