aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guile/starlet/playback.scm44
-rw-r--r--guile/starlet/utils.scm6
2 files changed, 11 insertions, 39 deletions
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)