diff --git a/yammer.scm b/yammer.scm index 1e70688..6d2a1ea 100644 --- a/yammer.scm +++ b/yammer.scm @@ -37,28 +37,32 @@ #:use-module (system foreign) #:use-module (yammer fftw)) +;; Add this dir to load path, for config (add-to-load-path ".") - (load "config.scm") + +;; Define widely used constants in relation to config values (define recip-fps (/ 1 fps)) (define sample-size (* 4 (round (* 3 (* (/ 44100 4) recip-fps))))) -(define vsize (exact (/ sample-size 4))) +;; Plan definition (if using fft) (define plan #f) -(if fft (monitor (set! plan (init_plan vsize)))) +(if fft (monitor (set! plan (init_plan (exact (/ sample-size 4)))))) +;; Initialize more values (define window #f) -(define win-id #f) (define renderer #f) (define bv (make-bytevector sample-size)) (define queue (make-q)) +;; Turns a list lst into a list of pairs (chunks of 2) (define (chunk2 lst) (if (>= (length lst) 2) (cons (take lst 2) (chunk2 (drop lst 2))) '())) +;; Open the MPD FIFO (define (open-fifo filename) (define fd (open-input-file filename)) (fcntl fd F_SETFL (logior O_NONBLOCK @@ -66,58 +70,70 @@ (setvbuf fd 'block sample-size) fd) +;; Read from the MPD FIFO (define (read-fifo fd) (if (port-closed? fd) (set! fd (open-fifo fifo-file))) (define new-bv #vu8()) (define bytes-read 0) (while (< bytes-read sample-size) - (set! new-bv (bytevector-append new-bv (bytevector (read-u8 fd)))) - (set! bytes-read (1+ bytes-read)) - (set! new-bv (bytevector-append - new-bv (get-bytevector-n fd (- sample-size bytes-read)))) - (set! bytes-read (bytevector-length new-bv))) + ;; TODO: timeout this read operation somehow + (set! new-bv (bytevector-append new-bv (bytevector (read-u8 fd)))) + (set! bytes-read (1+ bytes-read)) + (set! new-bv (bytevector-append + new-bv (get-bytevector-n + fd (- sample-size bytes-read)))) + (set! bytes-read (bytevector-length new-bv))) (enq! queue new-bv) (if (>= (q-length queue) queue-size) (set! bv (deq! queue)))) +;; Draw to renderer `ren' from chunked list `plst' (define (draw ren plst) (clear-renderer ren) (define init-surf #f) (define surf #f) (receive (x y) (window-size window) (set! init-surf (make-rgb-surface x y 32)) + ;; Make `surf' have rgba8888 pixel format, though alpha is unused (set! surf (convert-surface-format init-surf 'rgba8888)) + ;; Free `init-surf' (unused) (delete-surface! init-surf) + ;; Create surface-wide rectangle (fill-rect surf #nil color) (let ((y-mid (round/ y 2))) (do ((i 0 (+ i (* (/ x (length plst)) resolution))) (j 0 (1+ j))) ((>= j (length plst))) - (begin + (fill-rect + surf + (make-rect + (floor i) 0 + (* (ceiling/ x (length plst)) resolution) + ;; Math to make scale a sane value + (- y-mid (abs (round/ (* y (car (list-ref plst j))) + (/ 76800 scale))))) + bgcolor) + ;; This value is used twice, define in let statement + (let ((n (abs (round/ (* y (cadr (list-ref plst j))) + (/ 76800 scale))))) (fill-rect surf (make-rect - (floor i) 0 + (floor i) (+ y-mid n) (* (ceiling/ x (length plst)) resolution) - (- y-mid (abs (round/ (* y (car (list-ref plst j))) - (/ 76800 scale))))) - bgcolor) - (let ((n (abs (round/ (* y (cadr (list-ref plst j))) - (/ 76800 scale))))) - (fill-rect - surf - (make-rect - (floor i) (+ y-mid n) - (* (ceiling/ x (length plst)) resolution) - (- y-mid n)) - bgcolor)))))) + (- y-mid n)) + bgcolor))))) + ;; Create texture from surface (define texture (surface->texture ren surf)) + ;; Send to renderer (render-copy ren texture) (present-renderer ren) + ;; Free `texture' and `surf' (delete-texture! texture) (delete-surface! surf)) +;; Smooth non-chunked list `lst' with mode `type' (define (smooth lst type) (define ret '()) (define window 0) @@ -133,18 +149,24 @@ (set! ret (append ret (list window)))))) ret) +;; Run loop (define (lp ren fft?) (define read-future #f) (define sleep-future #f) (define plst '()) - (while (not (window-closed-event? (poll-event))) + (while (not (window-closed-event? (poll-event))) ;; Break on window close + ;; Initialize fps sleep to touch later (set! sleep-future (future (usleep (round (* recip-fps 1000))))) + ;; In the meantime, check if the read bytevector is the right size (if (= (bytevector-length bv) sample-size) (begin + ;; Chunk the bytevector (set! plst (chunk2 (bytevector->sint-list bv (native-endianness) 2))) + ;; Read again (set! read-future (future (read-fifo fd))) (if fft? + ;; FFF smoothing enabled check (if (not (equal? smoothing-mode #f)) (draw ren (map list @@ -164,22 +186,23 @@ (s16vector->list (do-dft plan (map cadr plst) (length plst)))))) + ;; No FFT (draw ren plst)))) (touch sleep-future))) +;; Initially open the MPD FIFO (define fd (open-fifo fifo-file)) -(sdl-init '(video events)) -(set! window (make-window #:title "Yammer")) -(set! win-id (window-id window)) -(set-window-resizable! window #t) -(set! renderer (make-renderer window)) +(sdl-init '(video events)) ;; Initialize SDL2 +(set! window (make-window #:title "Yammer")) ;; Create window +(set-window-resizable! window #t) ;; Allow window resizing +(set! renderer (make-renderer window)) ;; Create renderer from window -(lp renderer fft) +(lp renderer fft) ;; Run the loop -(delete-renderer! renderer) -(close-window! window) -(sdl-quit) -(close-port fd) +(delete-renderer! renderer) ;; Free renderer on close +(close-window! window) ;; Close window +(sdl-quit) ;; Quit SDL2 +(close-port fd) ;; Close MPD FIFO -(if fft (monitor (fftw_destroy_plan plan))) +(if fft (monitor (fftw_destroy_plan plan))) ;; Free FFT plan if FFT is enabled