Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv28358

Modified Files: buffer.lisp gui.lisp measure.lisp modes.lisp sdl.lisp Log Message: Support for semi/sesqui sharp/flat.

* don't declare the type of the accidentals slot any more; we can put that back in a little, after we work out a declarative way of defining all properties of accidentals.

* microsharpen and microflatten commands and functions; define sharpen and flatten in terms of those (and knowing which accidentals are the tonal ones). Keybindings for the commands.

* a more declarative table-based system for kerning accidentals, along with the ability to specify a per-glyph default (and a default default). Choose a sensible default default; also alter the :sharp/:sharp table when +4 steps away, as the previous value was colliding a little too much.

* support for playing the semi accidentals in equal temperament. No support in linear temperament, as I don't know what they mean.

* glyphs defined with a little too much liberal cut'n'paste. Some FIXMEs note the essential differences between the related glyphs.

--- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/06/18 15:18:17 1.46 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/06/21 11:14:25 1.47 @@ -219,8 +219,10 @@ (head :initform nil :initarg :head :reader head :type (or (member :whole :half :filled) null)) (accidentals :initform :natural :initarg :accidentals :reader accidentals - :type (member :natural :flat :double-flat - :sharp :double-sharp)) + ;; FIXME: we want :TYPE ACCIDENTAL here but need to + ;; sort out order of definition for that to be useful. + #+nil #+nil + :type (member :natural :flat :double-flat :sharp :double-sharp)) (dots :initform nil :initarg :dots :reader dots :type (or (integer 0 3) null)) (%tie-right :initform nil :initarg :tie-right :accessor tie-right) @@ -230,8 +232,9 @@ (declare (type (integer 0 127) pitch) (type staff staff) (type (or (member :whole :half :filled) null) head) - (type (member :natural :flat :double-flat - :sharp :double-sharp) + ;; FIXME: :TYPE ACCIDENTAL + #+nil #+nil + (type (member :natural :flat :double-flat :sharp :double-sharp) accidentals) (type (or (integer 0 3) null) dots) (ignore head accidentals dots)) @@ -300,9 +303,13 @@ (ecase pitch (0 0) (1 200) (2 400) (3 500) (4 700) (5 900) (6 1100)) (ecase (accidentals note) (:double-flat -200) + (:sesquiflat -150) (:flat -100) + (:semiflat -50) (:natural 0) + (:semisharp 50) (:sharp 100) + (:sesquisharp 150) (:double-sharp 200)))))

;;; regular temperaments are temperaments that --- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/06/18 15:18:17 1.77 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/06/21 11:14:25 1.78 @@ -822,17 +822,61 @@ (add-note element new-note) (setf *current-note* new-note))))

