Scales and Guitar

scales.lisp

(defvar *notes*
  '("C" "Db" "D" "Eb" "E" "F" "Gb" "G" "Ab" "A" "Bb" "B"))
;;   0    1   2   3    4   5   6    7   8    9   10  11

(defvar *intervals*
  '("R" "2b" "2" "3b" "3" "4" "5b" "5" "5#" "6" "7b" "7"))

(defvar *scales*)
(setf *scales*
      '(;; MAJOR SCALES
	:major          (:w :w :h :w :w :w :h)
	:harmonic-major (:w :w :h :w :h :b3 :h)
	:augmented      (:b3 :h :b3 :h :b3 :h)
	:blues-major    (:b3 :w :h :h :b3 :w)
	
	;; DOMINANT 7TH SCALES
	:dominant-7th   (:w :w :h :w :w :h :w])	
        :blues-scale    (:b3 :w :h :h :b3 :w)
	:pentatonic-maj (:w :w :b3 :w :b3)
	
	;; MINOR SCALES
	:dorian         (:w :h :w :w :w :h :w)
	:melodic-minor  (:w :h :w :w :w :w :h)
	:pentatonic-min (:b3 :w :w :b3 :w)
	:harmonic-minor (:w :h :w :w :h :b3 :h)
	:pure-minor     (:w :h :w :w :h :w :w)

	;; HALF DIMINISHED SCALES
	:half-dim       (:h :w :w :h :w :w :w)
	
	;; DIMINISHED SCALES
	:diminished     (:w :h :w :h :w :h :w :h)
	))

(defun get-note-with-wrap (n &optional (notes *notes*))
  "get the n-th note (0 indexed) with wrapping"
  (elt notes (mod n (length notes))))

(defun get-note (n)
  (get-note-with-wrap n *notes*))

(defun get-interval (n)
  (get-note-with-wrap n *intervals*))

(defun clamp (n lst)
  (mapcar (lambda (x) (mod x n)) lst))

(defun map-intervals (scale)
  (let ((iv '(:h 1 :w 2 :b3 3)))
    (mapcar #'(lambda (i)
		(getf iv i))
	    (getf *scales* scale))))

(defun intervals-to-values (xs &optional (acc 0) (lst (list acc)))
  "convert list of intervals, represented as a list of numbers
defining distance between consequtive notes in the scale in semitones,
to a list of values representing actual notes in the scale represented
by number of semitones from the root"
  (cond
    ((car xs)
     (let ((new-acc (+ acc (car xs))))
       (intervals-to-values (cdr xs)
		 new-acc
		 (cons new-acc lst))))
    (t (reverse lst))))

;; guitar tunning : e - 4; B - 11; G - 7; D - 2; A - 9; E - 4
;; intervals      : 5, 5, 5, 4, 5
(defun map-to-string (snote scale &optional (start 0) (end 24))
  "map scale to notes on the string"
  (let* ((scale-notes
	   (clamp (length *notes*)
		  (intervals-to-values (map-intervals scale))))
	 (idx (+ snote start))
	 (res snote))
    (list scale-notes idx res (list start end))))

;; example (do..) for list reversing
(defun list-reverse (list)
  (do ((x list (cdr x))
       (y '() (cons (car x) y)))
      ((endp x) y)))

;; MISSING 0 VALUE. COULD BE EASILY SOLVED BY ADDING (CONS 0 RESULT)
(defun intervals-to-values-gpt4-v1 (intervals)
  (let ((prev 0))
    (mapcar (lambda (x) (incf prev x)) intervals)))

;; GPT4 VERSION FIXED BY ADDING (CONS 0 ...)
(defun intervals-to-values-gpt4-v1-fixed (intervals &optional (start 0))
  (let* ((prev start)
	 (res (mapcar (lambda (x) (incf prev x)) intervals)))
    (cons start res)))

;; NEED TO ADD (REVERSE ...)
(defun intervals-to-values-gpt4-v2 (intervals)
  (let ((prev 0)
        (result (list 0)))	   ; initialize the result list with 0
    (dolist (x intervals result)   ; iterate over intervals
      (push (incf prev x) result))))  ; increment prev by x and push it to the result list

(defun -get-scale (scale get-fn start)
  (mapcar get-fn (intervals-to-values (map-intervals scale) start)))

(defun get-scale-notes (scale &optional (start 0))
  (-get-scale scale #'get-note start))

(defun get-scale-intervals (scale)
  (-get-scale scale #'get-interval 0))

;; (get-scale-notes :dorian)      :dorian -> ("C" "D" "D#" "F" "G" "A" "A#" "C")
;; (get-scale-intervals :dorian)  :dorian -> ("R" "2" "3b" "4" "5" "6" "7b" "R")

;; EXAMPLE TAB
;; e||-  -|-  -|-  -|-  -|-  -|
;; B||-  -|-  -|-  -|-  -|-  -|
;; G||-  -|-  -|-  -|-  -|-  -|
;; D||-  -|-  -|-  -|-  -|-  -|
;; A||-b3-|- 5-|-b7-|-#9-|-b7-|
;; E||- R-|- 2-|- 5-|- 6-|- 7-|

;; TEXT TAB REPRESENTATION
;; "[1:5,-,3:7,-,3:5,-,3:7,-,-,3:5,3:7,-,1:8,-,1:5]"

;;     e||---------------|---------------||
;;     B||---------------|---------------||
;;     G||---------------|---------------||
;;     D||--7-5-7--57----|--7-5-7--57----||
;;     A||---------------|---------------||
;;     E||5-----------8-5|5-----------8-5||

;; "[-,-,1:3|2:2|3:0|4:0|5:3|6:3,-,-][-,-,3:0|4:2|5:3|6:2,-,-]"

;;    e||--3--|--2--||
;;    B||--3--|--3--||
;;    G||--0--|--2--||
;;    D||--0--|--0--||
;;    A||--2--|-----||
;;    E||--3--|-----||