; 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"
"<Image>/Layer"
)