Jump to content

Search the Community

Showing results for tags 'code'.



More search options

  • Search By Tags

    Type tags separated by commas.
  • Search By Author

Content Type


Forums

  • Welcome To Opusmodus
    • Announcements
    • Pre Sales Questions
  • Support Forum
    • Support & Troubleshooting
    • OMN Lingo
    • Function Examples
    • Score and Notation
    • Live Coding Instrument
    • Library Setup
    • MIDI Setup
  • Sharing
    • Made In Opusmodus
    • User Extensions Source Code
    • Suggestions & Ideas

Blogs

  • Stephane Boussuge
  • Didier Debril

Categories

  • OMN The Language
  • Tutorial Guide
  • CLM Examples

Categories

  • Getting Started
  • HowTo
  • Live Coding
  • Music Theory and Analysis

Find results in...

Find results that contain...


Date Created

  • Start

    End


Last Updated

  • Start

    End


Filter by number of...

Joined

  • Start

    End


Group


Website URL


Gender


Location


Interests


About Me

Found 16 results

  1. ;;; ADD-RND-DUST TO LENGTHS ;;; this function adding RANDOMLY some "dust" to the LENGTHS, so it will be like a little rubato, ;;; or "humanizing"-effect. the ADD-SPAN is in percent (0.1 = 10%) on each length-value. (defun add-rnd-dust (omnseq &key (span '(0.1)) (seed nil) (quantize '(1 2 3 4 5 6 7 8 9))) (let ((rhy (omn :length omnseq)) (sp)) (progn (setf rhy (loop with cnt = 0 for i in rhy do (setf sp (nth cnt span)) when (not (null seed)) do (incf seed) when (> i 0) collect (+ i (car (rnd-number 1 0.0 (* i sp) :seed seed))) else collect (- i (car (rnd-number 1 0.0 (* i sp) :seed seed))) when (< cnt (1- (length span))) do (incf cnt))) (make-omn :length (quantize (float-to-ratio rhy :ratio 1/1) quantize) :pitch (omn :pitch omnseq) :velocity (omn :velocity omnseq) :articulation (omn :articulation omnseq))))) ;;; EXAMPLE (add-rnd-dust '(h c3 h. d3 -h q. f3 q g3) :span '(0.5 0.3 0.2 0.1) :quantize '(1 2 3 4 8) :seed 123) => (ht c3 h.s. d3 -e -q -t e.._3h f3 3q_q g3) (add-rnd-dust '(q c3 q d3 q e3 q f3 q g3) ;;possible add-span per value (1 = 100% of the value, 0.5 = 50% etc.) ;;if it's a list, it will stay on the last value of the span-list :span '(0.4 0.3 0 0 2) ;;how to quantize new lengths :quantize '(1 2 4 8) :seed 123) => (q c3 qt d3 q e3 f3 hs. g3) (add-rnd-dust '(h c3 h. d3 h e3 q. f3 q g3) :span '(0.5) ;; = every value max-add 50% :quantize '(1 2 3 4 8) :seed 2999) => (hs. c3 wt d3 3w.e e3 3wq. f3 q g3) (add-rnd-dust '(q c3 q d3 q e3 q f3 q g3) :span '(0.4 0.3 0 0 2) :quantize '(1 2 4 8) :seed 1111) => (qt c3 qs d3 q e3 f3 q... g3) (add-rnd-dust '(h c3 h d3 h e3 h f3 h g3) :span '(0.3 0.2 0.1 0 0.2) :quantize '(1 2 4 3 5) :seed 2999) => (5dh. c3 5dhq. d3 h e3 f3 he g3)
  2. greetings andré ;;; MODIFY THE PITCH CONTOUR inside a pitchfield or tonality ;;; please evaluate the example and have a look to the contours ;;; subfunction (defun position-items (items alist) (loop for item in items append (position-item item alist))) ;;; function (defun compr/expand-melody (melody field &key (type 'add) (n 1) (shift 0)) (let* ((ints (loop for i in (difference (position-items (pitch-to-midi melody) (pitch-to-midi field))) collect (cond ((equal type 'add) (cond ((<= i -1) (- i n)) ((>= i 1) (+ i n)) (t i))) ((equal type 'fibonacci) (cond ((>= i 1) (+ i (fibonacci i))) ((<= i -1) (- i (fibonacci (abs i)))) (t i))) ((equal type 'summativ) (cond ((>= i 1) (+ i (+ i n))) ((<= i -1) (- i (+ (abs i) n))) (t i))))))) (position-filter (x+b (interval-to-integer ints :start (car (position-items melody field))) shift) field))) ;;; expand 1a (progn (setf seed (random 100)) (pitch-list-plot (list (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed) (gen-sieve '(c1 c9) '(2 1 1) :type :pitch) :type 'add :n 1) (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed) (gen-sieve '(c1 c9) '(2 1 1) :type :pitch) :type 'add :n 2) (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed) (gen-sieve '(c1 c9) '(2 1 1) :type :pitch) :type 'add :n 3) (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed) (gen-sieve '(c1 c9) '(2 1 1) :type :pitch) :type 'add :n 5) (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed)) :join-points t)) ;;; expand 1b => using shift (changed startposition) (progn (setf seed (random 100)) (pitch-list-plot (list (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed) (gen-sieve '(c1 c9) '(2 1 1) :type :pitch) :type 'add :n 1 :shift 1) (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed) (gen-sieve '(c1 c9) '(2 1 1) :type :pitch) :type 'add :n 2 :shift 2) (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed) (gen-sieve '(c1 c9) '(2 1 1) :type :pitch) :type 'add :n 3 :shift 3) (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed) (gen-sieve '(c1 c9) '(2 1 1) :type :pitch) :type 'add :n 5 :shift 4) (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed)) :join-points t)) ;;; compress (progn (setf seed (random 100)) (pitch-list-plot (list (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed) (gen-sieve '(c1 c9) '(2 1 1) :type :pitch) :type 'add :n -1) (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed) (gen-sieve '(c1 c9) '(2 1 1) :type :pitch) :type 'add :n -2) (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed) (gen-sieve '(c1 c9) '(2 1 1) :type :pitch) :type 'add :n -3) (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed)) :join-points t)) ;;; expand 2 with fibonacci (progn (setf seed (random 100)) (pitch-list-plot (list (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed) (gen-sieve '(c1 c9) '(2 1 1) :type :pitch) :type 'fibonacci) (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed)) :join-points t)) ;;; expand 3 summativ (progn (setf seed (random 100)) (pitch-list-plot (list (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed) (gen-sieve '(c1 c9) '(2 1 1) :type :pitch) :type 'summativ :n 1) (compr/expand-melody (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed) (gen-sieve '(c1 c9) '(2 1 1) :type :pitch) :type 'summativ :n 2) (rnd-sample 7 (gen-sieve '(c4 c5) '(2 1 1) :type :pitch) :seed seed)) :join-points t)) some evaluations -> different melodic contours (rnd / in a sieve) and its expansions Bildschirmaufnahme 2019-05-26 um 22.04.38.mov
  3. have fun... greetings andré ;;; here is a MULTI-GEN-SORT ------------------------- ;;; you could interlace different processes of SORTING (defun multi-gen-sort (lists &key (types nil) (sorts '>) (steps nil) (seed nil)) (let* ((sorted-lists (loop for i in lists for cnt = 0 then (incf cnt) collect (gen-sort i :type (if (listp types) (nth cnt types) types) :sort (if (listp sorts) (nth cnt sorts) sorts) :step (if (listp steps) (nth cnt steps) steps) :seed seed)))) (flatten (loop repeat (find-max (loop for i in sorted-lists collect (length i))) for cnt = 0 then (incf cnt) collect (loop for i in (reverse sorted-lists) collect (nth cnt i)))))) ;;; some examples (pitch-list-plot (flatten (multi-gen-sort (list (expand-tonality '(c5 'chromatic)) (expand-tonality '(c3 'chromatic)) (expand-tonality '(c4 'chromatic)) (expand-tonality '(c6 'chromatic))) :types '(selection insertion min-max selection) :sorts '(> > > >) :steps '(7 6 7 3))) :join-points t :point-radius 0 :style :fill) (pitch-list-plot (flatten (multi-gen-sort (list (rnd-order (expand-tonality '(c5 'chromatic))) (rnd-order (expand-tonality '(c3 'chromatic))) (rnd-order (expand-tonality '(c6 'chromatic))) (rnd-order (expand-tonality '(c4 'chromatic)))) :types '(insertion selection min-max selection) :sorts '(> < < >) :steps '(5 3 7 nil))) :join-points t :point-radius 0 :style :fill) (pitch-list-plot (flatten (multi-gen-sort (list (rnd-order (expand-tonality '(c6 'chromatic))) (rnd-order (expand-tonality '(c5 'chromatic))) (rnd-order (expand-tonality '(c4 'chromatic))) (rnd-order (expand-tonality '(c3 'chromatic)))) :types '(selection nil insertion min-max) :sorts '(< > < >) :steps '(4 4 4 4))) :join-points t :point-radius 0 :style :fill) (pitch-list-plot (filter-repeat 1 (flatten (multi-gen-sort (list (rnd-order (expand-tonality '(c4 'chromatic))) (rnd-order (expand-tonality '(cs4 'chromatic))) (rnd-order (expand-tonality '(d4 'chromatic))) (rnd-order (expand-tonality '(ds4 'chromatic)))) :types '(insertion selection min-max selection) :sorts '(> < > <) :steps '(5 5 5 5)))) :join-points t :point-radius 0 :style :fill) ;;; a SORT2 :-) (pitch-list-plot (flatten (gen-sort (flatten (multi-gen-sort (list (rnd-order (expand-tonality '(c6 'chromatic))) (rnd-order (expand-tonality '(c5 'chromatic))) (rnd-order (expand-tonality '(c4 'chromatic))) (rnd-order (expand-tonality '(c3 'chromatic)))) :types '(selection nil insertion min-max) :sorts '(< > > >) :steps '(3 3 3 3))) :type 'insertion :step 7 :sort '>)) :join-points t :point-radius 0 :style :fill) some examples: a sorted mulit-gen-sort:
  4. ;;; THIS FUNCTION DOING SYMM TRANSPOSITIONS TO CONRACT (OR EXPAND, depends on INTERVAL) A CHORD or PITCH-SEQ ;;; default setting: it changes in every generation the highest and lowest pitch by an OCTAVE ;;; by changing :position (see examples) you could change which position should be changed/transposed ;;; default interval is 12 ;;; FUNCTION (defun chord-contraction/expansion (n pitchlist &key (position nil) (interval 12) (chord nil)) (let* ((pitchlist (if (chordp (car pitchlist)) (melodize pitchlist) pitchlist)) (position (if (null position) (list 0 (1- (length pitchlist))) (if (listp position) position (list position (- (1- (length pitchlist)) position))))) (pitchlist (cons pitchlist (loop repeat n collect (setf pitchlist (sort-asc (flatten (position-replace position (list (pitch-transpose interval (list (nth (car position) pitchlist))) (pitch-transpose (neg! interval) (list (nth (cadr position) pitchlist)))) pitchlist)))))))) (if (null chord) pitchlist (chordize pitchlist)))) ;;; EXAMPLES: evaluate by cmd3 (setf 12-tone-field '(f3 fs3 gs3 c4 d4 e4 b4 cs5 eb5 g5 a5 bb5)) (chord-contraction/expansion 4 12-tone-field :chord t) => ((f3fs3gs3c4d4e4b4cs5eb5g5a5bb5) (fs3gs3c4d4e4f4bb4b4cs5eb5g5a5) (gs3c4d4e4f4fs4a4bb4b4cs5eb5g5) (c4d4e4f4fs4g4gs4a4bb4b4cs5eb5) (d4eb4e4f4fs4g4gs4a4bb4b4c5cs5)) (chord-contraction/expansion 4 12-tone-field :chord t :interval 48) => ((f3fs3gs3c4d4e4b4cs5eb5g5a5bb5) (bb1fs3gs3c4d4e4b4cs5eb5g5a5f7) (f3fs3gs3c4d4e4b4cs5eb5g5a5bb5) (bb1fs3gs3c4d4e4b4cs5eb5g5a5f7) (f3fs3gs3c4d4e4b4cs5eb5g5a5bb5)) ;;; with spezific positions (inner change) (chord-contraction/expansion 4 12-tone-field :chord t :position 3) => ((f3fs3gs3c4d4e4b4cs5eb5g5a5bb5) (f3fs3gs3d4eb4e4b4c5cs5g5a5bb5) (f3fs3gs3cs4eb4e4b4c5d5g5a5bb5) (f3fs3gs3d4eb4e4b4c5cs5g5a5bb5) (f3fs3gs3cs4eb4e4b4c5d5g5a5bb5)) (chord-contraction/expansion 4 12-tone-field :chord t :position '(0 5)) => ((f3fs3gs3c4d4e4b4cs5eb5g5a5bb5) (e3fs3gs3c4d4f4b4cs5eb5g5a5bb5) (f3fs3gs3c4d4e4b4cs5eb5g5a5bb5) (e3fs3gs3c4d4f4b4cs5eb5g5a5bb5) (f3fs3gs3c4d4e4b4cs5eb5g5a5bb5)) ;;;; with different intervals (chord-contraction/expansion 4 12-tone-field :chord t :interval 11) => ((f3fs3gs3c4d4e4b4cs5eb5g5a5bb5) (fs3gs3c4d4e4e4b4b4cs5eb5g5a5) (gs3c4d4e4e4f4bb4b4b4cs5eb5g5) (c4d4e4e4f4g4gs4bb4b4b4cs5eb5) (d4e4e4e4f4g4gs4bb4b4b4b4cs5)) (chord-contraction/expansion 4 12-tone-field :chord t :interval 7) => ((f3fs3gs3c4d4e4b4cs5eb5g5a5bb5) (fs3gs3c4c4d4e4b4cs5eb5eb5g5a5) (gs3c4c4cs4d4e4b4cs5d5eb5eb5g5) (c4c4cs4d4eb4e4b4c5cs5d5eb5eb5) (c4cs4d4eb4e4g4gs4b4c5cs5d5eb5))
  5. hi all i'm looking for different SORTING ALGORITHMS in LISP - no problem to find (different) in the WWW... but: i would like to have as OUTPUT-result ALL generations of the SORTING-process and not only the LAST one - i'm interested in the PROCESS!! thanks for some help or any idea? (for once i do not want to code it myself :-)) greetings andré
  6. to use the function which works on event-numbers, first you have to number it (the score), so that you could work with this afterwards... ;;; ADD numbers to text attributes (can do that in your setup), then ADD number to events ;;; have a look to the example. after that, easy to use REPLACE-ON-EVENT-NUMBER etc... (defun add-numbers-to-text-attributes (a b) (loop for i from a to b append (add-text-attributes (list (compress (list 'nr i)) (write-to-string i))))) (add-numbers-to-text-attributes 0 100) (defun add-num-to-events (omnlist) (loop for x in (single-events omnlist) for i from 0 to (length (single-events omnlist)) when (omn-formp x) collect (omn-replace :articulation (list (compress (list 'nr i))) x) else collect x)) ;;; evaluate cmd3 (setf seq (add-num-to-events '(-q q c4 mp -q -q e e e e e q c4 mp -q -q q c4 mp -q))) => ((-q) (q c4 mp nr1) (-q) (-q) (e c4 mp nr4) (e c4 mp nr5) (e c4 mp nr6) (e c4 mp nr7) (e c4 mp nr8) (q c4 mp nr9) (-q) (-q) (q c4 mp nr12) (-q))
  7. the same idea with INSERT/REPLACE (defun replace-on-event-number (omn-list &key position/list (type 'replace) (output nil)) (progn (setf omn-list (loop for i in (single-events omn-list) for cnt = 0 then (incf cnt) with position-list = (loop for x in position/list collect (car x)) with list = (loop for y in position/list collect (rest y)) with cnt2 = 0 when (= cnt (nth cnt2 position-list)) collect (cond ((equal type 'replace) (if (listp (nth cnt2 list)) (flatten (nth cnt2 list)) (nth cnt2 list))) ((equal type 'add) (list i (nth cnt2 list)))) else collect i when (and (= cnt (nth cnt2 position-list)) (< cnt (car (last position-list)))) do (incf cnt2))) (if (equal output 'flatten) (flatten omn-list) omn-list))) ;;; EXAMPLES REPLACE (replace-on-event-number '(q g4 -q q g4 g4 g4 -q g4 g4 g4 g4) :position/list '((1 (q g5d5)) (5 -q)) :type 'replace) => ((q g4 mf) (q g5d5) (q g4 mf) (q g4 mf) (q g4 mf) (-q) (q g4 mf) (q g4 mf) (q g4 mf) (q g4 mf)) (replace-on-event-number '(q g4 -q q g4 g4 g4 -q g4 g4 g4 g4) :position/list '((1 (q g5d5)) (5 -q)) :type 'replace :output 'flatten) => (q g4 mf q g5d5 q g4 mf q g4 mf q g4 mf -q q g4 mf q g4 mf q g4 mf q g4 mf) ;;; EXAMPLES ADD (replace-on-event-number '(q g4 -q q g4 g4 g4 -q g4 g4 g4 g4) :position/list '((1 -e.) (5 -w)) :type 'add :output nil) => ((q g4 mf) ((-q) (-e.)) (q g4 mf) (q g4 mf) (q g4 mf) ((-q) (-w)) (q g4 mf) (q g4 mf) (q g4 mf) (q g4 mf)) (replace-on-event-number '(q g4 -q q g4 g4 g4 -q g4 g4 g4 g4) :position/list '((1 (w g6 ffff)) (5 -w)) :type 'add :output 'flatten) => (q g4 mf -q w g6 ffff q g4 mf q g4 mf q g4 mf -q -w q g4 mf q g4 mf q g4 mf q g4 mf) ;;;;
  8. Hi, here are the two functions i use daily in my workflow. The first gen-pitch-line can be used as this but is also required for the second function svoice1. svoice1 is a generic omn generator i find useful for my work. ;;; ------------------------------------------------------------------------------ ;;; GEN-PITCH-LINE ;;; Fonction de génération de hauteurs basées sur une conversion de vecteur de bruit ;;; avec un grand choix de type de bruit, taux de compression du vecteur, filtrage des répétitions et ambitus. (defun gen-pitch-line (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat (type :white)) (setf seed (rnd-seed seed)) (let (pitches) (do-verbose ("gen-pitch-line :seed ~s" 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))))) #| 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) |# ;;; ------------------------------------------------------------------------------ ;;; SVOICE1 ;;; VERSION 0.1 (defun svoice1 (nb-pitch &key (level 16) (low 1) (high 16) (ratio 1/16) (e-type 2)(e-rotate nil)(e-variant nil) (compress 1)(filter-repeat nil)(pline-type :white) (p-divide nil)(articulation nil) (length nil)(pitch nil)(velocity nil) (seed nil)(articulation-map nil) (add-interval-if-length nil) (i-length '1/16) (i-list '(-4 -5 -3 -7)) ) (setf seed (rnd-seed seed)) (do-verbose ("svoice1 :seed ~s" seed) (let* (( pitch (if pitch pitch (if p-divide (gen-divide p-divide (gen-pitch-line nb-pitch :compress compress :seed (seed) :filter-repeat filter-repeat :type pline-type)) (gen-pitch-line nb-pitch :compress compress :seed (seed) :filter-repeat filter-repeat :type pline-type)))) (len (if length length (euclidean-rhythm level low high ratio :type e-type :rotate e-rotate :variant e-variant :seed (seed)))) (art (if articulation articulation (if articulation-map (length-map articulation-map len :otherwise '(default)) ))) (velo (if velocity velocity '(mf))) ) (if add-interval-if-length (add-interval-if-length (make-omn :pitch pitch :length len :velocity velo :articulation art ) :length-val i-length :interval-list i-list ) (make-omn :pitch pitch :length len :velocity velo :articulation art ))))) #| USAGE (svoice1 32) (svoice1 32 :seed 1234) (svoice1 32 :pitch '(c4 d4 e4) :articulation '(marc)) (svoice1 32 :length '((h h)(q q e e e e))) (svoice1 32 :pitch '(c4 g4) :length '((h h)(q q e e e e)) :velocity '((f)(pp))) (svoice1 32 :i-list '(-7 -4 -5 -3) :low 1 :high 4) (svoice1 128 :p-divide 8 :level (gen-repeat 12 '(16)) :compress 0.16) (svoice1 128 :p-divide 8 :level (gen-repeat 12 '(16)) :compress 0.16 :articulation-map '((1/8 stacc)(1/16 leg))) (svoice1 128 :p-divide 8 :level (gen-repeat 12 '(16)) :low 8 :high 8 :compress 0.16 :articulation-map '((1/8 stacc)(1/16 leg))) (svoice1 128 :p-divide 8 :level (gen-repeat 12 '(16)) :low 8 :high 8 :compress 0.16 :articulation-map '((1/8 stacc)(1/16 leg)) :add-interval-if-length t) (svoice1 128 :p-divide 8 :level (gen-repeat 12 '(16)) :low 2 :high 16 :compress 0.16 :articulation-map '((1/8 stacc)(1/16 leg))) (tonality-map '(((0 2 4 6 8 10) :root d4)) (svoice1 128 :p-divide 8 :level (gen-repeat 12 '(16)) :low 2 :high 16 :compress 0.16 :articulation-map '((1/8 stacc)(1/16 leg))) ) |# S.
  9. ;;; CHANGE-TIME-STRUCTURES ;;; works okay, but not exactly precise because of rhy-to-integer, which is not very easy in some cases ;;; this function changes basic-rhy-structures (if it's all the time perhaps in x/32) ;;; to other/changing sections. the lengths/rests will be rounded like in LENGTH-RATIONAL-QUANTIZE ;;; rhy+span => '((32 2) (44 7)) => means in 32 three values, in 44 seven values (defun change-time-structure (omnseq rhy+span &key (basic-rhy 32) (round 1/4)) (let* ((intseq (loop for i in (omn :length (flatten omnseq)) collect (* i basic-rhy))) (rhyseq (mapcar #'car rhy+span)) (spanseq (mapcar #'cadr rhy+span)) (divided-intseq (gen-divide spanseq intseq))) (length-rational-quantize (flatten (gen-length divided-intseq rhyseq)) :round round))) (change-time-structure '(2/44 -2/44 3/44 5/44 6/44) '((32 2) (20 2) (28 3)) :basic-rhy 44) => (1/16 -1/16 -1/8 3/20 1/4 -1/10 3/14 -1/28) (change-time-structure '(2/32 -2/32 3/32 5/32 6/32) '((20 2) (44 2) (28 3)) :basic-rhy 32) => (1/10 -1/10 -1/20 3/44 5/44 -3/44 3/14 -1/28) could be done better -> go for it greetings andré
  10. (defun replace-lengths-of-a-pitch-sequence (omn-list pitch-list length-list) (flatten (loop with cnt = 0 for i in (single-events omn-list) when (equal (cadr i) (nth cnt pitch-list)) collect (append (list (nth cnt length-list)) (rest i)) and do (incf cnt) else collect i when (= cnt (length pitch-list)) do (setf cnt 0)))) (setf white-series-l (vector-to-pitch '(c4 c5) (gen-white-noise 100 :type :logistic :seed 23))) (replace-lengths-of-a-pitch-sequence (cons 't white-series-l) '(e4 f4 a4 gs4 g4 b4 c5 bb4) '(2/16 3/16 4/16 5/16 6/16 7/16 8/16)) => '(t gs4 mf t g4 mf t g4 mf t c5 mf t g4 mf t gs4 mf 1/8 e4 mf 3/16 f4 mf t gs4 mf t gs4 mf t bb4 mf t gs4 mf t fs4 mf t fs4 mf t f4 mf t g4 mf t bb4 mf t b4 mf t b4 mf t g4 mf t e4 mf t g4 mf t fs4 mf t b4 mf 1/4 a4 mf t g4 mf t g4 mf t a4 mf t b4 mf t fs4 mf t bb4 mf t a4 mf 5/16 gs4 mf t a4 mf 3/8 g4 mf t a4 mf t a4 mf t a4 mf t a4 mf t a4 mf t f4 mf t bb4 mf t g4 mf t fs4 mf 7/16 b4 mf t a4 mf t g4 mf t bb4 mf t a4 mf t gs4 mf t a4 mf t gs4 mf t g4 mf t g4 mf t gs4 mf t a4 mf t f4 mf t f4 mf t bb4 mf t gs4 mf t fs4 mf t a4 mf t g4 mf t a4 mf t g4 mf t gs4 mf t bb4 mf t eb4 mf t bb4 mf t fs4 mf t fs4 mf t gs4 mf t g4 mf t gs4 mf t gs4 mf t c4 mf t gs4 mf t g4 mf t gs4 mf 1/2 c5 mf bb4 mf t gs4 mf t fs4 mf t fs4 mf t bb4 mf t a4 mf t g4 mf t g4 mf t b4 mf t g4 mf t f4 mf t g4 mf t gs4 mf t gs4 mf t gs4 mf t gs4 mf t fs4 mf t gs4 mf t eb4 mf t a4 mf)
  11. hi all i would like to code a NAND gate with more then two input-items (as extension to AND etc...). here is a simple version of the NAND function with two inputs, but i don't know how to exapnd it to n-inputs without putting the the inputs to in a list (like lisp-internal AND / OR)... https://en.wikipedia.org/wiki/NAND_gate i dont't want it: (nand '(t t t nil)) but like to have (nand t nil nil t t t) when i get a solution for that i will code an XOR, NOR etc.... so the "problem" is: how to manage in DEFUN more then two inputs (don't work with &optional, i think) i tried it and failed)... any ideas, lisp-nerds? thanx! andré ;;; easy with a specific number of input-items - that works! (defun nand (a b) (not (and a b))) (nand t t) => nil (nand nil nil) => t (nand nil t) => t ;;; i like to have an input perhaps like that - with any number of input-items, like lisp's AND / OR (nand t t t t) (nand nil t t t nil t t t nil) ...
  12. Hello All As I continue my fascination with the fractal structures contained in Per Norgard's infinity series, I am wondering whether it might be possible to apply the infinity to particular scales or modes? Say I want to generate an infinity-series based on a pre-existing scales/modes (like in G major) or by any self-defined mode such as (make-scale 'c2 49 :alt '(1 2 1 1)) Any help much appreciated as always. Kind regards Brian
  13. ;;; ----------------------------------------------------------------------------------------------- ;;; A QUASI-UNISONO by proportional length-differences ;;; SAME PITCHES IN ALL VOICES INCLUDING START/END-PITCH ;;; ----------------------------------------------------------------------------------------------- ;;; a random-pitch-seq (rnd-walk) ;;; ;;; immediate-pitch-repetitions are building the rhythm ;;; ;;; with MODIFY-PROPORTIONS i'm generating "proportional variants" of this rhythm, in this example ;;; by 16 generations -> then i take the generations 1, 8, and 15 for each voice ;;; ;;; by "(filter-repeat 1 sequence)" i swallow the immediate-pitch-repetitions for correct ;;; of PITCH- and RHYTHM-phases ;;; ;;; ----------------------------------------------------------------------------------------------- ;;; FUNCTION (defun modify-proportions (n prop-list &key (style 'sharpen)) (let ((rest-pos (loop for i in prop-list for cnt = 0 then (incf cnt) when (< i 0) collect cnt)) (prop-list (abs! prop-list)) (liste)) (progn (setf liste (append (list prop-list) (loop repeat n when (or (= (length (find-above 1 prop-list)) 1) (= (length (find-unique prop-list)) 1)) collect prop-list else collect (setf prop-list (loop for i in prop-list for cnt = 0 then (incf cnt) collect (cond ((= cnt (position (find-closest 2 (find-above 1 prop-list)) prop-list)) (if (equal style 'sharpen) (1- i) (1+ i))) ((= cnt (position (find-max prop-list) prop-list)) (if (equal style 'sharpen) (1+ i) (1- i))) (t i))))))) (loop for i in liste collect (loop for k in i for cnt = 0 then (incf cnt) when (memberp cnt rest-pos) collect (* -1 k) else collect k))))) ;;; ----------------------------------------------------------------------------------------------- ;;; GENERATING SCORE (setf sequence (gen-walk 100 :step '(0 0 0 0 0 0 0 1 2) :start 'c5)) (setf rhy 1/32) ;;; ----------------------------------------------------------------------------------------------- (def-score quasi-unisono (:title "quasi-unisono" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instr1 :omn (make-omn :length (gen-length (nth 1 (modify-proportions 16 (count-repeat sequence) :style 'sharpen)) rhy) :pitch (filter-repeat 1 sequence)) :channel 1 :port 0 :sound 'gm) (instr2 :omn (make-omn :length (gen-length (nth 8 (modify-proportions 16 (count-repeat sequence) :style 'sharpen)) rhy) :pitch (filter-repeat 1 sequence)) :channel 2 :port 0 :sound 'gm) (instr3 :omn (make-omn :length (gen-length (nth 15 (modify-proportions 16 (count-repeat sequence) :style 'sharpen)) rhy) :pitch (filter-repeat 1 sequence)) :channel 3 :port 0 :sound 'gm)) there is no BUG when i work without "omn-to-time-signature", but is also not necessary!
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;gen-chained-sym-vals.by-markov;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; special-symm-sequences ;;; have look at the possible parameters (&key) ;;; it's generates symm-structures via MARKOV ;;; and the could be "chained" between generations ;;; also with symm.structures... like: (also look at CARTER's work) ;;; => ((1 2 5 8 5 2 1) (3 1 2 2 2 1 3) (8 1 3 1 8) (3 1 2 2 2 1 3) (1 2 5 8 5 2 1)) ;;; chains: 2 1 3 1 2 2 1 3 1 2 ;;; or: ;;; => ((e4 f4 c4 e4 d4 e4 c4 f4 e4) (c4 e4 f4 c4 fs4 c4 f4 e4 c4) (e4 fs4 f4 fs4 e4) (c4 e4 f4 c4 fs4 c4 f4 e4 c4) (e4 f4 c4 e4 d4... ;;; chains: c4 f4 e4 c4 e4 f4 c4 e4 c4 e4 e4 c4 e4 ........etc....... ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; main function with amateur-code :-) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun gen-chained-sym-vals.by-markov (&key (generations 'nil) (non-symmetric 'nil) (number-of-vals 20) (basic-seq-lengths '(3 5)) (transition-matrix '((1 (4 1) (5 1) (6 2)) (2 (5 2) (4 1)) (3 (4 1)) (4 (5 1) (2 1)) (5 (1 3) (6 2) (4 1)) (6 (4 1)) (7 (1 1) (6 1)))) (chain-weight 1.0) (possible-chain-length '(1 2 3)) (reduction 0.0) (start-value (car (car transition-matrix)))) (let ((sequence1 0) (sequence2 0) (seq-lengths basic-seq-lengths)) (setq sequence1 (loop repeat (if (equal generations 'nil) (car (list number-of-vals)) (if (equal non-symmetric 'nil) (if (evenp generations) (/ generations 2) (/ (1- generations) 2)) (car (list generations)))) with seq1 with seq with chain1 with slot = (second (gen-markov-from-transitions transition-matrix :size 2 :start start-value)) with seq-splitter = (gen-markov-from-transitions transition-matrix :size (rnd-pick possible-chain-length) :start slot) with seq-lengths = basic-seq-lengths when (equal (prob? chain-weight) 't) do (setq chain1 (append (list (setq slot (second (gen-markov-from-transitions transition-matrix :size 2 :start slot)))) seq-splitter (list (setq slot (second (gen-markov-from-transitions transition-matrix :size 2 :start slot)))))) and do (setq seq (append (butlast chain1) (reverse chain1))) and collect (if (equal (prob? reduction) 't) (append (setq seq (butlast (rest seq)))) (append seq)) else collect (setq seq1 (gen-markov-from-transitions transition-matrix :size (rnd-pick seq-lengths) :start slot) seq (append seq1 (reverse seq1))) do (setq seq-splitter (reverse (filter-last (rnd-pick possible-chain-length) seq))))) (if (equal generations 'nil) (progn (setq sequence2 (filter-first (if (evenp number-of-vals) (/ number-of-vals 2) (/ (1- number-of-vals) 2)) (flatten sequence1))) (if (evenp number-of-vals) (append sequence2 (reverse sequence2)) (append sequence2 (list (rnd-pick (flatten (filter-first 1 transition-matrix)))) (reverse sequence2)))) (if (equal non-symmetric 'nil) (if (evenp generations) (append sequence1 (reverse sequence1)) (append sequence1 (list (gen-sym-markov :seq-length (rnd-pick seq-lengths) :transition-matrix transition-matrix)) (reverse sequence1))) (append sequence1))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; test it! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (gen-chained-sym-vals.by-markov :generations 5 :transition-matrix '((1 (2 1) (3 3) (5 2) (8 1)) (2 (1 2) (5 3)) (3 (1 2) (8 1) (2 3)) (5 (3 2) (2 1) (1 3)) (8 (1 2) (2 2) (3 1)))) (gen-chained-sym-vals.by-markov :generations 5 :transition-matrix '((c4 (d4 1) (e4 3) (f4 2) (fs4 1)) (d4 (c4 2) (f4 3)) (e4 (c4 2) (fs4 1) (d4 3)) (f4 (e4 2) (d4 1) (c4 3)) (fs4 (c4 2) (d4 2) (e4 1)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15. have fun! andré ;;; TWO SIEVE-generators ;;; simple and multiple (the simple-function is part of multiple) ;;;;;;;;;;;;;;;;;;;;;;;;; (defun gen-sieve (ambitus.omn intervals) (midi-to-pitch (loop with ambitus.midi = (pitch-to-midi ambitus.omn) with interval.cnt = -1 for pitch = (first ambitus.midi) then (setq pitch (+ (nth interval.cnt intervals) pitch)) when (<= pitch (second ambitus.midi)) collect pitch into bag else return bag do (incf interval.cnt) when (= interval.cnt (length intervals)) do (setq interval.cnt 0)))) (gen-sieve '(c4 g7) '(2 1)) ;;;;;;;;;;;;;;;;;;;;;;;;; (defun gen-multiple-sieve (sieve-rules) ;sieve-rules => '((ambitus.omn intervals) (ambitus.omn intervals) (ambitus.omn intervals)) (midi-to-pitch (sort (remove-duplicates (loop for i in sieve-rules append (pitch-to-midi (gen-sieve (first i) (second i))))) #'<))) (gen-multiple-sieve '(((c4 g7) (2 1 12)) ((c1 g7) (3 5))))
  16. ;;; ------------------------------------------------------------------------------ ;;; 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.
×
×
  • Create New...