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

Initial Mercurial check in.
author samer
date Tue, 17 Jan 2012 17:50:20 +0000
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/scheme/lineout.scm	Tue Jan 17 17:50:20 2012 +0000
@@ -0,0 +1,49 @@
+(define set-step null)
+(define line-on null)
+(define line-off null)
+(define _lineout null)
+
+
+
+
+;;; Audio output from given vector to given AudioSink
+;;; Task is added to current task list, and functions line-on
+;;; and line-off are defined to insert and remove the lineout task.
+;;; Function set-step defined to change hop size.
+;;; Optional final parameter is hop size
+(define-method (lineout sink (in Vec) hop)
+	(let ((out 		(LineOut. in sink))
+			(tlist 	(tasks)))
+		(set! set-step (lambda (m) (.setWindow out 0 m)))
+		(set! line-on (lambda ()
+			(.starting out) (Thread.sleep 200L)
+			(.addTask tlist out)))
+		(set! line-off (lambda ()
+			(.removeTask tlist out)
+			(.stopping out) (Thread.sleep 200L)))
+		(set-step hop)
+		(addtasks out)
+		out))
+			
+(define-method (lineout (in Vec)) (lineout (linesnk) in))
+(define-method (lineout sink (in Vec)) (lineout sink in (.size in)))
+(define-method (lineout sink (in LineIn))
+	(put "lineout.scale" 1.0)
+	(let ((out (lineout sink (.output in))))
+		(set-step (.getStep in))
+		(set! set-step (lambda (n)
+			(.setStep in n)
+			(.setWindow out 0 n)))))
+
+(define-method (overlap-and-add sink x hop)
+	(define oa  (OverlapAndAdd. x hop))
+	(define line (LineOut. (.output oa) sink))
+	(.setWindow oa (Hanning.))
+	(.setWindow line 0 hop)
+	(addtasks oa line)
+	(set! _lineout line)
+	(set! set-step (lambda (h)
+		(.setHop oa h)
+		(.setWindow line 0 h)))
+	line)
+