mirror-seq

;;; --------------------------------------------------------------------------
;;; "mirror image" of a cutout
;;; --------------------------------------------------------------------------

;;; this function is generating a "mirror image" of a cutout
;;; by random-length/pos or by event-numbers
;;; the "untaken" part will be replaced by rests

;;; the "special thing is" to connect it exactly/immediately to the original-seq
;;; and as filtered-seq you could use it in an other part/instrument
;;; i coded it for my current work... so, take it or delete it!


(defun mirror-seq (n omn-list &key (type 'r))
  (let ((single-seq (single-events omn-list))
        (seq)
        (rests))
        
        (progn
          (setf seq (flatten (loop repeat (if (listp n)
                                            (cadr n)
                                            (1+ (random (- (length single-seq) n))))
                               for i in single-seq
                               collect i)))
          (setf rests (neg! (apply '+ (mapcar 'abs (omn :length (flatten seq))))))
          
          (setf seq (cond ((equal type 'r)
                           (gen-retrograde seq))
                          ((equal type 'i)
                           (pitch-invert seq))
                          ((equal type 'ri)
                           (pitch-invert (gen-retrograde seq)))))
          (setf seq (flatten (loop repeat (if (listp n)
                                            (- (cadr n) (car n))
                                            n)
                               for i in (single-events seq)
                               collect i)))
          (flatten (list rests
                         seq)))))

;;; examples
;;; if n = integer -> random-seq 
;;; if n = integer-list -> event-posititon => constant
;;; types r / i / ri

(setf seq '(e. b3 mf c4 s d4 pp q eb4 e4 f4 t fs4))

;;; retro
(setf exp1 (mirror-seq 2  seq :type 'r))
(setf exp2 (mirror-seq '(1 4) seq :type 'r))

;;; retro/inv
;(setf exp1 (mirror-seq 2  seq :type 'ri))
;(setf exp2 (mirror-seq '(1 4) seq :type 'ri))

;;; inv
;(setf exp1 (mirror-seq 2  seq :type 'i))
;(setf exp2 (mirror-seq '(1 4) seq :type 'i))

(def-score only-anonsense-example
           (:title "exp"
                   :key-signature 'atonal  
                   :time-signature '(4 4)
                   :tempo 124
                   :layout (bracket-group 
                            (treble-layout 'original)
                            (treble-layout 'exp1)
                            (bass-layout 'exp2)))

  

  (original 
   :omn seq
   :channel 1
   :port 1
   :sound 'gm
   :program 'acoustic-grand-piano)

  (exp1 
   :omn (pitch-transpose 0 exp1)
   :channel 1
   :port 1
   :sound 'gm
   :program 'acoustic-grand-piano)
  (exp2
   :omn (pitch-transpose 0 exp2)
   :channel 1
   :port 1
   :sound 'gm
   :program 'acoustic-grand-piano))

                            

in comination with length-augmentation (and tranpositions) you could generate a "distorted mirror image" in an other part/instrument