Jump to content

LdBeth

Members
  • Posts

    19
  • Joined

  • Last visited

Everything posted by LdBeth

  1. I think you might want this: (defun tw-p (omn) (equal (let ((x (sort (pitch-to-integer omn) #'<))) (x-b x (apply #'min x))) (range 0 11))) And in you example it seems should be '(c3 eb3 d3 f3 e3 g3 fs3 a3 gs3 b3 bb3 cs3) instead of cs4. (let ((x (pitch-to-integer '(c3 eb3 d3 f3 e3 g3 fs3 a3 gs3 b3 bb3 cs3)))) (x-b x (apply #'min x))) (0 3 2 5 4 7 6 9 8 11 10 13)
  2. Despite the documentation says Return true if sequence is a twelve-tone row, from what I observed it seems the algorithm used is: (defun twleve-tone-p (omn) (equal (sort (pitch-to-integer omn) #'<) (range 0 11)))
  3. (setf *audition-ignore-ports* nil) should do the trick However, let me make a further modification so you can set it as an argument to the call to play lists. (defun run-playlist (&key (timeout 5) (ignore-ports nil)) (mp:process-run-function "Playing..." () (lambda () (loop (let ((current (mp:mailbox-read *playlist* "Wait for feed tracks" timeout))) (if current (mp:process-join (start-midi current :ignore-ports ignore-ports)) (return))))))) ;; example call (run-playlist :timeout 2 :ignore-ports t) (run-playlist) ; won't ignore port settings now If you have more ideas one how this should be improved please let me know.
  4. Ok I have change push-to-list a bit so it would either compile the core, use the midi object, or read from a file. (defun push-to-list (item) (let ((midi (cond ((eq (type-of item) 'midi:midi) item) ((symbolp item) (compile-score item)) ((or (stringp item) (pathnamep item)) (midi:read-midi-file item))))) (mp:mailbox-send *playlist* midi)))
  5. Inspired by the example from this thread but I could not find the related function been shipped with the OM application. The code requires OM3.0 because of LispWorks specific API but the concept should be simple enough to be implemented in Clozure CL. After some midi objects has been compiled and inserted to the playlist one can use run-playlist to start play. While it is still playing one can feed more midi objects queued to the playlist. When the playlist is empty and after the specified seconds of timeout, the player process would exit. (setq midi1 (compile-score 'score1)) (setq midi2 (compile-score 'score2)) (setq midi3 (compile-score 'score3)) (defparameter *playlist* (mp:make-mailbox)) (defun push-to-list (item) (let ((midi (cond ((eq (type-of item) 'midi:midi) item) ((symbolp item) (compile-score item)) ((or (stringp item) (pathnamep item)) (midi:read-midi-file item))))) (mp:mailbox-send *playlist* midi))) (defun run-playlist (&key (timeout 5) (ignore-ports nil)) (mp:process-run-function "Playing..." () (lambda () (loop (let ((current (mp:mailbox-read *playlist* "Wait for feed tracks" timeout))) (if current (mp:process-join (start-midi current :ignore-ports ignore-ports)) (return))))))) (push-to-list midi1) (push-to-list midi2) (run-playlist 5) (push-to-list midi3)
  6. (format t "~{~{~S~^ ~}~^, ~}" alist) /player "12" 1.0 1.0 1.0, /player "23" 1.0 1.0 1.0, /player "12" 1.0 1.0 1.0, /player "23" 1.0 1.0 1.0 nil :: use format nil if you want the result as a string.
  7. There is vlime plugin that integrates Common Lisp development environment with vim (or neovim). I have never used but I guess should have at least a repl and eval thing a point feature, and should be not difficult to add "play omn" feature if you know how to program vimscript.
  8. It seems the `fermata` attribute would cause tempo change in MIDI output, however when combined with changing tempo in `def-score`, the restored level is the last value in the `:tempo` list, which I guess is a bug. the problem can be demonstrated by the following code snippet: (setf ns '((q a4b4d5fs5cs6 mp arp e b5 e5 q fs4g4b4d5a5 arp d5) (q c3g3d4e4b4 arp h. a5b5d6 #|fermata|#) ;; uncomment this ((leg e b2 fs3 s a3 e d4 s_h e4)) ;; the tempo starts here will be whichever is the last ((leg e b2 fs3 s a3 e d4 s_h e4)) ;; in the `:tempo' list, which is 164 ((leg e d4fs4a4 mf marc d4 e4 cs4e4gs4 marc cs4 e4 d4fs4cs5 marc d4 leg)) ((leg e e4 d4fs4a4 marc d4 e4 cs4e4gs4 marc cs4 d4fs4cs5 marc d4)))) (def-score score (:key-signature '(d major) :time-signature '(4 4) :tempo '((q :rit 74 70 1/32 :bars 2) (70 2) (164 3) ) :layout (list '(:treble notes)) ) (notes :omn ns)) My current version is 2.2.26652.
  9. I guess it is because combinations like (a3 b3 c3 b3) are acceptable but won't be available with combination
  10. There's a count-repeat function. ? (count-repeat '(a3 b3 b3 b3)) count-repeat (1 3) Thus (let ((*do-verbose* nil)) (remove-if (lambda (x) (> (apply #'max (count-repeat x)) 1)) ;; or replace apply with (reduce #'max (count-repeat x)), essentially does the same (combination2 4 '(c3 d3 e3 f3 g3 a3 b3)))) ((a3 b3 a3 b3) (g3 b3 a3 b3) (f3 b3 a3 b3) (e3 b3 a3 b3) (d3 b3 a3 b3) (c3 b3 a3 b3) (b3 g3 a3 b3) (a3 g3 a3 b3) (f3 g3 a3 b3) (e3 g3 a3 b3) (d3 g3 a3 b3) (c3 g3 a3 b3) (b3 f3 a3 b3) (a3 f3 a3 b3) (g3 f3 a3 b3) (e3 f3 a3 b3) (d3 f3 a3 b3) (c3 f3 a3 b3) (b3 e3 a3 b3) (a3 e3 a3 b3) (g3 e3 a3 b3) (f3 e3 a3 b3) (d3 e3 a3 b3) (c3 e3 a3 b3) (b3 d3 a3 b3) (a3 d3 a3 b3) (g3 d3 a3 b3) (f3 d3 a3 b3) (e3 d3 a3 b3) (c3 d3 a3 b3) (b3 c3 a3 b3) ...
  11. you can work with Common Lisp arrays to reduce memory usage. Here's a very direct translation of Algorithm T from http://www.kcats.org/csci/464/doc/knuth/fascicles/fasc2b.pdf which precomputes the permutation table of n distinct elements. ;; We needs to use the factorial function (defun factorial (x) ...) (defun algorithm-t (n &aux (num (factorial n))) ;; The `(integer 1 ,n) declaration will make sure CCL allocates far less memory ;; then using 'integer or 'fixnum. (let ((table (make-array num :element-type `(integer 1 ,n) :initial-element 0)) (m 2) j k d) (setf d (floor num 2) (aref table d) 1) (loop until (= m n) do (progn (incf m) (setf d (floor d m)) (setf k 0) (prog () t3 (setf k (+ k d) j (- m 1)) (loop while (> j 0) do (setf (aref table k) j j (1- j) k (+ k d))) (incf (aref table k)) (setf k (+ k d)) (loop while (< j (1- m)) do (progn (incf j) (setf (aref table k) j k (+ k d)))) (if (< k num) (go t3))) ) finally (return table)))) ;; CL-USER> (algorithm-t 4) ;; #(0 3 2 1 3 1 2 3 1 3 2 1 3 1 2 3 1 3 2 1 3 1 2 3) ;; Since Knuth uses 1 as index origin but CL uses 0, there's one extra element in the computated array. ;; here's a warper (defun n-th-permutation (n array table &aux tmp (array (copy-seq array))) (loop for k from 1 to n do (setf tmp (aref array (1- (aref table k))) (aref array (1- (aref table k))) (aref array (aref table k)) (aref array (aref table k)) tmp) finally (return array))) ;; usage: for a list of 5 pitchs '(c4 e4 f4 d4 g4) ;; first converts to a array > (setf tmp (coerce '(c4 e4 f4 d4 g4) 'array)) #(C4 E4 F4 D4 G4) ;; compute the permutation table, it could take a while for a "big" value such as 12 > (setf n-table (algorithm-t 5)) #(0 4 3 2 1 4 1 2 3 4 ... ;; then apply the n-th-permutation > (loop for i from 1 to 15 by 2 collect (n-th-permutation i tmp n-table)) ;Compiler warnings : ; In an anonymous lambda form: Undeclared free variable TMP ; In an anonymous lambda form: Undeclared free variable N-TABLE (#(C4 E4 F4 G4 D4) #(C4 G4 E4 F4 D4) #(G4 C4 E4 D4 F4) #(C4 E4 G4 D4 F4) #(C4 E4 D4 F4 G4) #(C4 D4 E4 G4 F4) #(C4 G4 D4 E4 F4) #(G4 D4 C4 E4 F4))
×
×
  • Create New...

Important Information

Terms of Use Privacy Policy