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

Modified Files: sdl.lisp Log Message: Fixed the problem with the C clef.

--- /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/06/05 00:53:41 1.26 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/06/05 18:43:56 1.27 @@ -492,7 +492,7 @@ ;;; reflected + shifted the thickness of the staff line.

(defmethod compute-design ((font font) (shape (eql :c-clef))) - (with-slots ((sld staff-line-distance) staff-line-thickness) font + (with-slots ((sld staff-line-distance) staff-line-thickness yoffset) font (flet ((c (x y) (complex x y))) (let* ( ;; define some x coordinates (xa (ceiling (* 0.5 sld))) @@ -509,7 +509,8 @@ (xk (+ xj (ceiling (* 0.5 sld)))) (xl (+ xe (round staff-line-thickness))) ;; define some y coordinates - (top (* 2 sld)) + (ystart (* 0.5 staff-line-thickness)) + (top (+ (* 2 sld) (* 0.5 staff-line-thickness))) (yd (+ sld (max 1 (round (* 0.1 sld))))) (ye sld) (yg (- top (* 2 staff-line-thickness))) @@ -517,7 +518,7 @@ (yj ye) (yk yj) (yl yh) - (p (mf (c xc 0) (direction #c(2 1)) ++ + (p (mf (c xc ystart) (direction #c(2 1)) ++ (direction #c(1 2)) (c xe ye) & (c xe ye) -- (c (1+ xe) ye) & (c (1+ xe) ye) (direction #c(1 -2)) ++ @@ -530,22 +531,23 @@ (c xd (+ yd (* 0.5 dot-width))) up ++ (c xf top) right ++ (c xk yk) down ++ (c xh (- yh staff-line-thickness)) ++ (c xl yl) & (c xl yl) ++ down (c xi 0))) - (q (translate (yscale p -1) (c 0 (- staff-line-thickness)))) + (q (yscale p -1)) (r (climi::close-path (reduce #'clim:region-union (list p - (mf (c xi 0) -- (c xi (- staff-line-thickness))) (climi::reverse-path q) - (mf (c xc (- staff-line-thickness)) -- (c xc 0))))))) - (clim:region-union - (climi::close-path (mf (c 0 top) -- (c xa top) -- - (c xa (- top)) -- - (c 0 (- top)) -- (c 0 top))) + (mf (c xc (- ystart)) -- (c xc ystart))))))) + (translate (clim:region-union - (climi::close-path (mf (c xb top) -- (c xc top) -- - (c xc (- top)) -- - (c xb (- top)) -- (c xb top))) - (translate r (c 0 staff-line-thickness)))))))) + (climi::close-path (mf (c 0 top) -- (c xa top) -- + (c xa (- top)) -- + (c 0 (- top)) -- (c 0 top))) + (clim:region-union + (climi::close-path (mf (c xb top) -- (c xc top) -- + (c xc (- top)) -- + (c xb (- top)) -- (c xb top))) + r)) + (c 0 yoffset))))))

;;; ;;;