(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 #include #include #include #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&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))))