Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv7403
Modified Files: drawing.lisp Log Message: Some code factoring.
Date: Sat Nov 12 08:14:29 2005 Author: rstrandh
Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.18 gsharp/drawing.lisp:1.19 --- gsharp/drawing.lisp:1.18 Fri Nov 11 20:19:39 2005 +++ gsharp/drawing.lisp Sat Nov 12 08:14:28 2005 @@ -187,6 +187,36 @@ (define-added-mixin welement () lyrics-element ((xpos :accessor element-xpos)))
+;;; given a list of notes, return the one that is at the top +(defun top-note (notes) + (reduce (lambda (n1 n2) + (cond ((< (staff-yoffset (staff n1)) + (staff-yoffset (staff n2))) + n1) + ((> (staff-yoffset (staff n1)) + (staff-yoffset (staff n2))) + n2) + ((> (note-position n1) + (note-position n2)) + n1) + (t n2))) + notes)) + +;;; given a list of notes, return the one that is at the bottom +(defun bot-note (notes) + (reduce (lambda (n1 n2) + (cond ((> (staff-yoffset (staff n1)) + (staff-yoffset (staff n2))) + n1) + ((< (staff-yoffset (staff n1)) + (staff-yoffset (staff n2))) + n2) + ((< (note-position n1) + (note-position n2)) + n1) + (t n2))) + notes)) + ;;; compute and store several important pieces of information ;;; about an element: ;;; * the position, in staff steps of the top note. @@ -195,30 +225,8 @@ ;;; * the y-offset of the staff containing the bottom note. (defun compute-top-bot-pos-yoffset (element) (if (and (typep element 'cluster) (notes element)) - (let ((top-note (reduce (lambda (n1 n2) - (cond ((< (staff-yoffset (staff n1)) - (staff-yoffset (staff n2))) - n1) - ((> (staff-yoffset (staff n1)) - (staff-yoffset (staff n2))) - n2) - ((> (note-position n1) - (note-position n2)) - n1) - (t n2))) - (notes element))) - (bot-note (reduce (lambda (n1 n2) - (cond ((> (staff-yoffset (staff n1)) - (staff-yoffset (staff n2))) - n1) - ((< (staff-yoffset (staff n1)) - (staff-yoffset (staff n2))) - n2) - ((< (note-position n1) - (note-position n2)) - n1) - (t n2))) - (notes element)))) + (let ((top-note (top-note (notes element))) + (bot-note (bot-note (notes element)))) (setf (top-note-pos element) (note-position top-note) (bot-note-pos element) (note-position bot-note) (bot-note-staff-yoffset element) (staff-yoffset (staff bot-note))