;;; Load GIMP Gradients. Kind of.
;;; 2014

(use-modules (ice-9 match)
	     (ice-9 rdelim)

	     (rnrs enums)
	     (srfi srfi-9)
	     (srfi srfi-26))

(define +default-steps+ 1024)

(define-enumeration blend-function
  (linear curved sinusoidal spherical-increasing spherical-decreaing)
  blend-functions)

(define-enumeration color-model
  (rgb hsv-counter hsv-clockwise)
  color-models)

;; Gradients are just a list of gradient-segment
#;(define-record-type <gradient-segment>
  (make-gradient-segment left-pos left-color mid-pos mid-color right-pos right-color)
  gradient-segment?
  (left-position ))


;; returna list of ((#(left-pos r g b) #(right-pos r g b)))
;; ignore alpha, blending function, midpoint... whatever, for now.
(define (parse-gradient file-name)
  (call-with-input-file file-name
    (lambda (instream)
      (read-line instream) ; Gimp Gradient
      (let* ((name (read-line instream))
	     (segments (string->number (read-line instream))))
	(let loop ((next-line (read-line instream))
		   (segments (list)))
	  (if (eof-object? next-line)
	      (reverse segments)
	      (let ((bits (string-split next-line #\space)))
		(format #t "bits (~A): ~A~%" (length bits) bits)
		(match (map string->number bits)
		  ((left-stop mid right-stop lr lg lb la rr rg rb ra blend color)
		   (loop (read-line instream)
			 (cons (list (vector left-stop lr lg lb)
				     #;(vector mid mr mg mb)
				     (vector right-stop rr rg rb))
			       segments)))))))))))

(define (segment->rgb segment total-steps)
  (match segment
    ((#(l lr lg lb) #(r rr rg rb))
     (linear-blend lr lg lb rr rg rb
		   (inexact->exact (floor (* total-steps (- r l))))))))

(define (segments->rgb segments total-steps)
  (apply append (map (cut segment->rgb <> total-steps) segments)))

(define* (linear-blend r1 g1 b1 r2 g2 b2 steps)
  (let ((rd (/ (- r2 r1) steps))
	(gd (/ (- g2 g1) steps))
	(bd (/ (- g2 g1) steps)))
    (let loop ((remaining steps)
	       (colors (list)))
      (if (= remaining 0)
	  (reverse colors)
	  (let ((step (- steps remaining)))
	    (loop (1- remaining)
		  (cons (vector (+ r1 (* rd step))
				(+ g1 (* gd step))
				(+ b1 (* bd step)))
			colors)))))))