opmo

New length rewrite in OM update (coming soon):
 
(7/20 7/20 3/10 3/10)  

New length rewrite in OM update (coming soon):
 
(7/20 7/20 3/10 3/10)  

New length rewrite in OM update (coming soon):
 
(7/20 7/20 3/10 3/10)  

time-point-system pitch length &key type start mod pcs variant
                      (denominator 4) time-signature seed
 
[Function]
 
Arguments and Values:
 
pitch                    a pitch list or lists of pitches.
length                  a length or list of lengths (length symbol or ratio).
type                            integers: 1 or 2. (Type of time point system). The default is 1.
start                          integers: from 0 to 11 or ’? (at random). The default is the first integer in the pitch list.
mod                         an integer, the default is 12.
variant                    'o (origin), 'r (retrograde), 'i (invert), 'ri (retrograde-invert), or '? (at random).
pcs                   pitch class set: 'n (normal order), 'r (retrograde), 'i (inversion). The default is NIL.
denominator           an integer. The default is 4 (list round up to given time signature measure). 
time-signature    time-signature measures. The default is '(3 4).
seed                            NIL or an integer (random seed). The default is NIL.
 
Description:
 
The Time Point System was first developed by Milton Babbitt and is based on two principles: 1. The relationships in a pitch system are transferred in totality to the sphere of time relations. 2. This transfer is accomplished through the linkage of one simple equivalence - that of time intervals corresponding to pitch intervals.
 
There are two types of the time point system.
The type 1 is based on Milton Babbitt system
The type 2 is based purely on modus 12: 0=1, 1=2, 2=3,  … 11=12
 
Type 1:
 