+(defmacro define-microtonal-accidentals (&rest microaccidentals) + `(progn + (setf (symbol-plist 'microsharpen) + ',(loop for (a b) on microaccidentals + if b collect a and collect b + else collect a and collect a)) + (setf (symbol-plist 'microflatten) + ',(loop for (a b) on (reverse microaccidentals) + if b collect a and collect b + else collect a and collect a)) + (deftype accidental () '(member ,@microaccidentals)) + (defun microsharpen (accidental) + (or (getf (symbol-plist 'microsharpen) accidental) + (error 'type-error :datum accidental :expected-type 'microaccidental))) + (defun microflatten (accidental) + (or (getf (symbol-plist 'microflatten) accidental) + (error 'type-error :datum accidental :expected-type 'microaccidental))))) + +(defmacro define-accidentals (&rest accidentals) + `(progn + (deftype accidental () '(member ,@accidentals)) + (defun sharpen (accidental) + (do ((a (microsharpen accidental) (microsharpen a)) + (olda accidental a)) + ((or (eq a olda) (member a ',accidentals)) a))) + (defun flatten (accidental) + (do ((a (microflatten accidental) (microflatten a)) + (olda accidental a)) + ((or (eq a olda) (member a ',accidentals)) a))))) + +(define-microtonal-accidentals :double-flat :sesquiflat :flat :semiflat + :natural + :semisharp :sharp :sesquisharp :double-sharp) + +(define-accidentals :double-flat :flat :natural :sharp :double-sharp) + (define-gsharp-command com-sharper () (let* ((cluster (cur-cluster)) (note (cur-note)) (new-note (make-note (pitch note) (staff note) :head (head note) - :accidentals (ecase (accidentals note) - (:double-sharp :double-sharp) - (:sharp :double-sharp) - (:natural :sharp) - (:flat :natural) - (:double-flat :flat)) + :accidentals (sharpen (accidentals note)) + :dots (dots note)))) + (remove-note note) + (add-note cluster new-note) + (setf *current-note* new-note))) + +(define-gsharp-command com-microsharper () + ;; FIXME: what are CUR-CLUSTER and CUR-NOTE and how do they relate + ;; to CURRENT-CLUSTER &c? + (let* ((cluster (cur-cluster)) + (note (cur-note)) + (new-note (make-note (pitch note) (staff note) + :head (head note) + :accidentals (microsharpen (accidentals note)) :dots (dots note)))) (remove-note note) (add-note cluster new-note) @@ -843,12 +887,18 @@ (note (cur-note)) (new-note (make-note (pitch note) (staff note) :head (head note) - :accidentals (ecase (accidentals note) - (:double-sharp :sharp) - (:sharp :natural) - (:natural :flat) - (:flat :double-flat) - (:double-flat :double-flat)) + :accidentals (flatten (accidentals note)) + :dots (dots note)))) + (remove-note note) + (add-note cluster new-note) + (setf *current-note* new-note))) + +(define-gsharp-command com-microflatter () + (let* ((cluster (cur-cluster)) + (note (cur-note)) + (new-note (make-note (pitch note) (staff note) + :head (head note) + :accidentals (microflatten (accidentals note)) :dots (dots note)))) (remove-note note) (add-note cluster new-note) --- /project/gsharp/cvsroot/gsharp/measure.lisp 2006/06/21 16:31:54 1.32 +++ /project/gsharp/cvsroot/gsharp/measure.lisp 2007/06/21 11:14:25 1.33 @@ -248,48 +248,57 @@ nil (accidentals note)))))

-;;; table of x offsets (in staff steps) of accendentals. -;;; The first index represents a notehead or a type of accidental. -;;; The second index represents a type of accidentsl. -;;; The third index is a vertical distance, measured in difference -;;; in staff steps between the two. -;;; The table entry gives how much the accidental represented by -;;; the second parameter must be positioned to the left of the -;;; first one. -;;; Entries in the table are offset by 5 in the last dimension -;;; so that vertical distances between -5 and 5 can be represented -(defparameter *accidental-offset* - ;;; -5 -4 -3 -2 -1 0 1 2 3 4 5 - #3A((( 0 0 0 3.5 3.5 3.5 3.5 3.5 3.5 1 0) ; notehead - dbl flat - ( 0 0 0 3.5 3.5 3.5 3.5 3.5 3.5 1 0) ; notehead - flat - ( 0 3.5 3.5 3.5 3.5 3.5 3.5 3.5 1 1 0) ; notehead - natural - ( 0 3.5 3.5 3.5 3.5 3.5 3.5 3.5 1 1 0) ; notehead - sharp - ( 0 0 0 3.5 3.5 3.5 3.5 3.5 0 0 0)) ; notehead - dbl sharp - (( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) ; dbl flat - dbl flat - ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) ; dbl flat - flat - ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) ; dbl flat - natural - ( 4 4 4 4 4 4 4 4 4 3.5 0) ; dbl flat - sharp - ( 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 0 0 0)) ; dbl flat - dbl sharp - (( 2 2 2 2 2 2 2 2 1.5 1 0) ; flat - dbl flat - ( 2 2 2 2 2 2 2 2 1.5 1 0) ; flat - flat - ( 2 2 2 2 2 2 2 2 1.5 1 0) ; flat - natural - ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 1.5 0) ; flat - sharp - ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 0 0 0)) ; flat - dbl sharp - (( 2 2 2 2 2 2 2 2 2 1.5 1.5) ; natural - dbl flat - ( 2 2 2 2 2 2 2 2 2 1.5 1.5) ; natural - flat - ( 2 2 2 2 2 2 2 2 2 1.5 1.5) ; natural - natural - ( 2 2 2 2 2 2 2 2 2 2 2) ; natural - sharp - ( 2 2 2 2 2 2 2 2 1 1 1)) ; natural - dbl sharp - (( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) ; sharp - dbl flat - ( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) ; sharp - flat - ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) ; sharp - natural - ( 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 2.0) ; sharp - sharp - ( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 0 0)) ; sharp - dbl sharp - (( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) ; dbl sharp - dbl flat - ( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) ; dbl sharp - flat - ( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) ; dbl sharp - natural - ( 0 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 0) ; dbl sharp - sharp - ( 0 0 0 2.8 2.8 2.8 2.8 2.8 0 0 0)))) ; dbl sharp - dbl sharp +(defmacro define-accidental-kerning (left right table) + `(let ((plist (getf (symbol-plist 'accidental-kerning) ',right))) + (setf (getf (symbol-plist 'accidental-kerning) ',right) + (cons (cons ',left ',table) + (remove ',left plist :key #'car))))) +(defmacro define-default-accidental-kerning (right table) + `(define-accidental-kerning default ,right ,table)) + +(macrolet ((define-kernings (&rest args) + `(progn ,@(loop for (left right table) on args by #'cdddr + collect `(define-accidental-kerning ,left ,right ,table))))) + (define-kernings + :double-flat :notehead #( 0 0 0 3.5 3.5 3.5 3.5 3.5 3.5 1 0) + :flat :notehead #( 0 0 0 3.5 3.5 3.5 3.5 3.5 3.5 1 0) + :natural :notehead #( 0 3.5 3.5 3.5 3.5 3.5 3.5 3.5 1 1 0) + :sharp :notehead #( 0 3.5 3.5 3.5 3.5 3.5 3.5 3.5 1 1 0) + :double-sharp :notehead #( 0 0 0 3.5 3.5 3.5 3.5 3.5 0 0 0) + + :double-flat :double-flat #(3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) + :flat :double-flat #(3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) + :natural :double-flat #(3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 3 3 0) + :sharp :double-flat #( 4 4 4 4 4 4 4 4 4 3.5 0) + :double-sharp :double-flat #(3.8 3.8 3.8 3.8 3.8 3.8 3.8 3.8 0 0 0) + + :double-flat :flat #( 2 2 2 2 2 2 2 2 1.5 1 0) + :flat :flat #( 2 2 2 2 2 2 2 2 1.5 1 0) + :natural :flat #( 2 2 2 2 2 2 2 2 1.5 1 0) + :sharp :flat #(2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 1.5 0) + :double-sharp :flat #(2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 0 0 0) + + :double-flat :natural #( 2 2 2 2 2 2 2 2 2 1.5 1.5) + :flat :natural #( 2 2 2 2 2 2 2 2 2 1.5 1.5) + :natural :natural #( 2 2 2 2 2 2 2 2 2 1.5 1.5) + :sharp :natural #( 2 2 2 2 2 2 2 2 2 2 2) + :double-sharp :natural #( 2 2 2 2 2 2 2 2 1 1 1) + + :double-flat :sharp #( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) + :flat :sharp #( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) + :natural :sharp #(2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0 1.5 1.0) + :sharp :sharp #(2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.0) + :double-sharp :sharp #( 0 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 0 0) + + :double-flat :double-sharp #( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) + :flat :double-sharp #( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) + :natural :double-sharp #( 0 0 2.4 2.4 2.4 2.4 2.4 2.4 2 1 0) + :sharp :double-sharp #( 0 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 0) + :double-sharp :double-sharp #( 0 0 0 2.8 2.8 2.8 2.8 2.8 0 0 0) + )) + +(defvar *default-accidental-kerning* + #(4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0 4.0))

;;; given 1) a type of accidental 2) its position (in staff steps) 3) ;;; a type of accidental or a type of notehead, and 4) its position, @@ -297,24 +306,16 @@ ;;; steps to the left that it must be moved in order to avoid overlap ;;; with the second one. (defun accidental-distance (acc1 pos1 acc2 pos2) - (let ((dist (- pos2 pos1))) - (if (> (abs dist) 5) - 0 - (aref *accidental-offset* - (ecase acc2 - (:notehead 0) - (:double-flat 1) - (:flat 2) - (:natural 3) - (:sharp 4) - (:double-sharp 5)) - (ecase acc1 - (:double-flat 0) - (:flat 1) - (:natural 2) - (:sharp 3) - (:double-sharp 4)) - (+ dist 5))))) + (let* ((dist (- pos2 pos1)) + (right-info (getf (symbol-plist 'accidental-kerning) acc2)) + (left-right-info (cdr (assoc acc1 right-info))) + (default-right-info (cdr (assoc 'default right-info)))) + (cond + ((> (abs dist) 5) 0) + ((or (not right-info) (and (not left-right-info) (not default-right-info))) + (aref *default-accidental-kerning* (+ dist 5))) + ((not left-right-info) (aref default-right-info (+ dist 5))) + (t (aref left-right-info (+ dist 5))))))

;;; given two notes (where the first one has an accidental, and the ;;; second one may or may not have an accidental) and the conversion --- /project/gsharp/cvsroot/gsharp/modes.lisp 2007/06/10 08:15:29 1.23 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2007/06/21 11:14:27 1.24 @@ -84,6 +84,8 @@

(set-key 'com-sharper 'cluster-table '((##))) (set-key 'com-flatter 'cluster-table '(#@)) +(set-key 'com-microsharper 'cluster-table '((## :control))) +(set-key 'com-microflatter 'cluster-table '((#@ :control :shift))) (set-key 'com-add-note-c 'cluster-table '(#\C)) (set-key 'com-add-note-d 'cluster-table '(#\D)) (set-key 'com-add-note-e 'cluster-table '(#\E)) --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/06/07 22:40:26 1.31 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2007/06/21 11:14:27 1.32 @@ -1009,6 +1009,56 @@ ;;; ;;; Accidentals

+(defmethod compute-design ((font font) (shape (eql :semisharp))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + stem-thickness + yoffset) font + (let* (;; A factor that determines the space between the vertical + ;; bars and the outer edge of the character as a fraction of + ;; the staff line distance + (edge-distance-multiplier 0.2) + ;; A factor that determines the height of the thin part as a + ;; fraction of the staff line distance + (height-multiplier 2.5) + ;; A factor that determines the width of the hole as a fraction of the + ;; staff line distance. + (hole-width-multiplier 0.33) + (hole-width (round (* hole-width-multiplier sld))) + ;; Hope that half a pixel will not be visible and will not influence + ;; the required distance to the noteheads. + ;; + ;; FIXME: this is the only real difference between the + ;; :semisharp and :sesquisharp glyph calculations, and the + ;; :sharp glyph. Find a way to unify the glyph + ;; computations in a proper metafonty way. + (xoffset (if (oddp hole-width) 0.5 0.5)) + (edge-distance (* edge-distance-multiplier sld)) + (width (+ hole-width (* 2 stem-thickness) (* 2 edge-distance))) + ;; FIXME: this leads to a blurry glyph at most sizes: + ;; choose a coordinate which lies on a pixel boundary in + ;; preference. + (xleft (* -0.25 width)) + (xright (- xleft)) + (yleft (* -0.15 width)) + (yright (- yleft)) + ;; The path for the thick part symmetric around (0, 0) + (thickpart (mf (complex xleft yleft) -- (complex xright yright))) + ;; Determine the y coordinate of the previous path at the + ;; cross point of the thin part. Use congruent triangles. + (ythin (/ (* (- xright edge-distance) yright) xright)) + (height (* height-multiplier sld)) + ;; The path for the thin part symmetric around (0, 0) + (thinpart (mf (complex 0 (* 0.5 height)) -- (complex 0 (* -0.5 height))))) + (clim:region-union + (with-pen (rotate (scale +razor+ (* 0.4 sld)) (/ pi 2)) + (clim:region-union (draw-path (translate thickpart + (complex xoffset (+ yoffset (* 0.5 sld))))) + (draw-path (translate thickpart + (complex xoffset (+ yoffset (* -0.5 sld))))))) + (with-pen (scale +razor+ stem-thickness) + (draw-path (translate thinpart (complex xoffset yoffset)))))))) + (defmethod compute-design ((font font) (shape (eql :sharp))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness) @@ -1060,6 +1110,58 @@ (* 0.5 stem-thickness)) (+ yoffset ythin))))))))))

