Merge pull request #18 from kb10uy/dax-layers

dax モジュールに便利レイヤーを追加する

declavatar-extra/sexpr/dax.ket

@@ -1,16 +1,6 @@
 ; vim: set ft=commonlisp
 (use da :self)
-
-(define (foldl f i l)
-    (if (null l)
-        i
-        (call-self f (f i (first l)) (tail l))
-    )
-)
-
-(define (map f l)
-    (foldl (lambda (a x) (append a (f x))) () l)
-)
+(use lm (map))
 
 (define (tracking-layer name targets parameters)
     (da/raw-layer name
@@ -23,11 +13,46 @@
         )
         (da/state "Animation"
             (da/clip (da/inline-animation (da/set-tracking 'animation targets)))
-            (map (lambda (p)
-                (da/transition-to "Tracking" (da/cond-ze p))
-            ) parameters)
+            (map (lambda (p) (da/transition-to "Tracking" (da/cond-ze p))) parameters)
+        )
+    )
+)
+
+(define (switch-objects name parameter object-pairs)
+    (da/switch-layer name
+        :driven-by parameter
+        (da/option 'disabled
+            (map (lambda (pair)
+                (da/set-object (first pair) :value (not (second pair)))
+            ) object-pairs)
+        )
+        (da/option 'enabled
+            (map (lambda (pair)
+                (da/set-object (first pair) :value (second pair))
+            ) object-pairs)
+        )
+    )
+)
+
+(define (switch-shapes name parameter mesh shape-pairs)
+    (da/switch-layer name
+        :driven-by parameter
+        :default-mesh mesh
+        (da/option 'disabled
+            (map (lambda (pair)
+                (da/set-shape (first pair) :value (elt pair 1))
+            ) shape-pairs)
+        )
+        (da/option 'enabled
+            (map (lambda (pair)
+                (da/set-shape (first pair) :value (elt pair 2))
+            ) shape-pairs)
         )
     )
 )
 
-(export (tracking-layer))
+(export (
+    tracking-layer
+    switch-objects
+    switch-shapes
+))

declavatar-extra/sexpr/lm.ket

@@ -0,0 +1,30 @@
+; vim: set ft=commonlisp
+
+(define (foldl f i l)
+    (if (null l)
+        i
+        (call-self f (f i (first l)) (tail l))
+    )
+)
+
+(define (foldr f l i)
+    (if (null l)
+        i
+        (call-self f (init l) (f (last l) i))
+    )
+)
+
+(define (map f l)
+    (foldl (lambda (a x) (append a (f x))) () l)
+)
+
+(define (filter p l)
+    (foldl (lambda (a x) (if (p x) (append a x) a)) () l)
+)
+
+(export (
+    foldl
+    foldr
+    map
+    filter
+))

examples/sexpr/dax.declisp

@@ -5,9 +5,13 @@
 (da/avatar "dax"
     (da/parameters
         (da/int "dax-parameter")
+        (da/bool "Hat")
+        (da/bool "Smile")
     )
 
     (da/fx-controller
         (dax/tracking-layer "EyePrevention" '(eyes) '("dax-parameter"))
+        (dax/switch-objects "HatSwitch" "Hat" '(("hat" true)))
+        (dax/switch-shapes "SmileSwitch" "Smile" "Body" '(("mouth_笑顔" 0.0 1.0) ("eye_笑顔" 0.0 1.0)))
     )
 )