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

Modified Files: bezier.lisp sdl.lisp score-pane.lisp Log Message: Output recording of Bezier designs seems to be working now.

Clefs are now drawn using the new system. There is still considerable ugliness in the code, but I intend to work on that incrementally.

Modified the G clef to look a bit better (which is easier to do with the new system than with the Metafont program).

--- /project/gsharp/cvsroot/gsharp/bezier.lisp 2006/05/29 19:55:24 1.1 +++ /project/gsharp/cvsroot/gsharp/bezier.lisp 2006/05/30 02:13:26 1.2 @@ -63,10 +63,31 @@ ;;; define the trampoline method from a sheet to a medium (def-graphic-op draw-design (design))

-;;; define output records, etc -(def-grecording draw-design (() design) () - (setf (slot-value climi::graphic 'design) design) - (bounding-rectangle* design)) +(defclass bezier-design-output-record (standard-graphics-displayed-output-record) + ((stream :initarg :stream) + (design :initarg :design))) + +(defmethod initialize-instance :after ((record bezier-design-output-record) &key) + (with-slots (design) record + (setf (rectangle-edges* record) + (bounding-rectangle* design)))) + +(defmethod medium-draw-design* :around ((stream output-recording-stream) design) + (with-sheet-medium (medium stream) + (let ((transformed-design (transform-region (medium-transformation medium) design))) + (when (stream-recording-p stream) + (let ((record (make-instance 'bezier-design-output-record + :stream stream + :design transformed-design))) + (stream-add-output-record stream record))) + (when (stream-drawing-p stream) + (medium-draw-design* medium design))))) + +(defmethod replay-output-record ((record bezier-design-output-record) stream &optional + (region +everywhere+) (x-offset 0) (y-offset 0)) + (declare (ignore x-offset y-offset region)) + (with-slots (design) record + (medium-draw-design* (sheet-medium stream) design)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/05/29 19:55:24 1.15 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/05/30 02:13:26 1.16 @@ -425,7 +425,8 @@ ;;;

(defmethod compute-design ((font font) (shape (eql :g-clef))) - (with-slots ((sld staff-line-distance) staff-line-thickness stem-thickness) font + (with-slots ((sld staff-line-distance) staff-line-thickness + stem-thickness yoffset) font (let* ((xf 0.0) (yf (* 0.5 sld)) (xy (max 2.0 (round (* 0.4 sld)))) (yy (* 0.2 sld)) (xb (+ xy (max 2.0 (round (* 0.4 sld))))) (yb (* 0.3 sld)) @@ -433,7 +434,7 @@ (xa (+ xcc (max 1.0 (* 0.2 sld)))) (ya (* -0.4 sld)) (xc (+ xb (round (* 0.7 sld)))) (yc (+ sld (max 1.0 (* 0.15 sld)))) (xd (+ xc sld)) (yd 0.0) - (xe (* 1.5 sld)) (ye (- (+ staff-line-thickness sld))) + (xe (* 1.5 sld)) (ye (- sld)) (xg (round (* 1.8 sld))) (yg (* 3.8 sld)) (xw (- xg (* 2.0 staff-line-thickness))) (yw (round (* 5.0 sld))) (xh xw) (yh (- yw (max 2.0 (round (* 0.4 sld))))) @@ -450,7 +451,9 @@ (xl (+ xs stem-thickness)) (yl ys) (xm (- xp (* 1 staff-line-thickness))) (ym (round (* -2.75 sld))) (xr xm) (yr (+ ym staff-line-thickness)) - (xz xe) (yz (- staff-line-thickness sld)) + (xz xe) + ;; yz should be slightly above the upper edge of the staff line + (yz (+ (- sld) (* 1.2 staff-line-thickness))) (xaa (- xd (max 1 (round (* 0.3 sld))))) (yaa yd) (xbb xc) (ybb (- sld staff-line-thickness (max 2 (* 0.3 sld)))) (xdd xp) (ydd (* 2 sld)) @@ -458,36 +461,37 @@ (xff (floor (* 1.4 sld))) (yff sld) (xgg (+ xff stem-thickness)) (ygg yff)) (flet ((c (x y) (complex x y))) - (mf (c xa ya) ++ (c xb yb) up ++ (c xc yc) right ++ - (c xd yd) down ++ (c xe ye) left ++ (c xf yf) up ++ - (c xee yee) ++ - (c xg yg) up - (tensions 1 1.8) - (c xh yh) - (tensions 1.8 1) - (c xi yi) - (tensions 1.8 1) - (c xgg ygg) (direction #c(1 -4)) - (tensions 1 20) - (c xl yl) down ++ - (c xm ym) left ++ - (c xn yn) up ++ (c xo yo) right ++ (c xp yp) down ++ - (c xq yq) & - (c xq yq) ++ (c xr yr) right ++ - (c xs ys) up - (tensions 20 1) - (c xff yff) (direction #c(-1 4)) - (tensions 1 1.8) - (c xv yv) up - (tensions 1 1.8) - (c xw yw) right - (tensions 1.8 1) - (c xx yx) down ++ - (c xdd ydd) ++ - (c xy yy) down ++ (c xz yz) right ++ - (c xaa yaa) up ++ (c xbb ybb) left ++ - (c xcc ycc) down ++ (c (+ xa 1) ya) & - (c (+ xa 1) ya) ++ cycle))))) ; replace ++ by -- one day + (translate (mf (c xa ya) ++ (c xb yb) up ++ (c xc yc) right ++ + (c xd yd) down ++ (c xe ye) left ++ (c xf yf) up ++ + (c xee yee) ++ + (c xg yg) up + (tensions 1 1.8) + (c xh yh) + (tensions 1.8 1) + (c xi yi) + (tensions 1.8 1) + (c xgg ygg) (direction #c(1 -4)) + (tensions 1 20) + (c xl yl) down ++ + (c xm ym) left ++ + (c xn yn) up ++ (c xo yo) right ++ (c xp yp) down ++ + (c xq yq) & + (c xq yq) ++ (c xr yr) right ++ + (c xs ys) up + (tensions 20 1) + (c xff yff) (direction #c(-1 4)) + (tensions 1 1.8) + (c xv yv) up + (tensions 1 1.8) + (c xw yw) right + (tensions 1.8 1) + (c xx yx) down ++ + (c xdd ydd) ++ + (c xy yy) down ++ (c xz yz) right ++ + (c xaa yaa) up ++ (c xbb ybb) left ++ + (c xcc ycc) down ++ (c (+ xa 1) ya) & + (c (+ xa 1) ya) ++ cycle) + (complex 0 yoffset)))))) ; replace ++ by -- one day

;;; ;;; xa xb --- /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/05/29 19:55:24 1.24 +++ /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/05/30 02:13:26 1.25 @@ -265,16 +265,14 @@ ((:treble :treble8) :g-clef) (:bass :f-clef) (:c :c-clef)) - x (staff-step staff-step))) + x (staff-step (- staff-step)))) - - (define-presentation-type clef () :options (name x staff-step))

(define-presentation-method present (object (type clef) stream (view score-view) &key) (with-output-as-presentation (stream object 'clef) - (draw-clef stream name x staff-step))) + (new-draw-clef stream name x staff-step)))

;;;;;;;;;;;;;;;;;; rest