SMOLNET PORTAL home about changes
(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
Original URLgopher://gopher.club/0/users/screwtape/boilerplate.ecl
Content-Typetext/plain; charset=utf-8