summaryrefslogtreecommitdiffstats
path: root/plug-ins/script-fu/scripts/round-corners.scm
blob: 53711d5a6760f681695ac06cf02b23d9b058af2f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
; GIMP - The GNU Image Manipulation Program
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
;
; 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 3 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.
;
; You should have received a copy of the GNU General Public License
; along with this program.  If not, see <https://www.gnu.org/licenses/>.
;
;
; round-corners.scm   version 1.02   1999/12/21
;
; CHANGE-LOG:
; 1.00 - initial release
; 1.01 - some code cleanup, no real changes
;
; Copyright (C) 1997-1999 Sven Neumann <sven@gimp.org>
;
;
; Rounds the corners of an image, optionally adding a drop-shadow and
; a background layer
;
; The script works on RGB and grayscale images that contain only
; one layer. It creates a copy of the image or can optionally work
; on the original. The script uses the current background color to
; create a background layer. It makes a call to the script drop-shadow.
;
; This script is derived from my script add-shadow, which has become
; obsolete now.



(define (script-fu-round-corners img
                                 drawable
                                 radius
                                 shadow-toggle
                                 shadow-x
                                 shadow-y
                                 shadow-blur
                                 background-toggle
                                 work-on-copy)
  (let* ((shadow-blur (abs shadow-blur))
         (radius (abs radius))
         (diam (* 2 radius))
         (width (car (gimp-image-width img)))
         (height (car (gimp-image-height img)))
         (image (cond ((= work-on-copy TRUE)
                       (car (gimp-image-duplicate img)))
                      ((= work-on-copy FALSE)
                       img)))
         ; active drawable is not necessarily the active layer
         (pic-layer (car (gimp-image-get-active-layer image)))
         (type (car (gimp-drawable-type-with-alpha pic-layer)))
        )

  (gimp-context-push)
  (gimp-context-set-defaults)

  (if (= work-on-copy TRUE)
      (gimp-image-undo-disable image)
      (gimp-image-undo-group-start image)
  )

  ; add an alpha channel to the image
  (gimp-layer-add-alpha pic-layer)

  ; round the edges
  (gimp-selection-none image)
  (gimp-image-select-rectangle image CHANNEL-OP-ADD 0 0 radius radius)
  (gimp-image-select-ellipse image CHANNEL-OP-SUBTRACT  0 0 diam diam)
  (gimp-image-select-rectangle image CHANNEL-OP-ADD (- width radius) 0 radius radius)
  (gimp-image-select-ellipse image CHANNEL-OP-SUBTRACT (- width diam) 0 diam diam)
  (gimp-image-select-rectangle image CHANNEL-OP-ADD 0 (- height radius) radius radius)
  (gimp-image-select-ellipse image CHANNEL-OP-SUBTRACT 0 (- height diam) diam diam)
  (gimp-image-select-rectangle image CHANNEL-OP-ADD (- width radius) (- height radius)
                    radius radius)
  (gimp-image-select-ellipse image CHANNEL-OP-SUBTRACT (- width diam) (- height diam)
                       diam diam)
  (gimp-drawable-edit-clear pic-layer)
  (gimp-selection-none image)

  ; optionally add a shadow
  (if (= shadow-toggle TRUE)
      (begin
        (script-fu-drop-shadow image
                               pic-layer
                               shadow-x
                               shadow-y
                               shadow-blur
                               '(0 0 0)
                               80
                               TRUE)
        (set! width (car (gimp-image-width image)))
        (set! height (car (gimp-image-height image)))))

  ; optionally add a background
  (if (= background-toggle TRUE)
      (let* ((bg-layer (car (gimp-layer-new image
                                            width
                                            height
                                            type
                                            "Background"
                                            100
                                            LAYER-MODE-NORMAL))))
        (gimp-drawable-fill bg-layer FILL-BACKGROUND)
        (gimp-image-insert-layer image bg-layer 0 -1)
        (gimp-image-raise-item image pic-layer)
        (if (= shadow-toggle TRUE)
            (gimp-image-lower-item image bg-layer))))

; clean up after the script
  (if (= work-on-copy TRUE)
      (gimp-image-undo-enable image)
      (gimp-image-undo-group-end image)
  )

  (if (= work-on-copy TRUE)
      (gimp-display-new image))
  (gimp-context-pop)
  (gimp-displays-flush))
)

(script-fu-register "script-fu-round-corners"
  _"_Round Corners..."
  _"Round the corners of an image and optionally add a drop-shadow and background"
  "Sven Neumann <sven@gimp.org>"
  "Sven Neumann"
  "1999/12/21"
  "RGB* GRAY*"
  SF-IMAGE      "Image"            0
  SF-DRAWABLE   "Drawable"         0
  SF-ADJUSTMENT _"Edge radius"     '(15 0 4096 1 10 0 1)
  SF-TOGGLE     _"Add drop-shadow" TRUE
  SF-ADJUSTMENT _"Shadow X offset" '(8 -4096 4096 1 10 0 1)
  SF-ADJUSTMENT _"Shadow Y offset" '(8 -4096 4096 1 10 0 1)
  SF-ADJUSTMENT _"Blur radius"     '(15 0 1024 1 10 0 1)
  SF-TOGGLE     _"Add background"  TRUE
  SF-TOGGLE     _"Work on copy"    TRUE
)

(script-fu-menu-register "script-fu-round-corners"
                         "<Image>/Filters/Decor")