Thanks John

I've made updates (below) based on your suggestions, and the overall effect
is pleasing.


1. The use of asdr fixed the choppiness, although I don't really understand
what I'm doing. [I understand that asdr stands for
Attack-Decay-Sustain-Release
<https://en.wikipedia.org/wiki/Synthesizer#Attack_Decay_Sustain_Release_(ADSR)_envelope>
.]

It's unclear to me why I still need to clip, and some documentation would
indeed be welcome.

(define (note->piano n d)
  (define len (tone-length d))
  (clip
   (rs-mult
    (piano-tone (string->midi n))
    ((adsr 2 1.0 2 1.0 (exact-round (* 1/2 len))) len))
   0 len))

2. On my 2012 Mac the streamed version (stream-mozart) is crackly early on,
until the processing finishes.

3. More trivially I added a beats-per-minute parameter.


Finally, I look forward to someone adding some visualisation
<https://www.youtube.com/watch?v=9aW9t5Cn-KU>!


Dan


#lang racket

(require racket/random
         rsound
         rsound/piano-tones
         rsound/envelope
         net/url)

(define bpm 180) ; presto

(define base-composition-url (string->url "
https://gist.githubusercontent.com/cosmologicon/708fefa9793753ed4f075aaf781f3d67/raw/f08364a6056691215b99f705b4836f3d131ff6eb/mozart-dice-starting.txt
"))

(define (string->midi s)
  (let* ([note (string->symbol (substring s 0 1))]
         [sharp (if (string-contains? s "#") 1 0)]
         [octave (string->number (substring s (+ 1 sharp)))])
    (+ (match note ['C 0] ['D 2] ['E 4] ['F 5] ['G 7] ['A 9] ['B 11])
       sharp
       (* 12 (+ octave 1)))))

(define base-composition
  (for/list ([line (string-split
                    (port->string
                     (get-pure-port base-composition-url))
                    "\n")])
    (define items (string-split line " "))
    (cons (first items) (map string->number (rest items)))))

(define (tone-length d)
  (exact-round (/ (* FRAME-RATE 60 d) bpm)))

(define (note->piano n d)
  (define len (tone-length d))
  (clip
   (rs-mult
    (piano-tone (string->midi n))
    ((adsr 2 1.0 2 1.0 (exact-round (* 1/2 len))) len))
   0 len))

(define (in-measure note measure)
  (match-define (list _ start duration) note)
  (<= (* 3 measure) start (+ start duration) (* 3 (+ measure 1))))

(define (measure n)
  (for/list ([note base-composition] #:when (in-measure note n)
                                     #:break (in-measure note (+ 1 n)))
    (match-define (list tone start duration) note)
    (list tone (- start (* n 3)) duration)))

(define (measure->sound n)
  (rs-overlay*
   (for/list ([note (measure n)])
     (rs-append (silence (+ 1 (tone-length (second note))))
                (note->piano (first note) (last note))))))

(define preferred-measures
  '((96 32 69 40 148 104 152 119 98 3 54)
    (22 6 95 17 74 157 60 84 142 87 130)
    (141 128 158 113 163 27 171 114 42 165 10)
    (41 63 13 85 45 167 53 50 156 61 103)
    (105 146 153 161 80 154 99 140 75 135 28)
    (122 46 55 2 97 68 133 86 129 47 37)
    (11 134 110 159 36 118 21 169 62 147 106)
    (30 81 24 100 107 91 127 94 123 33 5)
    (70 117 66 90 25 138 16 120 65 102 35)
    (121 39 136 176 143 71 155 88 77 4 20)
    (26 126 15 7 64 150 57 48 19 31 108)
    (9 56 132 34 125 29 175 166 82 164 92)
    (112 174 73 67 76 101 43 51 137 144 12)
    (49 18 58 160 136 162 168 115 38 59 124)
    (109 116 145 52 1 23 89 72 149 173 44)
    (14 83 79 170 93 151 172 111 8 78 131)))

(define measure-length (tone-length 3))

(define (musical-dice)
  (for/list ([m preferred-measures])
    (list-ref m (+ (random 6) (random 6)))))


(define (play-mozart)
  (play
   (rs-append*
    (for/list ([i (musical-dice)]
               [d (in-naturals)])
      (display (~a (+ 1 d) ". " i ": "))
      (displayln (measure (- i 1)))
      (measure->sound (- i 1))))))

(define (stream-mozart)
  (define ps (make-pstream))
  (for ([i (musical-dice)]
        [d (in-naturals)])
    (display (~a (+ 1 d) ". " i ": "))
    (displayln (measure (- i 1)))
    (pstream-queue ps
                   (measure->sound (- i 1))
                   (* (+ d 1) measure-length))))

(play-mozart)

-- 
You received this message because you are subscribed to the Google Groups 
"Racket Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email 
to racket-users+unsubscr...@googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

Reply via email to