1.1--- a/lisp/lib/obj/music/music.lisp Tue Oct 01 22:29:08 2024 -0400
1.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
1.3@@ -1,266 +0,0 @@
1.4-;;; music.lisp --- Musical Lisp Systems
1.5-;; inspired by CLM (Stanford CCRMA)
1.6-;;
1.7-;; see also: http://www.titanmusic.com/papers/public/mips20010910.pdf
1.8-;;
1.9-;; refs: https://openmusictheory.github.io/
1.10-;; https://mlochbaum.github.io/BQN-Musician/index.html
1.11-
1.12-;;; Code:
1.13-(in-package :obj/music)
1.14-
1.15-;;; unicode char support
1.16-(defvar *flat-char* #\MUSIC_FLAT_SIGN) ;; ♭
1.17-(defvar *sharp-char* #\MUSIC_SHARP_SIGN) ;; ♯
1.18-(defvar *natural-char* #\MUSIC_NATURAL_SIGN) ;; ♮
1.19-
1.20-;;; amp/db/adb
1.21-(defmacro db-to-amp (db)
1.22- `(expt 10 (/ ,db 20)))
1.23-
1.24-(defmacro amp-to-db (amp)
1.25- `(* 20 (log ,amp 10)))
1.26-
1.27-(defmacro vol-to-amp (v &key (max 1000))
1.28- (let ((vol (gensym)))
1.29- `(let ((,vol ,v))
1.30- (if (<= ,vol 0) 0 (db-to-amp (* -10 (log (/ ,max ,vol) 2)))))))
1.31-
1.32-;; the 96.3296 figure for max is from track-rms.ins
1.33-(defmacro adb-to-amp (adb &key (max 96.3296))
1.34- (let ((db (gensym)))
1.35- `(let ((,db ,adb))
1.36- (if (<= ,db 0.0) 0.0 (db-to-amp (- (abs ,db) ,max))))))
1.37-
1.38-(defmacro amp-to-adb (amp &key (max 96.3296))
1.39- `(if (<= ,amp .00001526) 0.0 (+ ,max (amp-to-db ,amp))))
1.40-
1.41-;;; Tones
1.42-
1.43-;; reading more on this, tones can be simple or complex. Here we deal
1.44-;; with simple tones. A 'pitch' on the other hand, is the perceived
1.45-;; representation of a tone or complex tones. Multiple sets of tones
1.46-;; can share the same 'pitch'.
1.47-
1.48-;; In CLM, pitches are based on C0, compared to A4
1.49-;; which is the norm. I think it makes quite a bit of sense from a
1.50-;; technical standpoint, but with notes that low it becomes very
1.51-;; difficult to hear the differences between tunings.
1.52-
1.53-;; This is Lisp after all though, so the correct implementation should
1.54-;; support tuning by ear based on any note in the *PITCH-TABLE*.
1.55-
1.56-;; Ideally we get smart with it.
1.57-;; NOTE: chroma,morph,chromamorph,genus equivalence across oct
1.58-
1.59-(defvar *c0-default* 16.35160)
1.60-
1.61-;;; Ideally pitch-sets are vectors with a lookup table for
1.62-;;; strings/symbols
1.63-(eval-always
1.64- (defvar *pitch-table* (make-hash-table :test #'equal)))
1.65-
1.66-;; (defmacro define-pitch (name octave interval &key (table *pitch-table*) (c0 *c0-default*))
1.67-;; ;; TODO
1.68-;; ;; (declare (ignore idx))
1.69-;; `(let ((pitch (* ,c0 (expt 2.0 (+ ,octave (/ ,interval 12.0))))))
1.70-;; (setf (gethash ,(symbol-name name) ,table) pitch)))
1.71-
1.72-;; (define-pitch c0 0 0)
1.73-;; (define-pitch cs0 0 1)
1.74-;; (define-pitch df0 0 1)
1.75-;; (define-pitch d0 0 2)
1.76-;; (define-pitch ds0 0 3)
1.77-;; (define-pitch ef0 0 3)
1.78-;; (define-pitch e0 0 4)
1.79-;; (define-pitch ff0 0 4)
1.80-;; (define-pitch f0 0 5)
1.81-;; (define-pitch es0 0 5)
1.82-;; (define-pitch fs0 0 6)
1.83-;; (define-pitch gf0 0 6)
1.84-;; (define-pitch g0 0 7)
1.85-;; (define-pitch gs0 0 8)
1.86-;; (define-pitch af0 0 8)
1.87-;; (define-pitch a0 0 9)
1.88-;; (define-pitch as0 0 10)
1.89-;; (define-pitch bf0 0 10)
1.90-;; (define-pitch b0 0 11)
1.91-;; (define-pitch cf0 0 -1)
1.92-;; (define-pitch bs0 0 12)
1.93-
1.94-;; (define-pitch c1 1 0)
1.95-;; (define-pitch cs1 1 1)
1.96-;; (define-pitch df1 1 1)
1.97-;; (define-pitch d1 1 2)
1.98-;; (define-pitch ds1 1 3)
1.99-;; (define-pitch ef1 1 3)
1.100-;; (define-pitch e1 1 4)
1.101-;; (define-pitch ff1 1 4)
1.102-;; (define-pitch f1 1 5)
1.103-;; (define-pitch es1 1 5)
1.104-;; (define-pitch fs1 1 6)
1.105-;; (define-pitch gf1 1 6)
1.106-;; (define-pitch g1 1 7)
1.107-;; (define-pitch gs1 1 8)
1.108-;; (define-pitch af1 1 8)
1.109-;; (define-pitch a1 1 9)
1.110-;; (define-pitch as1 1 10)
1.111-;; (define-pitch bf1 1 10)
1.112-;; (define-pitch b1 1 11)
1.113-;; (define-pitch cf1 1 -1)
1.114-;; (define-pitch bs1 1 12)
1.115-
1.116-;; (define-pitch c2 2 0)
1.117-;; (define-pitch cs2 2 1)
1.118-;; (define-pitch df2 2 1)
1.119-;; (define-pitch d2 2 2)
1.120-;; (define-pitch ds2 2 3)
1.121-;; (define-pitch ef2 2 3)
1.122-;; (define-pitch e2 2 4)
1.123-;; (define-pitch ff2 2 4)
1.124-;; (define-pitch f2 2 5)
1.125-;; (define-pitch es2 2 5)
1.126-;; (define-pitch fs2 2 6)
1.127-;; (define-pitch gf2 2 6)
1.128-;; (define-pitch g2 2 7)
1.129-;; (define-pitch gs2 2 8)
1.130-;; (define-pitch af2 2 8)
1.131-;; (define-pitch a2 2 9)
1.132-;; (define-pitch as2 2 10)
1.133-;; (define-pitch bf2 2 10)
1.134-;; (define-pitch b2 2 11)
1.135-;; (define-pitch cf2 2 -1)
1.136-;; (define-pitch bs2 2 12)
1.137-
1.138-;; (define-pitch c3 3 0)
1.139-;; (define-pitch cs3 3 1)
1.140-;; (define-pitch df3 3 1)
1.141-;; (define-pitch d3 3 2)
1.142-;; (define-pitch ds3 3 3)
1.143-;; (define-pitch ef3 3 3)
1.144-;; (define-pitch e3 3 4)
1.145-;; (define-pitch ff3 3 4)
1.146-;; (define-pitch f3 3 5)
1.147-;; (define-pitch es3 3 5)
1.148-;; (define-pitch fs3 3 6)
1.149-;; (define-pitch gf3 3 6)
1.150-;; (define-pitch g3 3 7)
1.151-;; (define-pitch gs3 3 8)
1.152-;; (define-pitch af3 3 8)
1.153-;; (define-pitch a3 3 9)
1.154-;; (define-pitch as3 3 10)
1.155-;; (define-pitch bf3 3 10)
1.156-;; (define-pitch b3 3 11)
1.157-;; (define-pitch cf3 3 -1)
1.158-;; (define-pitch bs3 3 12)
1.159-
1.160-;; (define-pitch c4 4 0)
1.161-;; (define-pitch cs4 4 1)
1.162-;; (define-pitch df4 4 1)
1.163-;; (define-pitch d4 4 2)
1.164-;; (define-pitch ds4 4 3)
1.165-;; (define-pitch ef4 4 3)
1.166-;; (define-pitch e4 4 4)
1.167-;; (define-pitch ff4 4 4)
1.168-;; (define-pitch f4 4 5)
1.169-;; (define-pitch es4 4 5)
1.170-;; (define-pitch fs4 4 6)
1.171-;; (define-pitch gf4 4 6)
1.172-;; (define-pitch g4 4 7)
1.173-;; (define-pitch gs4 4 8)
1.174-;; (define-pitch af4 4 8)
1.175-;; (define-pitch a4 4 9)
1.176-;; (define-pitch as4 4 10)
1.177-;; (define-pitch bf4 4 10)
1.178-;; (define-pitch b4 4 11)
1.179-;; (define-pitch cf4 4 -1)
1.180-;; (define-pitch bs4 4 12)
1.181-
1.182-;; (define-pitch c5 5 0)
1.183-;; (define-pitch cs5 5 1)
1.184-;; (define-pitch df5 5 1)
1.185-;; (define-pitch d5 5 2)
1.186-;; (define-pitch ds5 5 3)
1.187-;; (define-pitch ef5 5 3)
1.188-;; (define-pitch e5 5 4)
1.189-;; (define-pitch ff5 5 4)
1.190-;; (define-pitch f5 5 5)
1.191-;; (define-pitch es5 5 5)
1.192-;; (define-pitch fs5 5 6)
1.193-;; (define-pitch gf5 5 6)
1.194-;; (define-pitch g5 5 7)
1.195-;; (define-pitch gs5 5 8)
1.196-;; (define-pitch af5 5 8)
1.197-;; (define-pitch a5 5 9)
1.198-;; (define-pitch as5 5 10)
1.199-;; (define-pitch bf5 5 10)
1.200-;; (define-pitch b5 5 11)
1.201-;; (define-pitch cf5 5 -1)
1.202-;; (define-pitch bs5 5 12)
1.203-
1.204-;; (define-pitch c6 6 0)
1.205-;; (define-pitch cs6 6 1)
1.206-;; (define-pitch df6 6 1)
1.207-;; (define-pitch d6 6 2)
1.208-;; (define-pitch ds6 6 3)
1.209-;; (define-pitch ef6 6 3)
1.210-;; (define-pitch e6 6 4)
1.211-;; (define-pitch ff6 6 4)
1.212-;; (define-pitch f6 6 5)
1.213-;; (define-pitch es6 6 5)
1.214-;; (define-pitch fs6 6 6)
1.215-;; (define-pitch gf6 6 6)
1.216-;; (define-pitch g6 6 7)
1.217-;; (define-pitch gs6 6 8)
1.218-;; (define-pitch af6 6 8)
1.219-;; (define-pitch a6 6 9)
1.220-;; (define-pitch as6 6 10)
1.221-;; (define-pitch bf6 6 10)
1.222-;; (define-pitch b6 6 11)
1.223-;; (define-pitch cf6 6 -1)
1.224-;; (define-pitch bs6 6 12)
1.225-
1.226-;; (define-pitch c7 7 0)
1.227-;; (define-pitch cs7 7 1)
1.228-;; (define-pitch df7 7 1)
1.229-;; (define-pitch d7 7 2)
1.230-;; (define-pitch ds7 7 3)
1.231-;; (define-pitch ef7 7 3)
1.232-;; (define-pitch e7 7 4)
1.233-;; (define-pitch ff7 7 4)
1.234-;; (define-pitch f7 7 5)
1.235-;; (define-pitch es7 7 5)
1.236-;; (define-pitch fs7 7 6)
1.237-;; (define-pitch gf7 7 6)
1.238-;; (define-pitch g7 7 7)
1.239-;; (define-pitch gs7 7 8)
1.240-;; (define-pitch af7 7 8)
1.241-;; (define-pitch a7 7 9)
1.242-;; (define-pitch as7 7 10)
1.243-;; (define-pitch bf7 7 10)
1.244-;; (define-pitch b7 7 11)
1.245-;; (define-pitch cf7 7 -1)
1.246-;; (define-pitch bs7 7 12)
1.247-
1.248-;; (define-pitch c8 8 0)
1.249-;; (define-pitch cs8 8 1)
1.250-;; (define-pitch df8 8 1)
1.251-;; (define-pitch d8 8 2)
1.252-;; (define-pitch ds8 8 3)
1.253-;; (define-pitch ef8 8 3)
1.254-;; (define-pitch e8 8 4)
1.255-;; (define-pitch ff8 8 4)
1.256-;; (define-pitch f8 8 5)
1.257-;; (define-pitch es8 8 5)
1.258-;; (define-pitch fs8 8 6)
1.259-;; (define-pitch gf8 8 6)
1.260-;; (define-pitch g8 8 7)
1.261-;; (define-pitch gs8 8 8)
1.262-;; (define-pitch af8 8 8)
1.263-;; (define-pitch a8 8 9)
1.264-;; (define-pitch as8 8 10)
1.265-;; (define-pitch bf8 8 10)
1.266-;; (define-pitch b8 8 11)
1.267-;; (define-pitch cf8 8 -1)
1.268-;; (define-pitch bs8 8 12)
1.269-