swap-marks.lsp

Replace every instance of a dynamic marking with another. In fact, it will work with any mark that can be added to the :marks slot of an event object.

sc-web-bar

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; File:    swap-marks.lsp
;;;
;;; Author:  Daniel James Ross (mr.danielross@gmail.com)
;;;
;;; Created: Tue Sep 22 14:26:30 BST 2015
;;;
;;; Date:    Mon Nov 23 13:01:48 GMT 2015
;;;
;;; Purpose: Replace one dynamic mark with another
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#|

;; Old method, no longer used
(map-over-bars sc nil nil nil
               #'(lambda (bar old-mark new-mark)
                  (loop for e in (rhythms bar) do
                   (when (has-mark e old-mark)
                     (rm-marks e old-mark)
                    (add-mark-once e new-mark))))
	       'p 'fff)
|#

;; DJR - Mon Nov 23 12:54:01 GMT 2015
;; Have turned this lambda function into a method

(defmethod swap-marks ((sc slippery-chicken) 
                       start-bar end-bar player
		       old-mark new-mark)
  (unless end-bar (setf end-bar (num-bars sc)))
  (unless start-bar (setf start-bar 1))
  (loop for bn from start-bar to end-bar
     for bar = (get-bar sc bn player)
     do
       (loop for e in (rhythms bar) do
                   (when (has-mark e old-mark)
                     (rm-marks e old-mark)
                    (add-mark-once e new-mark)))))
       


;; Example using an adapted and simplified version of Michael
;; Edwards' template.lsp to show swap-marks at work.

#|
(in-package :sc)
(in-scale :chromatic)

(make-slippery-chicken  
 '+your-title-here+ 
 :title "Your Title Here" 
 :composer "Your Name Here"
 :ensemble '(((flt (flute :midi-channel 1))))
 :staff-groupings '(1)
 :tempo-map '((1 (q 60)))
 :set-palette '((set1 ((fs2 b2 d4 a4 d5 e5 a5 d6))) 
                (set2 ((b2 fs3 d4 e4 a4 d5 e5 a5 d6))))
 :set-map '((1 (set1 set1 set2 set1 set1 set2)))
 :rthm-seq-palette
 '((seq1 ((((4 4) (q) (q) q q))   
          :pitch-seq-palette (1 2)
	  :marks (p 1)))  
   (seq2 ((((4 4) (e) e q h)) 
          :pitch-seq-palette (1 2 3)
	  :marks (pp 1))))
 :rthm-seq-map
 '((1 ((flt (seq1 seq1 seq2 seq1 seq1 seq2))))))

(swap-marks +your-title-here+ 1 2 'flt 'p 'fff)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Media content generation:
;;; cmn score
;;; #+ notation means only run the next Lisp form if e.g. the 
;;; CMN package is available  
#+cmn (cmn-display +your-title-here+ 
         :file "/tmp/your-title-here.eps")

|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; EOF swap-marks.lsp
Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s