cobra
/
yammer
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add comments to yammer.scm 

Signed-off-by: Skylar "The Cobra" Widulski <cobra@vern.cc>
This commit is contained in:
Skylar "The Cobra" Widulski 2023-12-21 22:37:41 -05:00
parent 7664a67d9d
commit 7fd8d78740
Signed by: cobra
GPG Key ID: 4FD8F812083FF6F9
1 changed files with 58 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
yammer.scm
View File

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