+(defmethod compute-design ((font font) (shape (eql :sesquisharp))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + stem-thickness + yoffset) font + (let* (;; A factor that determines the space between the vertical + ;; bars and the outer edge of the character as a fraction of + ;; the staff line distance + (edge-distance-multiplier 0.2) + ;; A factor that determines the height of the thin part as a + ;; fraction of the staff line distance + (height-multiplier 2.5) + ;; A factor that determines the width of the hole as a fraction of the + ;; staff line distance. + (hole-width-multiplier 0.33) + (hole-width (round (* hole-width-multiplier sld))) + ;; Hope that half a pixel will not be visible and will not + ;; influence the required distance to the noteheads. + ;; + ;; FIXME: see note in :semisharp glyph at this point + (xoffset (if (oddp hole-width) 0.5 0.5)) + (edge-distance (* edge-distance-multiplier sld)) + (width (+ hole-width (* 2 stem-thickness) (* 2 edge-distance))) + (xleft (* -0.75 width)) + (xright (- xleft)) + (yleft (* -0.15 width)) + (yright (- yleft)) + ;; The path for the thick part symmetric around (0, 0) + (thickpart (mf (complex xleft yleft) -- (complex xright yright))) + ;; Determine the y coordinate of the previous path at the + ;; cross point of the thin part. Use congruent triangles. + (ythin (/ (* (- xright edge-distance) yright) xright)) + (height (* height-multiplier sld)) + ;; The path for the thin part symmetric around (0, 0) + (thinpart (mf (complex 0 (* 0.5 height)) -- (complex 0 (* -0.5 height))))) + (clim:region-union + (with-pen (rotate (scale +razor+ (* 0.4 sld)) (/ pi 2)) + (clim:region-union (draw-path (translate thickpart + (complex xoffset (+ yoffset (* 0.5 sld))))) + (draw-path (translate thickpart + (complex xoffset (+ yoffset (* -0.5 sld))))))) + (with-pen (scale +razor+ stem-thickness) + (clim:region-union + (clim:region-union + (draw-path (translate thinpart + (complex (- xoffset hole-width (* 1 stem-thickness)) + (- yoffset ythin)))) + (draw-path (translate thinpart (complex (- xoffset (* 0 stem-thickness)) yoffset)))) + (draw-path (translate thinpart + (complex (+ xoffset hole-width (* 1 stem-thickness)) + (+ yoffset ythin)))))))))) + (defmethod compute-design ((font font) (shape (eql :double-sharp))) (with-slots ((sld staff-line-distance) xoffset yoffset) font (flet ((c (x y) (complex x y))) @@ -1075,13 +1177,38 @@ (translate (rotate leg (* pi 1.0)) (c xoffset yoffset)) (translate (rotate leg (* pi 1.5)) (c xoffset yoffset))))))))

