code from class 2011-10-23

class-code.rkt

(require rsound)
(require 2htdp/universe)
(require 2htdp/image)
 
(define SR 44100.0)
(define (s sec) (* sec SR))
;(define beat-frames (round (/ (* SR 60) 128)))
;(define (beat b) (* beat-frames b))
 
(define LEAD-FRAMES (s 1/14))
(define TICK-INTERVAL 1/28)
(define TICK-FRAMES (s TICK-INTERVAL))
 
(define samp (rs-read/clip "/tmp/yuba-city.wav" (s 0) (s 20)))
 
;(play samp)
 
;; a loop is (make-loop sound frame frame)
(define-struct loop (sound start end))
 
(define LOOP1 (make-loop samp (s 8) (s 9)))
(define TEST-PSTREAM (make-pstream))
 
(check-expect (loop-start LOOP1) (s 7))
 
;; plays a loop
;; loop -> "played sound"
(define (play-loop-times n loop)
  (play
   (times
    n
    (loop->sound loop))))
 
;; loop -> sound
;; extract the looped portion of the sound
(define (loop->sound loop)
  (clip
   (loop-sound loop)
   (loop-start loop)
   (loop-end loop)))
 
;; loop -> number
;; return the length of the loop in frames
(define (loop-len l)
(- (loop-end l) (loop-start l)))
 
(check-expect (loop-len (make-loop samp 340 410)) 70)
 
;; should play sound, as well:
#;(check-expect (play-loop-times
4
(make-loop samp
(beat 4)
(beat 8)))
"played sound")
 
 
 
(define WIDTH 400)
(define HEIGHT 300)
(define LEFT-PAD 40)
(define RIGHT-PAD 40)
(define LINE-HEIGHT 50)
 
 
(define START-IMG (star 40 "solid" "red"))
(define STOP-IMG (triangle 40 "solid" "tan"))
 
;; a world is (make-world pct pct pstream frames loop)
(define-struct world (start end stream next-start loop))

;; world -> scene
;; draw a slider world
(define (draw-world w)
  (place-image
   STOP-IMG
   (+ LEFT-PAD
      (* (/ (world-end w) 100)
         (- WIDTH LEFT-PAD RIGHT-PAD)))
   LINE-HEIGHT
   (place-image
    START-IMG
    (+ LEFT-PAD
       (* (/ (world-start w) 100)
          (- WIDTH LEFT-PAD RIGHT-PAD)))
    LINE-HEIGHT
    (scene+line
     (empty-scene WIDTH HEIGHT)
     LEFT-PAD LINE-HEIGHT (- WIDTH RIGHT-PAD) LINE-HEIGHT
     (make-pen "lightblue" 15 "solid" "round" "round"))))
  )



(check-expect
 (draw-world (make-world 50 75 TEST-PSTREAM LOOP1 0))
 (place-image
  STOP-IMG
  (+ LEFT-PAD
     (* 0.75 (- WIDTH LEFT-PAD RIGHT-PAD)))
  LINE-HEIGHT
  (place-image
   START-IMG
   200
   LINE-HEIGHT
   (scene+line
    (empty-scene WIDTH HEIGHT)
    LEFT-PAD LINE-HEIGHT (- WIDTH RIGHT-PAD) LINE-HEIGHT
    (make-pen "lightblue" 15 "solid" "round" "round")))))




#;(draw-world (make-world 25 50))

;; world number number string -> world
(define (mouse-handler w x y evt)
  (cond [(or (string=? evt "button-down")
             (string=? evt "drag"))
         (make-world (* 100 (/ x WIDTH))
                     (world-end w)
                     (world-stream w)
                     (world-next-start w)
                     (world-loop w))]
        [else
         w])
  )



 
(check-expect (mouse-handler (make-world 25 50  TEST-PSTREAM LOOP1 0)
                             200 30 "button-down")
              (make-world 50 50 TEST-PSTREAM LOOP1 0))
(check-expect (mouse-handler (make-world 25 50  TEST-PSTREAM LOOP1 0)
                             200 30 "move")
              (make-world 25 50 TEST-PSTREAM LOOP1 0))





;; world -> world
;; play the loop when it's time to
(define (maybe-play w)
  (cond [(< (- (world-next-start w)
               (pstream-current-frame (world-stream w)))
            LEAD-FRAMES)
         (make-world
          (world-start w)
          (world-end w)
          (pstream-queue (world-stream w)
                        (loop->sound (world-loop w))
                        (world-next-start w))
          (+ (world-next-start w)
             (loop-len (world-loop w)))
          (world-loop w))]
        [else w])
  ;(world-stream w)
  ;(world-next-start w)
  ;(world-loop w)
  )

;; should play the sound
(check-expect 
 (maybe-play (make-world 0 100 TEST-PSTREAM
                         0
                         LOOP1))
 (maybe-play (make-world 0 100 TEST-PSTREAM
                         (s 1)
                         LOOP1)))


(big-bang (make-world 25 50 (make-pstream) 0 LOOP1)
          [to-draw draw-world]
          [on-mouse mouse-handler]
          [on-tick maybe-play])