changelog shortlog graph tags branches changeset file revisions annotate raw help

Mercurial > core / lisp/lib/obj/music/music.lisp

revision 690: 90417ae14b21
parent 689: 2e7d93b892a5
child 691: 295ea43ceb2d
     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-