"Fossies" - the Fresh Open Source Software Archive

Member "gimp-2.10.28/plug-ins/script-fu/scripts/add-bevel.scm" (14 Sep 2021, 7083 Bytes) of package /linux/misc/gimp-2.10.28.tar.bz2:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Lisp source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "add-bevel.scm": 2.99.4_vs_2.99.6.

    1 ; GIMP - The GNU Image Manipulation Program
    2 ; Copyright (C) 1995 Spencer Kimball and Peter Mattis
    3 ;
    4 ; add-bevel.scm version 1.04
    5 ; Time-stamp: <2004-02-09 17:07:06 simon>
    6 ;
    7 ; This program is free software: you can redistribute it and/or modify
    8 ; it under the terms of the GNU General Public License as published by
    9 ; the Free Software Foundation; either version 3 of the License, or
   10 ; (at your option) any later version.
   11 ;
   12 ; This program is distributed in the hope that it will be useful,
   13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
   14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15 ; GNU General Public License for more details.
   16 ;
   17 ; You should have received a copy of the GNU General Public License
   18 ; along with this program.  If not, see <https://www.gnu.org/licenses/>.
   19 ;
   20 ; Copyright (C) 1997 Andrew Donkin  (ard@cs.waikato.ac.nz)
   21 ; Contains code from add-shadow.scm by Sven Neumann
   22 ; (neumanns@uni-duesseldorf.de) (thanks Sven).
   23 ;
   24 ; Adds a bevel to an image.  See http://www.cs.waikato.ac.nz/~ard/gimp/
   25 ;
   26 ; If there is a selection, it is bevelled.
   27 ; Otherwise if there is an alpha channel, the selection is taken from it
   28 ; and bevelled.
   29 ; Otherwise the part of the layer inside the image boundaries is bevelled.
   30 ;
   31 ; The selection is set on exit, so Select->Invert then Edit->Clear will
   32 ; leave a cut-out.  Then use Sven's add-shadow for that
   33 ; floating-bumpmapped-texture cliche.
   34 
   35 ;
   36 ; 1.01: now works on offset layers.
   37 ; 1.02: has crop-pixel-border option to trim one pixel off each edge of the
   38 ;       bevelled image.  Bumpmapping leaves edge pixels unchanged, which
   39 ;       looks bad.  Oddly, this is not apparent in GIMP - you have to
   40 ;       save the image and load it into another viewer.  First noticed in
   41 ;       Nutscrape.
   42 ;       Changed path (removed "filters/").
   43 ; 1.03: adds one-pixel border before bumpmapping, and removes it after.
   44 ;       Got rid of the crop-pixel-border option (no longer reqd).
   45 ; 1.04: Fixed undo handling, ensure that bumpmap is big enough,
   46 ;       (instead of resizing the image). Removed references to outdated
   47 ;       bumpmap plugin.     (Simon)
   48 ; 1.05  When there is no selection, bevel the whole layer instead of the
   49 ;       whole image (which was broken in the first place).
   50 ;       Also fixed some bugs with setting the selection when there is no
   51 ;       initial selection.     (Barak Itkin)
   52 ;
   53 
   54 (define (script-fu-add-bevel img
   55                              drawable
   56                              thickness
   57                              work-on-copy
   58                              keep-bump-layer)
   59 
   60   (let* (
   61         (index 1)
   62         (greyness 0)
   63         (thickness (abs thickness))
   64         (type (car (gimp-drawable-type-with-alpha drawable)))
   65         (image (if (= work-on-copy TRUE) (car (gimp-image-duplicate img)) img))
   66         (pic-layer (car (gimp-image-get-active-drawable image)))
   67         (offsets (gimp-drawable-offsets pic-layer))
   68         (width (car (gimp-drawable-width pic-layer)))
   69         (height (car (gimp-drawable-height pic-layer)))
   70 
   71         ; Bumpmap has a one pixel border on each side
   72         (bump-layer (car (gimp-layer-new image
   73                                          (+ width 2)
   74                                          (+ height 2)
   75                                          RGB-IMAGE
   76                                          _"Bumpmap"
   77                                          100
   78                                          LAYER-MODE-NORMAL)))
   79 
   80         (selection-exists (car (gimp-selection-bounds image)))
   81         (selection 0)
   82         )
   83 
   84     (gimp-context-push)
   85     (gimp-context-set-defaults)
   86 
   87     ; disable undo on copy, start group otherwise
   88     (if (= work-on-copy TRUE)
   89       (gimp-image-undo-disable image)
   90       (gimp-image-undo-group-start image)
   91     )
   92 
   93     (gimp-image-insert-layer image bump-layer 0 1)
   94 
   95     ; If the layer we're bevelling is offset from the image's origin, we
   96     ; have to do the same to the bumpmap
   97     (gimp-layer-set-offsets bump-layer (- (car offsets) 1)
   98                                        (- (cadr offsets) 1))
   99 
  100     ;------------------------------------------------------------
  101     ;
  102     ; Set the selection to the area we want to bevel.
  103     ;
  104     (if (= selection-exists 0)
  105         (gimp-image-select-item image CHANNEL-OP-REPLACE pic-layer)
  106     )
  107 
  108     ; Store it for later.
  109     (set! selection (car (gimp-selection-save image)))
  110     ; Try to lose the jaggies
  111     (gimp-selection-feather image 2)
  112 
  113     ;------------------------------------------------------------
  114     ;
  115     ; Initialise our bumpmap
  116     ;
  117     (gimp-context-set-background '(0 0 0))
  118     (gimp-drawable-fill bump-layer FILL-BACKGROUND)
  119 
  120     (while (and (< index thickness)
  121                 (= (car (gimp-selection-is-empty image)) FALSE)
  122            )
  123            (set! greyness (/ (* index 255) thickness))
  124            (gimp-context-set-background (list greyness greyness greyness))
  125            ;(gimp-selection-feather image 1) ;Stop the slopey jaggies?
  126            (gimp-drawable-edit-fill bump-layer FILL-BACKGROUND)
  127            (gimp-selection-shrink image 1)
  128            (set! index (+ index 1))
  129     )
  130     ; Now the white interior
  131     (if (= (car (gimp-selection-is-empty image)) FALSE)
  132         (begin
  133           (gimp-context-set-background '(255 255 255))
  134           (gimp-drawable-edit-fill bump-layer FILL-BACKGROUND)
  135         )
  136     )
  137 
  138     ;------------------------------------------------------------
  139     ;
  140     ; Do the bump.
  141     ;
  142     (gimp-selection-none image)
  143 
  144     ; To further lessen jaggies?
  145     ;(plug-in-gauss-rle RUN-NONINTERACTIVE image bump-layer thickness TRUE TRUE)
  146 
  147 
  148     ;
  149     ; BUMPMAP INVOCATION:
  150     ;
  151     (plug-in-bump-map RUN-NONINTERACTIVE image pic-layer bump-layer 125 45 3 0 0 0 0 TRUE FALSE 1)
  152 
  153     ;------------------------------------------------------------
  154     ;
  155     ; Restore things
  156     ;
  157     (if (= selection-exists 0)
  158         (gimp-selection-none image)        ; No selection to start with
  159         (gimp-image-select-item image CHANNEL-OP-REPLACE selection)
  160     )
  161     ; If they started with a selection, they can Select->Invert then
  162     ; Edit->Clear for a cutout.
  163 
  164     ; clean up
  165     (gimp-image-remove-channel image selection)
  166     (if (= keep-bump-layer TRUE)
  167         (gimp-item-set-visible bump-layer 0)
  168         (gimp-image-remove-layer image bump-layer)
  169     )
  170 
  171     (gimp-image-set-active-layer image pic-layer)
  172 
  173     ; enable undo / end undo group
  174     (if (= work-on-copy TRUE)
  175       (begin
  176         (gimp-display-new image)
  177         (gimp-image-undo-enable image)
  178       )
  179       (gimp-image-undo-group-end image)
  180     )
  181 
  182     (gimp-displays-flush)
  183 
  184     (gimp-context-pop)
  185   )
  186 )
  187 
  188 (script-fu-register "script-fu-add-bevel"
  189   _"Add B_evel..."
  190   _"Add a beveled border to an image"
  191   "Andrew Donkin <ard@cs.waikato.ac.nz>"
  192   "Andrew Donkin"
  193   "1997/11/06"
  194   "RGB*"
  195   SF-IMAGE       "Image"           0
  196   SF-DRAWABLE    "Drawable"        0
  197   SF-ADJUSTMENT _"Thickness"       '(5 0 30 1 2 0 0)
  198   SF-TOGGLE     _"Work on copy"    TRUE
  199   SF-TOGGLE     _"Keep bump layer" FALSE
  200 )
  201 
  202 (script-fu-menu-register "script-fu-add-bevel" "<Image>/Filters/Decor")