; 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")