summaryrefslogtreecommitdiff
path: root/lib/xm-test.lsp
diff options
context:
space:
mode:
Diffstat (limited to 'lib/xm-test.lsp')
-rw-r--r--lib/xm-test.lsp622
1 files changed, 622 insertions, 0 deletions
diff --git a/lib/xm-test.lsp b/lib/xm-test.lsp
new file mode 100644
index 0000000..8fb34ff
--- /dev/null
+++ b/lib/xm-test.lsp
@@ -0,0 +1,622 @@
+;; xm-test.lsp
+;;
+;; ============== some test code for xm.lsp ===============
+;;
+
+;(load "xm")
+
+'(setf pat (make-heap '(a b c d e)))
+'(dotimes (i 10) (print (next pat)))
+'(print "heap test done: ")
+'(read)
+
+
+(defun about-equal (x y)
+ (cond ((null x) (null y))
+ ((consp x)
+ (and (consp y)
+ (about-equal (car x) (car y))
+ (about-equal (cdr x) (cdr y))))
+ ((numberp x)
+ (and (numberp y)
+ (< (abs (- x y)) 0.000001)))
+ (t
+ (equal x y))))
+
+
+(defun test (name &rest pairs)
+ (format t "TEST ~A : " name)
+ (loop
+ (cond ((or (null pairs) (null (cdr pairs)))
+ (format t " --PASSED--~%")
+ (return))
+ ((not (about-equal (car pairs) (cadr pairs)))
+ (format t " --FAILED-- ~A returned instead of ~A~%"
+ (car pairs) (cadr pairs))
+ (break "a test failed")
+ (return)))
+ (setf pairs (cddr pairs))))
+
+
+
+(setf xx (make-cycle '(x y z) :name "xx" :trace nil))
+
+(test "test" (next xx) 'x (next xx) 'y (next xx t) '(z) (next xx t) '(x y z))
+
+(setf aa (make-cycle '(a b) :name "aa" :trace nil))
+
+(setf zz (make-cycle (list xx aa)))
+
+(test "test2" (next zz) 'x (next zz) 'y (next zz t) '(z) (next zz t) '(a b))
+
+(setf zz1 (make-cycle (list xx aa) :for 1 :name "zz1"))
+
+(setf zz10 (make-cycle (list xx aa) :for 10 :name "zz10" :trace nil))
+
+(test "test3" (next zz1 t) '(x y z) (next zz1 t) '(a b)
+ (next zz10 t) '(x y z)
+ (next zz10 t) '(a b))
+
+(setf aa1 (make-cycle '(a b) :for 1 :name "aa1"))
+
+(setf zza1 (make-cycle (list xx aa1) :name "zza1"))
+
+(test "test4" (next zza1 t) '(x y z) (next zza1 t) '(a)
+ (next zza1 t) '(x y z) (next zza1 t) '(b))
+
+
+(setf zz2 (make-cycle (list xx aa) :for 1 :name "zz2"))
+(setf zzz (make-cycle (list zz2 'q) :name "zzz"))
+
+(test "test5" (next zzz t) '(x y z) (next zzz t) '(q)
+ (next zzz t) '(a b) (next zzz t) '(q)
+ (next zzz t) '(x y z) (next zzz t) '(q))
+
+ ; test using cpat as items list
+(setf cpat (make-cycle '(a b) :name "cpat" :trace nil))
+(setf recycpat (make-cycle cpat :for 3 :name "recycpat" :trace nil))
+
+(test "test6" (next recycpat t) '(a b a)
+ (next recycpat t) '(a b a))
+
+; test length-class
+(setf lpat (make-length (make-cycle '(a b c)) 2))
+(test "length test 1" (next lpat t) '(a b) (next lpat t) '(c a))
+
+(setf lpat2 (make-length (make-cycle '(a b c)) (make-cycle '(2 1 0))))
+(test "length test 2" (next lpat2 t) '(a b) (next lpat2 t) '(c)
+ (next lpat2 t) '() (next lpat2 t) '(a b))
+
+
+(setf pp1 (make-palindrome '(a b c)
+ :elide (make-cycle '(:first :last t nil) :name "pp1-elide-pattern")
+ :name "pp1"))
+(test "palindrome test" (next pp1 t) '(a b c c b) (next pp1 t) '(a b c b a)
+ (next pp1 t) '(a b c b) (next pp1 t) '(a b c c b a)
+ (next pp1 1) '(a b c c b))
+
+
+(setf pp2 (make-palindrome '(a b c)
+ :elide (make-cycle '(:first :last t)) :for 3))
+(test "palindrome test 2" (next pp2 t) '(a b c) (next pp2 t) '(c b a)
+ (next pp2 t) '(a b c) (next pp2 t) '(b a b))
+
+
+(setf pp3 (make-palindrome '(a) :elide (make-cycle '(:first :last t nil))))
+(test "palindrome test 3" (next pp3 t) '(a) (next pp3 t) '(a)
+ (next pp3 t) nil (next pp3 t) '(a a))
+
+
+(setf pp4 (make-palindrome '(a b c) :elide (make-cycle '(:first :last))
+ :for 6))
+(test "palindrome test 4" (next pp4 t) '(a b c c b a)
+ (next pp4 t) '(b c b a a b))
+
+(setf ll1 (make-line '(a b c d)))
+(test "line test" (next ll1 t) '(a b c d) (next ll1 t) '(d d d d))
+
+(setf nn1 (make-cycle (list
+ (make-cycle (list
+ (make-cycle '(a b) :name "ab")
+ (make-cycle '(c) :name "c"))
+ :name "ab-c")
+ (make-cycle (list
+ (make-cycle '(x y) :name "xy")
+ (make-cycle '(u v) :name "uv"))
+ :name "xy-uv"))
+ :name "ab-c-xy-uv"))
+
+(test "nested test" (next nn1 t) '(a b) (next nn1 t) '(c) (next nn1 t) '(x y)
+ (next nn1 t) '(u v) (next nn1 t) '(a b) (next nn1 t) '(c))
+
+(setf win1 (make-window (make-cycle '(a b c)) 3 1))
+
+(test "window test 1" (next win1 t) '(a b c)
+ (next win1 t) '(b c a) (next win1 t) '(c a b))
+
+(setf win2 (make-window (make-cycle '(a b c)) ; source
+ (make-cycle '(3 1)) ; length
+ (make-cycle '(1 1 3)))) ; skip
+
+(test "window test 2" (next win2 t) '(a b c)
+ (next win2 t) '(b) ; skip 1 length 1
+ (next win2 t) '(a b c) ; skip 1 length 3
+ (next win2 t) '(a) ; skip 3 length 1
+ (next win2 t) '(b c a) ; skip 1 length 3
+ (next win2 t) '(c) ; skip 1 length 1
+ (next win2 t) '(a b c) ; skip 3 length 3
+ (next win2 t) '(b) ; skip 1 length 1
+ (next win2 t) '(a b c)) ; skip 1 length 3
+
+(defun only-abc-n (lis n)
+ (and (= (length lis) n)
+ (dolist (item lis t)
+ (cond ((not (member item '(a b c)))
+ (return nil))))))
+
+(defun abc2 (lis) (only-abc-n lis 2))
+
+(defun abc3 (lis) (only-abc-n lis 3))
+
+(setf rr1 (make-random '(a b c) :name "rr1"))
+(display "rr1" (next rr1 t))
+(test "random 1" (abc3 (next rr1 t)) t (abc3 (next rr1 t)) t)
+
+(setf rr2 (make-random '(a b c) :for 2 :name "rr2" :trace nil))
+(test "random 2" (abc2 (next rr2 t)) t (abc2 (next rr2 t)) t)
+
+
+; random using weights
+(setf rr3 (make-random '((a :weight 1) (b :weight 10))))
+(setf a-count 0 b-count 0)
+(setf *num-trials* 10000) ;; NORMALLY, SET THIS TO 10000
+(setf rr3-all nil)
+(dotimes (i *num-trials*)
+ ;(display "weight test" i)
+ (if (eq (setf rr3-out (next rr3)) 'a) (incf a-count) (incf b-count))
+ (push rr3-out rr3-all))
+;(print (reverse rr3-all))
+
+(setf rr-ratio (/ (float a-count) b-count))
+(format t "test rr3 a/b should be 0.091, actual ratio is ~A~%" rr-ratio)
+(test "weight test" (and (< rr-ratio 0.12) (> rr-ratio 0.08)) t)
+
+
+; random using :min
+(setf rr4 (make-random '((a :weight 1 :min 2) (b :weight 10 :min 1))))
+(setf sum 0)
+(setf a-count 0 b-count 0)
+(dotimes (i *num-trials*)
+ ;(display "min test" (next rr4))
+ (if (eq (next rr4) 'a) (incf a-count) (incf b-count))
+)
+(setf rr-ratio (/ (float a-count) b-count))
+(format t "test rr4 a/b should be about 0.191, actual ratio is ~A~%" rr-ratio)
+(test "min test" (and (< rr-ratio 0.22) (> rr-ratio 0.16)) t)
+
+
+; random using :max
+(setf rr5 (make-random '((a :weight 1 :min 2) (b :weight 10 :max 5))))
+(setf sum 0)
+(setf rr5-all nil)
+(setf a-count 0 b-count 0)
+(dotimes (i *num-trials*)
+ ;(display "max test" (next rr5))
+ (if (eq (setf rr5-out (next rr5)) 'a) (incf a-count) (incf b-count))
+ (push rr5-out rr5-all))
+(setf rr5-all (reverse rr5-all))
+(setf rr5-state 'a2)
+(setf rr5-count 0)
+(dolist (s rr5-all)
+ (incf rr5-count)
+ (cond ((and (eq rr5-state 'a1) (eq s 'a))
+ (setf rr5-state 'a2))
+ ((and (eq rr5-state 'a2) (eq s 'a)))
+ ((and (eq rr5-state 'a2) (eq s 'b))
+ (setf rr5-state 'b1))
+ ((and (eq rr5-state 'b1) (eq s 'b))
+ (setf rr5-state 'b2))
+ ((and (eq rr5-state 'b2) (eq s 'b))
+ (setf rr5-state 'b3))
+ ((and (eq rr5-state 'b3) (eq s 'b))
+ (setf rr5-state 'b4))
+ ((and (eq rr5-state 'b4) (eq s 'b))
+ (setf rr5-state 'b5))
+ ((and (eq rr5-state 'b1) (eq s 'a))
+ (setf rr5-state 'a1))
+ ((and (eq rr5-state 'b2) (eq s 'a))
+ (setf rr5-state 'a1))
+ ((and (eq rr5-state 'b3) (eq s 'a))
+ (setf rr5-state 'a1))
+ ((and (eq rr5-state 'b4) (eq s 'a))
+ (setf rr5-state 'a1))
+ ((and (eq rr5-state 'b5) (eq s 'a))
+ (setf rr5-state 'a1))
+ (t
+ (error "bad state"))))
+
+(setf rr-ratio (/ (float a-count) b-count))
+(format t "test rr5 a/b should be 0.503613, actual ratio is ~A~%" rr-ratio)
+(test "max test" (and (> rr-ratio 0.4) (< rr-ratio 0.6)) t)
+
+
+(setf hh1 (make-heap '(a b c)))
+(test "heap 1" (abc3 (next hh1 t)) t (abc3 (next hh1 t)) t)
+
+(setf hh2 (make-heap '(a b c) :for 2 :name "hh2" :trace nil))
+(test "heap 2" (abc2 (next hh2 t)) t (abc2 (next hh2 t)) t)
+
+(setf xx (make-markov `((a -> a (b ,(make-cycle '(1 2)))) (b -> a))
+ :past '(b)
+ :produces `(a ,(make-cycle '(0))
+ b ,(make-cycle '(1 2 3 4)
+ :trace nil :name "b-produces"))
+ :is-nested t
+ :trace nil :name "markov"))
+(setf xx-out nil)
+(dotimes (i 12) (push (next xx) xx-out))
+(setf xx-out (reverse xx-out))
+(print xx-out)
+;; this is a special test to see if the output is plausible
+(defun markov-test-xx (lis)
+ (let (a b)
+ (setf a (car lis))
+ (setf lis (cdr lis))
+ (cond ((null lis) t)
+ ((and (setf b (car lis))
+ (eq a 0) (member b '(0 1)))
+ (markov-test-xx lis))
+ ((and (eq a 1) (eq b 2))
+ (markov-test-xx lis))
+ ((and (eq a 2) (eq b 3))
+ (markov-test-xx lis))
+ ((and (eq a 3) (eq b 4))
+ (markov-test-xx lis))
+ ((and (= a 4) (= b 0))
+ (markov-test-xx lis))
+ (t nil))))
+(format t "TEST markov test : ~A~%" (if (markov-test-xx xx-out) "--PASSED--"
+ (break "markov test failed")))
+
+
+(setf cc (make-copier (make-cycle '(a b) :name "ab" :trace nil)
+ :repeat 3 :name "copier" :trace nil :merge t))
+
+(test "copier test 1" (next cc t) '(a b a b a b) (next cc t) '(a b a b a b))
+
+(setf cc2 (make-copier (make-cycle '(a b) :name "ab" :trace nil)
+ :repeat 3 :name "copier" :trace nil))
+
+(test "copier test 2" (next cc2 t) '(a b) (next cc2 t) '(a b) (next cc2 t) '(a b))
+
+(setf cc3 (make-copier (make-cycle (list (make-cycle '(a)) (make-cycle '(b))))
+ :repeat 3 :merge t))
+
+(test "copier test 3" (next cc3 t) '(a a a) (next cc3 t) '(b b b)
+ (next cc3 t) '(a a a))
+
+(setf cc4 (make-copier (make-cycle '(a b c d) :for 1)
+ :repeat (make-cycle '(2 -2 3 -3))
+ :merge t))
+(test "copier test 4" (next cc4 t) '(a a) (next cc4 t) '(d d d)
+ (next cc4 t) '(d d) (next cc4 t) '(c c c))
+
+(setf cc5 (make-copier (make-cycle '(a b c d) :for 1)
+ :repeat 3))
+(test "compier test 5" (next cc5 t) '(a) (next cc5 t) '(a)
+ (next cc5 t) '(a) (next cc5 t) '(b) (next cc5 t) '(b)
+ (next cc5 t) '(b) (next cc5 t) '(c) (next cc5 t) '(c)
+ (next cc5 t) '(c) (next cc5 t) '(d) (next cc5 t) '(d)
+ (next cc5 t) '(d) (next cc5 t) '(a) (next cc5 t) '(a))
+
+
+(setf acc1 (make-accumulate (make-cycle '(1 2 -3))))
+
+(test "accumulate test 1" (next acc1 t) '(1 3 0) (next acc1 t) '(1 3 0))
+
+(setf acc2 (make-accumulate (make-cycle '(1 2 -3) :for 2)))
+
+(test "accumulate test 2" (next acc2 t) '(1 3) (next acc2 t) '(0 1)
+ (next acc2 t) '(3 0))
+
+(setf sum1 (make-sum (make-cycle '(1 2)) (make-cycle '(3 4 5))))
+
+(test "sum test 1" (next sum1 t) '(4 6) (next sum1 t) '(6 5)
+ (next sum1 t) '(5 7))
+
+(setf sum2 (make-sum (make-cycle '(1 2)) (make-cycle '(3 4 5)) :for 4))
+
+(test "sum test 2" (next sum2 t) '(4 6 6 5) (next sum2 t) '(5 7 4 6))
+
+(setf prod1 (make-product (make-cycle '(1 2)) (make-cycle '(3 4 5))))
+
+(test "prod test 1" (next prod1 t) '(3 8) (next prod1 t) '(5 6)
+ (next prod1 t) '(4 10))
+
+(setf prod2 (make-product (make-cycle '(1 2)) (make-cycle '(3 4 5)) :for 4))
+
+(test "prod test 2" (next prod2 t) '(3 8 5 6) (next prod2 t) '(4 10 3 8))
+
+(setf eval1 (make-eval '(+ 1 2) :for 3))
+
+(test "eval test 1" (next eval1 t) '(3 3 3))
+
+#|
+
+(setf testscore '((0 0 (score-begin-end 0 10))
+ (0.1 1 (note :pitch 60 :vel 100))
+ (1 1 (note :pitch 61 :vel 91))
+ (1 0.5 (note :pitch 68 :vel 92))
+ (1.5 0.5 (note :pitch 67 :vel 93))
+ (2 1 (note :pitch 62 :vel 94))))
+
+(test "basic1" (score-get-begin testscore) 0)
+(test "basic2" (score-get-end testscore) 10)
+(test "basic3" (score-set-begin testscore 1)
+ (cons '(0 0 (score-begin-end 1 10)) (cdr testscore)))
+(test "basic4" (score-set-end testscore 4)
+ (cons '(0 0 (score-begin-end 0 4)) (cdr testscore)))
+(test "basic5" (score-get-begin (cdr testscore)) 0.1)
+(test "basic6" (score-get-end (cdr testscore)) 3)
+
+(test "score-shift" (score-shift testscore 5)
+ '((0 0 (SCORE-BEGIN-END 0 15))
+ (5.1 1 (NOTE :PITCH 60 :VEL 100))
+ (6 0.5 (NOTE :PITCH 68 :VEL 92))
+ (6 1 (NOTE :PITCH 61 :VEL 91))
+ (6.5 0.5 (NOTE :PITCH 67 :VEL 93))
+ (7 1 (NOTE :PITCH 62 :VEL 94))
+ ))
+
+(test "score-stretch1" (setf xx (score-stretch testscore 2))
+ (setf yy '((0 0 (SCORE-BEGIN-END 0 20))
+ (0.2 2 (NOTE :PITCH 60 :VEL 100))
+ (2 2 (NOTE :PITCH 61 :VEL 91))
+ (2 1 (NOTE :PITCH 68 :VEL 92))
+ (3 1 (NOTE :PITCH 67 :VEL 93))
+ (4 2 (NOTE :PITCH 62 :VEL 94))
+ )))
+
+(test "score-stretch2" (score-stretch testscore 2 :dur nil)
+ '((0 0 (SCORE-BEGIN-END 0 20))
+ (0.2 1 (NOTE :PITCH 60 :VEL 100))
+ (2 1 (NOTE :PITCH 61 :VEL 91))
+ (2 0.5 (NOTE :PITCH 68 :VEL 92))
+ (3 0.5 (NOTE :PITCH 67 :VEL 93))
+ (4 1 (NOTE :PITCH 62 :VEL 94))
+ ))
+
+(test "score-stretch3" (score-stretch testscore 2 :from-index 2 :to-index 3)
+ '((0 0 (SCORE-BEGIN-END 0 10.5))
+ (0.1 1.1 (NOTE :PITCH 60 :VEL 100))
+ (1 1.5 (NOTE :PITCH 61 :VEL 91))
+ (1 1 (NOTE :PITCH 68 :VEL 92))
+ (2 0.5 (NOTE :PITCH 67 :VEL 93))
+ (2.5 1 (NOTE :PITCH 62 :VEL 94))
+ ))
+
+(test "score-stretch4" (score-stretch testscore 2 :from-time 1.5 :to-time 2.5)
+ '((0 0 (SCORE-BEGIN-END 0 11))
+ (0.1 1 (NOTE :PITCH 60 :VEL 100))
+ (1 1.5 (NOTE :PITCH 61 :VEL 91))
+ (1 0.5 (NOTE :PITCH 68 :VEL 92))
+ (1.5 1 (NOTE :PITCH 67 :VEL 93))
+ (2.5 1.5 (NOTE :PITCH 62 :VEL 94))
+ ))
+
+
+(test "score-transpose1" (score-transpose testscore :pitch 5)
+ '((0 0 (score-begin-end 0 10))
+ (0.1 1 (note :pitch 65 :vel 100))
+ (1 1 (note :pitch 66 :vel 91))
+ (1 0.5 (note :pitch 73 :vel 92))
+ (1.5 0.5 (note :pitch 72 :vel 93))
+ (2 1 (note :pitch 67 :vel 94))))
+
+(test "score-transpose1" (score-transpose testscore :pitch 5
+ :from-index 2 :to-index 3)
+ '((0 0 (score-begin-end 0 10))
+ (0.1 1 (note :pitch 60 :vel 100))
+ (1 1 (note :pitch 66 :vel 91))
+ (1 0.5 (note :pitch 73 :vel 92))
+ (1.5 0.5 (note :pitch 67 :vel 93))
+ (2 1 (note :pitch 62 :vel 94))))
+
+(test "score-scale1" (score-scale testscore :vel 0.5)
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (0.1 1 (NOTE :PITCH 60 :VEL 50))
+ (1 1 (NOTE :PITCH 61 :VEL 45.5))
+ (1 0.5 (NOTE :PITCH 68 :VEL 46))
+ (1.5 0.5 (NOTE :PITCH 67 :VEL 46.5))
+ (2 1 (NOTE :PITCH 62 :VEL 47))
+ ))
+
+(test "score-scale2" (score-scale testscore :vel 0.5
+ :from-time 1 :to-time 1.5)
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (0.1 1 (NOTE :PITCH 60 :VEL 100))
+ (1 1 (NOTE :PITCH 61 :VEL 45.5))
+ (1 0.5 (NOTE :PITCH 68 :VEL 46))
+ (1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+ (2 1 (NOTE :PITCH 62 :VEL 94))
+ ))
+
+(test "score-sustain1" (score-sustain testscore 2)
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (0.1 2 (NOTE :PITCH 60 :VEL 100))
+ (1 2 (NOTE :PITCH 61 :VEL 91))
+ (1 1 (NOTE :PITCH 68 :VEL 92))
+ (1.5 1 (NOTE :PITCH 67 :VEL 93))
+ (2 2 (NOTE :PITCH 62 :VEL 94))))
+
+(test "score-sustain2" (score-sustain testscore 2
+ :from-index 0 :to-index 1)
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (0.1 2 (NOTE :PITCH 60 :VEL 100))
+ (1 1 (NOTE :PITCH 61 :VEL 91))
+ (1 0.5 (NOTE :PITCH 68 :VEL 92))
+ (1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+ (2 1 (NOTE :PITCH 62 :VEL 94))))
+
+(test "score-voice1" (score-voice testscore '((note violin)))
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (0.1 1 (VIOLIN :PITCH 60 :VEL 100))
+ (1 1 (VIOLIN :PITCH 61 :VEL 91))
+ (1 0.5 (VIOLIN :PITCH 68 :VEL 92))
+ (1.5 0.5 (VIOLIN :PITCH 67 :VEL 93))
+ (2 1 (VIOLIN :PITCH 62 :VEL 94))))
+
+(test "score-voice2" (score-voice testscore '((flute horn) (note violin))
+ :from-index 0 :to-index 10)
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (0.1 1 (VIOLIN :PITCH 60 :VEL 100))
+ (1 1 (VIOLIN :PITCH 61 :VEL 91))
+ (1 0.5 (VIOLIN :PITCH 68 :VEL 92))
+ (1.5 0.5 (VIOLIN :PITCH 67 :VEL 93))
+ (2 1 (VIOLIN :PITCH 62 :VEL 94))))
+
+'(score-print (score-merge testscore
+ (score-shift
+ (score-voice testscore '((note violin)))
+ 0.1)))
+
+
+(test "score-merge1" (score-merge testscore
+ (score-shift
+ (score-voice testscore '((note violin)))
+ 0.1))
+ '((0 0 (SCORE-BEGIN-END 0 10.1))
+ (0.1 1 (NOTE :PITCH 60 :VEL 100))
+ (0.2 1 (VIOLIN :PITCH 60 :VEL 100))
+ (1 1 (NOTE :PITCH 61 :VEL 91))
+ (1 0.5 (NOTE :PITCH 68 :VEL 92))
+ (1.1 0.5 (VIOLIN :PITCH 68 :VEL 92))
+ (1.1 1 (VIOLIN :PITCH 61 :VEL 91))
+ (1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+ (1.6 0.5 (VIOLIN :PITCH 67 :VEL 93))
+ (2 1 (NOTE :PITCH 62 :VEL 94))
+ (2.1 1 (VIOLIN :PITCH 62 :VEL 94))
+ ))
+
+(test "score-merge2" (score-merge
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (0 1 (NOTE :PITCH 60 :VEL 100)))
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (1 1 (NOTE :PITCH 61 :VEL 91)))
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (2 1 (NOTE :PITCH 62 :VEL 94))))
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (0 1 (NOTE :PITCH 60 :VEL 100))
+ (1 1 (NOTE :PITCH 61 :VEL 91))
+ (2 1 (NOTE :PITCH 62 :VEL 94))))
+
+(test "score-append1"
+ (score-append testscore testscore)
+ '((0 0 (SCORE-BEGIN-END 0 20))
+ (0.1 1 (NOTE :PITCH 60 :VEL 100))
+ (1 1 (NOTE :PITCH 61 :VEL 91))
+ (1 0.5 (NOTE :PITCH 68 :VEL 92))
+ (1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+ (2 1 (NOTE :PITCH 62 :VEL 94))
+ (10.1 1 (NOTE :PITCH 60 :VEL 100))
+ (11 1 (NOTE :PITCH 61 :VEL 91))
+ (11 0.5 (NOTE :PITCH 68 :VEL 92))
+ (11.5 0.5 (NOTE :PITCH 67 :VEL 93))
+ (12 1 (NOTE :PITCH 62 :VEL 94))))
+
+
+(test "score-select1"
+ (score-select testscore t :from-time 1 :to-time 1.5)
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (1 1 (NOTE :PITCH 61 :VEL 91))
+ (1 0.5 (NOTE :PITCH 68 :VEL 92))))
+
+(test "score-select2"
+ (score-select testscore
+ '(lambda (time dur expr) (eql (expr-get-attr expr :pitch) 61))
+ :from-time 1 :to-time 1.5)
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (1 1 (NOTE :PITCH 61 :VEL 91))))
+
+(test "score-select3"
+ (score-select testscore
+ '(lambda (time dur expr) (eql (expr-get-attr expr :pitch) 61))
+ :reject t)
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (0.1 1 (NOTE :PITCH 60 :VEL 100))
+ (1 0.5 (NOTE :PITCH 68 :VEL 92))
+ (1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+ (2 1 (NOTE :PITCH 62 :VEL 94))))
+
+(test "score-filter-length"
+ (score-filter-length testscore 1.5)
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (0.1 1 (NOTE :PITCH 60 :VEL 100))
+ (1 0.5 (NOTE :PITCH 68 :VEL 92))))
+
+(test "score-repeat"
+ (score-repeat testscore 3)
+ '((0 0 (SCORE-BEGIN-END 0 30))
+ (0.1 1 (NOTE :PITCH 60 :VEL 100))
+ (1 0.5 (NOTE :PITCH 68 :VEL 92))
+ (1 1 (NOTE :PITCH 61 :VEL 91))
+ (1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+ (2 1 (NOTE :PITCH 62 :VEL 94))
+ (10.1 1 (NOTE :PITCH 60 :VEL 100))
+ (11 1 (NOTE :PITCH 61 :VEL 91))
+ (11 0.5 (NOTE :PITCH 68 :VEL 92))
+ (11.5 0.5 (NOTE :PITCH 67 :VEL 93))
+ (12 1 (NOTE :PITCH 62 :VEL 94))
+ (20.1 1 (NOTE :PITCH 60 :VEL 100))
+ (21 1 (NOTE :PITCH 61 :VEL 91))
+ (21 0.5 (NOTE :PITCH 68 :VEL 92))
+ (21.5 0.5 (NOTE :PITCH 67 :VEL 93))
+ (22 1 (NOTE :PITCH 62 :VEL 94))))
+
+(test "score-stretch-to-length"
+ (score-stretch-to-length testscore 20)
+ '((0 0 (SCORE-BEGIN-END 0 20))
+ (0.2 2 (NOTE :PITCH 60 :VEL 100))
+ (2 2 (NOTE :PITCH 61 :VEL 91))
+ (2 1 (NOTE :PITCH 68 :VEL 92))
+ (3 1 (NOTE :PITCH 67 :VEL 93))
+ (4 2 (NOTE :PITCH 62 :VEL 94))
+ ))
+
+(test "score-filter-overlap"
+ (score-filter-overlap testscore)
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (0.1 1 (NOTE :PITCH 60 :VEL 100))
+ (1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+ (2 1 (NOTE :PITCH 62 :VEL 94))))
+
+(test "score-adjacent-events1"
+ (score-adjacent-events testscore #'(lambda (a b c) b))
+ testscore)
+
+(test "score-adjacent-events2"
+ (score-adjacent-events testscore
+ #'(lambda (a b c)
+ (if (eql (event-get-attr b :pitch) 61)
+ nil b))) ; remove pitches with 61
+ '((0 0 (SCORE-BEGIN-END 0 10))
+ (0.1 1 (NOTE :PITCH 60 :VEL 100))
+ (1 0.5 (NOTE :PITCH 68 :VEL 92))
+ (1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+ (2 1 (NOTE :PITCH 62 :VEL 94))))
+
+(test "score-indexof"
+ (score-indexof testscore #'(lambda (time dur expr)
+ (eql (expr-get-attr expr :pitch) 61)))
+ 2)
+
+(test "score-last-indexof"
+ (score-last-indexof testscore #'(lambda (time dur expr)
+ (> (expr-get-attr expr :pitch) 65)))
+ 4)
+
+
+|#
+
+
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-20 02:21:46 +0000