(in-package cl-user) ; too lazy to make own package
;;;; This is a trivial/well-known sndfile usage with 10-20 lines of lisp
;;;; added to it.
;;;; I don't rewrite this boilerplate unless I want to change something.
(ffi:clines "
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sndfile.h>
#define SAMPLE_RATE 44100
#define AMP_NORM 0x7F000000
")
;;; I create C function pointers that
;;; call a lisp function for either channel
;;; they rely on hypothetical definitions
;;; of #'left-fun and #'right-fun
;;; I did this quickly, okay
(defvar *left-fun
(ffi:defcallback left-fun-c :float ((timef :float))
(left-fun timef)))
(defvar *right-fun
(ffi:defcallback right-fun-c :float ((timef :float))
(right-fun timef)))
(defun make-horrible-wav (path seconds) "
Makes a PCM_24 WAV. A WAV file has a header that describes what it describes.
"
(ffi:with-cstring (cpath path)
(ffi:c-inline (cpath seconds *left-fun *right-fun)
(:cstring :float :pointer-void :pointer-void) nil
"
float my_seconds = #1;
float (* lefty)(float) = (float (*)(float))#2;
float (* righty)(float) = (float (*)(float))#3;
float my_amp_max = 1.0 * AMP_NORM;
int my_sample_count = (int)(my_seconds * SAMPLE_RATE);
SNDFILE *file;
SF_INFO sfinfo;
int k;
int *buffer;
if (! (buffer = malloc(2 * my_sample_count * sizeof(int)))) {
printf(\"Error : Malloc failed.\n\");
return;
}
memset(&sfinfo, 0, sizeof(sfinfo));
sfinfo.samplerate = SAMPLE_RATE;
sfinfo.frames = my_sample_count;
sfinfo.channels = 2;
sfinfo.format = (SF_FORMAT_WAV | SF_FORMAT_PCM_24);
if (! (file = sf_open (#0, SFM_WRITE, &sfinfo))) {
printf(\"Error: Not able to open output file.\\n\");
free(buffer);
return;
}
for (k=0; k<my_sample_count; k++) {
buffer[2*k] = my_amp_max*lefty(k/(1.0*SAMPLE_RATE));
buffer[2*k+1] = my_amp_max*righty(k/(1.0*SAMPLE_RATE));
}
if (sf_write_int (file, buffer, sfinfo.channels * my_sample_count) !=
sfinfo.channels * my_sample_count)
puts(sf_strerror(file));
sf_close(file);
free(buffer);
")))
(defun make-sine (freq &optional (amp 1.0))
(lambda (x) (* amp (sin (* 2 pi x freq)))))
(defun my-get-note (name length)
"
The parent is asked to cat the audio to openbsd sndio/snd/0.
This allows a different operating system to
change how it accesses the audio device.
*changed to use mpv music player
"
(let ((note-path (format nil "notes/~a.wav" name)))
(unless (probe-file note-path)
(make-horrible-wav note-path length))
(values (lambda ()
(ext:system
(format nil "mpv --no-terminal ~a 2>&1 > /dev/null"
note-path))))))
;;;; I hand-transcribed this because the computer I am using doesn't talk to
;;;; that computer normally. Errors mine.
(defun note (f1 f2 dur &optional (mod 0.1d0)) "
(setq *note* (note left-frequency right-frequency duration loudness))
(setq *note* (note 440 660 1.7 0.15))
(funcall *note*)
;; Stores the note in ./notes/ which should be cleaned out manually.
"
(defun left-fun (float) (* mod (apply (make-sine f1) `(,float))))
(defun right-fun (float) (* mod (apply (make-sine f2) `(,float))))
(my-get-note (format nil "~a-~a-~a-~a" f1 f2 dur mod) dur))
(defun synote (dur frq mod) "
args are closures but like note
"
(flet ((fun1 (float) (* (funcall mod)
(apply (make-sine (funcall frq))
`(,float)))))
(defun left-fun (float) (fun1 float))
(defun right-fun (float) (left-fun float))
(my-get-note (format nil "~a" (gensym)) (funcall dur))))
Response:
text/plain