GIMP Script-fu

Artifact Content

Artifact 4ca3cf6d086c435e8fb20520e5acc5b472fe0cef:

; 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
; GNU General Public License for more details.
; The GNU Public License is available at

(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)
      ((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-image-undo-group-start image)

    (set! boxes '())
    (if (or (= (car (gimp-selection-is-empty image)) TRUE)
            (zero? (car (gimp-drawable-mask-intersect layer))) )
        (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
          ((and (= layer-left selection-left) (= layer-right selection-right))
            (set! boxes ;; Horizontal - use the top and bottom "middle" boxes
                (list selection-left layer-top selection-right selection-top)
                (list selection-left selection-bottom selection-right layer-bottom) ))
            (set! offsets 
                '(0 0) ;; first box is always directly above original
                (list 0 (- selection-top selection-bottom)) )))
          ((and (= layer-top selection-top) (= layer-bottom selection-bottom))
              (set! boxes ;; Vertical - use the left and right "middle" boxes
                  (list layer-left selection-top selection-left selection-bottom)
                  (list selection-right selection-top layer-right selection-bottom) ))
              (set! offsets 
                  '(0 0) ;; first box is always directly above original
                  (list (- selection-left selection-right) 0) ))))
            (set! boxes ;; Diagonal - use the four corners
                 (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 
                 '(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-message-set-handler old-message-handler)

(script-fu-register "script-fu-sg-anti-crop"
 "Crops away the selection"
 "Saul Goode"
 "Saul Goode"
 SF-IMAGE    "Image"    0
 SF-DRAWABLE "Drawable" 0
(script-fu-menu-register "script-fu-sg-anti-crop"