[CM] more fun w. CMN: music-font

[Anders Vinjar]

>>> "BS" == Bill Sack <wsack@acsu.buffalo.edu> writes:

    BS> hello all, i want to change a few things in cmn's default
    BS> font - i want straight flags that are slanted opposite
    BS> the stem direction, kind of like the stockhausen UE
    BS> scores from the early sixties

Heres a version of #'draw-flags in cmn2.lisp which accomodates
these flags without changing any font.  

Adjust the variables 'rx1 and 'ry1 for various slanting and
length of flags (set ry1 to 0.0 for cmns original straigh-flags
mode).  This could easily be made customisable with score-slots
etc.


(defun draw-flags (score note nflags up-stem stem-end x0)
  (let* ((y0 (if (not shorter-stems)
		 (+ stem-end (if up-stem -.1 .05))
	       stem-end))
	 (incr (if up-stem (- *flag-vertical-spacing*) *flag-vertical-spacing*))
	 (ny0 (if (not shorter-stems)
		  (+ stem-end (* incr nflags) (if up-stem .1 -.175))
		(+ stem-end (* incr (1- nflags))))))
    (if (member (note-head note) *centered-note-heads*)
	(incf x0 (- (note-head-x0-offset note up-stem *half-stem-width*) *half-stem-width*))
      (if (and up-stem *curvy-flags*)
	  (incf x0 (note-head-x0-offset note up-stem *stem-width*))))
    (if *curvy-flags*
	(progn
	  (if up-stem
	      (show score flag-up :matrix (translate-matrix score note x0 ny0))
	    (show score flag-down :matrix (translate-matrix score note x0 ny0)))
          (loop for i from 1 below nflags and y from y0 by incr do
            (if up-stem
                (show score add-flag-up :matrix (translate-matrix score note x0 y))
              (show score add-flag-down :matrix (translate-matrix score note x0 y)))))

      (let* ((bx0 (+ x0 (if up-stem (- .3 *stem-width*) *stem-width*)))
	     (by0 (if up-stem (- stem-end .1) stem-end))
             (rx1 0.3)                  ; adjust for length of flag
             (ry1 0.1))                 ; adjust for slant of flag
        (loop for i from 0 below nflags and y from by0 by incr do
          (moveto score bx0 y)
          (rlineto score rx1 (if up-stem (- ry1) ry1))
          (rlineto score 0.0 *beam-width*)
          (lineto score bx0 (+ y *beam-width*))
          (lineto score bx0 y)
          (fill-in score))
        ))))



#|
(cmn (curvy-flags nil)
     (automatic-beams nil)
     (beam-width 0.12)
     (c4 (rq 1/16))
     (g5 (rq 5/16) (note-head :diamond-1))
     (g5 e (note-head :x))
     (d4 e)
     (f4 e)
     (a4 e)
     (b4 e)
     (c4 e))

|#