GIMP Script-fu

Artifact Content
Login

Artifact f510b2955430dec7dbced70529cf56d3f505fef2:


; 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.

;; To use this script, create path stroke consisting of two points (the
;; reference points of the source image), hold down the SHIFT key and
;; click on the location to where the first source point should be moved,
;; release the SHIFT key and click on the location to where the second 
;; source point should be moved. You should have a path consisting of two
;; strokes, and each stroke should have to points.
;;
;; The active layer will be rotated, scaled, and moved such that the two
;; reference points get moved to their corresponding target points.

(define (script-fu-sg-fit-face image drawable)
  (define (atan2 y x)
    (if (> x 0)
      (atan (/ y x))
      (if (< x 0)
        (if (< y 0)
          (- (atan (/ y x)) *pi*)
          (+ (atan (/ y x)) *pi*) )
        (cond ;; x is zero
          ((> y 0) (/ *pi* 2))
          ((< y 0) (- (/ *pi* 2)))
          (else ;; x==y==0 is typically undefined but we return 0 instead
            0 ) ) ) ) )
  (let* (
      (source drawable)
      (path 0)
      (strokes 0)
      )
    (set! path (car (gimp-image-get-active-vectors image)))
    (if (= path -1)
      (gimp-message "Must supply a path consisting of two strokes")
      (begin
        (set! strokes (gimp-vectors-get-strokes path))
        (if (<> (car strokes) 2)
          (gimp-message "Must supply a path consisting of two strokes")
          (let* ((orig-aspect (/ (car (gimp-drawable-width source)) (car (gimp-drawable-height source))))
                 (aspect 0)
                 (strokes (cadr strokes))
                 (src-pts (caddr (gimp-vectors-stroke-get-points path (vector-ref strokes 0))))
                 (tgt-pts (caddr (gimp-vectors-stroke-get-points path (vector-ref strokes 1))))
                 (sx1 (vector-ref src-pts 2))
                 (sy1 (vector-ref src-pts 3))
                 (sx2 (vector-ref src-pts 8))
                 (sy2 (vector-ref src-pts 9))
                 (tx1 (vector-ref tgt-pts 2))
                 (ty1 (vector-ref tgt-pts 3))
                 (tx2 (vector-ref tgt-pts 8))
                 (ty2 (vector-ref tgt-pts 9))
                 (src-dist (sqrt (+ (pow (- sx2 sx1) 2) (pow (- sy2 sy1) 2))))
                 (tgt-dist (sqrt (+ (pow (- tx2 tx1) 2) (pow (- ty2 ty1) 2))))
                 (scale-factor (/ tgt-dist src-dist))
                 (src-angle (atan2 (- sy2 sy1) (- sx2 sx1) ))
                 (tgt-angle (atan2 (- ty2 ty1) (- tx2 tx1) ))
                 (angle (- src-angle tgt-angle))
                 (orig-sel 0)
                 )
            (gimp-image-undo-group-start image)
            (set! orig-sel (car (gimp-selection-save image)))
            (gimp-selection-none image)
            (gimp-layer-set-offsets source
                                    (- (car  (gimp-drawable-offsets source)) sx1)
                                    (- (cadr (gimp-drawable-offsets source)) sy1)
                                    )
            (gimp-drawable-transform-rotate source
                                            angle
                                            FALSE 
                                            0 0 
                                            TRANSFORM-BACKWARD
                                            INTERPOLATION-CUBIC 
                                            TRUE
                                            3
                                            TRANSFORM-RESIZE-ADJUST
                                            )
            (let* ((w (car (gimp-drawable-width source)))
                   (h (car (gimp-drawable-height source)))
                   (ar-ratio (/ orig-aspect (/ w h))) )
              (gimp-layer-resize source
                                 (max w (* w ar-ratio))
                                 (max h (/ h ar-ratio))
                                 0
                                 0 ) )
            (gimp-layer-scale-full source
                                   (* (car (gimp-drawable-width source)) scale-factor)
                                   (* (car (gimp-drawable-height source)) scale-factor)
                                   FALSE
                                   INTERPOLATION-CUBIC
                                   )
            (gimp-layer-set-offsets source
                                    (+ (car  (gimp-drawable-offsets source)) tx1)
                                    (+ (cadr (gimp-drawable-offsets source)) ty1)
                                    )
            (gimp-displays-flush)
            (gimp-selection-load orig-sel)
            (gimp-image-remove-channel image orig-sel)
            (gimp-image-undo-group-end image)
            )
          )
        )
      )
    )
  )

(script-fu-register "script-fu-sg-fit-face"
 "Fit face to path"
 "Scale, rotate, and move active layer based on active path"
 "Saul Goode"
 "Saul Goode"
 "1/7/2010"
 "*"
 SF-IMAGE    "Image"    0
 SF-DRAWABLE "Drawable"  0
 )

(script-fu-menu-register "script-fu-sg-fit-face"
                         "<Image>/Layer")