Browse files

om.rhythm.transformer: fix <rhythm-transformer>, add tests

  • Loading branch information...
1 parent a21e074 commit 4be758ccc7ddb54251f37576414f6d3253721455 @k7f committed Mar 25, 2012
View
1 work/om/rhythm/transformer/transformer-docs.factor
@@ -61,6 +61,7 @@ HELP: with-rhythm-transformer
OM-REFERENCE:
"projects/02-musicproject/functions/trees.lisp"
+{ "treeobj" rhythm-ref "type" }
{ "trans-tree" <rhythm-transformer> }
{ "trans-obj" >rhythm-transformer< } ;
View
14 work/om/rhythm/transformer/transformer-tests.factor
@@ -0,0 +1,14 @@
+! Copyright (C) 2012 krzYszcz.
+! See http://factorcode.org/license.txt for BSD license.
+
+USING: accessors om.rhythm om.rhythm.meter om.rhythm.transformer sequences
+ tools.test ;
+IN: om.rhythm.transformer.tests
+
+[ { 0 1 2 3 4 } ] [
+ T{ rhythm f f
+ { T{ rhythm f T{ meter f 3 4 } { 1 T{ rhythm f 1 { 1 1 } } 1 } }
+ T{ rhythm f T{ meter f 3 4 } { 1 } }
+ }
+ } <rhythm-transformer> refs>> [ index>> ] map
+] unit-test
View
19 work/om/rhythm/transformer/transformer.factor
@@ -1,7 +1,8 @@
! Copyright (C) 2012 krzYszcz.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel math om.rhythm refs sequences sequences.deep ;
+USING: accessors addenda.sequences arrays kernel math om.rhythm refs
+ sequences sequences.deep ;
IN: om.rhythm.transformer
! __________
@@ -39,19 +40,21 @@ TUPLE: rhythm-transformer
{ underlying rhythm } ;
<PRIVATE
-GENERIC: (create-references) ( ndx parent relt -- refs )
+GENERIC: (create-refs) ( ndx parent relt -- ndx' refs )
-M: number (create-references) ( ndx parent value -- ref )
- <rhythm-ref> ;
+M: number (create-refs) ( ndx parent value -- ndx' ref )
+ [ [ 1 + ] keep ] 2dip <rhythm-ref> ;
-M: rhythm (create-references) ( ndx parent rhm -- refs )
- 2nip [ division>> ] keep
- [ rot (create-references) ] curry map-index ;
+: (create-next-refs) ( ndx relt rhm -- ndx' refs )
+ swap (create-refs) ; inline
+
+M: rhythm (create-refs) ( ndx parent rhm -- ndx' refs )
+ nip [ division>> ] keep [ (create-next-refs) ] curry map ;
PRIVATE>
: <rhythm-transformer> ( rhm -- rt )
[
- f f rot (create-references) dup rhythm-ref?
+ 0 f rot (create-refs) nip dup rhythm-ref?
[ 1array ] [ flatten ] if
] keep rhythm-transformer boa ;

0 comments on commit 4be758c

Please sign in to comment.