; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation; either version 2 of the License, or
; (at your option) any later version.
;
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
; GNU General Public License for more details.
;
; The GNU Public License is available at
; http://www.gnu.org/copyleft/gpl.html
(define (script-fu-sg-anti-crop image drawable)
;; Routine that selects box using image coordinates
(define (sel-box img box)
(gimp-rect-select img (car box) (cadr box)
(- (caddr box) (car box)) (- (cadr (cddr box)) (cadr box)) 2 0 0)
)
;; Routine to check if a box is zero-size
(define (box-exists? box)
(let* (
(not-empty TRUE)
)
(unless (null? box)
(if (= (car box) (caddr box))
(set! not-empty FALSE)
(if (= (cadr box) (caddr (cdr box)))
(set! not-empty FALSE)
)
)
)
not-empty
)
)
(let* (
(layer (car (gimp-image-get-active-layer image)))
(layer-name (car (gimp-drawable-get-name layer)))
(lay-x2 0)
(lay-y2 0)
(sel-bounds (gimp-selection-bounds image))
(orig-img-width (car (gimp-image-width image)))
(orig-img-height (car (gimp-image-height image)))
(orig-img-offset-x (car (gimp-drawable-offsets layer)))
(orig-img-offset-y (cadr (gimp-drawable-offsets layer)))
(box's (cdr sel-bounds)) ;; box's temporarily used for setting the selection bounds
(sel-x1 (car box's))
(sel-y1 (cadr box's))
(sel-x2 (cadr (cdr box's)))
(sel-y2 (caddr (cdr box's)))
(old-message-handler (car (gimp-message-get-handler)))
(offsets ())
(float-layer ())
(newlayer's ())
(newmade FALSE) ;; In case ALL was selected nothing is done
(pos 0)
)
(gimp-context-push)
(gimp-image-undo-group-start image)
;; Temporarily resize the canvas to assure layer is inside image
(gimp-image-resize image (car (gimp-drawable-width layer)) (car (gimp-drawable-height layer))
(- orig-img-offset-x) (- orig-img-offset-y))
(set! sel-bounds (gimp-drawable-mask-bounds layer))
(sel-box image (cdr sel-bounds)) ;; hard-code the selection
(set! box's (cdr sel-bounds)) ;; box's is temporarily used for setting the selection bounds
;; lay-x1 and lay-y1 == 0 because of canvas being resized to layer
(set! lay-x2 (car (gimp-drawable-width layer)))
(set! lay-y2 (car (gimp-drawable-height layer)))
(set! sel-x1 (car box's)) ;; adjust selection for canvas resizing
(set! sel-y1 (cadr box's))
(set! sel-x2 (cadr (cdr box's)))
(set! sel-y2 (caddr (cdr box's)))
(set! box's ()) ;; just to be sure
(if (= (car (gimp-selection-is-empty image)) TRUE)
(begin ;; NOTE: This code should never be executed (just to be safe though)
(gimp-message-set-handler MESSAGE-BOX)
(gimp-message "You must select something first.")
(gimp-message-set-handler old-message-handler)
)
(begin ;; OK, we have a valid selection
(if (and (= 0 sel-x1) (= lay-x2 sel-x2))
(begin ;; HORIZONTAL SELECTION
(set! box's ;; Use the top and bottom "middle" box's
(list
(list sel-x1 0 sel-x2 sel-y1) ;; SL LT SR ST
(list sel-x1 sel-y2 sel-x2 lay-y2) ;; SL SB SR LB
)
)
;; OFFSETS ( 0 0 ) ( 0 sy1-sy2)
(set! offsets
(list
(list 0 (- sel-y1 sel-y2))
)
)
)
(begin
(if (and (= 0 sel-y1) (= lay-y2 sel-y2))
(begin
(set! box's ;; Use the left and right "middle" box's
(list
(list 0 sel-y1 sel-x1 sel-y2) ;; LL ST SL SB
(list sel-x2 sel-y1 lay-x2 sel-y2) ;; SR ST LR SB
)
)
; OFFSETS ( 0 0 ) ( sx1-sx2 0)
(set! offsets
(list
(list (- sel-x1 sel-x2) 0)
)
)
)
(begin ;; DIAGONAL
(set! box's ;; Use the four corners
(list
(list 0 0 sel-x1 sel-y1) ;; LL LT SL ST
(list sel-x2 0 lay-x2 sel-y1) ;; SR LT LR ST
(list 0 sel-y2 sel-x1 lay-y2) ;; LL SB SL LB
(list sel-x2 sel-y2 lay-x2 lay-y2) ;; SR SB LR LB
)
)
; OFFSETS ( 0 0 ) ( sel-x1-sx2 0 ) (0 sy1-sy2) ( sx1-sy2)
(set! offsets
(list
(list (- sel-x1 sel-x2) 0)
(list 0 (- sel-y1 sel-y2))
(list (- sel-x1 sel-x2) (- sel-y1 sel-y2))
)
)
)
)
)
)
(if (= (box-exists? (car box's)) TRUE)
(begin
(set! newmade TRUE)
(sel-box image (car box's))
(set! float-layer (gimp-selection-float layer 0 0)) ;; 1st box is zero offset
(set! newlayer's (append newlayer's float-layer)) ;; add layer to the list
(gimp-floating-sel-to-layer (car float-layer)) ;; create new layer
)
)
(unless (null? box's)
(set! box's (cdr box's)) ;; next box
)
(while (pair? box's)
(if (= (box-exists? (car box's)) TRUE)
(begin
(set! newmade TRUE)
(sel-box image (car box's))
(set! float-layer (gimp-selection-float layer (car (car offsets)) (cadr (car offsets))))
(set! newlayer's (append newlayer's float-layer)) ;; add layer to the list
(gimp-floating-sel-to-layer (car float-layer)) ;; create new layer
)
)
(set! box's (cdr box's))
(set! offsets (cdr offsets))
)
;; New layers are generated we just have to merge them
(unless (null? newlayer's)
(set! newlayer's (cdr newlayer's))
)
(while (pair? newlayer's) ;; newlayer's value isn't used, it just "counts" the layers
(set! float-layer (gimp-image-merge-down image (car float-layer) EXPAND-AS-NECESSARY))
(set! newlayer's (cdr newlayer's))
)
;; Now center the new layer (relative to original)
(if (= newmade TRUE)
(begin
(gimp-layer-set-offsets (car float-layer)
(/ (- (car (gimp-drawable-width layer)) (car (gimp-drawable-width (car float-layer)))) 2)
(/ (- (car (gimp-drawable-height layer)) (car (gimp-drawable-height (car float-layer)))) 2)
)
(while (< pos (car (gimp-image-get-layer-position image layer)))
(gimp-image-lower-layer image (car float-layer))
(set! pos (+ pos 1))
)
(gimp-image-remove-layer image layer)
(gimp-drawable-set-name (car float-layer) layer-name)
)
)
)
)
;; reset canvas
(gimp-image-resize image orig-img-width orig-img-height orig-img-offset-x orig-img-offset-y)
(gimp-image-undo-group-end image)
(gimp-displays-flush)
(gimp-message-set-handler old-message-handler)
(gimp-context-pop)
)
)
(script-fu-register "script-fu-sg-anti-crop"
"Anticro_p"
"Crops away the selection"
"Saul Goode"
"Saul Goode"
"1/29/2006"
"*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
)
(script-fu-menu-register "script-fu-sg-anti-crop"
"<Image>/Layer"
)