opmo

Version 1.1.1.18850 MOTIF-MAP with WILDCARD (?) and section. (setf pitch '((g5 fs5 g5 c5 ds5 g5 fs5 g5 a5 d5) (g5 fs5 g5 a5 c5 d5 ds5 d5 c5 as4) (ds5 d5 ds5 g4 gs4 f5 ds5 f5 a4 as4) (g5 f5 g5 b4 c5 d5 ds5 f5) (ds5 d5 c5 as4 gs4 g4 f4 gs5 g5 f5 ds5) (d5 ds5 f5 b4 c5 d5 b4 c5 g5))) (setf intervals (pitch-to-interval pitch)) => ((-1 1 -7 3 4 -1 1 2 -7) (5 -1 1 2 -9 2 1 -1 -2 -2) (5 -1 1 -8 1 9 -2 2 -8 1) (9 -2 2 -8 1 2 1 2) (-2 -1 -2 -2 -2 -1 -2 15 -1 -2 -2) (-1 1 2 -6 1 2 -3 1 7)) (setf imap '(((-1 ?) 3) ((1 -2) 2) ((1 1) (3 3)))) (setf new-intervals (motif-map imap intervals)) => ((3 -7 3 4 3 2 -7) (5 3 2 -9 2 1 3 -2) (5 3 -8 1 9 -2 2 -8 1) (9 -2 2 -8 1 2 1 2) (-2 3 -2 -2 3 15 3 -2) (3 2 -6 1 2 -3 1 7)) (interval-to-pitch new-intervals :start 'g5) => ((g5 bb5 eb5 fs5 bb5 cs6 eb6 gs5) (cs6 e6 fs6 a5 b5 c6 eb6 cs6) (fs6 a6 cs6 d6 b6 a6 b6 eb6 e6) (cs7 b6 cs7 f6 fs6 gs6 a6 b6) (a6 c7 bb6 gs6 b6 gs5 f5 g5) (e5 d5 gs5 g5 f5 gs5 g5 c5)) (setf imap2 '(((-1 ?) 3) ((1 -2) 2) ((-2 ?) (-4 -4)))) (motif-map imap2 intervals) => ((3 -7 3 4 3 2 -7) (5 3 2 -9 2 1 3 -2) (5 3 -8 1 9 -4 -4 -8 1) (9 -4 -4 -8 1 2 1 2) (-4 -4 -4 -4 3 15 3 -2) (3 2 -6 1 2 -3 1 7)) (motif-map imap2 intervals :otherwise '(13 -11)) => ((3 13 -11 13 3 -11 13) (13 3 -11 13 -11 13 3 -11) (13 3 -11 13 -11 -4 -4 13 -11) (13 -4 -4 -11 13 -11 13 -11) (-4 -4 -4 -4 3 13 3 -11) (3 13 -11 13 -11 13 -11 13))

Fix to LENGTH-CHORDIZE-MAP and function names in "Sextet Studies" scores.

Think about motifs and patterns replacement. the "Motif" name is more musical :-) (motif-map '(((0 1 2) (a b c)) ((0 1 2 3) (p q r))) '(0 1 2 3 4 5 6 7 8 9 10 11) :otherwise 'x) 1st (motif-map '(((0 1 2) (a b c))) '(0 1 2 3 4 5 6 7 8 9 10 11)) => (a b c 3 4 5 6 7 8 9 10 11) 2nd (motif-map '(((0 1 2 3) (p q r))) '(a b c 3 4 5 6 7 8 9 10 11)) => (a b c 3 4 5 6 7 8 9 10 11) and finaly the 'x => (a b c x x x x x x x x x) Yes, it is from the left to right. I will add this to the documentation. Thank you for your suggestions and comments.

I truly like the concept of build-from-transforms function. Maybe we could add something like that to our system.

New function: motif-map map sequence &key otherwise swallow [Function] Arguments and Values: map a list. (<old><new>). sequence a proper sequence. otherwise NIL or an argument. The default is NIL. swallow NIL or T. The default is NIL. Description: MOTIF-MAP returns a copy of sequence in which each motif that has been mapped is replaced with a new motif. Examples: The argument (((0 1 2) (a b c))) means motif (0 1 2) will be replace with new motif (a b c). (motif-map '(((0 1 2) (a b c))) '(0 1 2 3 4 5 6 7 8 9 10 11)) => (a b c 3 4 5 6 7 8 9 10 11) The otherwise with an argument 'x replaces all items in the sequence with 'x which are not mapped. (motif-map '(((0 1 2) (a b c))) '(0 1 2 3 4 5 6 7 8 9 10 11) :otherwise 'x) => (a b c x x x x x x x x x) Example with many mappings. (motif-map '(((0 1 2) (a b c)) ((3 4 5) (a a a)) ((6 7) (b b)) ((8 9 10) (c c c)) (11 d)) '(0 1 2 3 4 5 6 7 8 9 10 11)) => (a b c a a a b b c c c d) Mapping length: (setf length '((1/16 1/16 1/8 1/8 1/8 1/16 1/16 1/8 1/8 1/8) (1/16 1/16 1/8 1/8 1/16 1/16 1/4 1/16 1/16 1/8) (1/16 1/16 1/8 1/8 1/8 1/16 1/16 1/8 1/8 1/8) (1/16 1/16 1/8 1/8 1/8 1/16 1/16 3/8) (1/16 1/16 1/16 1/16 1/16 1/16 1/8 1/8 1/8 1/8 1/8) (1/8 1/8 1/8 1/8 1/8 1/8 1/8 1/16 1/16))) (setf lmap '(((1/16 1/16 1/8) (1/4)) ((1/16 1/16 1/4) (3/8)) ((1/16 1/16 1/16 1/16 1/16 1/16 1/16 1/16) (1/2)) ((1/8 1/8 1/8 1/8) (3/8 1/8)))) (motif-map lmap length) => ((1/4 1/8 1/8 1/4 1/8 1/8) (1/4 1/8 3/8 1/4) (1/4 1/8 1/8 1/4 1/8 1/8) (1/4 1/8 1/8 1/16 1/16 3/8) (1/16 1/16 3/8 3/8 1/8) (3/8 1/8 1/8 1/8 1/8 1/16 1/16)) Mapping interval: (setf pitch '((g5 fs5 g5 c5 ds5 g5 fs5 g5 a5 d5) (g5 fs5 g5 a5 c5 d5 ds5 d5 c5 as4) (ds5 d5 ds5 g4 gs4 f5 ds5 f5 a4 as4) (g5 f5 g5 b4 c5 d5 ds5 f5) (ds5 d5 c5 as4 gs4 g4 f4 gs5 g5 f5 ds5) (d5 ds5 f5 b4 c5 d5 b4 c5 g5))) (setf intervals (pitch-to-interval pitch)) => ((-1 1 -7 3 4 -1 1 2 -7) (5 -1 1 2 -9 2 1 -1 -2 -2) (5 -1 1 -8 1 9 -2 2 -8 1) (9 -2 2 -8 1 2 1 2) (-2 -1 -2 -2 -2 -1 -2 15 -1 -2 -2) (-1 1 2 -6 1 2 -3 1 7)) (setf imap '(((-1 1) 3) ((1 -2) 2) ((1 1) (3 3)))) (setf new-intervals (motif-map imap intervals)) => ((3 -7 3 4 3 2 -7) (5 3 2 -9 2 1 -1 -2 -2) (5 3 -8 1 9 -2 2 -8 1) (9 -2 2 -8 1 2 1 2) (-2 -1 -2 -2 -2 -1 -2 15 -1 -2 -2) (3 2 -6 1 2 -3 1 7)) (interval-to-pitch new-intervals :start 'g5) => ((g5 bb5 eb5 fs5 bb5 cs6 eb6 gs5) (cs6 e6 fs6 a5 b5 c6 b5 a5 g5) (c6 eb6 g5 gs5 f6 eb6 f6 a5 bb5) (g6 f6 g6 b5 c6 d6 eb6 f6) (eb6 d6 c6 bb5 gs5 g5 f5 gs6 g6 f6 eb6) (fs6 gs6 d6 eb6 f6 d6 eb6 bb6)) Mapping articulation to length: (setf lengths '((-11/16 1/16 -1/4) (-3/4 1/12 -1/12 1/12) (1/16 1/8 1/16 1/16 1/16 1/8) (1/20 -1/20 1/20 -1/20 1/20 1/20 1/20 1/20 1/20 1/20) (-1/16 1/16 1/16 1/16 1/16 1/16 1/8) (1/16 1/16 -1/8 1/16 1/16 1/16 1/16))) (motif-map '(((1/8 1/4) leg) ((1/16 1/16 1/16 1/16) (leg leg leg)) (1/12 stacc) ((1/20 1/20) (stacc stacc))) lengths :otherwise '-) => ((- - -) (- stacc - stacc) (- - - - - -) (- - - - stacc stacc stacc stacc stacc stacc) (- leg leg leg - -) (- - - leg leg leg)) The swallow keyword t (true) swallows items that align with rest-length values. This keyword can be used if a sequence contain lengths. (motif-map '(((1/8 1/4) leg) ((1/16 1/16 1/16 1/16) (leg leg leg)) (1/12 stacc) ((1/20 1/20) (stacc stacc))) lengths :swallow t :otherwise '-) => ((-) (stacc stacc) (- - - - - -) (- - stacc stacc stacc stacc stacc stacc) (leg leg leg - - -) (- - leg leg leg -)) ;;;--------------------------------------------------------- ;;; SCORE EXAMPLE ;;;--------------------------------------------------------- (progn (setf lengths (binary-rhythm (gen-repeat 4 '(16 12 8 10 8 8 12)) (gen-repeat 4 '( 8 5 7 5 6 6 6)) (gen-repeat 4 '( s 3q s 5q s s 3e)) :type '? :variant '? :rotate (rnd-sample 24 '(-2 -1 1 0 1 2)))) (setf articulations (motif-map '(((1/8 1/4) leg) ((1/16 1/8) leg) ((1/12 1/12 1/12) (leg leg)) ((1/16 1/16 1/16 1/16 1/16) (stacc stacc stacc stacc stacc)) ((1/20 1/20 1/20 1/20 1/20) (leg leg leg leg)) ((1/20 1/20) (stacc stacc)) ((3/8 5/16 5/16) (leg leg))) lengths :swallow t :otherwise '-)) (setf pitches (randomize-octaves '(g3 c7) (interval-to-pitch (rnd-sample 128 '(0 -1 1 6 -6)) :start 'a3))) (setf omn (make-omn :pitch pitches :length lengths :velocity '(f) :articulation articulations)) (def-score solo-violin (:title "Violin Solo" :composer "OPMO" :copyright "Copyright © 2016 Opusmodus" :key-signature 'chromatic :time-signature (get-time-signature omn) :tempo 96 :layout (violin-layout 'vln)) (vln :omn omn :channel 1 :sound 'gm :program 'violin)) (display-midi 'solo-violin) ) -------------------------------------------------------------------------------------- length-chordize-map map pitch length &key unique otherwise seed [Function] Arguments and Values: map a list (<old><new>). pitch a list or lists of pitches length a list or lists of length. unique NIL or T (unique pitches in a chord). The default is T. otherwise an integer (chord size). The default is 1. seed NIL or an integer. The default is NIL. Description: LENGTH-CHORDIZE-MAP creates chords from a pitch series from a set of maps (<length> <chord-size>). (length-chordize-map '(1/8 2) '(c4 d4 e4 f4 g4 a4 b4) '(1/4 1/8 -1/8 1/16 1/16 1/16 -1/16 1/8 1/8 1/2)) => (c4 d4e4 f4 g4 a4 b4c4 d4e4 f4) Any length in a sequence that has not been mapped, a single note is used (default otherwise). Examples: In the preliminary examples the contents of a chromatic scale are chordized in a variety of different ways. Here the chord size 2 is activated to 1/8: (length-chordize-map '(1/8 2) '(c4 cs4 d4 ds4 e4 f4 fs4 g4 gs4 a4 bb4 b4 c5) '(1/8 1/16 1/16 -1/16 1/16 1/4 1/4 1/2)) => (c4cs4 d4 ds4 e4 f4 fs4 g4) Notice that the output is trimmed to the length of the rhythm. (length-chordize-map '((1/16 1) (1/8 (1 2))) '(c4 cs4 d4 ds4 e4 f4 fs4 g4 gs4 a4 bb4 b4 c5) '(1/8 1/16 1/16 -1/16 1/16 1/4 1/4 1/2)) => (c4cs4 d4 ds4 e4 f4 fs4 g4) Examples with length symbols: Here, otherwise is activated with chord size 3 on lengths that have not been mapped: (length-chordize-map '((s 1) (e (1 2))) '(c4 cs4 d4 ds4 e4 f4 fs4 g4 gs4 a4 bb4 b4 c5) (1/8 1/16 1/16 -1/16 1/16 1/4 1/4 1/2) :otherwise 3) => (c4cs4 d4 ds4 e4 f4fs4g4 gs4a4bb4 b4c5c4) In the following example the otherwise value is chosen at random: (length-chordize-map '((s 1) (e (1 2))) '(c4 cs4 d4 ds4 e4 f4 fs4 g4 gs4 a4 bb4 b4 c5) '(1/8 1/16 1/16 -1/16 1/16 1/4 1/4 1/2) :otherwise '(2 3)) => (c4cs4 d4 ds4 e4 f4fs4 g4gs4 a4bb4b4) Example with sublists: (setf pitches '((ds5 d5 g5 fs5 g5 g5 g5 c5 a5 fs5) (c5 g5 ds5 d5 fs5 a5 g5 as4 c5 d5) (ds5 as4 d5 a4 f5 ds5 f5 gs4 ds5 g4) (d5 g5 b4 f5 g5 ds5 f5 c5) (c5 ds5 as4 gs5 d5 f5 ds5 g4 gs4 f4 g5) (f5 c5 d5 b4 b4 ds5 g5 d5 c5))) (setf lengths '((s = e) (q) (s = q) (q.) (s = = = = = = =) (h) (e = q) (q. e))) (length-chordize-map '((s 1) (e 2)) pitches lengths :otherwise '(2 3)) => ((ds5 d5 g5fs5) (g5c5a5) (c5 a5 fs5c5g5) (ds5d5fs5) (a5 g5 as4 c5 d5 ds5 as4 d5) (a4f5ds5) (f5gs4 ds5g4 d5g5b4) (f5g5 ds5f5)) -------------------------------------------------------------------------------------- REVISED: length-map map length otherwise &key type seed [Function] Arguments and Values: map a list (<old><new>). sequence a proper sequence. otherwise an item, selected at random. swallow NIL or T. The default is NIL. type 'repeat or '? (at random). The default is '?. 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 at random. (length-map '((s c4fs4) (e f6g6 c6d6) (q (fs6g6 c6ds6))) '((q q h -s s s) (s e -q -q -e e -e s s h)) '(c4 cs4 fs4 g4)) => ((c6ds6 c6ds6 g4 c4fs4 c4fs4) (c4fs4 c6d6 c6d6 c4fs4 c4fs4 cs4)) Examples: (length-map '((e (spicc trem)) (s (pizz stacc)) (q (non-vib leg))) '(s = e h -s = e -q h q) '(harm tasto) :type 'repeat :seed 34) => (stacc stacc spicc tasto stacc spicc tasto non-vib) The swallow t (true) swallows items that align with rest-length values: (length-map '((e (spicc trem)) (s (pizz stacc)) (q (non-vib leg))) '(s = e h -s = e -q h q) '(harm tasto) :type 'repeat :seed 34 :swallow t) => (stacc stacc spicc tasto spicc tasto stacc stacc) Example with sublists: Mapping articulation to length. (setf length '((1/2 4/5 1/5 3/10 1/10) (5/16 1/16 1/2 3/16 1/8) (4/5 1/2 3/10 1/5 1/10) (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/10))) (length-map '(((1/40 1/10) (tas-stacc detache-short stacc)) ((3/20 1/3) (tas-detache detache-long)) ((7/20 13/20) (tas-sus dyn-me-novib-1.5s tas-trem)) ((2/3 7/6) (tas-sus pfp-vib-4s dyn-me-novib-3s)) ((5/4 7/4) (tas-sus sus-novib))) length '(tas-sus sus-novib) :type 'repeat) => ((tas-sus dyn-me-novib-3s detache-long detache-long stacc) (tas-detache detache-short tas-sus tas-detache sus-novib) (pfp-vib-4s tas-trem tas-detache tas-detache detache-short) (dyn-me-novib-1.5s detache-long detache-long sus-novib tas-stacc) (detache-short tas-sus detache-long sus-novib detache-long sus-novib detache-long tas-sus detache-short detache-short tas-sus) (tas-trem detache-long detache-long detache-short tas-sus detache-short detache-long detache-long tas-trem) (detache-short detache-long detache-long dyn-me-novib-1.5s pfp-vib-4s detache-long dyn-me-novib-1.5s pfp-vib-4s dyn-me-novib-1.5s detache-long detache-long) (tas-sus tas-detache tas-stacc tas-trem tas-detache) (tas-sus detache-long tas-sus stacc detache-long) (tas-trem dyn-me-novib-3s detache-short detache-long detache-long detache-long detache-long)) See MOTIF-MAP -------------------------------------------------------------------------------------- replace-map map sequence &key otherwise [Function] Arguments and Values: map a list. (<old><new>). sequence a proper sequence. otherwise NIL or an argument. The default is NIL. Description: REPLACE-MAP returns a copy of sequence in which each element that has been mapped is replaced with a new item. (replace-map '((1 a) (2 b) (3 c)) '(1 2 3 4 5 4 5 3 2 3)) => (a b c 4 5 4 5 c b c) (replace-map '((1 a) (2 b) (3 c)) '(1 2 3 4 5 4 5 3 2 3) :otherwise 'd) => (a b c d d d d c b c) Examples: The argument ((1 2) a) means number 1 and 2 will be replaced with a. (replace-map '(((1 2) a) ((3 4 5) b)) '(1 2 3 4 5 4 5 3 2 3)) => (a a b b b b b b a b) The otherwise keyword with an argument 'd replaces all items in the sequence with 'd which are not mapped. (replace-map '(((1 2) a) ((3 4 5) b) ((6 11) c)) '(( 1 2 3 4 5) (6 7 8 9 10 11)) :otherwise 'd) => ((d a a b b b) (c d d d d c)) See SUBSTITUTE-MAP -------------------------------------------------------------------------------------- Additional keyword time-signature in MERGE-VOICES The LENGTH-CHORDIZE-MAP replaced the chordize-to-length and chordize-to-length2 function.

The OMN decode and encode functions (not documented): (omn-encode '(s q e = = - -)) => (1/16 1/4 1/8 1/8 1/8 -1/8 -1/8) (omn-encode '(c4 = = =)) => (c4 c4 c4 c4) (omn-decode '(1/16 1/4 1/8 1/8 1/8 -1/8 -1/8)) => (s q e = = - -) What we need is a documentation of predicates etc... functions used in Opusmodus for developers and programmers. I hope we can add this part to our system with version 2.0

The substitute-motif function is MOTIF-MAP now, and will be released with few other new functions later today.

The LENGTH-WEIGHT functions is a good solution.

At the moment this is not possible. We will add this with next upgrade.

Opusmodus 1.1.1.8740 New macro IF* added to Opusmodus system. The IF* (public domain) macro used in Allegro: if* Arguments: (test-form {then then-form+ | thenret} {elseif else-test-form {then else-then-form+ | thenret}}* [else else-form+]) This form consists of a series of clauses introduced by the symbols then, elseif, else, and thenret. First the predicate test-form is evaluated. If it is true, the then-forms are evaluated, and the value of the last such form is returned. If test-form evaluates to nil, any remaining clauses are processed. If no clauses remain, if* returns nil. When a thenret clause is encountered no further evaluation takes place, and the value of the most recently evaluated test-form is returned. When an elseif clause is encountered, the predicate else-test-form is evaluated. If it is true, the else-then-forms are evaluated, and the value of the last such form is returned; otherwise any remaining clauses are processed. If no clauses remain, if* returns nil. And lastly, when an else clause is encountered, the else-forms are evaluated, and the value of the last such form is returned. Examples ;; The basic format of a IF* expression is: ;; ;; (if* [test] then [do this 1] [do this 2] else [do other 1] [do other 2]) ;; ;; When [test] is true, the forms after the THEN are evaluated and the ;; result of the last returned; if [test] if false, the forms after the ;; ELSE are evaluated and the result of the last is returned. ;; So: (if* (> 3 2) then "three is bigger" 3 else "three is smaller" 2) => 3 ;; Your do not need an ELSE form: (if* (> 3 2) then "three is bigger" 3) => 3 (if* (> 2 3) then "two is bigger" 2) => nil ;; You can have multiple fors after THEN or ELSE: (defun foo (x) (if* x then (setq y 2) (print x) else (setq y -2) "no")) (foo 2) => 2 (foo "hello") => "hello" "hello" (foo nil) => "no" ;; There are two more special symbols: THENRET and ELSEIF. ;; THENRET says when the test is true just return the value of the test ;; form just evaluated: (if* (+ 4 5) thenret) => 9 ;; ELSEIF introduces a new test, so you can have compound tests: (setq score 77) (if* (< score 60) then "F" elseif (< score 70) then "D" elseif (< score 80) then "C" elseif (< score 90) then "B" else "A") => "C" (setq score 55) (if* (< score 60) then "F" elseif (< score 70) then "D" elseif (< score 80) then "C" elseif (< score 90) then "B" else "A") => "F" (setq score 92) (if* (< score 60) then "F" elseif (< score 70) then "D" elseif (< score 80) then "C" elseif (< score 90) then "B" else "A") => "A"

New: gen-binary-series size number level &key rotate [Function] Arguments and Values: size an integer (list length). number an integer (decimal binary number). level an integer (the unit count). rotate an integer (1 forwards and -1 backwards). The default is 0. variant 'p (prime), 'r (retrograde), 'i (inversion) 'ri (retrograde inversion) and '? (at random). seed an integer or NIL. The default is NIL. Description: This function returns a binary list series of a given size. A random :seed may be given with variant arguments. This is a good function to use to create an instant beat/space rhythm as found in much traditional / world music. binary 1 = (1) with level 2 = (0 1) with internal retrograde = (1 0) (gen-binary-series 24 1 2) => (1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0) binary 2 = (1 0) with level 5 = (0 0 0 1 0) with internal retrograde = (0 1 0 0 0) (gen-binary-series 24 2 5) => (0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0) Examples: (gen-binary-series 24 1 '(3 2 4)) => ((1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0) (1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0) (1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0)) (gen-binary-series 24 '(1 3 4) '(3 5 4) :rotate -2) => ((0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0) (0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 1 1) (1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0)) (gen-binary-series '(8 12 16) '(1 3 4) '(3 5 4) :rotate '(1 -1 0)) => ((0 1 0 0 1 0 0 1) (1 0 0 0 1 1 0 0 0 1 1 1) (0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0)) Example with variant option: (gen-binary-series '(8 12 16) '(1 3 4) '(3 5 4) :rotate '(1 -1 0) :variant '? :seed 786) => ((0 1 0 0 1 0 0 1) (1 0 0 0 1 1 0 0 0 1 1 1) (1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1)) (gen-binary-series '(8 12 16) '(1 3 4) '(3 5 4) :rotate '(1 -1 0) :variant '(? r ri) :seed 786) => ((0 1 0 0 1 0 0 1) (1 1 1 0 0 0 1 1 0 0 0 1) (1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1)) (setf bin (gen-binary-series '(8 8 8 8 8 8 8 8) '(1 2 3) '(3 3 4) :variant '? :seed 62)) => ((1 0 0 1 0 0 1 0) (1 0 0 1 0 0 1 0) (0 0 1 1 0 0 1 1) (0 1 0 0 1 0 0 1) (0 1 0 0 1 0 0 1) (1 1 0 0 1 1 0 0) (0 1 1 0 1 1 0 1) (0 1 1 0 1 1 0 1)) Mapping the bin variable to lengths with BINARY-MAP function: (binary-map bin 's :omn t) => ((s - - = - - = -) (s - - = - - = -) (-s - = = - - = =) (-s = - - = - - =) (-s = - - = - - =) (s = - - = = - -) (-s = = - = = - =) (-s = = - = = - =)) ------------------------------------------------------------- And fix to GEN-REPEAT-SEQ (gen-repeat-seq 12 1 3 '(c4 cs4 d4 ds4)) => (c4 c4 c4 cs4 cs4 cs4 d4 d4 ds4 ds4 ds4 c4)

Done. The final function: ;; ------------------------------------------------------------------------- ;; gen-binary-series ;; ------------------------------------------------------------------------- (defun gen-binary-series (size number level &key rotate variant seed) (do-verbose ("gen-binary-series") (rnd-seed seed) (flet ((binary-series (size number level &key rotate) (let* ((binary (reverse (binary-level number level))) (out (gen-trim* size binary))) (if rotate (gen-rotate rotate out) out)))) (let* ((size (list! size)) (number (list! number)) (level (list! level)) (len (find-max (mapcar 'length (list size number level)))) (series (mapcar #'(lambda (a b c d) (binary-series a b c :rotate d)) (gen-trim* len size) (gen-trim* len number) (gen-trim* len level) (gen-trim* len (list! rotate)))) (out (if (and (listsp series) (< 1 (length series))) series (car series)))) (if variant (binary-variant out variant :seed (seed)) out))))) (gen-binary-series 24 1 2) => (1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0) (gen-binary-series 24 1 '(3 2 4)) => ((1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0) (1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0) (1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0)) (gen-binary-series 24 '(1 3 4) '(3 5 4) :rotate -2) => ((0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0) (0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 1 1) (1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0)) (gen-binary-series '(8 12 16) '(1 3 4) '(3 5 4) :rotate '(1 -1 0)) => ((0 1 0 0 1 0 0 1) (1 0 0 0 1 1 0 0 0 1 1 1) (0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0)) (gen-binary-series '(8 12 16) '(1 3 4) '(3 5 4) :rotate '(1 -1 0) :variant '? :seed 786) => ((0 1 0 0 1 0 0 1) (1 0 0 0 1 1 0 0 0 1 1 1) (1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1)) (gen-binary-series '(8 12 16) '(1 3 4) '(3 5 4) :rotate '(1 -1 0) :variant '(? r ri) :seed 786) => ((0 1 0 0 1 0 0 1) (1 1 1 0 0 0 1 1 0 0 0 1) (1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1)) Added variant as well.

I agree Rangarajan, the BINARY-SERIES it is something else but is inspired from your solution.

Sorry Julio but I don't understand what you are looking for. Could you show we the output you are looking for.

Good result indeed (score). I like your coding stile and your knowledge of lisp. The only problem here is that we can end with NIL. I don't have the book therefore I can comment on possible solution to avoid the NIL result. In theory - I think - we could make something like: (defun binary-series (size number &key rotate) (let* ((binary (decimal-to-binary number)) (out (gen-repeat size binary))) (if rotate (gen-rotate rotate out) out))) (binary-series 22 4) => (1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0) Other possibility (flexibility): (defun binary-series (size number level &key rotate) (let* ((binary (reverse (binary-level number level))) (out (gen-repeat size binary))) (if rotate (gen-rotate rotate out) out))) (binary-series 8 1 2) => (1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0) (binary-series 8 1 3) => (1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0 1 0 0) (binary-series 8 1 4) => (1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0) (binary-series 8 3 4) => (1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0) (binary-series 8 3 6) => (1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0) I will add the BINARY-SERIES function to our system with few more options. Thank you Rangarajan for the inspiration.

Thank you.

Indeed, this is a document error. Thank you for the report. Version 1.1.18705 fixed the docs.

(defun gen-length-div (length values &key omn) (prog (elem out) (setf length (omn-encode length)) loop (cond ((null values) (return (maybe-omn-decode omn (nreverse out))))) (setf elem (gen-repeat (car values) (/ length (car values)))) (setf out (cons elem out)) (setf values (cdr values)) (go loop))) (gen-length-div 'w '(1 2 4 8 16) :omn t) => ((w) (h =) (q = = =) (e = = = = = = =) (s = = = = = = = = = = = = = = =)) (gen-length-div 'w '(2 3 4 5 8) :omn t) => ((h =) (3w = =) (q = = =) (5w = = = =) (e = = = = = = =)) Other possibility: (ql '(1 w 2 h 4 q 8 e 16 s)) => (w h = q = = = e = = = = = = = s = = = = = = = = = = = = = = =)

Please check the documentation. (gen-length ds-i2 8) => (1/2 1/4 1/4 1/2 1/4 1/8 1/8 1/4 1/4 1/8 1/8 1/4 1/2 1/4 1/4 1/2) or (gen-length ds-i2 '(8 8 8 8)) => ((1/2 1/4 1/4 1/2) (1/4 1/8 1/8 1/4) (1/4 1/8 1/8 1/4) (1/2 1/4 1/4 1/2))

All this you do in the tempo section (DEF-SCORE). ;; Tempo (setf tempo-events '(("Sehr mäßig" e. 40 16) (:rit 40 26 1/64 2) (40 1) (:rit 40 26 1/64 3) (40 1) (:rit 40 26 1/64 1) (40 1) (:rit 40 26 1/64 1) (40 1) (:rit 40 26 1/64 1) (40 1) (:rit 40 26 1/64 1) (40 1) (:rit 40 26 1/64 1) (40 1) (:rit 40 26 1/64 1) (40 5) (:rit 40 24 1/64 5) (40 11) (:rit 40 26 1/64 2) (40 3) (:rit 40 26 1/64 2) (40 1) (:rit 40 20 1/64 3))) Doing this directly with length values we would get values which are not possible to notate. Maybe the GEN-ACCUMULATE function can do what you are looking for: (gen-accumulate '(1/32) :count 12) => (1/32 1/16 3/32 1/8 5/32 3/16 7/32 1/4 9/32 5/16 11/32 3/8)

New: rnd-12tone-form n row &key type seed [Function] Arguments and Values: n an integer (number of forms). row a 12-tone row. type :integer or :pitch. The default is :integer. seed NIL or an integer. The default is NIL. Description: This function returns N lists of 12-tone forms selected at random. (rnd-12tone-form 2 '(0 4 9 10 5 3 8 7 1 2 11 6) :seed 56) => ((6 1 10 11 5 4 9 7 2 3 8 0) (8 3 0 1 7 6 11 9 4 5 10 2)) (rnd-12tone-form 2 '(0 4 9 10 5 3 8 7 1 2 11 6) :type :pitch :seed 56) => ((fs4 cs4 bb4 b4 f4 e4 a4 g4 d4 eb4 gs4 c4) (gs4 eb4 c4 cs4 g4 fs4 b4 a4 e4 f4 bb4 d4)) Example: ;;;--------------------------------------------------------- ;;; SCORE EXAMPLE ;;;--------------------------------------------------------- (progn (setf forms (rnd-12tone-form 24 (rnd-row :transpose 6))) (setf pitch (integer-to-pitch forms)) (setf mat (gen-chord2 200 (rnd-sample 12 '(1 2)) (flatten pitch))) (setf vel (substitute-map '(ppp ppp pp pp p p f f ff ff fff fff) '(0 1 2 3 4 5 6 7 8 9 10 11) forms)) (setf fib (rnd-sample 16 (fibonacci 10 18))) (setf l1 (binary-rhythm '(16 20 32) fib '(1/16 1/20 1/32) :type (rnd-sample 12 '(1 2)) :rotate (rnd-sample 12 '(0 1 -1 2 -2)))) (setf l2 (binary-rhythm '(28 16 12) fib '(1/28 1/16 1/12) :type (rnd-sample 12 '(1 2 3)) :rotate (rnd-sample 12 '(0 1 -1 2 -2)))) (setf cd-p (distribute-seq mat l1 l2)) (setf cd-v (distribute-seq vel l1 l2)) (setf p1 (randomize-octaves 'piano (1~ cd-p))) (setf p2 (randomize-octaves 'piano (2~ cd-p))) (setf v1 (1~ cd-v)) (setf v2 (2~ cd-v)) (setf in1 (make-omn :length l1 :pitch p1 :velocity v1)) (setf in2 (make-omn :length l2 :pitch p2 :velocity v2)) (setf tempo (gen-tempo '(32 88 72 56 96) '(1) l1 :beat 1/1)) (def-score form-dist (:title "Form Distribution" :copyright "(c) 2016 Opusmodus" :composer "OPMO" :key-signature 'chromatic :time-signature '(8 8) :tempo tempo :layout (grand-layout '(in1 in2))) (in1 :omn in1 :channel 1 :sound 'gm :program 0) (in2 :omn in2 :channel 2 :sound 'gm :program 0) ) ) --------------------------------------------------------- get—12tone-form row form &key type [Function] Arguments and Values: row a 12-tone row. form a form or list of forms. type :integer or :pitch. The default is :integer. Description: The function GET-12TONE-FORM returns 12-tone row of a given form. Forms: Prime: P 0-11 Inversion: I 0-11 Retrograde: R 0-11 Retrograde Inversion: RI 0-11 (get-12tone-form '(0 4 9 10 5 3 8 7 1 2 11 6) 'r7) => (1 6 9 8 2 3 10 0 5 4 11 7) (get-12tone-form '(0 4 9 10 5 3 8 7 1 2 11 6) 'r7 :type :pitch) => (cs4 fs4 a4 gs4 d4 eb4 bb4 c4 f4 e4 b4 g4) Example: (get-12tone-form '(0 4 9 10 5 3 8 7 1 2 11 6) '(r5 p4 ri3)) => ((11 4 7 6 0 1 8 10 3 2 9 5) (4 8 1 2 9 7 0 11 5 6 3 10) (9 4 1 2 8 7 0 10 5 6 11 3)) (get-12tone-form (rnd-row) '(p0 r9 i3 ri5)) => ((0 9 5 4 2 3 7 10 11 6 1 8) (5 10 3 8 7 4 0 11 1 2 6 9) (3 6 10 11 1 0 8 5 4 9 2 7) (9 4 11 6 7 10 2 3 1 0 8 5)) --------------------------------------------------------- Renamed functions: CONSECUTIVE-DISTRIBUTE -> DISTRIBUTE-SEQ CONSECUTIVE-COLLECT -> COLLECT-SEQ And minor bug fixes. JP

Another great orchestral template example in action, very inspiring :-)

GET-TIME-SIGNATURE bug fix.

The bug will be fixed soon. As for the MERGE-VOICES function I would use it with simple lengths and with 2 voices max.