New patch-many function

1 files changed, 16 insertions, 16 deletions

diff --git a/src/init.scm b/src/init.scm
index 93747ba..91d261e 100644
--- a/src/init.scm
+++ b/src/init.scm
@@ -12,6 +12,7 @@
       [(eq? (fixture-name (car fixtures)) name) (car fixtures)]
       [else (find-fixture (cdr fixtures) name)])))
 
+
 (define find-fixture-class
   (lambda (fixture-classes name)
     (cond
@@ -19,19 +20,18 @@
       [(string-ci=? (fixture-class-name (car fixture-classes)) name) (car fixture-classes)]
       [else (find-fixture-class (cdr fixture-classes) name)])))
 
-#!
-(let ([robe-dl7s-mode1 (find-fixture-class fixture-class-library
-                                           "Robe Robin DL7S Profile Mode 1")])
-  (if robe-dl7s-mode1
-    (begin
-      (patch-fixture 'mh1 robe-dl7s-mode1 0 1)
-      (patch-fixture 'mh2 robe-dl7s-mode1 0 52)
-      (patch-fixture 'mh3 robe-dl7s-mode1 0 103)
-      (patch-fixture 'mh4 robe-dl7s-mode1 0 154))
-    (display "DL7S not available\n")))
-!#
-
-(let ([dimmer (find-fixture-class fixture-class-library "Generic dimmer")])
-  (if dimmer
-    (patch-fixture 'dim1 dimmer 0 1)
-    (display "Dimmer class not available\n")))
+
+(define patch-many
+  (lambda (fixcls prefix n universe start-addr)
+    (letrec ([f (lambda (i)
+                   (patch-fixture (symbol-append prefix (string->symbol (number->string i)))
+                                  fixcls universe (+ start-addr (- i 1)))
+                   (if (< i n)
+                     (f (+ i 1))))])
+      (if fixcls
+        (f 1)
+        (display "Fixture class not available\n")))))
+
+
+(patch-many (find-fixture-class fixture-class-library "Generic dimmer") 'dim 48 0 1)
+;(patch-many (find-fixture-class fixture-class-library "Robe Robin DL7S Profile Mode 1") 'mh 4 0 51)