AM

The Opusmodus editor allows to have a number of "windows" open next to each other, but not enough for me. With Emacs I have commonly 3-4 frames with code open next to each other, in addition to the documentation, output viewers etc. (nice to have multiple screens :)
 
Any chance to do the same and open 3-4 files from the current project/workspace side by side?
 
EDIT: Note that I can open additional files, but only if they are not part of the current project/workspace -- going beyond that restriction would help. 
 
Thanks!
 
Best,
Torsten

Dear Janusz,
 
After our chat last night I still think that it would be useful to make voice numbers optional. If they are absent, this could simply mean that they are in increasing order, starting with 1. So, the following two snippets would be equivalent.
(:1 (q e4 ff h f4 q c5)  :2 (e fs4 ff gs4 bb4 gs4 q fs4 f4)  :3 (s g3 ff gs3 q bb3 s gs3 g3 q gs3 f4)) ((q e4 ff h f4 q c5)  (e fs4 ff gs4 bb4 gs4 q fs4 f4)  (s g3 ff gs3 q bb3 s gs3 g3 q gs3 f4)) Now, the problem with the latter notation is that it cannot be distinguished from a sequence of bars, which is why I proposed another notation to mark parallel voices (those brackets). Alternatively, we could simply require another level of parentheses. 
(((q e4 ff h f4 q c5))  ((e fs4 ff gs4 bb4 gs4 q fs4 f4))  ((s g3 ff gs3 q bb3 s gs3 g3 q gs3 f4))) This could also be done by a simple function that expects an arbitrary number of voices with or without sublists for bars, and then creates the additional lists (or voice number markers) behind the scene.
(make-voices (q e4 ff h f4 q c5)  (e fs4 ff gs4 bb4 gs4 q fs4 f4)  (s g3 ff gs3 q bb3 s gs3 g3 q gs3 f4)) Anyway, as I pointed out before I suspect we quickly run into cases where the time signatures of different voices get inconsistent -- regardless of the notation used, and that it would be useful to optionally specify time signatures explicitly, like in def-score. This would simply cause a re-barring behind the scene, which is not a big deal.
(make-voices (q e4 ff h f4 q c5)  (e fs4 ff gs4 bb4 gs4 q fs4 f4)  (s g3 ff gs3 q bb3 s gs3 g3 q gs3 f4) :time-signature '((1 1 1 1) 4)) Tempo specifications for snippets would be very useful as well, and so would be partial scores with instrument names specified instead of voice numbers, but that might be too much :)
 
Best,
Torsten

I am working on a new omn symbol VOICES and wonder which way is more natural to write.
I would like to hear your comments and ideas on this.
 
Here are the two examples.
 
With symbol :vx

1) Each voice after each event, next to each other (1 bar 4/4):
symbol option :vx (:v1 q cs5 ff :v2 q gs4 ff :v3 q f4 ff :v4 q f3 ff :v1 q eb5 ff :v2 q gs4 ff :v3 q c4 ff :v4 q gs3 ff :v1 q cs5 ff :v2 q gs4 ff :v3 q f4 ff :v4 q cs3 ff :v1 q f5 ff :v2 q cs5 ff :v3 q gs4 ff :v4 q cs3 ff) symbol option :x (:1 q cs5 ff :2 q gs4 ff :3 q f4 ff :4 q f3 ff :1 q eb5 ff :2 q gs4 ff :3 q c4 ff :4 q gs3 ff :1 q cs5 ff :2 q gs4 ff :3 q f4 ff :4 q cs3 ff :1 q f5 ff :2 q cs5 ff :3 q gs4 ff :4 q cs3 ff)  
2) Each voice in a separate bar (1 bar 4/4):
symbol option :vx (:v1 (q bb4 ff g4 gs4 e g4 f4)  :v2 (q cs5 ff b4 gs4 fs4)  :v3 (q f4 ff bb3 gs3 e bb3 gs3)  :v3 (q d3 ff e eb3 d3 q c3 bb2)) symbol option :x (:1 (q e4 ff h f4 q c5) :2 (e fs4 ff gs4 bb4 gs4 q fs4 f4)  :3 (s g3 ff gs3 q bb3 s gs3 g3 q gs3 f4)  :4 (q c3 ff h f2 q f3))  
The symbol option :1 :2 :3 :4
(:1 (q e4 ff h f4 q c5)  :2 (e fs4 ff gs4 bb4 gs4 q fs4 f4)  :3 (s g3 ff gs3 q bb3 s gs3 g3 q gs3 f4)  :4 (q c3 ff h f2 q f3))  
will print in the Listener:
(:|1| (q e4 ff h f4 q c5)  :|2| (e fs4 ff gs4 bb4 gs4 q fs4 f4)  :|3| (s g3 ff gs3 q bb3 s gs3 g3 q gs3 f4)  :|4| (q c3 ff h f2 q f3))  
I personally think the second option is better to control.
 
Best wishes,
JP

OMN added to LENGTH-MAP function.
I you used the function before please add the :otherwise keyword to the function in your score.
 
--------------------------------
 
length-map map sequence &key repeat otherwise
              section exclude seed
 
[Function]
 
Arguments and Values:
 
map                              a list (<length><item>).
sequence            list of lengths or omn list.
otherwise           an item or list of items.
repeat                                  nil, t and '? (at random).  The default is nil.
section             an integer or list of integers. Selected list or lists to process.
                                                The default is NIL. This keyword is for omn lists only.
exclude             an integer or list of integers. Excluded list or lists from process.
                                                The default is NIL. This keyword is for omn lists only.
seed                                      NIL or an integer. The default is NIL.
 
Description:
 
LENGTH-MAP returns a copy of sequence in which each element that has been mapped (<length><item>) is replaced with a new item, if not, an otherwise item is chosen. If the sequence is omn-list and the otherwise is Nil, then the item is unchanged.
 
