1
; The GIMP -- an image manipulation program
2
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
4
; This program is free software; you can redistribute it and/or modify
5
; it under the terms of the GNU General Public License as published by
6
; the Free Software Foundation; either version 2 of the License, or
7
; (at your option) any later version.
9
; This program is distributed in the hope that it will be useful,
10
; but WITHOUT ANY WARRANTY; without even the implied warranty of
11
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12
; GNU General Public License for more details.
14
; You should have received a copy of the GNU General Public License
15
; along with this program; if not, write to the Free Software
16
; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19
; slide.scm version 0.41 2004/03/28
22
; 0.20 - first public release
23
; 0.30 - some code cleanup
24
; now uses the rotate plug-in to improve speed
25
; 0.40 - changes to work with gimp-1.1
26
; if the image was rotated, rotate the whole thing back when finished
27
; 0.41 - changes to work with gimp-2.0, slightly correct text offsets,
28
; Nils Philippsen <nphilipp@redhat.com> 2004/03/28
30
; !still in development!
31
; TODO: - change the script so that the film is rotated, not the image
33
; - make 'add background' an option
36
; Copyright (C) 1997-1999 Sven Neumann <sven@gimp.org>
38
; makes your picture look like a slide
40
; The script works on RGB and grayscale images that contain only
41
; one layer. The image is cropped to fit into an aspect ratio of 1:1,5.
42
; It creates a copy of the image or can optionally work on the original.
43
; The script uses the current background color to create a background
47
(define (crop width height ratio)
48
(cond ((>= width (* ratio height)) (* ratio height))
49
((< width (* ratio height)) width)))
52
(define (script-fu-slide img
59
(let* ((type (car (gimp-drawable-type-with-alpha drawable)))
60
(image (cond ((= work-on-copy TRUE)
61
(car (gimp-image-duplicate img)))
62
((= work-on-copy FALSE)
64
(owidth (car (gimp-image-width image)))
65
(oheight (car (gimp-image-height image)))
66
(ratio (if (>= owidth oheight) (/ 3 2)
68
(crop-width (crop owidth oheight ratio))
69
(crop-height (/ crop-width ratio))
70
(width (* (max crop-width crop-height) 1.05))
71
(height (* (min crop-width crop-height) 1.5))
72
(hole-width (/ width 20))
73
(hole-space (/ width 8))
74
(hole-height (/ width 12))
75
(hole-radius (/ hole-width 4))
76
(hole-start (- (/ (rand 1000) 1000) 0.5))
77
(film-layer (car (gimp-layer-new image
84
(bg-layer (car (gimp-layer-new image
91
(pic-layer (car (gimp-image-get-active-drawable image)))
92
(numbera (string-append number "A")))
96
(gimp-image-undo-disable image)
98
; add an alpha channel to the image
99
(gimp-layer-add-alpha pic-layer)
101
; crop, resize and eventually rotate the image
102
(gimp-image-crop image
105
(/ (- owidth crop-width) 2)
106
(/ (- oheight crop-height) 2))
107
(gimp-image-resize image
110
(/ (- width crop-width) 2)
111
(/ (- height crop-height) 2))
112
(if (< ratio 1) (plug-in-rotate 1
118
; add the background layer
119
(gimp-drawable-fill bg-layer BACKGROUND-FILL)
120
(gimp-image-add-layer image bg-layer -1)
123
(gimp-context-set-background '(0 0 0))
124
(gimp-drawable-fill film-layer BACKGROUND-FILL)
125
(gimp-image-add-layer image film-layer -1)
128
(gimp-context-set-foreground font-color)
129
(gimp-floating-sel-anchor (car (gimp-text-fontname image
131
(+ hole-start (* -0.25 width))
136
(* 0.040 height) PIXELS fontname)))
137
(gimp-floating-sel-anchor (car (gimp-text-fontname image
139
(+ hole-start (* 0.75 width))
144
(* 0.040 height) PIXELS
146
(gimp-floating-sel-anchor (car (gimp-text-fontname image
148
(+ hole-start (* 0.35 width))
153
(* 0.050 height) PIXELS
155
(gimp-floating-sel-anchor (car (gimp-text-fontname image
157
(+ hole-start (* 0.35 width))
162
(* 0.050 height) PIXELS
164
(gimp-floating-sel-anchor (car (gimp-text-fontname image
166
(+ hole-start (* 0.85 width))
171
(* 0.045 height) PIXELS
174
; create a mask for the holes and cut them out
175
(let* ((film-mask (car (gimp-layer-create-mask film-layer ADD-WHITE-MASK)))
177
(top-y (* height 0.06))
178
(bottom-y(* height 0.855)))
180
(gimp-layer-add-mask film-layer film-mask)
182
(gimp-selection-none image)
184
(gimp-rect-select image
192
(gimp-rect-select image
200
(set! hole (+ hole 1)))
202
(gimp-context-set-foreground '(0 0 0))
203
(gimp-edit-fill film-mask BACKGROUND-FILL)
204
(gimp-selection-none image)
205
(plug-in-gauss-rle 1 image film-mask hole-radius TRUE TRUE)
206
(gimp-threshold film-mask 127 255)
208
(gimp-layer-remove-mask film-layer MASK-APPLY))
211
(gimp-image-raise-layer image pic-layer)
212
(gimp-image-raise-layer image pic-layer)
214
; eventually rotate the whole thing back
222
; clean up after the script
223
(gimp-selection-none image)
224
(gimp-image-undo-enable image)
225
(if (= work-on-copy TRUE)
226
(gimp-display-new image))
227
(gimp-displays-flush)
231
(script-fu-register "script-fu-slide"
233
"Gives the image the look of a slide"
234
"Sven Neumann <sven@gimp.org>"
239
SF-DRAWABLE "Drawable" 0
240
SF-STRING _"Text" "The GIMP"
241
SF-STRING _"Number" "32"
242
SF-FONT _"Font" "Serif"
243
SF-COLOR _"Font color" '(255 180 0)
244
SF-TOGGLE _"Work on copy" TRUE)
246
(script-fu-menu-register "script-fu-slide"
247
_"<Image>/Script-Fu/Decor")