From fa2751d1201b83e32ba6074e68259ac467595808 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Thu, 8 Apr 2021 19:02:18 +0200
Subject: Neater abstraction for fade types

---
 guile/starlet/playback.scm | 44 +++++---------------------------------------
 guile/starlet/utils.scm    |  6 ++++++
 2 files changed, 11 insertions(+), 39 deletions(-)

(limited to 'guile')

diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm
index 742d314..0d5167b 100644
--- a/guile/starlet/playback.scm
+++ b/guile/starlet/playback.scm
@@ -344,14 +344,14 @@
       (else target-val))))
 
 
-(define (make-general-fade start-val
+(define (make-general-fade fade-func
+                           start-val
                            target-val
                            preset-val
                            fade-time
                            fade-start-time
                            preset-time
-                           preset-start-time
-                           fade-func)
+                           preset-start-time)
 
   (if (and (not (procedure? target-val))
            (not (eq? target-val 'no-value))
@@ -390,40 +390,6 @@
           (else target-val)))))
 
 
-(define (make-colour-fade start-val
-                          target-val
-                          preset-val
-                          fade-time
-                          fade-start-time
-                          preset-time
-                          preset-start-time)
-  (make-general-fade start-val
-                     target-val
-                     preset-val
-                     fade-time
-                     fade-start-time
-                     preset-time
-                     preset-start-time
-                     colour-fade))
-
-
-(define (make-continuous-attr-fade start-val
-                                   target-val
-                                   preset-val
-                                   fade-time
-                                   fade-start-time
-                                   preset-time
-                                   preset-start-time)
-  (make-general-fade start-val
-                     target-val
-                     preset-val
-                     fade-time
-                     fade-start-time
-                     preset-time
-                     preset-start-time
-                     simple-fade))
-
-
 (define (match-fix-attr attr-el fix attr)
   (cond
 
@@ -520,9 +486,9 @@
 
 (define (make-fade-for-attribute-type type)
   (cond
-    ((eq? type 'continuous) make-continuous-attr-fade)
+    ((eq? type 'continuous) (partial-start make-general-fade simple-fade))
     ((eq? type 'list) make-list-attr-fade)
-    ((eq? type 'colour) make-colour-fade)
+    ((eq? type 'colour) (partial-start make-general-fade colour-fade))
     (else
       (raise-exception (make-exception
                          (make-exception-with-message
diff --git a/guile/starlet/utils.scm b/guile/starlet/utils.scm
index 940441c..24a2b5c 100644
--- a/guile/starlet/utils.scm
+++ b/guile/starlet/utils.scm
@@ -3,6 +3,7 @@
   #:export (print-hash-table
             copy-hash-table
             partial
+            partial-start
             in-range
             mean
             flatten-sublists
@@ -30,6 +31,11 @@
     (f first-val second-val)))
 
 
+(define (partial-start f first-val)
+  (lambda args
+    (apply f first-val args)))
+
+
 (define (in-range a val1 val2)
   (or
    (and (>= a val1)
-- 
cgit v1.2.3