#lang racket

(require "rsound.rkt"

(provide rsound-draw
         ;; for testing

(define channels 2)

(define (make-sound-drawing-callback left-getter right-getter vec-len)
  (let ([sound-max (max (abs-max-from left-getter vec-len)
                        (abs-max-from right-getter vec-len))])
    (lambda (canvas dc)
      (let* ([h (send canvas get-height)]
             [half-h (/ h 2)]
             [w (send canvas get-width)]
             [frames vec-len]
             [h-scale (/ (- frames 1) (- w 1))]
             [v-scale (/ (/ half-h 2) sound-max)]
             [upper-centerline (* 1/2 half-h)]
             [lower-centerline (* 3/2 half-h)])
        ;; basically, this is a rasterization problem.
        ;; the very left and right edges are special cases.
        ;; ... in fact, I'll just skip them for now :)
        (for ([i (in-range 1 (- w 1))])
          (let ([raster-left (* h-scale (- i 1/2))]
                [raster-right (* h-scale (+ i 1/2))])
          (let*-values ([(left-min left-max) (rasterize-column left-getter raster-left raster-right)]
                        [(right-min right-max) (rasterize-column right-getter raster-left raster-right)])
            (send dc draw-line
                  i (inexact->exact (floor (- upper-centerline (* v-scale left-max))))
                  i (inexact->exact (floor (- upper-centerline (* v-scale left-min)))))
            (send dc draw-line
                  i (inexact->exact (floor (- lower-centerline (* v-scale right-max))))
                  i (inexact->exact (floor (- lower-centerline (* v-scale right-min))))))))))))

;; max-from : (nat -> number) nat -> number
;; find the largest absolute value among the samples in [0,limit)
(define (abs-max-from getter limit)
  (for/fold ([abs-max 0])
    ([i (in-range limit)])
    (max (abs (getter i)) abs-max)))

;; rasterize-column: return the min and max points that the sampled line reaches in
;; the interval defined by the left and right edge.
;; (nat -> number) number number -> (values number number)
(define (rasterize-column getter left-edge right-edge)
  (let* ([left-edge-left-value (interpolate getter left-edge)]
         [left-edge-right-value (interpolate getter right-edge)]
         [in-between-left-values (for/list ([i (in-range (ceiling left-edge) (floor right-edge))])
                                   (getter i))]
         [all-vals (cons left-edge-left-value (cons left-edge-right-value in-between-left-values))]
         [left-min (apply min all-vals)]
         [left-max (apply max all-vals)])
      (values left-min left-max)))

;; where does the interpolated line between samples cross a vertical line?
(define (interpolate get-sample n)
  (let* ([fl (floor n)]
         [frac (- n fl)])
    (+ (* (- 1 frac) (get-sample fl)) (* frac (get-sample (+ fl 1))))))

(define sound-canvas%
  (class canvas%
    (init-field len)
    (init-field frame-num-text)
    (inherit get-width get-parent)
    (define/override (on-event evt)
      (let* ([x (send evt get-x)])
        (send frame-num-text begin-edit-sequence #f)
        (send frame-num-text erase)
        (send frame-num-text insert (number->string (pixel->frame x)))
        (send frame-num-text end-edit-sequence)))
    ;; given an x coordinate, return the corresponding frame
    (define (pixel->frame x)
      (floor (* len (/ x (get-width)))))

(define (vectors-draw title left-getter right-getter len width height)
  (let* ([f (new frame% [label title] [width width] [height height])]
         [t (new text%)]
         [c (new sound-canvas% 
                 [parent f]
                 [paint-callback (make-sound-drawing-callback left-getter right-getter len)]
                 [len len]
                 [frame-num-text t])]
         [ec (new editor-canvas%
                  [parent f]
                  [editor t]
                  [style '(no-border no-hscroll no-vscroll)]
                  [stretchable-width #f]
                  [stretchable-height #f]
                  [horizontal-inset 1]
                  [vertical-inset 1]
                  [min-width 50]
                  [min-height 20])])
    (send f show #t)))

(define (rsound-draw sound #:title [title "picture of sound"] #:width [width 800] #:height [height 200])
  (vectors-draw title
                (lambda (i) (rsound-nth-sample/left sound i))
                (lambda (i) (rsound-nth-sample/right sound i))
                (rsound-frames sound)