; 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.
(define (script-fu-sg-dump-path-values image drawable output-dir basename)
(define (stroke-get-pts layer path stroke)
(let* ((x0 (car (gimp-drawable-offsets layer)))
(y0 (cadr (gimp-drawable-offsets layer)))
(x1 (+ x0 (car (gimp-drawable-width layer))))
(y1 (+ y0 (car (gimp-drawable-height layer)))))
(let ((path-length (car (gimp-vectors-stroke-get-length path stroke 0.25))))
(let loop ((dist 0)
(pts '()))
(if (>= dist path-length)
(reverse pts)
(let* ((pt-info (gimp-vectors-stroke-get-point-at-dist path stroke dist 0.5))
(px (car pt-info))
(py (cadr pt-info)))
(loop (+ dist 0.5)
(if (or (zero? (cadddr pt-info))
(< px x0)
(< py y0)
(>= px x1)
(>= py y1))
pts
(cons (cadr pt-info) (cons (car pt-info) pts))))))))))
(define (get-value layer x y)
(let ((dx (- x (truncate x)))
(left? #t)
(dy (- y (truncate y)))
(upper? #t))
(if (< dx 0.5)
(set! dx (- 0.5 dx))
(begin
(set! dx (- dx 0.5))
(set! left? #f)))
(if (< dy 0.5)
(set! dy (- 0.5 dy))
(begin
(set! dy (- dy 0.5))
(set! upper? #f)))
(let ((rx (- 1 dx))
(ry (- 1 dy))
(lx (car (gimp-drawable-offsets layer)))
(ly (cadr (gimp-drawable-offsets layer))))
(let* ((x0 (- (if left?
(max lx (- (floor x) 1))
(floor x)) lx))
(y0 (- (if upper?
(max ly (- (floor y) 1))
(floor y)) ly))
(x1 (- (if left?
(floor x)
(min (- (+ lx (car (gimp-drawable-width layer))) 1)
(ceiling x))) lx))
(y1 (- (if upper?
(floor y)
(min (- (+ ly (car (gimp-drawable-height layer))) 1)
(ceiling y))) ly)))
(+ (* dx
dy
(vector-ref (cadr (gimp-drawable-get-pixel layer x0 y0)) 0))
(* rx
dy
(vector-ref (cadr (gimp-drawable-get-pixel layer x0 y1)) 0))
(* dx
ry
(vector-ref (cadr (gimp-drawable-get-pixel layer x1 y0)) 0))
(* rx
ry
(vector-ref (cadr (gimp-drawable-get-pixel layer x1 y1)) 0)))))))
(let* ((path (car (gimp-image-get-active-vectors image)))
(all-strokes (vector->list (cadr (gimp-vectors-get-strokes path)))))
(gimp-image-undo-freeze image)
(let ((layer (car (gimp-layer-copy drawable FALSE))))
(gimp-image-insert-layer image layer 0 -1)
(let loop-strokes ((strokes all-strokes)
(stroke-id (if (= (length all-strokes) 1) 0 1)))
(if (null? strokes)
(gimp-progress-end)
(begin
(let ((filename (string-append output-dir
(if (string=? output-dir "")
""
DIR-SEPARATOR)
basename
(if (zero? stroke-id)
""
(string-append "-" (number->string stroke-id)))
".csv")))
(with-output-to-file filename
(lambda ()
(let ((all-pts (stroke-get-pts layer path (car strokes))))
(let loop-pts ((pts all-pts)
(lastx (truncate (car all-pts)))
(lasty (truncate (cadr all-pts))))
(unless (null? pts)
(let* ((x (car pts))
(y (cadr pts))
(ix (truncate x))
(iy (truncate y)))
(unless (and (= ix lastx)
(= iy lasty))
(display x) (display ",")
(display y) (display ",")
(display (truncate (get-value layer x y)))
(newline)
(gimp-progress-pulse))
(loop-pts (cddr pts)
ix
iy))))))))
(loop-strokes (cdr strokes)
(+ stroke-id 1)))))
(gimp-image-remove-layer image layer))
(gimp-image-undo-thaw image)))
(script-fu-register "script-fu-sg-dump-path-values"
"Dump Path Values..."
"Sample pixels along path and save to CSV file"
"Saul Goode"
"Saul Goode"
"December 2014"
"RGB*,GRAY*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-DIRNAME "Output Folder" ""
SF-STRING "Filename (.csv will be appended)" "path-values"
)
(script-fu-menu-register "script-fu-sg-dump-path-values"
"<Image>/Filters/Misc"
)