comparison src/scheme/lineout.scm @ 0:bf79fb79ee13

Initial Mercurial check in.
author samer
date Tue, 17 Jan 2012 17:50:20 +0000
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:bf79fb79ee13
1 (define set-step null)
2 (define line-on null)
3 (define line-off null)
4 (define _lineout null)
5
6
7
8
9 ;;; Audio output from given vector to given AudioSink
10 ;;; Task is added to current task list, and functions line-on
11 ;;; and line-off are defined to insert and remove the lineout task.
12 ;;; Function set-step defined to change hop size.
13 ;;; Optional final parameter is hop size
14 (define-method (lineout sink (in Vec) hop)
15 (let ((out (LineOut. in sink))
16 (tlist (tasks)))
17 (set! set-step (lambda (m) (.setWindow out 0 m)))
18 (set! line-on (lambda ()
19 (.starting out) (Thread.sleep 200L)
20 (.addTask tlist out)))
21 (set! line-off (lambda ()
22 (.removeTask tlist out)
23 (.stopping out) (Thread.sleep 200L)))
24 (set-step hop)
25 (addtasks out)
26 out))
27
28 (define-method (lineout (in Vec)) (lineout (linesnk) in))
29 (define-method (lineout sink (in Vec)) (lineout sink in (.size in)))
30 (define-method (lineout sink (in LineIn))
31 (put "lineout.scale" 1.0)
32 (let ((out (lineout sink (.output in))))
33 (set-step (.getStep in))
34 (set! set-step (lambda (n)
35 (.setStep in n)
36 (.setWindow out 0 n)))))
37
38 (define-method (overlap-and-add sink x hop)
39 (define oa (OverlapAndAdd. x hop))
40 (define line (LineOut. (.output oa) sink))
41 (.setWindow oa (Hanning.))
42 (.setWindow line 0 hop)
43 (addtasks oa line)
44 (set! _lineout line)
45 (set! set-step (lambda (h)
46 (.setHop oa h)
47 (.setWindow line 0 h)))
48 line)
49