playing with audio processing in scheme

dsp.scm

#!/usr/bin/chibi-scheme
(import (scheme r5rs)
	(scheme base)
	(chibi io))

; plot function f
; start with x = start
; get next value by applying function next-f to value
; for number of samples
; output vector vec
(define (plot f start next-f samples vec i)
  (if (= samples 0)
    vec
    (begin
      (vector-set! vec i (f start))
      (plot f (next-f start) next-f (- samples 1) vec (+ 1 i)))))

; plot function f
; start with x = start
; given samples resolution
; for given number of samples
(define (plot-with-resolution f start resolution samples)
  (plot f start (lambda (x) (+ x resolution)) samples (make-vector (inexact->exact samples)) 0))

; plot a wave given function f, phase offset, frequency, samplerate, and length of time
(define (plot-wave f phase-offset frequency sample-rate time)
  (plot-with-resolution f phase-offset (* 2 pi (/ frequency sample-rate))
			(floor (* time sample-rate))))

; modulo
(define (mod x y)
  (if (< x y)
    x
    (mod (- x y) y)))

; generate a sawtooth waveform
(define (sawtooth x)
  (- (mod (/ x pi) 2) 1))

; maps range -1 to 1 to 0 to 255
; also clip
(define (unit->u8 n)
  (if (>= n 1)
    255
    (inexact->exact (floor (* 128 (+ 1 (max (min n 1) -1)))))))

; output a vector of bytes as unsigned 8bit ints
(define (print-bytes bytes)
  (vector-for-each write-u8 bytes))

; convert audio data ranged between -1 and 1 to 0 and 255
(define (format-audio data)
  (vector-map unit->u8 data))

; output raw audio data as 8bit unsigned audio
(define (print-audio data)
  (print-bytes (format-audio data)))

; environment settings
(define sample-rate 44100)
(define pi 3.14159265358979323)

; average values
(define (average . vals)
  (/ (apply + vals) (length vals)))

; average functions together
(define (average-f . functions)
  (compose-f average functions))

; add functions together
(define (add-f . functions)
  (compose-f + functions))

; multiply functions together
(define (multiply-f . functions)
  (compose-f * functions))

; compose functions with f
(define (compose-f f functions)
  (lambda args
    (apply f (map (lambda (f) 
		    (apply f args)) functions))))

; compute a line of x given slope, y-intercept
(define (line slope y-intercept x)
  (+ (* x slope) y-intercept))

; make a procudere which computes a line
(define (line-f slope y-intercept)
  (lambda (x) (line slope y-intercept x)))

; compute an envelope given a function
; (bounds x and y to > 0
(define (envelope f t)
  (if (< t 0)
    0
    (max 0 (f t))))

; compute a linear decay envelope
(define (linear-decay decay-time t)
  ; for efficiency's sake
  (if (> t decay-time)
    0
    (envelope (line-f (- (/ 1 decay-time)) 1) t)))

; make a procedure which computes a linear decay envelope
(define (linear-decay-f decay-time)
  (lambda (t) (linear-decay decay-time t)))

; simply generate a waveform for time seconds from function f
(define (gen time f)
  (plot-wave f 0.0 1 sample-rate time))

; make a procedure which comptutes the function f(t) for a given frequency
(define (f-with-freq f freq)
  (lambda (t) (f (* t freq))))

; make a procedure which comptutes the function f(t) with freq-f to compute freq of t
(define (f-with-var-freq f freq-f)
  (lambda (t) (f (* t (freq-f t)))))

; this is a function that generates a cheap kick drum
(define kick (multiply-f (linear-decay-f 1)
		         (f-with-var-freq sin (line-f -100 180))))

; delay a function
(define (delay-f-pure f delta)
  (lambda (t) (f (- t (* pi 2 delta)))))

; make function return 0 for x < 0
(define (onset-f f)
  (lambda (x)
    (if (< x 0)
      0
      (f x))))

; delay a function that gives 0 for t < 0
(define (delay-f f delta)
  (delay-f-pure (onset-f f) delta))

; here's the function that computes a cheap beat
; the sum of incrementally delayed kick drums
(define beat
  (add-f (delay-f kick 0)
         (delay-f kick 0.5)
         (delay-f kick 1)
         (delay-f kick 1.5)))

; generate the data
(define data (gen 2 (average-f beat
		               (f-with-freq sin 150)
		               (f-with-freq sin 375))))

(define (subsamples data cutoff i)
  (let ((samples (/ sample-rate cutoff)))
    (subvector data (max 0 (- i samples)) i)))

(define (low-pass cutoff data)
  (let ((filtered (vector-copy data)))
    (let loop ((i 0) (a 0))
      (if (>= i (vector-length filtered))
	filtered
	(begin
	  (vector-set! filtered i (apply average (subsamples data cutoff i)))
          (loop (+ i 1) a))))))

; output the audio data
(print-audio (low-pass 400 data))

play.sh

#!/bin/sh
./dsp.scm | aplay -r 44100 -c 1 -f U8