From: Clinton Ebadi <clinton@unknownlamer.org>
Date: Mon, 24 Nov 2014 02:59:58 +0000 (-0500)
Subject: Basic gimp gradient loader
X-Git-Url: https://git.hcoop.net/clinton/scratch.git/commitdiff_plain/9eaf9046e1d27e907edfbb063def56ebe1331c49?hp=2d6a241e9a3798d38c7a8821dd3cf2c815e04c15

Basic gimp gradient loader

Can generate a linear blend of arbitrary steps from a gimp gradient
file. Kind of works for generating input for my arduino led controller.
---

diff --git a/gimp-gradient.scm b/gimp-gradient.scm
new file mode 100644
index 0000000..59778e5
--- /dev/null
+++ b/gimp-gradient.scm
@@ -0,0 +1,72 @@
+;;; 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)))))))