From 9ecfd4bbe19d8ffea69e55412f205c0eada7aa7e Mon Sep 17 00:00:00 2001 From: Thomas White Date: Sat, 22 Feb 2020 09:36:24 +0100 Subject: New patch-many function --- src/init.scm | 32 ++++++++++++++++---------------- 1 file 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) -- cgit v1.2.3