Commit fe7fc19f authored by Dave Griffiths's avatar Dave Griffiths
Browse files

fluxa fixes and lz added

parent e80d59d2
......@@ -47,8 +47,8 @@
(map (lambda (l) (apply synth-connect l)) (make-args id operands))
(node id)))
(define (play-now node pan) (synth-play 0 (node-id node) pan))
(define (play time node pan) (synth-play time (node-id node) pan))
(define (play-now node pan) (synth-play 0 0 (node-id node) pan))
(define (play time node pan) (synth-play (car time) (cadr time) (node-id node) pan))
;;---------------------------------------------------------------
;; operators
......@@ -105,6 +105,16 @@
26579.5 28160 29834.5 31608.5 33488.1 35479.4 37589.1 39824.3 42192.3 44701.2
47359.3 50175.4 53159 56320))
(define (pick l c)
(list-ref l (modulo c (length l))))
(define (inter l c)
(define (_ l c cc a)
(cond ((eqv? c cc) a)
(else
(_ l c (+ cc 1) (+ a (pick l cc))))))
(_ l c 0 0))
(define (note n)
(list-ref scale-lut (modulo (inter flx-scale (abs (inexact->exact (round n)))) (length scale-lut))))
......
; lz/nz
(synth-init)
(define (make-lz md d stk w h mem)
(vector md d stk w h mem))
(define (lz-md l) (vector-ref l 0))
(define (lz-d l) (vector-ref l 1))
(define (lz-stk l) (vector-ref l 2))
(define (lz-w l) (vector-ref l 3))
(define (lz-h l) (vector-ref l 4))
(define (lz-mem l) (vector-ref l 5))
(define (set-lz-d! l v) (vector-set! l 1 v))
(define (set-lz-stk! l v) (vector-set! l 2 v))
(define (set-lz-mem! l v) (vector-set! l 5 v))
(define (build-lz md w h)
(make-lz md 0 '((0 0)) w h (make-vector (* w h) #\ )))
(define (lz-poke lz x y s)
(vector-set! (lz-mem lz) (+ x (* (lz-w lz) y)) s))
(define (lz-peek lz x y)
(vector-ref (lz-mem lz) (+ x (* (lz-w lz) y))))
(define (lz-read lz)
(let ((top (lz-top lz)))
(lz-peek lz (car top) (cadr top))))
(define (lz-pop! lz)
(when (> (lz-d lz) 0)
(set-lz-d! lz (- (lz-d lz) 1)))
(let ((tmp (car (lz-stk lz))))
(when (not (eq? (length (lz-stk lz)) 1))
(set-lz-stk! lz (cdr (lz-stk lz))))
tmp))
(define (lz-push! lz item)
(when (< (lz-d lz) (lz-md lz))
(set-lz-d! lz (+ (lz-d lz) 1))
(set-lz-stk! lz (cons item (lz-stk lz)))))
(define (lz-top lz)
(car (lz-stk lz)))
(define (set-lz-top! lz s)
(set-lz-stk! lz (cons s (cdr (lz-stk lz)))))
(define (lz-inc-pos lz)
(set-lz-top! lz (list (+ (car (lz-top lz)) 1) (cadr (lz-top lz)))))
(define (lz-tick lz)
(lz-inc-pos lz)
(when (>= (car (lz-top lz)) 8)
(cond
((eq? (length (lz-stk lz)) 1)
(set-lz-top! lz (list 0 0)))
(else
(lz-pop! lz))))
(let ((pos (car (lz-top lz)))
(pat (cadr (lz-top lz)))
(data (lz-read lz)))
; (printf "~a ~a ~a ~a~n" pos pat data (lz-stk lz))
(cond
((char=? data #\ )
(cond
((eq? (length (lz-stk lz)) 1)
(set-lz-top! lz (list 0 0)))
(else
(lz-pop! lz))))
((char=? data #\A) (lz-inc-pos lz) (lz-push! lz (list 0 0)))
((char=? data #\B) (lz-inc-pos lz) (lz-push! lz (list 0 1)))
((char=? data #\C) (lz-inc-pos lz) (lz-push! lz (list 0 2))))
(lz-read lz)))
(define (lz-prog lz pat str)
(let ((c 0))
(for-each
(lambda (item)
(lz-poke lz c pat item)
(set! c (+ c 1)))
(string->list str))))
; nz
(define max-vals 16)
(define (make-nz lz vals vx sz cur-t tk off)
(vector lz vals vx sz cur-t tk off))
(define (nz-lz n) (vector-ref n 0))
(define (nz-vals n) (vector-ref n 1))
(define (nz-vx n) (vector-ref n 2))
(define (nz-sz n) (vector-ref n 3))
(define (nz-cur-t n) (vector-ref n 4))
(define (nz-tk n) (vector-ref n 5))
(define (nz-off n) (vector-ref n 6))
(define (set-nz-vals! n v) (vector-set! n 1 v))
(define (set-nz-vx! n v) (vector-set! n 2 v))
(define (set-nz-cur-t! n v) (vector-set! n 4 v))
(define (t) (ntp-time))
(define (build-nz lz sz tk)
(make-nz lz '(60) 0 sz (ntp-time-add (t) 1) tk 1.0))
(define (nz-pop! nz)
(let ((tmp (car (nz-vals nz))))
(when (not (eq? (length (nz-vals nz)) 1))
(set-nz-vals! nz (cdr (nz-vals nz))))
tmp))
(define (nz-push! nz item)
(when (< (length (nz-vals nz)) max-vals)
(set-nz-vals! nz (cons item (nz-vals nz)))))
(define (nz-dup! nz)
(nz-push! nz (car (nz-vals nz))))
(define (ntp>? a b)
(or (> (car a) (car b))
(and (eqv? (car a) (car b))
(> (cadr a) (cadr b)))))
(define (nz-tick nz)
(when (ntp>? (ntp-time-add (t) (nz-off nz)) (nz-cur-t nz))
(set-nz-cur-t! nz (ntp-time-add (nz-cur-t nz) (nz-tk nz)))
(let ((t (lz-tick (nz-lz nz)))
(v (car (nz-vals nz))))
(cond
((char=? t #\+) (set-nz-vals! nz (cons (+ (car (nz-vals nz)) 1) (cdr (nz-vals nz)))))
((char=? t #\-) (set-nz-vals! nz (cons (- (car (nz-vals nz)) 1) (cdr (nz-vals nz)))))
((char=? t #\<) (set-nz-vx! nz (modulo (- (nz-vx nz) 1) (length (nz-sz nz)))))
((char=? t #\>) (set-nz-vx! nz (modulo (+ (nz-vx nz) 1) (length (nz-sz nz)))))
((char=? t #\a) (play (nz-cur-t nz) ((list-ref (list-ref (nz-sz nz) (nz-vx nz)) 0) v) 0))
((char=? t #\b) (play (nz-cur-t nz) ((list-ref (list-ref (nz-sz nz) (nz-vx nz)) 1) v) 0))
((char=? t #\c) (play (nz-cur-t nz) ((list-ref (list-ref (nz-sz nz) (nz-vx nz)) 2) v) 0))
((char=? t #\d) (play (nz-cur-t nz) ((list-ref (list-ref (nz-sz nz) (nz-vx nz)) 3) v) 0))
((char=? t #\[) (nz-dup! nz))
((char=? t #\]) (nz-pop! nz)))
)))
; --
(define l (build-lz 9 8 3))
(lz-prog l 0 "cCBca-aa")
(lz-prog l 1 "c-d-c<.d")
(lz-prog l 2 "b++b+ACd")
;(lz-prog l 0 "ccddddcd")
;(lz-prog l 1 "->d-AC-A")
;(lz-prog l 2 "b+b--bAB")
(define z (build-nz l
(list
(list
(lambda (v) (mul (adsr 0 0.01 0.1 1) (sine (add (mul 20 (sine 4)) (note v)))))
(lambda (v) (mul (adsr 0 0.1 0 0) (mul 0.2 (add (saw (* 1.5 (note v)))
(saw (note v))))))
(lambda (v) (mul (adsr 0 0.1 0 0)
(moogbp (squ (add 10 (mul 1000 (pow (adsr 0 0.2 0 0) 10))))
(* v 0.1) 0.1)))
(lambda (v) (mul (adsr 0 0.02 0 0) (moogbp (white 4) (* v 0.01) 0.45))))
(list
(lambda (v) (mul (adsr 0 0.03 0.1 1) (mooghp (saw (* (note v) 0.5))
(mul 0.2 (adsr 0.5 0 0 0)) 0.45)))
(lambda (v) (mul (adsr 0 0.1 0.1 1) (mooglp (add (saw (* 1.5 (note v))) (saw (note v)))
(* v 0.12) 0.4)))
(lambda (v) (mul (adsr 0 0.1 0 0) (sine (add
(fmod (* v 50) 300)
(mul 1000 (pow (adsr 0 0.2 0 0) 10))))))
(lambda (v) (mul (adsr 0.04 0.02 0 0) (mooglp (white 4) (* v 0.01) 0.45))))
(list
(lambda (v) (mul (adsr 0 0.03 0.1 1) (crush (sine (* (note v) 0.5))
0.1 0.3)))
(lambda (v) (mul (adsr 0 0.03 0.1 1) (mooglp (white (* 0.125 (note v)))
(fmod (* v 0.04) 1) 0.4)))
(lambda (v) (mul (adsr 0 0.1 0.1 0.5)
(add
(saw (add (/ (note v) 4) (mul 1000 (pow (adsr 0.3 0.1 0 0) 3))))
(saw (add (+ 1 (/ (note v) 4)) (mul 1000 (pow (adsr 0.1 0.1 0 0) 3)))))))
(lambda (v) (mul (adsr 0 0.02 0 0) (mooglp (white 4) (* v 0.01) 0.45)))))
0.1))
(define (loop)
(nz-tick z)
(sleep 100)
(loop))
;(play-now (sine 400) 0)
(loop)
......@@ -201,7 +201,7 @@ void Graph::Process(unsigned int bufsize, Sample &left, Sample &right)
while (m_EventQueue.Get(LastTime, m_CurrentTime, e)) {
float t = LastTime.GetDifference(e.TimeStamp);
// hack to get round bug with GetDifference throwing big numbers
// hack to get round bug with GetDifference throwing big numbers
if (t<=0) {
_Play(t,e.ID,e.Pan);
} else {
......@@ -211,7 +211,7 @@ void Graph::Process(unsigned int bufsize, Sample &left, Sample &right)
e.TimeStamp.Print();
}
}
for(list<pair<unsigned int, float> >::iterator i=m_RootNodes.begin();
i!=m_RootNodes.end(); ++i)
......@@ -225,12 +225,12 @@ void Graph::Process(unsigned int bufsize, Sample &left, Sample &right)
float leftpan=1,rightpan=1;
if (pan<0) leftpan=1-pan;
else rightpan=1+pan;
left.MulMix(m_NodeMap[i->first]->GetOutput(),0.1*leftpan);
right.MulMix(m_NodeMap[i->first]->GetOutput(),0.1*rightpan);
}
}
pthread_mutex_unlock(m_Mutex);
}
......@@ -252,7 +252,7 @@ void Graph::Play(unsigned int seconds, unsigned int fraction, unsigned int id, f
}
if (e.TimeStamp>=m_CurrentTime) {
m_EventQueue.Add(e);
if (e.TimeStamp.GetDifference(m_CurrentTime)>30) {
cerr<<"Reset clock? Event far in future: "<<e.TimeStamp.GetDifference(m_CurrentTime)<<endl;
}
......@@ -264,4 +264,5 @@ void Graph::Play(unsigned int seconds, unsigned int fraction, unsigned int id, f
m_EventQueue.Add(e);
}
pthread_mutex_unlock(m_Mutex);
}
......@@ -211,6 +211,7 @@
_OP_DEF(opexe_6, "synth-connect", 3, 3, 0, OP_SYNTH_CON )
_OP_DEF(opexe_6, "synth-play", 4, 4, 0, OP_SYNTH_PLY )
_OP_DEF(opexe_6, "sleep", 1, 1, 0, OP_SLEEP )
_OP_DEF(opexe_6, "fmod", 2, 2, 0, OP_FMOD )
_OP_DEF(opexe_6, "push", 0, 0, 0, OP_PUSH )
......
......@@ -4572,6 +4572,9 @@ static pointer opexe_6(scheme *sc, enum scheme_opcodes op) {
usleep(ivalue(car(sc->args)));
s_return(sc,sc->F);
} break;
case OP_FMOD: {
s_return(sc,mk_real(sc,fmod(rvalue(car(sc->args)),rvalue(cadr(sc->args)))));
} break;
//////////////////// fluxus /////////////////////////////////////////
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment