view src/scheme/synthesis.scm @ 0:bf79fb79ee13

Initial Mercurial check in.
author samer
date Tue, 17 Jan 2012 17:50:20 +0000
parents
children
line wrap: on
line source
(import "samer.maths.random.*")
(load "lineout.scm")

; sets the Generator of a VGenerator to one
; constructed in it's own context.
(define (load-generator gen)
	(letrec ((nd (.getNode gen))
		(spec (Shell.getString (.fullName nd)))
		(g (node nd (eval-string spec))) )
		(.setGenerator gen g)
	)
)

(define (fir-filter coeffs) (FIRFilter. (.array coeffs)))
(define (iir-filter coeffs) (IIRFilter. (.array coeffs)))

(define (spectral-fir n spec)
   (define filter (SpectralFIR. n spec))
	(Ops.triggerTask filter spec)
	(.coefficients filter))
		

(define (filter-gen filt gen) (FilteredGenerator. gen filt))
(define (gen->vector n gen)
  (define x (VVector. (cat "buffer(" (.toString gen) ")") n))
  (define t (GenerateVector. x gen))
  (addtasks t (Ops.update x))
  x)

(define (oscillator f)
   (define osc (Oscillator. f))
	(define vf (VDouble. "freq" f))
	(on-change vf (.setFrequency osc (.get vf)))
;	(samer.core.types.VParameter. "freq" (.getFrequencyModel osc))
	osc)
			
(define (specsynth in N M)
  (define filter (SpectralFilter. in N))
  (addtask filter)
  ;(gen->vector (filter-gen filter (VGenerator. "source" (Binary.))) M))
  (gen->vector (filter-gen filter (BipolarUniform.)) M )
)

(define (specsynth-async in N M)
  (define filter (SpectralFilter. in N))
  (addtask filter)
  (node "synth"
	  (put "regulator.thread.priority" -0.1)
	  (let ((new-tasks  (CompoundTask.)))
	    (RThread. new-tasks)
		 (with-tasks new-tasks
			 (gen->vector M (filter-gen filter (NormalisedGaussian. ))))
	  )))

(define (synth2 ft mag hop sink)
  (define ift (RescaledIFT. ft mag))
  (addtask ift)
  (overlap-and-add sink (.output ift) hop))

 ;;; this generates a white noise signal modulated by
;;; another signal E

(define (noise-resynth E N sink)
	(define buf (gen->vector N samer.maths.random.NormalisedGaussian.))
	(addtask (task (Mathx.mul (.array buf) (- (.get E) 200))))
	(lineout sink buf)
)