#lang racket
(require (planet "main.rkt" ("clements" "rsound.plt" 1 7)))
(require racket/runtime-path)
(define sr 44100)
(define bpm 130)
(define num-steps 12)
(define beat-steps 4)
(unless (integer? (/ num-steps beat-steps))
(error 'num-steps
"the number of steps (~s) is not divisible by the steps per beat (~s)."
num-steps
beat-steps))
(define beat-length (/ 60 bpm))
(define sps (* (/ beat-length beat-steps) sr))
(define (rsound-overlay/z rsounds)
(rsound-overlay* (map (lambda (l) (list l 0)) rsounds)))
(define (loop-at rsound loop-len)
(let ([rlen (rsound-frames rsound)])
(unless (< 0 loop-len rlen)
(error 'loop-at
"expected a number of frames between 0 and the length of the rsound (~s)."
(rsound-frames rsound)))
(unless (<= (/ rlen 2) loop-len)
(error 'loop-at
(format
(string-append
"the given loop-length (~s) is less than half the length of the "
"sound (~s). This would cause triple overlap.")
loop-len
rlen)))
(rsound-overlay/z (list (rsound-clip rsound 0 loop-len)
(rsound-clip rsound loop-len rlen)))))
(define (s sound . switches)
(rsound-overlay*
(for/list ([b (in-list switches)]
[i (in-naturals)]
#:when (= b 1))
(list sound (round (* i sps))))
))
(define-runtime-path drum-samples "./drum-samples")
(define kick (rsound-read (build-path drum-samples "bassdrum-synth.wav")))
(define ohihat (rsound-read (build-path drum-samples "ohihat.wav")))
(define chihat (rsound-read (build-path drum-samples "chihat.wav")))
(define clap (rsound-read (build-path drum-samples "clap.wav")))
(define crash (rsound-read (build-path drum-samples "crash_cymbal.wav")))
(define pattern1
(rsound-overlay/z
(list
(s kick 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0)
(s ohihat 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 0)
(s chihat 0 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1)
(s clap 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0))))
(define pattern2
(rsound-overlay/z
(list
(s kick 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0)
(s ohihat 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0)
(s chihat 0 1 1 0 0 0 1 1 0 1 0 1 0 1 0 1)
(s clap 0 0 0 0 1 0 0 1 0 0 0 0 1 0 0 0))
))
(define (random-row prob)
(build-list num-steps (lambda (dc) (if (< (random) prob) 1 0))))
(define pattern3
(rsound-overlay/z
(list
(apply s kick (random-row 0.2))
(apply s chihat (random-row 0.8))
(apply s ohihat (random-row 0.4))
(apply s crash (random-row 0.1)))))
(define pat4
(rsound-overlay/z
(list
(s kick 1 0 0 0 0 0 1 0 0 0 0 0)
(s chihat 0 1 0 0 1 1 0 1 0 0 1 1))))
(define pattern3
(rsound-overlay/z
(list
(s kick 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0)
(s ohihat 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0)
(s chihat 0 1 0 1 0 1 0 1 0 1 1 1 0 1 0 1)
(s clap 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0)
(s crash 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0))))
(define (overlay-patterns . patterns)
(rsound-overlay*
(for/list ([p (in-list patterns)]
[i (in-naturals)])
(list p (round (* i (* num-steps sps)))))))
(rsound-loop (loop-at (overlay-patterns pat4 pat4 pat4)
(floor (* sps num-steps 3))))