Save-current-section

Hello everyone,

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