;; Setup TERMINAL (Mac)
;; stty -f /dev/dev/cu.usbmodem1401 9600 raw


(defparameter *arduino*
  (open "/dev/cu.usbmodem1401"
        :direction :output
        :if-exists :append
        :element-type '(unsigned-byte 8)))

;;Function
(defun send-byte (n)
          (uiop:run-program
           (format nil "printf '%b' \"\\x~2,'0X\" > /dev/cu.usbmodem1401"
                   n)))


;;Test
(loop repeat 20
        do (send-byte (random 100))
        do (sleep 1))

Here is a function I created (vibe coded) with NotebookLM/Gemini to create melodic countour of any sequence of pitches. It works with OMN expressions and also with chords. In the case of chords, you must count how many voices there is in the chords in order to create a countour. After processing (melodizing), the function puts the chords back to its place.

Best,

Julio

EXAMPLE

(setf contornos '((1 2 3) (3 1 2) (2 3 1) (1 3 2) (2 1 3) (3 2 1)))
(setf sequencia (gen-divide 3 (gen-repeat 10 '(q c4 e4 g4))))
(contour-mel-poly sequencia contornos)

ORIGINAL

(contour-mel-poly (gen-divide 4 (flatten sequencia)) '(0.5 0.49 2))
;; can be any number

(defun contour-mel-poly (omn-exp contornos)
  "Ordena alturas e acordes segundo um contorno melódico (ranking), 
   ajustando as oitavas para satisfazer a hierarquia do contorno."
  (let* ((dis (disassemble-omn omn-exp))
         (pitches (getf dis :pitch))
         (num-bars (length pitches))
         ;; 1. Alinha a lista de contornos ao número de compassos [2]
         (contorno-list (gen-trim num-bars (if (listp (car contornos)) contornos (list contornos)))))

    (labels ((apply-contour-logic (bar-ints contour)
               "Processa uma lista de inteiros (melodia/acordes) aplicando o contorno."
               (let* (;; A. Melodize: trata tudo como uma sequência linear de notas
                      (flat-ints (flatten bar-ints))
                      (pcs (mapcar (lambda (x) (mod x 12)) flat-ints))
                      (num-notes (length pcs))
                      ;; B. Cria mapeamento (PC, Rank-Alvo, Posição-Original)
                      (pos-rank-pairs (loop for pc in pcs 
                                            for rank in contour 
                                            for pos from 0
                                            collect (list :pc pc :rank rank :pos pos)))
                      ;; C. Ordena pelo ranking para definir as oitavas progressivamente
                      (sorted-by-rank (sort (copy-list pos-rank-pairs) #'< 
                                            :key (lambda (x) (getf x :rank))))
                      (last-val -999)
                      (final-pos-val-pairs nil))

                 ;; D. Atribuição de oitavas baseada no ranking
                 (dolist (item sorted-by-rank)
                   (let* ((pc (getf item :pc))
                          (pos (getf item :pos))
                          (oct 0)
                          (candidate (+ (* oct 12) pc)))
                     ;; Garante que Rank N > Rank N-1 (satisfaz posição aberta/fechada)
                     (while (<= candidate last-val)
                        do (setf oct (1+ oct))
                           (setf candidate (+ (* oct 12) pc)))
                     (setf last-val candidate)
                     (push (cons pos candidate) final-pos-val-pairs)))

                 ;; E. Restaura a ordem linear e reagrupa acordes se existiam
                 (let* ((linear-ints (loop for i from 0 below num-notes
                                           collect (cdr (assoc i final-pos-val-pairs))))
                        (idx 0))
                   (mapcar (lambda (evt)
                             (if (listp evt)
                                 (prog1 (loop repeat (length evt) collect (nth idx linear-ints) do (incf idx)) nil)
                                 (prog1 (nth idx linear-ints) (incf idx))))
                           bar-ints)))))

      ;; 2. Processamento por compasso
      (let ((processed-pitches
             (mapcar (lambda (bar contour)
                       (let* ((bar-ints (pitch-to-integer bar))
                              (new-ints (apply-contour-logic bar-ints contour)))
                         ;; Converte de volta para pitches OMN [4]
                         (integer-to-pitch new-ints)))
                     pitches contorno-list)))

        ;; 3. Remontagem OMN final preservando a estrutura original [5]
        (make-omn :pitch processed-pitches
                  :length (getf dis :length)
                  :velocity (getf dis :velocity)
                  :articulation (getf dis :articulation))))))

An useful function do make various pitch-demix operations at once.

(defun poly-demix (n-list mat-omn)

"Extrai as vozes especificadas em N-LIST de uma sequência OMN

e as combina em um único fluxo polifônico."

(let* (;; 1. Garante que n-list seja uma lista e extrai cada voz

(extracted-voices (mapcar #'(lambda (n)

(pitch-demix n mat-omn))

(list! n-list))))

;; 2. Aplica merge-voices sobre a lista de vozes extraídas

(apply #'merge-voices extracted-voices)))

(setf mat-omn '((e. g2bb3d4f4a4 mf s -e e c4c5c5 e. g2bb3c4d4f4 s g3g4g4 -s s g2bb3d4f4a4) (q bb2db4f4ab4c5 mf -e e bb3bb4bb4 e. eb4eb5eb5 s ab3ab4ab4 -s s bb2db4ab4c5eb5)))

(poly-demix '(1 2 5) mat-omn)

((e. g2f4a4 s -e c5 e. g2d4f4 s g4 - g2f4a4) (q bb2ab4c5 -e bb4 e. eb5 s ab4 - bb2c5eb5))

Best, Julio

(setf intervals  '(-2 -1 1 2 5 -5))


(setf seq
 (loop repeat 200
       with alist = (filter-repeat 1 (vector-to-pitch '(a3 g5) (gen-noise  300)))
       with cnt = 0 
         
       when (memberp (car (pitch-to-interval (list (nth cnt alist)
                                             (nth  (1+ cnt) alist))))
                     intervals)

         append (make-omn :pitch (list (nth cnt alist)
                                       (nth  (1+ cnt) alist))
                          :length '(1/16 1/16)
                          :velocity '(fff fff))
         and do (incf cnt 1)
         

       else append (make-omn :pitch (list (nth cnt alist))
                             :length '(1/16)
                             :velocity '(ppp))
         
       do (incf cnt)))


(omn-list-plot seq :join-points t)

is there a simple range function in Opusmodus (no vector) like this?:

(defun range (lis min max)
"
Range a list between min and max.
Ex.:
;; (range '(1 2 3 4 5) 1 2) => (1.0 1.25 1.5 1.75 2.0)
;; (range '(1 3 6 7) 1 2) => (1.0 1.3333334 1.8333334 2.0)
;; (range '(2 3 6 4 5 8 6 7) 2 3) => (2.0 2.1666667 2.6666667 2.3333333 2.5 3.0 2.6666667 2.8333333)
;; (range '(0.2 0.4 0.7 0.3 0.9) 0.3 1.2)
"
(let ((minlis (reduce #'min lis))
(maxlis (reduce #'max lis)))
(labels ((map-range (a1 a2 b1 b2 s)
(* 1.0 (+ b1
(/ (* (- s a1)
(- b2 b1))
(- a2 a1))))))
(loop for i in lis
collect (map-range minlis maxlis min max i)))))

Achim

Here are a version for a diatonic (or all purpose set-transpose) function that rounds material around a collection used as reference).

Please, Let me know if you find bugs.

Best,

Julio

(defun set-transpose (n omn-sequence sets &key (round 'up))

"Realiza transposição diatônica por N passos em coleções de referência.

Arredonda notas fora do set para cima ou para baixo conforme :round."

(let* ((dis (disassemble-omn omn-sequence))

(pitches (getf dis :pitch))

(num-bars (length pitches))

;; Alinha N e os Sets ao número de sublistas (compassos)

(n-list (gen-trim num-bars (if (listp n) n (list n))))

(set-list (gen-trim num-bars sets)))

(labels ((process-pitch (p val-n collection)

(let* ((p-int (pitch-to-integer p))

;; Normaliza a coleção para pitch-classes (0-11) ordenadas

(coll-pcs (sort (remove-duplicates

(mapcar (lambda (x) (mod x 12))

(flatten (pitch-to-integer collection))))

#'<))

(len-coll (length coll-pcs)))

(flet ((transpose-single (single-p)

(let* ((pc (mod single-p 12))

(oct (floor single-p 12))

;; 1. Arredondamento com info de oitava

(r-info (get-rounded-info pc coll-pcs round))

(rounded-pc (car r-info))

(r-oct-shift (cdr r-info))

;; 2. Localiza índice e aplica N passos diatônicos

(curr-idx (position rounded-pc coll-pcs))

(new-idx (+ curr-idx val-n))

;; 3. Calcula deslocamento de oitava final (wrap-around)

(final-oct-shift (+ r-oct-shift (floor new-idx len-coll)))

(final-pc (nth (mod new-idx len-coll) coll-pcs)))

;; 4. Reconstrói o pitch mantendo o registro original

(+ (* (+ oct final-oct-shift) 12) final-pc))))

;; Suporte para notas individuais ou acordes

(if (listp p-int)

(mapcar #'transpose-single p-int)

(transpose-single p-int)))))

(get-rounded-info (pc coll direction)

;; Retorna (rounded-pc . octave-shift)

(if (member pc coll)

(cons pc 0)

(case direction

(up (let ((higher (find pc coll :test #'<)))

(if higher

(cons higher 0)

(cons (first coll) 1)))) ;; Wrap up: vai p/ próx oitava

(down (let ((lower (find pc coll :from-end t :test #'>)))

(if lower

(cons lower 0)

(cons (car (last coll)) -1)))))))) ;; Wrap down: oitava anterior

;; Mapeamento bar-a-bar

(let ((new-pitches (mapcar (lambda (bar bar-n bar-set)

(mapcar (lambda (p) (process-pitch p bar-n bar-set)) bar))

pitches n-list set-list)))

;; Remontagem OMN final preservando os outros parâmetros

(make-omn :pitch (integer-to-pitch new-pitches)

:length (getf dis :length)

:velocity (getf dis :velocity)

:articulation (getf dis :articulation))))))

EXAMPLE

(setf temav1 '((e. a4 mf s -e c5 e. f4 s g4 - a4) (q c5 mf -e bb4 e. eb5 s ab4 - eb5) (q cs5 mf -e e5 e. as4 s b4 - cs5)))

(setf sets (expand-tonality '((ab4 major) (c4 major))))

(set-transpose -4 temav1 sets :round 'down)

((e. cs4 mf s -e f4 e. bb3 s c4 - cs4) (q f4 mf -e d4 e. g4 s c4 - g4) (q g4 mf -e gs4 e. eb4 s - g4))

(set-transpose -4 temav1 sets :round 'up)

((e. eb4 mf s -e f4 e. bb3 s c4 - eb4) (q f4 mf -e e4 e. a4 s d4 - a4) (q g4 mf -e bb4 e. eb4 s f4 - g4))

(setf sets (expand-tonality '((ab4 messiaen-mode2) (c4 major))))

(set-transpose -4 temav1 sets :round 'up)

when using vector-smooth my tendencies start around 0.1 but end >0.2 (should be around 0.1 as well)

How can I prevent that?

(setf tend-list
'(0.1 0.4 0.2 0.6 0.5 0.5 0.9 0.7 0.7 1 0.9 1.2 0.9 0.9 0.5 0.5 0.6 0.2 0.2 0.1))

(list-plot
(setf dur-mults
(loop for i in durlens
with seed = (init-seed 123)
collect
(vector-smooth 0.3
(gen-tendency i tend-list :variance 0.2))))
:zero-based t :join-points t)

Thanks for help, Achim

All previous rewrite functions used in conjunction for transformations.

Ciao !

https://opusmodus.com/forums/topic/4097-rewrite-len-function/#comment-14209

(setf expressao-omn '((s eb4 d4 e a4 -s s eb4) (h eb4 a4 -s eb4 d4 -s)

(e. d4 a4 eb4 d4)

(-q e f4 s c5 qs fs4)))

(rewrite-pit

(rewrite-dyn

(rewrite-len expressao-omn

'(h -e s q -h q -q s s s))

'(pp< ff mf fff p < < fff ppp fff mf fff p))

'(c4 g5))

https://opusmodus.com/forums/topic/4097-rewrite-len-function/#comment-14209

Function to rewrite lengths

BEst,

Julio

(defun rewrite-len (expressao-omn new-lengths-list)

"Substitui os comprimentos (lengths) de uma expressão OMN por uma lista fornecida,

repetindo-a ciclicamente e mantendo a estrutura de sublistas original."

(let* ((dis (disassemble-omn expressao-omn)) ;; Desmonta a expressão original [2]

(old-pit (getf dis :pitch)) ;; Extrai as alturas [4]

(old-vel (getf dis :velocity)) ;; Extrai as velocidades [4]

(old-art (getf dis :articulation)) ;; Extrai as articulações [4]

;; 1. Mapeia a estrutura original (quantidade de eventos por sublista)

;; Captura o número de elementos rítmicos em cada compasso [3, 5]

(structure (mapcar #'length (getf dis :length)))

(total-events (apply #'+ structure)) ;; Soma total de eventos [6]

;; 2. Gera a sequência rítmica cíclica com base no total de eventos

;; gen-trim estende a lista do usuário para preencher todos os espaços [3, 7]

(new-flat-lengths (gen-trim total-events new-lengths-list))

;; 3. Re-organiza os novos ritmos na estrutura de sublistas original [3, 8]

(new-structured-lengths (gen-divide structure new-flat-lengths)))

;; 4. Remonta o objeto OMN completo com os parâmetros preservados [3, 4]

(make-omn :pitch old-pit

:length new-structured-lengths

:velocity old-vel

:articulation old-art)))

;;USE

(setf expressao-omn '((s eb4 d4 e a4 -s s eb4) (h eb4 a4 -s eb4 d4 -s)

(e. d4 a4 eb4 d4)

(-q e f4 s c5 qs fs4)))

(omn-to-time-signature (rewrite-len expressao-omn '(h -e s q -h q -q s s s)) '(3 4))

;;RESULT

((h eb4 mf -e s d4 a4 tie) (e. a4 -h s eb4 mf tie) (e. eb4 mf -q s a4 eb4 d4 e eb4 tie) (q. eb4 -e s d4 mf e. a4 tie) (s a4 -h e. f4 mf tie) (s f4 mf -q s c5 fs4))

Here is one more function in the style of the previous one (rewrite-dyn). This time to rewrite pitches.

(defun rewrite-pit (expressao-omn pitch-list)

"Substitui as alturas de uma expressão OMN por uma lista customizada,

fazendo a repetição cíclica se a lista for menor que o número de notas."

(let* ((dis (disassemble-omn expressao-omn)) ;; Desmonta a expressão [3, 6]

(pitches (getf dis :pitch)) ;; Extrai alturas atuais

(lengths (getf dis :length)) ;; Extrai durações (inclui rests) [7]

(velocities (getf dis :velocity)) ;; Extrai dinâmicas [8]

(articulations (getf dis :articulation)) ;; Extrai articulações/ties [9, 10]

;; 1. Mapeia a quantidade de notas em cada sublista/compasso

(counts (mapcar #'length pitches)) ;; [2, 5]

;; 2. Calcula o total de eventos de nota para o preenchimento

(total-notes (apply #'+ (flatten counts))) ;; [2, 11]

;; 3. Gera a lista de novas alturas repetindo o padrão do usuário

(flat-pitches (gen-trim total-notes pitch-list)) ;; [2, 4]

;; 4. Redistribui as alturas na estrutura de sublistas original

(structured-pitches (gen-divide counts flat-pitches))) ;; [2, 5]

;; 5. Remonta o objeto OMN completo preservando os demais parâmetros

(make-omn :pitch structured-pitches

:length lengths

:velocity velocities

:articulation articulations))) ;; [2, 3]

;;USE

(setf expressao-omn '((s eb4 d4 e a4 -s s eb4 tie) (h eb4 a4 -s eb4 d4 -s tie)

(e. d4 a4 eb4 d4)

(-q e f4 s c5 qs fs4)))

Using both rewrite-dyn and rewrite-pit

(rewrite-pit expressao-omn '(c4 e4 d4 c4 c4))

(rewrite-dyn (rewrite-pit expressao-omn '(c4 e4 d4 c4 c4)) '(ff > p p< ff> pp ff p p< ff p mf ppp p < ff))

Best !!

Julio Herrlein

This is a very cool and easy to use function to rewrite dynamics.

Check it out. Hope you like it !

Best,

Julio

(defun rewrite-dyn (expressao-omn dynamic-list)

"Substitui as dinâmicas de uma expressão OMN por uma lista customizada,

fazendo a rotação cíclica se a lista for menor que o número de notas."

(let* ((dis (disassemble-omn expressao-omn)) ; [2, 3]

(pitches (getf dis :pitch))

(lengths (getf dis :length))

(articulations (getf dis :articulation))

;; 1. Mapeia a estrutura de cada sublista (quantidade de notas por compasso)

(counts (mapcar #'length pitches)) ; [6]

;; 2. Calcula o total de notas para gerar dinâmicas suficientes

(total-notes (apply #'+ (flatten counts))) ; [7]

;; 3. Cria a lista plana de dinâmicas repetindo o padrão do usuário [4]

(flat-vels (gen-trim total-notes dynamic-list))

;; 4. Redistribui as dinâmicas na estrutura de sublistas original [5]

(structured-vels (gen-divide counts flat-vels)))

;; 5. Remonta o objeto OMN completo com os novos parâmetros [3]

(make-omn :pitch pitches

:length lengths

:velocity structured-vels

:articulation articulations)))

;; USE

;; Exemplo 1: Dinâmicas simples

(setf expressao-omn '((s eb4 d4 e a4 -s s eb4 tie) (h eb4 a4 -s eb4 d4 -s tie)

(e. d4 a4 eb4 d4)

(-q e f4 s c5 qs fs4)))

(rewrite-dyn expressao-omn '(p mf ff))

;; >> ((s eb4 p d4 mf e a4 ff -s eb4 p tie) (h eb4 mf a4 ff -s eb4 p d4 mf - d4 ff tie) (e. d4 p a4 mf eb4 ff d4 p) (-q e f4 mf s c5 ff qs fs4 p))

;; Exemplo 2: Incluindo crescendos

(rewrite-dyn expressao-omn '(ff > p p< ff> pp ff p p< ff p mf ppp p < ff))

;; ((s eb4 ff d4 > e a4 p -s eb4 p< tie) (h eb4 ff> a4 pp -s eb4 ff d4 p - d4 p< tie) (e. d4 ff a4 p eb4 mf d4 ppp) (-q e f4 p s c5 < qs fs4 ff))

Sometime ago I was here searching for a function to displace rhtyhms by a length amount, not just like a list rotation.

Now I did this prototype. I think that this can be very useful, specially inside counterpoint dictums where patterns can be displaced ( I did not tried inside the counterpoint function but seems like it will work).

Hope it can be useful to you too.

All the best,

Julio

(defun shift-rhythm (rhythm shift-length &key span)

;"Moves rhythmic material by inserting a pause at the beginning.

;Use length-adjust to ensure the result fits within the span."

(let* ((rhy (flatten rhythm))

;;;; Ensures a linear list for processing

;; Adds the offset value as a negative pause at the beginning [5]

(with-offset (append (list (- (abs shift-length))) rhy))

;;Define the target span: either the requested one or the original rhythm.

(target-span (or span (get-span rhythm))))

;; The length-adjust function adjusts the total to the desired span [1].

;; With :position 'e (default), it removes or adds from the end of the list [6].

(length-adjust target-span with-offset :omn t :type 'r)))

;;; USE

;Exemplo 1: Span de 4/4 (1/1)

(setf ideia '(e c5 e d4 q f4 -h)) ;; Span original de 1/1

(shift-rhythm ideia 1/8 :span 3/4)

;; (-e e c5 d4 q f4 -e)

(shift-rhythm ideia 3/8 :span 5/4)

;; (-q. e c5 d4 q f4 -q.)

also with negative displacement

(setf ideia '(-h e c5 e d4 q f4 -h))

(shift-rhythm ideia -1/8 :span 7/4)

;;(-e -h e c5 d4 q f4 -h -e)

It could be perfected to deal with nested sublists and with different displacements for each sublist, like

(setf ideia '((-h e c5 e d4 q f4 -h)(-h e c5 e d4 q f4 -h.)(-h e c5 e d4 q f4 -q))

(shift-rhythm ideia '((-1/8) (2/16) (3/8)) :span 7/4)

etc

I did (with a little help of Notebooklm) this cool function whose function is to concatenate 2 diferent lists with sublists, merging the first sublist of the list A with the first sublist of list B, with the options
1) to choose how many elements of each list to use; and

2) the possibility of not only mix different numbers of elements in each list but also the possibility to select the starting element of the list to pick elements.

3) The function also consider each list as a rotating element: for example, if 5 elements are required from the list (1 2 3), starting in the first element, the result will be (1 2 3 1 2), if the start is on the second element, the result will be (2 3 1 2 3) and so on.

This is useful for me. Hope you like it.

Best,

Julio

(defun get-rotated-elements (lst start count)

"Extracts COUNT elements from LST starting at index START, wrapping around if needed."

(let ((len (length lst)))

(loop for i from 0 below count

collect (nth (mod (+ start i) len) lst))))

(defun merge-rotated-sublists (list-a list-b counts-a counts-b starts-a starts-b)

"Merges sublists from A and B based on specific counts and starting positions with rotation."

(mapcar #'(lambda (sub-a sub-b n m s-a s-b)

(append (get-rotated-elements sub-a s-a n)

(get-rotated-elements sub-b s-b m)))

list-a list-b counts-a counts-b starts-a starts-b))

Example of Usage

(setf list-a '((1 2 3 4) (a b c) (q w e r t)))

(setf list-b '((4 5 6 7) (d e f) (a s d f g)))

(merge-rotated-sublists list-a list-b '(2 1 5) '(1 5 3) '(0 2 2) '(0 0 1))

;; Result: ((1 2 4) (c d e f d e) (e r t q w s d f))

(merge-rotated-sublists list-a list-b '(2 7 1) '(4 3 7) '(0 0 0) '(1 1 0))

;((1 2 5 6 7 4) (a b c a b c a e f d) (q a s d f g a s))

Thanks a lot, Achim

((-w) (-w) (w cs6 <mp> -14c) (w c6 <mp> -31c) (w c6 <mp> -31c) (w c6 <mp> -31c) (w c6 <mp> -31c) (w c6 <mp> -31c) (w cs6 <mp> -49c) (w cs6 <mp> -49c) (w cs6 <mp> -49c) (w cs6 <mp> -49c) (w cs6 <mp> 5c) (w cs6 <mp> 5c) (w cs6 <mp> 5c) (w c6 <mp>) (w c6 <mp> 2c) (w c6 <mp> 2c) (w c6 <mp> 2c) (w c6 <mp> 2c) (w c6 <mp> 5c) (w c6 <mp> 5c) (w c6 <mp> 5c) (w a5 <mp> -31c) (w a5 <mp> -31c) (w a5 <mp> -31c) (w gs5 <mp> -14c))

(harmonics 'a2 8 :quantize nil :type :hertz)

I am getting

(110.0 220.0 329.62756 440.0 546.4174 659.2551 772.751 880.0)

but I am expecting

(110.0 220.0 330.0 440.0 550.0 660.0 770.0 880.0)

What am I understanding wrong?

Best, Achim

Achim

They have been algorithmically created in order to collect all the mathematically possible tonalities:

;; Complete Summary

;; ==============================================================

;; Ditonic‑note scales: 66

;; Tritonic‑note scales: 220

;; Tetratonic‑note scales: 495

;; Pentatonic‑note scales: 792

;; Hexatonic‑note scales: 924

;; Heptatonic‑note scales: 792

;; Octatonic‑note scales: 495

;; Nonatonic‑note scales: 220

;; Decatonic‑note scales: 66

;; Undecatonic‑note scales: 12

;; Total mathematical tonalities: 4082

Once executed, the tonalities are available in Opusmodus. Place the chosen (or both) lisp file(s) into your Extensions Folder.

Here are the starts of the two files:

(in-package :Opusmodus)

;;; ==============================================================

;;; Math‑Tonalities — Complete Output

;;; ==============================================================

;; ditonic‑note tonalities (66 total)

;; ---------------------------------------------------------------

;; Group 01 (starting on 0)

;; ----------------------------------------------

(create-tonality math-ditonic-01-001 '(0 1))

(create-tonality math-ditonic-01-002 '(0 2))

(create-tonality math-ditonic-01-003 '(0 3))

(create-tonality math-ditonic-01-004 '(0 4))

(create-tonality math-ditonic-01-005 '(0 5))

(create-tonality math-ditonic-01-006 '(0 6))

(create-tonality math-ditonic-01-007 '(0 7))

(create-tonality math-ditonic-01-008 '(0 8))

(create-tonality math-ditonic-01-009 '(0 9))

(create-tonality math-ditonic-01-010 '(0 10))

(create-tonality math-ditonic-01-011 '(0 11))

;; Group 02 (starting on 1)

;; ----------------------------------------------

(create-tonality math-ditonic-02-001 '(1 2))

(create-tonality math-ditonic-02-002 '(1 3))

(create-tonality math-ditonic-02-003 '(1 4))

(create-tonality math-ditonic-02-004 '(1 5))

(create-tonality math-ditonic-02-005 '(1 6))

......

(in-package :Opusmodus)

;;; ==============================================================

;;; Math‑Tonalities — Complete Output

;;; ==============================================================

;; Ditonic‑note tonalities (66 total)

;; ---------------------------------------------------------------

;; Group 01 (starting on 0)

;; ----------------------------------------------

(create-tonality math-02-tonic-01-001 '(0 1))

(create-tonality math-02-tonic-01-002 '(0 2))

(create-tonality math-02-tonic-01-003 '(0 3))

(create-tonality math-02-tonic-01-004 '(0 4))

(create-tonality math-02-tonic-01-005 '(0 5))

(create-tonality math-02-tonic-01-006 '(0 6))

(create-tonality math-02-tonic-01-007 '(0 7))

(create-tonality math-02-tonic-01-008 '(0 8))

(create-tonality math-02-tonic-01-009 '(0 9))

(create-tonality math-02-tonic-01-010 '(0 10))

(create-tonality math-02-tonic-01-011 '(0 11))

;; Group 02 (starting on 1)

;; ----------------------------------------------

(create-tonality math-02-tonic-02-001 '(1 2))

(create-tonality math-02-tonic-02-002 '(1 3))

(create-tonality math-02-tonic-02-003 '(1 4))

(create-tonality math-02-tonic-02-004 '(1 5))

(create-tonality math-02-tonic-02-005 '(1 6))

......Math-N-Tonic-Library-Creator.lisp

Math-Tonality-Library-Creator.lisp

With the audio tools in windows can we make some breakbeats, like chopping audio files, like beat slicing and starting in different parts of the audio file, like the video below (serato sample plugin), and also sync accurately with midi parts in Opusmodus ?

All the best !

Julio

SOME HISTORY

Here are some breakbeats (amen sample)

If possible, would be great to includ a sample of the amen beat inside the documentation with an example of breakbeat.

This function can also serve to launch samples of any nature for electroacoustic or mixed music.

Thank you for your help.

(setf accent '((q -q -q )

(e -e -e e -e -e)

(3q -3q -3q 3q -3q -3q 3q -3q -3q)

(s -s -s s -s -s s -s -s s -s -s)

(5q -5q -5q 5q -5q -5q 5q -5q -5q 5q -5q -5q 5q -5q -5q)

(6q -6q -6q 6q -6q -6q 6q -6q -6q 6q -6q -6q 6q -6q -6q 6q -6q -6q)

(7q -7q -7q 7q -7q -7q 7q -7q -7q 7q -7q -7q 7q -7q -7q 7q -7q -7q 7q -7q -7q)

(8q -8q -8q 8q -8q -8q 8q -8q -8q 8q -8q -8q 8q -8q -8q 8q -8q -8q 8q -8q -8q 8q -8q -8q)

(8q -8q -8q 8q -8q -8q 8q -8q -8q 8q -8q -8q 8q -8q -8q 8q -8q -8q 8q -8q -8q 8q -8q -8q)

(7q -7q -7q 7q -7q -7q 7q -7q -7q 7q -7q -7q 7q -7q -7q 7q -7q -7q 7q -7q -7q)

(6q -6q -6q 6q -6q -6q 6q -6q -6q 6q -6q -6q 6q -6q -6q 6q -6q -6q)

(5q -5q -5q 5q -5q -5q 5q -5q -5q 5q -5q -5q 5q -5q -5q)

(s -s -s s -s -s s -s -s s -s -s)

(3q -3q -3q 3q -3q -3q 3q -3q -3q)

(e -e -e e -e -e)

(q -q -q)))

(setf pitacc '(e4 ;(1 notes)

e4 fs4 ;(2 notes)

e4 fs4 g4 ;(3 notes)

e4 fs4 g4 fs4 ;( 4 notes)

e4 fs4 g4 fs4 g4 ;(5 notes)

e4 fs4 g4 fs4 g4 a4 ;(6 notes)

e4 fs4 g4 fs4 g4 a4 g4 ;(7 notes)

e4 fs4 g4 fs4 g4 a4 g4 a4 ;(8 notes)

e4 fs4 g4 fs4 g4 a4 g4 a4 ;(8 notes)

e4 fs4 g4 fs4 g4 a4 g4 ;(7 notes)

e4 fs4 g4 fs4 g4 a4 ;(6 notes)

e4 fs4 g4 fs4 g4 ;(5 notes)

e4 fs4 g4 fs4 ;( 4 notes)

e4 fs4 g4 ;(3 notes)

e4 fs4 ;(2 notes)

e4 ;(1 notes)

))

(setf exo3acc (omn-to-time-signature (make-omn

:length accent

:pitch pitacc)

'(3 4)))

same with def-score

(def-score kona-score

(:title "kona"

:key-signature 'atonal

:time-signature '(3 4)

:tempo 50)

(instrument

:omn exo3acc

:channel 1

:sound 'gm

:program 'acoustic-grand-piano))

I have following questions:

What is "the sine wave corresponding to each note"?

I cannot change the coefficient of higher harmonics since I have only one coefficient argument. What does that mean?

Where can I find the explanation of "coefficients used in music theory"?

Where can I find the "mathematical approach" explained?

Thanks for help.

Achim

Jesper

(defun inf-ser (n &optional (offset 0) &aux tmp)

(loop for i to (1- n) do

(setf tmp 0)

(loop for bin in (decimal-to-binary i)

do

(setf tmp (if (zerop bin) (- tmp) (+ tmp bin))))

;(format t "~B = ~D~%" i tmp)

collect (+ tmp offset)))

(integer-to-pitch (inf-ser 128))

(integer-to-pitch (inf-ser 128 12))

I´m doing a function to extract the complementary set of notes.

For example:

1) Specify a set of notes, like a chord, Dm7

(setf note-list '(d5 f5 a5 c6))

Specify a tonality, like Cmajor or D dorian (same notes)

(expand-tonality '(c5 major))

Now, I want a function that gives me all the other available notes from the mode, except the chord tones (the first set of notes).

So, this function gives me exactly what I need (for ONE tonality at a time and ONE chord at a time):

(let ((rem (expand-tonality '(c5 major)))
      (super (ambitus '(c5 b5) note-list)))
  (loop for i in super
    do (setf rem (remove i rem))
    finally (return rem)))

Ok, this give me the right result, I.E., the complementary set of notes of C major in relation to Dm7

=> (e5 g5 b5)

The question is simple:

How can I do it for a list with many tonalities and many chords. How to do this recursively in nested lists, like

(setf note-list '((d5 f5 a5 c6)(eb4 gb4 bb4 db4)(fs4 as4 cs4)))

to sucessive tonalities, like:

(expand-tonality '((c5 major) (db4 major) (gb4 major)))

Since this WON´T work

(let ((rem (ambitus '(c5 b5) (expand-tonality '((c5 major) (db5 major) (gb5 major)))))
      (super (ambitus '(c5 b5) '((d5 f5 a5 c6)(eb4 gb4 bb4 db4)(fs4 as4 cs4)))))
  (loop for i in super
    do (setf rem (remove i rem))
    finally (return rem)))

The expected result, if the above worked would be:

 ((e5 g5 b5)  (f5 ab5 c5) (gs4 cb5 ds5))

Thanks in advance !!

Best !

Julio

Here is a proto-function idea... If Janusz or someone are interested in transform it in a core function, I think it could be interesting...

Sometimes I like to take a motive or chorale texture and use it to make a kind of accompaniment or texture ala Reich.

I created my way to do it, but it could be perfected in a better function and integrated in the core system.

Here is the idea:

;; Motive

(setf mat '(h c4 q. d4 e e4 -q w c4 h d4 q e4 -q))

;; small value

(setf fig-value '(e))

The "proto-function". What I could not achieve was how to make it respect the rests in the motive, but it works for generating the texture, respecting the pitch and length boundaries of the motive.

(flatten (make-omn

:pitch (omn :pitch (omn-to-time-signature mat (get-time-signature (omn-to-measure (length-legato mat) (flatten (length-legato (omn :length mat)))))))

:length (omn-to-time-signature

(length-span (get-span mat)

(gen-repeat 200 fig-value))

(get-time-signature (omn-to-measure (length-legato mat) (flatten (length-legato (omn :length mat))))))

))

RESULT

(e c4 mf c4 c4 c4 e d4 mf d4 d4 e e4 mf e4 e4 e c4 mf c4 c4 c4 c4 c4 c4 c4 e d4 mf d4 d4 d4 e e4 mf e4 e4 e4)

It could be perfected to result this:

(e c4 mf c4 c4 c4 d4 d4 d4 e4 -q e c4 c4 c4 c4 c4 c4 e c4 c4 d4 mf d4 d4 d4 e4 e4 -q)

Same texture with the fig-value set do 16th note

(setf fig-value '(s))

Best wishes,

Julio

I found a function that is missing documentation: 2d-matrix->linearized-upper-trangular. Would you mind explaining this briefly? I hope to see the documentation added to the next update.

Thanks!

For the composers and musicians among you following might seem trivial, so this post is probably only relevant for beginners like me (except for the question at the end of the post)

But for me it's all new and exploring and discovering new concepts is fascinating.

OM helps me a lot as learning tool to conceptualize and reuse in a principled, reproducible manner.

In Jazz for piano comping, the use of rootless shell-voicings is common as far as I have learned.

I have learned in a text book (Jeremy Siskind, Jazz Band Pianist), that typically for chord comping

• the bass pitch is removed as it's already covered by the bass player, see a question on that to community at the end of this post.

• the left hand plays the "essential tones" of the chord, which are 3rd and 7th

• the right hand plays the "color tones" of the chord, which are the 5th and 9th.

I have learned that there 2 types of voicings

• Type A: left-hand: 3rd below 7th; right-hand: 9th below 5th

• Type B is flipped version, so left-hand: 7th below 3rd; right-hand: 5th below 9th.

Here's a screenshot of the book were both voicings are demonstrated for 3 chords.

Now I have tried to reproduce this with OM and want to share my findings in this post.

Turns out, that

• Type A: is accomplished with drop-voicing :type '(2) :leading '(l)

• Type B: is accomplished with drop-voicing :type '(2) :leading '(h)

• and in both cases then splitting the chord to both hands with (split-chord 13 <> :lower-size 2 :upper-size 2)

Here's the code to reproduce the text book example:

(asdf:load-system :arrows)


(setf chord '((w (e3 m9))   ; e3g3b3d4fs4
              (w (d3 9))    ; d3fs3a3c4e4
              (w (bb2 maj9)); bb2d3f3a3c4
              ))

; Type A voicing
(setf chord-voiced-a
      (arrows:-<>
       ; remove bass from 5 note chord
       (loop for n in (reverse '(1 2 3 4))
        collect (pitch-demix n chord))
       (matrix-transpose)
       (mapcar 'pitch-mix <>)
       ; restore original length
       (omn-replace :length (omn :length chord) <>)
       ; voice-leading type a
       (drop-voicing :type '(2) :leading '(l))
       ; distribute to both hands
       (split-chord 13 <> :lower-size 2 :upper-size 2)
       ))


; Type B voicing
(setf chord-voiced-b
      (arrows:-<>
       ; remove bass from 5 note chord
       (loop for n in (reverse '(1 2 3 4))
        collect (pitch-demix n chord))
       (matrix-transpose)
       (mapcar 'pitch-mix <>)
       ; restore original length
       (omn-replace :length (omn :length chord) <>)
       ; voice-leading type a
       (drop-voicing :type '(2) :leading '(h))
       ; distribute to both hands
       (split-chord 13 <> :lower-size 2 :upper-size 2)
       ))

(setf rh-a (assemble-voices 1 chord-voiced-a))
(setf lh-a (assemble-voices 2 chord-voiced-a))
(setf rh-b (assemble-voices 1 chord-voiced-b))
(setf lh-b (assemble-voices 2 chord-voiced-b))

(ps 'gm 
    :title "Type A"
    :p (list rh-a lh-a))

(ps 'gm 
    :title "Type B"
    :p (list rh-b lh-b))

Result:

Question to community:

Are there smarter ways to remove the root pitch in a omn-notation chord-sequence like the one I defined in variable chord (which just drops the lowest pitch while retaining the other omn parameters like length from original) ?

Thanks for any hints.