; some helper functions (define (first list) (car list)) (define (second list) (car (cdr list))) (define (third list) (car (cdr (cdr list)))) ; nth in list (define (nth list n) (if (= n 0) (car list) (nth (cdr list) (- n 1)))) ; the rule definitions (define rule30-def '(0 0 0 1 1 1 1 0)) (define rule90-def '(0 1 0 1 1 0 1 0)) (define rule45-def '(0 0 1 0 1 1 0 1)) (define rule73-def '(0 1 0 0 1 0 0 1)) ;; to run program ;; ex. (sing orchard-oriole rule30 '(1) 7 0.30) ;; ex. (sing great-horned-owl rule90 '(1 0 1) 10 2.4) (define (sing bird-name rule start-cells depth note-duration) (with-sound (:srate 48000.0 :output "/zap/test.wav") (automaton-bird bird-name 0 0 (run-to-depth rule start-cells depth) note-duration))) ; the rule wrappers (define (rule30 one two three) (rule-scheme one two three rule30-def)) (define (rule90 one two three) (rule-scheme one two three rule90-def)) (define (rule45 one two three) (rule-scheme one two three rule45-def)) (define (rule73 one two three) (rule-scheme one two three rule45-def)) ; add caps around cells that are off so that rule computation works (define (add-caps list) (append '(0 0) list '(0 0))) ; maps over cells in level, computing rule with neighborhood = 3 (define (map-triplets rule list) (cond ((< (length list) 3) '()) (else (cons (rule (first list) (second list) (third list)) (map-triplets rule (cdr list)))))) ; calculates rule evaluation on neighborhood given the rule definition (define (rule-scheme one two three rule-def) (nth rule-def (+ (* (- 1 one) 4) (* (- 1 two) 2) (- 1 three)))) ; calculates the whole of level (define (iterate-rule rule list) (map-triplets rule (add-caps list))) ; calculates automaton to required depth (define (run-to-depth rule list depth) (if (= depth 0) list (run-to-depth rule (iterate-rule rule list) (- depth 1)))) ;; this controls the bird using a cellular automaton parameter ;; the bird sings whenever there is a 1 in the automaton and doesn't ;; when there is a 0 (define (automaton-bird bird-name beg n control-automaton note-duration) (cond ((= n (length control-automaton)) (display control-automaton)) ((= 0 (nth control-automaton n)) (automaton-bird bird-name (+ beg note-duration) (+ n 1) control-automaton note-duration)) (else (bird-name beg) (automaton-bird bird-name (+ beg note-duration) (+ n 1) control-automaton note-duration)))) ;; a bird I'm using (modified from Bill Schottstaedt) (define (great-horned-owl beg) (let ((owlup '(.00 .00 .30 1.00 1.00 1.0)) (owldown '(.00 1.00 1.00 .0)) (rand-int (random 4))) (cond ((= rand-int 0) (bigbird beg .1 300 0 .1 main-amp main-amp '(1 1 3 .02 7 .01))) ((= rand-int 1) (bigbird beg .4 293 6 .1 owldown main-amp '(1 1 3 .02 7 .01))) ((= rand-int 2) (bigbird beg .35 293 7 .1 owldown main-amp '(1 1 3 .02 7 .01))) (else (bigbird beg .2 300 0 .1 owlup main-amp '(1 1 3 .02 7 .01)))))) ;; another bird modified from Bill Schottstaedt (define (orchard-oriole beg) (let ((oriup '(.00 .00 1.00 1.0)) (oridwn '(.00 1.00 1.00 .0)) (oriupdwna '(.00 .00 .60 1.00 1.00 .60 )) (oriupdwnb '(.00 .50 .30 1.00 1.00 .0)) (oribiga '(.00 .90 .15 1.00 .40 .30 .60 .60 .85 .00 1.00 .0)) (orimid '(.00 1.00 .05 .50 .10 1.00 .25 .00 .85 .50 1.00 .0)) (oridwnup '(.00 .30 .25 .00 1.00 1.0)) (oriamp '(.00 .00 .10 1.00 1.00 .0)) (rand-int (random 16))) (cond ((= rand-int 0) (bird beg .03 3700 100 .05 oridwn main-amp)) ((= rand-int 1) (bird beg .05 2500 1000 .1 oriup main-amp)) ((= rand-int 2) (bigbird beg .1 2000 800 .2 oriupdwna main-amp '(1 1 2 .02 3 .05))) ((= rand-int 3) (bird beg .03 3900 1200 .1 oridwn main-amp)) ((= rand-int 4) (bigbird beg .21 2000 1200 .15 oribiga main-amp '(1 1 2 .05))) ((= rand-int 5) (bird beg .05 4200 1000 .1 oridwn main-amp)) ((= rand-int 6) (bigbird beg .1 2000 1000 .25 orimid main-amp '(1 1 2 .05))) ((= rand-int 7) rand (bigbird beg .1 2000 1000 .25 orimid main-amp '(1 1 2 .05))) ((= rand-int 8) (bird beg .1 2300 3200 .1 oriupdwnb oriamp)) ((= rand-int 9) (bird beg .03 1800 300 .05 oriup main-amp)) ((= rand-int 10) (bird beg .03 2200 100 .04 oridwn main-amp)) ((= rand-int 11) (bird beg .07 2500 2000 .15 oriupdwnb oriamp)) ((= rand-int 12) (bigbird beg .2 2400 1200 .25 oridwnup main-amp '(1 1 2 .04))) ((= rand-int 13) (bird beg .02 2200 3000 .04 oriup main-amp)) ((= rand-int 14) (bird beg .02 2200 3000 .04 oriup main-amp)) (else (bigbird beg .17 2000 1000 .2 oriupdwna oriamp '(1 1 2 .04)))))) ;;; bird songs -- (load "bird.scm") then (make-birds) ;;; writes "test.snd" unless you give it a file name as in (make-birds "hiho.snd") ;;; translated (semi-automatically) from a Sambox note list to bird.clm, then bird.scm (use-modules (ice-9 optargs) (ice-9 format)) (if (not (defined? '*output*)) (load-from-path "ws.scm")) (definstrument (bigbird start dur frequency freqskew amplitude freq-envelope amp-envelope partials) "(bigbird start dur frequency freqskew amplitude freq-envelope amp-envelope partials)" (define (sum-partials lst sum) (if (null? lst) sum (sum-partials (cddr lst) (+ sum (cadr lst))))) (define (scale-partials lst scl newlst) (if (null? lst) newlst (scale-partials (cddr lst) scl (append newlst (list (car lst) (* scl (cadr lst))))))) (define (normalize-partials lst) (scale-partials lst (/ 1.0 (sum-partials lst 0.0)) '())) (let* ((gls-env (make-env freq-envelope (hz->radians freqskew) dur)) (os (make-oscil :frequency frequency)) (coeffs (partials->polynomial (normalize-partials partials))) (amp-env (make-env amp-envelope amplitude dur)) (beg (inexact->exact (round (* (mus-srate) start)))) (len (inexact->exact (round (* (mus-srate) dur)))) (end (+ beg len))) (if (c-g?) (throw 'with-sound-interrupt)) (run (lambda () (do ((i beg (1+ i))) ((= i end)) (outa i (* (env amp-env) (polynomial coeffs (oscil os (env gls-env)))) *output*)))))) (definstrument (bird start dur frequency freqskew amplitude freq-envelope amp-envelope) "(bird start dur frequency freqskew amplitude freq-envelope amp-envelope)" (let* ((gls-env (make-env freq-envelope (hz->radians freqskew) dur)) (os (make-oscil :frequency frequency)) (amp-env (make-env amp-envelope amplitude dur)) (len (inexact->exact (round (* (mus-srate) dur)))) (beg (inexact->exact (round (* (mus-srate) start)))) (end (+ beg len))) (if (c-g?) (throw 'with-sound-interrupt)) (run (lambda () (do ((i beg (1+ i))) ((= i end)) (outa i (* (env amp-env) (oscil os (env gls-env))) *output*)))))) (define main-amp '(.00 .00 .25 1.00 .60 .70 .75 1.00 1.00 .0)) (define bird-tap '(.00 .00 .01 1.00 .99 1.00 1.00 .0)) (define bird-amp '(.00 .00 .25 1.00 .75 1.00 1.00 .0))