(length-map
 '(e (c4fs4 eb4a4))
 '(q q h -s s s s e -q - e - e s s h)
 :otherwise '(c4 cs5 d4 ds5))
=> (c4 cs5 d4 ds5 c4 cs5 c4fs4 eb4a4 c4fs4 cs5 d4 ds5)
 
(length-map
 '(e (c4fs4 eb4a4))
 '(q q h -s s s s e -q - e - e s s h)
 :otherwise '(c4 cs5 d4 ds5) :repeat t)
=> (c4 cs5 d4 ds5 c4 cs5 c4fs4 c4fs4 c4fs4 cs5 d4 ds5)
 
Examples:
 
Mapping pitch to length:
 
(length-map
 '(((s q) (c4db5 eb4d5)))
 '(q q h -s s s s e -q -q -e e -e s s h)
 :otherwise '(c4 cs4 fs4 g4))
=> (c4db5 eb4d5 fs4 c4db5 eb4d5 c4db5 fs4 g4 eb4d5 c4db5 fs4)
 
(length-map
 '(s (c4fs4 eb4a4))
 '(q q h -s s s s e -q -q -e e -e s s h)
 :otherwise (rnd-row :type :pitch))
=> (c4 cs4 d4 c4fs4 eb4a4 c4fs4 e4 gs4 eb4a4 c4fs4 g4)
 
(length-map
 '((s (c4fs4 eb4a4)) (q (fs4c5g5)))
 '(q q h -s s s s e -q -q -e e -e s s h)
 :otherwise (rnd-row :type :pitch) :repeat t)
=> (fs4c5g5 fs4c5g5 fs4 c4fs4 c4fs4 c4fs4 d4 eb4 eb4a4 eb4a4 a4)
 
Mapping velocity to length:
 
(length-map
 '((s f) (q p))
 '(q q h -s s s s e -q -q -e e -e s s h)
 :otherwise '(mp) :repeat t)
=> (p p mp f f f mp mp f f mp)
 
Mapping articulation to length:
 
(length-map 
      '((1/8 (marc mordent2)) (1/16 (ped stacc)) (1/4 (ped leg)))
      '(1/16 1/16 1/8 1/2 1/16 1/16 1/8 1/4 1/2 1/4)
      :otherwise '(tr1 tr2) :repeat t)
=> (ped ped marc tr2 stacc stacc mordent2 ped tr1 leg)
 
(length-map 
      '((1/8 (spicc marc)) (1/16 (pizz stacc)) (1/4 (vib leg)))
      '(1/16 1/16 1/8 1/2 1/16 1/16 1/8 1/4 1/2 1/4)
      :otherwise '(ord))
=> (pizz stacc spicc ord pizz stacc marc vib ord leg)
 
(setf length
      '((1/2 4/5 1/5)
        (5/16 1/16 1/2 3/16 1/8)
        (4/5 1/2 1/4 1/5)
        (1/2 5/16 3/16 1/8 1/16)
        (1/16 1/2 5/16 1/8 3/16 1/8 5/16 1/2 1/16 1/16 1/2)
        (1/2 5/16 3/16 1/16 1/8 1/16 3/16 5/16 1/2)
        (1/10 1/5 3/10 1/2 4/5 3/10 1/2 4/5 1/2 3/10 1/5)
        (1/8 5/16 1/16 1/2 3/16)
        (1/8 3/16 1/2 1/16 5/16)
        (1/2 4/5 1/10 3/10 1/5 1/5 3/20)))
 
(length-map
 '((1/2 (pfp-vib-4s detache-short stacc))
   ((1/8 5/16) (tas-detache detache-long))
   ((1/10 3/10) (tas-sus dyn-me-novib-1.5s tas-trem))
   ((2/3 7/6) (tas-sus pfp-vib-4s dyn-me-novib-3s)))
 length :otherwise '(sus-novib))
 
=> ((pfp-vib-4s sus-novib sus-novib)
    (tas-detache sus-novib pfp-vib-4s sus-novib detache-long)
    (sus-novib pfp-vib-4s sus-novib sus-novib)
    (pfp-vib-4s tas-detache sus-novib detache-long sus-novib)
    (sus-novib pfp-vib-4s tas-detache detache-long sus-novib
     tas-detache detache-long detache-short sus-novib sus-novib stacc)
    (pfp-vib-4s tas-detache sus-novib sus-novib detache-long
     sus-novib sus-novib tas-detache detache-short)
    (tas-sus sus-novib dyn-me-novib-1.5s pfp-vib-4s sus-novib
     tas-trem detache-short sus-novib stacc tas-sus sus-novib)
    (tas-detache detache-long sus-novib pfp-vib-4s sus-novib)
    (tas-detache sus-novib pfp-vib-4s sus-novib detache-long)
    (pfp-vib-4s sus-novib tas-sus dyn-me-novib-1.5s sus-novib
     sus-novib sus-novib))
 
OMN:
 
(setf omn '((e c4 fff cs5 f q d4 f ds5 p s f4 p fs5 p c5 p pp)
            (s cs4 p f d4 f e eb5 p f4 p eb4 f h d3 p ff)))
 
Mapping pitch to length:
 
(length-map '((s (c4fs4 fs3f4)) (e c6ds6)
              (q (rnd-sample 12 '(fs4 fs3 gs5) :seed 45)))
            omn :otherwise '(c3fs4g4 gs5))
=> ((e c6ds6 fff f q fs3 fs4 p s c4fs4 fs3f4 c4fs4 fs3f4 pp)
    (s c4fs4 p fs3f4 f c4fs4 e c6ds6 p c6ds6 c6ds6 f
     h c3fs4g4 p gs5 ff))
 
(length-map '((s (c4fs4 fs3f4)) (e c6ds6)
              (q (rnd-sample 12 '(fs4 fs3 gs5) :seed 45)))
            omn :repeat t)
=> ((e c6ds6 fff f q fs3 fs3 p s c4fs4 c4fs4 c4fs4 c4fs4 pp)
    (s c4fs4 p f c4fs4 e c6ds6 p c6ds6 c6ds6 f h d3 p ff))
 
Mapping articulation to length:
 
(length-map '((s stacc) (e ped) (q (rnd-sample 12 '(tr1 marc))))
            omn)
=> ((e c4 fff ped cs5 f ped q d4 tr1 ds5 p tr1
     s f4 stacc fs5 stacc c5 stacc c5 pp stacc)
    (s cs4 p stacc cs4 f stacc d4 stacc
     e eb5 p ped f4 ped eb4 f ped h d3 p ff))
 
Mapping velocity to length:
 
(length-map '((s ff) (e f) (q (rnd-sample 12 '(pp ppp))))
            omn :otherwise '(ppp))
=> ((e c4 f cs5 q d4 ppp ds5 pp s f4 ff fs5 c5 c5)
    (s cs4 ff cs4 d4 e eb5 f f4 eb4 h d3 ppp d3))
 
Best wishes,
JP
 

New:
 
single-events sequence
 
[Function]
 
Arguments and Values:
 
sequence                    omn sequence.
 
Description:
 
The function SINGLE-EVENTS brakes-up an omn sequence into a new list of single events (l p v a).
 
(single-events '(s bb3 leg a3 mp leg g3 a3 f c4 f4 a4))
=> ((s bb3 mf leg) (s a3 mp leg) (s g3 mp)
    (s a3 f) (s c4 f) (s f4 f) (s a4 f))
 
Examples:
 
(single-events
 '((s bb3 leg a3 mp leg g3 a3 f c4 f4 a4)
   (-q s bb4 c5 mf stacc b4 c5 mf d5 eb5 fff f5 eb5 d5)))
 
=> (((s bb3 mf leg) (s a3 mp leg) (s g3 mp) (s a3 f)
     (s c4 f) (s f4 f) (s a4 f))
    ((-q) (s bb4 mf) (s c5 mf stacc) (s b4 mf) (s c5 mf)
     (s d5 mf) (s eb5 fff) (s f5 fff) (s eb5 fff) (s d5 fff)))
 
---------------------------------------------------------------
 
gen-steps step sequence &key seed
 
[Function]
 
Arguments and Values:
 
step                an integer or list of integers (number of steps).
sequence            a sequence.
seed                an integer or NIL. The default is NIL.
 
Description:
 
The function GEN-STEPS randomises the order of a sequence and returns it into the original sequence order, after a given number of steps.
 
(gen-steps 12 '(0 1 2 3 4 5 6 7 8 9 10 11) :seed 43)
=> ((4 2 10 9 4 7 5 0 11 6 1 3)
    (4 2 2 9 4 7 5 0 11 6 1 3)
    (4 2 2 9 4 7 5 0 11 6 10 3)
    (4 2 2 9 4 7 5 0 11 9 10 3)
    (4 2 2 9 4 7 5 0 8 9 10 3)
    (4 2 2 9 4 7 5 7 8 9 10 3)
    (4 2 2 9 4 5 5 7 8 9 10 3)
    (0 2 2 9 4 5 5 7 8 9 10 3)
    (0 2 2 9 4 5 5 7 8 9 10 11)
    (0 2 2 9 4 5 6 7 8 9 10 11)
    (0 1 2 9 4 5 6 7 8 9 10 11)
    (0 1 2 3 4 5 6 7 8 9 10 11))
 
Examples:
 
(gen-steps 6 '(c4 e4 g4 b4 f4 d4 b3) :seed 56)
=> ((a4 c4 f4 b4 e4 a4 d4)
    (c4 c4 f4 f4 e4 a4 d4)
    (c4 c4 f4 f4 e4 a4 b4)
    (c4 c4 e4 f4 e4 a4 b4)
    (c4 c4 e4 f4 g4 a4 b4)
    (c4 d4 e4 f4 g4 a4 b4))
 
OMN:
 
(gen-steps
 7 '(s c4 ppp d4 pp e4 p f4 mp g4 mf a4 f - b4 ff c5 fff) :seed 45)
=> ((s g4 mf f4 mp c5 fff f4 mp g4 mf c4 ppp a4 f - b4 ff)
    (s g4 mf f4 mp c5 fff f4 mp g4 mf c4 ppp a4 f - c5 fff)
    (s g4 mf f4 mp e4 p f4 mp g4 mf c4 ppp a4 f - c5 fff)
    (s g4 mf d4 pp e4 p f4 mp g4 mf c4 ppp a4 f - c5 fff)
    (s c4 ppp d4 pp e4 p f4 mp g4 mf a4 f a4 - c5 fff)
    (s c4 ppp d4 pp e4 p f4 mp g4 mf a4 f - - c5 fff)
    (s c4 ppp d4 pp e4 p f4 mp g4 mf a4 f - b4 ff c5 fff))
 
(pitch-variant
 (gen-steps '(3 4 5 4 3)
            '(s bb3 p a3 mp g3 a3 f c4 f4 a4 pp -q
              s bb4 c5 p b4 c5 mf d5 eb5 fff f5 eb5 d5)
            :seed 67)
 :variant '? :seed 3567)
 
 
---------------------------------------------------------------
 
Added functions working with OMN events:
 
(gen-crossover '((s bb3 p a3 mp g3) (s a3 f c4 f4 a4 pp))
               '((-q s bb4 c5 p b4 c5 mf) (s d5 eb5 fff f5 eb5 d5)) :seed 45)
 
=> ((s bb3 p a3 mp c5 p b4 c5 mf) (-q s bb4 mf g3 mp)
    (s eb5 fff f5 eb5 d5) (s d5 mf a3 f c4 f4 a4 pp))
 
 
(gen-divide
 '(2 4 2)
 '(s c4 ppp d4 pp -q s e4 p f4 mp g4 mf a4 f b4 ff c5 fff))
=> ((s c4 ppp d4 pp) (-q s e4 p f4 mp g4 mf)
    (s a4 f b4 ff) (s c5 fff))
 
 
(gen-interleave 2 '(s c4 ppp d4 pp e4 p f4 mp g4 mf a4 f b4 ff c5 fff))
=> ((s c4 ppp d4 pp) (s d4 pp e4 p) (s e4 p f4 mp) (s f4 mp g4 mf)
    (s g4 mf a4 f) (s a4 f b4 ff) (s b4 ff c5 fff))
 
(gen-interleave '((2) (3))
                '((s c4 ppp d4 pp e4 p f4 mp g4 mf a4 f b4 ff c5 fff)
                  (s c4 ppp d4 pp e4 p f4 mp g4 mf a4 f b4 ff c5 fff))
                :flatten t)
 
=> ((s c4 ppp d4 pp d4 e4 p e4 f4 mp f4 g4 mf g4 a4 f a4 b4 ff b4 c5 fff)
    (s c4 ppp d4 pp e4 p d4 pp e4 p f4 mp e4 p f4 mp g4 mf f4 mp g4 mf
       a4 f g4 mf a4 f b4 ff a4 f b4 ff c5 fff))
 
 
More to come...
 
---------------------------------------------------------------
 
Notation:
 
Articulation harm will display above the note now.
 

Velocity symbols displaying correctly now - no more repeat symbols on tied notes.

Below is a function that might be interesting for others as well. When I starting writing this function it was much more complicated, but it got more simple by and by 🙂 A formatted version as an RTF file of the documentation is attached, below is a plain text version.
 
For completeness I also attached the documentation of the function circle-repeat, used by the function below. Unfortunately, the file names are destroyed by the software of this forum, sorry.
 
Best,
Torsten
 
alternate-omns ids omns
 
Arguments and Values
 
ids       a list of integers, indicating the position of OMN expressions in omns.
omns     a list of OMN expressions (can also be plain lengths, or pitches etc.) between which to switch.
 
Description
This function alternates between sublists of multiple OMN expressions.
This function can be useful, e.g., to switch between different musical characteristics. Each characteristic (e.g., gesture) and its development can be specified by a combination of parameters (rhythm, pitches, dynamics, and playing techniques) in a sequence of OMN expressions. The output of the function switches between these characteristics as specified in the first argument to the function. The following example demonstrates this.
 
(alternate-omns  (gen-eval 10 '(rnd-pick '(0 1)))  (list   (make-omn    :length (length-rest-series (rnd-sample 7 '(7 8 9))             (length-divide 3 2                            (rnd-sample 7 '((q q q) (h e e) (h.) (h q)))))    :pitch '(d4 e4 f4 g4)    :velocity '(pp))   (make-omn    :length '(s s s s)    :pitch (gen-rotate :right '(c5 d5 f5 a5 g5 e5) :type :seq)    :velocity '(ff)    :span :pitch)))
Alternatively, one can switch between plain sequences of OMN lengths, or pitches etc.
(alternate-omns   '(0 0 1 0 1 0 1 1 0 0 1 1 1)   (list     (gen-rotate :left '(-1/20 1/20 1/20 1/20 1/20) :type :seq)    '((q e e))))  
Examples
Remember that resulting OMN expressions can be “re-barred”.
(omn-to-time-signature  (alternate-omns   '(0 0 1 0 1 0 1 1 0 0 1 1 1)   (list    (make-omn     :length (gen-rotate :left '(-1/20 1/20 1/20 1/20 1/20) :type :seq)     :pitch '(d4 e4 f4 g4)     :velocity '(ff))    (make-omn     :length '(q e e)     :pitch (gen-rotate :left '(c5 e5 f5) :type :seq)     :velocity '(pp pp)     :attribute '(ten stacc stacc)     :span :pitch)))  '(4 4))  
Implementation
(defun alternate-omns (ids omns) "This function alternates between sublists of multiple omn expressions. It can be useful, e.g., to switch between different musical characteristics. Args: ids: a list of integers, indicating the position of OMN expressions in omns. omns: a list of OMN expressions (can also be plain lengths, or pitches etc.) between which to switch." (let ((omn-no (length omns))) (assert (every #'(lambda (x) (and (integerp x) (< x omn-no))) ids) (ids) "alternate-omns: must be a list of integers between 0 and (1- (length omns)): ~A" ids) (let ((hash (make-hash-table))) (loop for i from 0 to (1- omn-no) for my-omn in omns ;; span (circular repeat if necessary) omn sublists to number of occurences in specs ;; and fill hash table with that as side effect do (setf (gethash i hash) (circle-repeat my-omn (count i ids)))) (alternate-omns-aux ids hash)))) (defun alternate-omns-aux (ids hash) (loop for id in ids collect (pop (gethash id hash)))) (defun circle-repeat (pattern n) "Circle through elements in pattern (a list) until n elements are collected. NOTE: only supports flat list so far." (let ((l (length pattern))) (loop for i from 0 to (- n 1) collect (nth (mod i l) pattern))))  
TXT.rtf
TXT.rtf

Dear André,
 
Below is an alternative approach to do the same. The actual user-level code is more concise here, so this might be preferable if you have lots of such variations that should be easy to comprehend later.
 
Best,
Torsten
 
;;; ;;; Definition of map-omn ;;; (defun mat-trans (in-list) "Quasi a matrix transformations: transforms a list of form ((a1 a2 a3) (b1 b2 b3) (c1 c2 c3) ...) into ((a1 b1 c1 ...) (a2 b2 c2 ...) (a3 b3 c3 ...))." (apply #'mapcar #'(lambda (&rest all) all) in-list)) (defun map-omn (fn omn-expr) "Variant of mapcar for omn expressions, intended for creating variations of these. Applies function fn to every note in omn-expr (a flat OMN list). fn must exect four arguments (a length, pitch, velocity and articution) and returns a list of four values (a length, pitch, velocity and articution)." (destructuring-bind (lengths pitches velocities articulations) (mat-trans (funcall #'mapcar fn (omn :length omn-expr) (omn :pitch omn-expr) (omn :velocity omn-expr) (omn :articulation omn-expr))) (make-omn :length lengths :pitch pitches :velocity velocities :articulation articulations)))  
The user-level code starts here.
;;; ;;; Actual program ;;; (setf my-data '(e. c4 pppp tasto d4 ponte e4)) (map-omn #'(lambda (l p v a) (list l p ;; replace tasto dynamics by fff (if (equal a 'tasto) 'fff v) a)) my-data) ; => (e. c4 fff tasto d4 pppp ponte e4)  

Are rewrite-lsystem and its friends based on L-Lisp by Knut Arild Erstad (Erstad, 2002; http://www.ii.uib.no/~knute/lsystems/llisp.html)
If not, they look and work surprisingly similar. For example, I can just use complex examples as the following from Erstad's documentation, and they work in OM.
 
;; Mycelis muralis (from ABoP, p. 87--90) (defclass mycelis (l-system) ((axiom :initform '((I 20) Fa (A 0))) (ignore-list :initform '(+ /)) (homomorphism-depth :initform 10) (frame-delay :initform 0.5) (frame-list :initform '((0 100))) (limits :initform '((-2 -1 -1) (2 14 1))))) (defmethod l-productions ((ls mycelis)) (choose-production ls ;; Growing apex ((A x) (with-lc (S) (--> (T 0))) (if (> x 0) (--> (A (1- x))) (--> [ (+ 30) Fb ] Fa (/ 180) (A 2)))) ;; Stem segment: propagates signals (Fa (with-lc (S) (--> Fa S)) (with-rc ((T c)) (--> (T (1+ c)) Fa))) ;; Undeveloped branch segment (Fb (with-lc ((T c) Fa) (--> (I (1- c)) Fa (A 3)))) ;; Delayed signal ((I c) (if (zerop c) (--> S) (--> (I (1- c))))) ;; Signals disappers (S (--> nil)) ((T c) (--> nil)) )) (rewrite-lsystem 'mycelis :depth 7)  
If this is Erstad's code, then it would be appropriate to acknowledge this in the documentation etc., and helpful for users to point at the much more extensive documentation of the original software. There are very many more features of this generator that users cannot guess from the existing documentation.
 
Thanks!
 
Torsten
 
Erstad, K. A. (2002) L-systems, twining plants, Lisp. Master’s thesis thesis. University of Bergen. [online]. Available from: http://www.vcn.bc.ca/~griffink/lisp_lsystems.pdf (Accessed 21 December 2016).

if you want to modify "a weight" from GEN-generation to next GEN-generation you could use this...
(modifying a weight could be useful if you want to give your production-rules a global drift)
greetings
andré
 
(defun modify-weight (&key weight (step 0.1) type (threshold 0.5) (span '(0 1)) (max-weight 1.0)) (cond ((or (equal type 'incr) (equal type 'decr)) (progn (setq weight (cond ((equal type 'incr) (incf weight step)) ((equal type 'decr) (decf weight step)))) (if (and (> weight 0) (< weight max-weight)) (append weight) (cond ((>= weight max-weight) (random (- 1 threshold))) ((<= weight 0) (+ (random (- 1 threshold)) threshold)))))) ((equal type 'incr-noreset) (if (< weight max-weight) (incf weight step) (append max-weight))) ((equal type 'decr-noreset) (if (> weight 0) (decf weight step) (append 0))) ((equal type 'rnd) (+ (random (- 1 threshold)) threshold)) ((equal type 'rnd-span) (rnd-round (first span) (second span))))) ;;; EXAMPLES TO TEST THE FUNCTION -> ev. every example a few times to check it (setf weight 0.1) ;;; counts up until default-max-weight (1.0), then rnd-reset (setf weight (modify-weight :type 'incr :weight weight :step 0.2)) (setf weight 0.1) ;;; counts up, stays at max-weight (setf weight (modify-weight :type 'incr-noreset :weight weight :step 0.2 :max-weight 3.0)) (setf weight 1.0) ;;; counts down until 0, then rnd-reset (setf weight (modify-weight :type 'decr :weight weight :step 0.1)) (setf weight 1.0) ;;; counts up, stays at 0 (setf weight (modify-weight :type 'decr-noreset :weight weight :step 0.1)) (setf weight 1.0) ;;; rnd-weights, larger then threshold (setf weight (modify-weight :type 'rnd :threshold 0.3)) (setf weight 1.0) ;;; rnd-weights, in SPAN (setf weight (modify-weight :type 'rnd-span :span '(0.3 0.6)))  

hi wim
so it is up to us to share ideas and code here in the forum :-)
greetings
andré
 

Finally it is the question whether you want to generate music with the help of blackboxes/tools (whether open source or OM)... or you want to think, to reflect and to program your own ideas, and not to take what tools can easily generate (in this case you are not/less "independent"). with LISP (coding almost everything for myself) and OM for MIDI and SCORE it works for me... i think it's not a question of open source or not...

ALL-VARIANTS2
**********************
 
"extended version" -> if you want to have pairs of rest/length or if EVERY value could be changed
 
(defun all-variants2 (seq &key (length/rest 'nil)) (let ((all-basic-binary-combinations) (binary-seq-completed)) ;;;decides if should work with pairs of length/rests (if (equal length/rest 't) ;; produces all combinations of 0/1 with length of (/ (length seq) 2) => your ON/OFF (switching values) (progn (setf all-basic-binary-combinations (loop for i from 0 to (binary-to-decimal (loop repeat (/ (length seq) 2) collect 1)) with val = '() do (setf val (decimal-to-binary i)) collect (append (loop repeat (- (/ (length seq) 2) (length val)) collect 0) val))) ;; combines the 1/0-list with 0 (for the unchanging rests) (setf binary-seq-completed (loop for x in all-basic-binary-combinations collect (loop for y in x append (list y 0))))) ;;;EVERY val will be switched (setf binary-seq-completed (loop for i from 0 to (binary-to-decimal (loop repeat (length seq) collect 1)) with val = '() do (setf val (decimal-to-binary i)) collect (append (loop repeat (- (length seq) (length val)) collect 0) val)))) ;; maps the "binary-seq-completed" on your values (loop for k in binary-seq-completed collect (loop for l in k for value in seq when (= l 1) collect (abs value) else collect value)))) (all-variants2 '(-1/4 -1/4 -1/4 -3/8 -1/4 -1/4) :length/rest 't) (all-variants2 '(-1/4 -1/4 -1/4 -3/8 -1/4 -1/4) :length/rest 'nil)  

don't know if this already exists in the library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; chord-multiplication like boulez ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun chord-multiplication (chord1 chord2 &key (chord 'nil)) (let ((liste (sort-asc (remove-duplicates (loop for i in chord1 append (pitch-transpose-start i chord2)))))) (if (equal chord 't) (chordize liste) (append liste)))) (defun all-chord-multiplications (liste &key (chord 'nil)) (let ((liste (loop for i in (combination 2 liste) collect (chord-multiplication (first i) (second i))))) (if (equal chord 't) (chordize liste) (append liste)))) ;;; EXAMPLES ;;; with 2 chords (chord-multiplication '(eb4 a4 d5) '(ab4 g5) :chord 't) ;;; all possible multiplications (combinations of 2) in a diveded list (setf divided-list '((eb4 a4 d5) (ab4 g5) (e4 gs4 db4) (b3 f4 bb4 c5))) (all-chord-multiplications divided-list :chord 't) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
 

don't know if this already exists in the library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; chord-multiplication like boulez ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun chord-multiplication (chord1 chord2 &key (chord 'nil)) (let ((liste (sort-asc (remove-duplicates (loop for i in chord1 append (pitch-transpose-start i chord2)))))) (if (equal chord 't) (chordize liste) (append liste)))) (defun all-chord-multiplications (liste &key (chord 'nil)) (let ((liste (loop for i in (combination 2 liste) collect (chord-multiplication (first i) (second i))))) (if (equal chord 't) (chordize liste) (append liste)))) ;;; EXAMPLES ;;; with 2 chords (chord-multiplication '(eb4 a4 d5) '(ab4 g5) :chord 't) ;;; all possible multiplications (combinations of 2) in a diveded list (setf divided-list '((eb4 a4 d5) (ab4 g5) (e4 gs4 db4) (b3 f4 bb4 c5))) (all-chord-multiplications divided-list :chord 't) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; A WAY TO MUTATE/MODIFY A PROPORTION-LIST FOR "gen-length-constant" ;;;; the SUM in all generations is CONSTANT ;;;; FUNCTION (defun modify-prop-seq (generations values &key (value-step 1) (chance 1.0)) (append (list values) (loop repeat (- generations 1) with rnd-seq with new-seq do (if (prob? chance) (setq rnd-seq (rnd-sample-seq 2 values) new-seq (list (+ (car rnd-seq) value-step) (- (car (rest rnd-seq)) value-step)) values (loop for i in (pattern-map (list (append (list rnd-seq) (list new-seq))) values) when (> i 0) collect i)) (append values)) collect values))) ;;;; tests (modify-prop-seq 5 '(1 2 3 4 5 6 7 8 9)) (modify-prop-seq 5 '(2 1 8 5 1 3) :value-step 1 :chance 0.9) (modify-prop-seq 5 '(4 4 4 4 4) :value-step 1 :chance 0.5) ;;;; practical-use -> every generation in 1 bar (loop for i in (modify-prop-seq 5 '(2 1 8 5 1 3) :value-step 1 :chance 0.8) collect (gen-length-constant i '4/4)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; A WAY TO MUTATE/MODIFY A PROPORTION-LIST FOR "gen-length-constant" ;;;; the SUM in all generations is CONSTANT ;;;; FUNCTION (defun modify-prop-seq (generations values &key (value-step 1) (chance 1.0)) (append (list values) (loop repeat (- generations 1) with rnd-seq with new-seq do (if (prob? chance) (setq rnd-seq (rnd-sample-seq 2 values) new-seq (list (+ (car rnd-seq) value-step) (- (car (rest rnd-seq)) value-step)) values (loop for i in (pattern-map (list (append (list rnd-seq) (list new-seq))) values) when (> i 0) collect i)) (append values)) collect values))) ;;;; tests (modify-prop-seq 5 '(1 2 3 4 5 6 7 8 9)) (modify-prop-seq 5 '(2 1 8 5 1 3) :value-step 1 :chance 0.9) (modify-prop-seq 5 '(4 4 4 4 4) :value-step 1 :chance 0.5) ;;;; practical-use -> every generation in 1 bar (loop for i in (modify-prop-seq 5 '(2 1 8 5 1 3) :value-step 1 :chance 0.8) collect (gen-length-constant i '4/4)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;PERMUTE-SYMMETRCIAL -> seq of any lengths;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; SUB (defun divide-seq-length (seq) (if (evenp (length seq)) (/ (length seq) 2) (/ (1- (length seq)) 2))) ;;; MAIN (defun permute-symmetrical (row &key (chance 0.5)) (let ((1st (loop repeat (divide-seq-length row) for cnt = 0 then (incf cnt) collect (nth cnt row))) (2nd (loop repeat (divide-seq-length row) for cnt = (- (length row) 1) then (decf cnt) collect (nth cnt row)))) (loop for i in 1st for j in 2nd when (prob? chance) collect j into 1st-bag and collect i into 2nd-bag else collect i into 1st-bag and collect j into 2nd-bag when (= (length 1st-bag) (divide-seq-length row)) do (return (if (evenp (length row)) (append 1st-bag (reverse 2nd-bag)) (append 1st-bag (list (nth (length 1st) row)) (reverse 2nd-bag))))))) ;;; EXAMPLE (pitch-list-plot (permute-symmetrical '(a4 bb4 ab4 b4 g4 c5 fs4 cs4 f4 d4 e4 eb4) ;zimmermann-row :chance 0.3))  

hi yuichi
 
here a version without exit-problems... a simple loop (with x-generations), that's what your code is doing... so you don't have to re-evaluate, loop is doing this...
(setf generations 20) (setf omn (loop repeat generations do (setf pitch (integer-to-pitch (rnd-row))) do (setf len (span pitch '(s))) collect (make-omn :pitch pitch :length len))) (def-score 12-tone (:key-signature 'atonal :time-signature '(4 4) :tempo 120) (inst :omn omn)) (display-musicxml '12-tone) (display-midi '12-tone)  
 
 

;;; i think what you are looking for is something like that: ;;; in every generation the sequence will be new, and at some ;;; points (when sample-length = 1) the row is changing... (setf generations 200) (setf omn (loop repeat generations             with seq = (rnd-row)             do (setf pitch (integer-to-pitch (setf seq (rnd-sample-seq (1+ (random (length seq))) seq)))) ;; picks a rnd-length-sample of the row                          ;; when the random-chosen seq-length = 1 then a new row will be generated but ONE value shorter             ;; (see: (butlast (rnd-row)) , so the feedback will come quicker and quicker... because ;; of the chance to match seq-length = 1       when (= (length seq) 1) do (setq seq (butlast (rnd-row))) ;; the feedback on production             do (setf len (span pitch '(s)))             collect (make-omn :pitch pitch :length len)))        (def-score 12-tone            (:key-signature 'atonal                            :time-signature '(4 4)                            :tempo 120)   (inst :omn omn)) (display-musicxml '12-tone) (display-midi '12-tone) ;;;  

for further ideas: i think it's a good solution to work with "structures" = "datasets" and a "machine" who generates output based on these datas.
 
... your "machine" will pick its rules/datas... from there, so you have good possibilties to work with more then one dataset, and give also a feedback on this sets (such a dataset is like a "GENOM", and the machine produces its outputs based on this "GENOM" but also influences it = feeback)...
 
an dataset-example from my current project...
;;; defines a structure called CHORDSET (defstruct chordset name interval-seq interval-direction startpitch durations rhy velocity cresc-dim seq-length rotate-dynmics sampling-types form-types data1) ;;; VARIABLE CHORD1 will be "filled" with datas in this structure -> see "make-chordset" (setf chord1 (make-chordset :name 'chord1 :interval-seq '(3 5 3 3 5 3 3 5 3 3) :interval-direction '((up 0.5) (down 0.5)) :startpitch '(c4 gs4) :durations '1 :rhy '((1/32 0.4) (1/20 0.4) (1/12 0.2)) :velocity (weighted-random '(((pppp ppp pp p mp mf mp p pp ppp pppp) 0.5) ((p p p mp mp mf mp mp p p p) 0.5))) :cresc-dim '(pppp p) :seq-length '((3 0.3) (5 0.3) (7 0.1) (11 0.3)) :form-types '(crippled asymmetric symmetric broken) :sampling-types '(rnd from-center))) ;;; every data could be read by (for example) (chordset-startpitch chord1) => (c4 gs4) ;;; or could be rewritten by (setf (chordset-startpitch chord1) 'c3) ;;; then: (chordset-startpitch chord1) => c3  
=> the machine reads this self-definied datas and generating output (like YOUR program)
=> an perhaps when some patterns are recognized (in the production-process) there could be an influence on the dataset
     -> rewrite the dataset
 
=> that's a way to control and design such recursiv-production-systems, but there are also many other ways...
 
i hope that helps you - and i hope i did not misunderstand  your ideas/code...
regards
andré 

hi yuichi
 
here a version without exit-problems... a simple loop (with x-generations), that's what your code is doing... so you don't have to re-evaluate, loop is doing this...
(setf generations 20) (setf omn (loop repeat generations do (setf pitch (integer-to-pitch (rnd-row))) do (setf len (span pitch '(s))) collect (make-omn :pitch pitch :length len))) (def-score 12-tone (:key-signature 'atonal :time-signature '(4 4) :tempo 120) (inst :omn omn)) (display-musicxml '12-tone) (display-midi '12-tone)  
 
 

have fun or delete it...
chord-rotation by karel goeyvaerts (his early works), also used/modfied by stockhausen & co, etc...
regards
a.
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;some OLD code -> changed for OMN ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;; goeyvaerts-rotation -> from "komposition 1";;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; SUBS (defun weighted-random (list) (loop for item in list with rand-num = (random (loop for x in list sum (second x))) for add = (second item) then (+ add (second item)) when (< rand-num add) return (first item))) ;;; (defun weighted-t/nil (on-weight) (let ((off-weight (- 1 on-weight))) (weighted-random (list (list 't on-weight) (list 'nil off-weight))))) ;;; (defun single-pitch-transpose (pitch interval &key (midi-output 'nil)) (if (numberp pitch) (if (equal midi-output 'nil) (midi-to-pitch (+ interval pitch)) (+ interval pitch)) (if (equal midi-output 'nil) (midi-to-pitch (+ interval (pitch-to-midi pitch))) (+ interval (pitch-to-midi pitch))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;MAIN;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun goeyvaerts-rotation (&key pitches static-pitches generations goeyvaerts-transpose-interval (direction 'up) low-border high-border correction-interval) (let ((pitches (filter-remove (pitch-to-midi static-pitches) (pitch-to-midi pitches)))) (midi-to-pitch (append (list (append pitches (pitch-to-midi static-pitches))) (cond ((equal direction 'up) (loop repeat generations collect (append (setf pitches (append (loop for i in pitches when (> i (- (pitch-to-midi high-border) goeyvaerts-transpose-interval)) collect (- i (- (abs correction-interval) 12)) else collect (+ i goeyvaerts-transpose-interval)))) (pitch-to-midi static-pitches)))) ((equal direction 'down) (loop repeat generations collect (append (setf pitches (append (loop for i in pitches when (< i (+ (pitch-to-midi low-border) goeyvaerts-transpose-interval)) collect (+ i correction-interval 12) else collect (- i goeyvaerts-transpose-interval)))) (pitch-to-midi static-pitches))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (chordize (goeyvaerts-rotation :pitches '(cs2 a2 gs3 d4 bb4 a5 eb6) :static-pitches '(d4) :direction 'down :generations 3 :goeyvaerts-transpose-interval 12 :low-border 'c2 :high-border 'c5 :correction-interval 24)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;put in in a specific interval-to-chord-function ;;;;;;;;;;;;; ;;;;;:type rnd-octaves or goeyvaerts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun interval-to-chord+ (&key interval-seq startpitch (generations 1) (no-duplicates 'nil) (type 'rnd-octaves) (transpose-intervals '(-12 12)) (transpose-chance 0.5) (arpeggiando 'nil) (goeyvaerts-direction 'up) (goeyvaerts-static-pitches '(c4)) (goeyvaerts-transpose-interval 12) (goeyvaerts-low-border 'c2) (goeyvaerts-high-border 'c5) (goeyvaerts-correction-interval 24) (sorted-asc 't)) (let ((pitches (interval-to-pitch interval-seq :start startpitch))) (setf pitches (if (equal no-duplicates 't) (remove-duplicates pitches) (append pitches))) (setf pitches ;;type with rnd-octaves (cond ((equal type 'rnd-octaves) (loop repeat generations collect (setf pitches (loop for i in pitches collect (single-pitch-transpose i (if (weighted-t/nil transpose-chance) (rnd-pick transpose-intervals) (append 0))))))) ;;type with goeyvaerts-transp -> (from "komposition 1") ((equal type 'goeyvaerts) (goeyvaerts-rotation :pitches pitches :static-pitches goeyvaerts-static-pitches :direction goeyvaerts-direction :generations generations :goeyvaerts-transpose-interval goeyvaerts-transpose-interval :low-border goeyvaerts-low-border :high-border goeyvaerts-high-border :correction-interval goeyvaerts-correction-interval)) (t (append pitches)))) (if (equal sorted-asc 't) (setf pitches (sort-asc pitches))) (if (equal arpeggiando 't) (append pitches) (chordize pitches)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; examples ;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; GOEYVAERTS (pitch-list-plot (flatten (interval-to-chord+ :type 'goeyvaerts :interval-seq '(5 3 3 3 5 3 3 3 5) :generations 10 :startpitch 'c4 :type 'goeyvaerts :goeyvaerts-direction 'up :goeyvaerts-low-border 'c2 :goeyvaerts-high-border 'c5 :goeyvaerts-correction-interval 48 :arpeggiando t :sorted-asc 't))) ;;; RND-OCTAVES (pitch-list-plot (flatten (interval-to-chord+ :type 'rnd-octaves :interval-seq '(5 3 3 3 5 3 3 3 5) :startpitch 'c4 :type 'rnd-octaves :no-duplicates 't :transpose-intervals '(-12 12) :transpose-chance 0.5 :arpeggiando t :sorted-asc 't)))  

have fun or delete it...
chord-rotation by karel goeyvaerts (his early works), also used/modfied by stockhausen & co, etc...
regards
a.
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;some OLD code -> changed for OMN ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;; goeyvaerts-rotation -> from "komposition 1";;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; SUBS (defun weighted-random (list) (loop for item in list with rand-num = (random (loop for x in list sum (second x))) for add = (second item) then (+ add (second item)) when (< rand-num add) return (first item))) ;;; (defun weighted-t/nil (on-weight) (let ((off-weight (- 1 on-weight))) (weighted-random (list (list 't on-weight) (list 'nil off-weight))))) ;;; (defun single-pitch-transpose (pitch interval &key (midi-output 'nil)) (if (numberp pitch) (if (equal midi-output 'nil) (midi-to-pitch (+ interval pitch)) (+ interval pitch)) (if (equal midi-output 'nil) (midi-to-pitch (+ interval (pitch-to-midi pitch))) (+ interval (pitch-to-midi pitch))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;MAIN;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun goeyvaerts-rotation (&key pitches static-pitches generations goeyvaerts-transpose-interval (direction 'up) low-border high-border correction-interval) (let ((pitches (filter-remove (pitch-to-midi static-pitches) (pitch-to-midi pitches)))) (midi-to-pitch (append (list (append pitches (pitch-to-midi static-pitches))) (cond ((equal direction 'up) (loop repeat generations collect (append (setf pitches (append (loop for i in pitches when (> i (- (pitch-to-midi high-border) goeyvaerts-transpose-interval)) collect (- i (- (abs correction-interval) 12)) else collect (+ i goeyvaerts-transpose-interval)))) (pitch-to-midi static-pitches)))) ((equal direction 'down) (loop repeat generations collect (append (setf pitches (append (loop for i in pitches when (< i (+ (pitch-to-midi low-border) goeyvaerts-transpose-interval)) collect (+ i correction-interval 12) else collect (- i goeyvaerts-transpose-interval)))) (pitch-to-midi static-pitches))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (chordize (goeyvaerts-rotation :pitches '(cs2 a2 gs3 d4 bb4 a5 eb6) :static-pitches '(d4) :direction 'down :generations 3 :goeyvaerts-transpose-interval 12 :low-border 'c2 :high-border 'c5 :correction-interval 24)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;put in in a specific interval-to-chord-function ;;;;;;;;;;;;; ;;;;;:type rnd-octaves or goeyvaerts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun interval-to-chord+ (&key interval-seq startpitch (generations 1) (no-duplicates 'nil) (type 'rnd-octaves) (transpose-intervals '(-12 12)) (transpose-chance 0.5) (arpeggiando 'nil) (goeyvaerts-direction 'up) (goeyvaerts-static-pitches '(c4)) (goeyvaerts-transpose-interval 12) (goeyvaerts-low-border 'c2) (goeyvaerts-high-border 'c5) (goeyvaerts-correction-interval 24) (sorted-asc 't)) (let ((pitches (interval-to-pitch interval-seq :start startpitch))) (setf pitches (if (equal no-duplicates 't) (remove-duplicates pitches) (append pitches))) (setf pitches ;;type with rnd-octaves (cond ((equal type 'rnd-octaves) (loop repeat generations collect (setf pitches (loop for i in pitches collect (single-pitch-transpose i (if (weighted-t/nil transpose-chance) (rnd-pick transpose-intervals) (append 0))))))) ;;type with goeyvaerts-transp -> (from "komposition 1") ((equal type 'goeyvaerts) (goeyvaerts-rotation :pitches pitches :static-pitches goeyvaerts-static-pitches :direction goeyvaerts-direction :generations generations :goeyvaerts-transpose-interval goeyvaerts-transpose-interval :low-border goeyvaerts-low-border :high-border goeyvaerts-high-border :correction-interval goeyvaerts-correction-interval)) (t (append pitches)))) (if (equal sorted-asc 't) (setf pitches (sort-asc pitches))) (if (equal arpeggiando 't) (append pitches) (chordize pitches)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; examples ;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; GOEYVAERTS (pitch-list-plot (flatten (interval-to-chord+ :type 'goeyvaerts :interval-seq '(5 3 3 3 5 3 3 3 5) :generations 10 :startpitch 'c4 :type 'goeyvaerts :goeyvaerts-direction 'up :goeyvaerts-low-border 'c2 :goeyvaerts-high-border 'c5 :goeyvaerts-correction-interval 48 :arpeggiando t :sorted-asc 't))) ;;; RND-OCTAVES (pitch-list-plot (flatten (interval-to-chord+ :type 'rnd-octaves :interval-seq '(5 3 3 3 5 3 3 3 5) :startpitch 'c4 :type 'rnd-octaves :no-duplicates 't :transpose-intervals '(-12 12) :transpose-chance 0.5 :arpeggiando t :sorted-asc 't)))  

NEW:
MODUS is working with omn-form lists now.
 
(modus '((q c6 cs4 e a4 e3 d6 f4) (q b4 gs3 e bb4 eb4 g5 fs6)))
=> ((0 1 9 4 2 5) (11 8 10 3 7 6))
 
 
MOTIF-MAP function name has change to PATTERN-MAP with additional functionality.
 
(setf omn '((s c4 d4 e4 f4 g4 a4 b4 c5)
            (5q c4 d4 e4 f4 g4 g4 f4 e4 d4 c4)))
 
(pattern-map 
  '(((c4 d4 e4) (cs4 ds4 f4)) 
    ((f4 g4) (eb4 fs4))) omn
  :type :pitch)
=> ((s cs4 ds4 f4 eb4 fs4 a4 b4 c5)
    (5q cs4 ds4 f4 eb4 fs4 g4 f4 e4 d4 c4))
 
(pattern-map 
  '(((c4 d4 e4) (cs4 ds4 f4)) 
    ((f4 g4) (eb4 fs4))) omn
  :type :pitch :loop t)
=> ((s cs4 ds4 f4 f4 g4 a4 b4 c5)
    (5q c4 d4 e4 eb4 fs4 g4 f4 e4 d4 c4))
 
 
(setf mat '((q c6 cs4 a4 e3 d6 f4) (q b4 gs3 bb4 eb4 g5 fs6)))
 
(modus mat)
=> ((0 1 9 4 2 5) (11 8 10 3 7 6))
 
(pattern-map 
 '(((0 1 9 4 2 5) (0 4 2 1 9 5))
   ((11 8 10 3 7 6) (10 8 11 3 7 6)))
 mat :type :pitch :pcs t)
=> ((q c6 e4 d4 cs3 a6 f4)
    (q bb4 gs3 b4 eb4 g5 fs6))
 
(pattern-map
 '(((0 1 9) (10 8 11))
   ((11 8 10) (0 1 9)))
 mat :type :pitch :pcs t :loop t)
=> ((q bb6 gs4 b4 e3 d6 f4)
    (q c4 cs3 a4 eb4 g5 fs6))