(setf pitch1 '(f4 a4 gb4 ab4 e5 g4 db5 bb4 d4 c5 eb5 b4))
(setf pitch2 '((b4 d5 fs5) (d4 f4 a4)))
 
(time-point-system pitch1 's)
=> ((-q -s e. f4 tie s f4 e. a4 tie)
    (q a4 tie e a4 fs4 q gs4 tie)
    (q gs4 e. e5 q g4 tie s g4 tie)
    (s g4 h cs5 tie s cs5 e bb4 tie)
    (e bb4 h d4 tie e d4)
    (e. c5 s eb5 tie q eb5 tie e. eb5 s b4))
 
(time-point-system pitch1 's :start 0)
=> ((q f4 h a4 tie)
    (s a4 e fs4 s gs4 tie q gs4 tie e. gs4 s e5 tie)
    (e e5 q. g4 q cs5 tie)
    (q cs5 tie s cs5 e. bb4 tie s bb4 e. d4 tie)
    (q d4 tie e. d4 s c5 tie e c5 eb5 tie)
    (q eb5 tie e eb5 q. b4))
 
(time-point-system pitch1 's :start '? :seed 34)
=> ((-e. s f4 tie e. f4 q a4 tie s a4 tie)
    (q a4 e fs4 q. gs4 tie)
    (e gs4 e5 tie s e5 e. g4 tie g4 s cs5 tie)
    (h cs5 q bb4)
    (h d4 tie e d4 c5 tie)
    (s c5 e. eb5 tie q eb5 tie s eb5 e. b4))
 
(time-point-system pitch1 's :mod 6)
=> ((-q -s q.. f4 tie)
    (e. f4 h a4 tie s a4)
    (e fs4 gs4 h e5 tie)
    (s e5 g4 e cs5 tie s cs5 q.. bb4 tie)
    (e. bb4 h d4 tie s d4 tie)
    (s d4 e. c5 e eb5 q. b4 tie)
    (s b4))
 
(time-point-system pitch1 's :mod 6 :start 0)
=> ((h f4 tie e f4 a4 tie)
    (q a4 tie e. a4 s fs4 tie fs4 e gs4 s e5 tie)
    (h e5 s g4 e. cs5)
    (h bb4 tie e bb4 d4 tie)
    (h d4 e. c5 s eb5 tie)
    (s eb5 h b4 tie e. b4 tie)
    (s b4))
 
(time-point-system pitch1 's :mod 6 :start 2)
=> ((-e h f4 tie e f4)
    (h a4 tie s a4 e fs4 s gs4 tie)
    (s gs4 h e5 tie s e5 g4 cs5 tie)
    (e cs5 h bb4 tie e bb4)
    (h d4 tie e d4 c5 tie)
    (s c5 e eb5 h b4 tie s b4 tie)
    (s b4))
 
(time-point-system pitch2 's)
=> ((-h -e. s b4 tie)
    (e b4 d5 tie d5 q. fs5)
    (-e d4 tie s d4 e. f4 tie s f4 e. a4))
 
(time-point-system pitch2 's :start 0)
=> ((e. b4 s d5 tie e. d5 q fs5 tie s fs5)
    (e. d4 s f4 tie e. f4 q a4 tie s a4))
 
(time-point-system pitch2 's :start '? :seed 34)
=> ((e. b4 s d5 tie e. d5 q fs5 tie s fs5)
    (-h -e d4 tie)
    (s d4 e. f4 tie s f4 q.. a4))
 
(time-point-system pitch2 's :mod 6)
=> ((-q -s q.. b4 tie)
    (e b4 h d5 tie e d5)
    (h. fs5)
    (-e d4 tie s d4 q.. f4 tie)
    (e. f4 h a4 tie s a4))
 
(time-point-system pitch2 's :mod 6 :start 0)
=> ((h b4 tie s b4 e. d5 tie)
    (q d5 tie e. d5 q fs5 tie s fs5)
    (e. d4 h f4 tie s f4 tie)
    (s f4 h a4 tie e. a4))
 
(time-point-system pitch2 's :mod 6 :start '(0 2))
=> ((h b4 tie s b4 e. d5 tie)
    (q d5 tie e. d5 q fs5 tie s fs5)
    (-e d4 tie s d4 q.. f4 tie)
    (e. f4 h a4 tie s a4))
 
 
Type 2:
 
(time-point-system pitch1 's :type 2)
=> ((q f4 tie e f4 q. a4 tie)
    (q a4 fs4 tie e. fs4 s gs4 tie)
    (h gs4 q e5 tie)
    (s e5 e. g4 tie q g4 tie s g4 e cs5 s bb4 tie)
    (q bb4 tie bb4 tie e bb4 d4 tie)
    (s d4 c5 e eb5 tie eb5 q. b4 tie)
    (q b4 tie e b4))
 
(time-point-system pitch1 's :type 2 :start 0)
=> ((s f4 q a4 tie s a4 e fs4 q gs4)
    (h. e5)
    (e. g4 h cs5 tie s cs5)
    (q bb4 tie e bb4 q. d4 tie)
    (q d4 h c5)
    (h eb5 tie e. eb5 s b4 tie)
    (q b4 tie e b4))
 
(time-point-system pitch1 's :type 2 :start '? :seed 34)
=> ((q f4 h a4)
    (q fs4 tie s fs4 q.. gs4)
    (e. e5 s g4 tie q g4 tie s g4 e. cs5 tie)
    (q cs5 tie cs5 tie s cs5 e. bb4 tie)
    (q bb4 tie e bb4 s d4 q c5 tie s c5 tie)
    (q c5 tie e c5 eb5 q b4 tie)
    (q b4 tie e b4))
 
(time-point-system pitch1 's :type 2 :mod 6)
=> ((q f4 tie e f4 a4 tie a4 s fs4 gs4 tie)
    (e gs4 q e5 tie s e5 g4 tie g4 e cs5 s bb4 tie)
    (q bb4 e. d4 s c5 q eb5)
    (q b4 tie e b4))
 
(time-point-system pitch1 's :type 2 :mod 6 :start 0)
=> ((s f4 h a4 tie e. a4)
    (h fs4 q gs4 tie)
    (q gs4 tie e gs4 q. e5 tie)
    (q e5 tie e e5 q. g4 tie)
    (e. g4 h cs5 tie s cs5)
    (h. bb4)
    (h d4 tie e d4 c5 tie)
    (q c5 tie e c5 q. eb5 tie)
    (q eb5 tie s eb5 b4))
 
(time-point-system pitch1 's :type 2 :mod 6 :start 2)
=> ((e. f4 s a4 h fs4 tie)
    (e fs4 h gs4 tie e gs4 tie)
    (e gs4 e5 h g4 tie)
    (e. g4 h cs5 tie s cs5 tie)
    (e cs5 bb4 h d4 tie)
    (q d4 h c5 tie)
    (e c5 s eb5 b4 tie e b4))
 
(time-point-system pitch2 's :type 2)
=> ((h. b4)
    (e. d5 s fs5 tie q fs5 tie e fs5 d4 tie)
    (s d4 e. f4 tie f4 q a4 tie s a4 tie)
    (q a4 tie s a4))
 
(time-point-system pitch2 's :type 2 :start 0)
=> ((s b4 e. d5 tie s d5 q.. fs5 tie)
    (s fs5 d4 e f4 tie f4 q. a4 tie) (e a4))
 
(time-point-system pitch2 's :type 2 :start '? :seed 34)
=> ((s b4 e. d5 tie s d5 q.. fs5 tie)
    (s fs5 h d4 tie e. d4) (e f4 q. a4))
 
(time-point-system pitch2 's :type 2 :mod 6 :start 0)
=> ((s b4 h d5 tie e d5 s fs5 tie)
    (q fs5 tie e. fs5 s d4 q f4) (e a4))
 
(time-point-system pitch2 's :type 2 :mod 6 :start '(0 2))
=> ((s b4 h d5 tie e d5 s fs5 tie)
    (q fs5 tie e. fs5 s d4 tie e d4 f4 tie)
    (q f4 a4))
 
Mixing types:
 
(setf pitch3 '((e4 a4 fs4 d4) (f4 b4 c4 bb4) (eb4 ab4 db4 g4)))
 
(time-point-system pitch3 's :type '(2 1 1))
=> ((q e4 tie s e4 q.. a4 tie)
    (e. a4 s fs4 tie q fs4 tie e fs4 d4 tie)
    (s d4 -e. -s -s q. f4)
    (s b4 h c4 tie e c4 s bb4 tie)
    (s bb4 -e. q eb4 tie s eb4 e. gs4 tie)
    (e gs4 q. cs4 q g4 tie)
    (s g4))
 
With :time-signature keyword:
 
(setf pitch4
      (row-group-combination
       4 '(6 6) '(6 6) '(0 1 2 3 4 5 6 7 8 9 10 11) :type :pitch))
=> ((f4 e4 eb4 d4 cs4 c4) (b4 bb4 a4 gs4 g4 fs4))
 
(time-point-system pitch4 's)
=> ((-q -s q.. f4 tie)
    (q f4 h e4 tie)
    (e. e4 h eb4 tie s eb4 tie)
    (e eb4 h d4 tie e d4 tie)
    (s d4 h cs4 tie e. cs4)
    (h. c4)
    (-h -e. s b4 tie)
    (q b4 tie b4 tie e b4 bb4 tie)
    (q bb4 tie bb4 tie s bb4 e. a4 tie)
    (h a4 q gs4 tie)
    (q gs4 tie e. gs4 q g4 tie s g4 tie)
    (q g4 tie e g4 q. fs4))
 
(time-point-system pitch4 's :type '(1 2))
=> ((-q -s q.. f4 tie)
    (q f4 h e4 tie)
    (e. e4 h eb4 tie s eb4 tie)
    (e eb4 h d4 tie e d4 tie)
    (s d4 h cs4 tie e. cs4)
    (h. c4)
    (h. b4)
    (h bb4 tie e. bb4 s a4 tie)
    (q a4 tie a4 tie s a4 e. gs4 tie)
    (q gs4 tie e gs4 q. g4 tie)
    (e g4 fs4 tie q fs4 tie s fs4))
 
With :mod keyword:
 
(setf pitch5 '((eb4 f4 fs4 a4 c4) (bb4 c4 eb4 e4 f4)))
 
(time-point-system pitch5 '(s t) :type '(2 1) :mod '(3 4))
=> ((s eb4 e. f4 s fs4 a4 c4 -s q bb4 tie)
    (s bb4 s. c4 q eb4 tie t eb4 e4 q f4 tie t f4 tie)
    (s f4))
 
With :pcs keyword:
 
(time-point-system pitch5 '(s t) :mod '(3 4) :pcs '(i r))
=> ((h eb4 tie e eb4 f4)
    (s fs4 a4 h c4 tie e c4 tie)
    (e c4 s. bb4 q c4 tie t c4 tie s c4 e. eb4 tie)
    (e eb4 tie t eb4 q e4 tie s. e4 q f4 tie)
    (e f4))
 
Example:
 
With chords:
 
(setf clusters
      (gen-loop
       3
       (flatten
        (gen-cluster '(3 4 2 3)
                     :type 'c
                     :transpose (rnd-sample 4 (gen-integer -12 12))))
       :seed 3568))
      
(time-point-system clusters 's)
=> ((-h -s e. a4bb4b4 tie)
    (e. a4bb4b4 h eb3e3f3fs3 tie s eb3e3f3fs3)
    (s c3cs3 h c3cs3d3 tie e. c3cs3d3 tie)
    (s c3cs3d3 -s cs4d4eb4 cs4d4eb4e4 e. d3eb3 q f4fs4g4 tie s f4fs4g4 tie)
    (e f4fs4g4 -e -s q.. eb3e3f3 tie)
    (e eb3e3f3 c5cs5d5eb5 q d4eb4 fs4g4gs4 tie)
    (e fs4g4gs4))
 
L-SYSTEM with TIME POINT SYSTEM:
 
(defclass exp (l-system)
  ((axiom :initform '(c4 b3 ab3 bb3 a3 ab4))
   (depth :initform 3)))
 
(defmethod l-productions ((ls exp))
  (choose-production ls
                     (c4  (--> - + b3))
                     (b3  (--> ab3 + bb3))
                     (ab3 (--> bb3 a3))
                     (bb3 (--> a3 gb3 c4))
                     (a3  (--> gb3 + c4 -))
                     (ab4 (--> gb3 - + b3))))
 
(time-point-system
 (gen-divide 4 (pitch-lsystem 'exp :depth 3))
 's :type '(1 2 1 1 2))
 
=> ((-h -e bb3 tie)
    (q bb3 tie bb3 tie s bb3 a3 e bb3 tie)
    (q bb3 tie e. bb3 q g3 tie s g3)
    (e cs4 h bb3 tie e bb3 tie)
    (s bb3 e. g3 tie q g3 tie s g3 e cs4 -s)
    (-q -e q. g3 tie)
    (s g3 e. d4 tie d4 q gs3 tie s gs3 tie)
    (e gs3 h eb4 tie s eb4 -s)
    (-q -e. q gs3 tie s gs3)
    (q cs4 tie e. cs4 q gs3 tie s gs3 tie)
    (e gs3 h eb4 tie s eb4 gs3 tie)
    (h gs3 e cs4 gs3 tie)
    (q gs3 tie e. gs3 s d4 tie e d4 -e)
    (-q -e q. gs3)
    (q d4 tie e d4 gs3 bb3 cs4)
    (h a3 tie e a3 s c4 eb4 tie)
    (e. eb4 -h -s)
    (-s e. bb3 tie s bb3 q.. d4 tie)
    (q d4 s cs4 q.. d4 tie)
    (e. d4 -h -s)
    (-e q. b3 q f4 tie)
    (e. f4))

For software development, we have requirement gathering tools, UML-like modelling tools, Design Patterns, IDEs for programming, and even software Testing tools. When it comes to music composition, if you are manually composing music, there are tools such as "Finale" for notating, or you can fall back on the ubiquitous "paper" for expressing your composition. On the other hand, if you use algorithmic composition, we have many tools such as Opusmodus, Open Music, SuperCollider, Max/MSP, and so on. I think what is missing, and what I feel is important, is a way to represent intermediate stages of composition, which is really the creative part. Just as in software development we say the design is more important than the final code, we should be able to independently study, understand and critique the compositional design of a musician. In fact, it might even be possible to automatically generate executable code from this intermediate design representation (just as in simple cases, UML design can be converted to code in any language). So what I am really proposing is to come up with a "Music Design Notation" for algorithmic composition. When I listen to some of Stephane's pieces, they sound good, but when I look at his code, his "design" insight is not obvious. This is true for any non-trivial program. On the other hand, if there was a MDN representation of his work, it might be easier to understand what is going on. Whether your final piece is rendered on paper, or Finale, or in Opusmodus, there is a great benefit to documenting the "higher" level design of the composition. Then we can even talk about "Design Patterns" in musical composition in a programming language-neutral way.
 
For those of you who do not come from software background, I encourage you to read the works of Christopher Alexander, especially, "The Timeless Way of Building" (Oxford University Press, 1979).
 
I have had this on my mind for a long time, so thought I will post it to see what others think.
 
Regards,
Rangarajan

Nice and very realistic!
 
Do you have a video of this session, and if you do, is it possible to share it?
 
-Rangarajan

Yes, I have also experienced this difficulty, for example, can't distinguish between 4/4 and 2/2 because both reduce to 1! As JP points out, this is a Lisp issue, nothing to do with OM. If we are adventurous, we could implement our own "data type", for example keeping numerator and denominator separately as a cons pair (numerator . denominator) or something similar. We can write a set of functions that operate on this, and then apply reduction when actually needed. More work, of course, but Lisp gives you control.
 
Regards,
Rangarajan

Hi,
Picat is a Prolog-derived language with good support for Constraint Programming. In today's blog, I have shown how to implement a simple CP-based function in Picat for chord/non-chord tone generation, and more interestingly, how we can interact with Picat from Opusmodus to get the results of the computation.
 
To me, this opens up new possibilities for expanding what you can do from Opusmodus!
 
Regards,
Rangarajan

"hysterical" with a value-list = multiple states :-)
 
;;;; SUBFUNCTIONS (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))))) (weighted-t/nil 0.5) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; MAINFUNCTION (defun binary-hysteresis-1.2 (&key number-of-values (value-list '((0 1) (4 0) (0 1) (4 7))) (start-weight 0.1) (sensitivity 0.02) (static 1.0)) (loop repeat number-of-values with weight = start-weight with cnt1 = 0 with cnt-v = 0 when (equal (weighted-t/nil weight) 'nil) collect (first (nth cnt-v value-list)) else collect (second (nth cnt-v value-list)) and do (incf cnt1) when (= cnt1 3) do (setq weight (+ weight sensitivity) cnt1 0) when (> weight static) do (incf cnt-v) and do (setq weight start-weight) when (= cnt-v (length value-list)) do (setq cnt-v 0))) ;;example (length-list-plot (binary-hysteresis-1.2 :number-of-values 600 :start-weight 0.1 :sensitivity 0.05 :value-list '((0 1) (10 2) (7 3)) :static 2.0))  

Dear Dago, there are many priorities but the colorisation is on my list.

;;; ------------------------------------------------------------------------------ ;;; GEN-PITCH-LINE ;;; Pitch generation function based on noise vectors conversion with a large choice of ;;; types of noises, compress ratio for the vector, filtering repetitions and ambitus. (defun gen-pitch-line (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat (type :white)) (do-verbose ("gen-pitch-line") (rnd-seed seed) (labels ((white (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat type) (if filter-repeat (gen-trim nb-pitch (filter-repeat filter-repeat (vector-to-pitch ambitus (vector-smooth compress (gen-white-noise nb-pitch :seed seed :type type))))) (vector-to-pitch ambitus (vector-smooth compress (gen-white-noise nb-pitch :seed seed :type type))))) (pink (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat) (if filter-repeat (gen-trim nb-pitch (filter-repeat filter-repeat (vector-to-pitch ambitus (vector-smooth compress (gen-pink-noise nb-pitch :seed seed))))) (vector-to-pitch ambitus (vector-smooth compress (gen-pink-noise nb-pitch :seed seed))))) ) (cond ((equal type ':white) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :normal)) ((equal type ':binary) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :binary)) ((equal type ':cauchy) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :cauchy)) ((equal type ':chi-square-2) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :chi-square-2)) ((equal type ':double-exponential) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :double-exponential)) ((equal type ':exponential) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :exponential)) ((equal type ':extreme) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :extreme)) ((equal type ':gaussian) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :gaussian)) ((equal type ':logistic) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :logistic)) ((equal type ':lognormal) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :lognormal)) ((equal type ':triangular) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :triangular)) ((equal type ':low-pass) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :low-pass)) ((equal type ':high-pass) (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :high-pass)) ((equal type ':pink) (pink nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed))))))) #| USAGE (gen-pitch-line 24 :compress 0.42 :type :white :filter-repeat 1) (gen-pitch-line 24 :compress 0.42 :type :pink :filter-repeat 1) (gen-pitch-line 24 :compress 0.42 :type :extreme :filter-repeat 1) (gen-eval 8 '(make-omn :pitch (gen-pitch-line 24 :compress 0.42 :type :white :filter-repeat 1) :length (euclidean-rhythm 16 1 16 's :type 2) ) :seed 33) |# ;;; ------------------------------------------------------------------------------ SB.

SB,
Thanks. Useful function, I am sure.
 
Thought I could re-write the function slightly differently, hope you don't mind:
(defun gen-pitch-line2 (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat (type :white)) (let (pitches) (do-verbose ("gen-pitch-line2") (rnd-seed seed) (labels ((white-or-pink (nb-pitch seed type) (if (eq type ':pink) (gen-pink-noise nb-pitch :seed seed) (gen-white-noise nb-pitch :seed seed :type (if (eq type ':white) :normal type)))) (process (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat type) (setf pitches (vector-to-pitch ambitus (vector-smooth compress (white-or-pink nb-pitch seed type)))) (when filter-repeat (setf pitches (gen-trim nb-pitch (filter-repeat filter-repeat pitches)))) pitches) ) (process nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type type)))))  
I hope I haven't messed up the logic!
 
Regards,
Rangarajan

Hi,
In today's blog post, I have shared some basic ideas about the Screamer Lisp library, with examples of how to start using it for constraint programming. The inspiration came from some earlier posts in OM forum on this topic. It was an exciting exercise and learnt a few interesting things!
 
Regards,
Rangarajan

Fix GET-TIME-SIGNATURE (spacial case with repeat and ends) and ASSEMBLE-SUBSEQ.

Welcome back 
 
Quick Note:
(setf wholetone-scale (gen-repeat 4 (list (make-scale 'c4 5 :alt '(2) :type :pal))))  
(setf my-tonality1       (tonality-series        '(maj)        :root '(c4)        :closest '(down up))) ;;only 'down is used (1 tonality) => ((maj :root c4 :ambitus piano :closest down)) (tonality-map my-tonality1 wholetone-scale) => ((c4 c4 e4 g4 g4 g4 e4 c4 c4)  ;down     (c4 c4 e4 g4 g4 g4 e4 c4 c4)  ;down     (c4 c4 e4 g4 g4 g4 e4 c4 c4)  ;down     (c4 c4 e4 g4 g4 g4 e4 c4 c4)) ;down  
The count of the tonalities determines the number of tonality changes (loop).
(setf my-tonality2       (tonality-series        '(maj maj)        :root '(c4)        :closest '(down up))) => ((maj :root c4 :ambitus piano :closest down)     (maj :root c4 :ambitus piano :closest up)) (tonality-map my-tonality wholetone-scale) ((c4 c4 e4 g4 g4 g4 e4 c4 c4)  ;down  (c4 e4 e4 g4 g4 g4 e4 e4 c4)  ;up  (c4 c4 e4 g4 g4 g4 e4 c4 c4)  ;down  (c4 e4 e4 g4 g4 g4 e4 e4 c4)) ;up  
We could make the function to determine the tonality count based on the count values of any of the tonality-form keywords values (max).
Example:
(setf my-tonality3       (tonality-series        '(maj)        :root '(c4)        :closest '(down up up down))) => ((maj :root c4 :ambitus piano :closest down) (maj :root c4 :ambitus piano :closest up) (maj :root c4 :ambitus piano :closest up) (maj :root c4 :ambitus piano :closest down))  

SB,
Sorry for hijacking your thread! 
 
Nice piece at the top and we are starting to discuss other things. 
On the other hand it is a good thing when music touch you and make you feel and think.
 
Good day

We will make even better :-)

Lasse, i write many many unfinished Bits and pieces, and in past almost only that. 
Long time ago, when speaking with a friend, i said i never finish my piece but i said it was not to important because it was only training, but this friend reply: i understand but finishing a piece is also a training and finishing a piece is a different training than starting a piece....
From this day and discussion with that friend, i have started to finish some of my pieces :-)
 
SB.

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))  

;; gen-hoquetus.4 https://en.wikipedia.org/wiki/Hocket ;;; andré meier / 27-4-2016 ;;; write a instrumentation-list (instrument + techniques + velocity), pitch-list ;;; and length-list. the gen-hoquetus-function will split the melody ;;; off... in any possibilities, techniques/articulations/velocities will be added ;;; this is only a function i coded for my actual work... perhaps you could use ;;; it or code it properly :-) ;;; HAVE FUN! regards, andré (setq instrumentation '(((pno ponte ppp)) ((vn pizz p)) ((vn pizz f) (va ponte f)) ((pno tasto ff)) ((pno pizz fff)) ((vn tasto mf) (pno ord ff) (vc tasto mf) (trp ord pp)) ((trp mute pp) (vn ponte mf)))) ;; mainfuction: (defun gen-hoquetus.4 (filtered-instrument &key pitch length instrument-list) (let ((events (generate-events.4 length pitch :optional_data instrument-list))) (filtering-color.4 filtered-instrument events))) (gen-hoquetus.4 'vn :pitch '(c4 d4 e5 f6) :length '(1/32 2/32 3/32 4/32) :instrument-list instrumentation) ;; subfunctions (defun generate-events.4 (durations pitches &key (velocity '(mf)) (articulation '(-)) (optional_data 'nil)) (loop repeat (length durations) with cnt-d = 0 with cnt-rest = 0 when (> (nth cnt-d durations) 0) collect (list (nth cnt-d durations) (nth cnt-rest pitches) (nth cnt-rest velocity) (nth cnt-rest articulation) (nth cnt-rest optional_data)) and do (incf cnt-rest) and do (incf cnt-d) else collect (list (nth cnt-d durations) 'nil 'nil 'nil 'nil) and do (incf cnt-d))) (generate-events.4 '(1 2 -3 4) '(60 61 62) :optional_data instrumentation) (defun filtering-color.4 (selected-color event-stream) (loop for i in event-stream with match = 0 append (loop for x in (fifth i) when (equal (first x) selected-color) do (setq articulation (second x) velocity (third x)) and do (setq match 1)) when (and (= match 1) (> (first i) 0)) append (list (first i) (second i) velocity articulation) else collect (* -1 (abs (first i))) do (setq match 0))) (filtering-color.4 'vn (generate-events.4 (gen-length '(1 -100 2 3 4 5) 1/32) '(c4 d4 e4 e5) :optional_data instrumentation)) ;; OMN_EXAMPLE: (setq pitches (midi-to-pitch '(60 61 62 63 64 65 66 67 68 69 70))) ; only an example (setq lengths (gen-length '(1 2 3 -4 5 6 5 -4 3 -2 1) 1/16)) ; only an example (setq instrumentation (loop repeat 10 collect (rnd-pick '(((pno ponte ppp)) ; only an example ((vn pizz p)) ((vn pizz f) (va ponte f)) ((pno tasto ff)) ((pno pizz fff)) ((vn tasto mf) (pno ord ff) (vc tasto mf) (trp ord pp)) ((trp mute pp) (vn ponte mf)))))) (def-score hoquetus.4 (:key-signature '(c maj) :time-signature '(4 4) :tempo '(120) :layout (bracket-group (trumpet-layout 'trumpet) (piano-grand-layout 'piano) (violin-layout 'violin) (viola-layout 'viola) (violoncello-layout 'violoncello))) (trumpet :omn (gen-hoquetus.4 'trp :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (piano :omn (gen-hoquetus.4 'pno :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (violin :omn (gen-hoquetus.4 'vn :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (viola :omn (gen-hoquetus.4 'va :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (violoncello :omn (gen-hoquetus.4 'vc :pitch pitches :length lengths :instrument-list instrumentation) :channel 1))  

liitle example:
here a little extra-function -> splittering am melody... + hoquetus.4 (take the function from last post)
regards
andré
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;gen-hoquetus.4 + time-splittered-melody;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;andré meier / 27-4-2016 ;;;hoquetus.4 with a extra-funny-melody-splittered-function ;;;good night and good luck! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;extra-functions;;;;;;;;;splittering-melody;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun weighted-t/nil (on-weight) (let ((off-weight (- 1 on-weight))) (weighted-random (list (list 't on-weight) (list 'nil off-weight))))) (defun splittering-length-seq (lengths &key (possible-lengths '(1 2 3 4)) (rest-weight 0.5) (rhy-factor 1/32)) (loop for i in lengths when (> i 0) collect (loop for j in (rnd-sum i possible-lengths) collect (if (equal (weighted-t/nil rest-weight) 't) (* j -1 rhy-factor) (* j rhy-factor))) else collect (list (* i rhy-factor)))) (defun add-pitch-seq-to-splittered-length-seq (length-seq pitch-seq) (loop for i in length-seq with cnt = 0 append (loop for j in i when (> j 0) collect (nth cnt pitch-seq)) do (incf cnt) when (> cnt (length pitch-seq)) do (setq cnt 0))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun time-splitterd-melody (length-seq pitch-seq &key (possible-lengths '(1 2 3 4)) (rest-weight 0.5) (rhy-factor 1/32)) (make-omn :length (setq lengths (splittering-length-seq length-seq :possible-lengths possible-lengths :rest-weight rest-weight :rhy-factor rhy-factor)) :pitch (add-pitch-seq-to-splittered-length-seq lengths pitch-seq))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;OMN_EXAMPLE HOQUETUS + TIME_SPLTTERED_MELODY :;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq values (flatten (time-splitterd-melody '(16 16 16 16 16 16 16 16 16 16 32 16 16 32) '(c5 d5 e5 c5 c5 d5 e5 c5 e5 f5 g5 e5 f5 g5) :rest-weight 0.5))) (setq lengths (omn :length values)) (setq pitches (omn :pitch values)) (setq pos-durations (car (last (loop for i in lengths with cnt = 0 when (> i 0) collect (incf cnt))))) (setq instrumentation (loop repeat pos-durations collect (rnd-pick '(((pno ponte ppp)) ; only an example ((vn pizz p)) ((vn pizz f) (va ponte f)) ((pno tasto ff)) ((pno pizz fff)) ((vn tasto mf) (pno ord ff) (vc tasto mf) (trp ord pp)) ((trp mute pp) (vn ponte mf)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def-score hoquetus.4 (:key-signature '(c maj) :time-signature '(4 4) :tempo '(120) :layout (bracket-group (trumpet-layout 'trumpet) (piano-grand-layout 'piano) (violin-layout 'violin) (viola-layout 'viola) (violoncello-layout 'violoncello))) (trumpet :omn (gen-hoquetus.4 'trp :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (piano :omn (gen-hoquetus.4 'pno :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (violin :omn (gen-hoquetus.4 'vn :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (viola :omn (gen-hoquetus.4 'va :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (violoncello :omn (gen-hoquetus.4 'vc :pitch pitches :length lengths :instrument-list instrumentation) :channel 1))  
 
 

Friends,
Time for yet another blog post! This week I have described a technique that you can use to read a MIDI file and then transform the corresponding score.
 
I personally think that Opusmodus could introduce many interesting functions for working with MIDI files, not just for transforming as explained in my blog, but also for analyzing the score.
 
Hope you find this article interesting.
 
Regards,
Rangarajan   

SB,
Please look at the attached source file. I guess this will meet your requirements (to the extent I have understood). Let me know if you need to make some changes or if you encounter any problem running it.
 
Regards,
Rangarajan
 
Midi to score serialization.opmo

SB,
Here it is. Can you please check this program? I tried and it seems to work here.
 
-Rangarajan
Create Library File From MIDI.opmo

SB,
It should not be difficult to read many files from a directory. In my example, each MIDI file was read into as a single def-score. How to handle the multiple MIDI files? Do you want a corresponding score for each one of them (in memory) or do you want to serialise them (i.e., write each to a separate file)?
 
if you let me know, I can work on that in my spare time and send the code to you. 
 
You can send me an email (ranga@mmsindia.com) if you do not want to use this forum for that purpose.
 
Regards,
Rangarajan