Oops forgot to cc: users. Dan, if you respond, could you respond to this one 
rather than the one I sent only to you? Sorry.

John

> Begin forwarded message:
> 
> From: John Clements <cleme...@brinckerhoff.org>
> Subject: Re: [racket-users] Mozart's Musical dice with rsound
> Date: March 29, 2018 at 15:24:11 PDT
> To: Daniel Prager <daniel.a.pra...@gmail.com>
> 
> 
> 
>> On Mar 29, 2018, at 14:40, Daniel Prager <daniel.a.pra...@gmail.com> wrote:
>> 
>> For fun, I've written a program to synthesise random compositions based on 
>> Mozart's musical dice procedure, with results played courtesy of rsound. 
>> [Program appended.]
>> 
>> See this Daily Programmer challenge for background:
>> 
>> https://www.reddit.com/r/dailyprogrammer/comments/7i1ib1/20171206_challenge_343_intermediate_mozarts/
>> 
>> 
>> Areas for improvement 
>> 
>> 1. There is an unpleasant quality to the ends of the notes, which I generate 
>> by naively clipping piano-tones. Furthermore, if I up the tempo (e.g. set 
>> BEAT-LENGTH to 1/4) it becomes unlistenable. What's a better way to truncate 
>> the notes?
> 
> Check out the “envelope” functions. I think you’re looking for something like 
> this:
> 
> ```
> #lang racket
> 
> (require rsound
>         rsound/envelope)
> 
> (play
> 
> (rs-mult
>  (make-tone 500 0.7 48000)
>  ((adsr 2 1.0 2 1.0 24000) 48000)))
> ```
> 
> The adsr function is undocumented. Let me know if you want me to document it.
> 
>> 
>> 2. I assembled the piece by appending measures and then playing the result. 
>> What's the recommended way to reduce memory and start playing faster using 
>> (say) pstream?
> 
> 
> Something like this:
> 
> ```
> #lang racket
> 
> (require rsound
>         rsound/envelope
>         rsound/piano-tones)
> 
> (define FR 48000)
> (define bpm 120)
> (define qtr-len (round (* FR (/ 60 bpm) 1)))
> (define eighth-len (round (* FR (/ 60 bpm) 1/2)))
> 
> (define notes
>  '((0 60)
>    (1 62)
>    (2 64)
>    (3 65)
>    (4 62)
>    (5 64)
>    (6 60)))
> 
> (define ps (make-pstream))
> 
> (define delay (* FR 1))
> 
> (for ([n (in-list notes)])
>  (pstream-queue ps
>                 (piano-tone (second n))
>                 (+ delay (* (first n) eighth-len))))
> ```
> 
> Note that since the pstream starts its internal clock immediately, queueing 
> things to play without a delay will be a problem; by the time the piano-tone 
> is computed, you’re queueing it in the past. A delay of a second is fine on 
> my machine, but it might not be on a different one.
> 
> Also, the piano notes are hashed on construction, so you could “warm up” the 
> generator by pre-generating each pitch you want to use.
> 
> Finally, the piano note generation could be a lot faster; it’s not really 
> optimized at all.
> 
> Best,
> 
> John
> 
> 
>> 
>> Dan
>> 
>> 
>> #lang racket
>> 
>> (require racket/random
>>         rsound
>>         rsound/piano-tones
>>         net/url)
>> 
>> (define BEAT-LENGTH 1/2)
>> 
>> (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 (note->piano n d)
>>  (clip (piano-tone (string->midi n)) 0 (exact-round (* FRAME-RATE d 1/2))))
>> 
>> (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 (exact-round (* BEAT-LENGTH FRAME-RATE (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 (musical-dice)
>>  (for/list ([m preferred-measures])
>>    (list-ref m (+ (random 6) (random 6)))))
>> 
>> (play
>> (rs-append*
>>  (for/list ([i (musical-dice)])
>>    (display (~a i ": "))
>>    (displayln (measure (- i 1)))
>>    (measure->sound (- i 1)))))
>> 
>> -- 
>> 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.
> 

-- 
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