Smoothing !!!
Signed-off-by: Skylar "The Cobra" Widulski <cobra@vern.cc>
This commit is contained in:
parent
8ce6e20fe8
commit
e8aa120b31
|
@ -1,3 +1,4 @@
|
|||
compile.sh
|
||||
libyammer.so
|
||||
config.scm
|
||||
*.swp
|
||||
|
|
|
@ -24,8 +24,10 @@ Below is a list of values and what they do
|
|||
* `bgcolor`: Background color
|
||||
* `queue-size`: The size of the queue (minimum of 1), delays displaying bars by `queue-size` frames. Useful if desync is noticed
|
||||
* `fft`: Whether or not to perform a fourier transform to show frequencies (like `spectrum` mode in most other visualizers)
|
||||
* `smoothing`: Not implemented
|
||||
* `smoothing-factor`: Not implemented
|
||||
* `smoothing`: Smoothing mode. Possible values are:
|
||||
* `#f`: No smoothing
|
||||
* `moving-average`: Moving average
|
||||
* `moving-average-block-size`: Size of the moving average window. Higher is smoother.
|
||||
|
||||
# Running
|
||||
Either install libyammer.so and yammer.h to their respective systemwide locations, or do the following:
|
||||
|
@ -40,7 +42,7 @@ guile -L . yammer.scm
|
|||
|
||||
# Wishlist
|
||||
* Native PulseAudio and PipeWire sources
|
||||
* Smoothing
|
||||
* More smoothing modes
|
||||
* Average over `resolution`
|
||||
* Offload some calculations to the GPU
|
||||
|
||||
|
|
|
@ -0,0 +1,193 @@
|
|||
;;;
|
||||
;;; Copyright (C) 2023 Skylar Widulski
|
||||
;;;
|
||||
;;; This file is part of Yammer.
|
||||
;;;
|
||||
;;; Yammer is free software: you can redistribute it and/or modify it under the
|
||||
;;; terms of the GNU General Public License as published by the Free Software
|
||||
;;; Foundation, either version 3 of the License, or (at your option) any later
|
||||
;;; version.
|
||||
;;;
|
||||
;;; Yammer is distributed in the hope that it will be useful, but WITHOUT ANY
|
||||
;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
;;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
|
||||
;;; details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License along with
|
||||
;;; Yammer. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;;
|
||||
|
||||
(define-module (yammer)
|
||||
#:declarative? #f
|
||||
#:use-module (sdl2)
|
||||
#:use-module (sdl2 blend-mode)
|
||||
#:use-module (sdl2 events)
|
||||
#:use-module (sdl2 render)
|
||||
#:use-module (sdl2 rect)
|
||||
#:use-module (sdl2 surface)
|
||||
#:use-module (sdl2 video)
|
||||
#:use-module (ice-9 binary-ports)
|
||||
#:use-module (ice-9 futures)
|
||||
#:use-module (ice-9 receive)
|
||||
#:use-module (ice-9 threads)
|
||||
#:use-module (ice-9 q)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (scheme base)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (system foreign)
|
||||
#:use-module (yammer fftw))
|
||||
|
||||
(add-to-load-path ".")
|
||||
|
||||
(define moving-average 0)
|
||||
|
||||
(load "config.scm")
|
||||
(define recip-fps (/ 1 fps))
|
||||
(define sample-size (* 4 (round (* 3 (* (/ 44100 4) recip-fps)))))
|
||||
(define vsize (exact (/ sample-size 4)))
|
||||
|
||||
(define plan #f)
|
||||
(if fft (monitor (set! plan (init_plan vsize))))
|
||||
|
||||
(define window #f)
|
||||
(define win-id #f)
|
||||
(define renderer #f)
|
||||
(define bv (make-bytevector sample-size))
|
||||
(define queue (make-q))
|
||||
|
||||
(define (chunk2 lst)
|
||||
(if (>= (length lst) 2)
|
||||
(cons (take lst 2)
|
||||
(chunk2 (drop lst 2)))
|
||||
'()))
|
||||
|
||||
(define (open-fifo filename)
|
||||
(define fd (open-input-file filename))
|
||||
(fcntl fd F_SETFL (logior O_NONBLOCK
|
||||
(fcntl fd F_GETFL)))
|
||||
(setvbuf fd 'block sample-size)
|
||||
fd)
|
||||
|
||||
(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)))
|
||||
(enq! queue new-bv)
|
||||
(if (>= (q-length queue) queue-size)
|
||||
(set! bv (deq! queue))))
|
||||
|
||||
(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))
|
||||
(set! surf (convert-surface-format init-surf 'rgba8888))
|
||||
(delete-surface! init-surf)
|
||||
(fill-rect surf #nil color)
|
||||
(let ((y-mid (round/ y 2)))
|
||||
(do ((i 0 (+ i (/ x (length plst))))
|
||||
(j 0 (1+ j)))
|
||||
((>= j (length plst)))
|
||||
(begin
|
||||
(fill-rect
|
||||
surf
|
||||
(make-rect
|
||||
(floor i) 0
|
||||
(ceiling/ x (length plst))
|
||||
(- y-mid (abs (round/ (* y (car (list-ref plst j)))
|
||||
(/ 76800
|
||||
(if (= smoothing-mode moving-average)
|
||||
(/ i scale)
|
||||
scale))))))
|
||||
bgcolor)
|
||||
(let ((n (abs (round/ (* y (cadr (list-ref plst j)))
|
||||
(/ 76800
|
||||
(if (= smoothing-mode moving-average)
|
||||
(/ i scale)
|
||||
scale))))))
|
||||
(fill-rect
|
||||
surf
|
||||
(make-rect
|
||||
(floor i) (+ y-mid n)
|
||||
(ceiling/ x (length plst))
|
||||
(- y-mid n))
|
||||
bgcolor))))))
|
||||
(define texture (surface->texture ren surf))
|
||||
(render-copy ren texture)
|
||||
(present-renderer ren)
|
||||
(delete-texture! texture)
|
||||
(delete-surface! surf))
|
||||
|
||||
(define (smooth lst type)
|
||||
(define ret '())
|
||||
(define window 0)
|
||||
(cond
|
||||
((= type moving-average)
|
||||
(do ((i 1 (1+ i)))
|
||||
((>= i (- (length lst) moving-average-block-size)))
|
||||
(set! window 0)
|
||||
(do ((j 0 (1+ j)))
|
||||
((>= j moving-average-block-size))
|
||||
(set! window (+ window (list-ref lst (+ i j)))))
|
||||
(set! window (round/ window moving-average-block-size))
|
||||
(set! ret (append ret (list window))))))
|
||||
ret)
|
||||
|
||||
(define (lp ren fft?)
|
||||
(define read-future #f)
|
||||
(define sleep-future #f)
|
||||
(define plst '())
|
||||
(while (not (window-closed-event? (poll-event)))
|
||||
(set! sleep-future (future (usleep (round (* recip-fps 1000)))))
|
||||
(if (= (bytevector-length bv) sample-size)
|
||||
(begin
|
||||
(set! plst (chunk2 (bytevector->sint-list
|
||||
bv (native-endianness) 2)))
|
||||
(set! read-future (future (read-fifo fd)))
|
||||
(if fft?
|
||||
(if (not (equal? smoothing-mode #f))
|
||||
(draw ren
|
||||
(map list
|
||||
(smooth (s16vector->list
|
||||
(do-dft plan (map car plst)
|
||||
(length plst)))
|
||||
smoothing-mode)
|
||||
(smooth (s16vector->list
|
||||
(do-dft plan (map cadr plst)
|
||||
(length plst)))
|
||||
smoothing-mode)))
|
||||
(draw ren
|
||||
(map list
|
||||
(s16vector->list
|
||||
(do-dft plan (map car plst)
|
||||
(length plst)))
|
||||
(s16vector->list
|
||||
(do-dft plan (map cadr plst)
|
||||
(length plst))))))
|
||||
(draw ren plst))))
|
||||
(touch sleep-future)))
|
||||
|
||||
(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))
|
||||
|
||||
(lp renderer fft)
|
||||
|
||||
(delete-renderer! renderer)
|
||||
(close-window! window)
|
||||
(sdl-quit)
|
||||
(close-port fd)
|
||||
|
||||
(if fft (monitor (fftw_destroy_plan plan)))
|
|
@ -6,5 +6,5 @@
|
|||
(define bgcolor #x2e2016ff)
|
||||
(define queue-size 1)
|
||||
(define fft #f)
|
||||
(define smoothing #f)
|
||||
(define smoothing-factor 1.0)
|
||||
(define smoothing-mode 'moving-average)
|
||||
(define moving-average-block-size 25)
|
||||
|
|
31
yammer.scm
31
yammer.scm
|
@ -38,6 +38,7 @@
|
|||
#:use-module (yammer fftw))
|
||||
|
||||
(add-to-load-path ".")
|
||||
|
||||
(load "config.scm")
|
||||
(define recip-fps (/ 1 fps))
|
||||
(define sample-size (* 4 (round (* 3 (* (/ 44100 4) recip-fps)))))
|
||||
|
@ -90,7 +91,7 @@
|
|||
(delete-surface! init-surf)
|
||||
(fill-rect surf #nil color)
|
||||
(let ((y-mid (round/ y 2)))
|
||||
(do ((i 0 (+ i (/ x (length plst))))
|
||||
(do ((i 0 (+ i (* (/ x (length plst)) resolution)))
|
||||
(j 0 (1+ j)))
|
||||
((>= j (length plst)))
|
||||
(begin
|
||||
|
@ -98,7 +99,7 @@
|
|||
surf
|
||||
(make-rect
|
||||
(floor i) 0
|
||||
(ceiling/ x (length plst))
|
||||
(* (ceiling/ x (length plst)) resolution)
|
||||
(- y-mid (abs (round/ (* y (car (list-ref plst j)))
|
||||
(/ 76800 scale)))))
|
||||
bgcolor)
|
||||
|
@ -108,7 +109,7 @@
|
|||
surf
|
||||
(make-rect
|
||||
(floor i) (+ y-mid n)
|
||||
(ceiling/ x (length plst))
|
||||
(* (ceiling/ x (length plst)) resolution)
|
||||
(- y-mid n))
|
||||
bgcolor))))))
|
||||
(define texture (surface->texture ren surf))
|
||||
|
@ -117,8 +118,20 @@
|
|||
(delete-texture! texture)
|
||||
(delete-surface! surf))
|
||||
|
||||
(define (smooth lst)
|
||||
lst)
|
||||
(define (smooth lst type)
|
||||
(define ret '())
|
||||
(define window 0)
|
||||
(cond
|
||||
((eq? type 'moving-average)
|
||||
(do ((i 1 (1+ i)))
|
||||
((>= i (- (length lst) moving-average-block-size)))
|
||||
(set! window (list-ref lst (- i 1)))
|
||||
(do ((j 0 (1+ j)))
|
||||
((>= j moving-average-block-size))
|
||||
(set! window (+ window (list-ref lst (+ i j)))))
|
||||
(set! window (round/ window moving-average-block-size))
|
||||
(set! ret (append ret (list window))))))
|
||||
ret)
|
||||
|
||||
(define (lp ren fft?)
|
||||
(define read-future #f)
|
||||
|
@ -132,15 +145,17 @@
|
|||
bv (native-endianness) 2)))
|
||||
(set! read-future (future (read-fifo fd)))
|
||||
(if fft?
|
||||
(if smoothing
|
||||
(if (not (equal? smoothing-mode #f))
|
||||
(draw ren
|
||||
(map list
|
||||
(smooth (s16vector->list
|
||||
(do-dft plan (map car plst)
|
||||
(length plst))))
|
||||
(length plst)))
|
||||
smoothing-mode)
|
||||
(smooth (s16vector->list
|
||||
(do-dft plan (map cadr plst)
|
||||
(length plst))))))
|
||||
(length plst)))
|
||||
smoothing-mode)))
|
||||
(draw ren
|
||||
(map list
|
||||
(s16vector->list
|
||||
|
|
Loading…
Reference in New Issue