File: round-corners.scm

package info (click to toggle)
gimp 2.2.13-1etch4
  • links: PTS
  • area: main
  • in suites: etch
  • size: 94,832 kB
  • ctags: 47,113
  • sloc: ansic: 524,858; xml: 36,798; lisp: 9,870; sh: 9,409; makefile: 7,923; python: 2,674; perl: 2,589; yacc: 520; lex: 334
file content (142 lines) | stat: -rw-r--r-- 4,877 bytes parent folder | download | duplicates (3)
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
; The GIMP -- an 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 2 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, write to the Free Software
; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;
;
; 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 
; obsolet 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)))
	 (type (car (gimp-drawable-type-with-alpha drawable)))
	 (image (cond ((= work-on-copy TRUE)
		       (car (gimp-image-duplicate img)))
		      ((= work-on-copy FALSE)
		       img)))
	 (pic-layer (car (gimp-image-get-active-drawable image))))

  (cond ((= work-on-copy TRUE)
         (gimp-image-undo-disable image))
        ((= work-on-copy FALSE)
         (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-rect-select image 0 0 radius radius CHANNEL-OP-ADD 0 0)
  (gimp-ellipse-select image 0 0 diam diam CHANNEL-OP-SUBTRACT TRUE 0 0)
  (gimp-rect-select image (- width radius) 0 radius radius CHANNEL-OP-ADD 0 0)
  (gimp-ellipse-select image (- width diam) 0 diam diam CHANNEL-OP-SUBTRACT TRUE 0 0)
  (gimp-rect-select image 0 (- height radius) radius radius CHANNEL-OP-ADD 0 0)
  (gimp-ellipse-select image 0 (- height diam) diam diam CHANNEL-OP-SUBTRACT TRUE 0 0)
  (gimp-rect-select image (- width radius) (- height radius)
		    radius radius CHANNEL-OP-ADD 0 0)
  (gimp-ellipse-select image (- width diam) (- height diam)
		       diam diam CHANNEL-OP-SUBTRACT TRUE 0 0)
  (gimp-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
					    NORMAL-MODE))))
	(gimp-drawable-fill bg-layer BACKGROUND-FILL)
	(gimp-image-add-layer image bg-layer -1)
	(gimp-image-raise-layer image pic-layer)
	(if (= shadow-toggle TRUE)
	    (gimp-image-lower-layer image bg-layer))))

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

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

(script-fu-register "script-fu-round-corners"
		    _"_Round Corners..."
		    "Round the corners of an image and optionally adds a drop-shadow and a 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>/Script-Fu/Decor")