; 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-colors image drawable output-dir basename xy-prec)
(define (stroke-get-pts path stroke ptperpx)
(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 (/ ptperpx))))
(loop (+ dist (/ ptperpx))
(if (zero? (cadddr pt-info))
pts
(cons (cadr pt-info) (cons (car pt-info) pts)))))))))
(let* ((path (car (gimp-image-get-active-vectors image)))
(strokes (vector->list (cadr (gimp-vectors-get-strokes path))))
(xy-prec (vector-ref #(1 10 100 1000) xy-prec)))
(let loop-strokes ((strokes strokes)
(stroke-id (if (= (length strokes) 1) 0 1)))
(if (null? strokes)
(gimp-progress-end)
(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 path (car strokes) 5)))
(let loop-pts ((pts all-pts)
(lastx (truncate (car all-pts)))
(lasty (truncate (cadr all-pts))))
(unless (null? pts)
(let ((x (truncate (car pts)))
(y (truncate (cadr pts))))
(unless (and (= x lastx)
(= y lasty))
(let ((px (if (= 1 xy-prec)
(inexact->exact (truncate (car pts)))
(/ (truncate (* (car pts) xy-prec)) xy-prec)))
(py (if (= 1 xy-prec)
(inexact->exact (truncate (cadr pts)))
(/ (truncate (* (cadr pts) xy-prec)) xy-prec))))
(display px) (display ",")
(display py)
(let loop-colors ((colors (vector->list (cadr (gimp-drawable-get-pixel drawable x y)))))
(unless (null? colors)
(display ",") (display (car colors))
(loop-colors (cdr colors)))))
(newline)
(gimp-progress-pulse))
(loop-pts (cddr pts)
x
y)))))))
(loop-strokes (cdr strokes)
(+ stroke-id 1)))))))
(script-fu-register "script-fu-sg-dump-path-colors"
"Dump Path Colors..."
"Sample colors 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-colors"
SF-OPTION "X-Y Precision" '("1." "0.1" "0.01" "0.001")
)
(script-fu-menu-register "script-fu-sg-dump-path-colors"
"<Image>/Filters/Misc"
)