+(defmethod compute-design ((font font) (shape (eql :semiflat))) + (with-slots ((sld staff-line-distance) stem-thickness) font + (flet ((c (x y) (complex x y))) + (let* ((outer (xyscale (translate (rotate +half-circle+ pi) #c(-0.5 0)) + (* 1 sld) (* 1 sld))) + ;; FIXME: 1.2 here (and in the :sesquiflat glyph, below) + ;; represents the difference in width between the + ;; :semiflat bulge and the regular :flat bulge. Find a + ;; way to share code between the glyphs. + (inner (xyscale (translate (rotate +half-circle+ pi) #c(-0.6 0)) + (* 0.75 sld) (* (/ 0.75 1.2) sld))) + (middle (mf (climi::path-end outer) -- (climi::path-end inner))) + (finish (mf (climi::path-start inner) -- (climi::path-start outer))) + (combined (climi::close-path + (reduce #'clim:region-union + (list outer middle (climi::reverse-path inner) finish))))) + (clim:region-union (translate (rotate (slant combined 0.6) (- (/ pi 2))) + (c (round (- (* -0.2 sld) stem-thickness)) (* -0.5 sld))) + (with-pen (scale +razor+ stem-thickness) + (draw-path (mf (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness)) + (* 1.5 sld)) + -- + (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness)) + (* -0.5 sld)))))))))) + (defmethod compute-design ((font font) (shape (eql :flat))) (with-slots ((sld staff-line-distance) stem-thickness) font (flet ((c (x y) (complex x y))) (let* ((outer (xyscale (translate +half-circle+ #c(-0.5 0)) sld (* 1.2 sld))) (inner (scale (translate +half-circle+ #c(-0.6 0)) - (* 0.8 sld))) + (* 0.75 sld))) (middle (mf (climi::path-end outer) -- (climi::path-end inner))) (finish (mf (climi::path-start inner) -- (climi::path-start outer))) (combined (climi::close-path @@ -1096,6 +1223,38 @@ (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness)) (* -0.5 sld))))))))))

+(defmethod compute-design ((font font) (shape (eql :sesquiflat))) + (with-slots ((sld staff-line-distance) stem-thickness) font + (flet ((c (x y) (complex x y))) + (let* ((outer (xyscale (translate (rotate +half-circle+ pi) #c(-0.5 0)) + (* 1 sld) (* 1 sld))) + (inner (xyscale (translate (rotate +half-circle+ pi) #c(-0.6 0)) + (* 0.75 sld) (* (/ 0.75 1.2) sld))) + (middle (mf (climi::path-end outer) -- (climi::path-end inner))) + (finish (mf (climi::path-start inner) -- (climi::path-start outer))) + (combined (climi::close-path + (reduce #'clim:region-union + (list outer middle (climi::reverse-path inner) finish)))) + (outer1 (xyscale (translate +half-circle+ #c(-0.5 0)) + sld (* 1.2 sld))) + (inner1 (scale (translate +half-circle+ #c(-0.6 0)) + (* 0.75 sld))) + (middle1 (mf (climi::path-end outer1) -- (climi::path-end inner1))) + (finish1 (mf (climi::path-start inner1) -- (climi::path-start outer1))) + (combined1 (climi::close-path + (reduce #'clim:region-union + (list outer1 middle1 (climi::reverse-path inner1) finish1))))) + (clim:region-union (clim:region-union (translate (rotate (slant combined (* 0.6 1.2)) (- (/ pi 2))) + (c (round (- (* -0.2 sld) stem-thickness)) (* -0.5 sld))) + (translate (rotate (slant combined1 -0.6) (- (/ pi 2))) + (c (round (* -0.2 sld)) (* -0.5 sld)))) + (with-pen (scale +razor+ stem-thickness) + (draw-path (mf (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness)) + (* 1.5 sld)) + -- + (c (- (round (* -0.2 sld)) (* 0.5 stem-thickness)) + (* -0.5 sld)))))))))) + (defmethod compute-design ((font font) (shape (eql :double-flat))) (with-slots ((sld staff-line-distance) stem-thickness) font (flet ((c (x y) (complex x y)))