I would like to share a small utility function I recently developed for Opusmodus that may be useful for people working with long-form generative or multi-section compositions.

The idea is very simple:

The function automatically captures the output of pprint-last-score, creates a file if necessary, and appends the generated def-score into that file while allowing automatic or manual section naming.

For example:

(save-current-section

:file "/Users/stephaneboussuge/Opusmodus/Scores/my-piece.lisp")

Automatically generates:

(def-score section001 ...)

(def-score section002 ...)

(def-score section003 ...)

Or with a custom name:

(save-current-section

:file "/Users/stephaneboussuge/Opusmodus/Scores/my-piece.lisp"

:name 'coda)

One particularly useful aspect is the possibility to store metadata alongside each section:

(save-current-section

:file "/Users/stephaneboussuge/Opusmodus/Scores/my-piece.lisp"

:metadata `((:seed ,*gseed*)

(:tempo 72)

(:mode octatonic)

(:algorithm score212)))

This allows the score file to become not only a collection of sections, but also a compositional archive containing informations on each section.

I have found this especially useful for:

• large algorithmic works,

• iterative composition,

• and building long-form modular pieces.

The function automatically:

• creates the file if needed,

• appends new sections without overwriting,

• detects the next available section number,

• renames the internal def-score,

• and optionally stores metadata comments.

I am sharing the full code below in case it may be useful to others.

(in-package :opusmodus)

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

;;; CAPTURE DU DERNIER SCORE

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

(defun capture-pprint-last-score ()

"Capture le texte produit par pprint-last-score sans la ligne pprint-last-score."

(let* ((txt (with-output-to-string (*standard-output*)

(pprint-last-score)))

(pos (search "(def-score" txt :test #'char-equal)))

(unless pos

(error "Aucun (def-score ...) trouvé dans pprint-last-score."))

(subseq txt pos)))

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

;;; REMPLACEMENT DU NOM DU DEF-SCORE

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

(defun replace-def-score-name (score-string new-name)

"Remplace le nom du premier def-score par NEW-NAME."

(let* ((new-name-string (string-downcase (string new-name)))

(pos (search "(def-score" score-string :test #'char-equal)))

(unless pos

(error "Aucun (def-score ...) trouvé dans le texte capturé."))

(let* ((start (+ pos (length "(def-score")))

(after-space

(position-if-not

#'(lambda (c)

(member c '(#\Space #\Tab #\Newline)))

score-string

:start start))

(end-name

(position-if

#'(lambda (c)

(member c '(#\Space #\Tab #\Newline #\()))

score-string

:start after-space)))

(concatenate 'string

(subseq score-string 0 after-space)

new-name-string

(subseq score-string end-name)))))

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

;;; UTILITAIRES

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

(defun read-file-as-string (file)

"Lit FILE sous forme de string. Renvoie une string vide si le fichier n'existe pas."

(if (probe-file file)

(with-open-file (in file :direction :input)

(let ((contents (make-string (file-length in))))

(read-sequence contents in)

contents))

""))

(defun zero-pad-number (number width)

"Convertit NUMBER en string avec des zéros à gauche."

(let ((s (write-to-string number)))

(concatenate 'string

(make-string (max 0 (- width (length s)))

:initial-element #\0)

s)))

(defun collect-auto-section-numbers (text prefix)

"Collecte tous les numéros trouvés dans des noms du type PREFIX001, PREFIX002, etc."

(let* ((prefix-string (string-downcase prefix))

(prefix-length (length prefix-string))

(text-lower (string-downcase text))

(numbers '())

(start 0))

(loop

for pos = (search prefix-string text-lower :start2 start)

while pos do

(let* ((num-start (+ pos prefix-length))

(num-end num-start))

(loop

while (and (< num-end (length text-lower))

(digit-char-p (char text-lower num-end)))

do (incf num-end))

(when (> num-end num-start)

(push (parse-integer text-lower

:start num-start

:end num-end)

numbers))

(setf start num-end)))

numbers))

(defun next-section-number (file prefix)

"Trouve le prochain numéro disponible pour PREFIX dans FILE."

(let* ((text (read-file-as-string file))

(numbers (collect-auto-section-numbers text prefix)))

(if numbers

(1+ (apply #'max numbers))

1)))

(defun make-auto-section-name (file prefix digits)

"Crée un nom automatique du type section001."

(intern

(string-upcase

(format nil "~a~a"

prefix

(zero-pad-number

(next-section-number file prefix)

digits)))))

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

;;; FONCTION PRINCIPALE

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

(defun save-current-section (&key

file

name

(prefix "section")

(digits 3)

(separator t)

(comment-date nil)

metadata)

"Sauvegarde le dernier score Opusmodus dans FILE.

Si NAME est fourni, le def-score prendra ce nom.

Si NAME est NIL, un nom automatique sera généré :

section001, section002, section003, etc.

Exemples :

(save-current-section

:file \"/Users/stephaneboussuge/Opusmodus/Scores/my-piece.lisp\")

(save-current-section

:file \"/Users/stephaneboussuge/Opusmodus/Scores/my-piece.lisp\"

:name 'introduction)

(save-current-section

:file \"/Users/stephaneboussuge/Opusmodus/Scores/my-piece.lisp\"

:prefix \"part\"

:digits 2)

(save-current-section

:file \"/Users/stephaneboussuge/Opusmodus/Scores/my-piece.lisp\"

:metadata '((:seed 12345)

(:mode octatonic-1)

(:tempo 72)))"

(unless file

(error "Tu dois fournir un chemin avec :file."))

(let* ((score-name

(or name

(make-auto-section-name file prefix digits)))

(raw-score

(capture-pprint-last-score))

(renamed-score

(replace-def-score-name raw-score score-name)))

(ensure-directories-exist file)

(with-open-file (out file

:direction :output

:if-exists :append

:if-does-not-exist :create)

(when separator

(format out "~%~%;;; ------------------------------------------------------------~%")

(format out ";;; SCORE: ~a~%" score-name)

(when comment-date

(format out ";;; Exported: ~a~%" (get-universal-time)))

(when metadata

(format out ";;; Metadata: ~s~%" metadata))

(format out ";;; ------------------------------------------------------------~%~%"))

(format out "~a~%" renamed-score))

score-name))

#|USAGE

Utilisation automatique :

(save-current-section

:file "/Users/stephaneboussuge/Opusmodus/Scores/my-piece.lisp")

Cela écrit automatiquement :

(def-score section001 ...)

Puis au prochain appel :

(def-score section002 ...)

Avec un nom manuel :

(save-current-section

:file "/Users/stephaneboussuge/Opusmodus/Scores/my-piece.lisp"

:name 'coda)

Avec métadonnées :

(save-current-section

:file "/Users/stephaneboussuge/Opusmodus/Scores/my-piece.lisp"

:metadata `((:seed ,*gseed*)

(:tempo 72)

(:material "octatonic")))

|#

Best,
Stéphane

If you’re like me and use Dorico to compose with Opusmodus, you’ve probably noticed that the dynamics notation like pp, mf, and ff aren’t imported into Dorico when you import an XML file from Opusmodus.

Here’s a function that solves this problem. It’s probably not perfect, but I’m sharing it here in case it helps some Opusmodus/Dorico users.

Be careful not to forget to change the path for your own path in the first parameter inside the Lisp document to make it work properly.

Best,

Stéphane

I’m sharing my personal framework for generating algorithmically Csound files directly from Opusmodus.

I’m sharing it « as is » and I know it can be improved, but it works well for my actual use. You can use it as a starting point for building your own framework.

There are some personal choices in the design of this framework, such as a very simple signal flow. After testing more complex routing like Csound mixers and send FX, I decided to return to a simpler workflow that aligns more closely with my usual Csound practice.

Disclaimer: This tool is intended for individuals who are already proficient in Csound.

Hope you will enjoy it !

GitHub

I programmed it to read a kind of sample matrix, which results in a continuous replacement process that happens generatively, kind of a tree structure.

(defun binary-layers (seqs)
  (append (list (car seqs))
          (loop repeat (1- (length seqs))
                with seq = (car seqs)
                with seqcnt = 1
                with interf = 1
                collect (setf seq (loop for i in seq
                                        with cnt = 0
                                          
                                when (and (= i interf)
                                          (= (nth cnt (nth seqcnt seqs)) 1))
                                            
                                          collect (+ i 1)
                                        else collect i
                                          
                                        when (> i (1- interf)) do (incf cnt)))
                do (incf seqcnt)
                do (incf interf))))

;;;; EXAMPLES


(binary-layers '((0 1 0 1 1 0 1) (0 1 0 1 1 0 0) (1 1 0 1 1 0 0) (1 0 1 1 1 0 0)))
=> ((0 1 0 1 1 0 1) (0 1 0 2 1 0 2) (0 1 0 3 1 0 3) (0 1 0 4 1 0 3))


(binary-layers '((1 1 0 1 1 0 0 1 0 1 1) (0 1 1 1 0 1 1 0 1 1 0) (1 1 1 1 0 1 1 0 0 1 0) (0 1 1 0 1 1 1 1 1 0 0)))
=> ((1 1 0 1 1 0 0 1 0 1 1) (1 2 0 2 2 0 0 1 0 2 2) (1 3 0 3 3 0 0 1 0 3 2) (1 3 0 4 4 0 0 1 0 3 2))


(binary-layers (loop repeat 10 collect (rnd-order '(1 1 0 1 1 0 0 1 0 1 1) :seed 243)))
=> ((0 1 1 1 1 0 0 1 1 0 1) (0 1 2 2 2 0 0 2 1 0 1) (0 1 2 3 3 0 0 3 1 0 1) (0 1 2 3 4 0 0 4 1 0 1) (0 1 2 3 4 0 0 5 1 0 1) (0 1 2 3 4 0 0 5 1 0 1) (0 1 2 3 4 0 0 5 1 0 1) (0 1 2 3 4 0 0 5 1 0 1) (0 1 2 3 4 0 0 5 1 0 1) (0 1 2 3 4 0 0 5 1 0 1))
               


;; STATIC VIEW - LISTPLOT wit lists in list
(list-plot (binary-layers (loop repeat 10 collect (rnd-order '(1 1 0 1 1 0 0 1 0 1 1) :seed 243))) :join-points t)

;; RANDOM VIEW + flatten all lists -> EVAL A FEW TIMES
(list-plot (flatten (binary-layers (loop repeat 10 collect (rnd-order '(1 1 0 1 1 0 0 1 0 1 1))))) :join-points t)

;; EVAL TO SEE the structures for each generation - it's a kind of REWRITE
(loop repeat 10
       do (list-plot (binary-layers (loop repeat 10 collect (rnd-order '(1 1 0 1 1 0 0 1 0 1 1)))) :join-points t)
      do (sleep 2))

GeeksforGeeks

;; kNN implementation in Common Lisp with weighted voting
;; -------------------------------------------------------
;; This program classifies a new data point based on the k nearest neighbors
;; from a given dataset, giving more weight to closer neighbors.

(defun euclidean-distance (vec1 vec2)
  "Compute the Euclidean distance between two numeric vectors."
  (unless (= (length vec1) (length vec2))
    (error "Vectors must have the same length."))
  (sqrt (reduce #'+
                (mapcar (lambda (a b) (expt (- a b) 2))
                        vec1 vec2))))

(defun knn-classify-weighted (dataset labels query k)
  "Classify QUERY using weighted k nearest neighbors from DATASET with LABELS.
   Closer neighbors contribute more to the vote."
  (when (or (null dataset) (null labels))
    (error "Dataset and labels cannot be empty."))
  (unless (= (length dataset) (length labels))
    (error "Dataset and labels must have the same length."))
  (when (or (<= k 0) (> k (length dataset)))
    (error "Invalid k value."))

  ;; Compute distances and pair with labels
  (let* ((distances (mapcar (lambda (point label)
                              (list (euclidean-distance point query) label))
                            dataset labels))
         ;; Sort by distance
         (sorted (sort distances #'< :key #'first))
         ;; Take k nearest
         (neighbors (subseq sorted 0 k))
         ;; Weighted label counts
         (label-weights (make-hash-table :test #'equal)))
    (dolist (n neighbors)
      (let ((dist (first n))
            (label (second n)))
        ;; Weight: inverse of distance (avoid division by zero)
        (incf (gethash label label-weights 0)
              (if (zerop dist) 1e6 (/ 1.0 dist)))))
    ;; Return label with highest total weight
    (car (car (sort (loop for key being the hash-keys of label-weights
                          collect (list key (gethash key label-weights)))
                    #'>
                    :key #'second)))))

;; Example usage
(let* ((dataset '((1.0 2.0) (2.0 3.0) (3.0 3.0) (6.0 5.0) (7.0 8.0)))
       (labels  '("A" "A" "B" "B" "B"))
       (query   '(2.5 3.0))
       (k 3))
  (format t "Predicted class for ~a: ~a~%"
          query
          (knn-classify-weighted dataset labels query k)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; GENERATING A 2D-RND_DATASET

(setf dataset_1
      (loop for x from 0.0 to 0.999 by 0.001 
            for y in (gen-noise 1000 :seed 6235)
            collect (list x y)))


;; GENERATING LABELS (a scale, 7 labels)

(setf labels_1 (rnd-sample 1000 (make-scale 'c4 7 :alt '(1 2)) :prob 0.5))
            

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; EXAMPLE

(let* ((dataset dataset_1)
       (labels  labels_1)
       (query   '(0.21 0.112)) ;; what i'm searching (2d)
       (k 5))
  (format t "Predicted class for ~a: ~a~%"
          query
          (knn-classify-weighted dataset labels query k)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun ratios-to-integers (lst)
  (let* ((lcm (reduce #'lcm (denominators lst))))
    (mapcar (lambda (x) (* x lcm)) lst)))


;; a rhythm to integers via LCM
(list-plot
    (ratios-to-integers
     '(1/12 1/16 1/20 1/24 1/28)) :join-points t)

;; gen same proportions with 1/32
(list-plot
    (gen-length 
     (ratios-to-integers
      '(1/12 1/16 1/20 1/24 1/28))
     1/32)
 :join-points t)


;; very strange proportions back to gen-length 1/32
(gen-length 
     (ratios-to-integers
      '(1/12 -3/12 5/20 1/16 -1/20 1/24 1/28))
     1/32)

• I’ve experimented with Opusmodus GPT and created this tool for my personal use. However, I thought it might be helpful for some of you, so I’m sharing it.

  GEN-SLONIMSKY-PATTERN

  Synopsis

  (gen-slonimsky-pattern octaves divisions
    &key
      interpolation infrapolation ultrapolation
      root direction
      dedupe dedupe-mode dedupe-tolerance
      limit-to-octave
      trim-with-gen-trim
      interpolation-permutation
      remove-consecutive-repeats
      transpose
      rotate)

  Description

  GEN-SLONIMSKY-PATTERN generates a Slonimsky-like procedural pitch pattern as an Opusmodus pitch list.

  Conceptually, the function builds a chain of “principal tones” across a span of octaves (converted to a total chromatic span), subdivided into divisions. For each principal tone, it can optionally insert:

  • an infrapolation pitch (below the principal tone),

  • one or more interpolation pitches (offsets around each principal tone),

  • an ultrapolation pitch (above the principal tone).

  After construction, the pattern can be octave-wrapped, de-duplicated (exactly or with a tolerance), trimmed to a target size, filtered for repeats, then optionally transposed and rotated.

  The function returns either one pitch list or a list of pitch-lists, depending on :interpolation-permutation.

  Parameters

  Required

  • octaves
    Number of octaves covered by the pattern. Internally, the chromatic span is (* 12 octaves).

  • divisions
    Number of divisions across the total span. The step size is computed as:

    • step = (/ (* 12 octaves) divisions)

    The principal-tone loop iterates i = 0 .. divisions (inclusive), so endpoints are included.

  Keyword options

  Pattern content

  • :interpolation (default: NIL)
    A list of numeric offsets (in MIDI units) inserted after each principal tone. Each k produces an inserted pitch at pt + (dir-sign * k).

  • :infrapolation (default: NIL)
    If non-NIL, inserts one pitch below each principal tone: pt - infrapolation (respecting direction sign as implemented).

  • :ultrapolation (default: NIL)
    If non-NIL, inserts one pitch above each principal tone: pt + (dir-sign * ultrapolation).

  • :root (default: 'c4)
    Root pitch (Opusmodus pitch symbol). Converted to MIDI via PITCH-TO-MIDI.

  • :direction (default: :up)
    Either :up or :down. Controls the sign of principal-tone stepping and of interpolation offsets.

  De-duplication

  • :dedupe (default: NIL)
    Enables de-duplication after optional octave-wrapping.

  • :dedupe-mode (default: :consecutive)

    • :consecutive removes only consecutive duplicates.

    • :all removes duplicates globally (first occurrence kept).

  • :dedupe-tolerance (default: 0)
    If 0, duplicates are detected by exact MIDI equality.
    If > 0, two MIDI values are considered equal if their absolute difference is <= dedupe-tolerance.

  Octave limiting

  • :limit-to-octave (default: NIL)

    • NIL: no wrapping

    • T: wraps every MIDI value into the octave [root, root+12) (relative to the MIDI value of root), then converts back to pitches.

  Trimming / sizing

  • :trim-with-gen-trim (default: NIL)
    If true, calls GEN-TRIM to force a computed target size. GEN-TRIM trims or extends a list to the requested length.

    The internal target size is computed as:

    target-size = divisions
                + (length interpolation)
                + (if infrapolation 1 0)
                + (if ultrapolation 1 0)

    (Note: principal tones are generated with endpoints included, but the trimming target is computed as shown above.)

  Interpolation permutation

  • :interpolation-permutation (default: NIL)
    Controls only the ordering/selection of the :interpolation list; principal tones remain fixed.

    Supported values:

    • NIL → uses interpolation as given.

    • :all → generates all permutations of interpolation via PERMUTE and returns a list of pitch-lists (one per permutation).

    • :messiaen → applies MESSIAEN-PERMUTATION to the interpolation list. For length 2, the code forces :type :openby default. (MESSIAEN-PERMUTATION is documented with :type options such as :open / :closed.)

    • (:messiaen type) → uses MESSIAEN-PERMUTATION with an explicit :type.

    • (:nth n) → takes the nth permutation from (permute interpolation) and builds a single pattern.

  Repeat filtering

  • :remove-consecutive-repeats (default: NIL)
    If true, applies (filter-repeat 1 ...) to the trimmed pitch list. FILTER-REPEAT limits repetitions; with n = 1 it removes consecutive repeats.

  Post transforms (new)

  • :transpose (default: NIL)
    If non-NIL, applies (pitch-transpose transpose sequence) to the final pitch list.

  • :rotate (default: NIL)
    If non-NIL, applies (pitch-rotate rotate sequence) to the (optionally transposed) result. PITCH-ROTATE supports rotation-number as a number or list, and has keyword options such as :chord (default T).

  Return value

  • If :interpolation-permutation is :all → returns a list of pitch-lists (one per permutation variant).

  • Otherwise → returns a single pitch list.

  Pitch conversion uses MIDI-TO-PITCH for the final MIDI list back to pitch symbols.

  Examples

  ;; Basic example + consecutive de-dupe + target trimming
  (gen-slonimsky-pattern 1 2 :root 'c4 :direction :up
                         :interpolation '(1 6)
                         :dedupe t :dedupe-mode :consecutive
                         :trim-with-gen-trim t)
  ;; target-size = 2 + 2 = 4
  
  
  ;; With infra + ultra, trimmed to target size
  (gen-slonimsky-pattern 1 2 :root 'c4 :direction :up
                         :interpolation '(1 6)
                         :infrapolation 1
                         :ultrapolation 2
                         :trim-with-gen-trim t)
  ;; target-size = 2 + 2 + 1 + 1 = 6
  
  
  ;; Messiaen permutation of interpolations (principal tones unchanged)
  (gen-slonimsky-pattern 1 2
                         :root 'c4 :direction :up
                         :interpolation '(1 6)
                         :trim-with-gen-trim nil
                         :interpolation-permutation :messiaen)
  
  
  ;; Messiaen permutation + remove consecutive repeats
  (gen-slonimsky-pattern 1 2
                         :root 'c4 :direction :up
                         :interpolation '(1 6)
                         :trim-with-gen-trim nil
                         :interpolation-permutation :messiaen
                         :remove-consecutive-repeats t)
  
  
  ;; Transpose then rotate (melodic rotation)
  (gen-slonimsky-pattern 1 2
                         :root 'c4 :direction :up
                         :interpolation '(1 6)
                         :interpolation-permutation :messiaen
                         :remove-consecutive-repeats t
                         :transpose 2
                         :rotate 1)
  
  
  ;; Rotation with a longer interpolation set
  (gen-slonimsky-pattern 1 2
                         :root 'c4
                         :interpolation '(1 6 8)
                         :trim-with-gen-trim t
                         :rotate 2)
  
  
  ;; Random interpolation offsets + random rotation amount
  (gen-slonimsky-pattern 1 2
                         :root 'c4
                         :interpolation (rndn (rndn 1 2 5) 1 11)
                         :trim-with-gen-trim nil
                         :rotate (rndn 1 0 11))

  Related documented functions (used internally)

  • PITCH-TO-MIDI (list &key quantize remain)

  • MIDI-TO-PITCH (values &key quantize remain)

  • GEN-TRIM (n sequence ...) (trims/extends to length)

  • FILTER-REPEAT (repeat limiting / consecutive control)

  • PERMUTE (sequence) (all permutations)

  • MESSIAEN-PERMUTATION ... :type ... (permutation strategies, e.g., :open, :closed)

  • PITCH-ROTATE (rotation-number sequence &key chord section exclude ambitus)

gen-slonimsky-pattern.lisp

(progn
  (setf chord  (rnd-sample-seq 10 (gen-sieve '(c3 g7) '(1 2 4 7 4 2) :type :pitch)))
  
  
  (setf rule30 (cellular-automaton 30 200 '(0 0 0 1 0 1 0 0 0 0)))
  (setf positions (loop for i in rule30
                        collect (position-item 1 i)))
  
  (setf chords (loop for i in positions
                     collect (chordize (position-filter i chord))))

  (pitch-list-plot (flatten chords)  :join-chords t))

https://plato.stanford.edu/entries/cellular-automata/supplement.html

here's a function I find useful for my work and sharing it here.

This is an anti oscillation function to remove aba type patterns when working on algorithmically generated material.

(defun anti-oscil (lst)
  "Supprime les éléments formant des oscillations de type x _ x dans LST.
   Exemple : (anti-oscil '(a b a a c)) => (a b c)"
  (labels
      ((rec (remaining result)
         (if (null remaining)
             ;; Plus rien à traiter, on renvoie le résultat tel quel
             result
           (let ((x (car remaining)))
             (if (and (>= (length result) 2)
                      (equal x (nth (- (length result) 2) result)))
                 ;; x forme une oscillation x _ x : on l'ignore
                 (rec (cdr remaining) result)
               ;; Sinon, on l'ajoute à la fin du résultat
               (rec (cdr remaining) (append result (list x))))))))
    ;; On démarre la récursion avec la liste complète et un résultat vide
    (rec lst '())))

#| Usage examples
 (filter-repeat
  1
  (anti-oscil
   (vector-to-pitch
    '(c3 c5)
    (vector-smooth 0.2 (gen-noise 128 :seed 42)))
   ))

(tonality-map
 '(messiaen-mode2 :map 'step)
 (filter-repeat
  1
  (anti-oscil
   (vector-to-pitch
    '(0 20)
    (vector-smooth 0.2 (gen-noise 128)))
   )))
|#

(defun totalistic-cellular-automaton (states rules initial-state generations)
  "Generates a multi-state totalistic cellular automaton.
   STATES: the number of possible states (e.g., 0, 1, 2, ...).
   RULES: a list of rules that map the sum of neighborhood states to a new state.
   INITIAL-STATE: a list representing the initial state of the automaton.
   GENERATIONS: the number of generations to evolve.
   Returns a list of all generations."
  (let* ((length (length initial-state))  ; Calculate the length from the initial-state
         (current-state initial-state)
         (next-state (make-list length))
         (all-generations (list current-state))) ; Initialize list with initial state
    (loop for gen from 1 to (1- generations)
          do (progn
               (loop for i from 0 below length
                     do (let* ((left (nth (mod (- i 1) length) current-state))  ; Left neighbor (wrap-around)
                               (center (nth i current-state))                 ; Current cell
                               (right (nth (mod (+ i 1) length) current-state)) ; Right neighbor (wrap-around)
                               (neighborhood-sum (+ left center right)))      ; Calculate the sum of neighbors
                          ;; Apply the totalistic rule based on the neighborhood sum
                          (setf (nth i next-state) (nth neighborhood-sum rules))))
               ;; Append the new state to the list of all generations
               (push (copy-list next-state) all-generations)
               ;; Move to the next state
               (setf current-state (copy-list next-state))))
    ;; Return the list of all generations
    (reverse all-generations)))  ; Return in the correct order

(defun generate-random-rule-set (states &key seed)
  "Generates a random rule set for a totalistic cellular automaton with the given number of STATES.
   The rule set maps sums (from 0 to 3 * (states - 1)) to a random state.
   The SEED parameter allows reproducibility of random output."
  (let ((max-sum (* 3 (1- states))))
    ;; Generate the entire rule set in one go using rndn with the seed parameter
    (rndn (1+ max-sum) 0 (1- states) :seed seed)))  ;; Generate integers between 0 and states-1

;; usage
(setf states 8)
(setf rule (generate-random-rule-set states :seed 12))
(totalistic-cellular-automaton states rule '(0 1 2 7 7 2 1 0) 4)
=> ((0 1 2 7 7 2 1 0)
    (7 3 6 2 2 6 3 7)
    (2 2 6 6 6 6 2 2)
    (3 6 7 4 4 7 6 3))

Example of usage is at the end of the function definition file, a short string quartet example.

;;; OMN-RND-VAR
;;; Base sur ma vieille pratique
;;; avec omn-rnd-variations1.

(defun generate-variation (max-length num-measures)
  "Generate a sorted list of unique random numbers based on num-measures."
  (sort-asc (find-unique (rnd-number num-measures 1 max-length :norep t))))

(defun omn-rnd-var (variations measures omn-sequence &key (uset 'om))
  "Application de variations via unfold avec une liste de variations et mesures correspondantes."
  (let ((max-length (length omn-sequence))
        (variation-list '()))
    (dolist (pair (mapcar #'cons variations measures))
      (let ((var (car pair))
            (num-measures (cdr pair)))
        (push (list var (generate-variation max-length num-measures)) variation-list)))
    (unfold uset (reverse variation-list) omn-sequence )))

#!
;; Exemple d'appel de l a fonction
;; Note: Le nombre de mesure n'est pas toujours exact
;; en raison de l'appel de find unique dans la fonction
;; generate variations afin de generer les index aleatoires
;; de mesure sans repetition, find-unique donc qui peut entrainer
;; la suppression de certains index qui etaient repetes. 

;; Attention, pour que la fonction fonctionne bien,
;; Les 2 listes variations et measures doivent etre
;; de la meme longueur (meme nombre d'elements).

;; Possibilite d'utiliser un unfold set personel avec uset.
(setf omn-mat (gen-trim 8 '((e c4 fs4 d4 a4 c5 g4 d4 e4))))
(omn-rnd-var '(ld12 ld42 d) '(2 4 3) omn-mat)
(omn-rnd-var '(ld12 ld42 d) '(2 5 3) omn-mat :uset 'om) ;replace 'om by your own unfold set.

;; Exemple d'utilisation:
(setf mat1 '((s c4 d4 e4 fs4 q b4)))
(setf vars1.n 24)
(setf vars1 (length-legato
             (omn-rnd-var 
              '(ad da d ld12mx ld22mx i ri ra rr4 pf2 rop 7-15 stacc dl1)
              '(3   8 3  4     4      2  2  2 8   8   8   8    11    12)
              (gen-repeat vars1.n mat1)) 
             ))

(setf idx1 (vector-round 1 vars1.n (gen-noise vars1.n)))
(setf idx2 (vector-round 1 vars1.n (gen-noise vars1.n)))
(setf idx3 (vector-round 1 vars1.n (gen-noise vars1.n)))
(setf idx4 (vector-round 1 vars1.n (gen-noise vars1.n)))

(setf line1 (vector-map vars1 idx1))
(setf line2 (vector-map vars1 idx2))
(setf line3 (vector-map vars1 idx3))
(setf line4 (vector-map vars1 idx4))

(setf vn1 (ambitus 'violin (pitch-transpose 8 line1)))
(setf vn2 (ambitus 'violin (pitch-transpose 0 line2)))
(setf vla (ambitus 'viola (pitch-transpose -8 line3)))
(setf vlc (ambitus 'cello (pitch-transpose -18 line4)))

(ps 'gm :sq (list vn1 vn2 vla vlc))
!#

(defun position-insert-seq (&key alist insert item)
  (let ((pos (car (position-item item alist))))
    (position-replace (gen-integer pos (+ pos (1- (length insert)))) insert alist)))


(setf alist '(0 0 0 0 0 0 1 0 2 0 0 0 3 5 7))
(setf insert '(a b c d))

(position-insert-seq :alist '(0 0 0 0 0 0 1 0 2 0 0 0 3 5 7)
                 :insert '(a b c d)
                 :item 2)

=> (0 0 0 0 0 0 1 0 a b c d 3 5 7)

This is an earlier version:

For the fun of it and hopefully some use I wrote this simple function:

;;;;;;;;;

(defun rk_rnd-order-omn (inomnl &key (exclude nil) seed  (flat nil))
"to exclude use l for :length, p for :pitch, v for :velocity; d for :duration, a for :articulation, 
 leg for :leg, ped for :ped;   i.e :exclude '(p leg)
  To be even more random flatten the omn with :flat t"
  (let* ( 
          (state *init-seed* )
          (vseed (rnd-seed seed))
          (omnl (if flat (flatten inomnl) inomnl))
          (len (if (member 'l exclude) (omn :length omnl) (rnd-order (omn :length omnl) :seed vseed) )) 
          (pit (if (member 'p exclude) (omn :pitch omnl) (rnd-order (omn :pitch omnl) :seed vseed) )) 
          (vel (if (member 'v exclude) (omn :velocity omnl) (rnd-order (omn :velocity omnl) :seed vseed) )) 
          (dur (if (member 'd exclude) (omn :duration omnl) (rnd-order (omn :duration omnl) :seed vseed) )) 
          (arti (if (member 'a exclude) (omn :articulation omnl) (rnd-order (omn :articulation omnl) :seed vseed) )) 
          (vleg (if (member 'leg exclude) (omn :leg omnl) (rnd-order (omn :leg omnl) :seed vseed) )) 
          (vped (if (member 'ped exclude) (omn :ped omnl) (rnd-order (omn :ped omnl) :seed vseed) ))
          (x )
       )
       (progn
         (init-state state) 
         (make-omn :length len :pitch pit :velocity vel :duration dur :articulation arti  :leg vleg :ped vped)
       )
  )
)  ;end rk_rnd-order-omn

(setf mat2 '((q e5 leg e fs5 leg gs5 q a5 ten cs6 ten)
  (h cs6 leg q b5 e d6 leg cs6 leg)
  (q a5 cs6 marc+leg gs5 cs6 leg)
  (h. fs5)))

(gen-loop 10 (rk_rnd-order-omn mat2 :seed 10 ))
(gen-loop 10 (rk_rnd-order-omn mat2 :flat t :seed 10 ))
(gen-loop 10 (rk_rnd-order-omn mat2 :exclude '(p ) :flat t :seed 10))

(gen-loop 10 (rk_rnd-order-omn mat2  ))
(gen-loop 10 (rk_rnd-order-omn mat2 :exclude '(p ) ))
(gen-loop 10 (rk_rnd-order-omn mat2 :exclude '(l a leg) :seed 60))
(gen-loop 10 (rk_rnd-order-omn mat2 :flat t ))
 

;;;;;;;;

I find the results interesting to create variations with selected similarities.

If there is already a function like this or another easy way to get the same results please let me know.

how it could sound - mapped on different tonalities

Brownsche Brücke – Wikipedia

DE.WIKIPEDIA.ORG

for understanding in OPMO:

axiom: start end

(50 23)

gen1 => 1 step

(50 8 23)

gen2  => 3 steps

(50 15 8 -3 23)

gen3 => 7 steps

(50 40 15 13 8 -14 -3 29 23)

gen4 => 15 steps

(50 58 40 33 15 22 13 4 8 4 -14 -16 -3 17 29 17 23)

...and so on

-------------------------------------------------------------------------------

some evaluations with same AXIOM:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; BROWNIAN BRIDGE -> could be use as a rnd-process from A to B (integers or pitches)
;;; if you have a look to example with ":all-gen t", you will see the process with all generations, how it works

;;; or take a look to:
;;; https://de.wikipedia.org/wiki/Wiener-Prozess#/media/File:BrownscheBewegung.png
;;; https://de.wikipedia.org/wiki/Brownsche_Brücke
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; SUB

(defun pick (a b &key (span 5))
  (let ((rnd1 (car (rnd-number 1 (+ a span) (- a span))))
        (rnd2  (car (rnd-number 1 (+ b span) (- b span))))
        (n))
    (progn
      (setf n (car (rnd-number 1 rnd1 rnd2)))     
      (if (or (= n a) (= n b))
        (+ (rnd-pick '(1 -1)) n)
        n))))


(pick 2 3)


;;; MAIN

;;; MAIN

(defun gen-brownian-bridge (n startend &key (all-gen nil) (output 'integer) (span 5))
  (let ((seq))
    (progn
      (setf seq (append (list startend)
                        (loop repeat n
                          with liste = startend
                          do (setf liste (filter-repeat 1 (loop repeat (1- (length liste))
                                                            for cnt = 0 then (incf cnt)
                                                            append (append (list (nth cnt liste) 
                                                                                 (pick (nth cnt liste) 
                                                                                       (nth (1+ cnt) liste) 
                                                                                       :span span)
                                                                                 (nth (1+ cnt) liste))))))
                          collect liste)))

      (setf seq (if (equal all-gen t)
                  seq
                  (car (last seq))))
      (if (equal output 'pitch)
        (integer-to-pitch seq)
        seq))))
  

;;; EXAMPLES


;; SPAN influence -> span 2
(loop repeat 20
      do (list-plot (gen-brownian-bridge 5 '(1.2 5.4) :span 2 :all-gen t)
                    :zero-based t
                    :point-radius 3
                    :join-points t)
         
        do (sleep 2))  
         

;; SPAN influence -> span 10
(list-plot (gen-brownian-bridge 5 '(50 23) :span 20 :all-gen t)
           :zero-based t
           :point-radius 3
           :join-points t)

;;; SPAN default (5)
(list-plot (gen-brownian-bridge 5 '(50 23) :all-gen t)
           :zero-based t
           :point-radius 3
           :join-points t)

(list-plot (gen-brownian-bridge 5 '(50 23))
           :zero-based t
           :point-radius 3
           :join-points t)


(gen-brownian-bridge 5 '(50 23) :all-gen t :output 'pitch)
(gen-brownian-bridge 5 '(50 23) :output 'pitch)

About ITERATE library:

https://common-lisp.net/project/iterate/

The code requires OM3.0 because of LispWorks specific API but the concept should be simple enough to be implemented in Clozure CL.

After some midi objects has been compiled and inserted to the playlist one can use run-playlist to start play. While it is still playing one

can feed more midi objects queued to the playlist. When the playlist is empty and after the specified seconds of timeout, the player process would exit.

(setq midi1 (compile-score 'score1))
(setq midi2 (compile-score 'score2))
(setq midi3 (compile-score 'score3))

(defparameter *playlist* (mp:make-mailbox))

(defun push-to-list (item)
  (let ((midi (cond ((eq (type-of item) 'midi:midi)
                     item)
                    ((symbolp item)
                     (compile-score item))
                    ((or (stringp item) (pathnamep item))
                     (midi:read-midi-file item)))))
    (mp:mailbox-send *playlist* midi)))

(defun run-playlist (&key (timeout 5) (ignore-ports nil))
  (mp:process-run-function
   "Playing..." ()
   (lambda ()
     (loop
        (let ((current (mp:mailbox-read *playlist* "Wait for feed tracks" timeout)))
          (if current
              (mp:process-join (start-midi current :ignore-ports ignore-ports))
            (return)))))))

(push-to-list midi1)
(push-to-list midi2)

(run-playlist 5)

(push-to-list midi3)

Here's a function to help to add such appoggiature in your score based on a list of rhythmic values.

There is a draft doc in French joined to the function definition.

Hope it could be useful for some of us and may be improved and better coded and refined.

My best to all of Opmo users.

SB.

gen-ornament.lisp gen-ornament.rtfd.zip

here's a function i've made for my own usage and i think could be useful for others.

It is a split point function which divide an OMN flux according to a list of split points.

Attached, you will find the French doc of the function 😉

;;; SPLIT-POINT
;;; SB. 2020
;;; Fonction utile pour séparer les 2 mains pour une partie de piano
;;; renvoie une liste de listes


(defun split-point (split-points omn-seq)
  (do-verbose ("split-point")
  (let* (
         (spltconvert (if (numberp (car split-points))
                        split-points
                        (pitch-to-integer split-points)))
         (spltp (gen-trim (length omn-seq) spltconvert))
         (p1 (loop for sp in spltp
               for l in omn-seq
               collect (ambitus-filter `(,sp 128) l)
               ))
         (p2 (loop for sp in spltp
               for l in omn-seq
               collect (ambitus-filter `(-128 ,(- sp  1)) l)
               ))
         )
    (list p1 p2))))

#|
(split-point '(c4 d4) '((e a3d4 c4e4 f4c5 q g3d4 e4)(e a3d4 c4e4 f4c5 q g3d4 e4)))
=> (((e d4 c4e4 f4c5 q d4 e4)(q d4 e4 f4c5 d4 e4)) ((e a3 - - q g3 -)(e a3 c4 - q g3 -)))


;;; Example
(setf pmat (make-scale 'c2 32 :alt '(2 1 2 3)))
(setf pch (rnd-sample 128 pmat))
(setf chrd (chordize-list (gen-divide (rnd-number 8 1 4) pch)))
(setf mat (length-legato (gen-filter-euclidean 8 16 4 16 chrd 's '(mf))))
(setf split (split-point '(c4) mat))
(setf piano-rh (ambitus-chord 12 (first split)))
(setf piano-lh (ambitus-chord 12 (second split)))

(ps 'gm
    :p (list piano-rh piano-lh)
    )


|#

SB.

split-point.rtfd.zip

;; FUNCTION ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun 2d-field-to-chord (matrix &key (start 'c4) (merge-chords nil))
  (let* ((int-horizontal
         (x+b (loop for x in (loop for i in matrix 
                               collect (position-item 1 i))
                when (not (null x))
                collect x)
              1))
  
        (int-vertical
         (x+b (loop repeat (length matrix)
                for n = 0 then (incf n)
                
                when (not (null (position-item 1 (nth n matrix))))
                collect n)
              1))

        (chords (loop 
                  for h in int-horizontal
                  for v in int-vertical
                  append (loop for z in h
                           collect (chordize (interval-to-pitch (list z v) :start start))))))

    (if (null merge-chords)
      chords
      (chord-pitch-unique (chordize (flatten chords))))))




;; interval-matrix ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; numbers are intervals (inverted order then in the book)
;; (different sizes are possible)

(setf matrix 
              #|1 2 3 4 5 6 7 8 9 etc..|#

       #|1|# '((1 0 0 0 0 0 0 0 0 0 0 0) 
       #|2|#   (0 1 0 0 0 0 0 0 0 0 0 0) 
       #|3|#   (0 0 1 0 0 0 0 0 0 0 0 0) 
       #|4|#   (0 0 0 0 0 0 0 0 0 0 0 0) 
       #|5|#   (0 0 0 0 0 0 0 0 0 0 0 0) 
       #|6|#   (0 0 0 0 0 0 0 0 0 0 0 0)
       #|7|#   (0 0 0 0 0 0 0 0 0 0 0 0)
   #|etc..|#   (0 0 0 0 0 0 0 0 0 0 0 0)
               (0 0 0 0 0 0 0 0 1 0 0 0)
               (0 0 0 0 0 0 0 0 0 0 0 0)
               (0 0 0 0 0 1 0 0 0 0 0 0)
               (0 0 0 0 0 0 0 0 0 0 0 0)))
      
              
(2d-field-to-chord matrix)
(2d-field-to-chord matrix :start 'd4)
(2d-field-to-chord matrix :merge-chords t)
(2d-field-to-chord matrix :merge-chords t :start 'd4)

;; as a scale
(sort-asc (melodize (2d-field-to-chord matrix :merge-chords t)))


;; with rnd-generated field (by probability)

(progn
  (setf matrix (loop repeat 32
                 collect (loop repeat 32 
                           collect (prob-pick '((0 0.97) (1 0.03))))))
  (2d-field-to-chord matrix))

(progn
  (setf matrix (loop repeat 32
                 collect (loop repeat 32 
                           collect (prob-pick '((0 0.99) (1 0.01))))))
  (2d-field-to-chord matrix :merge-chords t))

here's a function I've made for my personal usage.

May be it could be useful for some users...

Best

Stéphane

;;;===================================
;;; PITCH-TRAJECTORY
;;;===================================
;;; SB 1.11.21
;;;===================================
(defun pitch-trajectory (nbpitch range tendency 
                                 &key 
                                 (variance 0.5) 
                                 (type :around) 
                                 (quantize 1/2) 
                                 (smooth 1)
                                 filter-repeat
                                 seed
                                 )
  (setf seed (rnd-seed seed))
  (do-verbose ("pitch-trajectory :seed ~s" seed)
  (let* ((values (gen-tendency nbpitch tendency :variance variance :type type 
                           :seed (seed)))
         (smoothedval (vector-smooth smooth values))
         (out (vector-to-pitch range smoothedval :quantize quantize))
         )
    (if filter-repeat 
      (filter-repeat filter-repeat out)
      out))))


#|
;;; Tests divers
(pitch-trajectory 32 '(c4 g5) '(0.1 1 0.1) :seed 1234)
(pitch-trajectory 32 '(c4 g5) '(0.1 1 0.1) :seed 1234 :filter-repeat 1)
(pitch-trajectory 32 '(c4 g5) '(0.1 1 0.1) :seed 1234 
                  :filter-repeat 1
                  :variance 1
                  )
(pitch-trajectory 32 '(c4 g5) '(0.1 1 0.1) :seed 1234 
                  :filter-repeat 1
                  :variance 0.1
                  )
(pitch-trajectory 32 '(c4 g5) '(0.1 1 0.1) :seed 1234 
                  :filter-repeat 1
                  :smooth 0.1
                  )
(pitch-trajectory 32 '(c4 g5) '(0.1 1 0.1) :seed 1234 
                  :filter-repeat 1
                  :quantize 1/4
                  )
(pitch-trajectory 32 '(c4 g5) '(0.1 1 0.1) :seed 1234 
                  :filter-repeat 1
                  :quantize 1/8
                  )
(pitch-trajectory 32 '(c4 g5) '(0.1 1 0.1) :seed 1234 
                  :filter-repeat 1
                  :variance 1
                  :quantize 1/8
                  )



(gen-filter-change 
 (pitch-trajectory 
  32 '(c4 g5) '(0.1 1 0.1) :seed 1234)
 's)


|#

(defun serie-proliferantes (row)
  (let* ((ri_row (pitch-invert (gen-retrograde row)))
         (row (loop for z in (loop for x in (pitch-to-midi ri_row)
                          collect (or (position x (pitch-to-midi row))
                                      (position (- x 12)
                                                (pitch-to-midi row)) 
                                      (position (+ x 12) 
                                                (pitch-to-midi row))))
           
                collect (nth z ri_row))))

    row))


(serie-proliferantes '(c5 ab4 g4 db5 e4 d4 bb4 eb4 b4  f4 fs4 a4))
=> (fs4 a4 g4 cs5 d5 c5 eb5 gs4 b4 f4 e5 bb4)

seen here:

https://www.amazon.de/Jean-Barraqué-Musik-Konzepte-Heinz-Klaus-Metzger/dp/3883774499

page 19-20

Any ideas/experience in applying version control on OpusModus scripts while composing?

Big hug,

Wim Dijkgraaf

While there is no bespoke Opusmodus tutorial for any of them (you might consider my presentation at he Opusmodus convention as that tutorial, and additionally there are some nods to Opusmodus in the docs here and there), these libraries are all documented. For all libraries I write I tend to create detailed reference documentation for my own good 🙂  Much of the documentation is simply at the Common Lisp level, but that means in Opusmodus it would be largely used the same way. 

Fenv (Function Envelopes)

There is some short intro doc at the github project page of this library at https://github.com/tanders/fenv for plain Common Lisp but with a few Opusmodus-specific notes. In the fenv library, pretty much every definition has a very short docstring (e.g., see https://github.com/tanders/fenv/blob/master/sources/fenv.lisp ). These docstrings were also used for creating some HTML documentation. Check out the doc directory in this library. Further, there is a test file, which can also be considered a file with a bunch of examples, though without further documentation (see https://github.com/tanders/fenv/blob/master/tests/test-fenv.lisp ).

Cluster Engine and Cluster Rules

Concerning the constraint libraries, the situation is a bit more complex. The Github landing page of Cluster Engine (https://github.com/tanders/cluster-engine ) also starts with something like a mini tutorial and some very brief consideration of Opusmodus, like the fenv library. Nevertheless, these libraries where originally written for PWGL and they are still best documented when used from within PWGL.

You might want start looking into these libraries by watching some video tutorial I did for my students (as part of a collection/playlist of videos on PWGL) where I am showing them how to get started with these libraries in PWGL at

Both libraries feature some PWGL tutorial that consists of a number of PWGL patches accessible from the PWGL docs menu after installing and loading them.  These PWGL tutorials go much further than I do in the above-mentioned video.

Beyond these PWGL tutorials, there is also some reference doc for the top-level Cluster Engine functions (e.g.,  the rule applicators) and the predefined rules in Cluster Rules, again written as docstrings but also part of HTML docs of these libraries, but these are best understood after you followed the PWGL tutorials.

So, unfortunately I have to encourage you to check these libraries out in PWGL first, that is still more easy. You can then rather easily port your first PWGL Cluster Engine patches to Opusmodus, as the boxes in PWGL and the functions for Opusmodus at called the same, as long as you only used definitions from the Cluster Engine package.

Note that unfortunately, the original PWGL site is meanwhile down (this software is not developed any further), but it seems that some version of the software can still be downloaded at

Apologies that there are no bespoke Opusmodus tutorials. Janusz already also mentioned some interest in these libraries, so I may give some dedicated talk on those at some later stage (e.g., as part of our next convention). I would likely cover largely what is already covered in the above-mentioned docs, only from within Opusmodus then.

TOT

Again, this library has a github landing page with some initial documentation (https://github.com/tanders/tot ) and some detailed reference documentation in HTML in the doc folder (https://tanders.github.io/tot/ ). This reference documentation features many examples that can be directly executed within Opusmodus. In some earlier version of Opusmodus, the HTML doc files could also be directly opened and the code could be evaluated without copying, but that is currently not possible any more (due to some changes by Apple as I understand, sigh). 

Note that all of these libraries might have some problems here and there. I try to test all my definitions carefully (for Cluster Engine I even defined a suit of regression tests), but things on which these libraries depends can change (e.g., some updates of Opusmodus break some TOT code every now and then). Anyway, if case you run into problems just get in touch. I have currently rather little time to look into these matters and thus may not be very response, but I will try to help at some stage... 

Best,
Torsten

Is there a way to fill in distances between 'time-points' like in the example? Thanks for help!

best

ole

(setf time-points '(e b5 f - - -  b5 - -  b5 - - - - b5 -  b5 - - b5 - - - 
                      b5 - - - - a5 - - - - - a5 - - - a5 - - - -
                      a5 - - -  a5 - - - a5 - - - - a5 - - - a5 - - - - a5))

(omn :length time-points)

;is there a way to achive this:
(setf filled '(4/8 3/8 5/8 2/8 3/8 4/8 5/8 6/8 4/8 5/8 4/8 4/8 5/8 4/8 5/8 1/8))

(setf time-points-filled (make-omn :length filled
          :pitch (pitch-transpose -12 (omn :pitch time-points))
          :velocity (omn :velocity time-points)))

(def-score tp
            (:key-signature '(c maj)
             :time-signature '(4 4)  
             :tempo 50)             
            
  (voice1 :omn time-points :channel 1 :sound 'gm :program 0)
  (voice2 :omn time-points-filled :channel 2 :sound 'gm :program 0))