Code from class, 2012-11-16

auto-play.rkt

(require (planet clements/rsound:4))
(require "event-channel.rkt")
(require 2htdp/image)
(require 2htdp/universe)

(define ec (make-event-channel))

;; an event is either
;; - (make-note-start number)
;; - (make-note-stop)
(define-struct note-start (pitch))
(define-struct note-stop ())

;; a schedule is a list of future-events

;; a future-event is [make-future-event event number]
(define-struct future-event (event time))

;; latch : remember the last non-false value
(define (latch input old)
  (cond [(false? input) old]
        [else input]))

(check-expect (latch 34 49) 34)
(check-expect (latch false 49) 49)

(define (env-fun last-evt old)
  (cond [(note-start? last-evt) 0.5]
        [else 
         (max 0.0 (* old #i0.9999))]))

(signal-play 
 (network ()
          [last-evt (latch (try-get-event ec) 
                           (prev last-evt 
                                 (make-note-stop)))]
          [env-amp (env-fun last-evt (prev env-amp 0.0))]
          [pitch (+ 0 (cond [(note-start? last-evt)
                             (note-start-pitch last-evt)]
                            [else (prev pitch 0.0)]))]
          [tone (sine-wave pitch)]
          [out (* tone env-amp)]))



;; keh : world key -> world
#;(define (keh w k)
  (cond [(key=? "1" k) 
         (begin (send-event ec (make-note-start 440.0))
                w)]
        [(key=? "2" k)
         (begin (send-event ec (make-note-start 920.0))
                w)]
        [else w]))

;; kreh : world key -> world
#;(define (kreh w k)
  (begin
    (send-event ec (make-note-stop))
    w))

(define (fake-draw w) (empty-scene 100 100))


(define TICK-INTERVAL 1/30)

;; tick-handler : world -> world
(define (tick-handler w)
  (local [(define t (world-time w))
          (define rem (world-remaining w))]
    (cond [(empty? rem)
           (make-world (+ t TICK-INTERVAL) rem)]
          [else
           (cond [(<= (future-event-time (first rem)) t)
                  (begin (send-event ec
                                     (future-event-event
                                      (first rem)))
                         (make-world (+ t TICK-INTERVAL)
                                     (rest rem)))]
                 [else
                  (make-world (+ t TICK-INTERVAL) rem)])])))



(define example-schedule
  (cons (make-future-event (make-note-start 400.0) 0)
        (cons (make-future-event (make-note-stop) 1)
              (cons (make-future-event (make-note-start 500.0) 2)
                    (cons (make-future-event (make-note-stop) 3)
                          empty)))))

;; a world is [make-world number schedule]
(define-struct world (time remaining))

(define initial-world
  (make-world 0 example-schedule))

(check-expect (tick-handler initial-world)
              (make-world 1/30
                          (cons (make-future-event (make-note-stop) 1)
                                (cons (make-future-event (make-note-start 500.0) 2)
                                      (cons (make-future-event (make-note-stop) 3)
                                            empty)))))
 
(big-bang initial-world
          [on-draw fake-draw]
          [on-tick tick-handler TICK-INTERVAL]
          #;[on-key keh]
          #;[on-release kreh])