[CM] CMN - arrow-down and straight flag interaction

[Bill Schottstaedt]

> the note's flag is displaced a bit to the right of its stem

Thanks for the bug report (though this sort of stuff drives me crazy...);
here's a version of cmn2.lisp draw-flags that seems to work better:

(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*)
	(if up-stem
	    (incf x0 (note-head-x0-offset note up-stem *half-stem-width*))
	  (incf x0 (- (note-head-x0-offset note up-stem *half-stem-width*) *half-stem-width*)))
        ;; -> (cmn treble c5 s)
	(if (and up-stem *curvy-flags*)
	    (incf x0 (- (note-head-x0-offset note up-stem *half-stem-width*)  *half-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)))
	  #-(or gcl sbcl)	  
	  (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))))
	  #+(or gcl sbcl)
	  (do ((i 1 (1+ i))
	       (y y0 (+ y incr)))
	      ((>= i nflags))
	    (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))))
	  )

      ;; not *curvy-flags*
      ;; all the .3's below are probably wrong for unusual note heads or note head sizes
      (let* ((bx0 (+ x0 (if up-stem 
			    (if (member (note-head note) *centered-note-heads*)
				(- *half-stem-width*) 
			      (- .3 *half-stem-width*)) ; .3=head size
			  *half-stem-width*)))
	     (by0 (if up-stem (- stem-end *beam-width*) stem-end)))

	#-(or gcl sbcl)
	(loop for i from 0 below nflags and y from by0 by incr do
	  (moveto score bx0 y)
	  ;; this version from AV 7-Oct-02
	  (rlineto score *straight-flag-dx* (if up-stem (- *straight-flag-dy*) *straight-flag-dy*))
	  (rlineto score 0.0 *beam-width*)
	  (lineto score bx0 (+ y *beam-width*))
	  (lineto score bx0 y)
	  (fill-in score))

	#+(or gcl sbcl)
	(do ((i 0 (1+ i))
	     (y by0 (+ y incr)))
	    ((>= i nflags))
	  (moveto score bx0 y)
	  (rlineto score *straight-flag-dx* (if up-stem (- *straight-flag-dy*) *straight-flag-dy*))
	  (rlineto score 0.0 *beam-width*)
	  (lineto score bx0 (+ y *beam-width*))
	  (lineto score bx0 y)
	  (fill-in score))
	))))


I've updated the cmn tarball.