Make this a git repo

Signed-off-by: Skylar "The Cobra" Widulski <cobra@vern.cc>

.gitignore

@@ -0,0 +1,2 @@
+compile.sh
+libyammer.so

config.scm

@@ -0,0 +1,10 @@
+(define fifo-file "/tmp/mpd.fifo")
+(define fps 45)
+(define resolution 1)
+(define scale 1)
+(define color #xff99c8ff) ; rgba format (alpha must be 255)
+(define bgcolor #x2e2016ff)
+(define queue-size 1)
+(define fft #f)
+(define smoothing #f)
+(define smoothing-factor 1.01)

yammer.c

@@ -0,0 +1,61 @@
+/**
+ * Copyright (C) 2023 Skylar Widulski
+ *
+ * @file yammer.c
+ * @brief Discrete Fourier Transform wrapper
+ * @details Wrapper around FFTW's real-to-complex (r2c) discrete fourier
+ * transform
+ */
+
+#include "yammer.h"
+
+#include <stdlib.h>
+#include <math.h>
+
+#include <fftw3.h>
+
+/**
+ * @brief Initializes the FFTW plan
+ * @details This function initializes the FFTW plan for the DFT. It allocates
+ * memory for the input and output pointers, and creates the plan.
+ * @param vsize The size of the input pointer
+ * @return The FFTW plan
+ * @note The caller is responsible for freeing the plan
+ */
+fftw_plan init_plan(int vsize) {
+        double* in = fftw_malloc(sizeof(double) * vsize);
+        fftw_complex* out = fftw_malloc(sizeof(fftw_complex) * vsize);
+        fftw_plan p = fftw_plan_dft_r2c_1d(vsize, in, out, FFTW_ESTIMATE);
+        fftw_free(in);
+        fftw_free(out);
+        return p;
+}
+
+/**
+ * @brief Performs the DFT
+ * @details This function performs the DFT on the input pointer. It allocates
+ * memory for the output pointer, and then copies the result of the DFT into it.
+ * @param plan The FFTW plan
+ * @param ins The input pointer
+ * @param len The length of the input pointer
+ * @return The output pointer
+ * @note The caller is responsible for freeing the output pointer
+ */
+short int* do_dft(fftw_plan plan, short int* ins, int len) {
+        int result_len = len / 2 + 1;
+        double* in = fftw_malloc(sizeof(double) * len);
+        short int* outs = malloc(sizeof(short int) * result_len);
+        fftw_complex* out = fftw_malloc(sizeof(fftw_complex) * result_len);
+        for (int i = 0; i < len; i++) {
+                in[i] = (double)ins[i];
+        }
+        fftw_execute_dft_r2c(plan, in, out);
+        for (int i = 0; i < result_len; i++) {
+                outs[i] = (short int)sqrt(out[i][0] * out[i][0] +
+                                          out[i][1] * out[i][1]);
+                outs[i] *= (log2(2 + i) * (100.0 / result_len));
+        }
+        fftw_free(in);
+        fftw_free(out);
+        return outs;
+}

yammer.h

@@ -0,0 +1,16 @@
+/**
+ * Copyright (C) 2023 Skylar Widulski
+ *
+ * @file yammer.h
+ * @brief Headers for yammer.c
+ */
+
+#ifndef _YAMMER_H_
+#define _YAMMER_H_
+
+#include <fftw3.h>
+
+fftw_plan init_plan(int vsize);
+short int* do_dft(fftw_plan plan, short int* ins, int len);
+
+#endif  // _YAMMER_H_

yammer.scm

@@ -0,0 +1,135 @@
+(define-module (yammer)
+  #: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 ".")
+(load "config.scm")
+(define recip-fps (/ 1 fps))
+(define sample-size (* 3 (* 44100 recip-fps)))
+
+(define vsize (exact (/ sample-size 4)))
+
+(define plan #f)
+(if fft (monitor (set! plan (init_plan vsize))))
+(load "config.scm")
+(define recip-fps (/ 1 fps))
+(define sample-size (* 3 (* 44100 recip-fps)))
+
+(define window #f)
+(define win-id #f)
+(define renderer #f)
+(define bv (make-bytevector sample-size))
+(define queue (make-q))
+
+(define smoothing-weights '())
+
+(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 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)) (- 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)
+  (define ret lst)
+  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 smoothing
+                 (draw ren
+                       (map list
+                            (smooth (s16vector->list (do-dft plan (map car  plst) (length plst))))
+                            (smooth (s16vector->list (do-dft plan (map cadr plst) (length plst))))))
+                 (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))
+(display fd)
+(newline)
+
+(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)))

yammer/fftw.scm

@@ -0,0 +1,37 @@
+(define-module (yammer fftw)
+  #:use-module (system foreign)
+  #:export (FFTW_ESTIMATE
+            fftw_plan_dft_r2c_1d
+            fftw_destroy_plan ;))
+            init_plan
+            do-dft))
+
+(define fftw (dynamic-link "libfftw3"))
+
+(define FFTW_ESTIMATE 48)
+
+(define fftw_plan_dft_r2c_1d
+  (pointer->procedure '*
+                      (dynamic-func "fftw_plan_dft_r2c_1d" fftw)
+                      (list int '* '* unsigned-int)))
+
+(define fftw_destroy_plan
+  (pointer->procedure void
+                      (dynamic-func "fftw_destroy_plan" fftw)
+                      (list '*)))
+
+(define libyammer (dynamic-link "libyammer"))
+
+(define do_dft
+  (pointer->procedure '*
+                      (dynamic-func "do_dft" libyammer)
+                      (list '* '* int)))
+
+(define init_plan
+  (pointer->procedure '*
+                      (dynamic-func "init_plan" libyammer)
+                      (list int)))
+
+(define (do-dft plan lst len)
+  (define out (do_dft plan (bytevector->pointer (list->s16vector lst)) len))
+  (pointer->bytevector out (floor/ len 2) (sizeof short) 's16))