; 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) (cond ((null? box) #f) ((= (car box) (caddr box)) #f) ((= (cadr box) (cadddr box)) #f) (else #t) ) ) (let* ((layer (car (gimp-image-get-active-layer image))) (layer-name (car (gimp-drawable-get-name layer))) (sel-bounds (cdr (gimp-drawable-mask-bounds layer))) (layer-left (car (gimp-drawable-offsets layer))) (layer-top (cadr (gimp-drawable-offsets layer))) (layer-right (+ layer-left (car (gimp-drawable-width layer)))) (layer-bottom (+ layer-top (car (gimp-drawable-height layer)))) (image-width (car (gimp-image-width image))) (image-height (car (gimp-image-height image))) (selection-left (+ layer-left (car sel-bounds))) (selection-top (+ layer-top (cadr sel-bounds))) (selection-right (+ layer-left (caddr sel-bounds))) (selection-bottom (+ layer-top (cadddr sel-bounds))) (old-message-handler (car (gimp-message-get-handler))) (offsets '()) (boxes '()) (float-layer 0) (newlayers '()) (newmade? #f) ;; In case ALL was selected nothing is done (pos 0) ) (gimp-context-push) (gimp-image-undo-group-start image) (set! boxes '()) (if (or (= (car (gimp-selection-is-empty image)) TRUE) (zero? (car (gimp-drawable-mask-intersect layer))) ) (begin (gimp-message-set-handler MESSAGE-BOX) (gimp-message "You must select part of the layer first.") (gimp-message-set-handler old-message-handler) ) (begin ;; OK, we have a valid selection (cond ((and (= layer-left selection-left) (= layer-right selection-right)) (set! boxes ;; Horizontal - use the top and bottom "middle" boxes (list (list selection-left layer-top selection-right selection-top) (list selection-left selection-bottom selection-right layer-bottom) )) (set! offsets (list '(0 0) ;; first box is always directly above original (list 0 (- selection-top selection-bottom)) ))) ((and (= layer-top selection-top) (= layer-bottom selection-bottom)) (begin (set! boxes ;; Vertical - use the left and right "middle" boxes (list (list layer-left selection-top selection-left selection-bottom) (list selection-right selection-top layer-right selection-bottom) )) (set! offsets (list '(0 0) ;; first box is always directly above original (list (- selection-left selection-right) 0) )))) (else (set! boxes ;; Diagonal - use the four corners (list (list layer-left layer-top selection-left selection-top) (list selection-right layer-top layer-right selection-top) (list layer-left selection-bottom selection-left layer-bottom) (list selection-right selection-bottom layer-right layer-bottom) )) ; OFFSETS ( 0 0 ) ( selection-left-sx2 0 ) (0 sy1-sy2) ( sx1-sy2) (set! offsets (list '(0 0) ;; first box is always directly above original (list (- selection-left selection-right) 0) (list 0 (- selection-top selection-bottom)) (list (- selection-left selection-right) (- selection-top selection-bottom)) )))) (while (pair? boxes) (when (box-exists? (car boxes)) (set! newmade? #t) (sel-box image (car boxes)) (set! float-layer (car (gimp-selection-float layer (caar offsets) (cadar offsets)))) (set! newlayers (cons float-layer newlayers)) ;; add layer to the list (gimp-floating-sel-to-layer float-layer) ) (set! boxes (cdr boxes)) (set! offsets (cdr offsets)) ) ;; New layers are generated, we just have to merge them (unless (null? newlayers) (set! newlayers (cdr (reverse newlayers))) ;; we don't need to merge the first new layer ) (while (pair? newlayers) ;; newlayers value isn't used, it just "counts" the layers (set! float-layer (car (gimp-image-merge-down image float-layer EXPAND-AS-NECESSARY))) (set! newlayers (cdr newlayers)) ) ;; Now center the new layer (relative to original) (when newmade? (gimp-layer-set-offsets float-layer (+ layer-left (/ (- (car (gimp-drawable-width layer)) (car (gimp-drawable-width float-layer))) 2)) (+ layer-top (/ (- (car (gimp-drawable-height layer)) (car (gimp-drawable-height float-layer))) 2)) ) (while (< pos (car (gimp-image-get-layer-position image layer))) (gimp-image-lower-layer image float-layer) (set! pos (+ pos 1)) ) (gimp-image-remove-layer image layer) (gimp-drawable-set-name float-layer layer-name) ))) ;; reset canvas (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" "/Layer" )