AlderconeStudio/PIKApp
0
0
Fork 0
Code Issues 1 Pull Requests Packages Projects Releases 1 Wiki Activity

Initial checkin of Pika from heckimp

Browse Source
This commit is contained in:
Cassowary
2023-09-25 15:35:21 -07:00
commit 891e999216
6761 changed files with 5240685 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

202
plug-ins/script-fu/scripts/add-bevel.scm Normal file
View File

@ -0,0 +1,202 @@
; PIKA - Photo and Image Kooker Application
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
;
; add-bevel.scm version 1.04
; Time-stamp: <2004-02-09 17:07:06 simon>
;
; 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/>.
;
; Copyright (C) 1997 Andrew Donkin (ard@cs.waikato.ac.nz)
; Contains code from add-shadow.scm by Sven Neumann
; (neumanns@uni-duesseldorf.de) (thanks Sven).
;
; Adds a bevel to an image. See http://www.cs.waikato.ac.nz/~ard/pika/
;
; If there is a selection, it is bevelled.
; Otherwise if there is an alpha channel, the selection is taken from it
; and bevelled.
; Otherwise the part of the layer inside the image boundaries is bevelled.
;
; The selection is set on exit, so Select->Invert then Edit->Clear will
; leave a cut-out. Then use Sven's add-shadow for that
; floating-bumpmapped-texture cliche.
;
; 1.01: now works on offset layers.
; 1.02: has crop-pixel-border option to trim one pixel off each edge of the
; bevelled image. Bumpmapping leaves edge pixels unchanged, which
; looks bad. Oddly, this is not apparent in PIKA - you have to
; save the image and load it into another viewer. First noticed in
; Nutscrape.
; Changed path (removed "filters/").
; 1.03: adds one-pixel border before bumpmapping, and removes it after.
; Got rid of the crop-pixel-border option (no longer reqd).
; 1.04: Fixed undo handling, ensure that bumpmap is big enough,
; (instead of resizing the image). Removed references to outdated
; bumpmap plugin. (Simon)
; 1.05 When there is no selection, bevel the whole layer instead of the
; whole image (which was broken in the first place).
; Also fixed some bugs with setting the selection when there is no
; initial selection. (Barak Itkin)
;
(define (script-fu-add-bevel img
drawable
thickness
work-on-copy
keep-bump-layer)
(let* (
(index 1)
(greyness 0)
(thickness (abs thickness))
(type (car (pika-drawable-type-with-alpha drawable)))
(image (if (= work-on-copy TRUE) (car (pika-image-duplicate img)) img))
(pic-layer (aref (cadr (pika-image-get-selected-drawables image)) 0))
(offsets (pika-drawable-get-offsets pic-layer))
(width (car (pika-drawable-get-width pic-layer)))
(height (car (pika-drawable-get-height pic-layer)))
; Bumpmap has a one pixel border on each side
(bump-layer (car (pika-layer-new image
(+ width 2)
(+ height 2)
RGB-IMAGE
_"Bumpmap"
100
LAYER-MODE-NORMAL)))
(selection-exists (car (pika-selection-bounds image)))
(selection 0)
)
(pika-context-push)
(pika-context-set-defaults)
; disable undo on copy, start group otherwise
(if (= work-on-copy TRUE)
(pika-image-undo-disable image)
(pika-image-undo-group-start image)
)
(pika-image-insert-layer image bump-layer 0 1)
; If the layer we're bevelling is offset from the image's origin, we
; have to do the same to the bumpmap
(pika-layer-set-offsets bump-layer (- (car offsets) 1)
(- (cadr offsets) 1))
;------------------------------------------------------------
;
; Set the selection to the area we want to bevel.
;
(if (= selection-exists 0)
(pika-image-select-item image CHANNEL-OP-REPLACE pic-layer)
)
; Store it for later.
(set! selection (car (pika-selection-save image)))
; Try to lose the jaggies
(pika-selection-feather image 2)
;------------------------------------------------------------
;
; Initialise our bumpmap
;
(pika-context-set-background '(0 0 0))
(pika-drawable-fill bump-layer FILL-BACKGROUND)
(while (and (< index thickness)
(= (car (pika-selection-is-empty image)) FALSE)
)
(set! greyness (/ (* index 255) thickness))
(pika-context-set-background (list greyness greyness greyness))
;(pika-selection-feather image 1) ;Stop the slopey jaggies?
(pika-drawable-edit-fill bump-layer FILL-BACKGROUND)
(pika-selection-shrink image 1)
(set! index (+ index 1))
)
; Now the white interior
(if (= (car (pika-selection-is-empty image)) FALSE)
(begin
(pika-context-set-background '(255 255 255))
(pika-drawable-edit-fill bump-layer FILL-BACKGROUND)
)
)
;------------------------------------------------------------
;
; Do the bump.
;
(pika-selection-none image)
; To further lessen jaggies?
;(plug-in-gauss-rle RUN-NONINTERACTIVE image bump-layer thickness TRUE TRUE)
;
; BUMPMAP INVOCATION:
;
(plug-in-bump-map RUN-NONINTERACTIVE image pic-layer bump-layer 125 45 3 0 0 0 0 TRUE FALSE 1)
;------------------------------------------------------------
;
; Restore things
;
(if (= selection-exists 0)
(pika-selection-none image) ; No selection to start with
(pika-image-select-item image CHANNEL-OP-REPLACE selection)
)
; If they started with a selection, they can Select->Invert then
; Edit->Clear for a cutout.
; clean up
(pika-image-remove-channel image selection)
(if (= keep-bump-layer TRUE)
(pika-item-set-visible bump-layer 0)
(pika-image-remove-layer image bump-layer)
)
(pika-image-set-selected-layers image 1 (vector pic-layer))
; enable undo / end undo group
(if (= work-on-copy TRUE)
(begin
(pika-display-new image)
(pika-image-undo-enable image)
)
(pika-image-undo-group-end image)
)
(pika-displays-flush)
(pika-context-pop)
)
)
(script-fu-register "script-fu-add-bevel"
_"Add B_evel..."
_"Add a beveled border to an image"
"Andrew Donkin <ard@cs.waikato.ac.nz>"
"Andrew Donkin"
"1997/11/06"
"RGB*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-ADJUSTMENT _"Thickness" '(5 0 30 1 2 0 0)
SF-TOGGLE _"Work on copy" TRUE
SF-TOGGLE _"Keep bump layer" FALSE
)
(script-fu-menu-register "script-fu-add-bevel" "<Image>/Filters/Decor")

177
plug-ins/script-fu/scripts/addborder.scm Normal file
View File

@ -0,0 +1,177 @@
; PIKA - Photo and Image Kooker Application
; 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/>.
;
; Copyright (C) 1997 Andy Thomas alt@picnic.demon.co.uk
;
; Version 0.2 10.6.97 Changed to new script-fu interface in 0.99.10
; Delta the color by the given amount. Check for boundary conditions
; If < 0 set to zero
; If > 255 set to 255
; Return the new value
(define (script-fu-addborder aimg adraw xsize ysize color dvalue)
(define (deltacolor col delta)
(let* ((newcol (+ col delta)))
(if (< newcol 0) (set! newcol 0))
(if (> newcol 255) (set! newcol 255))
newcol
)
)
(define (adjcolor col delta)
(mapcar (lambda (x) (deltacolor x delta)) col)
)
(define (gen_top_array xsize ysize owidth oheight width height)
(let* ((n_array (cons-array 10 'double)))
(aset n_array 0 0 )
(aset n_array 1 0 )
(aset n_array 2 xsize)
(aset n_array 3 ysize)
(aset n_array 4 (+ xsize owidth))
(aset n_array 5 ysize)
(aset n_array 6 width)
(aset n_array 7 0 )
(aset n_array 8 0 )
(aset n_array 9 0 )
n_array)
)
(define (gen_left_array xsize ysize owidth oheight width height)
(let* ((n_array (cons-array 10 'double)))
(aset n_array 0 0 )
(aset n_array 1 0 )
(aset n_array 2 xsize)
(aset n_array 3 ysize)
(aset n_array 4 xsize)
(aset n_array 5 (+ ysize oheight))
(aset n_array 6 0 )
(aset n_array 7 height )
(aset n_array 8 0 )
(aset n_array 9 0 )
n_array)
)
(define (gen_right_array xsize ysize owidth oheight width height)
(let* ((n_array (cons-array 10 'double)))
(aset n_array 0 width )
(aset n_array 1 0 )
(aset n_array 2 (+ xsize owidth))
(aset n_array 3 ysize)
(aset n_array 4 (+ xsize owidth))
(aset n_array 5 (+ ysize oheight))
(aset n_array 6 width)
(aset n_array 7 height)
(aset n_array 8 width )
(aset n_array 9 0 )
n_array)
)
(define (gen_bottom_array xsize ysize owidth oheight width height)
(let* ((n_array (cons-array 10 'double)))
(aset n_array 0 0 )
(aset n_array 1 height)
(aset n_array 2 xsize)
(aset n_array 3 (+ ysize oheight))
(aset n_array 4 (+ xsize owidth))
(aset n_array 5 (+ ysize oheight))
(aset n_array 6 width)
(aset n_array 7 height)
(aset n_array 8 0 )
(aset n_array 9 height)
n_array)
)
(let* ((img (car (pika-item-get-image adraw)))
(owidth (car (pika-image-get-width img)))
(oheight (car (pika-image-get-height img)))
(width (+ owidth (* 2 xsize)))
(height (+ oheight (* 2 ysize)))
(layer (car (pika-layer-new img
width height
(car (pika-drawable-type-with-alpha adraw))
_"Border Layer" 100 LAYER-MODE-NORMAL))))
(pika-context-push)
(pika-context-set-paint-mode LAYER-MODE-NORMAL)
(pika-context-set-opacity 100.0)
(pika-context-set-antialias FALSE)
(pika-context-set-feather FALSE)
(pika-image-undo-group-start img)
(pika-image-resize img
width
height
xsize
ysize)
(pika-image-insert-layer img layer 0 0)
(pika-drawable-fill layer FILL-TRANSPARENT)
(pika-context-set-background (adjcolor color dvalue))
(pika-image-select-polygon img
CHANNEL-OP-REPLACE
10
(gen_top_array xsize ysize owidth oheight width height))
(pika-drawable-edit-fill layer FILL-BACKGROUND)
(pika-context-set-background (adjcolor color (/ dvalue 2)))
(pika-image-select-polygon img
CHANNEL-OP-REPLACE
10
(gen_left_array xsize ysize owidth oheight width height))
(pika-drawable-edit-fill layer FILL-BACKGROUND)
(pika-context-set-background (adjcolor color (- 0 (/ dvalue 2))))
(pika-image-select-polygon img
CHANNEL-OP-REPLACE
10
(gen_right_array xsize ysize owidth oheight width height))
(pika-drawable-edit-fill layer FILL-BACKGROUND)
(pika-context-set-background (adjcolor color (- 0 dvalue)))
(pika-image-select-polygon img
CHANNEL-OP-REPLACE
10
(gen_bottom_array xsize ysize owidth oheight width height))
(pika-drawable-edit-fill layer FILL-BACKGROUND)
(pika-selection-none img)
(pika-image-undo-group-end img)
(pika-displays-flush)
(pika-context-pop)
)
)
(script-fu-register "script-fu-addborder"
_"Add _Border..."
_"Add a border around an image"
"Andy Thomas <alt@picnic.demon.co.uk>"
"Andy Thomas"
"6/10/97"
"*"
SF-IMAGE "Input image" 0
SF-DRAWABLE "Input drawable" 0
SF-ADJUSTMENT _"Border X size" '(12 1 250 1 10 0 1)
SF-ADJUSTMENT _"Border Y size" '(12 1 250 1 10 0 1)
SF-COLOR _"Border color" '(38 31 207)
SF-ADJUSTMENT _"Delta value on color" '(25 1 255 1 10 0 1)
)
(script-fu-menu-register "script-fu-addborder"
"<Image>/Filters/Decor")

242
plug-ins/script-fu/scripts/blend-anim.scm Normal file
View File

@ -0,0 +1,242 @@
; PIKA - Photo and Image Kooker Application
; 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/>.
;
;
; blend-anim.scm version 1.03 1999/12/21
;
; CHANGE-LOG:
; 1.00 - initial release
; 1.01 - some code cleanup, no real changes
; 1.02 - use pika-message to output an error message if called
; with less than three layers
; 1.03 - only call blur plugin when blut-radius >= 1.0
;
; Copyright (C) 1997-1999 Sven Neumann <sven@gimp.org>
;
;
; Blends two or more layers over a background, so that an animation can
; be saved. A minimum of three layers is required.
(define (script-fu-blend-anim img
drawable
frames
max-blur
looped)
(define (multi-raise-layer image layer times)
(while (> times 0)
(pika-image-raise-item image layer)
(set! times (- times 1))
)
)
(let* (
(max-blur (max max-blur 0))
(frames (max frames 0))
(image (car (pika-image-duplicate img)))
(width (car (pika-image-get-width image)))
(height (car (pika-image-get-height image)))
(layers (pika-image-get-layers image))
(num-layers (car layers))
(layer-array (cadr layers))
(slots (- num-layers 2))
(bg-layer (aref layer-array (- num-layers 1)))
(max-width 0)
(max-height 0)
(offset-x 0)
(offset-y 0)
)
(if (> num-layers 2)
(begin
(pika-image-undo-disable image)
(if (= looped TRUE)
; add a copy of the lowest blend layer on top
(let* ((copy (car (pika-layer-copy
(aref layer-array (- num-layers 2)) TRUE))))
(pika-image-insert-layer image copy 0 0)
(set! layers (pika-image-get-layers image))
(set! num-layers (car layers))
(set! layer-array (cadr layers))
(set! slots (- num-layers 2))
(set! bg-layer (aref layer-array (- num-layers 1)))))
; make all layers invisible and check for sizes
(let* ((min-offset-x width)
(min-offset-y height)
(layer-count slots))
(pika-item-set-visible bg-layer FALSE)
(while (> layer-count -1)
(let* ((layer (aref layer-array layer-count))
(layer-width (+ (car (pika-drawable-get-width layer))
(* max-blur 2)))
(layer-height (+ (car (pika-drawable-get-height layer))
(* max-blur 2)))
(layer-offsets (pika-drawable-get-offsets layer))
(layer-offset-x (- (car layer-offsets) max-blur))
(layer-offset-y (- (cadr layer-offsets) max-blur)))
(pika-item-set-visible layer FALSE)
(set! max-width (max max-width layer-width))
(set! max-height (max max-height layer-height))
(set! min-offset-x (min min-offset-x layer-offset-x))
(set! min-offset-y (min min-offset-y layer-offset-y))
(set! layer-count (- layer-count 1))))
(set! offset-x (- (car (pika-drawable-get-offsets bg-layer))
min-offset-x))
(set! offset-y (- (cadr (pika-drawable-get-offsets bg-layer))
min-offset-y)))
; create intermediate frames by merging copies of adjacent layers
; with the background layer
(let* ((layer-count slots))
(while (> layer-count 0)
(let* ((frame-count frames)
(lower-layer (aref layer-array layer-count))
(upper-layer (aref layer-array (- layer-count 1))))
(while (> frame-count 0)
(let* ((opacity (* (/ frame-count (+ frames 1)) 100))
(blur (/ (* opacity max-blur) 100))
(upper-copy (car (pika-layer-copy upper-layer TRUE)))
(lower-copy (car (pika-layer-copy lower-layer TRUE)))
(bg-copy (car (pika-layer-copy bg-layer TRUE))))
(pika-image-insert-layer image bg-copy 0 0)
(pika-image-insert-layer image lower-copy 0 0)
(pika-image-insert-layer image upper-copy 0 0)
(pika-item-set-visible upper-copy TRUE)
(pika-item-set-visible lower-copy TRUE)
(pika-item-set-visible bg-copy TRUE)
(pika-layer-set-opacity upper-copy (- 100 opacity))
(pika-layer-set-opacity lower-copy opacity)
(pika-layer-set-opacity bg-copy 100)
(if (> max-blur 0)
(let* ((layer-width (car (pika-drawable-get-width upper-copy)))
(layer-height (car (pika-drawable-get-height upper-copy))))
(pika-layer-set-lock-alpha upper-copy FALSE)
(pika-layer-resize upper-copy
(+ layer-width (* blur 2))
(+ layer-height (* blur 2))
blur
blur)
(if (>= blur 1.0)
(plug-in-gauss-rle RUN-NONINTERACTIVE
image
upper-copy
blur
TRUE TRUE))
(set! blur (- max-blur blur))
(pika-layer-set-lock-alpha lower-copy FALSE)
(set! layer-width (car (pika-drawable-get-width
lower-copy)))
(set! layer-height (car (pika-drawable-get-height
lower-copy)))
(pika-layer-resize lower-copy
(+ layer-width (* blur 2))
(+ layer-height (* blur 2))
blur
blur)
(if (>= blur 1.0)
(plug-in-gauss-rle RUN-NONINTERACTIVE
image
lower-copy
blur
TRUE TRUE))))
(pika-layer-resize bg-copy
max-width
max-height
offset-x
offset-y)
(let* ((merged-layer (car (pika-image-merge-visible-layers
image CLIP-TO-IMAGE))))
(pika-item-set-visible merged-layer FALSE))
(set! frame-count (- frame-count 1))))
(set! layer-count (- layer-count 1)))))
; merge all original blend layers but the lowest one
; with copies of the background layer
(let* ((layer-count 0))
(while (< layer-count slots)
(let* ((orig-layer (aref layer-array layer-count))
(bg-copy (car (pika-layer-copy bg-layer TRUE))))
(pika-image-insert-layer image
bg-copy
-1
(* layer-count (+ frames 1)))
(multi-raise-layer image
orig-layer
(+ (* (- slots layer-count) frames) 1))
(pika-item-set-visible orig-layer TRUE)
(pika-item-set-visible bg-copy TRUE)
(pika-layer-resize bg-copy
max-width
max-height
offset-x
offset-y)
(let* ((merged-layer (car (pika-image-merge-visible-layers
image CLIP-TO-IMAGE))))
(pika-item-set-visible merged-layer FALSE))
(set! layer-count (+ layer-count 1)))))
; merge the lowest blend layer with the background layer
(let* ((orig-layer (aref layer-array (- num-layers 2))))
(pika-item-set-visible bg-layer TRUE)
(pika-item-set-visible orig-layer TRUE)
(pika-image-merge-visible-layers image CLIP-TO-IMAGE))
; make all layers visible again
(let* ((result-layers (pika-image-get-layers image))
(num-result-layers (car result-layers))
(result-layer-array (cadr result-layers))
(layer-count (- num-result-layers 1)))
(while (> layer-count -1)
(let* ((layer (aref result-layer-array layer-count))
(name (string-append _"Frame" " "
(number->string
(- num-result-layers layer-count) 10))))
(pika-item-set-visible layer TRUE)
(pika-item-set-name layer name)
(set! layer-count (- layer-count 1))))
(if (= looped TRUE)
; remove the topmost layer
(pika-image-remove-layer image (aref result-layer-array 0))))
(pika-image-undo-enable image)
(pika-display-new image)
(pika-displays-flush)
)
(pika-message _"Blend Animation needs at least three source layers")
)
)
)
(script-fu-register "script-fu-blend-anim"
_"_Blend..."
_"Create intermediate layers to blend two or more layers over a background as an animation"
"Sven Neumann <sven@gimp.org>"
"Sven Neumann"
"1999/12/21"
"RGB* GRAY*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-ADJUSTMENT _"Intermediate frames" '(3 1 1024 1 10 0 1)
SF-ADJUSTMENT _"Max. blur radius" '(0 0 1024 1 10 0 1)
SF-TOGGLE _"Looped" TRUE
)
(script-fu-menu-register "script-fu-blend-anim"
"<Image>/Filters/Animation/")

243
plug-ins/script-fu/scripts/burn-in-anim.scm Normal file
View File

@ -0,0 +1,243 @@
;
; burn-in-anim.scm V2.1 - script-fu for PIKA 1.1 and higher
;
; Copyright (C) 9/2000 Roland Berger
; roland@fuchur.leute.server.de
; http://fuchur.leute.server.de
;
; Let text appear and fade out with a "burn-in" like SFX.
; Works on an image with a text and a background layer
;
; Copying Policy: GNU Public License http://www.gnu.org
;
(define (script-fu-burn-in-anim org-img
org-layer
glow-color
fadeout
bl-width
corona-width
after-glow
show-glow
optimize
speed)
(let* (
;--- main variable: "bl-x" runs from 0 to layer-width
(bl-x 0)
(frame-nr 0)
(img 0)
(source-layer 0)
(bg-source-layer 0)
(source-layer-width 0)
(bg-layer 0)
(bg-layer-name 0)
(bl-layer 0)
(bl-layer-name 0)
(bl-mask 0)
(bl-layer-width 0)
(bl-height 0)
(bl-x-off 0)
(bl-y-off 0)
(nofadeout-bl-x-off 0)
(nofadeout-bl-width 0)
(blended-layer 0)
(img-display 0)
)
(if (< speed 1)
(set! speed (* -1 speed)) )
;--- check image and work on a copy
(if (and (= (car (pika-image-get-layers org-img)) 2)
(= (car (pika-image-get-floating-sel org-img)) -1))
;--- main program structure starts here, begin of "if-1"
(begin
(pika-context-push)
(pika-context-set-defaults)
(set! img (car (pika-image-duplicate org-img)))
(pika-image-undo-disable img)
(if (> (car (pika-drawable-type org-layer)) 1 )
(pika-image-convert-rgb img))
(set! source-layer (aref (cadr (pika-image-get-layers img)) 0 ))
(set! bg-source-layer (aref (cadr (pika-image-get-layers img)) 1 ))
(set! source-layer-width (car (pika-drawable-get-width source-layer)))
;--- hide layers, cause we want to "merge visible layers" later
(pika-item-set-visible source-layer FALSE)
(pika-item-set-visible bg-source-layer FALSE)
;--- process image horizontal with pixel-speed
(while (< bl-x (+ source-layer-width bl-width))
(set! bl-layer (car (pika-layer-copy source-layer TRUE)))
(set! bl-layer-name (string-append "fr-nr"
(number->string frame-nr 10) ) )
(pika-image-insert-layer img bl-layer 0 -2)
(pika-item-set-name bl-layer bl-layer-name)
(pika-item-set-visible bl-layer TRUE)
(pika-layer-set-lock-alpha bl-layer TRUE)
(pika-layer-add-alpha bl-layer)
;--- add an alpha mask for blending and select it
(pika-image-select-item img CHANNEL-OP-REPLACE bl-layer)
(set! bl-mask (car (pika-layer-create-mask bl-layer ADD-MASK-BLACK)))
(pika-layer-add-mask bl-layer bl-mask)
;--- handle layer geometry
(set! bl-layer-width source-layer-width)
(set! bl-height (car (pika-drawable-get-height bl-layer)))
(set! bl-x-off (- bl-x bl-width))
(set! bl-x-off (+ bl-x-off (car (pika-drawable-get-offsets bl-layer))))
(set! bl-y-off (cadr (pika-drawable-get-offsets bl-layer)))
;--- select a rectangular area to blend
(pika-image-select-rectangle img CHANNEL-OP-REPLACE bl-x-off bl-y-off bl-width bl-height)
;--- select at least 1 pixel!
(pika-image-select-rectangle img CHANNEL-OP-ADD bl-x-off bl-y-off (+ bl-width 1) bl-height)
(if (= fadeout FALSE)
(begin
(set! nofadeout-bl-x-off (car (pika-drawable-get-offsets bl-layer)))
(set! nofadeout-bl-width (+ nofadeout-bl-x-off bl-x))
(set! nofadeout-bl-width (max nofadeout-bl-width 1))
(pika-image-select-rectangle img CHANNEL-OP-REPLACE
nofadeout-bl-x-off bl-y-off
nofadeout-bl-width bl-height)
)
)
;--- alpha blending text to trans (fadeout)
(pika-context-set-foreground '(255 255 255))
(pika-context-set-background '( 0 0 0))
(if (= fadeout TRUE)
(begin
; blend with 20% offset to get less transparency in the front
(pika-context-set-gradient-fg-bg-rgb)
(pika-drawable-edit-gradient-fill bl-mask
GRADIENT-LINEAR 20
FALSE 0 0
TRUE
(+ bl-x-off bl-width) 0
bl-x-off 0)
)
)
(if (= fadeout FALSE)
(begin
(pika-context-set-foreground '(255 255 255))
(pika-drawable-edit-fill bl-mask FILL-FOREGROUND)
)
)
(pika-layer-remove-mask bl-layer MASK-APPLY)
;--- add bright glow in front
(if (= show-glow TRUE)
(begin
;--- add some brightness to whole text
(if (= fadeout TRUE)
(pika-drawable-brightness-contrast bl-layer 0.787 0)
)
;--- blend glow color inside the letters
(pika-context-set-foreground glow-color)
(pika-context-set-gradient-fg-transparent)
(pika-drawable-edit-gradient-fill bl-layer
GRADIENT-LINEAR 0
FALSE 0 0
TRUE
(+ bl-x-off bl-width) 0
(- (+ bl-x-off bl-width) after-glow) 0)
;--- add corona effect
(pika-image-select-item img CHANNEL-OP-REPLACE bl-layer)
(pika-selection-sharpen img)
(pika-selection-grow img corona-width)
(pika-layer-set-lock-alpha bl-layer FALSE)
(pika-selection-feather img corona-width)
(pika-context-set-foreground glow-color)
(pika-drawable-edit-gradient-fill bl-layer
GRADIENT-LINEAR 0
FALSE 0 0
TRUE
(- (+ bl-x-off bl-width) corona-width) 0
(- (+ bl-x-off bl-width) after-glow) 0)
)
)
;--- merge with bg layer
(set! bg-layer (car (pika-layer-copy bg-source-layer FALSE)))
(pika-image-insert-layer img bg-layer 0 -1)
(pika-image-lower-item img bg-layer)
(set! bg-layer-name (string-append "bg-"
(number->string frame-nr 10)))
(pika-item-set-name bg-layer bg-layer-name)
(pika-item-set-visible bg-layer TRUE)
(set! blended-layer (car (pika-image-merge-visible-layers img
CLIP-TO-IMAGE)))
;(set! blended-layer bl-layer)
(pika-item-set-visible blended-layer FALSE)
;--- end of "while" loop
(set! frame-nr (+ frame-nr 1))
(set! bl-x (+ bl-x speed))
)
;--- finalize the job
(pika-selection-none img)
(pika-image-remove-layer img source-layer)
(pika-image-remove-layer img bg-source-layer)
(pika-image-set-file img "burn-in.xcf")
(if (= optimize TRUE)
(begin
(pika-image-convert-indexed img CONVERT-DITHER-FS CONVERT-PALETTE-WEB 250 FALSE TRUE "")
(set! img (car (plug-in-animationoptimize RUN-NONINTERACTIVE
img
blended-layer)))
)
)
(pika-item-set-visible (aref (cadr (pika-image-get-layers img)) 0)
TRUE)
(pika-image-undo-enable img)
(pika-image-clean-all img)
(set! img-display (car (pika-display-new img)))
(pika-displays-flush)
(pika-context-pop)
)
;--- false form of "if-1"
(pika-message _"The Burn-In script needs two layers in total. A foreground layer with transparency and a background layer.")
)
)
)
(script-fu-register "script-fu-burn-in-anim"
_"B_urn-In..."
_"Create intermediate layers to produce an animated 'burn-in' transition between two layers"
"Roland Berger roland@fuchur.leute.server.de"
"Roland Berger"
"January 2001"
"RGBA GRAYA INDEXEDA"
SF-IMAGE "The image" 0
SF-DRAWABLE "Layer to animate" 0
SF-COLOR _"Glow color" "white"
SF-TOGGLE _"Fadeout" FALSE
SF-VALUE _"Fadeout width" "100"
SF-VALUE _"Corona width" "7"
SF-VALUE _"After glow" "50"
SF-TOGGLE _"Add glowing" TRUE
SF-TOGGLE _"Prepare for GIF" FALSE
SF-VALUE _"Speed (pixels/frame)" "50"
)
(script-fu-menu-register "script-fu-burn-in-anim"
"<Image>/Filters/Animation/")

234
plug-ins/script-fu/scripts/carve-it.scm Normal file
View File

@ -0,0 +1,234 @@
; CARVE-IT
; Carving, embossing, & stamping
; Process taken from "The Photoshop 3 WOW! Book"
; http://www.peachpit.com
; This script requires a grayscale image containing a single layer.
; This layer is used as the mask for the carving effect
; NOTE: This script requires the image to be carved to either be an
; RGB color or grayscale image with a single layer. An indexed file
; can not be used due to the use of pika-drawable-histogram and
; pika-drawable-levels.
(define (carve-scale val scale)
(* (sqrt val) scale))
(define (calculate-inset-gamma img layer)
(let* ((stats (pika-drawable-histogram layer 0 0.0 1.0))
(mean (car stats)))
(cond ((< mean 127) (+ 1.0 (* 0.5 (/ (- 127 mean) 127.0))))
((>= mean 127) (- 1.0 (* 0.5 (/ (- mean 127) 127.0)))))))
(define (copy-layer-carve-it dest-image dest-drawable source-image source-drawable)
(pika-selection-all dest-image)
(pika-drawable-edit-clear dest-drawable)
(pika-selection-none dest-image)
(pika-selection-all source-image)
(pika-edit-copy 1 (vector source-drawable))
(let* (
(pasted (pika-edit-paste dest-drawable FALSE))
(num-pasted (car pasted))
(floating-sel (aref (cadr pasted) (- num-pasted 1)))
)
(pika-floating-sel-anchor floating-sel)
)
)
(define (script-fu-carve-it mask-img mask-drawable bg-layer carve-white)
(let* (
(width (car (pika-drawable-get-width mask-drawable)))
(height (car (pika-drawable-get-height mask-drawable)))
(type (car (pika-drawable-type bg-layer)))
(img (car (pika-image-new width height (cond ((= type RGB-IMAGE) RGB)
((= type RGBA-IMAGE) RGB)
((= type GRAY-IMAGE) GRAY)
((= type GRAYA-IMAGE) GRAY)
((= type INDEXED-IMAGE) INDEXED)
((= type INDEXEDA-IMAGE) INDEXED)))))
(size (min width height))
(offx (carve-scale size 0.33))
(offy (carve-scale size 0.25))
(feather (carve-scale size 0.3))
(brush-size (carve-scale size 0.3))
(brush-name (car (pika-brush-new "Carve It")))
(mask (car (pika-channel-new img width height "Engraving Mask" 50 '(0 0 0))))
(inset-gamma (calculate-inset-gamma (car (pika-item-get-image bg-layer)) bg-layer))
(mask-fat 0)
(mask-emboss 0)
(mask-highlight 0)
(mask-shadow 0)
(shadow-layer 0)
(highlight-layer 0)
(cast-shadow-layer 0)
(csl-mask 0)
(inset-layer 0)
(il-mask 0)
(bg-width (car (pika-drawable-get-width bg-layer)))
(bg-height (car (pika-drawable-get-height bg-layer)))
(bg-type (car (pika-drawable-type bg-layer)))
(bg-image (car (pika-item-get-image bg-layer)))
(layer1 (car (pika-layer-new img bg-width bg-height bg-type "Layer1" 100 LAYER-MODE-NORMAL)))
)
(pika-context-push)
(pika-context-set-defaults)
(pika-image-undo-disable img)
(pika-image-insert-layer img layer1 0 0)
(pika-selection-all img)
(pika-drawable-edit-clear layer1)
(pika-selection-none img)
(copy-layer-carve-it img layer1 bg-image bg-layer)
(pika-edit-copy 1 (vector mask-drawable))
(pika-image-insert-channel img mask -1 0)
(plug-in-tile RUN-NONINTERACTIVE img 1 (vector layer1) width height FALSE)
(let* (
(pasted (pika-edit-paste mask FALSE))
(num-pasted (car pasted))
(floating-sel (aref (cadr pasted) (- num-pasted 1)))
)
(pika-floating-sel-anchor floating-sel)
)
(if (= carve-white FALSE)
(pika-drawable-invert mask FALSE))
(set! mask-fat (car (pika-channel-copy mask)))
(pika-image-insert-channel img mask-fat -1 0)
(pika-image-select-item img CHANNEL-OP-REPLACE mask-fat)
(pika-brush-set-shape brush-name BRUSH-GENERATED-CIRCLE)
(pika-brush-set-spikes brush-name 2)
(pika-brush-set-hardness brush-name 1.0)
(pika-brush-set-spacing brush-name 25)
(pika-brush-set-aspect-ratio brush-name 1)
(pika-brush-set-angle brush-name 0)
(cond (<= brush-size 17) (pika-brush-set-radius brush-name (\ brush-size 2))
(else pika-brush-set-radius brush-name (\ 19 2)))
(pika-context-set-brush brush-name)
(pika-context-set-foreground '(255 255 255))
(pika-drawable-edit-stroke-selection mask-fat)
(pika-selection-none img)
(set! mask-emboss (car (pika-channel-copy mask-fat)))
(pika-image-insert-channel img mask-emboss -1 0)
(plug-in-gauss-rle RUN-NONINTERACTIVE img mask-emboss feather TRUE TRUE)
(plug-in-emboss RUN-NONINTERACTIVE img mask-emboss 315.0 45.0 7 TRUE)
(pika-context-set-background '(180 180 180))
(pika-image-select-item img CHANNEL-OP-REPLACE mask-fat)
(pika-selection-invert img)
(pika-drawable-edit-fill mask-emboss FILL-BACKGROUND)
(pika-image-select-item img CHANNEL-OP-REPLACE mask)
(pika-drawable-edit-fill mask-emboss FILL-BACKGROUND)
(pika-selection-none img)
(set! mask-highlight (car (pika-channel-copy mask-emboss)))
(pika-image-insert-channel img mask-highlight -1 0)
(pika-drawable-levels mask-highlight 0
0.7056 1.0 TRUE
1.0
0.0 1.0 TRUE)
(set! mask-shadow mask-emboss)
(pika-drawable-levels mask-shadow 0
0.0 0.70586 TRUE
1.0
0.0 1.0 TRUE)
(pika-edit-copy 1 (vector mask-shadow))
(let* (
(pasted (pika-edit-paste layer1 FALSE))
(num-pasted (car pasted))
(floating-sel (aref (cadr pasted) (- num-pasted 1)))
)
(set! shadow-layer floating-sel)
(pika-floating-sel-to-layer shadow-layer)
)
(pika-layer-set-mode shadow-layer LAYER-MODE-MULTIPLY)
(pika-edit-copy 1 (vector mask-highlight))
(let* (
(pasted (pika-edit-paste shadow-layer FALSE))
(num-pasted (car pasted))
(floating-sel (aref (cadr pasted) (- num-pasted 1)))
)
(set! highlight-layer floating-sel)
(pika-floating-sel-to-layer highlight-layer)
)
(pika-layer-set-mode highlight-layer LAYER-MODE-SCREEN)
(pika-edit-copy 1 (vector mask))
(let* (
(pasted (pika-edit-paste highlight-layer FALSE))
(num-pasted (car pasted))
(floating-sel (aref (cadr pasted) (- num-pasted 1)))
)
(set! cast-shadow-layer floating-sel)
(pika-floating-sel-to-layer cast-shadow-layer)
)
(pika-layer-set-mode cast-shadow-layer LAYER-MODE-MULTIPLY)
(pika-layer-set-opacity cast-shadow-layer 75)
(plug-in-gauss-rle RUN-NONINTERACTIVE img cast-shadow-layer feather TRUE TRUE)
(pika-item-transform-translate cast-shadow-layer offx offy)
(set! csl-mask (car (pika-layer-create-mask cast-shadow-layer ADD-MASK-BLACK)))
(pika-layer-add-mask cast-shadow-layer csl-mask)
(pika-image-select-item img CHANNEL-OP-REPLACE mask)
(pika-context-set-background '(255 255 255))
(pika-drawable-edit-fill csl-mask FILL-BACKGROUND)
(set! inset-layer (car (pika-layer-copy layer1 TRUE)))
(pika-image-insert-layer img inset-layer 0 1)
(set! il-mask (car (pika-layer-create-mask inset-layer ADD-MASK-BLACK)))
(pika-layer-add-mask inset-layer il-mask)
(pika-image-select-item img CHANNEL-OP-REPLACE mask)
(pika-context-set-background '(255 255 255))
(pika-drawable-edit-fill il-mask FILL-BACKGROUND)
(pika-selection-none img)
(pika-selection-none bg-image)
(pika-drawable-levels inset-layer 0 0.0 1.0 TRUE inset-gamma 0.0 1.0 TRUE)
(pika-image-remove-channel img mask)
(pika-image-remove-channel img mask-fat)
(pika-image-remove-channel img mask-highlight)
(pika-image-remove-channel img mask-shadow)
(pika-item-set-name layer1 _"Carved Surface")
(pika-item-set-name shadow-layer _"Bevel Shadow")
(pika-item-set-name highlight-layer _"Bevel Highlight")
(pika-item-set-name cast-shadow-layer _"Cast Shadow")
(pika-item-set-name inset-layer _"Inset")
(pika-brush-delete brush-name)
(pika-display-new img)
(pika-image-undo-enable img)
(pika-context-pop)
)
)
(script-fu-register "script-fu-carve-it"
_"Stencil C_arve..."
_"Use the specified drawable as a stencil to carve from the specified image."
"Spencer Kimball"
"Spencer Kimball"
"1997"
"GRAY"
SF-IMAGE "Mask image" 0
SF-DRAWABLE "Mask drawable" 0
SF-DRAWABLE _"Image to carve" 0
SF-TOGGLE _"Carve white areas" TRUE
)
(script-fu-menu-register "script-fu-carve-it"
"<Image>/Filters/Decor")

261
plug-ins/script-fu/scripts/chrome-it.scm Normal file
View File

@ -0,0 +1,261 @@
; CHROME-IT
; State of the art chrome effect for user-specified mask
; This script requires a grayscale image containing a single layer.
; This layer is used as the mask for the SOTA chrome effect
(define (script-fu-sota-chrome-it mask-img mask-drawable chrome-saturation
chrome-lightness chrome-factor env-map hc cc carve-white)
(define (set-pt a index x y)
(begin
(aset a (* index 2) x)
(aset a (+ (* index 2) 1) y)
)
)
(define (spline-chrome-it)
(let* ((a (cons-array 18 'double)))
(set-pt a 0 0.0 0.0)
(set-pt a 1 0.125 0.9216)
(set-pt a 2 0.25 0.0902)
(set-pt a 3 0.375 0.9020)
(set-pt a 4 0.5 0.0989)
(set-pt a 5 0.625 0.9549)
(set-pt a 6 0.75 00784)
(set-pt a 7 0.875 0.9412)
(set-pt a 8 1.0 0.1216)
a
)
)
(define (shadows val)
(/ (* 0.96 val) 2.55)
)
(define (midtones val)
(/ val 2.55)
)
(define (highlights val)
; The result is used as "pika-drawable-color-balance" color parameter
; and thus must be restricted to -100.0 <= highlights <= 100.0.
(min (/ (* 1.108 val) 2.55) 100.0)
)
(define (rval col)
(car col)
)
(define (gval col)
(cadr col)
)
(define (bval col)
(caddr col)
)
(define (sota-scale val scale chrome-factor)
(* (sqrt val) (* scale chrome-factor))
)
(define (copy-layer-chrome-it dest-image dest-drawable source-image source-drawable)
(pika-selection-all dest-image)
(pika-drawable-edit-clear dest-drawable)
(pika-selection-none dest-image)
(pika-selection-all source-image)
(pika-edit-copy 1 (vector source-drawable))
(let* (
(pasted (pika-edit-paste dest-drawable FALSE))
(num-pasted (car pasted))
(floating-sel (aref (cadr pasted) (- num-pasted 1)))
)
(pika-floating-sel-anchor floating-sel)
)
)
(let* (
(banding-img (car (pika-file-load RUN-NONINTERACTIVE env-map)))
(banding-layer (aref (cadr (pika-image-get-selected-drawables banding-img)) 0))
(banding-height (car (pika-drawable-get-height banding-layer)))
(banding-width (car (pika-drawable-get-width banding-layer)))
(banding-type (car (pika-drawable-type banding-layer)))
(width (car (pika-drawable-get-width mask-drawable)))
(height (car (pika-drawable-get-height mask-drawable)))
(img (car (pika-image-new width height GRAY)))
(size (min width height))
(offx1 (sota-scale size 0.33 chrome-factor))
(offy1 (sota-scale size 0.25 chrome-factor))
(offx2 (sota-scale size (- 0.33) chrome-factor))
(offy2 (sota-scale size (- 0.25) chrome-factor))
(feather (sota-scale size 0.5 chrome-factor))
(brush-size (sota-scale size 0.5 chrome-factor))
(brush-name (car (pika-brush-new "Chrome It")))
(mask (car (pika-channel-new img width height "Chrome Stencil" 50 '(0 0 0))))
(bg-layer (car (pika-layer-new img width height GRAY-IMAGE _"Background" 100 LAYER-MODE-NORMAL)))
(layer1 (car (pika-layer-new img banding-width banding-height banding-type _"Layer 1" 100 LAYER-MODE-NORMAL)))
(layer2 (car (pika-layer-new img width height GRAYA-IMAGE _"Layer 2" 100 LAYER-MODE-DIFFERENCE)))
(layer3 (car (pika-layer-new img width height GRAYA-IMAGE _"Layer 3" 100 LAYER-MODE-NORMAL)))
(shadow (car (pika-layer-new img width height GRAYA-IMAGE _"Drop Shadow" 100 LAYER-MODE-NORMAL)))
(layer-mask 0)
)
(pika-context-push)
(pika-context-set-defaults)
(pika-image-undo-disable img)
(pika-image-insert-channel img mask -1 0)
(pika-image-insert-layer img bg-layer 0 0)
(pika-image-insert-layer img shadow 0 0)
(pika-image-insert-layer img layer3 0 0)
(pika-image-insert-layer img layer2 0 0)
(pika-edit-copy 1 (vector mask-drawable))
; Clipboard is copy of mask-drawable. Paste into mask, a channel, and anchor it.
(let* (
(pasted (pika-edit-paste mask FALSE))
(num-pasted (car pasted))
(floating-sel (aref (cadr pasted) (- num-pasted 1)))
)
(pika-floating-sel-anchor floating-sel)
)
(if (= carve-white FALSE)
(pika-drawable-invert mask FALSE)
)
(pika-context-set-background '(255 255 255))
(pika-selection-none img)
(pika-drawable-edit-fill layer2 FILL-BACKGROUND)
(pika-drawable-edit-fill layer3 FILL-BACKGROUND)
(pika-drawable-edit-clear shadow)
(pika-item-set-visible bg-layer FALSE)
(pika-item-set-visible shadow FALSE)
(pika-image-select-item img CHANNEL-OP-REPLACE mask)
(pika-context-set-background '(0 0 0))
(pika-selection-translate img offx1 offy1)
(pika-selection-feather img feather)
(pika-drawable-edit-fill layer2 FILL-BACKGROUND)
(pika-selection-translate img (* 2 offx2) (* 2 offy2))
(pika-drawable-edit-fill layer3 FILL-BACKGROUND)
(pika-selection-none img)
(set! layer2 (car (pika-image-merge-visible-layers img CLIP-TO-IMAGE)))
(pika-drawable-invert layer2 FALSE)
(pika-image-insert-layer img layer1 0 0)
(copy-layer-chrome-it img layer1 banding-img banding-layer)
(pika-image-delete banding-img)
(pika-layer-scale layer1 width height FALSE)
(plug-in-gauss-iir RUN-NONINTERACTIVE img layer1 10 TRUE TRUE)
(pika-layer-set-opacity layer1 50)
(set! layer1 (car (pika-image-merge-visible-layers img CLIP-TO-IMAGE)))
(pika-drawable-curves-spline layer1 HISTOGRAM-VALUE 18 (spline-chrome-it))
(set! layer-mask (car (pika-layer-create-mask layer1 ADD-MASK-BLACK)))
(pika-layer-add-mask layer1 layer-mask)
(pika-image-select-item img CHANNEL-OP-REPLACE mask)
(pika-context-set-background '(255 255 255))
(pika-drawable-edit-fill layer-mask FILL-BACKGROUND)
(set! layer2 (car (pika-layer-copy layer1 TRUE)))
(pika-image-insert-layer img layer2 0 0)
(pika-brush-set-shape brush-name BRUSH-GENERATED-CIRCLE)
(pika-brush-set-spikes brush-name 2)
(pika-brush-set-hardness brush-name 1.0)
(pika-brush-set-spacing brush-name 25)
(pika-brush-set-aspect-ratio brush-name 1)
(pika-brush-set-angle brush-name 0)
(cond (<= brush-size 17) (pika-brush-set-radius brush-name (\ brush-size 2))
(else pika-brush-set-radius brush-name (\ 19 2)))
(pika-context-set-brush brush-name)
(pika-context-set-foreground '(255 255 255))
(pika-drawable-edit-stroke-selection layer-mask)
(pika-context-set-background '(0 0 0))
(pika-selection-feather img (* feather 1.5))
(pika-selection-translate img (* 2.5 offx1) (* 2.5 offy1))
(pika-drawable-edit-fill shadow FILL-BACKGROUND)
(pika-selection-all img)
(pika-context-set-pattern "Marble #1")
(pika-drawable-edit-fill bg-layer FILL-PATTERN)
(pika-selection-none img)
(pika-image-convert-rgb img)
(pika-drawable-color-balance layer1 TRANSFER-SHADOWS TRUE
(shadows (rval hc))
(shadows (gval hc))
(shadows (bval hc)))
(pika-drawable-color-balance layer1 TRANSFER-MIDTONES TRUE
(midtones (rval hc))
(midtones (gval hc))
(midtones (bval hc)))
(pika-drawable-color-balance layer1 TRANSFER-HIGHLIGHTS TRUE
(highlights (rval hc))
(highlights (gval hc))
(highlights (bval hc)))
(pika-drawable-color-balance layer2 TRANSFER-SHADOWS TRUE
(shadows (rval cc))
(shadows (gval cc))
(shadows (bval cc)))
(pika-drawable-color-balance layer2 TRANSFER-MIDTONES TRUE
(midtones (rval cc))
(midtones (gval cc))
(midtones (bval cc)))
(pika-drawable-color-balance layer2 TRANSFER-HIGHLIGHTS TRUE
(highlights (rval cc))
(highlights (gval cc))
(highlights (bval cc)))
(pika-drawable-hue-saturation layer2 HUE-RANGE-ALL
0.0
chrome-lightness
chrome-saturation
0.0)
(pika-item-set-visible shadow TRUE)
(pika-item-set-visible bg-layer TRUE)
(pika-item-set-name layer2 _"Chrome")
(pika-item-set-name layer1 _"Highlight")
(pika-image-remove-channel img mask)
(pika-brush-delete brush-name)
(pika-display-new img)
(pika-image-undo-enable img)
(pika-context-pop)
)
)
(script-fu-register "script-fu-sota-chrome-it"
_"Stencil C_hrome..."
_"Add a chrome effect to the selected region (or alpha) using a specified (grayscale) stencil"
"Spencer Kimball"
"Spencer Kimball"
"1997"
"GRAY"
SF-IMAGE "Chrome image" 0
SF-DRAWABLE "Chrome mask" 0
SF-ADJUSTMENT _"Chrome saturation" '(-80 -100 100 1 10 0 0)
SF-ADJUSTMENT _"Chrome lightness" '(-47 -100 100 1 10 0 0)
SF-ADJUSTMENT _"Chrome factor" '(0.75 0 1 0.1 0.2 2 0)
SF-FILENAME _"Environment map"
(string-append pika-data-directory
"/scripts/images/beavis.jpg")
SF-COLOR _"Highlight balance" '(211 95 0)
SF-COLOR _"Chrome balance" "black"
SF-TOGGLE _"Chrome white areas" TRUE
)
(script-fu-menu-register "script-fu-sota-chrome-it"
"<Image>/Filters/Decor")

147
plug-ins/script-fu/scripts/circuit.scm Normal file
View File

@ -0,0 +1,147 @@
; PIKA - Photo and Image Kooker Application
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
;
; Circuit board effect
; Copyright (c) 1997 Adrian Likins
;
; Generates what looks a little like the back of an old circuit board.
; Looks even better when gradient-mapp'ed with a suitable gradient.
;
; 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/>.
(define (script-fu-circuit image
drawable
mask-size
seed
remove-bg
keep-selection
separate-layer)
(let* (
(type (car (pika-drawable-type-with-alpha drawable)))
(image-width (car (pika-image-get-width image)))
(image-height (car (pika-image-get-height image)))
(active-selection 0)
(from-selection 0)
(selection-bounds 0)
(select-offset-x 0)
(select-offset-y 0)
(select-width 0)
(select-height 0)
(effect-layer 0)
(active-layer 0)
)
(pika-context-push)
(pika-context-set-defaults)
(pika-image-undo-group-start image)
(pika-layer-add-alpha drawable)
(if (= (car (pika-selection-is-empty image)) TRUE)
(begin
(pika-image-select-item image CHANNEL-OP-REPLACE drawable)
(set! active-selection (car (pika-selection-save image)))
(set! from-selection FALSE))
(begin
(set! from-selection TRUE)
(set! active-selection (car (pika-selection-save image)))))
(set! selection-bounds (pika-selection-bounds image))
(set! select-offset-x (cadr selection-bounds))
(set! select-offset-y (caddr selection-bounds))
(set! select-width (- (cadr (cddr selection-bounds)) select-offset-x))
(set! select-height (- (caddr (cddr selection-bounds)) select-offset-y))
(if (= separate-layer TRUE)
(begin
(set! effect-layer (car (pika-layer-new image
select-width
select-height
type
_"Effect layer"
100
LAYER-MODE-NORMAL)))
(pika-image-insert-layer image effect-layer 0 -1)
(pika-layer-set-offsets effect-layer select-offset-x select-offset-y)
(pika-selection-none image)
(pika-drawable-edit-clear effect-layer)
(pika-image-select-item image CHANNEL-OP-REPLACE active-selection)
(pika-edit-copy 1 (vector drawable))
(let* (
(pasted (pika-edit-paste effect-layer FALSE))
(num-pasted (car pasted))
(floating-sel (aref (cadr pasted) (- num-pasted 1)))
)
(pika-floating-sel-anchor floating-sel)
)
(pika-image-set-selected-layers image 1 (vector effect-layer)))
(set! effect-layer drawable)
)
(set! active-layer effect-layer)
(if (= remove-bg TRUE)
(pika-context-set-foreground '(0 0 0))
(pika-context-set-foreground '(14 14 14))
)
(pika-image-select-item image CHANNEL-OP-REPLACE active-selection)
(plug-in-maze RUN-NONINTERACTIVE image active-layer 5 5 TRUE 0 seed 57 1)
(plug-in-oilify RUN-NONINTERACTIVE image active-layer mask-size 0)
(plug-in-edge RUN-NONINTERACTIVE image active-layer 2 1 0)
(if (= type RGBA-IMAGE)
(pika-drawable-desaturate active-layer DESATURATE-LIGHTNESS))
(if (and
(= remove-bg TRUE)
(= separate-layer TRUE))
(begin
(pika-image-select-color image CHANNEL-OP-REPLACE active-layer '(0 0 0))
(pika-drawable-edit-clear active-layer)))
(if (= keep-selection FALSE)
(pika-selection-none image))
(pika-image-remove-channel image active-selection)
(pika-image-set-selected-layers image 1 (vector drawable))
(pika-image-undo-group-end image)
(pika-displays-flush)
(pika-context-pop)
)
)
(script-fu-register "script-fu-circuit"
_"_Circuit..."
_"Fill the selected region (or alpha) with traces like those on a circuit board"
"Adrian Likins <adrian@gimp.org>"
"Adrian Likins"
"10/17/97"
"RGB* GRAY*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-ADJUSTMENT _"Oilify mask size" '(17 3 50 1 10 0 1)
SF-ADJUSTMENT _"Circuit seed" '(3 1 3000000 1 10 0 1)
SF-TOGGLE _"No background (only for separate layer)" FALSE
SF-TOGGLE _"Keep selection" TRUE
SF-TOGGLE _"Separate layer" TRUE
)
(script-fu-menu-register "script-fu-circuit"
"<Image>/Filters/Render")

84
plug-ins/script-fu/scripts/clothify-v3.scm Normal file
View File

@ -0,0 +1,84 @@
; CLOTHIFY version 1.02
; Gives the current layer in the indicated image a cloth-like texture.
; Process invented by Zach Beane (Xath@irc.pika.net)
;
; Tim Newsome <drz@froody.bloke.com> 4/11/97
; v3>>> Adapted to take many drawables, but only handle the first
; v3>>> drawables is-a vector, and there is no formal arg for its length i.e. n_drawables
(define (script-fu-clothify-v3 timg drawables bx by azimuth elevation depth)
(let* (
(tdrawable (aref drawables 0)) v3>>> only the first drawable
(width (car (pika-drawable-get-width tdrawable)))
(height (car (pika-drawable-get-height tdrawable)))
(img (car (pika-image-new width height RGB)))
; (layer-two (car (pika-layer-new img width height RGB-IMAGE "Y Dots" 100 LAYER-MODE-MULTIPLY)))
(layer-one (car (pika-layer-new img width height RGB-IMAGE "X Dots" 100 LAYER-MODE-NORMAL)))
(layer-two 0)
(bump-layer 0)
)
(pika-context-push)
(pika-context-set-defaults)
(pika-image-undo-disable img)
(pika-image-insert-layer img layer-one 0 0)
(pika-context-set-background '(255 255 255))
(pika-drawable-edit-fill layer-one FILL-BACKGROUND)
(plug-in-noisify RUN-NONINTERACTIVE img layer-one FALSE 0.7 0.7 0.7 0.7)
(set! layer-two (car (pika-layer-copy layer-one 0)))
(pika-layer-set-mode layer-two LAYER-MODE-MULTIPLY)
(pika-image-insert-layer img layer-two 0 0)
(plug-in-gauss-rle RUN-NONINTERACTIVE img layer-one bx TRUE FALSE)
(plug-in-gauss-rle RUN-NONINTERACTIVE img layer-two by FALSE TRUE)
(pika-image-flatten img)
(set! bump-layer (car (pika-image-get-active-layer img)))
(plug-in-c-astretch RUN-NONINTERACTIVE img bump-layer)
(plug-in-noisify RUN-NONINTERACTIVE img bump-layer FALSE 0.2 0.2 0.2 0.2)
(plug-in-bump-map RUN-NONINTERACTIVE img tdrawable bump-layer azimuth elevation depth 0 0 0 0 FALSE FALSE 0)
(pika-image-delete img)
(pika-displays-flush)
(pika-context-pop)
; well-behaved requires error if more than one drawable
( if (> (vector-length drawables) 1 )
(begin
; Msg to status bar, need not be acknowledged by any user
(pika-message "Received more than one drawable.")
; Msg propagated in a GError to Pika's error dialog that must be acknowledged
(write "Received more than one drawable.")
; Indicate err to programmed callers
#f)
#t
)
)
)
; v3 >>> no image or drawable declared.
; v3 >>> SF-ONE-DRAWABLE means contracts to process only one drawable
(script-fu-register-filter "script-fu-clothify-v3"
_"_Clothify v3..."
_"Add a cloth-like texture to the selected region (or alpha)"
"Tim Newsome <drz@froody.bloke.com>"
"Tim Newsome"
"4/11/97"
"RGB* GRAY*"
SF-ONE-DRAWABLE
SF-ADJUSTMENT _"Blur X" '(9 3 100 1 10 0 1)
SF-ADJUSTMENT _"Blur Y" '(9 3 100 1 10 0 1)
SF-ADJUSTMENT _"Azimuth" '(135 0 360 1 10 1 0)
SF-ADJUSTMENT _"Elevation" '(45 0 90 1 10 1 0)
SF-ADJUSTMENT _"Depth" '(3 1 50 1 10 0 1)
)
(script-fu-menu-register "script-fu-clothify-v3"
"<Image>/Filters/Artistic")

68
plug-ins/script-fu/scripts/clothify.scm Normal file
View File

@ -0,0 +1,68 @@
; CLOTHIFY version 1.02
; Gives the current layer in the indicated image a cloth-like texture.
; Process invented by Zach Beane (Xath@irc.pika.net)
;
; Tim Newsome <drz@froody.bloke.com> 4/11/97
(define (script-fu-clothify timg tdrawable bx by azimuth elevation depth)
(let* (
(width (car (pika-drawable-get-width tdrawable)))
(height (car (pika-drawable-get-height tdrawable)))
(img (car (pika-image-new width height RGB)))
; (layer-two (car (pika-layer-new img width height RGB-IMAGE "Y Dots" 100 LAYER-MODE-MULTIPLY)))
(layer-one (car (pika-layer-new img width height RGB-IMAGE "X Dots" 100 LAYER-MODE-NORMAL)))
(layer-two 0)
(bump-layer 0)
)
(pika-context-push)
(pika-context-set-defaults)
(pika-image-undo-disable img)
(pika-image-insert-layer img layer-one 0 0)
(pika-context-set-background '(255 255 255))
(pika-drawable-edit-fill layer-one FILL-BACKGROUND)
(plug-in-noisify RUN-NONINTERACTIVE img layer-one FALSE 0.7 0.7 0.7 0.7)
(set! layer-two (car (pika-layer-copy layer-one 0)))
(pika-layer-set-mode layer-two LAYER-MODE-MULTIPLY)
(pika-image-insert-layer img layer-two 0 0)
(plug-in-gauss-rle RUN-NONINTERACTIVE img layer-one bx TRUE FALSE)
(plug-in-gauss-rle RUN-NONINTERACTIVE img layer-two by FALSE TRUE)
(pika-image-flatten img)
(set! bump-layer (aref (cadr (pika-image-get-selected-layers img)) 0))
(plug-in-c-astretch RUN-NONINTERACTIVE img bump-layer)
(plug-in-noisify RUN-NONINTERACTIVE img bump-layer FALSE 0.2 0.2 0.2 0.2)
(plug-in-bump-map RUN-NONINTERACTIVE img tdrawable bump-layer azimuth elevation depth 0 0 0 0 FALSE FALSE 0)
(pika-image-delete img)
(pika-displays-flush)
(pika-context-pop)
)
)
(script-fu-register "script-fu-clothify"
_"_Clothify..."
_"Add a cloth-like texture to the selected region (or alpha)"
"Tim Newsome <drz@froody.bloke.com>"
"Tim Newsome"
"4/11/97"
"RGB* GRAY*"
SF-IMAGE "Input image" 0
SF-DRAWABLE "Input drawable" 0
SF-ADJUSTMENT _"Blur X" '(9 3 100 1 10 0 1)
SF-ADJUSTMENT _"Blur Y" '(9 3 100 1 10 0 1)
SF-ADJUSTMENT _"Azimuth" '(135 0 360 1 10 1 0)
SF-ADJUSTMENT _"Elevation" '(45 0 90 1 10 1 0)
SF-ADJUSTMENT _"Depth" '(3 1 50 1 10 0 1)
)
(script-fu-menu-register "script-fu-clothify"
"<Image>/Filters/Artistic")

94
plug-ins/script-fu/scripts/coffee.scm Normal file
View File

@ -0,0 +1,94 @@
; Chris Gutteridge (cjg@ecs.soton.ac.uk)
; At ECS Dept, University of Southampton, England.
; 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/>.
(define (script-fu-coffee-stain inImage inLayer inNumber inDark)
(let* (
(theImage inImage)
(theHeight (car (pika-image-get-height theImage)))
(theWidth (car (pika-image-get-width theImage)))
(theNumber inNumber)
(theSize (min theWidth theHeight))
(theStain 0)
)
(pika-context-push)
(pika-context-set-defaults)
(pika-image-undo-group-start theImage)
(while (> theNumber 0)
(set! theNumber (- theNumber 1))
(set! theStain (car (pika-layer-new theImage theSize theSize
RGBA-IMAGE _"Stain" 100
(if (= inDark TRUE)
LAYER-MODE-DARKEN-ONLY LAYER-MODE-NORMAL))))
(pika-image-insert-layer theImage theStain 0 0)
(pika-selection-all theImage)
(pika-drawable-edit-clear theStain)
(let ((blobSize (/ (rand (- theSize 40)) (+ (rand 3) 1))))
(pika-image-select-ellipse theImage
CHANNEL-OP-REPLACE
(/ (- theSize blobSize) 2)
(/ (- theSize blobSize) 2)
blobSize blobSize)
)
(script-fu-distress-selection theImage theStain
(- (* (+ (rand 15) 1) (+ (rand 15) 1)) 1)
(/ theSize 25) 4 2 TRUE TRUE)
(pika-context-set-gradient "Coffee")
(pika-drawable-edit-gradient-fill theStain
GRADIENT-SHAPEBURST-DIMPLED 0
FALSE 0 0
TRUE
0 0 0 0)
(pika-layer-set-offsets theStain
(- (rand theWidth) (/ theSize 2))
(- (rand theHeight) (/ theSize 2)))
)
(pika-selection-none theImage)
(pika-image-undo-group-end theImage)
(pika-displays-flush)
(pika-context-pop)
)
)
; Register the function with PIKA:
(script-fu-register "script-fu-coffee-stain"
_"_Coffee Stain..."
_"Add realistic looking coffee stains to the image"
"Chris Gutteridge"
"1998, Chris Gutteridge / ECS dept, University of Southampton, England."
"25th April 1998"
"RGB*"
SF-IMAGE "The image" 0
SF-DRAWABLE "The layer" 0
SF-ADJUSTMENT _"Stains" '(3 1 10 1 2 0 0)
SF-TOGGLE _"Darken only" TRUE
)
(script-fu-menu-register "script-fu-coffee-stain" "<Image>/Filters/Decor")

336
plug-ins/script-fu/scripts/contactsheet.scm Normal file
View File

@ -0,0 +1,336 @@
; "Contact Sheet" v1.2 September 5, 2007
; by Kevin Cozens <kcozens@interlog.com>
;
; PIKA - Photo and Image Kooker Application
; 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/>.
;
; Version 1.0 (July 27, 2004)
; Created
;
; Version 1.1 (September 2, 2004)
; Added ability to select sheet size, set font used for sheet and image
;
; Version 1.2 (September 5, 2007)
; Preserve aspect ratio of original image. Center thumbnail in the area
; allowed for the thumbnail. Added disable/enable of undo operations.
; Added 1600x1200 sheet size.
(define (script-fu-contactsheet dir sheet-size
title-font legend-font text-color bg-color)
(define (init-sheet-data size)
(let (
(sheet-w 0)
(sheet-h 0)
(thumb-w 0)
(thumb-h 0)
(border-x 0) ;Space between rows and at top and bottom of thumbnails
(border-y 0) ;Space between columns and at left and right of thumbnails
(off-x 0) ; Additional X shift to properly center a row of thumbnails
(off-y 0) ; Additional Y shift to properly center rows of thumbnails
(count 0)
)
(case size
((0) (set! sheet-w 640)
(set! sheet-h 480)
(set! thumb-w 90)
(set! thumb-h 68)
(set! border-x 32)
(set! border-y 23)
(set! off-x -1)
(set! off-y 0)
(set! count 4)
)
((1) (set! sheet-w 800)
(set! sheet-h 600)
(set! thumb-w 119)
(set! thumb-h 90)
(set! border-x 34)
(set! border-y 25)
(set! off-x 0)
(set! off-y 0)
(set! count 4)
)
((2) (set! sheet-w 1024)
(set! sheet-h 768)
(set! thumb-w 133)
(set! thumb-h 100)
(set! border-x 32)
(set! border-y 24)
(set! off-x 1)
(set! off-y 0)
(set! count 5)
)
((3) (set! sheet-w 1280)
(set! sheet-h 1024)
(set! thumb-w 133)
(set! thumb-h 100)
(set! border-x 24)
(set! border-y 25)
(set! off-x 0)
(set! off-y 0)
(set! count 7)
)
((4) (set! sheet-w 1600)
(set! sheet-h 1200)
(set! thumb-w 120)
(set! thumb-h 90)
(set! border-x 36)
(set! border-y 25)
(set! off-x 2)
(set! off-y 0)
(set! count 9)
)
)
(list sheet-w sheet-h thumb-w thumb-h border-x border-y off-x off-y count)
)
)
(define (init-sheet-img img num img-width border-y off-y)
(let* (
(text-layer 0)
(text-width 0)
(text-height 0)
)
(pika-selection-all img)
(pika-drawable-fill (aref (cadr (pika-image-get-selected-layers img)) 0)
FILL-BACKGROUND)
(pika-selection-none img)
(set! text-layer (car (pika-text-fontname img -1 0 0
(string-append _"Contact Sheet "
(number->string num)
_" for directory " dir)
0 TRUE 14 PIXELS title-font)))
(set! text-width (car (pika-drawable-get-width text-layer)))
(set! text-height (car (pika-drawable-get-height text-layer)))
(pika-layer-set-offsets text-layer
(/ (- img-width text-width) 2)
(/ (- (+ border-y off-y) text-height) 2)
)
(pika-image-merge-visible-layers img CLIP-TO-IMAGE)
)
)
(define (make-thumbnail-size img thumb-w thumb-h)
(let* (
(file-height (car (pika-image-get-height img)))
(file-width (car (pika-image-get-width img)))
(aspect-ratio (/ file-width file-height))
)
;Preserve the aspect ratio of the original image
(if (> file-width file-height)
(set! thumb-h (/ thumb-w aspect-ratio))
(set! thumb-w (* thumb-h aspect-ratio))
)
(pika-image-scale img thumb-w thumb-h)
)
)
(let* (
(dir-stream (dir-open-stream dir))
(sheet-num 1)
(img-count 0)
(pos-x 0)
(pos-y 0)
(sheet-data 0)
(sheet-width 0)
(sheet-height 0)
(thumb-w 0)
(thumb-h 0)
(border-x 0)
(border-y 0)
(off-x 0)
(off-y 0)
(max-x 0)
(max-y 0)
(sheet-img 0)
(sheet-layer 0)
(new-img 0)
(file 0)
(file-path 0)
(tmp-layer 0)
)
(pika-context-push)
(pika-context-set-defaults)
(pika-context-set-foreground text-color)
(pika-context-set-background bg-color)
(set! sheet-data (init-sheet-data sheet-size))
(set! sheet-width (car sheet-data))
(set! sheet-height (cadr sheet-data))
(set! sheet-data (cddr sheet-data))
(set! thumb-w (car sheet-data))
(set! thumb-h (cadr sheet-data))
(set! sheet-data (cddr sheet-data))
(set! border-x (car sheet-data))
(set! border-y (cadr sheet-data))
(set! sheet-data (cddr sheet-data))
(set! off-x (car sheet-data))
(set! off-y (cadr sheet-data))
(set! max-x (caddr sheet-data))
(set! max-y max-x)
(set! sheet-img (car (pika-image-new sheet-width sheet-height RGB)))
(pika-image-undo-disable sheet-img)
(set! sheet-layer (car (pika-layer-new sheet-img sheet-width sheet-height
RGB-IMAGE "Background"
100 LAYER-MODE-NORMAL)))
(pika-image-insert-layer sheet-img sheet-layer 0 0)
(init-sheet-img sheet-img sheet-num sheet-width border-y off-y)
(if (not dir-stream)
(pika-message (string-append _"Unable to open directory " dir))
(begin
(do
( (file (dir-read-entry dir-stream) (dir-read-entry dir-stream)) )
( (eof-object? file) )
(set! file-path (string-append dir DIR-SEPARATOR file))
; file-path is a full path, file is filename
(if (and (not (re-match "index.*" file))
(= (file-type file-path) FILE-TYPE-FILE)
)
(catch ()
(set! new-img
(car (pika-file-load RUN-NONINTERACTIVE file-path)))
(make-thumbnail-size new-img thumb-w thumb-h)
(if (> (car (pika-image-get-layers new-img)) 1)
(pika-image-flatten new-img)
)
(set! tmp-layer
(car (pika-layer-new-from-drawable
(aref (cadr (pika-image-get-selected-drawables new-img)) 0)
sheet-img)))
(pika-image-insert-layer sheet-img tmp-layer 0 0)
;Move thumbnail in to position and center it in area available.
(pika-layer-set-offsets tmp-layer
(+ border-x off-x (* pos-x (+ thumb-w border-x))
(/ (- thumb-w (car (pika-image-get-width new-img))) 2)
)
(+ border-y off-y (* pos-y (+ thumb-h border-y))
(/ (- thumb-h (car (pika-image-get-height new-img))) 2)
)
)
(pika-image-delete new-img)
(set! tmp-layer (car (pika-text-fontname sheet-img -1 0 0 file
0 TRUE 12 PIXELS legend-font)))
(pika-layer-set-offsets tmp-layer
(+ border-x off-x (* pos-x (+ thumb-w border-x))
(/ (- thumb-w (car (pika-drawable-get-width tmp-layer))) 2))
(+ border-y off-y (* pos-y (+ thumb-h border-y)) thumb-h 6)
)
(set! img-count (+ img-count 1))
(set! pos-x (+ pos-x 1))
(if (> pos-x max-x)
(begin
(set! pos-x 0)
(set! pos-y (+ pos-y 1))
(if (> pos-y max-y)
(begin
(set! pos-y 0)
(set! sheet-layer (car (pika-image-flatten sheet-img)))
(pika-file-save
RUN-NONINTERACTIVE
sheet-img
1 (vector sheet-layer)
(string-append dir DIR-SEPARATOR
"index" (number->string sheet-num) ".jpg")
)
(set! sheet-num (+ sheet-num 1))
(init-sheet-img sheet-img sheet-num sheet-width
border-y off-y)
(set! img-count 0)
)
)
)
)
)
)
)
(dir-close-stream dir-stream)
(if (> img-count 0)
(begin
(set! sheet-layer (car (pika-image-flatten sheet-img)))
(pika-file-save
RUN-NONINTERACTIVE
sheet-img
1 (vector sheet-layer)
(string-append dir DIR-SEPARATOR
"index" (number->string sheet-num) ".jpg")
)
)
)
)
(pika-image-undo-enable sheet-img)
(pika-image-delete sheet-img)
(display (string-append _"Created " (number->string sheet-num)
_" contact sheets from a total of "
(number->string img-count) _" images"))
(newline)
)
(pika-context-pop)
)
)
(script-fu-register "script-fu-contactsheet"
_"_Contact Sheet..."
_"Create a series of images containing thumbnail sized versions of all of the images in a specified directory."
"Kevin Cozens <kcozens@interlog.com>"
"Kevin Cozens"
"July 19, 2004"
""
SF-DIRNAME _"Images Directory" "/tmp/test"
SF-OPTION _"Sheet size" '("640 x 480"
"800 x 600"
"1024 x 768"
"1280 x 1024"
"1600 x 1200")
SF-FONT _"Title font" "Sans Bold Italic"
SF-FONT _"Legend font" "Sans Bold"
SF-COLOR _"Text color" "white"
SF-COLOR _"Background color" "black"
)
(script-fu-menu-register "script-fu-contactsheet" "<Image>/Filters/Combine")

80
plug-ins/script-fu/scripts/difference-clouds.scm Normal file
View File

@ -0,0 +1,80 @@
; Plugin for the Photo and Image Kooker Application
; Copyright (C) 2006 Martin Nordholts
;
; 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/>.
;
; Renders Difference Clouds onto a layer, i.e. solid noise merged down with the
; Difference Mode
;
(define (script-fu-difference-clouds image
drawable)
(let* ((draw-offset-x (car (pika-drawable-get-offsets drawable)))
(draw-offset-y (cadr (pika-drawable-get-offsets drawable)))
(has-sel (car (pika-drawable-mask-intersect drawable)))
(sel-offset-x (cadr (pika-drawable-mask-intersect drawable)))
(sel-offset-y (caddr (pika-drawable-mask-intersect drawable)))
(width (cadddr (pika-drawable-mask-intersect drawable)))
(height (caddr (cddr (pika-drawable-mask-intersect drawable))))
(type (car (pika-drawable-type-with-alpha drawable)))
(diff-clouds -1)
(offset-x 0)
(offset-y 0)
)
(pika-image-undo-group-start image)
; Create the cloud layer
(set! diff-clouds (car (pika-layer-new image width height type
"Clouds" 100 LAYER-MODE-DIFFERENCE)))
; Add the cloud layer above the current layer
(pika-image-insert-layer image diff-clouds 0 -1)
; Clear the layer (so there are no noise in it)
(pika-drawable-fill diff-clouds FILL-TRANSPARENT)
; Selections are relative to the drawable; adjust the final offset
(set! offset-x (+ draw-offset-x sel-offset-x))
(set! offset-y (+ draw-offset-y sel-offset-y))
; Offset the clouds layer
(if (pika-item-is-layer drawable)
(pika-item-transform-translate diff-clouds offset-x offset-y))
; Show the solid noise dialog
(plug-in-solid-noise SF-RUN-MODE image diff-clouds 0 0 0 1 4.0 4.0)
; Merge the clouds layer with the layer below
(pika-image-merge-down image diff-clouds EXPAND-AS-NECESSARY)
(pika-image-undo-group-end image)
(pika-displays-flush)
)
)
(script-fu-register "script-fu-difference-clouds"
_"_Difference Clouds..."
_"Solid noise applied with Difference layer mode"
"Martin Nordholts <enselic@hotmail.com>"
"Martin Nordholts"
"2006/10/25"
"RGB* GRAY*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0)
(script-fu-menu-register "script-fu-difference-clouds"
"<Image>/Filters/Render/Noise")

122
plug-ins/script-fu/scripts/distress-selection.scm Normal file
View File

@ -0,0 +1,122 @@
;
; distress selection
;
;
; Chris Gutteridge (cjg@ecs.soton.ac.uk)
; At ECS Dept, University of Southampton, England.
; 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/>.
; Define the function:
(define (script-fu-distress-selection inImage
inDrawable
inThreshold
inSpread
inGranu
inSmooth
inSmoothH
inSmoothV)
(let (
(theImage inImage)
(theWidth (car (pika-image-get-width inImage)))
(theHeight (car (pika-image-get-height inImage)))
(theLayer 0)
(theMode (car (pika-image-get-base-type inImage)))
(prevLayers (pika-image-get-selected-layers inImage))
)
(pika-context-push)
(pika-context-set-defaults)
(pika-image-undo-group-start theImage)
(if (= theMode GRAY)
(set! theMode GRAYA-IMAGE)
(set! theMode RGBA-IMAGE)
)
(set! theLayer (car (pika-layer-new theImage
theWidth
theHeight
theMode
"Distress Scratch Layer"
100
LAYER-MODE-NORMAL)))
(pika-image-insert-layer theImage theLayer 0 0)
(if (= FALSE (car (pika-selection-is-empty theImage)))
(pika-drawable-edit-fill theLayer FILL-BACKGROUND)
)
(pika-selection-invert theImage)
(if (= FALSE (car (pika-selection-is-empty theImage)))
(pika-drawable-edit-clear theLayer)
)
(pika-selection-invert theImage)
(pika-selection-none inImage)
(pika-layer-scale theLayer
(/ theWidth inGranu)
(/ theHeight inGranu)
TRUE)
(plug-in-spread RUN-NONINTERACTIVE
theImage
theLayer
inSpread
inSpread)
(plug-in-gauss-iir RUN-NONINTERACTIVE
theImage theLayer inSmooth inSmoothH inSmoothV)
(pika-layer-scale theLayer theWidth theHeight TRUE)
(plug-in-threshold-alpha RUN-NONINTERACTIVE theImage theLayer inThreshold)
(plug-in-gauss-iir RUN-NONINTERACTIVE theImage theLayer 1 TRUE TRUE)
(pika-image-select-item inImage CHANNEL-OP-REPLACE theLayer)
(pika-image-remove-layer theImage theLayer)
(if (and (= (car (pika-item-id-is-channel inDrawable)) TRUE)
(= (car (pika-item-id-is-layer-mask inDrawable)) FALSE))
(pika-image-set-selected-channels theImage 1 (make-vector 1 inDrawable))
)
(pika-image-undo-group-end theImage)
(pika-image-set-selected-layers theImage (car prevLayers) (cadr prevLayers))
(pika-displays-flush)
(pika-context-pop)
)
)
(script-fu-register "script-fu-distress-selection"
_"_Distort..."
_"Distress the selection"
"Chris Gutteridge"
"1998, Chris Gutteridge / ECS dept, University of Southampton, England."
"23rd April 1998"
"RGB*,GRAY*"
SF-IMAGE "The image" 0
SF-DRAWABLE "The layer" 0
SF-ADJUSTMENT _"_Threshold (bigger 1<-->254 smaller)" '(127 1 254 1 10 0 0)
SF-ADJUSTMENT _"_Spread" '(8 0 1000 1 10 0 1)
SF-ADJUSTMENT _"_Granularity (1 is low)" '(4 1 25 1 10 0 1)
SF-ADJUSTMENT _"S_mooth" '(2 1 150 1 10 0 1)
SF-TOGGLE _"Smooth hor_izontally" TRUE
SF-TOGGLE _"Smooth _vertically" TRUE
)
(script-fu-menu-register "script-fu-distress-selection"
"<Image>/Select/[Modify]")

187
plug-ins/script-fu/scripts/drop-shadow.scm Normal file
View File

@ -0,0 +1,187 @@
; PIKA - Photo and Image Kooker Application
; 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/>.
;
;
; drop-shadow.scm version 1.05 2011/4/21
;
; CHANGE-LOG:
; 1.00 - initial release
; 1.01 - fixed the problem with a remaining copy of the selection
; 1.02 - some code cleanup, no real changes
; 1.03 - can't call pika-drawable-edit-fill until layer is added to image!
; 1.04
; 1.05 - replaced deprecated function calls with new ones for 2.8
;
; Copyright (C) 1997-1999 Sven Neumann <sven@gimp.org>
;
;
; Adds a drop-shadow of the current selection or alpha-channel.
;
; This script is derived from my script add-shadow, which has become
; obsolete now. Thanks to Andrew Donkin (ard@cs.waikato.ac.nz) for his
; idea to add alpha-support to add-shadow.
(define (script-fu-drop-shadow image
drawable
shadow-transl-x
shadow-transl-y
shadow-blur
shadow-color
shadow-opacity
allow-resize)
(let* (
(shadow-blur (max shadow-blur 0))
(shadow-opacity (min shadow-opacity 100))
(shadow-opacity (max shadow-opacity 0))
(type (car (pika-drawable-type-with-alpha drawable)))
(image-width (car (pika-image-get-width image)))
(image-height (car (pika-image-get-height image)))
(from-selection 0)
(active-selection 0)
(shadow-layer 0)
)
(pika-context-push)
(pika-context-set-defaults)
(pika-image-set-selected-layers image 1 (make-vector 1 drawable))
(pika-image-undo-group-start image)
(pika-layer-add-alpha drawable)
(if (= (car (pika-selection-is-empty image)) TRUE)
(begin
(pika-image-select-item image CHANNEL-OP-REPLACE drawable)
(set! from-selection FALSE))
(begin
(set! from-selection TRUE)
(set! active-selection (car (pika-selection-save image)))))
(let* ((selection-bounds (pika-selection-bounds image))
(select-offset-x (cadr selection-bounds))
(select-offset-y (caddr selection-bounds))
(select-width (- (cadr (cddr selection-bounds)) select-offset-x))
(select-height (- (caddr (cddr selection-bounds)) select-offset-y))
(shadow-width (+ select-width (* 2 shadow-blur)))
(shadow-height (+ select-height (* 2 shadow-blur)))
(shadow-offset-x (- select-offset-x shadow-blur))
(shadow-offset-y (- select-offset-y shadow-blur)))
(if (= allow-resize TRUE)
(let* ((new-image-width image-width)
(new-image-height image-height)
(image-offset-x 0)
(image-offset-y 0))
(if (< (+ shadow-offset-x shadow-transl-x) 0)
(begin
(set! image-offset-x (- 0 (+ shadow-offset-x
shadow-transl-x)))
(set! shadow-offset-x (- 0 shadow-transl-x))
(set! new-image-width (+ new-image-width image-offset-x))))
(if (< (+ shadow-offset-y shadow-transl-y) 0)
(begin
(set! image-offset-y (- 0 (+ shadow-offset-y
shadow-transl-y)))
(set! shadow-offset-y (- 0 shadow-transl-y))
(set! new-image-height (+ new-image-height image-offset-y))))
(if (> (+ (+ shadow-width shadow-offset-x) shadow-transl-x)
new-image-width)
(set! new-image-width
(+ (+ shadow-width shadow-offset-x) shadow-transl-x)))
(if (> (+ (+ shadow-height shadow-offset-y) shadow-transl-y)
new-image-height)
(set! new-image-height
(+ (+ shadow-height shadow-offset-y) shadow-transl-y)))
(pika-image-resize image
new-image-width
new-image-height
image-offset-x
image-offset-y)
)
)
(set! shadow-layer (car (pika-layer-new image
shadow-width
shadow-height
type
"Drop Shadow"
shadow-opacity
LAYER-MODE-NORMAL)))
(pika-image-set-selected-layers image 1 (make-vector 1 drawable))
(pika-image-insert-layer image shadow-layer 0 -1)
(pika-layer-set-offsets shadow-layer
shadow-offset-x
shadow-offset-y))
(pika-drawable-fill shadow-layer FILL-TRANSPARENT)
(pika-context-set-background shadow-color)
(pika-drawable-edit-fill shadow-layer FILL-BACKGROUND)
(pika-selection-none image)
(pika-layer-set-lock-alpha shadow-layer FALSE)
(if (>= shadow-blur 1.0) (plug-in-gauss-rle RUN-NONINTERACTIVE
image
shadow-layer
shadow-blur
TRUE
TRUE))
(pika-item-transform-translate shadow-layer shadow-transl-x shadow-transl-y)
(if (= from-selection TRUE)
(begin
(pika-image-select-item image CHANNEL-OP-REPLACE active-selection)
(pika-drawable-edit-clear shadow-layer)
(pika-image-remove-channel image active-selection)))
(if (and
(= (car (pika-layer-is-floating-sel drawable)) 0)
(= from-selection FALSE))
(pika-image-raise-item image drawable))
(pika-image-set-selected-layers image 1 (make-vector 1 drawable))
(pika-image-undo-group-end image)
(pika-displays-flush)
(pika-context-pop)
)
)
(script-fu-register "script-fu-drop-shadow"
_"_Drop Shadow (legacy)..."
_"Add a drop shadow to the selected region (or alpha)"
"Sven Neumann <sven@gimp.org>"
"Sven Neumann"
"1999/12/21"
"RGB* GRAY*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-ADJUSTMENT _"Offset X" '(4 -4096 4096 1 10 0 1)
SF-ADJUSTMENT _"Offset Y" '(4 -4096 4096 1 10 0 1)
SF-ADJUSTMENT _"Blur radius" '(15 0 1024 1 10 0 1)
SF-COLOR _"Color" "black"
SF-ADJUSTMENT _"Opacity" '(60 0 100 1 10 0 0)
SF-TOGGLE _"Allow resizing" TRUE
)
(script-fu-menu-register "script-fu-drop-shadow"
"<Image>/Filters/Light and Shadow/[Shadow]")

177
plug-ins/script-fu/scripts/font-map.scm Normal file
View File

@ -0,0 +1,177 @@
;; font-map
;; Spencer Kimball
;; To test, open the Font tool dialog,
;; press right mouse button in the list of fonts, choose "Render Font Map"
;; Test cases for font filter regex
;; ".*" expect render all installed fonts
;; "foo" expect render blank image (no matching fonts)
;; "Sans" expect render subset of installed fonts
(define (script-fu-font-map text
use-name
labels
font-filter
font-size
border
colors)
(define (max-font-width text use-name list-cnt list font-size)
(let* ((count 0)
(width 0)
(maxwidth 0)
(font "")
(extents '()))
(while (< count list-cnt)
(set! font (car list))
(if (= use-name TRUE)
(set! text font))
(set! extents (pika-text-get-extents-fontname text
font-size PIXELS
font))
(set! width (car extents))
(if (> width maxwidth)
(set! maxwidth width))
(set! list (cdr list))
(set! count (+ count 1))
)
maxwidth
)
)
(define (max-font-height text use-name list-cnt list font-size)
(let* ((count 0)
(height 0)
(maxheight 0)
(font "")
(extents '()))
(while (< count list-cnt)
(set! font (car list))
(if (= use-name TRUE)
(set! text font)
)
(set! extents (pika-text-get-extents-fontname text
font-size PIXELS
font))
(set! height (cadr extents))
(if (> height maxheight)
(set! maxheight height)
)
(set! list (cdr list))
(set! count (+ count 1))
)
maxheight
)
)
(let* (
; pika-fonts-get-list returns a one element list of results,
; the only element is itself a list of fonts, possibly empty.
(font-list (car (pika-fonts-get-list font-filter)))
(num-fonts (length font-list))
(label-size (/ font-size 2))
(border (+ border (* labels (/ label-size 2))))
(y border)
(maxheight (max-font-height text use-name num-fonts font-list font-size))
(maxwidth (max-font-width text use-name num-fonts font-list font-size))
(width (+ maxwidth (* 2 border)))
(height (+ (+ (* maxheight num-fonts) (* 2 border))
(* labels (* label-size num-fonts))))
(img (car (pika-image-new width height (if (= colors 0)
GRAY RGB))))
(drawable (car (pika-layer-new img width height (if (= colors 0)
GRAY-IMAGE RGB-IMAGE)
"Background" 100 LAYER-MODE-NORMAL)))
(count 0)
(font "")
)
(pika-context-push)
(pika-image-undo-disable img)
(if (= colors 0)
(begin
(pika-context-set-background '(255 255 255))
(pika-context-set-foreground '(0 0 0))))
(pika-image-insert-layer img drawable 0 0)
(pika-drawable-edit-clear drawable)
(if (= labels TRUE)
(begin
(set! drawable (car (pika-layer-new img width height
(if (= colors 0)
GRAYA-IMAGE RGBA-IMAGE)
"Labels" 100 LAYER-MODE-NORMAL)))
(pika-image-insert-layer img drawable 0 -1)))
(pika-drawable-edit-clear drawable)
(while (< count num-fonts)
(set! font (car font-list))
(if (= use-name TRUE)
(set! text font))
(pika-text-fontname img -1
border
y
text
0 TRUE font-size PIXELS
font)
(set! y (+ y maxheight))
(if (= labels TRUE)
(begin
(pika-floating-sel-anchor (car (pika-text-fontname img drawable
(- border
(/ label-size 2))
(- y
(/ label-size 2))
font
0 TRUE
label-size PIXELS
"Sans")))
(set! y (+ y label-size))
)
)
(set! font-list (cdr font-list))
(set! count (+ count 1))
)
(pika-image-set-selected-layers img 1 (vector drawable))
(pika-image-undo-enable img)
(pika-display-new img)
(pika-context-pop)
)
)
(script-fu-register "script-fu-font-map"
_"Render _Font Map..."
_"Create an image filled with previews of fonts matching a fontname filter"
"Spencer Kimball"
"Spencer Kimball"
"1997"
""
SF-STRING _"_Text" "How quickly daft jumping zebras vex."
SF-TOGGLE _"Use font _name as text" FALSE
SF-TOGGLE _"_Labels" TRUE
SF-STRING _"_Filter (regexp)" "Sans"
SF-ADJUSTMENT _"Font _size (pixels)" '(32 2 1000 1 10 0 1)
SF-ADJUSTMENT _"_Border (pixels)" '(10 0 200 1 10 0 1)
SF-OPTION _"_Color scheme" '(_"Black on white" _"Active colors")
)
(script-fu-menu-register "script-fu-font-map"
"<Fonts>")

168
plug-ins/script-fu/scripts/fuzzyborder.scm Normal file
View File

@ -0,0 +1,168 @@
;
; fuzzy-border
;
; Do a cool fade to a given color at the border of an image (optional shadow)
; Will make image RGB if it isn't already.
;
; Chris Gutteridge (cjg@ecs.soton.ac.uk)
; At ECS Dept, University of Southampton, England.
; 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/>.
; Define the function:
(define (script-fu-fuzzy-border inImage
inLayer
inColor
inSize
inBlur
inGranu
inShadow
inShadWeight
inCopy
inFlatten
)
(define (chris-color-edge inImage inLayer inColor inSize)
(pika-selection-all inImage)
(pika-selection-shrink inImage inSize)
(pika-selection-invert inImage)
(pika-context-set-background inColor)
(pika-drawable-edit-fill inLayer FILL-BACKGROUND)
(pika-selection-none inImage)
)
(let (
(theWidth (car (pika-image-get-width inImage)))
(theHeight (car (pika-image-get-height inImage)))
(theImage (if (= inCopy TRUE) (car (pika-image-duplicate inImage))
inImage))
(theLayer 0)
)
(pika-context-push)
(pika-context-set-defaults)
(if (= inCopy TRUE)
(pika-image-undo-disable theImage)
(pika-image-undo-group-start theImage)
)
(pika-selection-all theImage)
(if (> (car (pika-drawable-type inLayer)) 1)
(pika-image-convert-rgb theImage)
)
(set! theLayer (car (pika-layer-new theImage
theWidth
theHeight
RGBA-IMAGE
"layer 1"
100
LAYER-MODE-NORMAL)))
(pika-image-insert-layer theImage theLayer 0 0)
(pika-drawable-edit-clear theLayer)
(chris-color-edge theImage theLayer inColor inSize)
(pika-layer-scale theLayer
(/ theWidth inGranu)
(/ theHeight inGranu)
TRUE)
(plug-in-spread RUN-NONINTERACTIVE
theImage
theLayer
(/ inSize inGranu)
(/ inSize inGranu))
(chris-color-edge theImage theLayer inColor 1)
(pika-layer-scale theLayer theWidth theHeight TRUE)
(pika-image-select-item theImage CHANNEL-OP-REPLACE theLayer)
(pika-selection-invert theImage)
(pika-drawable-edit-clear theLayer)
(pika-selection-invert theImage)
(pika-drawable-edit-clear theLayer)
(pika-context-set-background inColor)
(pika-drawable-edit-fill theLayer FILL-BACKGROUND)
(pika-selection-none theImage)
(chris-color-edge theImage theLayer inColor 1)
(if (= inBlur TRUE)
(plug-in-gauss-rle RUN-NONINTERACTIVE
theImage theLayer inSize TRUE TRUE)
)
(if (= inShadow TRUE)
(begin
(pika-image-insert-layer theImage
(car (pika-layer-copy theLayer FALSE)) 0 -1)
(pika-layer-scale theLayer
(- theWidth inSize) (- theHeight inSize) TRUE)
(pika-drawable-desaturate theLayer DESATURATE-LIGHTNESS)
(pika-drawable-brightness-contrast theLayer 0.5 0.5)
(pika-drawable-invert theLayer FALSE)
(pika-layer-resize theLayer
theWidth
theHeight
(/ inSize 2)
(/ inSize 2))
(plug-in-gauss-rle RUN-NONINTERACTIVE
theImage
theLayer
(/ inSize 2)
TRUE
TRUE)
(pika-layer-set-opacity theLayer inShadWeight)
)
)
(if (= inFlatten TRUE)
(pika-image-flatten theImage)
)
(if (= inCopy TRUE)
(begin (pika-image-clean-all theImage)
(pika-display-new theImage)
(pika-image-undo-enable theImage)
)
(pika-image-undo-group-end theImage)
)
(pika-displays-flush)
(pika-context-pop)
)
)
(script-fu-register "script-fu-fuzzy-border"
_"_Fuzzy Border..."
_"Add a jagged, fuzzy border to an image"
"Chris Gutteridge"
"1998, Chris Gutteridge / ECS dept, University of Southampton, England."
"3rd April 1998"
"RGB* GRAY*"
SF-IMAGE "The image" 0
SF-DRAWABLE "The layer" 0
SF-COLOR _"Color" "white"
SF-ADJUSTMENT _"Border size" '(16 1 300 1 10 0 1)
SF-TOGGLE _"Blur border" TRUE
SF-ADJUSTMENT _"Granularity (1 is Low)" '(4 1 16 0.25 5 2 0)
SF-TOGGLE _"Add shadow" FALSE
SF-ADJUSTMENT _"Shadow weight (%)" '(100 0 100 1 10 0 0)
SF-TOGGLE _"Work on copy" TRUE
SF-TOGGLE _"Flatten image" TRUE
)
(script-fu-menu-register "script-fu-fuzzy-border"
"<Image>/Filters/Decor")

81
plug-ins/script-fu/scripts/gradient-example.scm Normal file
View File

@ -0,0 +1,81 @@
; PIKA - Photo and Image Kooker Application
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
;
; Gradient example script --- create an example image of a custom gradient
; Copyright (C) 1997 Federico Mena Quintero
; federico@nuclecu.unam.mx
;
; 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/>.
(define (script-fu-gradient-example width
height
gradient-reverse)
(let* (
(img (car (pika-image-new width height RGB)))
(drawable (car (pika-layer-new img width height RGB
"Gradient example" 100 LAYER-MODE-NORMAL)))
; Calculate colors for checkerboard... just like in the gradient editor
(fg-color (* 255 (/ 2 3)))
(bg-color (* 255 (/ 1 3)))
)
(pika-image-undo-disable img)
(pika-image-insert-layer img drawable 0 0)
; Render background checkerboard
(pika-context-push)
(pika-context-set-foreground (list fg-color fg-color fg-color))
(pika-context-set-background (list bg-color bg-color bg-color))
(plug-in-checkerboard RUN-NONINTERACTIVE img 1 (vector drawable) 0 8)
(pika-context-pop)
; Render gradient
(pika-context-push)
(pika-context-set-gradient-reverse gradient-reverse)
(pika-drawable-edit-gradient-fill drawable
GRADIENT-LINEAR 0
FALSE 0 0
TRUE
0 0 (- width 1) 0)
(pika-context-pop)
; Terminate
(pika-image-undo-enable img)
(pika-display-new img)
)
)
(script-fu-register "script-fu-gradient-example"
_"Custom _Gradient..."
_"Create an image filled with an example of the current gradient"
"Federico Mena Quintero"
"Federico Mena Quintero"
"June 1997"
""
SF-ADJUSTMENT _"Width" '(400 1 2000 1 10 0 1)
SF-ADJUSTMENT _"Height" '(30 1 2000 1 10 0 1)
SF-TOGGLE _"Gradient reverse" FALSE
)
(script-fu-menu-register "script-fu-gradient-example"
"<Gradients>")

43
plug-ins/script-fu/scripts/guides-from-selection.scm Normal file
View File

@ -0,0 +1,43 @@
;; -*-scheme-*-
(define (script-fu-guides-from-selection image drawable)
(let* (
(boundaries (pika-selection-bounds image))
;; non-empty INT32 TRUE if there is a selection
(selection (car boundaries))
(x1 (cadr boundaries))
(y1 (caddr boundaries))
(x2 (cadr (cddr boundaries)))
(y2 (caddr (cddr boundaries)))
)
;; need to check for a selection or we get guides right at edges of the image
(if (= selection TRUE)
(begin
(pika-image-undo-group-start image)
(pika-image-add-vguide image x1)
(pika-image-add-hguide image y1)
(pika-image-add-vguide image x2)
(pika-image-add-hguide image y2)
(pika-image-undo-group-end image)
(pika-displays-flush)
)
)
)
)
(script-fu-register "script-fu-guides-from-selection"
_"New Guides from _Selection"
_"Create four guides around the bounding box of the current selection"
"Alan Horkan"
"Alan Horkan, 2004. Public Domain."
"2004-08-13"
"*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
)
(script-fu-menu-register "script-fu-guides-from-selection"
"<Image>/Image/Guides")

41
plug-ins/script-fu/scripts/guides-new-percent.scm Normal file
View File

@ -0,0 +1,41 @@
;; -*-scheme-*-
;; Alan Horkan 2004. No copyright. Public Domain.
(define (script-fu-guide-new-percent image drawable direction position)
(let* (
(width (car (pika-image-get-width image)))
(height (car (pika-image-get-height image)))
)
(if (= direction 0)
(set! position (/ (* height position) 100))
(set! position (/ (* width position) 100))
)
(if (= direction 0)
;; convert position to pixel
(if (<= position height) (pika-image-add-hguide image position))
(if (<= position width) (pika-image-add-vguide image position))
)
(pika-displays-flush)
)
)
(script-fu-register "script-fu-guide-new-percent"
_"New Guide (by _Percent)..."
_"Add a guide at the position specified as a percentage of the image size"
"Alan Horkan"
"Alan Horkan, 2004"
"April 2004"
"*"
SF-IMAGE "Input Image" 0
SF-DRAWABLE "Input Drawable" 0
SF-OPTION _"_Direction" '(_"Horizontal"
_"Vertical")
SF-ADJUSTMENT _"_Position (in %)" '(50 0 100 1 10 2 1)
)
(script-fu-menu-register "script-fu-guide-new-percent"
"<Image>/Image/Guides")

40
plug-ins/script-fu/scripts/guides-new.scm Normal file
View File

@ -0,0 +1,40 @@
;; -*-scheme-*-
;; Alan Horkan 2004. Public Domain.
;; so long as remove this block of comments from your script
;; feel free to use it for whatever you like.
(define (script-fu-guide-new image
drawable
direction
position)
(let* (
(width (car (pika-image-get-width image)))
(height (car (pika-image-get-height image)))
)
(if (= direction 0)
;; check position is inside the image boundaries
(if (<= position height) (pika-image-add-hguide image position))
(if (<= position width) (pika-image-add-vguide image position))
)
(pika-displays-flush)
)
)
(script-fu-register "script-fu-guide-new"
_"New _Guide..."
_"Add a guide at the orientation and position specified (in pixels)"
"Alan Horkan"
"Alan Horkan, 2004. Public Domain."
"2004-04-02"
"*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-OPTION _"_Direction" '(_"Horizontal" _"Vertical")
SF-ADJUSTMENT _"_Position" (list 0 0 MAX-IMAGE-SIZE 1 10 0 1)
)
(script-fu-menu-register "script-fu-guide-new"
"<Image>/Image/Guides")

30
plug-ins/script-fu/scripts/guides-remove-all.scm Normal file
View File

@ -0,0 +1,30 @@
;; -*-scheme-*-
(define (script-fu-guides-remove image drawable)
(let* ((guide-id 0))
(pika-image-undo-group-start image)
(set! guide-id (car (pika-image-find-next-guide image 0)))
(while (> guide-id 0)
(pika-image-delete-guide image guide-id)
(set! guide-id (car (pika-image-find-next-guide image 0)))
)
(pika-image-undo-group-end image)
(pika-displays-flush)
)
)
(script-fu-register "script-fu-guides-remove"
_"_Remove all Guides"
_"Remove all horizontal and vertical guides"
"Alan Horkan"
"Alan Horkan, 2004. Public Domain."
"April 2004"
"*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
)
(script-fu-menu-register "script-fu-guides-remove"
"<Image>/Image/Guides")

BIN
plug-ins/script-fu/scripts/images/beavis.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 20 KiB

9
plug-ins/script-fu/scripts/images/meson.build Normal file
View File

@ -0,0 +1,9 @@
install_data([
'beavis.jpg',
'texture.jpg',
'texture1.jpg',
'texture2.jpg',
'texture3.jpg',
],
install_dir: pikadatadir / 'scripts' / 'images',
)

BIN
plug-ins/script-fu/scripts/images/texture.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 22 KiB

BIN
plug-ins/script-fu/scripts/images/texture1.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 4.2 KiB

BIN
plug-ins/script-fu/scripts/images/texture2.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 4.9 KiB

BIN
plug-ins/script-fu/scripts/images/texture3.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.2 KiB

147
plug-ins/script-fu/scripts/lava.scm Normal file
View File

@ -0,0 +1,147 @@
; PIKA - Photo and Image Kooker Application
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
;
; Lava effect
; Copyright (c) 1997 Adrian Likins
; aklikins@eos.ncsu.edu
;
; based on a idea by Sven Riedel <lynx@heim8.tu-clausthal.de>
; tweaked a bit by Sven Neumann <neumanns@uni-duesseldorf.de>
;
; 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/>.
(define (script-fu-lava image
drawable
seed
tile_size
mask_size
gradient
keep-selection
separate-layer
current-grad)
(let* (
(type (car (pika-drawable-type-with-alpha drawable)))
(image-width (car (pika-image-get-width image)))
(image-height (car (pika-image-get-height image)))
(active-selection 0)
(selection-bounds 0)
(select-offset-x 0)
(select-offset-y 0)
(select-width 0)
(select-height 0)
(lava-layer 0)
(active-layer 0)
(selected-layers (pika-image-get-selected-layers image))
(num-selected-layers (car selected-layers))
(selected-layers-array (cadr selected-layers))
)
(if (= num-selected-layers 1)
(begin
(pika-context-push)
(pika-context-set-defaults)
(pika-image-undo-group-start image)
(if (= (car (pika-drawable-has-alpha drawable)) FALSE)
(pika-layer-add-alpha drawable)
)
(if (= (car (pika-selection-is-empty image)) TRUE)
(pika-image-select-item image CHANNEL-OP-REPLACE drawable)
)
(set! active-selection (car (pika-selection-save image)))
(pika-image-set-selected-layers image 1 (make-vector 1 drawable))
(set! selection-bounds (pika-selection-bounds image))
(set! select-offset-x (cadr selection-bounds))
(set! select-offset-y (caddr selection-bounds))
(set! select-width (- (cadr (cddr selection-bounds)) select-offset-x))
(set! select-height (- (caddr (cddr selection-bounds)) select-offset-y))
(if (= separate-layer TRUE)
(begin
(set! lava-layer (car (pika-layer-new image
select-width
select-height
type
"Lava Layer"
100
LAYER-MODE-NORMAL-LEGACY)))
(pika-image-insert-layer image lava-layer 0 -1)
(pika-layer-set-offsets lava-layer select-offset-x select-offset-y)
(pika-selection-none image)
(pika-drawable-edit-clear lava-layer)
(pika-image-select-item image CHANNEL-OP-REPLACE active-selection)
(pika-image-set-selected-layers image 1 (make-vector 1 lava-layer))
)
)
(set! selected-layers (pika-image-get-selected-layers image))
(set! num-selected-layers (car selected-layers))
(set! selected-layers-array (cadr selected-layers))
(set! active-layer (aref selected-layers-array (- num-selected-layers 1)))
(if (= current-grad FALSE)
(pika-context-set-gradient gradient)
)
(plug-in-solid-noise RUN-NONINTERACTIVE image active-layer FALSE TRUE seed 2 2 2)
(plug-in-cubism RUN-NONINTERACTIVE image active-layer tile_size 2.5 0)
(plug-in-oilify RUN-NONINTERACTIVE image active-layer mask_size 0)
(plug-in-edge RUN-NONINTERACTIVE image active-layer 2 0 0)
(plug-in-gauss-rle RUN-NONINTERACTIVE image active-layer 2 TRUE TRUE)
(plug-in-gradmap RUN-NONINTERACTIVE image num-selected-layers selected-layers-array)
(if (= keep-selection FALSE)
(pika-selection-none image)
)
(pika-image-set-selected-layers image 1 (make-vector 1 drawable))
(pika-image-remove-channel image active-selection)
(pika-image-undo-group-end image)
(pika-context-pop)
(pika-displays-flush)
)
; else
(pika-message _"Lava works with exactly one selected layer")
)
)
)
(script-fu-register "script-fu-lava"
_"_Lava..."
_"Fill the current selection with lava"
"Adrian Likins <adrian@gimp.org>"
"Adrian Likins"
"10/12/97"
"RGB* GRAY*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-ADJUSTMENT _"Seed" '(10 1 30000 1 10 0 1)
SF-ADJUSTMENT _"Size" '(10 0 100 1 10 0 1)
SF-ADJUSTMENT _"Roughness" '(7 3 50 1 10 0 0)
SF-GRADIENT _"Gradient" "German flag smooth"
SF-TOGGLE _"Keep selection" TRUE
SF-TOGGLE _"Separate layer" TRUE
SF-TOGGLE _"Use current gradient" FALSE
)
(script-fu-menu-register "script-fu-lava"
"<Image>/Filters/Render")

121
plug-ins/script-fu/scripts/line-nova.scm Normal file
View File

@ -0,0 +1,121 @@
;;; line-nova.scm for pika-1.1 -*-scheme-*-
;;; Time-stamp: <1998/11/25 13:26:44 narazaki@gimp.org>
;;; Author Shuji Narazaki <narazaki@gimp.org>
;;; Version 0.7
(define (script-fu-line-nova img drw num-of-lines corn-deg offset variation)
(let* (
(*points* (cons-array (* 3 2) 'double))
(modulo fmod) ; in R4RS way
(pi/2 (/ *pi* 2))
(pi/4 (/ *pi* 4))
(pi3/4 (* 3 pi/4))
(pi5/4 (* 5 pi/4))
(pi3/2 (* 3 pi/2))
(pi7/4 (* 7 pi/4))
(2pi (* 2 *pi*))
(rad/deg (/ 2pi 360))
(variation/2 (/ variation 2))
(drw-width (car (pika-drawable-get-width drw)))
(drw-height (car (pika-drawable-get-height drw)))
(drw-offsets (pika-drawable-get-offsets drw))
(old-selection FALSE)
(radius (max drw-height drw-width))
(index 0)
(dir-deg/line (/ 360 num-of-lines))
(fg-color (car (pika-context-get-foreground)))
)
(pika-context-push)
(pika-context-set-defaults)
(pika-context-set-foreground fg-color)
(define (draw-vector beg-x beg-y direction)
(define (set-point! index x y)
(aset *points* (* 2 index) x)
(aset *points* (+ (* 2 index) 1) y)
)
(define (deg->rad rad)
(* (modulo rad 360) rad/deg)
)
(define (set-marginal-point beg-x beg-y direction)
(let (
(dir1 (deg->rad (+ direction corn-deg)))
(dir2 (deg->rad (- direction corn-deg)))
)
(define (aux dir index)
(set-point! index
(+ beg-x (* (cos dir) radius))
(+ beg-y (* (sin dir) radius)))
)
(aux dir1 1)
(aux dir2 2)
)
)
(let (
(dir0 (deg->rad direction))
(off (+ offset (- (modulo (rand) variation) variation/2)))
)
(set-point! 0
(+ beg-x (* off (cos dir0)))
(+ beg-y (* off (sin dir0)))
)
(set-marginal-point beg-x beg-y direction)
(pika-image-select-polygon img CHANNEL-OP-ADD 6 *points*)
)
)
(pika-image-undo-group-start img)
(set! old-selection
(if (eq? (car (pika-selection-is-empty img)) TRUE)
#f
(car (pika-selection-save img))
)
)
(pika-selection-none img)
(srand (realtime))
(while (< index num-of-lines)
(draw-vector (+ (nth 0 drw-offsets) (/ drw-width 2))
(+ (nth 1 drw-offsets) (/ drw-height 2))
(* index dir-deg/line)
)
(set! index (+ index 1))
)
(pika-drawable-edit-fill drw FILL-FOREGROUND)
(if old-selection
(begin
(pika-image-select-item img CHANNEL-OP-REPLACE old-selection)
(pika-image-remove-channel img old-selection)
)
)
(pika-image-undo-group-end img)
(pika-displays-flush)
(pika-context-pop)
)
)
(script-fu-register "script-fu-line-nova"
_"Line _Nova..."
_"Fill a layer with rays emanating outward from its center using the foreground color"
"Shuji Narazaki <narazaki@gimp.org>"
"Shuji Narazaki"
"1997,1998"
"*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-ADJUSTMENT _"Number of lines" '(200 40 1000 1 1 0 1)
SF-ADJUSTMENT _"Sharpness (degrees)" '(1.0 0.0 10.0 0.1 1 1 1)
SF-ADJUSTMENT _"Offset radius" '(100 0 2000 1 1 0 1)
SF-ADJUSTMENT _"Randomness" '(30 1 2000 1 1 0 1)
)
(script-fu-menu-register "script-fu-line-nova"
"<Image>/Filters/Render")

82
plug-ins/script-fu/scripts/meson.build Normal file
View File

@ -0,0 +1,82 @@
subdir('images')
# scripts interpreted by extension-script-fu, installed to /scripts
scripts = [
'add-bevel.scm',
'addborder.scm',
'blend-anim.scm',
'burn-in-anim.scm',
'carve-it.scm',
'chrome-it.scm',
'circuit.scm',
'clothify.scm',
'coffee.scm',
'difference-clouds.scm',
'distress-selection.scm',
'drop-shadow.scm',
'font-map.scm',
'fuzzyborder.scm',
'pika-online.scm',
'gradient-example.scm',
'guides-from-selection.scm',
'guides-new-percent.scm',
'guides-new.scm',
'guides-remove-all.scm',
'lava.scm',
'line-nova.scm',
'mkbrush.scm',
'old-photo.scm',
'palette-export.scm',
'paste-as-brush.scm',
'paste-as-pattern.scm',
'perspective-shadow.scm',
'plug-in-compat.init',
'reverse-layers.scm',
'ripply-anim.scm',
'round-corners.scm',
'script-fu-compat.init',
'script-fu-set-cmap.scm',
'script-fu-util.scm',
'script-fu.init',
'selection-round.scm',
'slide.scm',
'spinning-globe.scm',
'tileblur.scm',
'unsharp-mask.scm',
'waves-anim.scm',
'weave.scm',
'xach-effect.scm',
'clothify-v3.scm'
]
if not stable
scripts += [
'contactsheet.scm',
'test-sphere.scm',
]
endif
install_data(
scripts,
install_dir: pikadatadir / 'scripts',
)
# scripts interpreted by pika-script-fu-interpreter
# Each installed in subdirectory of /plug-in
# Each have a shebang and executable permission.
# Like other interpreted plugins.
# Lacking a shebang, a .interp file is needed to associate .scm suffix
scripts_independent = [
{ 'name': 'ts-helloworld' },
{ 'name': 'test-sphere-v3' },
]
foreach plugin : scripts_independent
name = plugin.get('name')
srcs = plugin.get('srcs', name + '.scm')
install_data(srcs,
install_dir: pikaplugindir / 'plug-ins' / name,
install_mode: 'rwxr-xr-x')
endforeach

272
plug-ins/script-fu/scripts/mkbrush.scm Normal file
View File

@ -0,0 +1,272 @@
; PIKA - Photo and Image Kooker Application
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
;
; Make-Brush - a script for the script-fu program
; by Seth Burgess 1997 <sjburges@ou.edu>
;
; 18-Dec-2000 fixed to work with the new convention (not inverted) of
; gbr saver (jtl@gimp.org)
;
; 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/>.
(define (script-fu-make-brush-rectangular name width height spacing)
(let* (
(img (car (pika-image-new width height GRAY)))
(drawable (car (pika-layer-new img
width height GRAY-IMAGE
"MakeBrush" 100 LAYER-MODE-NORMAL)))
(filename (string-append pika-directory
"/brushes/r"
(number->string width)
"x"
(number->string height)
".gbr"))
)
(pika-context-push)
(pika-context-set-defaults)
(pika-image-undo-disable img)
(pika-image-insert-layer img drawable 0 0)
(pika-context-set-background '(255 255 255))
(pika-drawable-fill drawable FILL-BACKGROUND)
(pika-image-select-rectangle img CHANNEL-OP-REPLACE 0 0 width height)
(pika-context-set-background '(0 0 0))
(pika-drawable-edit-fill drawable FILL-BACKGROUND)
(file-gbr-save 1 img 1 (vector drawable) filename spacing name)
(pika-image-delete img)
(pika-context-pop)
(pika-brushes-refresh)
(pika-context-set-brush name)
)
)
(script-fu-register "script-fu-make-brush-rectangular"
_"_Rectangular..."
_"Create a rectangular brush"
"Seth Burgess <sjburges@ou.edu>"
"Seth Burgess"
"1997"
""
SF-STRING _"Name" "Rectangle"
SF-ADJUSTMENT _"Width" '(20 1 200 1 10 0 1)
SF-ADJUSTMENT _"Height" '(20 1 200 1 10 0 1)
SF-ADJUSTMENT _"Spacing" '(25 1 100 1 10 1 0)
)
(script-fu-menu-register "script-fu-make-brush-rectangular"
"<Brushes>")
(define (script-fu-make-brush-rectangular-feathered name width height
feathering spacing)
(let* (
(widthplus (+ width feathering))
(heightplus (+ height feathering))
(img (car (pika-image-new widthplus heightplus GRAY)))
(drawable (car (pika-layer-new img
widthplus heightplus GRAY-IMAGE
"MakeBrush" 100 LAYER-MODE-NORMAL)))
(filename (string-append pika-directory
"/brushes/r"
(number->string width)
"x"
(number->string height)
"f"
(number->string feathering)
".gbr"))
)
(pika-context-push)
(pika-context-set-paint-mode LAYER-MODE-NORMAL)
(pika-context-set-opacity 100.0)
(pika-image-undo-disable img)
(pika-image-insert-layer img drawable 0 0)
(pika-context-set-background '(255 255 255))
(pika-drawable-fill drawable FILL-BACKGROUND)
(cond
((< 0 feathering)
(pika-context-set-feather TRUE)
(pika-context-set-feather-radius feathering feathering)
(pika-image-select-rectangle img CHANNEL-OP-REPLACE
(/ feathering 2) (/ feathering 2) width height))
((>= 0 feathering)
(pika-context-set-feather FALSE)
(pika-image-select-rectangle img CHANNEL-OP-REPLACE 0 0 width height))
)
(pika-context-set-background '(0 0 0))
(pika-drawable-edit-fill drawable FILL-BACKGROUND)
(file-gbr-save 1 img 1 (vector drawable) filename spacing name)
(pika-image-delete img)
(pika-context-pop)
(pika-brushes-refresh)
(pika-context-set-brush name)
)
)
(script-fu-register "script-fu-make-brush-rectangular-feathered"
_"Re_ctangular, Feathered..."
_"Create a rectangular brush with feathered edges"
"Seth Burgess <sjburges@ou.edu>"
"Seth Burgess"
"1997"
""
SF-STRING _"Name" "Rectangle"
SF-ADJUSTMENT _"Width" '(20 1 200 1 10 0 1)
SF-ADJUSTMENT _"Height" '(20 1 200 1 10 0 1)
SF-ADJUSTMENT _"Feathering" '(4 1 100 1 10 0 1)
SF-ADJUSTMENT _"Spacing" '(25 1 100 1 10 1 0)
)
(script-fu-menu-register "script-fu-make-brush-rectangular-feathered"
"<Brushes>")
(define (script-fu-make-brush-elliptical name width height spacing)
(let* (
(img (car (pika-image-new width height GRAY)))
(drawable (car (pika-layer-new img
width height GRAY-IMAGE
"MakeBrush" 100 LAYER-MODE-NORMAL)))
(filename (string-append pika-directory
"/brushes/e"
(number->string width)
"x"
(number->string height)
".gbr"))
)
(pika-context-push)
(pika-context-set-antialias TRUE)
(pika-context-set-feather FALSE)
(pika-image-undo-disable img)
(pika-image-insert-layer img drawable 0 0)
(pika-context-set-background '(255 255 255))
(pika-drawable-fill drawable FILL-BACKGROUND)
(pika-context-set-background '(0 0 0))
(pika-image-select-ellipse img CHANNEL-OP-REPLACE 0 0 width height)
(pika-drawable-edit-fill drawable FILL-BACKGROUND)
(file-gbr-save 1 img 1 (vector drawable) filename spacing name)
(pika-image-delete img)
(pika-context-pop)
(pika-brushes-refresh)
(pika-context-set-brush name)
)
)
(script-fu-register "script-fu-make-brush-elliptical"
_"_Elliptical..."
_"Create an elliptical brush"
"Seth Burgess <sjburges@ou.edu>"
"Seth Burgess"
"1997"
""
SF-STRING _"Name" "Ellipse"
SF-ADJUSTMENT _"Width" '(20 1 200 1 10 0 1)
SF-ADJUSTMENT _"Height" '(20 1 200 1 10 0 1)
SF-ADJUSTMENT _"Spacing" '(25 1 100 1 10 1 0)
)
(script-fu-menu-register "script-fu-make-brush-elliptical"
"<Brushes>")
(define (script-fu-make-brush-elliptical-feathered name
width height
feathering spacing)
(let* (
(widthplus (+ feathering width)) ; add 3 for blurring
(heightplus (+ feathering height))
(img (car (pika-image-new widthplus heightplus GRAY)))
(drawable (car (pika-layer-new img
widthplus heightplus GRAY-IMAGE
"MakeBrush" 100 LAYER-MODE-NORMAL)))
(filename (string-append pika-directory
"/brushes/e"
(number->string width)
"x"
(number->string height)
"f"
(number->string feathering)
".gbr"))
)
(pika-context-push)
(pika-context-set-antialias TRUE)
(pika-image-undo-disable img)
(pika-image-insert-layer img drawable 0 0)
(pika-context-set-background '(255 255 255))
(pika-drawable-fill drawable FILL-BACKGROUND)
(cond ((> feathering 0) ; keep from taking out pika with stupid entry.
(pika-context-set-feather TRUE)
(pika-context-set-feather-radius feathering feathering)
(pika-image-select-ellipse img CHANNEL-OP-REPLACE
(/ feathering 2) (/ feathering 2)
width height))
((<= feathering 0)
(pika-context-set-feather FALSE)
(pika-image-select-ellipse img CHANNEL-OP-REPLACE 0 0 width height)))
(pika-context-set-background '(0 0 0))
(pika-drawable-edit-fill drawable FILL-BACKGROUND)
(file-gbr-save 1 img 1 (vector drawable) filename spacing name)
(pika-image-delete img)
(pika-context-pop)
(pika-brushes-refresh)
(pika-context-set-brush name)
)
)
(script-fu-register "script-fu-make-brush-elliptical-feathered"
_"Elli_ptical, Feathered..."
_"Create an elliptical brush with feathered edges"
"Seth Burgess <sjburges@ou.edu>"
"Seth Burgess"
"1997"
""
SF-STRING _"Name" "Ellipse"
SF-ADJUSTMENT _"Width" '(20 1 200 1 10 0 1)
SF-ADJUSTMENT _"Height" '(20 1 200 1 10 0 1)
SF-ADJUSTMENT _"Feathering" '(4 1 100 1 10 0 1)
SF-ADJUSTMENT _"Spacing" '(25 1 100 1 10 1 0)
)
(script-fu-menu-register "script-fu-make-brush-elliptical-feathered"
"<Brushes>")

108
plug-ins/script-fu/scripts/old-photo.scm Normal file
View File

@ -0,0 +1,108 @@
;
; old-photo
;
;
; Chris Gutteridge (cjg@ecs.soton.ac.uk)
; At ECS Dept, University of Southampton, England.
; 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/>.
;
; Branko Collin <collin@xs4all.nl> added the possibility to change
; the border size in October 2001.
; Define the function:
(define (script-fu-old-photo inImage inLayer inDefocus inBorderSize inSepia inMottle inCopy)
(let (
(theImage (if (= inCopy TRUE) (car (pika-image-duplicate inImage)) inImage))
(theLayer 0)
(theWidth 0)
(theHeight 0)
)
(if (= inCopy TRUE)
(pika-image-undo-disable theImage)
(pika-image-undo-group-start theImage)
)
(pika-selection-all theImage)
(set! theLayer (car (pika-image-flatten theImage)))
(if (= inDefocus TRUE)
(plug-in-gauss-rle RUN-NONINTERACTIVE theImage theLayer 1.5 TRUE TRUE)
)
(if (> inBorderSize 0)
(script-fu-fuzzy-border theImage theLayer '(255 255 255)
inBorderSize TRUE 8 FALSE 100 FALSE TRUE )
)
(set! theLayer (car (pika-image-flatten theImage)))
(if (= inSepia TRUE)
(begin (pika-drawable-desaturate theLayer DESATURATE-LIGHTNESS)
(pika-drawable-brightness-contrast theLayer -0.078125 -0.15625)
(pika-drawable-color-balance theLayer TRANSFER-SHADOWS TRUE 30 0 -30)
)
)
(set! theWidth (car (pika-image-get-width theImage)))
(set! theHeight (car (pika-image-get-height theImage)))
(if (= inMottle TRUE)
(let (
(mLayer (car (pika-layer-new theImage theWidth theHeight
RGBA-IMAGE "Mottle"
100 LAYER-MODE-DARKEN-ONLY)))
)
(pika-image-insert-layer theImage mLayer 0 0)
(pika-selection-all theImage)
(pika-drawable-edit-clear mLayer)
(pika-selection-none theImage)
(plug-in-noisify RUN-NONINTERACTIVE theImage mLayer TRUE 0 0 0 0.5)
(plug-in-gauss-rle RUN-NONINTERACTIVE theImage mLayer 5 TRUE TRUE)
(set! theLayer (car (pika-image-flatten theImage)))
)
)
(pika-selection-none theImage)
(if (= inCopy TRUE)
(begin (pika-image-clean-all theImage)
(pika-display-new theImage)
(pika-image-undo-enable theImage)
)
(pika-image-undo-group-end theImage)
)
(pika-displays-flush theImage)
)
)
(script-fu-register "script-fu-old-photo"
_"_Old Photo..."
_"Make an image look like an old photo"
"Chris Gutteridge"
"1998, Chris Gutteridge / ECS dept, University of Southampton, England."
"16th April 1998"
"RGB* GRAY*"
SF-IMAGE "The image" 0
SF-DRAWABLE "The layer" 0
SF-TOGGLE _"Defocus" TRUE
SF-ADJUSTMENT _"Border size" '(20 0 300 1 10 0 1)
; since this plug-in uses the fuzzy-border plug-in, I used the
; values of the latter, with the exception of the initial value
; and the 'minimum' value.
SF-TOGGLE _"Sepia" TRUE
SF-TOGGLE _"Mottle" FALSE
SF-TOGGLE _"Work on copy" TRUE
)
(script-fu-menu-register "script-fu-old-photo"
"<Image>/Filters/Decor")

402
plug-ins/script-fu/scripts/palette-export.scm Normal file
View File

@ -0,0 +1,402 @@
; -----------------------------------------------------------------------------
; PIKA palette export toolkit -
; Written by Barak Itkin <lightningismyname@gmail.com>
;
; This script includes various exporters for PIKA palettes, and other
; utility function to help in exporting to other (text-based) formats.
; See instruction on adding new exporters at the end
;
; -----------------------------------------------------------------------------
; Numbers and Math
; -----------------------------------------------------------------------------
; For all the operations below, this is the order of respectable digits:
(define conversion-digits (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"
"a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k"
"l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v"
"w" "x" "y" "z"))
; Converts a decimal number to another base. The returned number is a string
(define (convert-decimal-to-base num base)
(if (< num base)
(list-ref conversion-digits num)
(let loop ((val num)
(order (inexact->exact (truncate (/ (log num)
(log base)))))
(result ""))
(let* ((power (expt base order))
(digit (quotient val power)))
(if (zero? order)
(string-append result (list-ref conversion-digits digit))
(loop (- val (* digit power))
(pred order)
(string-append result (list-ref conversion-digits digit))))))))
; Convert a string representation of a number in some base, to a decimal number
(define (convert-base-to-decimal base num-str)
(define (convert-char num-char)
(if (char-numeric? num-char)
(string->number (string num-char))
(+ 10 (- (char->integer num-char) (char->integer #\a)))
)
)
(define (calc base num-str num)
(if (equal? num-str "")
num
(calc base
(substring num-str 1)
(+ (* num base) (convert-char (string-ref num-str 0)))
)
)
)
(calc base num-str 0)
)
; If a string num-str is shorter then size, pad it with pad-str in the
; beginning until it's at least size long
(define (pre-pad-number num-str size pad-str)
(if (< (string-length num-str) size)
(pre-pad-number (string-append pad-str num-str) size pad-str)
num-str
)
)
; -----------------------------------------------------------------------------
; Color converters
; -----------------------------------------------------------------------------
; The standard way for representing a color would be a list of red
; green and blue (PIKA's default)
(define color-get-red car)
(define color-get-green cadr)
(define color-get-blue caddr)
; Convert a color to a hexadecimal string
; '(255 255 255) => "#ffffff"
(define (color-rgb-to-hexa-decimal color)
(string-append "#"
(pre-pad-number
(convert-decimal-to-base (color-get-red color) 16) 2 "0")
(pre-pad-number
(convert-decimal-to-base (color-get-green color) 16) 2 "0")
(pre-pad-number
(convert-decimal-to-base (color-get-blue color) 16) 2 "0")
)
)
; Convert a color to a css color
; '(255 255 255) => "rgb(255, 255, 255)"
(define (color-rgb-to-css color)
(string-append "rgb(" (number->string (color-get-red color))
", " (number->string (color-get-green color))
", " (number->string (color-get-blue color)) ");")
)
; Convert a color to a simple pair of braces with comma separated values
; '(255 255 255) => "(255, 255, 255)"
(define (color-rgb-to-comma-separated-list color)
(string-append "(" (number->string (color-get-red color))
", " (number->string (color-get-green color))
", " (number->string (color-get-blue color)) ")")
)
; -----------------------------------------------------------------------------
; Export utils
; -----------------------------------------------------------------------------
; List of characters that should not appear in file names
(define illegal-file-name-chars (list #\\ #\/ #\: #\* #\? #\" #\< #\> #\|))
; A function to filter a list lst by a given predicate pred
(define (filter pred lst)
(if (null? lst)
'()
(if (pred (car lst))
(cons (car lst) (filter pred (cdr lst)))
(filter pred (cdr lst))
)
)
)
; A function to check if a certain value obj is inside a list lst
(define (contained? obj lst) (member obj lst))
; This functions filters a string to have only characters which are
; either alpha-numeric or contained in more-legal (which is a variable
; holding a list of characters)
(define (clean str more-legal)
(list->string (filter (lambda (ch) (or (char-alphabetic? ch)
(char-numeric? ch)
(contained? ch more-legal)))
(string->list str)))
)
; A function that receives the a file-name, and filters out all the
; character that shouldn't appear in file names. Then, it makes sure
; the remaining name isn't only white-spaces. If it's only
; white-spaces, the function returns false. Otherwise, it returns the
; fixed file-name
(define (valid-file-name name)
(let* ((clean (list->string (filter (lambda (ch)
(not (contained?
ch illegal-file-name-chars)))
(string->list name))))
(clean-without-spaces (list->string (filter (lambda (ch)
(not (char-whitespace?
ch)))
(string->list clean))))
)
(if (equal? clean-without-spaces "")
#f
clean
)
)
)
; Filters a string from all the characters which are not alpha-numeric
; (this also removes whitespaces)
(define (name-alpha-numeric str)
(clean str '())
)
; This function does the same as name-alpha-numeric, with an added
; operation - it removes any numbers from the beginning
(define (name-standard str)
(let ((cleaned (clean str '())))
(while (char-numeric? (string-ref cleaned 0))
(set! cleaned (substring cleaned 1))
)
cleaned
)
)
(define name-no-conversion (lambda (obj) obj))
(define color-none (lambda (x) ""))
(define name-none (lambda (x) ""))
(define displayln (lambda (obj) (display obj) (display "\n")))
; The loop for exporting all the colors
(define (export-palette palette-name color-convertor name-convertor
start name-pre name-after name-color-seperator
color-pre color-after entry-seperator end)
(define (write-color-line index)
(display name-pre)
(display (name-convertor
(car (pika-palette-entry-get-name palette-name index))))
(display name-after)
(display name-color-seperator)
(display color-pre)
(display (color-convertor
(car (pika-palette-entry-get-color palette-name index))))
(display color-after)
)
(let ((color-count (car (pika-palette-get-colors palette-name)))
(i 0)
)
(display start)
(while (< i (- color-count 1))
(begin
(write-color-line i)
(display entry-seperator)
(set! i (+ 1 i))
)
)
(write-color-line i)
(display end)
)
)
(define (register-palette-exporter
export-type export-name file-type description author copyright date)
(script-fu-register (string-append "pika-palette-export-" export-type)
export-name
description
author
copyright
date
""
SF-DIRNAME _"Folder for the output file" ""
SF-STRING _"The name of the file to create (if a file with this name already exist, it will be replaced)"
(string-append "palette." file-type)
)
(script-fu-menu-register (string-append "pika-palette-export-" export-type)
"<Palettes>/Export as")
)
(define (bad-file-name)
(pika-message (string-append _"The filename you entered is not a suitable name for a file."
"\n\n"
_"All characters in the name are either white-spaces or characters which can not appear in filenames.")))
; -----------------------------------------------------------------------------
; Exporters
; -----------------------------------------------------------------------------
(define (pika-palette-export-css directory-name file-name)
(let ((valid-name (valid-file-name file-name)))
(if valid-name
(with-output-to-file (string-append
directory-name DIR-SEPARATOR file-name)
(lambda () (export-palette (car (pika-context-get-palette))
color-rgb-to-css
name-alpha-numeric ; name-convertor
"/* Generated with PIKA Palette Export */\n" ; start
"." ; name-pre
"" ; name-after
" { " ; name-color-seperator
"color: " ; color-pre
" }" ; color-after
"\n" ; entry-seperator
"" ; end
)))
(bad-file-name)
)
)
)
(register-palette-exporter "css" _"_CSS stylesheet..." "css"
(string-append _"Export the active palette as a CSS stylesheet with the color entry name as their class name, and the color itself as the color attribute")
"Barak Itkin <lightningismyname@gmail.com>"
"Barak Itkin" "May 15th, 2009")
(define (pika-palette-export-php directory-name file-name)
(let ((valid-name (valid-file-name file-name)))
(if valid-name
(with-output-to-file (string-append
directory-name DIR-SEPARATOR file-name)
(lambda () (export-palette (car (pika-context-get-palette))
color-rgb-to-hexa-decimal
name-standard ; name-convertor
"<?php\n/* Generated with PIKA Palette Export */\n$colors={\n" ; start
"'" ; name-pre
"'" ; name-after
" => " ; name-color-seperator
"'" ; color-pre
"'" ; color-after
",\n" ; entry-seperator
"}\n?>" ; end
)))
(bad-file-name)
)
)
)
(register-palette-exporter "php" _"P_HP dictionary..." "php"
_"Export the active palette as a PHP dictionary (name => color)"
"Barak Itkin <lightningismyname@gmail.com>"
"Barak Itkin" "May 15th, 2009")
(define (pika-palette-export-python directory-name file-name)
(let ((valid-name (valid-file-name file-name)))
(if valid-name
(with-output-to-file (string-append
directory-name DIR-SEPARATOR file-name)
(lambda ()
(let ((palette-name (car (pika-context-get-palette))))
(begin (displayln "# Generated with PIKA Palette Export")
(displayln (string-append
"# Based on the palette " palette-name))
(export-palette palette-name
color-rgb-to-hexa-decimal
name-standard ; name-convertor
"colors={\n" ; start
"'" ; name-pre
"'" ; name-after
": " ; name-color-seperator
"'" ; color-pre
"'" ; color-after
",\n" ; entry-seperator
"}" ; end
))))
)
(bad-file-name)
)
)
)
(register-palette-exporter "python" _"_Python dictionary..." "py"
_"Export the active palette as a Python dictionary (name: color)"
"Barak Itkin <lightningismyname@gmail.com>"
"Barak Itkin" "May 15th, 2009")
(define (pika-palette-export-text directory-name file-name)
(let ((valid-name (valid-file-name file-name)))
(if valid-name
(with-output-to-file (string-append
directory-name DIR-SEPARATOR file-name)
(lambda ()
(export-palette (car (pika-context-get-palette))
color-rgb-to-hexa-decimal
name-none ; name-convertor
"" ; start
"" ; name-pre
"" ; name-after
"" ; name-color-seperator
"" ; color-pre
"" ; color-after
"\n" ; entry-seperator
"" ; end
)
)
)
(bad-file-name)
)
)
)
(register-palette-exporter "text" _"_Text file..." "txt"
_"Write all the colors in a palette to a text file, one hexadecimal value per line (no names)"
"Barak Itkin <lightningismyname@gmail.com>"
"Barak Itkin" "May 15th, 2009")
(define (pika-palette-export-java directory-name file-name)
(let ((valid-name (valid-file-name file-name)))
(if valid-name
(with-output-to-file (string-append directory-name
DIR-SEPARATOR file-name)
(lambda ()
(let ((palette-name (car (pika-context-get-palette))))
(begin (displayln "")
(displayln "import java.awt.Color;")
(displayln "import java.util.Hashtable;")
(displayln "")
(displayln "// Generated with PIKA palette Export ")
(displayln (string-append
"// Based on the palette " palette-name))
(displayln (string-append
"public class "
(name-standard palette-name) " {"))
(displayln "")
(displayln " Hashtable<String, Color> colors;")
(displayln "")
(displayln (string-append
" public "
(name-standard palette-name) "() {"))
(export-palette (car (pika-context-get-palette))
color-rgb-to-comma-separated-list
name-no-conversion
" colors = new Hashtable<String,Color>();\n" ; start
" colors.put(\"" ; name-pre
"\"" ; name-after
", " ; name-color-seperator
"new Color" ; color-pre
");" ; color-after
"\n" ; entry-seperator
"\n }" ; end
)
(display "\n}"))))
)
(bad-file-name)
)
)
)
(register-palette-exporter "java" _"J_ava map..." "java"
_"Export the active palette as a java.util.Hashtable&lt;String,Color&gt;"
"Barak Itkin <lightningismyname@gmail.com>"
"Barak Itkin" "May 15th, 2009")

76
plug-ins/script-fu/scripts/paste-as-brush.scm Normal file
View File

@ -0,0 +1,76 @@
; PIKA - Photo and Image Kooker Application
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
;
; script-fu-paste-as-brush
; Based on select-to-brush by Copyright (c) 1997 Adrian Likins
;
; 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/>.
(define (script-fu-paste-as-brush name filename spacing)
(let* ((brush-image (car (pika-edit-paste-as-new-image)))
(brush-draw 0)
(type 0)
(path 0))
(if (= TRUE (car (pika-image-is-valid brush-image)))
(begin
(set! brush-draw (aref (cadr (pika-image-get-selected-drawables brush-image)) 0))
(set! type (car (pika-drawable-type brush-draw)))
(set! path (string-append pika-directory
"/brushes/"
filename
(number->string brush-image)
".gbr"))
(if (= type GRAYA-IMAGE)
(begin
(pika-context-push)
(pika-context-set-background '(255 255 255))
(set! brush-draw (car (pika-image-flatten brush-image)))
(pika-context-pop)
)
)
(file-gbr-save RUN-NONINTERACTIVE
brush-image
1 (vector brush-draw)
path
spacing name)
(pika-image-delete brush-image)
(pika-brushes-refresh)
(pika-context-set-brush name)
)
(pika-message _"There is no image data in the clipboard to paste.")
)
)
)
(script-fu-register "script-fu-paste-as-brush"
_"Paste as New _Brush..."
_"Paste the clipboard contents into a new brush"
"Michael Natterer <mitch@gimp.org>"
"Michael Natterer"
"2005-09-25"
""
SF-STRING _"_Brush name" "My Brush"
SF-STRING _"_File name" "mybrush"
SF-ADJUSTMENT _"_Spacing" '(25 0 1000 1 2 1 0)
)
(script-fu-menu-register "script-fu-paste-as-brush"
"<Image>/Edit/Paste as")

63
plug-ins/script-fu/scripts/paste-as-pattern.scm Normal file
View File

@ -0,0 +1,63 @@
; PIKA - Photo and Image Kooker Application
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
;
; script-fu-paste-as-pattern
; Based on select-to-pattern by Cameron Gregory, http://www.flamingtext.com/
;
; 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/>.
(define (script-fu-paste-as-pattern name filename)
(let* ((pattern-image (car (pika-edit-paste-as-new-image)))
(pattern-draw 0)
(path 0))
(if (= TRUE (car (pika-image-is-valid pattern-image)))
(begin
(set! pattern-draw (aref (cadr (pika-image-get-selected-drawables pattern-image)) 0))
(set! path (string-append pika-directory
"/patterns/"
filename
(number->string pattern-image)
".pat"))
(file-pat-save RUN-NONINTERACTIVE
pattern-image
1 (vector pattern-draw)
path
name)
(pika-image-delete pattern-image)
(pika-patterns-refresh)
(pika-context-set-pattern name)
)
(pika-message _"There is no image data in the clipboard to paste.")
)
)
)
(script-fu-register "script-fu-paste-as-pattern"
_"Paste as New _Pattern..."
_"Paste the clipboard contents into a new pattern"
"Michael Natterer <mitch@gimp.org>"
"Michael Natterer"
"2005-09-25"
""
SF-STRING _"_Pattern name" "My Pattern"
SF-STRING _"_File name" "mypattern"
)
(script-fu-menu-register "script-fu-paste-as-pattern"
"<Image>/Edit/Paste as")

216
plug-ins/script-fu/scripts/perspective-shadow.scm Normal file
View File

@ -0,0 +1,216 @@
; PIKA - Photo and Image Kooker Application
; 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/>.
;
;
; perspective-shadow.scm version 1.2 2000/11/08
;
; Copyright (C) 1997-2000 Sven Neumann <sven@gimp.org>
;
;
; Adds a perspective shadow of the current selection or alpha-channel
; as a layer below the active layer
;
(define (script-fu-perspective-shadow image
drawable
alpha
rel-distance
rel-length
shadow-blur
shadow-color
shadow-opacity
interpolation
allow-resize)
(let* (
(shadow-blur (max shadow-blur 0))
(shadow-opacity (min shadow-opacity 100))
(shadow-opacity (max shadow-opacity 0))
(rel-length (abs rel-length))
(alpha (* (/ alpha 180) *pi*))
(type (car (pika-drawable-type-with-alpha drawable)))
(image-width (car (pika-image-get-width image)))
(image-height (car (pika-image-get-height image)))
(from-selection 0)
(active-selection 0)
(shadow-layer 0)
)
(pika-context-push)
(pika-context-set-defaults)
(if (> rel-distance 24) (set! rel-distance 999999))
(if (= rel-distance rel-length) (set! rel-distance (+ rel-distance 0.01)))
(pika-image-undo-group-start image)
(pika-layer-add-alpha drawable)
(if (= (car (pika-selection-is-empty image)) TRUE)
(begin
(pika-image-select-item image CHANNEL-OP-REPLACE drawable)
(set! from-selection FALSE))
(begin
(set! from-selection TRUE)
(set! active-selection (car (pika-selection-save image)))))
(let* ((selection-bounds (pika-selection-bounds image))
(select-offset-x (cadr selection-bounds))
(select-offset-y (caddr selection-bounds))
(select-width (- (cadr (cddr selection-bounds)) select-offset-x))
(select-height (- (caddr (cddr selection-bounds)) select-offset-y))
(abs-length (* rel-length select-height))
(abs-distance (* rel-distance select-height))
(half-bottom-width (/ select-width 2))
(half-top-width (* half-bottom-width
(/ (- rel-distance rel-length) rel-distance)))
(x0 (+ select-offset-x (+ (- half-bottom-width half-top-width)
(* (cos alpha) abs-length))))
(y0 (+ select-offset-y (- select-height
(* (sin alpha) abs-length))))
(x1 (+ x0 (* 2 half-top-width)))
(y1 y0)
(x2 select-offset-x)
(y2 (+ select-offset-y select-height))
(x3 (+ x2 select-width))
(y3 y2)
(shadow-width (+ (- (max x1 x3) (min x0 x2)) (* 2 shadow-blur)))
(shadow-height (+ (- (max y1 y3) (min y0 y2)) (* 2 shadow-blur)))
(shadow-offset-x (- (min x0 x2) shadow-blur))
(shadow-offset-y (- (min y0 y2) shadow-blur)))
(set! shadow-layer (car (pika-layer-new image
select-width
select-height
type
"Perspective Shadow"
shadow-opacity
LAYER-MODE-NORMAL)))
(pika-image-insert-layer image shadow-layer 0 -1)
(pika-layer-set-offsets shadow-layer select-offset-x select-offset-y)
(pika-drawable-fill shadow-layer FILL-TRANSPARENT)
(pika-context-set-background shadow-color)
(pika-drawable-edit-fill shadow-layer FILL-BACKGROUND)
(pika-selection-none image)
(if (= allow-resize TRUE)
(let* ((new-image-width image-width)
(new-image-height image-height)
(image-offset-x 0)
(image-offset-y 0))
(if (< shadow-offset-x 0)
(begin
(set! image-offset-x (abs shadow-offset-x))
(set! new-image-width (+ new-image-width image-offset-x))
; adjust to new coordinate system
(set! x0 (+ x0 image-offset-x))
(set! x1 (+ x1 image-offset-x))
(set! x2 (+ x2 image-offset-x))
(set! x3 (+ x3 image-offset-x))
))
(if (< shadow-offset-y 0)
(begin
(set! image-offset-y (abs shadow-offset-y))
(set! new-image-height (+ new-image-height image-offset-y))
; adjust to new coordinate system
(set! y0 (+ y0 image-offset-y))
(set! y1 (+ y1 image-offset-y))
(set! y2 (+ y2 image-offset-y))
(set! y3 (+ y3 image-offset-y))
))
(if (> (+ shadow-width shadow-offset-x) new-image-width)
(set! new-image-width (+ shadow-width shadow-offset-x)))
(if (> (+ shadow-height shadow-offset-y) new-image-height)
(set! new-image-height (+ shadow-height shadow-offset-y)))
(pika-image-resize image
new-image-width
new-image-height
image-offset-x
image-offset-y)))
(pika-context-set-transform-direction TRANSFORM-FORWARD)
(pika-context-set-interpolation interpolation)
(pika-context-set-transform-resize TRANSFORM-RESIZE-ADJUST)
(pika-item-transform-perspective shadow-layer
x0 y0
x1 y1
x2 y2
x3 y3)
(if (>= shadow-blur 1.0)
(begin
(pika-layer-set-lock-alpha shadow-layer FALSE)
(pika-layer-resize shadow-layer
shadow-width
shadow-height
shadow-blur
shadow-blur)
(plug-in-gauss-rle RUN-NONINTERACTIVE
image
shadow-layer
shadow-blur
TRUE
TRUE))))
(if (= from-selection TRUE)
(begin
(pika-image-select-item image CHANNEL-OP-REPLACE active-selection)
(pika-drawable-edit-clear shadow-layer)
(pika-image-remove-channel image active-selection)))
(if (and
(= (car (pika-layer-is-floating-sel drawable)) 0)
(= from-selection FALSE))
(pika-image-raise-item image drawable))
(pika-image-set-selected-layers image 1 (vector drawable))
(pika-image-undo-group-end image)
(pika-displays-flush)
(pika-context-pop)
)
)
(script-fu-register "script-fu-perspective-shadow"
_"_Perspective..."
_"Add a perspective shadow to the selected region (or alpha)"
"Sven Neumann <sven@gimp.org>"
"Sven Neumann"
"2000/11/08"
"RGB* GRAY*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-ADJUSTMENT _"Angle" '(45 0 180 1 10 1 0)
SF-ADJUSTMENT _"Relative distance of horizon" '(5 0.1 24.1 0.1 1 1 1)
SF-ADJUSTMENT _"Relative length of shadow" '(1 0.1 24 0.1 1 1 1)
SF-ADJUSTMENT _"Blur radius" '(3 0 1024 1 10 0 0)
SF-COLOR _"Color" '(0 0 0)
SF-ADJUSTMENT _"Opacity" '(80 0 100 1 10 0 0)
SF-ENUM _"Interpolation" '("InterpolationType" "linear")
SF-TOGGLE _"Allow resizing" FALSE
)
(script-fu-menu-register "script-fu-perspective-shadow"
"<Image>/Filters/Light and Shadow/[Shadow]")

276
plug-ins/script-fu/scripts/pika-online.scm Normal file
View File

@ -0,0 +1,276 @@
; PIKA - Photo and Image Kooker Application
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
;
; pika-online.scm
; Copyright (C) 2003 Henrik Brix Andersen <brix@gimp.org>
;
; 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/>.
(define (pika-online-docs-web-site)
(plug-in-web-browser "https://docs.pika.org/")
)
(define (pika-help-main)
(pika-help "" "pika-main")
)
(define (pika-help-concepts-usage)
(pika-help "" "pika-concepts-usage")
)
(define (pika-help-using-docks)
(pika-help "" "pika-concepts-docks")
)
(define (pika-help-using-simpleobjects)
(pika-help "" "pika-using-simpleobjects")
)
(define (pika-help-using-selections)
(pika-help "" "pika-using-selections")
)
(define (pika-help-using-fileformats)
(pika-help "" "pika-using-fileformats")
)
(define (pika-help-using-photography)
(pika-help "" "pika-using-photography")
)
(define (pika-help-using-web)
(pika-help "" "pika-using-web")
)
(define (pika-help-concepts-paths)
(pika-help "" "pika-concepts-paths")
)
; shortcuts to help topics
(script-fu-register "pika-help-concepts-paths"
_"Using _Paths"
_"Bookmark to the user manual"
"Roman Joost <romanofski@gimp.org>"
"Roman Joost <romanofski@gimp.org>"
"2006"
""
)
(script-fu-menu-register "pika-help-concepts-paths"
"<Image>/Help/User Manual")
(script-fu-register "pika-help-using-web"
_"_Preparing your Images for the Web"
_"Bookmark to the user manual"
"Roman Joost <romanofski@gimp.org>"
"Roman Joost <romanofski@gimp.org>"
"2006"
""
)
(script-fu-menu-register "pika-help-using-web"
"<Image>/Help/User Manual")
(script-fu-register "pika-help-using-photography"
_"_Working with Digital Camera Photos"
_"Bookmark to the user manual"
"Roman Joost <romanofski@gimp.org>"
"Roman Joost <romanofski@gimp.org>"
"2006"
""
)
(script-fu-menu-register "pika-help-using-photography"
"<Image>/Help/User Manual")
(script-fu-register "pika-help-using-fileformats"
_"Create, Open and Save _Files"
_"Bookmark to the user manual"
"Roman Joost <romanofski@gimp.org>"
"Roman Joost <romanofski@gimp.org>"
"2006"
""
)
(script-fu-menu-register "pika-help-using-fileformats"
"<Image>/Help/User Manual")
(script-fu-register "pika-help-concepts-usage"
_"_Basic Concepts"
_"Bookmark to the user manual"
"Roman Joost <romanofski@gimp.org>"
"Roman Joost <romanofski@gimp.org>"
"2006"
""
)
(script-fu-menu-register "pika-help-concepts-usage"
"<Image>/Help/User Manual")
(script-fu-register "pika-help-using-docks"
_"How to Use _Dialogs"
_"Bookmark to the user manual"
"Roman Joost <romanofski@gimp.org>"
"Roman Joost <romanofski@gimp.org>"
"2006"
""
)
(script-fu-menu-register "pika-help-using-docks"
"<Image>/Help/User Manual")
(script-fu-register "pika-help-using-simpleobjects"
_"Drawing _Simple Objects"
_"Bookmark to the user manual"
"Roman Joost <romanofski@gimp.org>"
"Roman Joost <romanofski@gimp.org>"
"2006"
""
)
(script-fu-menu-register "pika-help-using-simpleobjects"
"<Image>/Help/User Manual")
(script-fu-register "pika-help-using-selections"
_"Create and Use _Selections"
_"Bookmark to the user manual"
"Roman Joost <romanofski@gimp.org>"
"Roman Joost <romanofski@gimp.org>"
"2006"
""
)
(script-fu-menu-register "pika-help-using-simpleobjects"
"<Image>/Help/User Manual")
(script-fu-register "pika-help-main"
_"_[Table of Contents]"
_"Bookmark to the user manual"
"Alx Sa"
"Alx Sa"
"2023"
""
)
(script-fu-menu-register "pika-help-main"
"<Image>/Help/User Manual")
;; Links to PIKA related web sites
(define (pika-online-main-web-site)
(plug-in-web-browser "https://heckin.technology/AlderconeStudio/PIKApp/")
)
(define (pika-online-developer-web-site)
(plug-in-web-browser "https://developer.pika.org/")
)
(define (pika-online-roadmap)
(plug-in-web-browser "https://developer.pika.org/core/roadmap/")
)
(define (pika-online-bugs-features)
(plug-in-web-browser "https://gitlab.gnome.org/GNOME/pika/issues")
)
; (define (pika-online-plug-in-web-site)
; (plug-in-web-browser "https://registry.pika.org/")
; )
(script-fu-register "pika-online-main-web-site"
_"_Main Web Site"
_"Bookmark to the PIKA web site"
"Henrik Brix Andersen <brix@gimp.org>"
"Henrik Brix Andersen <brix@gimp.org>"
"2003"
""
)
(script-fu-menu-register "pika-online-main-web-site"
"<Image>/Help/PIKA Online")
(script-fu-register "pika-online-developer-web-site"
_"_Developer Web Site"
_"Bookmark to the PIKA web site"
"Henrik Brix Andersen <brix@gimp.org>"
"Henrik Brix Andersen <brix@gimp.org>"
"2003"
""
)
(script-fu-menu-register "pika-online-developer-web-site"
"<Image>/Help/PIKA Online")
(script-fu-register "pika-online-roadmap"
_"_Roadmaps"
_"Bookmark to the roadmaps of PIKA"
"Alexandre Prokoudine <alexandre.prokoudine@gmail.com>"
"Alexandre Prokoudine <alexandre.prokoudine@gmail.com>"
"2018"
""
)
(script-fu-menu-register "pika-online-roadmap"
"<Image>/Help/PIKA Online")
(script-fu-register "pika-online-bugs-features"
_"_Bug Reports and Feature Requests"
_"Bookmark to the bug tracker of PIKA"
"Alexandre Prokoudine <alexandre.prokoudine@gmail.com>"
"Alexandre Prokoudine <alexandre.prokoudine@gmail.com>"
"2018"
""
)
(script-fu-menu-register "pika-online-bugs-features"
"<Image>/Help/PIKA Online")
(script-fu-register "pika-online-docs-web-site"
_"_User Manual Web Site"
_"Bookmark to the PIKA web site"
"Roman Joost <romanofski@gimp.org>"
"Roman Joost <romanofski@gimp.org>"
"2006"
""
)
(script-fu-menu-register "pika-online-docs-web-site"
"<Image>/Help/PIKA Online")
; (script-fu-register "pika-online-plug-in-web-site"
; _"Plug-in _Registry"
; _"Bookmark to the PIKA web site"
; "Henrik Brix Andersen <brix@gimp.org>"
; "Henrik Brix Andersen <brix@gimp.org>"
; "2003"
; ""
; )
; (script-fu-menu-register "pika-online-plug-in-web-site"
; "<Image>/Help/PIKA Online")

37
plug-ins/script-fu/scripts/plug-in-compat.init Normal file
View File

@ -0,0 +1,37 @@
; The Scheme code in this file provides some compatibility with
; scripts that were originally written for use with older versions of
; PIKA.
;
; It provides PDB procedures that used to be provided by plug-ins that
; were since then removed from the PIKA distribution. You should not
; use these in newly written scripts as the functions defined here may
; be removed at some later date.
(define (plug-in-color-map run-mode img layer
src-color-1 src-color-2 dest-color-1 dest-color-2
map-mode)
(pika-levels layer HISTOGRAM-RED
(car src-color-1) (car src-color-2) 1.0
(- 255 (car dest-color-1)) (- 255 (car dest-color-2)))
(pika-levels layer HISTOGRAM-GREEN
(cadr src-color-1) (cadr src-color-2) 1.0
(- 255 (cadr dest-color-1)) (- 255 (cadr dest-color-2)))
(pika-levels layer HISTOGRAM-BLUE
(caddr src-color-1) (caddr src-color-2) 1.0
(- 255 (caddr dest-color-1)) (- 255 (caddr dest-color-2)))
(pika-levels layer HISTOGRAM-VALUE 0 255 1.0 255 0)
)
; since 3.0 a layer selection can be many,
; so PDB methods to get selections return an int and a GObjectArray,
; which in Scheme is a list containing a numeric and a vector.
; and the word "active" changed to "selected".
; Formerly, such PDB methods returned a list of one element, the ID of a layer.
; A compatible replacement for pika-image-get-active-layer.
; This should be used only when you know the image has only one layer.
; In other situations, you may break a contract to process all selected layers.
(define (pika-image-get-active-layer img)
(list (aref (cadr (pika-image-get-selected-layers img)) 0))
)

53
plug-ins/script-fu/scripts/reverse-layers.scm Normal file
View File

@ -0,0 +1,53 @@
; reverse-layers.scm: Reverse the order of layers in the current image.
; Copyright (C) 2006 by Akkana Peck.
;
; 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/>.
(define (script-fu-reverse-layers img drawable)
(let* (
(layers (pika-image-get-layers img))
(num-layers (car layers))
(layer-array (cadr layers))
(i (- num-layers 1))
)
(pika-image-undo-group-start img)
(while (>= i 0)
(let ((layer (aref layer-array i)))
(if (= (car (pika-layer-is-floating-sel layer)) FALSE)
(pika-image-lower-item-to-bottom img layer))
)
(set! i (- i 1))
)
(pika-image-undo-group-end img)
(pika-displays-flush)
)
)
(script-fu-register "script-fu-reverse-layers"
_"Reverse Layer _Order"
_"Reverse the order of layers in the image"
"Akkana Peck"
"Akkana Peck"
"August 2006"
"*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
)
(script-fu-menu-register "script-fu-reverse-layers"
"<Image>/Layer/Stack")

83
plug-ins/script-fu/scripts/ripply-anim.scm Normal file
View File

@ -0,0 +1,83 @@
; "Rippling Image" animation generator (ripply-anim.scm)
; Adam D. Moss (adam@foxbox.org)
; 97/05/18
; Revised by Saul Goode April 2015.
;
; Designed to be used in conjunction with a plugin capable
; of saving animations (i.e. the GIF plugin).
;
(define (script-fu-ripply-anim image drawable displacement num-frames edge-type)
(let* ((width (car (pika-drawable-get-width drawable)))
(height (car (pika-drawable-get-height drawable)))
(work-image (car (pika-image-new width
height
(quotient (car (pika-drawable-type drawable))
2))))
(map-layer (car (pika-layer-new work-image
width
height
(car (pika-drawable-type drawable))
"Ripple Map"
100
LAYER-MODE-NORMAL))))
(pika-context-push)
(pika-context-set-paint-mode LAYER-MODE-NORMAL)
(pika-context-set-opacity 100.0)
(pika-image-undo-disable work-image)
; Create a tile-able displacement map in the first layer
(pika-context-set-background '(127 127 127))
(pika-image-insert-layer work-image map-layer 0 0)
(pika-drawable-edit-fill map-layer FILL-BACKGROUND)
(plug-in-noisify RUN-NONINTERACTIVE work-image map-layer FALSE 1.0 1.0 1.0 0.0)
(plug-in-tile RUN-NONINTERACTIVE work-image 1 (vector map-layer) (* width 3) (* height 3) FALSE)
(plug-in-gauss-iir RUN-NONINTERACTIVE work-image map-layer 35 TRUE TRUE)
(pika-drawable-equalize map-layer TRUE)
(plug-in-gauss-rle RUN-NONINTERACTIVE work-image map-layer 5 TRUE TRUE)
(pika-drawable-equalize map-layer TRUE)
(pika-image-crop work-image width height width height)
; Create the frame layers
(let loop ((remaining-frames num-frames))
(unless (zero? remaining-frames)
(let ((frame-layer (car (pika-layer-new-from-drawable drawable work-image))))
(pika-image-insert-layer work-image frame-layer 0 0)
(pika-item-set-name frame-layer
(string-append "Frame "
(number->string (+ 1 (- num-frames
remaining-frames)))
" (replace)"))
(plug-in-displace RUN-NONINTERACTIVE work-image frame-layer
displacement displacement
TRUE TRUE map-layer map-layer (+ edge-type 1))
(pika-item-set-visible frame-layer TRUE))
(pika-drawable-offset map-layer
TRUE
OFFSET-BACKGROUND
(/ width num-frames)
(/ height num-frames))
(loop (- remaining-frames 1))))
(pika-image-remove-layer work-image map-layer)
(pika-image-undo-enable work-image)
(pika-display-new work-image)
(pika-context-pop)))
(script-fu-register "script-fu-ripply-anim"
_"_Rippling..."
_"Create a multi-layer image by adding a ripple effect to the current layer"
"Adam D. Moss (adam@foxbox.org), Saul Goode"
"Adam D. Moss, Saul Goode"
"1997, 2015"
"RGB* GRAY*"
SF-IMAGE "Image to animage" 0
SF-DRAWABLE "Drawable to animate" 0
SF-ADJUSTMENT _"Rippling strength" '(3 0 256 1 10 1 0)
SF-ADJUSTMENT _"Number of frames" '(15 0 256 1 10 0 1)
SF-OPTION _"Edge behavior" '(_"Wrap" _"Smear" _"Black")
)
(script-fu-menu-register "script-fu-ripply-anim"
"<Image>/Filters/Animation/")

149
plug-ins/script-fu/scripts/round-corners.scm Normal file
View File

@ -0,0 +1,149 @@
; PIKA - Photo and Image Kooker Application
; 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 (pika-image-get-width img)))
(height (car (pika-image-get-height img)))
(image (cond ((= work-on-copy TRUE)
(car (pika-image-duplicate img)))
((= work-on-copy FALSE)
img)))
; active drawable is not necessarily the active layer
(pic-layer (aref (cadr (pika-image-get-selected-layers image)) 0))
(type (car (pika-drawable-type-with-alpha pic-layer)))
)
(pika-context-push)
(pika-context-set-defaults)
(if (= work-on-copy TRUE)
(pika-image-undo-disable image)
(pika-image-undo-group-start image)
)
; add an alpha channel to the image
(pika-layer-add-alpha pic-layer)
; round the edges
(pika-selection-none image)
(pika-image-select-rectangle image CHANNEL-OP-ADD 0 0 radius radius)
(pika-image-select-ellipse image CHANNEL-OP-SUBTRACT 0 0 diam diam)
(pika-image-select-rectangle image CHANNEL-OP-ADD (- width radius) 0 radius radius)
(pika-image-select-ellipse image CHANNEL-OP-SUBTRACT (- width diam) 0 diam diam)
(pika-image-select-rectangle image CHANNEL-OP-ADD 0 (- height radius) radius radius)
(pika-image-select-ellipse image CHANNEL-OP-SUBTRACT 0 (- height diam) diam diam)
(pika-image-select-rectangle image CHANNEL-OP-ADD (- width radius) (- height radius)
radius radius)
(pika-image-select-ellipse image CHANNEL-OP-SUBTRACT (- width diam) (- height diam)
diam diam)
(pika-drawable-edit-clear pic-layer)
(pika-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 (pika-image-get-width image)))
(set! height (car (pika-image-get-height image)))))
; optionally add a background
(if (= background-toggle TRUE)
(let* ((bg-layer (car (pika-layer-new image
width
height
type
"Background"
100
LAYER-MODE-NORMAL))))
(pika-drawable-fill bg-layer FILL-BACKGROUND)
(pika-image-insert-layer image bg-layer 0 -1)
(pika-image-raise-item image pic-layer)
(if (= shadow-toggle TRUE)
(pika-image-lower-item image bg-layer))))
; clean up after the script
(if (= work-on-copy TRUE)
(pika-image-undo-enable image)
(pika-image-undo-group-end image)
)
(if (= work-on-copy TRUE)
(pika-display-new image))
(pika-context-pop)
(pika-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")

457
plug-ins/script-fu/scripts/script-fu-compat.init Normal file
View File

@ -0,0 +1,457 @@
;The Scheme code in this file provides some compatibility with scripts that
;were originally written for use with the older SIOD based Script-Fu plug-in
;of PIKA.
;
;All items defined in this file except for the random number routines are
;deprecated. Existing scripts should be updated to avoid the use of the
;compatibility functions and define statements which follow the random number
;generator routines.
;
;The items marked as deprecated at the end of this file may be removed
;at some later date.
;The random number generator routines below have been slightly reformatted.
;A couple of define blocks which are not needed have been commented out.
;It has also been extended to enable it to generate numbers with exactly 31
;bits or more.
;The original file was called rand2.scm and can be found in:
;http://www-2.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/scheme/code/math/random/
; Minimal Standard Random Number Generator
; Park & Miller, CACM 31(10), Oct 1988, 32 bit integer version.
; better constants, as proposed by Park.
; By Ozan Yigit
;(define *seed* 1)
(define (srand seed)
(set! *seed* seed)
*seed*
)
(define (msrg-rand)
(let (
(A 48271)
(M 2147483647)
(Q 44488)
(R 3399)
)
(let* (
(hi (quotient *seed* Q))
(lo (modulo *seed* Q))
(test (- (* A lo) (* R hi)))
)
(if (> test 0)
(set! *seed* test)
(set! *seed* (+ test M))
)
)
)
*seed*
)
; poker test
; seed 1
; cards 0-9 inclusive (random 10)
; five cards per hand
; 10000 hands
;
; Poker Hand Example Probability Calculated
; 5 of a kind (aaaaa) 0.0001 0
; 4 of a kind (aaaab) 0.0045 0.0053
; Full house (aaabb) 0.009 0.0093
; 3 of a kind (aaabc) 0.072 0.0682
; two pairs (aabbc) 0.108 0.1104
; Pair (aabcd) 0.504 0.501
; Bust (abcde) 0.3024 0.3058
(define (random n)
(define (internal-random n)
(let* (
(n (inexact->exact (truncate n)))
(M 2147483647)
(slop (modulo M (abs n)))
)
(let loop ((r (msrg-rand)))
(if (>= r slop)
(modulo r n)
(loop (msrg-rand))
)
)
)
)
; Negative numbers have a bigger range in twos complement platforms
; (nearly all platforms out there) than positive ones, so we deal with
; the numbers in negative form.
(if (> n 0)
(+ n (random (- n)))
(if (>= n -2147483647)
(internal-random n)
; 31-or-more-bits number requested - needs multiple extractions
; because we don't generate enough random bits.
(if (>= n -1152921504606846975)
; Up to 2^60-1, two extractions are enough
(let ((q (- (quotient (+ n 1) 1073741824) 1))) ; q=floor(n/2^30)
(let loop ()
(let ((big (+ (* (internal-random q) 1073741824)
(internal-random -1073741824)
)
))
(if (> big n)
big
(loop)
)
)
)
)
; From 2^60 up, we do three extractions.
; The code is better understood if seen as generating three
; digits in base 2^30. q is the maximum value the first digit
; can take. The other digits can take the full range.
;
; The strategy is to generate a random number digit by digit.
; Here's an example in base 10. Say the input n is 348
; (thus requesting a number between 0 and 347). Then the algorithm
; first calls (internal-random 4) to get a digit between 0 and 3,
; then (internal-random 10) twice to get two more digits between
; 0 and 9. Say the result is 366: since it is greater than 347,
; it's discarded and the process restarted. When the result is
; <= 347, that's the returned value. The probability of it being
; greater than the max is always strictly less than 1/2.
;
; This is the same idea but in base 2^30 (1073741824). The
; first digit's weight is (2^30)^2 = 1152921504606846976,
; similarly to how in our base 10 example, the first digit's
; weight is 10^2 = 100. In the base 10 example we first divide
; the target number 348 by 100, taking the ceiling, to get 4.
; Here we divide by (2^30)^2 instead, taking the ceiling too.
;
; The math is a bit obscured by the fact that we generate
; the digits as negative, so that the result is negative as
; well, but it's really the same thing. Changing the sign of
; every digit just changes the sign of the result.
;
; This method works for n up to (2^30)^2*(2^31-1) which is
; 2475880077417839045191401472 (slightly under 91 bits). That
; covers the 64-bit range comfortably, and some more. If larger
; numbers are needed, they'll have to be composed with a
; user-defined procedure.
(if (>= n -2475880077417839045191401472)
(let ((q (- (quotient (+ n 1) 1152921504606846976) 1))) ; q=floor(n/2^60)
(let loop ()
(let ((big (+ (* (internal-random q) 1152921504606846976)
(* (internal-random -1073741824) 1073741824)
(internal-random -1073741824)
)
))
(if (> big n)
big
(loop)
)
)
)
)
(error "requested (random n) range too large")
)
)
)
)
)
;(define (rngtest)
; (display "implementation ")
; (srand 1)
; (do
; ( (n 0 (+ n 1)) )
; ( (>= n 10000) )
; (msrg-rand)
; )
; (if (= *seed* 399268537)
; (display "looks correct.")
; (begin
; (display "failed.")
; (newline)
; (display " current seed ") (display *seed*)
; (newline)
; (display " correct seed 399268537")
; )
; )
; (newline)
;)
;This macro defines a while loop which is needed by some older scripts.
;This is here since it is not defined in R5RS and could be handy to have.
;This while macro was found at:
;http://www.aracnet.com/~briand/scheme_eval.html
(define-macro (while test . body)
`(let loop ()
(cond
(,test
,@body
(loop)
)
)
)
)
;The following define block(s) require the tsx extension to be loaded
(define (realtime)
(car (gettimeofday))
)
;Items below this line are for compatibility with Script-Fu but
;may be useful enough to keep around
(define (delq item lis)
(let ((l '()))
(unless (null? lis)
(while (pair? lis)
(if (<> item (car lis))
(set! l (append l (list (car lis))))
)
(set! lis (cdr lis))
)
)
l
)
)
(define (make-list count fill)
(vector->list (make-vector count fill))
)
(define (strbreakup str sep)
(let* (
(seplen (string-length sep))
(start 0)
(end (string-length str))
(i start)
(l '())
)
(if (= seplen 0)
(set! l (list str))
(begin
(while (<= i (- end seplen))
(if (substring-equal? sep str i (+ i seplen))
(begin
(if (= start 0)
(set! l (list (substring str start i)))
(set! l (append l (list (substring str start i))))
)
(set! start (+ i seplen))
(set! i (+ i seplen -1))
)
)
(set! i (+ i 1))
)
(set! l (append l (list (substring str start end))))
)
)
l
)
)
(define (string-downcase str)
(list->string (map char-downcase (string->list str)))
)
(define (string-trim str)
(string-trim-right (string-trim-left str))
)
(define (string-trim-left str)
(let (
(strlen (string-length str))
(i 0)
)
(while (and (< i strlen)
(char-whitespace? (string-ref str i))
)
(set! i (+ i 1))
)
(substring str i (string-length str))
)
)
(define (string-trim-right str)
(let ((i (- (string-length str) 1)))
(while (and (>= i 0)
(char-whitespace? (string-ref str i))
)
(set! i (- i 1))
)
(substring str 0 (+ i 1))
)
)
(define (string-upcase str)
(list->string (map char-upcase (string->list str)))
)
(define (substring-equal? str str2 start end)
(string=? str (substring str2 start end))
)
(define (unbreakupstr stringlist sep)
(let ((str (car stringlist)))
(set! stringlist (cdr stringlist))
(while (not (null? stringlist))
(set! str (string-append str sep (car stringlist)))
(set! stringlist (cdr stringlist))
)
str
)
)
;Items below this line are deprecated and should not be used in new scripts.
(define aset vector-set!)
(define aref vector-ref)
(define fopen open-input-file)
(define mapcar map)
(define nil '())
(define nreverse reverse)
(define pow expt)
(define prin1 write)
(define (print obj . port)
(apply write obj port)
(newline)
)
(define strcat string-append)
(define string-lessp string<?)
(define symbol-bound? defined?)
(define the-environment current-environment)
(define *pi*
(* 4 (atan 1.0))
)
(define (butlast x)
(if (= (length x) 1)
'()
(reverse (cdr (reverse x)))
)
)
(define (cons-array count type)
(case type
((long) (make-vector count 0))
((short) (make-vector count 0))
((byte) (make-vector count 0))
((double) (make-vector count 0.0))
((string) (vector->list (make-vector count "")))
(else type)
)
)
(define (fmod a b)
(- a (* (truncate (/ a b)) b))
)
(define (fread arg1 file)
(define (fread-get-chars count file)
(let (
(str "")
(c 0)
)
(while (> count 0)
(set! count (- count 1))
(set! c (read-char file))
(if (eof-object? c)
(set! count 0)
(set! str (string-append str (make-string 1 c)))
)
)
(if (eof-object? c)
()
str
)
)
)
(if (number? arg1)
(begin
(set! arg1 (inexact->exact (truncate arg1)))
(fread-get-chars arg1 file)
)
(begin
(set! arg1 (fread-get-chars (string-length arg1) file))
(string-length arg1)
)
)
)
(define (last x)
(cons (car (reverse x)) '())
)
(define (nth k list)
(list-ref list k)
)
(define (prog1 form1 . form2)
(let ((a form1))
(if (not (null? form2))
form2
)
a
)
)
(define (rand . modulus)
(if (null? modulus)
(msrg-rand)
(apply random modulus)
)
)
(define (strcmp str1 str2)
(if (string<? str1 str2)
-1
(if (string>? str1 str2)
1
0
)
)
)
(define (trunc n)
(inexact->exact (truncate n))
)
(define verbose
(lambda n
(if (or (null? n) (not (number? (car n))))
0
(car n)
)
)
)

65
plug-ins/script-fu/scripts/script-fu-set-cmap.scm Normal file
View File

@ -0,0 +1,65 @@
; Set Colormap v1.1 September 29, 2004
; by Kevin Cozens <kcozens@interlog.com>
;
; Change the colormap of an image to the colors in a specified palette.
; Included is script-fu-make-cmap-array (available for use in scripts) which
; returns a GBytes containing the colors from a specified palette.
; This array can be used as the cmap argument for pika-image-set-colormap.
; PIKA - Photo and Image Kooker Application
; 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/>.
(define (script-fu-make-cmap-array palette)
(let* (
(num-colors (car (pika-palette-get-color-count palette)))
; cons-array is not Scheme standard
; but was in SIOD and is in script-fu-compat.init
(cmap (cons-array (* num-colors 3) 'byte))
(color 0)
(i 0)
)
(while (< i num-colors)
(set! color (car (pika-palette-entry-get-color palette i)))
(aset cmap (* i 3) (car color))
(aset cmap (+ (* i 3) 1) (cadr color))
(aset cmap (+ (* i 3) 2) (caddr color))
(set! i (+ i 1))
)
cmap
)
)
(define (script-fu-set-cmap img drawable palette)
(pika-image-set-colormap img
(script-fu-make-cmap-array palette))
(pika-displays-flush)
)
(script-fu-register "script-fu-set-cmap"
_"Se_t Colormap..."
_"Change the colormap of an image to the colors in a specified palette."
"Kevin Cozens <kcozens@interlog.com>"
"Kevin Cozens"
"September 29, 2004"
"INDEXED*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-PALETTE _"Palette" "Default"
)
(script-fu-menu-register "script-fu-set-cmap" "<Image>/Colors/Map/[Colormap]")

20
plug-ins/script-fu/scripts/script-fu-util-setpt.scm Normal file
View File

@ -0,0 +1,20 @@
; PIKA - Photo and Image Kooker Application
; 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/>.
(define (script-fu-set-pt a index x y)
(aset a (* index 2) x)
(aset a (+ (* index 2) 1) y)
)

92
plug-ins/script-fu/scripts/script-fu-util.scm Normal file
View File

@ -0,0 +1,92 @@
; PIKA - Photo and Image Kooker Application
; 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/>.
; Resizes the image so as to include the selected layer.
; The resulting image has the selected layer size.
; Copyright (C) 2002 Chauk-Mean PROUM
;
(define (script-fu-util-image-resize-from-layer image layer)
(let* (
(width (car (pika-drawable-get-width layer)))
(height (car (pika-drawable-get-height layer)))
(posx (- (car (pika-drawable-get-offsets layer))))
(posy (- (cadr (pika-drawable-get-offsets layer))))
)
(pika-image-resize image width height posx posy)
)
)
; Add the specified layers to the image.
; The layers will be added in the given order below the
; active layer.
;
(define (script-fu-util-image-add-layers image . layers)
(while (not (null? layers))
(let ((layer (car layers)))
(set! layers (cdr layers))
(pika-image-insert-layer image layer 0 -1)
(pika-image-lower-item image layer)
)
)
)
; Allow command line usage of PIKA such as:
;
; pika -i -b '(with-files "*.png" <body>)'
;
; where <body> is the code that handles whatever processing you want to
; perform on the files. There are four variables that are available
; within the <body>: 'basename', 'image', 'filename' and 'layer'.
; The 'basename' is the name of the file with its extension removed,
; while the other three variables are self-explanatory.
; You basically write your code as though it were processing a single
; 'image' and the 'with-files' macro applies it to all of the files
; matching the pattern.
;
; For example, to invert the colors of all of the PNG files in the
; start directory:
;
; pika -i -b '(with-files "*.png" (pika-drawable-invert layer FALSE) \
; (pika-file-save 1 image layer filename))'
;
; To do the same thing, but saving them as jpeg instead:
;
; pika -i -b '(with-files "*.png" (pika-drawable-invert layer FALSE) \
; (pika-file-save 1 image layer \
; (string-append basename ".jpg") ))'
(define-macro (with-files pattern . body)
(let ((loop (gensym))
(filenames (gensym))
(filename (gensym)))
`(begin
(let ,loop ((,filenames (cadr (file-glob ,pattern 1))))
(unless (null? ,filenames)
(let* ((filename (car ,filenames))
(image (catch #f (car (pika-file-load RUN-NONINTERACTIVE
filename))))
(layer (if image (aref (cadr (pika-image-get-selected-layers image)) 0) #f))
(basename (unbreakupstr (butlast (strbreakup filename ".")) ".")))
(when image
,@body
(pika-image-delete image)))
(,loop (cdr ,filenames))
)
)
)
)
)

716
plug-ins/script-fu/scripts/script-fu.init Normal file
View File

@ -0,0 +1,716 @@
; Initialization file for TinySCHEME 1.40
; Per R5RS, up to four deep compositions should be defined
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cdar x) (cdr (car x)))
(define (cddr x) (cdr (cdr x)))
(define (caaar x) (car (car (car x))))
(define (caadr x) (car (car (cdr x))))
(define (cadar x) (car (cdr (car x))))
(define (caddr x) (car (cdr (cdr x))))
(define (cdaar x) (cdr (car (car x))))
(define (cdadr x) (cdr (car (cdr x))))
(define (cddar x) (cdr (cdr (car x))))
(define (cdddr x) (cdr (cdr (cdr x))))
(define (caaaar x) (car (car (car (car x)))))
(define (caaadr x) (car (car (car (cdr x)))))
(define (caadar x) (car (car (cdr (car x)))))
(define (caaddr x) (car (car (cdr (cdr x)))))
(define (cadaar x) (car (cdr (car (car x)))))
(define (cadadr x) (car (cdr (car (cdr x)))))
(define (caddar x) (car (cdr (cdr (car x)))))
(define (cadddr x) (car (cdr (cdr (cdr x)))))
(define (cdaaar x) (cdr (car (car (car x)))))
(define (cdaadr x) (cdr (car (car (cdr x)))))
(define (cdadar x) (cdr (car (cdr (car x)))))
(define (cdaddr x) (cdr (car (cdr (cdr x)))))
(define (cddaar x) (cdr (cdr (car (car x)))))
(define (cddadr x) (cdr (cdr (car (cdr x)))))
(define (cdddar x) (cdr (cdr (cdr (car x)))))
(define (cddddr x) (cdr (cdr (cdr (cdr x)))))
;;;; Utility to ease macro creation
(define (macro-expand form)
((eval (get-closure-code (eval (car form)))) form))
(define (macro-expand-all form)
(if (macro? form)
(macro-expand-all (macro-expand form))
form))
(define *compile-hook* macro-expand-all)
(macro (unless form)
`(if (not ,(cadr form)) (begin ,@(cddr form))))
(macro (when form)
`(if ,(cadr form) (begin ,@(cddr form))))
; DEFINE-MACRO Contributed by Andy Gaynor
(macro (define-macro dform)
(if (symbol? (cadr dform))
`(macro ,@(cdr dform))
(let ((form (gensym)))
`(macro (,(caadr dform) ,form)
(apply (lambda ,(cdadr dform) ,@(cddr dform)) (cdr ,form))))))
; Utilities for math. Notice that inexact->exact is primitive,
; but exact->inexact is not.
(define exact? integer?)
(define (inexact? x) (and (real? x) (not (integer? x))))
(define (even? n) (= (remainder n 2) 0))
(define (odd? n) (not (= (remainder n 2) 0)))
(define (zero? n) (= n 0))
(define (positive? n) (> n 0))
(define (negative? n) (< n 0))
(define complex? number?)
(define rational? real?)
(define (abs n) (if (>= n 0) n (- n)))
(define (exact->inexact n) (* n 1.0))
(define (<> n1 n2) (not (= n1 n2)))
; min and max must return inexact if any arg is inexact; use (+ n 0.0)
(define (max . lst)
(foldr (lambda (a b)
(if (> a b)
(if (exact? b) a (+ a 0.0))
(if (exact? a) b (+ b 0.0))))
(car lst) (cdr lst)))
(define (min . lst)
(foldr (lambda (a b)
(if (< a b)
(if (exact? b) a (+ a 0.0))
(if (exact? a) b (+ b 0.0))))
(car lst) (cdr lst)))
(define (succ x) (+ x 1))
(define (pred x) (- x 1))
(define gcd
(lambda a
(if (null? a)
0
(let ((aa (abs (car a)))
(bb (abs (cadr a))))
(if (= bb 0)
aa
(gcd bb (remainder aa bb)))))))
(define lcm
(lambda a
(if (null? a)
1
(let ((aa (abs (car a)))
(bb (abs (cadr a))))
(if (or (= aa 0) (= bb 0))
0
(abs (* (quotient aa (gcd aa bb)) bb)))))))
(define (string . charlist)
(list->string charlist))
(define (list->string charlist)
(let* ((len (length charlist))
(newstr (make-string len))
(fill-string!
(lambda (str i len charlist)
(if (= i len)
str
(begin (string-set! str i (car charlist))
(fill-string! str (+ i 1) len (cdr charlist)))))))
(fill-string! newstr 0 len charlist)))
(define (string-fill! s e)
(let ((n (string-length s)))
(let loop ((i 0))
(if (= i n)
s
(begin (string-set! s i e) (loop (succ i)))))))
(define (string->list s)
(let loop ((n (pred (string-length s))) (l '()))
(if (= n -1)
l
(loop (pred n) (cons (string-ref s n) l)))))
(define (string-copy str)
(string-append str))
(define (string->anyatom str pred)
(let* ((a (string->atom str)))
(if (pred a) a
(error "string->xxx: not a xxx" a))))
(define (string->number str . base)
(let ((n (string->atom str (if (null? base) 10 (car base)))))
(if (number? n) n #f)))
(define (anyatom->string n pred)
(if (pred n)
(atom->string n)
(error "xxx->string: not a xxx" n)))
(define (number->string n . base)
(atom->string n (if (null? base) 10 (car base))))
(define (char-cmp? cmp a b)
(cmp (char->integer a) (char->integer b)))
(define (char-ci-cmp? cmp a b)
(cmp (char->integer (char-downcase a)) (char->integer (char-downcase b))))
(define (char=? a b) (char-cmp? = a b))
(define (char<? a b) (char-cmp? < a b))
(define (char>? a b) (char-cmp? > a b))
(define (char<=? a b) (char-cmp? <= a b))
(define (char>=? a b) (char-cmp? >= a b))
(define (char-ci=? a b) (char-ci-cmp? = a b))
(define (char-ci<? a b) (char-ci-cmp? < a b))
(define (char-ci>? a b) (char-ci-cmp? > a b))
(define (char-ci<=? a b) (char-ci-cmp? <= a b))
(define (char-ci>=? a b) (char-ci-cmp? >= a b))
; Note the trick of returning (cmp x y)
(define (string-cmp? chcmp cmp a b)
(let ((na (string-length a)) (nb (string-length b)))
(let loop ((i 0))
(cond
((= i na)
(if (= i nb) (cmp 0 0) (cmp 0 1)))
((= i nb)
(cmp 1 0))
((chcmp = (string-ref a i) (string-ref b i))
(loop (succ i)))
(else
(chcmp cmp (string-ref a i) (string-ref b i)))))))
(define (string=? a b) (string-cmp? char-cmp? = a b))
(define (string<? a b) (string-cmp? char-cmp? < a b))
(define (string>? a b) (string-cmp? char-cmp? > a b))
(define (string<=? a b) (string-cmp? char-cmp? <= a b))
(define (string>=? a b) (string-cmp? char-cmp? >= a b))
(define (string-ci=? a b) (string-cmp? char-ci-cmp? = a b))
(define (string-ci<? a b) (string-cmp? char-ci-cmp? < a b))
(define (string-ci>? a b) (string-cmp? char-ci-cmp? > a b))
(define (string-ci<=? a b) (string-cmp? char-ci-cmp? <= a b))
(define (string-ci>=? a b) (string-cmp? char-ci-cmp? >= a b))
(define (list . x) x)
(define (foldr f x lst)
(if (null? lst)
x
(foldr f (f x (car lst)) (cdr lst))))
(define (unzip1-with-cdr . lists)
(unzip1-with-cdr-iterative lists '() '()))
(define (unzip1-with-cdr-iterative lists cars cdrs)
(if (null? lists)
(cons cars cdrs)
(let ((car1 (caar lists))
(cdr1 (cdar lists)))
(unzip1-with-cdr-iterative
(cdr lists)
(append cars (list car1))
(append cdrs (list cdr1))))))
(define (map proc . lists)
(if (null? lists)
(apply proc)
(if (null? (car lists))
'()
(let* ((unz (apply unzip1-with-cdr lists))
(cars (car unz))
(cdrs (cdr unz)))
(cons (apply proc cars) (apply map (cons proc cdrs)))))))
(define (for-each proc . lists)
(if (null? lists)
(apply proc)
(if (null? (car lists))
#t
(let* ((unz (apply unzip1-with-cdr lists))
(cars (car unz))
(cdrs (cdr unz)))
(apply proc cars) (apply map (cons proc cdrs))))))
(define (list-tail x k)
(if (zero? k)
x
(list-tail (cdr x) (- k 1))))
(define (list-ref x k)
(car (list-tail x k)))
(define (last-pair x)
(if (pair? (cdr x))
(last-pair (cdr x))
x))
(define (head stream) (car stream))
(define (tail stream) (force (cdr stream)))
(define (vector-equal? x y)
(and (vector? x) (vector? y) (= (vector-length x) (vector-length y))
(let ((n (vector-length x)))
(let loop ((i 0))
(if (= i n)
#t
(and (equal? (vector-ref x i) (vector-ref y i))
(loop (succ i))))))))
(define (list->vector x)
(apply vector x))
(define (vector-fill! v e)
(let ((n (vector-length v)))
(let loop ((i 0))
(if (= i n)
v
(begin (vector-set! v i e) (loop (succ i)))))))
(define (vector->list v)
(let loop ((n (pred (vector-length v))) (l '()))
(if (= n -1)
l
(loop (pred n) (cons (vector-ref v n) l)))))
;; The following quasiquote macro is due to Eric S. Tiedemann.
;; Copyright 1988 by Eric S. Tiedemann; all rights reserved.
;;
;; Subsequently modified to handle vectors: D. Souflis
(macro
quasiquote
(lambda (l)
(define (mcons f l r)
(if (and (pair? r)
(eq? (car r) 'quote)
(eq? (car (cdr r)) (cdr f))
(pair? l)
(eq? (car l) 'quote)
(eq? (car (cdr l)) (car f)))
(if (or (procedure? f) (number? f) (string? f))
f
(list 'quote f))
(if (eqv? l vector)
(apply l (eval r))
(list 'cons l r)
)))
(define (mappend f l r)
(if (or (null? (cdr f))
(and (pair? r)
(eq? (car r) 'quote)
(eq? (car (cdr r)) '())))
l
(list 'append l r)))
(define (foo level form)
(cond ((not (pair? form))
(if (or (procedure? form) (number? form) (string? form))
form
(list 'quote form))
)
((eq? 'quasiquote (car form))
(mcons form ''quasiquote (foo (+ level 1) (cdr form))))
(#t (if (zero? level)
(cond ((eq? (car form) 'unquote) (car (cdr form)))
((eq? (car form) 'unquote-splicing)
(error "Unquote-splicing wasn't in a list:"
form))
((and (pair? (car form))
(eq? (car (car form)) 'unquote-splicing))
(mappend form (car (cdr (car form)))
(foo level (cdr form))))
(#t (mcons form (foo level (car form))
(foo level (cdr form)))))
(cond ((eq? (car form) 'unquote)
(mcons form ''unquote (foo (- level 1)
(cdr form))))
((eq? (car form) 'unquote-splicing)
(mcons form ''unquote-splicing
(foo (- level 1) (cdr form))))
(#t (mcons form (foo level (car form))
(foo level (cdr form)))))))))
(foo 0 (car (cdr l)))))
;;;;;Helper for the dynamic-wind definition. By Tom Breton (Tehom)
(define (shared-tail x y)
(let ((len-x (length x))
(len-y (length y)))
(define (shared-tail-helper x y)
(if
(eq? x y)
x
(shared-tail-helper (cdr x) (cdr y))))
(cond
((> len-x len-y)
(shared-tail-helper
(list-tail x (- len-x len-y))
y))
((< len-x len-y)
(shared-tail-helper
x
(list-tail y (- len-y len-x))))
(#t (shared-tail-helper x y)))))
;;;;;Dynamic-wind by Tom Breton (Tehom)
;;Guarded because we must only eval this once, because doing so
;;redefines call/cc in terms of old call/cc
(unless (defined? 'dynamic-wind)
(let
;;These functions are defined in the context of a private list of
;;pairs of before/after procs.
( (*active-windings* '())
;;We'll define some functions into the larger environment, so
;;we need to know it.
(outer-env (current-environment)))
;;Poor-man's structure operations
(define before-func car)
(define after-func cdr)
(define make-winding cons)
;;Manage active windings
(define (activate-winding! new)
((before-func new))
(set! *active-windings* (cons new *active-windings*)))
(define (deactivate-top-winding!)
(let ((old-top (car *active-windings*)))
;;Remove it from the list first so it's not active during its
;;own exit.
(set! *active-windings* (cdr *active-windings*))
((after-func old-top))))
(define (set-active-windings! new-ws)
(unless (eq? new-ws *active-windings*)
(let ((shared (shared-tail new-ws *active-windings*)))
;;Define the looping functions.
;;Exit the old list. Do deeper ones last. Don't do
;;any shared ones.
(define (pop-many)
(unless (eq? *active-windings* shared)
(deactivate-top-winding!)
(pop-many)))
;;Enter the new list. Do deeper ones first so that the
;;deeper windings will already be active. Don't do any
;;shared ones.
(define (push-many new-ws)
(unless (eq? new-ws shared)
(push-many (cdr new-ws))
(activate-winding! (car new-ws))))
;;Do it.
(pop-many)
(push-many new-ws))))
;;The definitions themselves.
(eval
`(define call-with-current-continuation
;;It internally uses the built-in call/cc, so capture it.
,(let ((old-c/cc call-with-current-continuation))
(lambda (func)
;;Use old call/cc to get the continuation.
(old-c/cc
(lambda (continuation)
;;Call func with not the continuation itself
;;but a procedure that adjusts the active
;;windings to what they were when we made
;;this, and only then calls the
;;continuation.
(func
(let ((current-ws *active-windings*))
(lambda (x)
(set-active-windings! current-ws)
(continuation x)))))))))
outer-env)
;;We can't just say "define (dynamic-wind before thunk after)"
;;because the lambda it's defined to lives in this environment,
;;not in the global environment.
(eval
`(define dynamic-wind
,(lambda (before thunk after)
;;Make a new winding
(activate-winding! (make-winding before after))
(let ((result (thunk)))
;;Get rid of the new winding.
(deactivate-top-winding!)
;;The return value is that of thunk.
result)))
outer-env)))
(define call/cc call-with-current-continuation)
;;;;; atom? and equal? written by a.k
;;;; atom?
(define (atom? x)
(not (pair? x)))
;;;; equal?
(define (equal? x y)
(cond
((pair? x)
(and (pair? y)
(equal? (car x) (car y))
(equal? (cdr x) (cdr y))))
((vector? x)
(and (vector? y) (vector-equal? x y)))
((string? x)
(and (string? y) (string=? x y)))
(else (eqv? x y))))
;;;; (do ((var init inc) ...) (endtest result ...) body ...)
;;
(macro do
(lambda (do-macro)
(apply (lambda (do vars endtest . body)
(let ((do-loop (gensym)))
`(letrec ((,do-loop
(lambda ,(map (lambda (x)
(if (pair? x) (car x) x))
`,vars)
(if ,(car endtest)
(begin ,@(cdr endtest))
(begin
,@body
(,do-loop
,@(map (lambda (x)
(cond
((not (pair? x)) x)
((< (length x) 3) (car x))
(else (car (cdr (cdr x))))))
`,vars)))))))
(,do-loop
,@(map (lambda (x)
(if (and (pair? x) (cdr x))
(car (cdr x))
'()))
`,vars)))))
do-macro)))
;;;; generic-member
(define (generic-member cmp obj lst)
(cond
((null? lst) #f)
((cmp obj (car lst)) lst)
(else (generic-member cmp obj (cdr lst)))))
(define (memq obj lst)
(generic-member eq? obj lst))
(define (memv obj lst)
(generic-member eqv? obj lst))
(define (member obj lst)
(generic-member equal? obj lst))
;;;; generic-assoc
(define (generic-assoc cmp obj alst)
(cond
((null? alst) #f)
((cmp obj (caar alst)) (car alst))
(else (generic-assoc cmp obj (cdr alst)))))
(define (assq obj alst)
(generic-assoc eq? obj alst))
(define (assv obj alst)
(generic-assoc eqv? obj alst))
(define (assoc obj alst)
(generic-assoc equal? obj alst))
(define (acons x y z) (cons (cons x y) z))
;;;; Handy for imperative programs
;;;; Used as: (define-with-return (foo x y) .... (return z) ...)
(macro (define-with-return form)
`(define ,(cadr form)
(call/cc (lambda (return) ,@(cddr form)))))
;;;; Simple exception handling
;
; Exceptions are caught as follows:
;
; (catch (do-something to-recover and-return meaningful-value)
; (if-something goes-wrong)
; (with-these calls))
;
; "Catch" establishes a scope spanning multiple call-frames
; until another "catch" is encountered.
;
; Exceptions are thrown with:
;
; (throw "message")
;
; If used outside a (catch ...), reverts to (error "message)
(define *handlers* (list))
(define (push-handler proc)
(set! *handlers* (cons proc *handlers*)))
(define (pop-handler)
(let ((h (car *handlers*)))
(set! *handlers* (cdr *handlers*))
h))
(define (more-handlers?)
(pair? *handlers*))
(define (throw . x)
(if (more-handlers?)
(apply (pop-handler))
(apply error x)))
(macro (catch form)
(let ((label (gensym)))
`(call/cc (lambda (exit)
(push-handler (lambda () (exit ,(cadr form))))
(let ((,label (begin ,@(cddr form))))
(pop-handler)
,label)))))
(define *error-hook* throw)
;;;;; Definition of MAKE-ENVIRONMENT, to be used with two-argument EVAL
(macro (make-environment form)
`(apply (lambda ()
,@(cdr form)
(current-environment))))
(define-macro (eval-polymorphic x . envl)
(display envl)
(let* ((env (if (null? envl) (current-environment) (eval (car envl))))
(xval (eval x env)))
(if (closure? xval)
(make-closure (get-closure-code xval) env)
xval)))
; Redefine this if you install another package infrastructure
; Also redefine 'package'
(define *colon-hook* eval)
;;;;; I/O
(define (input-output-port? p)
(and (input-port? p) (output-port? p)))
(define (close-port p)
(cond
((input-output-port? p) (close-input-port p) (close-output-port p))
((input-port? p) (close-input-port p))
((output-port? p) (close-output-port p))
(else (throw "Not a port" p))))
(define (call-with-input-file s p)
(let ((inport (open-input-file s)))
(if (eq? inport #f)
#f
(let ((res (p inport)))
(close-input-port inport)
res))))
(define (call-with-output-file s p)
(let ((outport (open-output-file s)))
(if (eq? outport #f)
#f
(let ((res (p outport)))
(close-output-port outport)
res))))
(define (with-input-from-file s p)
(let ((inport (open-input-file s)))
(if (eq? inport #f)
#f
(let ((prev-inport (current-input-port)))
(set-input-port inport)
(let ((res (p)))
(close-input-port inport)
(set-input-port prev-inport)
res)))))
(define (with-output-to-file s p)
(let ((outport (open-output-file s)))
(if (eq? outport #f)
#f
(let ((prev-outport (current-output-port)))
(set-output-port outport)
(let ((res (p)))
(close-output-port outport)
(set-output-port prev-outport)
res)))))
(define (with-input-output-from-to-files si so p)
(let ((inport (open-input-file si))
(outport (open-input-file so)))
(if (not (and inport outport))
(begin
(close-input-port inport)
(close-output-port outport)
#f)
(let ((prev-inport (current-input-port))
(prev-outport (current-output-port)))
(set-input-port inport)
(set-output-port outport)
(let ((res (p)))
(close-input-port inport)
(close-output-port outport)
(set-input-port prev-inport)
(set-output-port prev-outport)
res)))))
; Random number generator (maximum cycle)
(define *seed* 1)
(define (random-next)
(let* ((a 16807) (m 2147483647) (q (quotient m a)) (r (modulo m a)))
(set! *seed*
(- (* a (- *seed*
(* (quotient *seed* q) q)))
(* (quotient *seed* q) r)))
(if (< *seed* 0) (set! *seed* (+ *seed* m)))
*seed*))
;; SRFI-0
;; COND-EXPAND
;; Implemented as a macro
(define *features* '(srfi-0 tinyscheme))
(define-macro (cond-expand . cond-action-list)
(cond-expand-runtime cond-action-list))
(define (cond-expand-runtime cond-action-list)
(if (null? cond-action-list)
#t
(if (cond-eval (caar cond-action-list))
`(begin ,@(cdar cond-action-list))
(cond-expand-runtime (cdr cond-action-list)))))
(define (cond-eval-and cond-list)
(foldr (lambda (x y) (and (cond-eval x) (cond-eval y))) #t cond-list))
(define (cond-eval-or cond-list)
(foldr (lambda (x y) (or (cond-eval x) (cond-eval y))) #f cond-list))
(define (cond-eval condition)
(cond
((symbol? condition)
(if (member condition *features*) #t #f))
((eq? condition #t) #t)
((eq? condition #f) #f)
(else (case (car condition)
((and) (cond-eval-and (cdr condition)))
((or) (cond-eval-or (cdr condition)))
((not) (if (not (null? (cddr condition)))
(error "cond-expand : 'not' takes 1 argument")
(not (cond-eval (cadr condition)))))
(else (error "cond-expand : unknown operator" (car condition)))))))
(gc-verbose #f)

164
plug-ins/script-fu/scripts/selection-round.scm Normal file
View File

@ -0,0 +1,164 @@
; selection-rounded-rectangle.scm -*-scheme-*-
; PIKA - Photo and Image Kooker Application
; 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/>.
; CHANGE-LOG:
; 1.00 - initial release
; 1.01 - some code cleanup, no real changes
; 1.02 - made script undoable
; 2.00 - ALAN's Branch. changed name, menu, location, and description
; 2.01 - fixed to work if there was no current selection.
; 2.02 - changed scale to percentages, usability tweaking.
; 2.10 - added concave round edges, updated description.
; 2.11 - tweeked description, changed comments, relinquished any rights.
; Copyright (C) 1997, 1998, Sven Neumann
; Copyright (C) 2004, Alan Horkan.
; Alan Horkan relinquishes all rights to his changes,
; full ownership of this script belongs to Sven Neumann.
(define (script-fu-selection-rounded-rectangle image drawable radius concave)
(pika-image-undo-group-start image)
(if (= (car (pika-selection-is-empty image)) TRUE) (pika-selection-all image))
(let* (
(radius (/ radius 100)) ; convert from percentages
(radius (min radius 1.0))
(radius (max radius 0.0))
(select-bounds (pika-selection-bounds image))
(has-selection (car select-bounds))
(select-x1 (cadr select-bounds))
(select-y1 (caddr select-bounds))
(select-x2 (cadr (cddr select-bounds)))
(select-y2 (caddr (cddr select-bounds)))
(select-width (- select-x2 select-x1))
(select-height (- select-y2 select-y1))
(cut-radius 0)
(ellipse-radius 0)
)
(pika-context-push)
(pika-context-set-defaults)
;; select to the full bounds of the selection,
;; fills in irregular shapes or holes.
(pika-image-select-rectangle image CHANNEL-OP-ADD
select-x1 select-y1 select-width select-height)
(if (> select-width select-height)
(set! cut-radius (trunc (+ 1 (* radius (/ select-height 2)))))
(set! cut-radius (trunc (+ 1 (* radius (/ select-width 2)))))
)
(set! ellipse-radius (* cut-radius 2))
(pika-context-set-antialias TRUE)
;; cut away rounded (concave) corners
; top right
(pika-image-select-ellipse image CHANNEL-OP-SUBTRACT
(- select-x1 cut-radius)
(- select-y1 cut-radius)
(* cut-radius 2)
(* cut-radius 2))
; lower left
(pika-image-select-ellipse image CHANNEL-OP-SUBTRACT
(- select-x1 cut-radius)
(- select-y2 cut-radius)
(* cut-radius 2)
(* cut-radius 2))
; top right
(pika-image-select-ellipse image CHANNEL-OP-SUBTRACT
(- select-x2 cut-radius)
(- select-y1 cut-radius)
(* cut-radius 2)
(* cut-radius 2))
; bottom left
(pika-image-select-ellipse image CHANNEL-OP-SUBTRACT
(- select-x2 cut-radius)
(- select-y2 cut-radius)
(* cut-radius 2)
(* cut-radius 2))
;; add in rounded (convex) corners
(if (= concave FALSE)
(begin
(pika-image-select-ellipse image
CHANNEL-OP-ADD
select-x1
select-y1
ellipse-radius
ellipse-radius)
(pika-image-select-ellipse image
CHANNEL-OP-ADD
select-x1
(- select-y2 ellipse-radius)
ellipse-radius
ellipse-radius)
(pika-image-select-ellipse image
CHANNEL-OP-ADD
(- select-x2 ellipse-radius)
select-y1
ellipse-radius
ellipse-radius)
(pika-image-select-ellipse image
CHANNEL-OP-ADD
(- select-x2 ellipse-radius)
(- select-y2 ellipse-radius)
ellipse-radius
ellipse-radius)
)
)
(pika-image-undo-group-end image)
(pika-displays-flush)
(pika-context-pop)
)
)
(define (script-fu-selection-round image drawable radius)
(script-fu-selection-rounded-rectangle image drawable (* radius 100) FALSE)
)
(script-fu-register "script-fu-selection-rounded-rectangle"
_"Rounded R_ectangle..."
_"Round the corners of the current selection"
"Alan Horkan, Sven Neumann" ; authors
"Sven Neumann" ; copyright
"2004/06/07"
"*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-ADJUSTMENT _"R_adius (%)" '(50 0 100 1 10 0 0)
SF-TOGGLE _"Co_ncave" FALSE
)
(script-fu-register "script-fu-selection-round"
""
"This procedure is deprecated! Use 'script-fu-selection-rounded-rectangle' instead."
"Sven Neumann" ; authors
"Sven Neumann" ; copyright
"1998/02/06"
"*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-ADJUSTMENT "Relative radius" '(1 0 128 0.1 1 1 1)
)
(script-fu-menu-register "script-fu-selection-rounded-rectangle"
"<Image>/Select/[Modify]")

261
plug-ins/script-fu/scripts/slide.scm Normal file
View File

@ -0,0 +1,261 @@
; PIKA - Photo and Image Kooker Application
; 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/>.
;
;
; slide.scm version 0.41 2004/03/28
;
; CHANGE-LOG:
; 0.20 - first public release
; 0.30 - some code cleanup
; now uses the rotate plug-in to improve speed
; 0.40 - changes to work with pika-1.1
; if the image was rotated, rotate the whole thing back when finished
; 0.41 - changes to work with pika-2.0, slightly correct text offsets,
; Nils Philippsen <nphilipp@redhat.com> 2004/03/28
;
; !still in development!
; TODO: - change the script so that the film is rotated, not the image
; - antialiasing
; - make 'add background' an option
; - ?
;
; Copyright (C) 1997-1999 Sven Neumann <sven@gimp.org>
;
; makes your picture look like a slide
;
; The script works on RGB and grayscale images that contain only
; one layer. The image is cropped to fit into an aspect ratio of 1:1,5.
; 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.
(define (script-fu-slide img
drawable
text
number
fontname
font-color
work-on-copy)
(define (crop width height ratio)
(if (>= width (* ratio height))
(* ratio height)
width
)
)
(let* (
(type (car (pika-drawable-type-with-alpha drawable)))
(image (cond ((= work-on-copy TRUE)
(car (pika-image-duplicate img)))
((= work-on-copy FALSE)
img)))
(owidth (car (pika-image-get-width image)))
(oheight (car (pika-image-get-height image)))
(ratio (if (>= owidth oheight) (/ 3 2)
(/ 2 3)))
(crop-width (crop owidth oheight ratio))
(crop-height (/ crop-width ratio))
(width (* (max crop-width crop-height) 1.05))
(height (* (min crop-width crop-height) 1.5))
(hole-width (/ width 20))
(hole-space (/ width 8))
(hole-height (/ width 12))
(hole-radius (/ hole-width 4))
(hole-start (- (/ (rand 1000) 1000) 0.5))
(film-layer (car (pika-layer-new image
width
height
type
"Film"
100
LAYER-MODE-NORMAL)))
(bg-layer (car (pika-layer-new image
width
height
type
"Background"
100
LAYER-MODE-NORMAL)))
(pic-layer (aref (cadr (pika-image-get-selected-drawables image)) 0))
(numbera (string-append number "A"))
)
(pika-context-push)
(pika-context-set-paint-mode LAYER-MODE-NORMAL)
(pika-context-set-opacity 100.0)
(pika-context-set-feather FALSE)
(if (= work-on-copy TRUE)
(pika-image-undo-disable image)
(pika-image-undo-group-start image)
)
; add an alpha channel to the image
(pika-layer-add-alpha pic-layer)
; crop, resize and eventually rotate the image
(pika-image-crop image
crop-width
crop-height
(/ (- owidth crop-width) 2)
(/ (- oheight crop-height) 2))
(pika-image-resize image
width
height
(/ (- width crop-width) 2)
(/ (- height crop-height) 2))
(if (< ratio 1)
(plug-in-rotate RUN-NONINTERACTIVE image pic-layer 1 FALSE)
)
; add the background layer
(pika-drawable-fill bg-layer FILL-BACKGROUND)
(pika-image-insert-layer image bg-layer 0 -1)
; add the film layer
(pika-context-set-background '(0 0 0))
(pika-drawable-fill film-layer FILL-BACKGROUND)
(pika-image-insert-layer image film-layer 0 -1)
; add the text
(pika-context-set-foreground font-color)
(pika-floating-sel-anchor (car (pika-text-fontname image
film-layer
(+ hole-start (* -0.25 width))
(* 0.01 height)
text
0
TRUE
(* 0.040 height) PIXELS fontname)))
(pika-floating-sel-anchor (car (pika-text-fontname image
film-layer
(+ hole-start (* 0.75 width))
(* 0.01 height)
text
0
TRUE
(* 0.040 height) PIXELS
fontname )))
(pika-floating-sel-anchor (car (pika-text-fontname image
film-layer
(+ hole-start (* 0.35 width))
0.0
number
0
TRUE
(* 0.050 height) PIXELS
fontname )))
(pika-floating-sel-anchor (car (pika-text-fontname image
film-layer
(+ hole-start (* 0.35 width))
(* 0.94 height)
number
0
TRUE
(* 0.050 height) PIXELS
fontname )))
(pika-floating-sel-anchor (car (pika-text-fontname image
film-layer
(+ hole-start (* 0.85 width))
(* 0.945 height)
numbera
0
TRUE
(* 0.045 height) PIXELS
fontname )))
; create a mask for the holes and cut them out
(let* (
(film-mask (car (pika-layer-create-mask film-layer ADD-MASK-WHITE)))
(hole hole-start)
(top-y (* height 0.06))
(bottom-y (* height 0.855))
)
(pika-layer-add-mask film-layer film-mask)
(pika-selection-none image)
(while (< hole 8)
(pika-image-select-rectangle image
CHANNEL-OP-ADD
(* hole-space hole)
top-y
hole-width
hole-height)
(pika-image-select-rectangle image
CHANNEL-OP-ADD
(* hole-space hole)
bottom-y
hole-width
hole-height)
(set! hole (+ hole 1))
)
(pika-context-set-foreground '(0 0 0))
(pika-drawable-edit-fill film-mask FILL-BACKGROUND)
(pika-selection-none image)
(plug-in-gauss-rle RUN-NONINTERACTIVE image film-mask hole-radius TRUE TRUE)
(pika-drawable-threshold film-mask HISTOGRAM-VALUE 0.5 1.0)
(pika-layer-remove-mask film-layer MASK-APPLY)
)
; reorder the layers
(pika-image-raise-item image pic-layer)
(pika-image-raise-item image pic-layer)
; eventually rotate the whole thing back
(if (< ratio 1)
(plug-in-rotate RUN-NONINTERACTIVE image pic-layer 3 TRUE)
)
; clean up after the script
(pika-selection-none image)
(if (= work-on-copy TRUE)
(begin
(pika-display-new image)
(pika-image-undo-enable image)
)
(pika-image-undo-group-end image)
)
(pika-displays-flush)
(pika-context-pop)
)
)
(script-fu-register "script-fu-slide"
_"_Slide..."
_"Add a slide-film like frame, sprocket holes, and labels to an image"
"Sven Neumann <sven@gimp.org>"
"Sven Neumann"
"2004/03/28"
"RGB GRAY"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-STRING _"Text" "PIKA"
SF-STRING _"Number" "32"
SF-FONT _"Font" "Serif"
SF-COLOR _"Font color" '(255 180 0)
SF-TOGGLE _"Work on copy" TRUE
)
(script-fu-menu-register "script-fu-slide"
"<Image>/Filters/Decor")

111
plug-ins/script-fu/scripts/spinning-globe.scm Normal file
View File

@ -0,0 +1,111 @@
;
; anim_sphere
;
;
; Chris Gutteridge (cjg@ecs.soton.ac.uk)
; At ECS Dept, University of Southampton, England.
; 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/>.
; Define the function:
(define (script-fu-spinning-globe inImage
inLayer
inFrames
inFromLeft
inTransparent
inIndex
inCopy)
(let* (
(theImage (if (= inCopy TRUE)
(car (pika-image-duplicate inImage))
inImage))
(theLayer (aref (cadr (pika-image-get-selected-layers theImage)) 0))
(n 0)
(ang (* (/ 360 inFrames)
(if (= inFromLeft TRUE) 1 -1) ))
(theFrame 0)
)
(pika-layer-add-alpha theLayer)
(while (> inFrames n)
(set! n (+ n 1))
(set! theFrame (car (pika-layer-copy theLayer FALSE)))
(pika-image-insert-layer theImage theFrame 0 0)
(pika-item-set-name theFrame
(string-append "Anim Frame: "
(number->string (- inFrames n) 10)
" (replace)"))
(plug-in-map-object RUN-NONINTERACTIVE
theImage ; mapping image
1 (vector theFrame) ; mapping drawables
1 ; viewpoint
0.5 0.5 2.0 ; object pos
0.5 0.5 0.0 ; first axis
1.0 0.0 0.0 ; 2nd axis
0.0 1.0 0.0 ; axis rotation
0.0 (* n ang) 0.0 ; light (type, color)
0 '(255 255 255) ; light position
-0.5 -0.5 2.0 ; light direction
-1.0 -1.0 1.0 ; material (amb, diff, refl, spec, high)
0.3 1.0 0.5 0.0 27.0 ; antialias
TRUE ; tile
FALSE ; new image
FALSE ; transparency
inTransparent ; radius
0.25 ; unused parameters
1.0 1.0 1.0 1.0
-1 -1 -1 -1 -1 -1 -1 -1
)
)
(pika-image-remove-layer theImage theLayer)
(plug-in-autocrop RUN-NONINTERACTIVE theImage theFrame)
(if (= inIndex 0)
()
(pika-image-convert-indexed theImage CONVERT-DITHER-FS CONVERT-PALETTE-GENERATE inIndex
FALSE FALSE ""))
(if (= inCopy TRUE)
(begin
(pika-image-clean-all theImage)
(pika-display-new theImage)
)
)
(pika-displays-flush)
)
)
(script-fu-register
"script-fu-spinning-globe"
_"_Spinning Globe..."
_"Create an animation by mapping the current image onto a spinning sphere"
"Chris Gutteridge"
"1998, Chris Gutteridge / ECS dept, University of Southampton, England."
"16th April 1998"
"RGB* GRAY*"
SF-IMAGE "The Image" 0
SF-DRAWABLE "The Layer" 0
SF-ADJUSTMENT _"Frames" '(10 1 360 1 10 0 1)
SF-TOGGLE _"Turn from left to right" FALSE
SF-TOGGLE _"Transparent background" TRUE
SF-ADJUSTMENT _"Index to n colors (0 = remain RGB)" '(63 0 256 1 10 0 1)
SF-TOGGLE _"Work on copy" TRUE
)
(script-fu-menu-register "script-fu-spinning-globe"
"<Image>/Filters/Animation/")

174
plug-ins/script-fu/scripts/test-sphere-v3.scm Normal file
View File

@ -0,0 +1,174 @@
#!/usr/bin/env pika-script-fu-interpreter-3.0
; v3 >>> Has shebang, is interpreter
; This is a a test script to test Script-Fu parameter API.
; For PIKA 3: uses PikaImageProcedure, PikaProcedureDialog, PikaConfig
; See also test-sphere.scm, for PIKA 2, from which this is derived
; Diffs marked with ; v3 >>>
; v3 >>> signature of PikaImageProcedure
; drawables is a vector
(define (script-fu-test-sphere-v3
image
drawables
radius
light
shadow
bg-color
sphere-color
brush
text
multi-text
pattern
gradient
gradient-reverse
font
size
unused-palette
unused-filename
unused-orientation
unused-interpolation
unused-dirname
unused-image
unused-layer
unused-channel
unused-drawable)
(let* (
(width (* radius 3.75))
(height (* radius 2.5))
(img (car (pika-image-new width height RGB)))
(drawable (car (pika-layer-new img width height RGB-IMAGE
"Sphere Layer" 100 LAYER-MODE-NORMAL)))
(radians (/ (* light *pi*) 180))
(cx (/ width 2))
(cy (/ height 2))
(light-x (+ cx (* radius (* 0.6 (cos radians)))))
(light-y (- cy (* radius (* 0.6 (sin radians)))))
(light-end-x (+ cx (* radius (cos (+ *pi* radians)))))
(light-end-y (- cy (* radius (sin (+ *pi* radians)))))
(offset (* radius 0.1))
(text-extents (pika-text-get-extents-fontname multi-text
size PIXELS
font))
(x-position (- cx (/ (car text-extents) 2)))
(y-position (- cy (/ (cadr text-extents) 2)))
(shadow-w 0)
(shadow-x 0)
)
(pika-context-push)
(pika-context-set-defaults)
(pika-image-undo-disable img)
(pika-image-insert-layer img drawable 0 0)
(pika-context-set-foreground sphere-color)
(pika-context-set-background bg-color)
(pika-drawable-edit-fill drawable FILL-BACKGROUND)
(pika-context-set-background '(20 20 20))
(if (and
(or (and (>= light 45) (<= light 75))
(and (<= light 135) (>= light 105)))
(= shadow TRUE))
(let ((shadow-w (* (* radius 2.5) (cos (+ *pi* radians))))
(shadow-h (* radius 0.5))
(shadow-x cx)
(shadow-y (+ cy (* radius 0.65))))
(if (< shadow-w 0)
(begin (set! shadow-x (+ cx shadow-w))
(set! shadow-w (- shadow-w))))
(pika-context-set-feather TRUE)
(pika-context-set-feather-radius 7.5 7.5)
(pika-image-select-ellipse img CHANNEL-OP-REPLACE shadow-x shadow-y shadow-w shadow-h)
(pika-context-set-pattern pattern)
(pika-drawable-edit-fill drawable FILL-PATTERN)))
(pika-context-set-feather FALSE)
(pika-image-select-ellipse img CHANNEL-OP-REPLACE (- cx radius) (- cy radius)
(* 2 radius) (* 2 radius))
(pika-context-set-gradient-fg-bg-rgb)
(pika-drawable-edit-gradient-fill drawable
GRADIENT-RADIAL offset
FALSE 0 0
TRUE
light-x light-y
light-end-x light-end-y)
(pika-selection-none img)
(pika-image-select-ellipse img CHANNEL-OP-REPLACE 10 10 50 50)
(pika-context-set-gradient gradient)
(pika-context-set-gradient-reverse gradient-reverse)
(pika-drawable-edit-gradient-fill drawable
GRADIENT-LINEAR offset
FALSE 0 0
TRUE
10 10
30 60)
(pika-selection-none img)
(pika-context-set-foreground '(0 0 0))
(pika-floating-sel-anchor (car (pika-text-fontname img drawable
x-position y-position
multi-text
0 TRUE
size PIXELS
font)))
(pika-image-undo-enable img)
(pika-display-new img)
(pika-context-pop)
)
)
; v3 >>> use script-fu-register-filter
; v3 >>> menu item is v3, alongside old one
; v3 >>> not yet localized
(script-fu-register-filter "script-fu-test-sphere-v3"
"Sphere v3..."
"Test script-fu-register-filter and PikaProcedureDialog: needs 2 selected layers."
"Spencer Kimball, Sven Neumann"
"Spencer Kimball"
"1996, 1998"
"*" ; image types any
SF-TWO-OR-MORE-DRAWABLE ; v3 >>> additional argument
SF-ADJUSTMENT "Radius (in pixels)" (list 100 1 5000 1 10 0 SF-SPINNER)
SF-ADJUSTMENT "Lighting (degrees)" (list 45 0 360 1 10 1 SF-SLIDER)
SF-TOGGLE "Shadow" TRUE
SF-COLOR "Background color" "white"
SF-COLOR "Sphere color" "red"
SF-BRUSH "Brush" '("2. Hardness 100" 100 44 0)
SF-STRING "Text" "Tiny-Fu rocks!"
SF-TEXT "Multi-line text" "Hello,\nWorld!"
SF-PATTERN "Pattern" "Maple Leaves"
SF-GRADIENT "Gradient" "Deep Sea"
SF-TOGGLE "Gradient reverse" FALSE
SF-FONT "Font" "Agate"
SF-ADJUSTMENT "Font size (pixels)" '(50 1 1000 1 10 0 1)
SF-PALETTE "Palette" "Default"
SF-FILENAME "Environment map"
(string-append pika-data-directory
"/scripts/images/beavis.jpg")
SF-OPTION "Orientation" '("Horizontal"
"Vertical")
SF-ENUM "Interpolation" '("InterpolationType" "linear")
SF-DIRNAME "Output directory" "/var/tmp/"
SF-IMAGE "Image" -1
SF-LAYER "Layer" -1
SF-CHANNEL "Channel" -1
SF-DRAWABLE "Drawable" -1
SF-VECTORS "Vectors" -1
)
(script-fu-menu-register "script-fu-test-sphere-v3"
"<Image>/Filters/Development/Script-Fu/Test")

307
plug-ins/script-fu/scripts/test-sphere.scm Normal file
View File

@ -0,0 +1,307 @@
; This is a a test script to show and test the possibilities of the
; Script-Fu parameter API.
;
; ----------------------------------------------------------------------
; SF-ADJUSTMENT
; is only useful in interactive mode, if you call a script from
; the console, it acts just like a normal SF-VALUE
; In interactive mode it creates an adjustment widget in the dialog.
;
; Usage:
; SF-ADJUSTMENT "label" '(value lower upper step_inc page_inc digits type)
;
; type is one of: SF-SLIDER(0), SF-SPINNER(1)
;
; ----------------------------------------------------------------------
; SF-COLOR
; creates a color button in the dialog. It accepts either a list of three
; values for the red, green and blue components or a color name in CSS
; notatation
;
; Usage:
; SF-COLOR "label" '(red green blue)
; SF-COLOR "label" "color"
;
; ----------------------------------------------------------------------
; SF-FONT
; creates a font-selection widget in the dialog. It returns a fontname as
; a string. There are two new pika-text procedures to ease the use of this
; return parameter:
;
; (pika-text-fontname image drawable
; x-pos y-pos text border antialias size unit font)
; (pika-text-get-extents-fontname text size unit font))
;
; where font is the fontname you get. The size specified in the fontname
; is silently ignored. It is only used in the font-selector. So you are
; asked to set it to a useful value (24 pixels is a good choice) when
; using SF-FONT.
;
; Usage:
; SF-FONT "label" "fontname"
;
; ----------------------------------------------------------------------
; SF-BRUSH
; is only useful in interactive mode. It will create a widget in the control
; dialog. The widget consists of a preview area (which when pressed will
; produce a popup preview ) and a button with the "..." label. The button will
; popup a dialog where brushes can be selected and each of the
; characteristics of the brush can be modified.
;
; The actual value returned when the script is invoked is a list
; consisting of Brush name, opacity, spacing and brush mode in the same
; units as passed in as the default value.
;
; Usage:
; SF-BRUSH "Brush" '("Circle (03)" 100 44 0)
;
; Here the brush dialog will be popped up with a default brush of Circle (03)
; opacity 100 spacing 44 and paint mode of Normal (value 0).
; If this selection was unchanged the value passed to the function as a
; parameter would be '("Circle (03)" 100 44 0).
;
; ----------------------------------------------------------------------
; SF-PATTERN
; Only useful in interactive mode. It will create a widget in the control
; dialog. The widget consists of a preview area (which when pressed will
; produce a popup preview ) and a button with the "..." label. The button will
; popup a dialog where patterns can be selected.
;
; Usage:
; SF-PATTERN "Pattern" "Maple Leaves"
;
; The value returned when the script is invoked is a string containing the
; pattern name. If the above selection was not altered the string would
; contain "Maple Leaves"
;
; ----------------------------------------------------------------------
; SF-GRADIENT
; Only useful in interactive mode. It will create a widget in the control
; dialog. The widget consists of a button containing a preview of the selected
; gradient. If the button is pressed a gradient selection dialog will popup.
;
; Usage:
; SF-GRADIENT "Gradient" "Deep Sea"
;
; The value returned when the script is invoked is a string containing the
; gradient name. If the above selection was not altered the string would
; contain "Deep Sea"
;
; ----------------------------------------------------------------------
; SF-PALETTE
; Only useful in interactive mode. It will create a widget in the control
; dialog. The widget consists of a button containing a preview of the selected
; palette. If the button is pressed a palette selection dialog will popup.
;
; Usage:
; SF-PALETTE "Palette" "Named Colors"
;
; The value returned when the script is invoked is a string containing the
; palette name. If the above selection was not altered the string would
; contain "Named Colors"
;
; ----------------------------------------------------------------------
; SF-FILENAME
; Only useful in interactive mode. It will create a widget in the control
; dialog. The widget consists of a button containing the name of a file.
; If the button is pressed a file selection dialog will popup.
;
; Usage:
; SF-FILENAME "Environment Map"
; (string-append "" pika-data-directory "/scripts/beavis.jpg")
;
; The value returned when the script is invoked is a string containing the
; filename.
;
; ----------------------------------------------------------------------
; SF-DIRNAME
; Only useful in interactive mode. Very similar to SF-FILENAME, but the
; created widget allows to choose a directory instead of a file.
;
; Usage:
; SF-DIRNAME "Image Directory" "/var/tmp/images"
;
; The value returned when the script is invoked is a string containing the
; dirname.
;
; ----------------------------------------------------------------------
; SF-OPTION
; Only useful in interactive mode. It will create a widget in the control
; dialog. The widget is a combo-box showing the options that are passed
; as a list. The first option is the default choice.
;
; Usage:
; SF-OPTION "Orientation" '("Horizontal" "Vertical")
;
; The value returned when the script is invoked is the number of the
; chosen option, where the option first is counted as 0.
;
; ----------------------------------------------------------------------
; SF-ENUM
; Only useful in interactive mode. It will create a widget in the control
; dialog. The widget is a combo-box showing all enum values for the given
; enum type. This has to be the name of a registered enum, without the
; "Pika" prefix. The second parameter specifies the default value, using
; the enum value's nick.
;
; Usage:
; SF-ENUM "Interpolation" '("InterpolationType" "linear")
;
; The value returned when the script is invoked corresponds to chosen
; enum value.
;
; ----------------------------------------------------------------------
(define (script-fu-test-sphere radius
light
shadow
bg-color
sphere-color
brush
text
multi-text
pattern
gradient
gradient-reverse
font
size
unused-palette
unused-filename
unused-orientation
unused-interpolation
unused-dirname
unused-image
unused-layer
unused-channel
unused-drawable)
(let* (
(width (* radius 3.75))
(height (* radius 2.5))
(img (car (pika-image-new width height RGB)))
(drawable (car (pika-layer-new img width height RGB-IMAGE
"Sphere Layer" 100 LAYER-MODE-NORMAL)))
(radians (/ (* light *pi*) 180))
(cx (/ width 2))
(cy (/ height 2))
(light-x (+ cx (* radius (* 0.6 (cos radians)))))
(light-y (- cy (* radius (* 0.6 (sin radians)))))
(light-end-x (+ cx (* radius (cos (+ *pi* radians)))))
(light-end-y (- cy (* radius (sin (+ *pi* radians)))))
(offset (* radius 0.1))
(text-extents (pika-text-get-extents-fontname multi-text
size PIXELS
font))
(x-position (- cx (/ (car text-extents) 2)))
(y-position (- cy (/ (cadr text-extents) 2)))
(shadow-w 0)
(shadow-x 0)
)
(pika-context-push)
(pika-context-set-defaults)
(pika-image-undo-disable img)
(pika-image-insert-layer img drawable 0 0)
(pika-context-set-foreground sphere-color)
(pika-context-set-background bg-color)
(pika-drawable-edit-fill drawable FILL-BACKGROUND)
(pika-context-set-background '(20 20 20))
(if (and
(or (and (>= light 45) (<= light 75))
(and (<= light 135) (>= light 105)))
(= shadow TRUE))
(let ((shadow-w (* (* radius 2.5) (cos (+ *pi* radians))))
(shadow-h (* radius 0.5))
(shadow-x cx)
(shadow-y (+ cy (* radius 0.65))))
(if (< shadow-w 0)
(begin (set! shadow-x (+ cx shadow-w))
(set! shadow-w (- shadow-w))))
(pika-context-set-feather TRUE)
(pika-context-set-feather-radius 7.5 7.5)
(pika-image-select-ellipse img CHANNEL-OP-REPLACE shadow-x shadow-y shadow-w shadow-h)
(pika-context-set-pattern pattern)
(pika-drawable-edit-fill drawable FILL-PATTERN)))
(pika-context-set-feather FALSE)
(pika-image-select-ellipse img CHANNEL-OP-REPLACE (- cx radius) (- cy radius)
(* 2 radius) (* 2 radius))
(pika-context-set-gradient-fg-bg-rgb)
(pika-drawable-edit-gradient-fill drawable
GRADIENT-RADIAL offset
FALSE 0 0
TRUE
light-x light-y
light-end-x light-end-y)
(pika-selection-none img)
(pika-image-select-ellipse img CHANNEL-OP-REPLACE 10 10 50 50)
(pika-context-set-gradient gradient)
(pika-context-set-gradient-reverse gradient-reverse)
(pika-drawable-edit-gradient-fill drawable
GRADIENT-LINEAR offset
FALSE 0 0
TRUE
10 10
30 60)
(pika-selection-none img)
(pika-context-set-foreground '(0 0 0))
(pika-floating-sel-anchor (car (pika-text-fontname img drawable
x-position y-position
multi-text
0 TRUE
size PIXELS
font)))
(pika-image-undo-enable img)
(pika-display-new img)
(pika-context-pop)
)
)
(script-fu-register "script-fu-test-sphere"
_"_Sphere..."
"Simple script to test and show the usage of the new Script-Fu API extensions."
"Spencer Kimball, Sven Neumann"
"Spencer Kimball"
"1996, 1998"
""
SF-ADJUSTMENT "Radius (in pixels)" (list 100 1 5000 1 10 0 SF-SPINNER)
SF-ADJUSTMENT "Lighting (degrees)" (list 45 0 360 1 10 1 SF-SLIDER)
SF-TOGGLE "Shadow" TRUE
SF-COLOR "Background color" "white"
SF-COLOR "Sphere color" "red"
SF-BRUSH "Brush" '("2. Hardness 100" 100 44 0)
SF-STRING "Text" "Tiny-Fu rocks!"
SF-TEXT "Multi-line text" "Hello,\nWorld!"
SF-PATTERN "Pattern" "Maple Leaves"
SF-GRADIENT "Gradient" "Deep Sea"
SF-TOGGLE "Gradient reverse" FALSE
SF-FONT "Font" "Agate"
SF-ADJUSTMENT "Font size (pixels)" '(50 1 1000 1 10 0 1)
SF-PALETTE "Palette" "Default"
SF-FILENAME "Environment map"
(string-append pika-data-directory
"/scripts/images/beavis.jpg")
SF-OPTION "Orientation" '("Horizontal"
"Vertical")
SF-ENUM "Interpolation" '("InterpolationType" "linear")
SF-DIRNAME "Output directory" "/var/tmp/"
SF-IMAGE "Image" -1
SF-LAYER "Layer" -1
SF-CHANNEL "Channel" -1
SF-DRAWABLE "Drawable" -1
SF-VECTORS "Vectors" -1
)
(script-fu-menu-register "script-fu-test-sphere"
"<Image>/Filters/Development/Script-Fu/Test")

42
plug-ins/script-fu/scripts/test/README Normal file
View File

@ -0,0 +1,42 @@
Scripts to test various cases for ScriptFu subsystem.
Not usually installed.
Should not be localized i18n : for developers only.
## Install
To use, install them:
1. Old style scripts: copy to /scripts.
2. New style independently interpreted scripts:
copy a dir containing the test script into /plugins
and ensure the .scm files have execute permission.
Old style scripts test and are interpreted by extension-script-fu.
When a script crashes extension-script-fu, you must restart Pika.
New style scripts are interpreted in a separate process
running binary script-fu-interpreter-3.0.
## Invoke
Any installed script can be tested in the SF Console
by just calling it from the PDB: "(script-fu-test-foo)"
since they are PDB procedures.
Scripts that have menu items can be tested from the Pika GUI.
Any test script can be called by another script.
## Testing framework
test9.scm has a built-in testing framework.
FUTURE: extract the framework to a Scheme extension
that is in the Pika repo,
that other scripts can load and use.

30
plug-ins/script-fu/scripts/test/always-fail/always-fail.scm Normal file
View File

@ -0,0 +1,30 @@
#!/usr/bin/env pika-script-fu-interpreter-3.0
; A script that always fails
;
; Setup: copy this file w/ executable permission, and its parent dir to /plug-ins
; Example: to ~/.pika-2.99/plug-ins/always-fail/always-fail.scm
; Expect "Test>Always fail" in the menus
; Expect when chosen, message on PIKA message bar "Failing"
; Expect a dialog in PIKA app that requires an OK
(define (script-fu-always-fail)
(begin
(pika-message "Failing")
; since last expression, the result, and should mean error
#f
)
)
(script-fu-register "script-fu-always-fail"
"Always fail"
"Expect error dialog in Gimp, or PDB execution error when called by another"
"lkk"
"lkk"
"2022"
"" ; requires no image
; no arguments or dialog
)
(script-fu-menu-register "script-fu-always-fail" "<Image>/Test")

29
plug-ins/script-fu/scripts/test/call-always-fail/call-always-fail.scm Normal file
View File

@ -0,0 +1,29 @@
#!/usr/bin/env pika-script-fu-interpreter-3.0
; A script that calls a script that always fails
;
; Setup: copy this file w/ executable permission, and its parent dir to /plug-ins
; Example: to ~/.pika-2.99/plug-ins/always-fail/always-fail.scm
; Expect "Test>Call always fail" in the menus
; Expect when chosen, message on PIKA message bar "Failing" (from script-fu-always-fail)
; Expect a dialog in PIKA app that requires an OK
(define (script-fu-call-always-fail)
; call a script that always fails
(script-fu-always-fail)
; we have not checked the result and declaring the error on our own.
; since this is the last expression, the #f from the call should propogate.
)
(script-fu-register "script-fu-call-always-fail"
"Call always fail"
"Expect error dialog in Gimp, having concatenated error messages"
"lkk"
"lkk"
"2022"
"" ; requires no image
; no arguments or dialog
)
(script-fu-menu-register "script-fu-call-always-fail" "<Image>/Test")

161
plug-ins/script-fu/scripts/test/resource-class/resource-class.scm Normal file
View File

@ -0,0 +1,161 @@
#!/usr/bin/env pika-script-fu-interpreter-3.0
; A script that tests resource classes in PIKA
; Tests the marshalling of parameters and return values in ScriptFu
;
; Setup: copy this file w/ executable permission, and its parent dir to /plug-ins
; Example: to ~/.pika-2.99/plug-ins/always-fail/always-fail.scm
; Delete .config/PIKA so that resources are in a standard state.
; Expect various resource names in the console
; Expect no "Fail" in the console
(define (script-fu-test-resource-class)
(define (expect expression
expected-value )
; use equal?, don't use eq?
(if (equal? expression expected-value)
#t
(pika-message "Fail")
)
)
; redirect messages to the console
(pika-message-set-handler 1)
(let* (
; Test as a return value
; These calls return a list with one element, use car
(brush (car (pika-context-get-brush)))
(font (car (pika-context-get-font)))
(gradient (car (pika-context-get-gradient)))
(palette (car (pika-context-get-palette)))
(pattern (car (pika-context-get-pattern)))
; font and pattern cannot be new(), duplicate(), delete()
; new() methods
(brushnew (car (pika-brush-new "Brush New")))
(gradientnew (car (pika-gradient-new "Gradient New")))
(palettenew (car (pika-palette-new "Palette New")))
; copy() methods
; copy method is named "duplicate"
; Takes an existing brush and a desired name
(brushcopy (car (pika-brush-duplicate brushnew "brushcopy")))
(gradientcopy (car (pika-gradient-duplicate gradientnew "gradientcopy")))
(palettecopy (car (pika-palette-duplicate palettenew "palettecopy")))
; See below, we test rename later
)
; write names to console
(pika-message brush)
(pika-message font)
(pika-message gradient)
(pika-message palette)
(pika-message pattern)
(pika-message brushnew)
(pika-message gradientnew)
(pika-message palettenew)
(pika-message brushcopy)
(pika-message gradientcopy)
(pika-message palettecopy)
; Note equal? works for strings, but eq? and eqv? do not
(pika-message "Expect resources from context have de novo installed PIKA names")
(expect (equal? brush "2. Hardness 050") #t)
(expect (equal? font "Sans-serif") #t)
(expect (equal? gradient "FG to BG (RGB)") #t)
(expect (equal? palette "Color History") #t)
(expect (equal? pattern "Pine") #t)
(pika-message "Expect new resource names are the names given when created")
(expect (equal? brushnew "Brush New") #t)
(expect (equal? gradientnew "Gradient New") #t)
(expect (equal? palettenew "Palette New") #t)
(pika-message "Expect copied resources have names given when created")
; !!! TODO PIKA appends " copy" and does not use the given name
; which contradicts the docs for the procedure
(expect (equal? brushcopy "Brush New copy") #t)
(expect (equal? gradientcopy "Gradient New copy") #t)
(expect (equal? palettecopy "Palette New copy") #t)
; rename() methods
; Returns new resource proxy, having possibly different name than requested
; ScriptFu marshals to a string
; !!! Must assign it to the same var,
; else the var becomes an invalid reference since it has the old name
(set! brushcopy (car (pika-brush-rename brushcopy "Brush Copy Renamed")))
(set! gradientcopy (car (pika-gradient-rename gradientcopy "Gradient Copy Renamed")))
(set! palettecopy (car (pika-palette-rename palettecopy "Palette Copy Renamed")))
; write renames to console
(pika-message brushcopy)
(pika-message gradientcopy)
(pika-message palettecopy)
(pika-message "Expect renamed have new names")
(expect (equal? brushcopy "Brush Copy Renamed") #t)
(expect (equal? gradientcopy "Gradient Copy Renamed") #t)
(expect (equal? palettecopy "Palette Copy Renamed") #t)
(pika-message "Expect class method id_is_valid of the PikaResource class")
; the class method takes a string.
; ScriptFu already has a string var, and marshalling is trivial
; For now, returns (1), not #t
(expect (car (pika-brush-id-is-valid brush)) 1)
(expect (car (pika-font-id-is-valid font)) 1)
(expect (car (pika-gradient-id-is-valid gradient)) 1)
(expect (car (pika-palette-id-is-valid palette)) 1)
(expect (car (pika-pattern-id-is-valid pattern)) 1)
(pika-message "Expect class method id_is_valid for invalid name")
; Expect false, but no error dialog from PIKA
; Returns (0), not #f
(expect (car (pika-brush-id-is-valid "invalid_name")) 0)
(expect (car (pika-font-id-is-valid "invalid_name")) 0)
(expect (car (pika-gradient-id-is-valid "invalid_name")) 0)
(expect (car (pika-palette-id-is-valid "invalid_name")) 0)
(expect (car (pika-pattern-id-is-valid "invalid_name")) 0)
(pika-message "Expect as a parameter to context works")
; Pass each resource class instance back to Gimp
(pika-context-set-brush brush)
(pika-context-set-font font)
(pika-context-set-gradient gradient)
(pika-context-set-palette palette)
(pika-context-set-pattern pattern)
(pika-message "Expect delete methods work without error")
(pika-brush-delete brushnew)
(pika-gradient-delete gradientnew)
(pika-palette-delete palettenew)
(pika-message "Expect var holding deleted resource is still defined, but is invalid reference")
; Returns (0), not #f
(expect (car (pika-brush-id-is-valid brushnew)) 0)
(expect (car (pika-gradient-id-is-valid gradientnew)) 0)
(expect (car (pika-palette-id-is-valid palettenew)) 0)
; We don't test the specialized methods of the classes here, see elsewhere
)
)
(script-fu-register "script-fu-test-resource-class"
"Test resource classes of Pika"
"Expect no errors in the console"
"lkk"
"lkk"
"2022"
"" ; requires no image
; no arguments or dialog
)
(script-fu-menu-register "script-fu-test-resource-class" "<Image>/Test")

33
plug-ins/script-fu/scripts/test/test-install-fail/test-install-fail.scm Normal file
View File

@ -0,0 +1,33 @@
; An old style script, not an independent plugin
; A script that fails at install time: has syntax error
;
; Setup: copy this file w/ executable permission, to one of the /scripts dirs.
; Example: to ~/snap/393/.config/PIKA/2.10/scripts/test-quit.scm
; Start Gimp, configure to have Error Console open, and quit.
; Install this plugin.
; Restart Pika from a terminal
; Expect:
; - an error in the Pika Error Console
; - an error in the terminal
; !!! the first is currently failing. So this script is to test FUTURE.
(define (script-fu-test-install-fail )
( ; <= syntax error
)
; Much is moot, since this should fail to install
(script-fu-register "script-fu-test-install-fail"
"Moot"
"Moot"
"lkk"
"lkk"
"2023"
"" ; requires no image
; no args
)
(script-fu-menu-register "script-fu-test-install-fail"
"<Image>/Filters/Development/Script-Fu/Test")

49
plug-ins/script-fu/scripts/test/test-quit/test-quit.scm Normal file
View File

@ -0,0 +1,49 @@
#!/usr/bin/env pika-script-fu-interpreter-3.0
; A script to test calls to Scheme function: (quit 1)
;
; Setup: copy this file w/ executable permission, and its parent dir to /plug-ins
; Example: to ~/.pika-2.99/plug-ins/test-quit/test-quit.scm
; Expect "Filters>Dev>Script-Fu>Test>Quit with code" in the menus
; Test interactive:
; Choose "Quit with code". Expect the plugin's dialog.
; Choose OK.
; Expect:
; 1. a message in stderr
; 2. an error dialog in PIKA that must be OK'd
; OR a message in Pika Error Console when it is open.)
; !!! FIXME: this fails now, for reasons unrelated to (quit)
; Repeat, but enter 0.
; Expect:
; No error in stderr OR Gimp
; Test non-interactive:
; Enter "(script-fu-test-quit 1)" in SF Console
; Expect:
; 1. a message in stderr
2. SF Console to print the error message.
; In both test case, the error message is like:
; "Execution error for 'Quit with code': script quit with code: 1"
(define (script-fu-test-quit code)
(quit code)
)
(script-fu-register "script-fu-test-quit"
"Quit with code"
"Expect error in Gimp, or PDB execution error when called by another"
"lkk"
"lkk"
"2023"
"" ; requires no image
; The argument is an integer, defaulting to 1, that the script will call quit with.
SF-ADJUSTMENT "Return code" '(1 -5 5 1 2 0 0)
)
(script-fu-menu-register "script-fu-test-quit"
"<Image>/Filters/Development/Script-Fu/Test")

53
plug-ins/script-fu/scripts/test/test-run-error-PDB/test-run-error-PDB.scm Normal file
View File

@ -0,0 +1,53 @@
#!/usr/bin/env pika-script-fu-interpreter-3.0
; test-run-error-PDB.scm
; A script that throws a run-time error calling PDB with wrong signature
; The script has a dialog so it can run INTERACTIVE
;
; Setup: copy this file to /scripts
; Example: to ~/.pika-2.99/scripts/test-run-error-PDB.scm
; Expect "Filters>Dev>Script-Fu>Test>Runtime PDB error" in the menus
; !!! Do not export G_DEBUG=fatal-warnings
; Test interactive:
; Choose "Runtime PDB error". Expect the plugin's dialog.
; Choose OK.
; Expect:
; an error dialog in PIKA that must be OK'd
; OR a CRITICAL and WARNING message in Pika Error Console when it is open.)
; Test non-interactive:
; Enter "(script-fu-test-run-error-PDB 1)" in SF Console
; Expect SF Console to print the error message.
; In both test case, the error message is like:
; PIKA CRITICAL pika_procedure_real_execute: assertion 'pika_value_array_length (args) >= procedure->num_args' failed
; PIKA WARNING pika_procedure_execute: no return values, shouldn't happen
; The root error is "not enough args to a PDB procedure"
; ScriptFu will warn but proceed to call the PDB procedure.
; Pika will throw CRITICAL but proceed
; On return, Pika will throw WARNING that the procedure did not return values.
; ???? Why does it crash and give a backtrace???
(define (script-fu-test-run-error-PDB code)
(pika-message) ; <= run-time error signature mismatch
)
(script-fu-register "script-fu-test-run-error-PDB"
"Runtime PDB error"
"Expect error in Gimp, or PDB execution error when called by another"
"lkk"
"lkk"
"2023"
"" ; requires no image
; The argument here just to ensure a dialog
SF-ADJUSTMENT "Not used" '(1 -2 2 1 2 0 0)
)
(script-fu-menu-register "script-fu-test-run-error-PDB"
"<Image>/Filters/Development/Script-Fu/Test")

31
plug-ins/script-fu/scripts/test/test0/test0.scm Normal file
View File

@ -0,0 +1,31 @@
#!/usr/bin/env pika-script-fu-interpreter-3.0
; Basic test of a .scm file interpreted by script-fu-interpreter
;
; Setup: copy this file w/ executable permission, and its parent dir to /plug-ins
; Example: to ~/.pika-2.99/plug-ins/test0/test0.scm
; (That is custom to one user.)
; Expect "Test>Test SF interpreter 0" in the menus
; Expect when chosen, message on PIKA message bar.
; Also, remove the execute permission.
; Then expect not appear in PIKA menus (not queried.)
; Also, make the name different from its parent dir.
; Then expect not appear in PIKA menus (not queried.)
(define (script-fu-test0)
(pika-message "Hello script-fu-test0")
)
(script-fu-register "script-fu-test0"
"Test SF interpreter 0"
"Just gives a message from Pika"
"lkk"
"lkk"
"2022"
"" ; all image types
)
(script-fu-menu-register "script-fu-test0" "<Image>/Test")

43
plug-ins/script-fu/scripts/test/test1/test1.scm Normal file
View File

@ -0,0 +1,43 @@
#!/usr/bin/env pika-script-fu-interpreter-3.0
; Basic test that a second .scm file is also queried.
; Expect "Test>Test SF interpreter 1" in the menus
; Expect when chosen, message on PIKA message bar.
; Also tests that one .scm file can define two PDB procedures
; File is queried once, yielding two names.
; Two separate procedures created.
(define (script-fu-test1)
(pika-message "Hello script-fu-test1")
)
(script-fu-register "script-fu-test1"
"Test SF interpreter 01"
"Just gives a message from Pika"
"lkk"
"lkk"
"2022"
"" ; all image types
)
(script-fu-menu-register "script-fu-test1" "<Image>/Test")
(define (script-fu-test2)
(pika-message "Hello script-fu-test2")
)
(script-fu-register "script-fu-test2"
"Test SF interpreter 02"
"Just gives a message from Pika"
"lkk"
"lkk"
"2022"
"" ; all image types
)
(script-fu-menu-register "script-fu-test2" "<Image>/Test")

31
plug-ins/script-fu/scripts/test/test1/test3.scm Normal file
View File

@ -0,0 +1,31 @@
; !!! No shebang here
; Test a second .scm file in the same directory as a queried .scm.
; The second .scm file need not be executable.
; The second .scm file need not have a shebang.
; The pika-script-fu-interpreter will nevertheless load the second .scm
; while it is querying the first, executable .scm in the dir.
; The plugin manager queries the first executable,
; and pika-script-fu-interpreter loads (and returns defined names in)
; the second during the query of the first.
; Expect "Test>Test SF interpreter 3" in the menus
; Expect when chosen, message on PIKA message bar.
; plug-ins/test1/test1.scm is executable
; plug-ins/test1/test3.scm is NOT executable
(define (script-fu-test3)
(pika-message "Hello script-fu-test3")
)
(script-fu-register "script-fu-test3"
"Test SF interpreter 3"
"Just gives a message from Pika"
"lkk"
"lkk"
"2022"
"" ; all image types
)
(script-fu-menu-register "script-fu-test3" "<Image>/Test")

25
plug-ins/script-fu/scripts/test/test4/test4.scm Normal file
View File

@ -0,0 +1,25 @@
#!/usr/bin/env pika-script-fu-interpreter-3.0
; Test a .scm file that does not call script-fu-menu-register
; The menu will NOT default.
; Expect "Test SF interpreter 4" to NOT EXIST in any menu
; Expect the PDB proc "script-fu-test4" does appear in the PDB Brower
; Two test cases:
; Alongside an executable script: plug-ins/test4/test4.scm NOT executable
; Executable, in its own directory: plug-ins/test1/test4.scm is executable
(define (script-fu-test4)
(pika-message "Hello script-fu-test4")
)
(script-fu-register "script-fu-test4"
"Test SF interpreter 4"
"Just gives a message from Pika"
"lkk"
"lkk"
"2022"
"" ; all image types
)
; !!! No call to script-fu-menu-register

16
plug-ins/script-fu/scripts/test/test5/test5.scm Normal file
View File

@ -0,0 +1,16 @@
#!/usr/bin/env pika-script-fu-interpreter
; Test a .scm file with an invalid shebang
; Note "-3.0" missing above.
; The test depends on platform and env and .interp
; Must not be a file system link from pika-script-fu-interpreter to pika-script-fu-interpreter-3.0
; Must not be a .interp file having "pika-script-fu-interpreter=pika-script-fu-interpreter-3.0"
; Expect in the console: "/usr/bin/env: 'script-fu-interpreter': No such file or directory"
(define (script-fu-test5)
(pika-message "Hello script-fu-test5")
)
; !!! No call to script-fu-menu-register

12
plug-ins/script-fu/scripts/test/test6/test6.scm Normal file
View File

@ -0,0 +1,12 @@
#!/usr/bin/env pika-script-fu-interpreter-3.0
; Test a .scm file that does not register any procedure
; Expect in the console:
; "(test6.scm:164): scriptfu-WARNING **: 10:06:07.966: No procedures defined in /work/.home/.config/PIKA/2.99/plug-ins/test6/test6.scm"
(define (script-fu-test6)
(pika-message "Hello script-fu-test6")
)
; !!! No call to script-fu-register

28
plug-ins/script-fu/scripts/test/test7/test7.scm Normal file
View File

@ -0,0 +1,28 @@
#!/usr/bin/env pika-script-fu-interpreter-3.0
; Test non-canonical name for PDB procedure
; pika-script-fu-interpreter does not enforce canonical name.
; Other parts of PIKA (PDB) does not enforce canonical name
; for PDB procedures defined by .scm scripts.
; Canonical means starts with "script-fu-"
; Here the name doesn't, its just "test7"
; Expect "Test>Test SF interpreter 7" in the menus
; Expect when chosen, message on PIKA message bar.
(define (test7)
(pika-message "Hello test7")
)
(script-fu-register "test7"
"Test SF interpreter 7"
"Just gives a message from Pika"
"lkk"
"lkk"
"2022"
"" ; all image types
)
(script-fu-menu-register "test7" "<Image>/Test")

39
plug-ins/script-fu/scripts/test/test8/test8.scm Normal file
View File

@ -0,0 +1,39 @@
#!/usr/bin/env pika-script-fu-interpreter-3.0
; Test mismatch between name of defined run function and name for PDB procedure
; Not a high priority: a rare syntax error in a plugin text.
; If authors follow a template, they won't make this mistake.
; The names must match exactly.
; Here, "mismatch" the name of the defined run function
; does not match "script-fu-test8" the name of the PDB proc.
; Expect a warning in the text console as the plugin text is queried:
; script-fu: WARNING: Run function not defined, or does not match PDB procedure name: script-fu-test8.
; Expect the PDB procedure to not exist
; If we don't detect this syntax error:
; A PDB procedure is created.
; When invoked from Test>Test SF interpreter 8"
; the interpreter enters an infinite loop.
; There is no harm to the PIKA app, but the interpreter process can only be killed.
; During the run phase, the "(define foo)"
; should re-define an existing definition in the interpreter state.
; Instead, since the name is mismatched,
; the foo function remains defined to be a call to the PDB procedure named foo.
; So script-fu-script-proc instead calls the PDB again, an infinite loop.
(define (mismatch)
(pika-message "mismatch")
)
(script-fu-register "script-fu-test8"
"Test SF interpreter 8"
"Just gives a message from Pika"
"lkk"
"lkk"
"2022"
"" ; all image types
)
(script-fu-menu-register "script-fu-test8" "<Image>/Test")

547
plug-ins/script-fu/scripts/test/test9/test9.scm Normal file
View File

@ -0,0 +1,547 @@
#!/usr/bin/env pika-script-fu-interpreter-3.0
; Test byte, file/string ports and string handling.
(define temp-path
(string-append (car (pika-pikarc-query "temp-path")) "/"))
(define (plugin-tmp-filepath name)
(string-append temp-path "script-fu-test9-" name ".txt"))
; ---------- Helper functions ----------
(define (make-testresult success error-message)
(list success error-message))
(define (testresult-success x) (car x))
(define (testresult-error x) (cadr x))
(define (displayln msg)
(display msg)
(newline))
(define (trim char chars)
(if (= (char->integer char) (char->integer (car chars)))
(trim char (cdr chars))
chars))
(define (rtrim str)
(list->string (reverse (trim #\space (reverse (string->list str))))))
(define (any->string any)
(let* ((to-string
(lambda (any)
(let* ((str (make-string 256)))
(call-with-output-string str
(lambda (port) (write any port)))
str))))
(rtrim (to-string any))))
(define (write-all-bytes port bytes)
(if (null? bytes)
'()
(begin
(write-byte (car bytes) port)
(write-all-bytes port (cdr bytes)))))
(define (bytes->string bytes)
(let* ((str (make-string (length bytes))))
(call-with-output-string str
(lambda (port) (map (lambda (b) (write-byte b port)) bytes)))
str))
(define (with-string open-function str function)
(let ((port (open-function str)))
(if (port? port)
(let ((result '()))
(set! result (function port))
(close-port port)
result)
(make-testresult #f "Failed to open string for string port!"))))
(define (call-with-input-string str function)
(with-string open-input-string str function))
(define (call-with-output-string str function)
(with-string open-output-string str function))
; Loops from i to n-1.
(define (loop i n function)
(if (< i n)
(begin
(function i)
(loop (+ i 1) n function))
#t))
(define (assert code)
(let* ((old-error-hook *error-hook*)
(exceptions '())
(append-exception
(lambda (x)
(if (null? exceptions)
(set! exceptions "Exception: ")
'())
(set! exceptions (string-append exceptions " " (any->string x)))))
(assert-error-hook
(lambda (xs)
(map append-exception xs)
(old-error-hook xs)))
(result #f))
(set! *error-hook* assert-error-hook)
(catch '() (set! result (eval code)))
(set! *error-hook* old-error-hook)
(if (and (null? exceptions)
result)
(make-testresult result '())
(make-testresult #f
(if (null? exceptions)
(string-append "Assertion failed: " (any->string code))
exceptions)))))
; ---------- Test data ----------
(define test-data-1byte
(map integer->byte (list 65))) ; 65 = A
(define test-data-256bytes
(let ((result '()))
(loop 0 256 (lambda (i) (set! result (cons i result))))
(reverse (map integer->byte result))))
(define test-data-1char
(map integer->byte (list 228 189 160))) ; 你 (UTF-8)
(define test-data-2chars
(map integer->byte
(list 228 189 160 ; 你 (UTF-8)
229 165 189))) ; 好 (UTF-8)
; ---------- Tests start here ---------
; Each test function should be individually executable or
; have a wrapper function that can be individually executed.
; ----- Test byte functions -----
; Ensure all integers with values in the range 0-255
; can be converted to a byte and then back successfully.
(define (test-byte-conversion)
(let* ((errors '())
(failed
(lambda (error)
(if (null? errors)
(set! errors "")
'())
(set! errors (string-append errors error))))
(test-conversion
(lambda (i)
(let ((result (assert `(= (byte->integer (integer->byte ,i)) ,i))))
(if (not (testresult-success result))
(failed (testresult-error result))
'())))))
(loop 0 256 test-conversion)
(make-testresult (null? errors) errors)))
; Ensure byte? returns true with bytes.
(define (test-byte?-byte)
(assert '(byte? (integer->byte 10))))
; Ensure byte? returns false with integers.
(define (test-byte?-integer)
(assert '(not (byte? 10))))
; Ensure byte? returns false with characters.
(define (test-byte?-char)
(assert '(not (byte? #\A))))
; Ensure atom? works with bytes.
(define (test-byte-atom?)
(assert '(atom? (integer->byte 128))))
; Ensure atom->string works with bytes.
(define (test-byte-atom->string)
(assert '(string=? (atom->string (integer->byte 65)) "A")))
; ----- Read tests for ports -----
; The same tests are used for file and string ports,
; as they must behave identically. These do not have to be
; individually executable, as they require the port to be set up.
; Ensure that we can read a single byte.
; Test data: test-data-1byte
(define (test-read-byte-single port)
(assert `(= (byte->integer (read-byte ,port)) 65))) ; 65 = A
; Ensure peek-byte returns the correct value and does not remove bytes from the port.
; Test data: test-data-1byte
(define (test-read-byte-peek port)
(assert
`(and (= (byte->integer (peek-byte ,port)) 65) ; 65 = A
(not (eof-object? (peek-byte ,port))))))
; Ensure every single possible byte value can be read.
; Test data: test-data-256bytes
(define (test-read-byte-all-values port)
(let* ((errors '())
(failure (lambda () ))
(try
(lambda (i)
(let ((result (assert `(= (byte->integer (read-byte ,port)) ,i))))
(if (not (testresult-success result))
(failure (testresult-error result))
'())))))
(loop 0 256 try)
(make-testresult (null? errors) errors)))
; Ensure that we can read a single char (not multi-byte).
; Test data: test-data-1byte
(define (test-read-char-single-ascii port)
(assert `(= (char->integer (read-char ,port)) 65))) ; 65 = A
; Ensure that we can read a single multi-byte char.
; Note: char->integer returns the integer value of a gunichar,
; which is a UTF-32 or UCS-4 character code.
; Test data: test-data-1char
(define (test-read-char-single port)
(assert `(= (char->integer (read-char ,port)) 20320))) ; 20320 = 你 (UTF-32)
; Ensure peek-char returns the correct value and does not
; remove chars from the port.
; Test data: test-data-1char
(define (test-read-char-peek port)
(assert
`(and (= (char->integer (peek-char ,port)) 20320) ; 20320 = 你 (UTF-32)
(not (eof-object? (peek-char ,port))))))
; Ensure that we can read multiple multi-byte chars from a file.
; Test data: test-data-2chars
(define (test-read-char-multiple port)
(assert
`(and (= (char->integer (read-char ,port)) 20320) ; 20320 = 你 (UTF-32)
(= (char->integer (read-char ,port)) 22909)))) ; 22909 = 好 (UTF-32)
; Ensure read-byte can not read past EOF.
; Test data: test-data-1byte
(define (test-read-byte-overflow port)
(assert `(begin (read-byte ,port) (eof-object? (read-byte ,port)))))
; Ensure read-char can not read past EOF.
; Test data: test-data-1char
(define (test-read-char-overflow port)
(assert `(begin (read-char ,port) (eof-object? (read-char ,port)))))
; ----- Write tests for ports -----
; These tests come in pairs, we write to a port and then read from it to verify.
(define (test-write-byte-single port)
(assert `(begin (write-byte (integer->byte 77) ,port) #t))) ; 77 == M
(define (test-write-byte-single-verify port)
(assert `(= (byte->integer (read-byte ,port)) 77))) ; 77 == M
(define (test-write-char-single port)
(assert `(begin (write-char (car (string->list "你")) ,port) #t)))
(define (test-write-char-single-verify port)
(assert `(= (char->integer (read-char ,port)) 20320))) ; 20320 = 你 (UTF-32)
; ----- String port tests -----
; Wrapper functions for the port read and write tests.
(define (test-input-string-port test-data test-function)
(call-with-input-string (bytes->string test-data) test-function))
(define (test-string-port-read-byte-single)
(test-input-string-port test-data-1byte test-read-byte-single))
(define (test-string-port-read-byte-peek)
(test-input-string-port test-data-1byte test-read-byte-peek))
(define (test-string-port-read-byte-all-values)
(test-input-string-port test-data-256bytes test-read-byte-all-values))
(define (test-string-port-read-char-single-ascii)
(test-input-string-port test-data-1byte test-read-char-single-ascii))
(define (test-string-port-read-char-single)
(test-input-string-port test-data-1char test-read-char-single))
(define (test-string-port-read-char-peek)
(test-input-string-port test-data-1char test-read-char-peek))
(define (test-string-port-read-char-multiple)
(test-input-string-port test-data-2chars test-read-char-multiple))
(define (test-string-port-read-byte-overflow)
(test-input-string-port test-data-1byte test-read-byte-overflow))
(define (test-string-port-read-char-overflow)
(test-input-string-port test-data-1char test-read-char-overflow))
(define (test-string-port-write test-data write-test verify-write-test)
(let* ((str (make-string (length test-data)))
(write-result (call-with-output-string str write-test))
(read-result (call-with-input-string str verify-write-test)))
(if (and (testresult-success write-result)
(testresult-success read-result))
(make-testresult #t '())
(make-testresult #f
(string-append
"write-error: " (any->string (testresult-error write-result)) ", "
"read-error: " (any->string (testresult-error read-result)))))))
(define (test-string-port-write-byte-single)
(test-string-port-write test-data-1byte test-write-byte-single test-write-byte-single-verify))
(define (test-string-port-write-char-single)
(test-string-port-write test-data-1char test-write-char-single test-write-char-single-verify))
; ----- File port tests -----
; Wrapper functions for the port read and write tests.
(define (test-input-file-port test-data test-function)
(let ((filepath (plugin-tmp-filepath "fileport")))
(call-with-output-file filepath (lambda (port) (write-all-bytes port test-data)))
(call-with-input-file filepath test-function)))
(define (test-file-port-read-byte-single)
(test-input-file-port test-data-1byte test-read-byte-single))
(define (test-file-port-read-byte-single)
(test-input-file-port test-data-1byte test-read-byte-single))
(define (test-file-port-read-byte-peek)
(test-input-file-port test-data-1byte test-read-byte-peek))
(define (test-file-port-read-byte-all-values)
(test-input-file-port test-data-256bytes test-read-byte-all-values))
(define (test-file-port-read-char-single-ascii)
(test-input-file-port test-data-1byte test-read-char-single-ascii))
(define (test-file-port-read-char-single)
(test-input-file-port test-data-1char test-read-char-single))
(define (test-file-port-read-char-peek)
(test-input-file-port test-data-1char test-read-char-peek))
(define (test-file-port-read-char-multiple)
(test-input-file-port test-data-2chars test-read-char-multiple))
(define (test-file-port-read-byte-overflow)
(test-input-file-port test-data-1byte test-read-byte-overflow))
(define (test-file-port-read-char-overflow)
(test-input-file-port test-data-1char test-read-char-overflow))
(define (test-file-port-write test-data write-test verify-write-test)
(let* ((filepath (plugin-tmp-filepath "fileport"))
(write-result (call-with-output-file filepath write-test))
(read-result (call-with-input-file filepath verify-write-test)))
(if (and (testresult-success write-result)
(testresult-success read-result))
(make-testresult #t '())
(make-testresult #f
(string-append
"write-error: " (any->string (testresult-error write-result)) ", "
"read-error: " (any->string (testresult-error read-result)))))))
(define (test-file-port-write-byte-single)
(test-string-port-write
test-data-1byte test-write-byte-single test-write-byte-single-verify))
(define (test-file-port-write-char-single)
(test-string-port-write
test-data-1char test-write-char-single test-write-char-single-verify))
; ----- Generic string tests -----
; Ensure basic string functions work.
(define (test-string-length)
(assert '(= (string-length "Hello") 5)))
(define (test-string-length-multibyte)
(assert '(= (string-length "你好") 2)))
(define (test-string->list-length)
(assert '(= (length (string->list "Hello")) 5)))
(define (test-string->list-length-multibyte)
(assert '(= (length (string->list "你好")) 2)))
(define (test-string-first-char)
(assert '(= (char->integer (car (string->list "Hello"))) 72))) ; 72 = H
(define (test-string-first-char-multibyte)
(assert '(= (char->integer (car (string->list "你好"))) 20320))) ; 20320 = 你 (UTF-32)
(define (test-string-overflow)
(assert '(null? (cdr (string->list "H")))))
(define (test-string-overflow-multibyte)
(assert '(null? (cdr (string->list "你")))))
; ----- Generic string tests on strings created using string port -----
; Test string functions on strings which are created by writing bytes into
; a string port.
; Write byte sequence of 你 into a string and ensure string-count returns 1.
(define (test-string-port-string-count)
(let* ((str (make-string 3))
(port (open-output-string str)))
(begin
; 你 = E4 BD A0 = 228 189 160
(write-byte (integer->byte 228) port)
(write-byte (integer->byte 189) port)
(write-byte (integer->byte 160) port)
(close-port port)
(assert
`(and (= (char->integer (car (string->list ,str))) 20320) ; 20320 = 你 (UTF-32)
(= (string-length ,str) 1))))))
; ---------- Test Execution ----------
; Count test results.
(define tests-succeeded 0)
(define tests-failed 0)
(define (test-succeeded)
(set! tests-succeeded (+ tests-succeeded 1))
(display "SUCCESS")
(newline))
(define (test-failed msg)
(set! tests-failed (+ tests-failed 1))
(display "FAILED") (newline)
(display msg) (newline))
(define (run-test test)
(display test) (display ": ")
(let ((result ((eval test))))
(if (car result)
(test-succeeded)
(test-failed (cdr result)))))
(define (run-tests . tests)
(map run-test tests))
(define (run-byte-tests)
(run-tests
'test-byte-conversion
'test-byte?-byte
'test-byte?-integer
'test-byte?-char
'test-byte-atom?
'test-byte-atom->string))
(define (run-string-port-tests)
(run-tests
'test-string-port-read-byte-single
'test-string-port-read-byte-peek
'test-string-port-read-byte-all-values
'test-string-port-read-char-single-ascii
'test-string-port-read-char-single
'test-string-port-read-char-peek
'test-string-port-read-char-multiple
'test-string-port-read-byte-overflow
'test-string-port-read-char-overflow
'test-string-port-write-byte-single
'test-string-port-write-char-single))
(define (run-file-port-tests)
(run-tests
'test-file-port-read-byte-single
'test-file-port-read-byte-peek
'test-file-port-read-byte-all-values
'test-file-port-read-char-single-ascii
'test-file-port-read-char-single
'test-file-port-read-char-peek
'test-file-port-read-char-multiple
'test-file-port-read-byte-overflow
'test-file-port-read-char-overflow
'test-file-port-write-byte-single
'test-file-port-write-char-single))
(define (run-string-tests)
(run-tests
'test-string-length
'test-string-length-multibyte
'test-string->list-length
'test-string->list-length-multibyte
'test-string-first-char
'test-string-first-char-multibyte
'test-string-overflow
'test-string-overflow-multibyte))
(define (run-string-tests-string-port)
(run-tests
'test-string-port-string-count))
(define (run-string-tests-string-port)
(run-test 'test-string-port-string-count))
(define (run-all-tests)
(displayln "========== Information ==========")
(displayln "To run a single test individually, specify the name of the test.")
(displayln (string-append "Temporary files with format 'script-fu-test9-*.txt' can be found in: " temp-path))
(newline)
(displayln "========== Testing byte functions ==========")
(run-byte-tests)
(newline)
(displayln "========== Testing string port ==========")
(run-string-port-tests)
(newline)
(displayln "========== Testing string functions ==========")
(run-string-tests)
(newline)
(displayln "========== Testing string functions on strings created using string ports ==========")
(run-string-tests-string-port)
(newline)
(displayln "========== Testing file port ==========")
; All file port tests will fail if writing to a file doesn't work properly,
; as test data is written to a temporary file. This was done so that the test
; data only exists in one place (in this file as list of bytes).
(run-file-port-tests)
(newline)
(if (= tests-failed 0)
(displayln "ALL tests passed!")
(displayln
(string-append
"Test 9: " (number->string tests-failed)
" tests FAILED. Run tests in Script-Fu console for details."))))
(define (with-log-to-pika-message function)
(let ((test-log (make-string 4096)))
(call-with-output-string test-log
(lambda (port)
(set-output-port port)
(function)))
(pika-message (rtrim test-log))))
(define (name->function name)
(eval (call-with-input-string (string-append "'" name) read)))
(define (select-run-function testname)
(if (> (string-length testname) 0)
(lambda () (run-test (name->function testname)))
run-all-tests))
(define (script-fu-test9 testname)
(with-log-to-pika-message (select-run-function testname)))
; ---------- Script registration ----------
(script-fu-register
"script-fu-test9"
"Test SF interpreter 9"
"Test byte and utf8 char handling. Must print SUCCESS for each test case."
"Richard Szibele"
"Copyright (C) 2022, Richard Szibele"
"2022"
""
SF-STRING "Test (optional)" ""
)
(script-fu-menu-register "script-fu-test9" "<Image>/Test")

87
plug-ins/script-fu/scripts/tileblur.scm Normal file
View File

@ -0,0 +1,87 @@
; Chris Gutteridge (cjg@ecs.soton.ac.uk)
; At ECS Dept, University of Southampton, England.
; 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/>.
(define (script-fu-tile-blur inImage inLayer inRadius inVert inHoriz inType)
(let* (
(theImage inImage)
(theLayer inLayer)
(theHeight (car (pika-drawable-get-height theLayer)))
(theWidth (car (pika-drawable-get-width theLayer)))
)
(define (pasteat xoff yoff)
(let* (
(pasted (pika-edit-paste theLayer FALSE))
(num-pasted (car pasted))
(floating-sel (aref (cadr pasted) (- num-pasted 1)))
)
(pika-layer-set-offsets floating-sel (* xoff theWidth) (* yoff theHeight) )
(pika-floating-sel-anchor floating-sel)
)
)
(pika-context-push)
(pika-context-set-feather FALSE)
(pika-image-undo-group-start theImage)
(pika-layer-resize theLayer (* 3 theWidth) (* 3 theHeight) 0 0)
(pika-image-select-rectangle theImage CHANNEL-OP-REPLACE 0 0 theWidth theHeight)
(pika-edit-cut 1 (vector theLayer))
(pika-selection-none theImage)
(pika-layer-set-offsets theLayer theWidth theHeight)
(pasteat 1 1) (pasteat 1 2) (pasteat 1 3)
(pasteat 2 1) (pasteat 2 2) (pasteat 2 3)
(pasteat 3 1) (pasteat 3 2) (pasteat 3 3)
(pika-selection-none theImage)
(if (= inType 0)
(plug-in-gauss-iir RUN-NONINTERACTIVE
theImage theLayer inRadius inHoriz inVert)
(plug-in-gauss-rle RUN-NONINTERACTIVE
theImage theLayer inRadius inHoriz inVert)
)
(pika-layer-resize theLayer
theWidth theHeight (- 0 theWidth) (- 0 theHeight))
(pika-layer-set-offsets theLayer 0 0)
(pika-image-undo-group-end theImage)
(pika-displays-flush)
(pika-context-pop)
)
)
(script-fu-register "script-fu-tile-blur"
_"_Tileable Blur..."
_"Blur the edges of an image so the result tiles seamlessly"
"Chris Gutteridge"
"1998, Chris Gutteridge / ECS dept, University of Southampton, England."
"25th April 1998"
"RGB*"
SF-IMAGE "The Image" 0
SF-DRAWABLE "The Layer" 0
SF-ADJUSTMENT _"Radius" '(5 0 128 1 5 0 0)
SF-TOGGLE _"Blur vertically" TRUE
SF-TOGGLE _"Blur horizontally" TRUE
SF-OPTION _"Blur type" '(_"IIR" _"RLE")
)
(script-fu-menu-register "script-fu-tile-blur"
"<Image>/Filters/Blur")

67
plug-ins/script-fu/scripts/ts-helloworld.scm Normal file
View File

@ -0,0 +1,67 @@
#!/usr/bin/env pika-script-fu-interpreter-3.0
; "Hello, World" Test v1.00 February 29, 2004
; by Kevin Cozens <kcozens@interlog.com>
;
; Creates an image with the text "Hello, World!"
; This was the first TinyScheme based script ever created and run for the
; 2.x version of PIKA.
; PIKA - Photo and Image Kooker Application
; 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/>.
;
; Tiny-Fu first successfully ran this script at 2:07am on March 6, 2004.
(define (script-fu-helloworld text font size color)
(let* (
(width 10)
(height 10)
(img (car (pika-image-new width height RGB)))
(text-layer)
)
(pika-context-push)
(pika-image-undo-disable img)
(pika-context-set-foreground color)
(set! text-layer (car (pika-text-fontname img -1 0 0 text 10 TRUE size PIXELS font)))
(set! width (car (pika-drawable-get-width text-layer)))
(set! height (car (pika-drawable-get-height text-layer)))
(pika-image-resize img width height 0 0)
(pika-image-undo-enable img)
(pika-display-new img)
(pika-context-pop)
)
)
(script-fu-register "script-fu-helloworld"
"_Hello World..."
"Creates an image with a user specified text string."
"Kevin Cozens <kcozens@interlog.com>"
"Kevin Cozens"
"February 29, 2004"
""
SF-STRING "Text string" "Hello, World!"
SF-FONT "Font" "Sans"
SF-ADJUSTMENT "Font size (pixels)" '(100 2 1000 1 10 0 1)
SF-COLOR "Color" '(0 0 0)
)
(script-fu-menu-register "script-fu-helloworld"
"<Image>/Filters/Development/Script-Fu/Test")

90
plug-ins/script-fu/scripts/unsharp-mask.scm Normal file
View File

@ -0,0 +1,90 @@
;;; unsharp-mask.scm
;;; Time-stamp: <1998/11/17 13:18:39 narazaki@gimp.org>
;;; Author: Narazaki Shuji <narazaki@gimp.org>
;;; Version 0.8
(define (script-fu-unsharp-mask img drw mask-size mask-opacity)
(let* (
(drawable-width (car (pika-drawable-get-width drw)))
(drawable-height (car (pika-drawable-get-height drw)))
(new-image (car (pika-image-new drawable-width drawable-height RGB)))
(original-layer (car (pika-layer-new new-image
drawable-width drawable-height
RGB-IMAGE "Original"
100 LAYER-MODE-NORMAL)))
(original-layer-for-darker 0)
(original-layer-for-lighter 0)
(blurred-layer-for-darker 0)
(blurred-layer-for-lighter 0)
(darker-layer 0)
(lighter-layer 0)
)
(pika-selection-all img)
(pika-edit-copy 1 (vector drw))
(pika-image-undo-disable new-image)
(pika-image-insert-layer new-image original-layer 0 0)
(let* (
(pasted (pika-edit-paste original-layer FALSE))
(num-pasted (car pasted))
(floating-sel (aref (cadr pasted) (- num-pasted 1)))
)
(pika-floating-sel-anchor floating-sel)
)
(set! original-layer-for-darker (car (pika-layer-copy original-layer TRUE)))
(set! original-layer-for-lighter (car (pika-layer-copy original-layer TRUE)))
(set! blurred-layer-for-darker (car (pika-layer-copy original-layer TRUE)))
(pika-item-set-visible original-layer FALSE)
(pika-display-new new-image)
;; make darker mask
(pika-image-insert-layer new-image blurred-layer-for-darker 0 -1)
(plug-in-gauss-iir RUN-NONINTERACTIVE
new-image blurred-layer-for-darker mask-size TRUE TRUE)
(set! blurred-layer-for-lighter
(car (pika-layer-copy blurred-layer-for-darker TRUE)))
(pika-image-insert-layer new-image original-layer-for-darker 0 -1)
(pika-layer-set-mode original-layer-for-darker LAYER-MODE-SUBTRACT)
(set! darker-layer
(car (pika-image-merge-visible-layers new-image CLIP-TO-IMAGE)))
(pika-item-set-name darker-layer "darker mask")
(pika-item-set-visible darker-layer FALSE)
;; make lighter mask
(pika-image-insert-layer new-image original-layer-for-lighter 0 -1)
(pika-image-insert-layer new-image blurred-layer-for-lighter 0 -1)
(pika-layer-set-mode blurred-layer-for-lighter LAYER-MODE-SUBTRACT)
(set! lighter-layer
(car (pika-image-merge-visible-layers new-image CLIP-TO-IMAGE)))
(pika-item-set-name lighter-layer "lighter mask")
;; combine them
(pika-item-set-visible original-layer TRUE)
(pika-layer-set-mode darker-layer LAYER-MODE-SUBTRACT)
(pika-layer-set-opacity darker-layer mask-opacity)
(pika-item-set-visible darker-layer TRUE)
(pika-layer-set-mode lighter-layer LAYER-MODE-ADDITION)
(pika-layer-set-opacity lighter-layer mask-opacity)
(pika-item-set-visible lighter-layer TRUE)
(pika-image-undo-enable new-image)
(pika-displays-flush)
)
)
(script-fu-register "script-fu-unsharp-mask"
"Unsharp Mask..."
"Make a new image from the current layer by applying the unsharp mask method"
"Shuji Narazaki <narazaki@gimp.org>"
"Shuji Narazaki"
"1997,1998"
""
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable to apply" 0
SF-ADJUSTMENT _"Mask size" '(5 1 100 1 1 0 1)
SF-ADJUSTMENT _"Mask opacity" '(50 0 100 1 1 0 1)
)

110
plug-ins/script-fu/scripts/waves-anim.scm Normal file
View File

@ -0,0 +1,110 @@
; PIKA - Photo and Image Kooker Application
; 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/>.
;
;
; waves-anim.scm version 1.01 1997/12/13
;
; CHANGE-LOG:
; 1.00 - initial release
; 1.01 - some code cleanup, no real changes
;
; Copyright (C) 1997 Sven Neumann <sven@gimp.org>
;
;
; Makes a copy of your image and creates an animation of the active layer
; as if a stone was thrown into the image. The animation may be saved with
; the gif-plug-in.
(define (script-fu-waves-anim img
drawable
amplitude
wavelength
num-frames
invert)
(let* ((amplitude (max 0 amplitude))
(wavelength (max 0 wavelength))
(num-frames (max 1 num-frames))
(remaining-frames num-frames)
(phase 0)
(phaseshift (/ 360 num-frames))
(image (car (pika-image-duplicate img)))
(source-layer (aref (cadr (pika-image-get-selected-layers image)) 0)))
(pika-image-undo-disable image)
(if (= invert TRUE)
(set! phaseshift (- 0 phaseshift)))
(while (> remaining-frames 1)
(let* (
(waves-layer (car (pika-layer-copy source-layer TRUE)))
(layer-name (string-append "Frame "
(number->string
(- (+ num-frames 2)
remaining-frames) 10
)
" (replace)"))
)
(pika-layer-set-lock-alpha waves-layer FALSE)
(pika-image-insert-layer image waves-layer 0 -1)
(pika-item-set-name waves-layer layer-name)
(plug-in-waves RUN-NONINTERACTIVE
image
waves-layer
amplitude
phase
wavelength
0
FALSE)
(set! remaining-frames (- remaining-frames 1))
(set! phase (- phase phaseshift))
)
)
(pika-item-set-name source-layer "Frame 1")
(plug-in-waves RUN-NONINTERACTIVE
image
source-layer
amplitude
phase
wavelength
0
FALSE)
(pika-image-undo-enable image)
(pika-display-new image)
)
)
(script-fu-register "script-fu-waves-anim"
_"_Waves..."
_"Create a multi-layer image with an effect like a stone was thrown into the current image"
"Sven Neumann <sven@gimp.org>"
"Sven Neumann"
"1997/13/12"
"RGB* GRAY*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-ADJUSTMENT _"Amplitude" '(10 1 101 1 10 1 0)
SF-ADJUSTMENT _"Wavelength" '(10 0.1 100 1 10 1 0)
SF-ADJUSTMENT _"Number of frames" '(6 1 512 1 10 0 1)
SF-TOGGLE _"Invert direction" FALSE
)
(script-fu-menu-register "script-fu-waves-anim"
"<Image>/Filters/Animation/")

436
plug-ins/script-fu/scripts/weave.scm Normal file
View File

@ -0,0 +1,436 @@
; PIKA - Photo and Image Kooker Application
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
;
; Weave script --- make an image look as if it were woven
; Copyright (C) 1997 Federico Mena Quintero
; federico@nuclecu.unam.mx
;
; 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/>.
; Copies the specified rectangle from/to the specified drawable
(define (copy-rectangle img
drawable
x1
y1
width
height
dest-x
dest-y)
(pika-image-select-rectangle img CHANNEL-OP-REPLACE x1 y1 width height)
(pika-edit-copy 1 (vector drawable))
(let* (
(pasted (pika-edit-paste drawable FALSE))
(num-pasted (car pasted))
(floating-sel (aref (cadr pasted) (- num-pasted 1)))
)
(pika-layer-set-offsets floating-sel dest-x dest-y)
(pika-floating-sel-anchor floating-sel)
)
(pika-selection-none img))
; Creates a single weaving tile
(define (create-weave-tile ribbon-width
ribbon-spacing
shadow-darkness
shadow-depth)
(let* ((tile-size (+ (* 2 ribbon-width) (* 2 ribbon-spacing)))
(darkness (* 255 (/ (- 100 shadow-darkness) 100)))
(img (car (pika-image-new tile-size tile-size RGB)))
(drawable (car (pika-layer-new img tile-size tile-size RGB-IMAGE
"Weave tile" 100 LAYER-MODE-NORMAL))))
(pika-image-undo-disable img)
(pika-image-insert-layer img drawable 0 0)
(pika-context-set-background '(0 0 0))
(pika-drawable-edit-fill drawable FILL-BACKGROUND)
; Create main horizontal ribbon
(pika-context-set-foreground '(255 255 255))
(pika-context-set-background (list darkness darkness darkness))
(pika-image-select-rectangle img
CHANNEL-OP-REPLACE
0
ribbon-spacing
(+ (* 2 ribbon-spacing) ribbon-width)
ribbon-width)
(pika-context-set-gradient-fg-bg-rgb)
(pika-drawable-edit-gradient-fill drawable
GRADIENT-BILINEAR (- 100 shadow-depth)
FALSE 0 0
TRUE
(/ (+ (* 2 ribbon-spacing) ribbon-width -1) 2) 0
0 0)
; Create main vertical ribbon
(pika-image-select-rectangle img
CHANNEL-OP-REPLACE
(+ (* 2 ribbon-spacing) ribbon-width)
0
ribbon-width
(+ (* 2 ribbon-spacing) ribbon-width))
(pika-drawable-edit-gradient-fill drawable
GRADIENT-BILINEAR (- 100 shadow-depth)
FALSE 0 0
TRUE
0 (/ (+ (* 2 ribbon-spacing) ribbon-width -1) 2)
0 0)
; Create the secondary horizontal ribbon
(copy-rectangle img
drawable
0
ribbon-spacing
(+ ribbon-width ribbon-spacing)
ribbon-width
(+ ribbon-width ribbon-spacing)
(+ (* 2 ribbon-spacing) ribbon-width))
(copy-rectangle img
drawable
(+ ribbon-width ribbon-spacing)
ribbon-spacing
ribbon-spacing
ribbon-width
0
(+ (* 2 ribbon-spacing) ribbon-width))
; Create the secondary vertical ribbon
(copy-rectangle img
drawable
(+ (* 2 ribbon-spacing) ribbon-width)
0
ribbon-width
(+ ribbon-width ribbon-spacing)
ribbon-spacing
(+ ribbon-width ribbon-spacing))
(copy-rectangle img
drawable
(+ (* 2 ribbon-spacing) ribbon-width)
(+ ribbon-width ribbon-spacing)
ribbon-width
ribbon-spacing
ribbon-spacing
0)
; Done
(pika-image-undo-enable img)
(list img drawable)))
; Creates a complete weaving mask
(define (create-weave width
height
ribbon-width
ribbon-spacing
shadow-darkness
shadow-depth)
(let* ((tile (create-weave-tile ribbon-width ribbon-spacing shadow-darkness
shadow-depth))
(tile-img (car tile))
(tile-layer (cadr tile))
(weaving (plug-in-tile RUN-NONINTERACTIVE tile-img 1 (vector tile-layer) width height TRUE)))
(pika-image-delete tile-img)
weaving))
; Creates a single tile for masking
(define (create-mask-tile ribbon-width
ribbon-spacing
r1-x1
r1-y1
r1-width
r1-height
r2-x1
r2-y1
r2-width
r2-height
r3-x1
r3-y1
r3-width
r3-height)
(let* ((tile-size (+ (* 2 ribbon-width) (* 2 ribbon-spacing)))
(img (car (pika-image-new tile-size tile-size RGB)))
(drawable (car (pika-layer-new img tile-size tile-size RGB-IMAGE
"Mask" 100 LAYER-MODE-NORMAL))))
(pika-image-undo-disable img)
(pika-image-insert-layer img drawable 0 0)
(pika-context-set-background '(0 0 0))
(pika-drawable-edit-fill drawable FILL-BACKGROUND)
(pika-image-select-rectangle img CHANNEL-OP-REPLACE r1-x1 r1-y1 r1-width r1-height)
(pika-image-select-rectangle img CHANNEL-OP-ADD r2-x1 r2-y1 r2-width r2-height)
(pika-image-select-rectangle img CHANNEL-OP-ADD r3-x1 r3-y1 r3-width r3-height)
(pika-context-set-background '(255 255 255))
(pika-drawable-edit-fill drawable FILL-BACKGROUND)
(pika-selection-none img)
(pika-image-undo-enable img)
(list img drawable)))
; Creates a complete mask image
(define (create-mask final-width
final-height
ribbon-width
ribbon-spacing
r1-x1
r1-y1
r1-width
r1-height
r2-x1
r2-y1
r2-width
r2-height
r3-x1
r3-y1
r3-width
r3-height)
(let* ((tile (create-mask-tile ribbon-width ribbon-spacing
r1-x1 r1-y1 r1-width r1-height
r2-x1 r2-y1 r2-width r2-height
r3-x1 r3-y1 r3-width r3-height))
(tile-img (car tile))
(tile-layer (cadr tile))
(mask (plug-in-tile RUN-NONINTERACTIVE tile-img 1 (vector tile-layer) final-width final-height
TRUE)))
(pika-image-delete tile-img)
mask))
; Creates the mask for horizontal ribbons
(define (create-horizontal-mask ribbon-width
ribbon-spacing
final-width
final-height)
(create-mask final-width
final-height
ribbon-width
ribbon-spacing
0
ribbon-spacing
(+ (* 2 ribbon-spacing) ribbon-width)
ribbon-width
0
(+ (* 2 ribbon-spacing) ribbon-width)
ribbon-spacing
ribbon-width
(+ ribbon-width ribbon-spacing)
(+ (* 2 ribbon-spacing) ribbon-width)
(+ ribbon-width ribbon-spacing)
ribbon-width))
; Creates the mask for vertical ribbons
(define (create-vertical-mask ribbon-width
ribbon-spacing
final-width
final-height)
(create-mask final-width
final-height
ribbon-width
ribbon-spacing
(+ (* 2 ribbon-spacing) ribbon-width)
0
ribbon-width
(+ (* 2 ribbon-spacing) ribbon-width)
ribbon-spacing
0
ribbon-width
ribbon-spacing
ribbon-spacing
(+ ribbon-width ribbon-spacing)
ribbon-width
(+ ribbon-width ribbon-spacing)))
; Adds a threads layer at a certain orientation to the specified image
(define (create-threads-layer img
width
height
length
density
orientation)
(let* ((drawable (car (pika-layer-new img width height RGBA-IMAGE
"Threads" 100 LAYER-MODE-NORMAL)))
(dense (/ density 100.0)))
(pika-image-insert-layer img drawable 0 -1)
(pika-context-set-background '(255 255 255))
(pika-drawable-edit-fill drawable FILL-BACKGROUND)
(plug-in-noisify RUN-NONINTERACTIVE img drawable FALSE dense dense dense dense)
(plug-in-c-astretch RUN-NONINTERACTIVE img drawable)
(cond ((eq? orientation 'horizontal)
(plug-in-gauss-rle RUN-NONINTERACTIVE img drawable length TRUE FALSE))
((eq? orientation 'vertical)
(plug-in-gauss-rle RUN-NONINTERACTIVE img drawable length FALSE TRUE)))
(plug-in-c-astretch RUN-NONINTERACTIVE img drawable)
drawable))
(define (create-complete-weave width
height
ribbon-width
ribbon-spacing
shadow-darkness
shadow-depth
thread-length
thread-density
thread-intensity)
(let* ((weave (create-weave width height ribbon-width ribbon-spacing
shadow-darkness shadow-depth))
(w-img (car weave))
(w-layer (cadr weave))
(h-layer (create-threads-layer w-img width height thread-length
thread-density 'horizontal))
(h-mask (car (pika-layer-create-mask h-layer ADD-MASK-WHITE)))
(v-layer (create-threads-layer w-img width height thread-length
thread-density 'vertical))
(v-mask (car (pika-layer-create-mask v-layer ADD-MASK-WHITE)))
(hmask (create-horizontal-mask ribbon-width ribbon-spacing
width height))
(hm-img (car hmask))
(hm-layer (cadr hmask))
(vmask (create-vertical-mask ribbon-width ribbon-spacing width height))
(vm-img (car vmask))
(vm-layer (cadr vmask)))
(pika-layer-add-mask h-layer h-mask)
(pika-selection-all hm-img)
(pika-edit-copy 1 (vector hm-layer))
(pika-image-delete hm-img)
(let* (
(pasted (pika-edit-paste h-mask FALSE))
(num-pasted (car pasted))
(floating-sel (aref (cadr pasted) (- num-pasted 1)))
)
(pika-floating-sel-anchor floating-sel)
)
(pika-layer-set-opacity h-layer thread-intensity)
(pika-layer-set-mode h-layer LAYER-MODE-MULTIPLY)
(pika-layer-add-mask v-layer v-mask)
(pika-selection-all vm-img)
(pika-edit-copy 1 (vector vm-layer))
(pika-image-delete vm-img)
(let* (
(pasted (pika-edit-paste v-mask FALSE))
(num-pasted (car pasted))
(floating-sel (aref (cadr pasted) (- num-pasted 1)))
)
(pika-floating-sel-anchor floating-sel)
)
(pika-layer-set-opacity v-layer thread-intensity)
(pika-layer-set-mode v-layer LAYER-MODE-MULTIPLY)
; Uncomment this if you want to keep the weaving mask image
; (pika-display-new (car (pika-image-duplicate w-img)))
(list w-img
(car (pika-image-flatten w-img)))))
; The main weave function
(define (script-fu-weave img
drawable
ribbon-width
ribbon-spacing
shadow-darkness
shadow-depth
thread-length
thread-density
thread-intensity)
(pika-context-push)
(pika-image-undo-group-start img)
(let* (
(d-img (car (pika-item-get-image drawable)))
(d-width (car (pika-drawable-get-width drawable)))
(d-height (car (pika-drawable-get-height drawable)))
(d-offsets (pika-drawable-get-offsets drawable))
(weaving (create-complete-weave d-width
d-height
ribbon-width
ribbon-spacing
shadow-darkness
shadow-depth
thread-length
thread-density
thread-intensity))
(w-img (car weaving))
(w-layer (cadr weaving))
)
(pika-context-set-paint-mode LAYER-MODE-NORMAL)
(pika-context-set-opacity 100.0)
(pika-context-set-feather FALSE)
(pika-selection-all w-img)
(pika-edit-copy 1 (vector w-layer))
(pika-image-delete w-img)
(let* (
(pasted (pika-edit-paste drawable FALSE))
(num-pasted (car pasted))
(floating-sel (aref (cadr pasted) (- num-pasted 1)))
)
(pika-layer-set-offsets floating-sel
(car d-offsets)
(cadr d-offsets))
(pika-layer-set-mode floating-sel LAYER-MODE-MULTIPLY)
(pika-floating-sel-to-layer floating-sel)
)
)
(pika-context-pop)
(pika-image-undo-group-end img)
(pika-displays-flush)
)
(script-fu-register "script-fu-weave"
_"_Weave..."
_"Create a new layer filled with a weave effect to be used as an overlay or bump map"
"Federico Mena Quintero"
"Federico Mena Quintero"
"June 1997"
"RGB* GRAY*"
SF-IMAGE "Image to Weave" 0
SF-DRAWABLE "Drawable to Weave" 0
SF-ADJUSTMENT _"Ribbon width" '(30 0 256 1 10 1 1)
SF-ADJUSTMENT _"Ribbon spacing" '(10 0 256 1 10 1 1)
SF-ADJUSTMENT _"Shadow darkness" '(75 0 100 1 10 1 1)
SF-ADJUSTMENT _"Shadow depth" '(75 0 100 1 10 1 1)
SF-ADJUSTMENT _"Thread length" '(200 0 256 1 10 1 1)
SF-ADJUSTMENT _"Thread density" '(50 0 100 1 10 1 1)
SF-ADJUSTMENT _"Thread intensity" '(100 0 100 1 10 1 1)
)
(script-fu-menu-register "script-fu-weave"
"<Image>/Filters/Artistic")

142
plug-ins/script-fu/scripts/xach-effect.scm Normal file
View File

@ -0,0 +1,142 @@
; PIKA - Photo and Image Kooker Application
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
;
; xach effect script
; Copyright (c) 1997 Adrian Likins
; aklikins@eos.ncsu.edu
;
; based on a idea by Xach Beane <xach@mint.net>
;
;
; 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/>.
(define (script-fu-xach-effect image
drawable
hl-offset-x
hl-offset-y
hl-color
hl-opacity-comp
ds-color
ds-opacity
ds-blur
ds-offset-x
ds-offset-y
keep-selection)
(let* (
(ds-blur (max ds-blur 0))
(ds-opacity (min ds-opacity 100))
(ds-opacity (max ds-opacity 0))
(type (car (pika-drawable-type-with-alpha drawable)))
(image-width (car (pika-image-get-width image)))
(hl-opacity (list hl-opacity-comp hl-opacity-comp hl-opacity-comp))
(image-height (car (pika-image-get-height image)))
(active-selection 0)
(from-selection 0)
(theLayer 0)
(hl-layer 0)
(shadow-layer 0)
(mask 0)
)
(pika-context-push)
(pika-context-set-defaults)
(pika-image-undo-group-start image)
(pika-layer-add-alpha drawable)
(if (= (car (pika-selection-is-empty image)) TRUE)
(begin
(pika-image-select-item image CHANNEL-OP-REPLACE drawable)
(set! active-selection (car (pika-selection-save image)))
(set! from-selection FALSE))
(begin
(set! from-selection TRUE)
(set! active-selection (car (pika-selection-save image)))))
(set! hl-layer (car (pika-layer-new image image-width image-height type _"Highlight" 100 LAYER-MODE-NORMAL)))
(pika-image-insert-layer image hl-layer 0 -1)
(pika-selection-none image)
(pika-drawable-edit-clear hl-layer)
(pika-image-select-item image CHANNEL-OP-REPLACE active-selection)
(pika-context-set-background hl-color)
(pika-drawable-edit-fill hl-layer FILL-BACKGROUND)
(pika-selection-translate image hl-offset-x hl-offset-y)
(pika-drawable-edit-fill hl-layer FILL-BACKGROUND)
(pika-selection-none image)
(pika-image-select-item image CHANNEL-OP-REPLACE active-selection)
(set! mask (car (pika-layer-create-mask hl-layer ADD-MASK-WHITE)))
(pika-layer-add-mask hl-layer mask)
(pika-context-set-background hl-opacity)
(pika-drawable-edit-fill mask FILL-BACKGROUND)
(set! shadow-layer (car (pika-layer-new image
image-width
image-height
type
_"Shadow"
ds-opacity
LAYER-MODE-NORMAL)))
(pika-image-insert-layer image shadow-layer 0 -1)
(pika-selection-none image)
(pika-drawable-edit-clear shadow-layer)
(pika-image-select-item image CHANNEL-OP-REPLACE active-selection)
(pika-selection-translate image ds-offset-x ds-offset-y)
(pika-context-set-background ds-color)
(pika-drawable-edit-fill shadow-layer FILL-BACKGROUND)
(pika-selection-none image)
(plug-in-gauss-rle RUN-NONINTERACTIVE image shadow-layer ds-blur TRUE TRUE)
(pika-image-select-item image CHANNEL-OP-REPLACE active-selection)
(pika-drawable-edit-clear shadow-layer)
(pika-image-lower-item image shadow-layer)
(if (= keep-selection FALSE)
(pika-selection-none image))
(pika-image-set-selected-layers image 1 (vector drawable))
(pika-image-remove-channel image active-selection)
(pika-image-undo-group-end image)
(pika-displays-flush)
(pika-context-pop)
)
)
(script-fu-register "script-fu-xach-effect"
_"_Xach-Effect..."
_"Add a subtle translucent 3D effect to the selected region (or alpha)"
"Adrian Likins <adrian@gimp.org>"
"Adrian Likins"
"9/28/97"
"RGB* GRAY*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-ADJUSTMENT _"Highlight X offset" '(-1 -100 100 1 10 0 1)
SF-ADJUSTMENT _"Highlight Y offset" '(-1 -100 100 1 10 0 1)
SF-COLOR _"Highlight color" "white"
SF-ADJUSTMENT _"Highlight opacity" '(66 0 255 1 10 0 0)
SF-COLOR _"Drop shadow color" "black"
SF-ADJUSTMENT _"Drop shadow opacity" '(100 0 100 1 10 0 0)
SF-ADJUSTMENT _"Drop shadow blur radius" '(12 0 255 1 10 0 1)
SF-ADJUSTMENT _"Drop shadow X offset" '(5 0 255 1 10 0 1)
SF-ADJUSTMENT _"Drop shadow Y offset" '(5 0 255 1 10 0 1)
SF-TOGGLE _"Keep selection" TRUE
)
(script-fu-menu-register "script-fu-xach-effect"
"<Image>/Filters/Light and Shadow/[Shadow]")