gsharp-cvs

gsharp-cvs@common-lisp.net

396 discussions

[gsharp-cvs] CVS gsharp
by crhodes 02 Jun '06

02 Jun '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv30880 Modified Files: score-pane.lisp Log Message: Use the new code for all the pixmap-recording things (noteheads, rests, ties, flags, accidentals). Some degradation in output as a result * misalignments between stems and noteheads; * whole and half rests do not line up with staff lines; * flag has a discontinuity near the extreme point on the inside. (Possibly others. On the other hand, this means that with my local modifications I can produce things like <http://www-jcsu.jesus.cam.ac.uk/~csr21/gsharp-cris.ps>) --- /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/05/30 02:13:26 1.25 +++ /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/06/02 14:11:10 1.26 @@ -211,6 +211,8 @@ ;;;;;;;;;;;;;;;;;; helper macro +;;; This macro is currently not used. (And probably never will be +;;; used, now that we raster our own bezier curves.) (defmacro define-pixmap-recording ((draw-name args) &body body) `(defun ,draw-name (pane ,@args x staff-step) (let* ((extra (if *light-glyph* 1 0)) @@ -222,14 +224,16 @@ ;;;;;;;;;;;;;;;;;; notehead -(define-pixmap-recording (draw-notehead (name)) - (ecase name - (:whole +glyph-whole+) - (:half +glyph-half+) - (:filled +glyph-filled+))) - (define-presentation-type notehead () :options (name x staff-step)) +(defun draw-notehead (stream name x staff-step) + (sdl::draw-shape stream *font* + (ecase name + (:whole :whole-notehead) + (:half :half-notehead) + (:filled :filled-notehead)) + x (staff-step (- staff-step)))) + (define-presentation-method present (object (type notehead) stream (view score-view) &key) (with-output-as-presentation (stream object 'notehead) @@ -237,31 +241,19 @@ ;;;;;;;;;;;;;;;;;; accidental -(define-pixmap-recording (draw-accidental (name)) - (ecase name - (:natural +glyph-natural+) - (:flat +glyph-flat+) - (:double-flat +glyph-double-flat+) - (:sharp +glyph-sharp+) - (:double-sharp +glyph-double-sharp+))) +(defun draw-accidental (stream name x staff-step) + (sdl::draw-shape stream *font* name x (staff-step (- staff-step)))) ;;;;;;;;;;;;;;;;;; clef -(define-pixmap-recording (draw-clef (name)) - (ecase name - ;; FIXME: while using the same glyph for :TREBLE and :TREBLE8 is - ;; fine from a musical point of view, some differentiation (by - ;; putting an italic 8 underneath, for instance) would be good. - ((:treble :treble8) +glyph-g-clef+) - (:bass +glyph-f-clef+) - (:c +glyph-c-clef+))) - -(defun new-draw-clef (stream name x staff-step) +(defun draw-clef (stream name x staff-step) (sdl::draw-shape stream *font* (ecase name - ;; FIXME: while using the same glyph for :TREBLE and :TREBLE8 is - ;; fine from a musical point of view, some differentiation (by - ;; putting an italic 8 underneath, for instance) would be good. + ;; FIXME: while using the same glyph for :TREBLE + ;; and :TREBLE8 is fine from a musical point of + ;; view, some differentiation (by putting an + ;; italic 8 underneath, for instance) would be + ;; good. ((:treble :treble8) :g-clef) (:bass :f-clef) (:c :c-clef)) @@ -272,45 +264,52 @@ (define-presentation-method present (object (type clef) stream (view score-view) &key) (with-output-as-presentation (stream object 'clef) - (new-draw-clef stream name x staff-step))) + (draw-clef stream name x staff-step))) ;;;;;;;;;;;;;;;;;; rest -(define-pixmap-recording (draw-rest (duration)) - (ecase duration - (1 +glyph-whole-rest+) - (1/2 +glyph-half-rest+) - (1/4 +glyph-quarter-rest+) - (1/8 +glyph-eighth-rest+) - (1/16 +glyph-sixteenth-rest+) - (1/32 +glyph-thirtysecondth-rest+) - (1/64 +glyph-sixtyfourth-rest+) - (1/128 +glyph-onehundredandtwentyeigth-rest+))) +(defun draw-rest (stream duration x staff-step) + (sdl::draw-shape stream *font* + (ecase duration + (1 :whole-rest) + (1/2 :half-rest) + (1/4 :quarter-rest) + (1/8 :8th-rest) + (1/16 :16th-rest) + (1/32 :32nd-rest) + (1/64 :64th-rest) + ;; FIXME 128th + ) + x (staff-step (- staff-step)))) ;;;;;;;;;;;;;;;;;; flags down -(define-pixmap-recording (draw-flags-down (nb)) - (ecase nb - (1 +glyph-flags-down-one+) - (2 +glyph-flags-down-two+) - (3 +glyph-flags-down-three+) - (4 +glyph-flags-down-four+) - (5 +glyph-flags-down-five+))) +(defun draw-flags-down (stream nb x staff-step) + (sdl::draw-shape stream *font* + (ecase nb + (1 :flags-down-1) + (2 :flags-down-2) + (3 :flags-down-3) + (4 :flags-down-4) + (5 :flags-down-5)) + x (staff-step (- staff-step)))) ;;;;;;;;;;;;;;;;;; flags up -(define-pixmap-recording (draw-flags-up (nb)) - (ecase nb - (1 +glyph-flags-up-one+) - (2 +glyph-flags-up-two+) - (3 +glyph-flags-up-three+) - (4 +glyph-flags-up-four+) - (5 +glyph-flags-up-five+))) +(defun draw-flags-up (stream nb x staff-step) + (sdl::draw-shape stream *font* + (ecase nb + (1 :flags-up-1) + (2 :flags-up-2) + (3 :flags-up-3) + (4 :flags-up-4) + (5 :flags-up-5)) + x (staff-step (- staff-step)))) ;;;;;;;;;;;;;;;;;; dot -(define-pixmap-recording (draw-dot ()) - +glyph-dot+) +(defun draw-dot (stream x staff-step) + (sdl::draw-shape stream *font* :dot x (staff-step (- staff-step)))) ;;;;;;;;;;;;;;;;;; staff line @@ -652,58 +651,60 @@ (xx2 (round (- x2 (staff-step 10)))) (y1 (- (round (staff-step (+ staff-step 11/3))))) (thickness (round (staff-step 2/3)))) - (draw-antialiased-glyph pane +glyph-large-tie-left-up+ xx1 staff-step) - (draw-antialiased-glyph pane +glyph-large-tie-right-up+ xx2 staff-step) + (sdl::draw-shape pane *font* :large-tie-up-left xx1 (staff-step (- staff-step))) + (sdl::draw-shape pane *font* :large-tie-up-right xx2 (staff-step (- staff-step))) (draw-rectangle* pane xx1 y1 xx2 (+ y1 thickness))) - (let ((glyph-no (cond ((> dist 18) +glyph-large-tie-ten-up+) - ((> dist 17) +glyph-large-tie-nine-up+) - ((> dist 16) +glyph-large-tie-eight-up+) - ((> dist 15) +glyph-large-tie-seven-up+) - ((> dist 14) +glyph-large-tie-six-up+) - ((> dist 13) +glyph-large-tie-five-up+) - ((> dist 12) +glyph-large-tie-four-up+) - ((> dist 11) +glyph-large-tie-three-up+) - ((> dist 10) +glyph-large-tie-two-up+) - ((> dist 9) +glyph-large-tie-one-up+) - ((> dist 8) +glyph-small-tie-eight-up+) - ((> dist 7) +glyph-small-tie-seven-up+) - ((> dist 6) +glyph-small-tie-six-up+) - ((> dist 5) +glyph-small-tie-five-up+) - ((> dist 4) +glyph-small-tie-four-up+) - ((> dist 3) +glyph-small-tie-three-up+) - ((> dist 2) +glyph-small-tie-two-up+) - (t +glyph-small-tie-one-up+)))) - (draw-antialiased-glyph pane glyph-no (round (* 0.5 (+ x1 x2))) staff-step))))) + (let ((glyph-name (cond ((> dist 18) :large-tie-10-up) + ((> dist 17) :large-tie-9-up) + ((> dist 16) :large-tie-8-up) + ((> dist 15) :large-tie-7-up) + ((> dist 14) :large-tie-6-up) + ((> dist 13) :large-tie-5-up) + ((> dist 12) :large-tie-4-up) + ((> dist 11) :large-tie-3-up) + ((> dist 10) :large-tie-2-up) + ((> dist 9) :large-tie-1-up) + ((> dist 8) :small-tie-8-up) + ((> dist 7) :small-tie-7-up) + ((> dist 6) :small-tie-6-up) + ((> dist 5) :small-tie-5-up) + ((> dist 4) :small-tie-4-up) + ((> dist 3) :small-tie-3-up) + ((> dist 2) :small-tie-2-up) + (t :small-tie-1-up)))) + (sdl::draw-shape pane *font* glyph-name + (round (* 0.5 (+ x1 x2))) (staff-step (- staff-step))))))) (defun draw-tie-down (pane x1 x2 staff-step) (let ((dist (/ (- x2 x1) (staff-step 4/3)))) (if (> dist 19) (let ((xx1 (round (+ x1 (staff-step 10)))) (xx2 (round (- x2 (staff-step 10)))) - (y1 (- (round (staff-step (+ staff-step 11/3))))) + (y1 (- (round (staff-step (- staff-step 8/3))))) (thickness (round (staff-step 2/3)))) - (draw-antialiased-glyph pane +glyph-large-tie-left-down+ xx1 staff-step) - (draw-antialiased-glyph pane +glyph-large-tie-right-down+ xx2 staff-step) + (sdl::draw-shape pane *font* :large-tie-down-left xx1 (staff-step (- staff-step))) + (sdl::draw-shape pane *font* :large-tie-down-right xx2 (staff-step (- staff-step))) (draw-rectangle* pane xx1 y1 xx2 (+ y1 thickness))) - (let ((glyph-no (cond ((> dist 18) +glyph-large-tie-ten-down+) - ((> dist 17) +glyph-large-tie-nine-down+) - ((> dist 16) +glyph-large-tie-eight-down+) - ((> dist 15) +glyph-large-tie-seven-down+) - ((> dist 14) +glyph-large-tie-six-down+) - ((> dist 13) +glyph-large-tie-five-down+) - ((> dist 12) +glyph-large-tie-four-down+) - ((> dist 11) +glyph-large-tie-three-down+) - ((> dist 10) +glyph-large-tie-two-down+) - ((> dist 9) +glyph-large-tie-one-down+) - ((> dist 8) +glyph-small-tie-eight-down+) - ((> dist 7) +glyph-small-tie-seven-down+) - ((> dist 6) +glyph-small-tie-six-down+) - ((> dist 5) +glyph-small-tie-five-down+) - ((> dist 4) +glyph-small-tie-four-down+) - ((> dist 3) +glyph-small-tie-three-down+) - ((> dist 2) +glyph-small-tie-two-down+) - (t +glyph-small-tie-one-down+)))) - (draw-antialiased-glyph pane glyph-no (round (* 0.5 (+ x1 x2))) staff-step))))) + (let ((glyph-name (cond ((> dist 18) :large-tie-10-down) + ((> dist 17) :large-tie-9-down) + ((> dist 16) :large-tie-8-down) + ((> dist 15) :large-tie-7-down) + ((> dist 14) :large-tie-6-down) + ((> dist 13) :large-tie-5-down) + ((> dist 12) :large-tie-4-down) + ((> dist 11) :large-tie-3-down) + ((> dist 10) :large-tie-2-down) + ((> dist 9) :large-tie-1-down) + ((> dist 8) :small-tie-8-down) + ((> dist 7) :small-tie-7-down) + ((> dist 6) :small-tie-6-down) + ((> dist 5) :small-tie-5-down) + ((> dist 4) :small-tie-4-down) + ((> dist 3) :small-tie-3-down) + ((> dist 2) :small-tie-2-down) + (t :small-tie-1-down)))) + (sdl::draw-shape pane *font* glyph-name + (round (* 0.5 (+ x1 x2))) (staff-step (- staff-step))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[gsharp-cvs] CVS gsharp
by crhodes 02 Jun '06

02 Jun '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv25227 Modified Files: sdl.lisp Log Message: Implement the large (outsize) tie left and right curves. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/06/02 12:37:47 1.20 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/06/02 13:17:35 1.21 @@ -883,6 +883,36 @@ (c (- (- width 1.0)) (- top height)) -- (c (- width) (- top height)) ++ cycle)))) +(defun large-tie-up-left (sld slt width-multiplier) + (declare (ignore slt)) + (let* ((thickness (round (* 0.33 sld))) + (height (round (* 1.0 sld))) + (top (round (* 11/6 sld))) + (width (* width-multiplier sld))) + (flet ((c (x y) (complex x y))) + (climi::close-path + (mf (c 0.0 top) left ++ + (c (- width) (- top height)) -- + (c (- (- width 1.0)) (- top height)) ++ + (c (* -0.3 width) (- top thickness)) ++ + (c 0.0 (- top thickness)) & + (c 0.0 (- top thickness)) -- (c 0.0 top)))))) + +(defun large-tie-up-right (sld slt width-multiplier) + (declare (ignore slt)) + (let* ((thickness (round (* 0.33 sld))) + (height (round (* 1.0 sld))) + (top (round (* 11/6 sld))) + (width (* width-multiplier sld))) + (flet ((c (x y) (complex x y))) + (climi::close-path + (mf (c 0.0 top) right ++ + (c width (- top height)) -- + (c (- width 1.0) (- top height)) ++ + (c (* 0.3 width) (- top thickness)) ++ + (c 0.0 (- top thickness)) & + (c 0.0 (- top thickness)) -- (c 0.0 top)))))) + (defmethod compute-design ((font font) (shape (eql :large-tie-1-up))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font (large-tie-up sld slt 2.0))) @@ -923,6 +953,14 @@ (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font (large-tie-up sld slt 5.0))) +(defmethod compute-design ((font font) (shape (eql :large-tie-up-left))) + (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font + (large-tie-up-left sld slt 5.0))) + +(defmethod compute-design ((font font) (shape (eql :large-tie-up-right))) + (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font + (large-tie-up-right sld slt 5.0))) + (defun large-tie-down (sld slt width-multiplier) (let* ((thickness (round (* 0.33 sld))) (height (round (* 1.0 sld))) @@ -938,6 +976,34 @@ (c (- (- width 1.0)) (- height bot)) -- (c (- width) (- height bot)) ++ cycle)))) +(defun large-tie-down-left (sld slt width-multiplier) + (let* ((thickness (round (* 0.33 sld))) + (height (round (* 1.0 sld))) + (bot (- (round(* 11/6 sld)) slt)) + (width (* width-multiplier sld))) + (flet ((c (x y) (complex x y))) + (climi::close-path + (mf (c 0.0 (- bot)) left ++ + (c (- width) (- height bot)) -- + (c (- (- width 1.0)) (- height bot)) ++ + (c (* -0.3 width) (- thickness bot)) ++ + (c 0.0 (- thickness bot)) & + (c 0.0 (- thickness bot)) -- (c 0.0 (- bot))))))) + +(defun large-tie-down-right (sld slt width-multiplier) + (let* ((thickness (round (* 0.33 sld))) + (height (round (* 1.0 sld))) + (bot (- (round(* 11/6 sld)) slt)) + (width (* width-multiplier sld))) + (flet ((c (x y) (complex x y))) + (climi::close-path + (mf (c 0.0 (- bot)) right ++ + (c width (- height bot)) -- + (c (- width 1.0) (- height bot)) ++ + (c (* 0.3 width) (- thickness bot)) ++ + (c 0.0 (- thickness bot)) & + (c 0.0 (- thickness bot)) -- (c 0.0 (- bot))))))) + (defmethod compute-design ((font font) (shape (eql :large-tie-1-down))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font (large-tie-down sld slt 2.0))) @@ -978,6 +1044,14 @@ (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font (large-tie-down sld slt 5.0))) +(defmethod compute-design ((font font) (shape (eql :large-tie-down-left))) + (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font + (large-tie-down-left sld slt 5.0))) + +(defmethod compute-design ((font font) (shape (eql :large-tie-down-right))) + (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font + (large-tie-down-right sld slt 5.0))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Accidentals

1 0

[gsharp-cvs] CVS gsharp
by crhodes 02 Jun '06

02 Jun '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv19736 Modified Files: sdl.lisp Log Message: Fix large-tie glyphs and whole-rest glyph. (Note that there is clearly an offset problem: the half- and whole- rests do not lie on / hang cleanly from staff lines, with or without this change) --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/06/01 18:57:40 1.19 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/06/02 12:37:47 1.20 @@ -885,43 +885,43 @@ (defmethod compute-design ((font font) (shape (eql :large-tie-1-up))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-up sld slt (round (* 2.0 sld))))) + (large-tie-up sld slt 2.0))) (defmethod compute-design ((font font) (shape (eql :large-tie-2-up))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-up sld slt (round (* 2.33 sld))))) + (large-tie-up sld slt 2.33))) (defmethod compute-design ((font font) (shape (eql :large-tie-3-up))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-up sld slt (round (* 2.67 sld))))) + (large-tie-up sld slt 2.67))) (defmethod compute-design ((font font) (shape (eql :large-tie-4-up))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-up sld slt (round (* 3.0 sld))))) + (large-tie-up sld slt 3.0))) (defmethod compute-design ((font font) (shape (eql :large-tie-5-up))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-up sld slt (round (* 3.33 sld))))) + (large-tie-up sld slt 3.33))) (defmethod compute-design ((font font) (shape (eql :large-tie-6-up))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-up sld slt (round (* 3.67 sld))))) + (large-tie-up sld slt 3.67))) (defmethod compute-design ((font font) (shape (eql :large-tie-7-up))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-up sld slt (round (* 4.0 sld))))) + (large-tie-up sld slt 4.0))) (defmethod compute-design ((font font) (shape (eql :large-tie-8-up))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-up sld slt (round (* 4.33 sld))))) + (large-tie-up sld slt 4.33))) (defmethod compute-design ((font font) (shape (eql :large-tie-9-up))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-up sld slt (round (* 4.67 sld))))) + (large-tie-up sld slt 4.67))) (defmethod compute-design ((font font) (shape (eql :large-tie-10-up))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-up sld slt (round (* 5.0 sld))))) + (large-tie-up sld slt 5.0))) (defun large-tie-down (sld slt width-multiplier) (let* ((thickness (round (* 0.33 sld))) @@ -940,43 +940,43 @@ (defmethod compute-design ((font font) (shape (eql :large-tie-1-down))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-down sld slt (round (* 2.0 sld))))) + (large-tie-down sld slt 2.0))) (defmethod compute-design ((font font) (shape (eql :large-tie-2-down))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-down sld slt (round (* 2.33 sld))))) + (large-tie-down sld slt 2.33))) (defmethod compute-design ((font font) (shape (eql :large-tie-3-down))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-down sld slt (round (* 2.67 sld))))) + (large-tie-down sld slt 2.67))) (defmethod compute-design ((font font) (shape (eql :large-tie-4-down))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-down sld slt (round (* 3.0 sld))))) + (large-tie-down sld slt 3.0))) (defmethod compute-design ((font font) (shape (eql :large-tie-5-down))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-down sld slt (round (* 3.33 sld))))) + (large-tie-down sld slt 3.33))) (defmethod compute-design ((font font) (shape (eql :large-tie-6-down))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-down sld slt (round (* 3.67 sld))))) + (large-tie-down sld slt 3.67))) (defmethod compute-design ((font font) (shape (eql :large-tie-7-down))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-down sld slt (round (* 4.0 sld))))) + (large-tie-down sld slt 4.0))) (defmethod compute-design ((font font) (shape (eql :large-tie-8-down))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-down sld slt (round (* 4.33 sld))))) + (large-tie-down sld slt 4.33))) (defmethod compute-design ((font font) (shape (eql :large-tie-9-down))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-down sld slt (round (* 4.67 sld))))) + (large-tie-down sld slt 4.67))) (defmethod compute-design ((font font) (shape (eql :large-tie-10-down))) (with-slots ((sld staff-line-distance) (slt staff-line-thickness)) font - (large-tie-down sld slt (round (* 5.0 sld))))) + (large-tie-down sld slt 5.0))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -1155,7 +1155,7 @@ (flet ((c (x y) (complex x y))) (translate (xyscale (translate +unit-square+ #c(-0.5 0)) notehead-width (* 0.5 sld)) - (c xoffset (* yoffset (* 0.5 sld))))))) + (c xoffset (+ yoffset (* 0.5 sld))))))) (defmethod compute-design ((font font) (shape (eql :half-rest))) (with-slots ((sld staff-line-distance) notehead-width xoffset yoffset) font

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 01 Jun '06

01 Jun '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv5096 Modified Files: bezier.lisp fontview.lisp sdl.lisp Log Message: Fixed a bug in bezier.lisp that made the resulting pixmap positioned in the wrong place sometimes. Fixed a bug in sdl.lisp that computed the wrong xoffset (in particular for noteheads). Fixed the whole notehead so that its vertical position is not offset as it should. Fixed the C clef so that it no longer goes below the bottom line. Improved the font viewer by having the bounding box of the glyph drawn in :pixel mode. --- /project/gsharp/cvsroot/gsharp/bezier.lisp 2006/06/01 04:55:37 1.3 +++ /project/gsharp/cvsroot/gsharp/bezier.lisp 2006/06/01 18:57:40 1.4 @@ -703,6 +703,8 @@ (defun render-through-pixmap (design medium positive-areas negative-areas) (multiple-value-bind (min-x min-y) (bounding-rectangle* design) + (setf min-x (floor min-x) + min-y (floor min-y)) (let ((pixmap (gethash (list (medium-sheet medium) (resolve-ink medium) design) *pixmaps*))) (when (null pixmap) --- /project/gsharp/cvsroot/gsharp/fontview.lisp 2006/06/01 04:55:37 1.2 +++ /project/gsharp/cvsroot/gsharp/fontview.lisp 2006/06/01 18:57:40 1.3 @@ -9,9 +9,9 @@ ((font :initform (make-instance 'sdl::font :staff-line-distance 6)) (shape :initform :g-clef) (grid :initform t) - (staff :initform nil) + (staff :initform t) (staff-offset :initform 0) - (view :initform :pixel) + (view :initform :antialiased) (zoom :initform 1) (hoffset :initform 300) (voffset :initform 300)) @@ -72,6 +72,24 @@ do (draw-rectangle* pane x -300 (1+ x) 300 :ink +blue+)) (loop for x from 0 below 300 by (* 4 zoom) do (draw-rectangle* pane x -300 (1+ x) 300 :ink +blue+)) + ;; draw the bounding rectangle + (draw-rectangle* pane + (* zoom min-x) (* zoom min-y) + (* zoom max-x) (1+ (* zoom min-y)) + :ink +red+) + (draw-rectangle* pane + (* zoom min-x) (* zoom max-y) + (* zoom max-x) (1+ (* zoom max-y)) + :ink +red+) + (draw-rectangle* pane + (* zoom min-x) (* zoom min-y) + (1+ (* zoom min-x)) (* zoom max-y) + :ink +red+) + (draw-rectangle* pane + (* zoom max-x) (* zoom min-y) + (1+ (* zoom max-x)) (* zoom max-y) + :ink +red+) + ;; draw the reference point (draw-rectangle* pane -300 0 300 1 :ink +red+) (draw-rectangle* pane 0 -300 1 300 :ink +red+)))))))) --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/06/01 11:01:26 1.18 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/06/01 18:57:40 1.19 @@ -151,7 +151,7 @@ beam-hang-sit-offset) font (setf staff-line-thickness (round (/ (staff-line-distance font) 10))) (setf xoffset - (if (oddp (round (* 1.5 staff-line-distance))) 1.5 0)) + (if (oddp (round (* 1.5 staff-line-distance))) 0.5 0)) (setf yoffset (if (oddp staff-line-thickness) 0.5 0)) (setf dot-diameter @@ -610,12 +610,12 @@ (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) staff-line-thickness)) -- - (c 0 (- (- top) staff-line-thickness)) -- (c 0 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) staff-line-thickness)) -- - (c xb (- (- top) staff-line-thickness)) -- (c xb top))) + (c xc (- top)) -- + (c xb (- top)) -- (c xb top))) (translate r (c 0 staff-line-thickness)))))))) ;;; @@ -712,7 +712,7 @@ (complex xoffset yoffset)))) (defmethod compute-design ((font font) (shape (eql :whole-notehead))) - (with-slots ((sld staff-line-distance)) font + (with-slots (xoffset yoffset (sld staff-line-distance)) font (let ((op (scale (superellipse #c(0.75 0.0) #c(0.0 0.58) #c(-0.75 0.0) #c(0.0 -0.58) 0.7) sld)) @@ -720,7 +720,8 @@ #c(-0.3 0.0) #c(0.0 -0.35) 0.8) -0.3) sld))) - (clim:region-difference op (climi::reverse-path ip))))) + (translate (clim:region-difference op (climi::reverse-path ip)) + (complex xoffset yoffset))))) (defmethod compute-design ((font font) (shape (eql :half-notehead))) (with-slots (xoffset yoffset (sld staff-line-distance)) font

1 0

[gsharp-cvs] CVS gsharp
by crhodes 01 Jun '06

01 Jun '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv31532 Modified Files: sdl.lisp Log Message: Fix a bug in the C clef. It's still not symmetrical about the X axis, but the weird zooming point in the curve is fixed. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/05/31 19:51:58 1.17 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/06/01 11:01:26 1.18 @@ -598,7 +598,7 @@ (c (+ xd (* 0.5 dot-width)) (+ yd dot-width)) right ++ (c (+ xd dot-width) (+ yd (* 0.5 dot-width))) down ++ (c (+ xd (* 0.5 dot-width)) yd) left ++ - (c xd (* yd (* 0.5 dot-width))) up ++ (c xf top) right ++ + (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))))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 01 Jun '06

01 Jun '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv13899 Modified Files: gui.lisp Log Message: Removed bogus menu entry. --- /project/gsharp/cvsroot/gsharp/gui.lisp 2006/05/23 11:43:29 1.63 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2006/06/01 04:57:10 1.64 @@ -233,6 +233,7 @@ :errorp nil :menu '(("File" :menu file-command-table) ("Buffer" :menu buffer-command-table) + ("Stuff" :menu segment-command-table) ("Segment" :menu segment-command-table) ("Layer" :menu layer-command-table) ("Slice" :menu slice-command-table)

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 01 Jun '06

01 Jun '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv13742 Modified Files: bezier.lisp fontview.lisp Log Message: Moved things around a bit inside bezier.lisp to make it easier to render to an array from the font viewer. Implemented pixel viewing in the font viewer. Initial results indicate that the G-clef is pretty good, and there must be something wrong either with the way the pixmap gets generated or with the way it gets copied to the pane (it is too far down). Initial result also indicate that the C-clef is completely wrong and incredibly ugly at sizes above 6. --- /project/gsharp/cvsroot/gsharp/bezier.lisp 2006/05/30 02:13:26 1.2 +++ /project/gsharp/cvsroot/gsharp/bezier.lisp 2006/06/01 04:55:37 1.3 @@ -662,23 +662,25 @@ repeat (nb-lines lines) do (render-scan-lines array pixel-value i (crossings lines i) min-x min-y)))) -(defun render-to-array (positive-areas negative-areas min-x min-y max-x max-y) - (setf min-x (* 4 (floor min-x)) - min-y (* 4 (floor min-y)) - max-x (* 4 (ceiling max-x)) - max-y (* 4 (ceiling max-y))) - (let ((result (make-array (list (- max-y min-y) (- max-x min-x)) - :element-type 'bit :initial-element 1)) - (transformation (make-scaling-transformation* 4 4))) - (loop for area in positive-areas - do (let* ((transformed-area (transform-region transformation area)) - (polygon (polygonalize transformed-area))) - (render-polygon result polygon 0 min-x min-y))) - (loop for area in negative-areas - do (let* ((transformed-area (transform-region transformation area)) - (polygon (polygonalize transformed-area))) - (render-polygon result polygon 1 min-x min-y))) - result)) +(defun render-to-array (positive-areas negative-areas) + (multiple-value-bind (min-x min-y max-x max-y) + (bounding-rectangle-of-areas positive-areas) + (setf min-x (* 4 (floor min-x)) + min-y (* 4 (floor min-y)) + max-x (* 4 (ceiling max-x)) + max-y (* 4 (ceiling max-y))) + (let ((result (make-array (list (- max-y min-y) (- max-x min-x)) + :element-type 'bit :initial-element 1)) + (transformation (make-scaling-transformation* 4 4))) + (loop for area in positive-areas + do (let* ((transformed-area (transform-region transformation area)) + (polygon (polygonalize transformed-area))) + (render-polygon result polygon 0 min-x min-y))) + (loop for area in negative-areas + do (let* ((transformed-area (transform-region transformation area)) + (polygon (polygonalize transformed-area))) + (render-polygon result polygon 1 min-x min-y))) + result))) (defparameter *x* 0) (defparameter *y* 0) @@ -699,12 +701,12 @@ (+ (* a 1.0) (* 1-a b)))))) (defun render-through-pixmap (design medium positive-areas negative-areas) - (multiple-value-bind (min-x min-y max-x max-y) - (bounding-rectangle-of-areas positive-areas) + (multiple-value-bind (min-x min-y) + (bounding-rectangle* design) (let ((pixmap (gethash (list (medium-sheet medium) (resolve-ink medium) design) *pixmaps*))) (when (null pixmap) - (let* ((picture (render-to-array positive-areas negative-areas min-x min-y max-x max-y)) + (let* ((picture (render-to-array positive-areas negative-areas)) (height (array-dimension picture 0)) (width (array-dimension picture 1)) (reduced-picture (make-array (list (/ height 4) (/ width 4)) :initial-element 16))) @@ -741,6 +743,20 @@ (multiple-value-bind (*x* *y*) (transform-position (translation design) 0 0) (medium-draw-design* medium (original-region design)))) +(defgeneric render-design-to-array (design)) + +(defmethod render-design-to-array ((design bezier-area)) + (render-to-array (list design) '())) + +(defmethod render-design-to-array ((design bezier-union)) + (render-to-array (areas design) '())) + +(defmethod render-design-to-array ((design bezier-difference)) + (render-to-array (positive-areas design) (negative-areas design))) + +(defmethod render-design-to-array ((design translated-region)) + (render-design-to-array (original-region design))) + (defmethod draw-design (sheet design &rest args &key &allow-other-keys) (climi::with-medium-options (sheet args) (medium-draw-design* medium design))) --- /project/gsharp/cvsroot/gsharp/fontview.lisp 2006/05/31 19:55:19 1.1 +++ /project/gsharp/cvsroot/gsharp/fontview.lisp 2006/06/01 04:55:37 1.2 @@ -8,10 +8,10 @@ (define-application-frame fontview () ((font :initform (make-instance 'sdl::font :staff-line-distance 6)) (shape :initform :g-clef) - (grid :initform nil) + (grid :initform t) (staff :initform nil) (staff-offset :initform 0) - (view :initform :antialiased) + (view :initform :pixel) (zoom :initform 1) (hoffset :initform 300) (voffset :initform 300)) @@ -41,9 +41,39 @@ (* 10 sld) (+ y down))))))))) (defun display-pixel-view (frame pane) - (declare (ignore pane)) (with-slots (font shape grid zoom hoffset voffset) frame - nil)) + (with-translation (pane hoffset voffset) + (let ((design (sdl::ensure-design font shape))) + (multiple-value-bind (min-x min-y max-x max-y) (bounding-rectangle* design) + (setf min-x (* 4 (floor min-x)) + min-y (* 4 (floor min-y)) + max-x (* 4 (ceiling max-x)) + max-y (* 4 (ceiling max-y))) + (let ((array (climi::render-design-to-array design))) + (loop for y from min-y below max-y + for y-index from 0 + do (loop with x0 = nil + for x from min-x below max-x + for x-index from 0 + do (if (zerop (aref array y-index x-index)) + (when (null x0) + (setf x0 x)) + (unless (null x0) + (draw-rectangle* pane (* x0 zoom) (* y zoom) (* x zoom) (* (1+ y) zoom)) + (setf x0 nil))) + finally (unless (null x0) + (draw-rectangle* pane (* x0 zoom) (* y zoom) (* x zoom) (* (1+ y) zoom))))) + (when grid + (loop for y downfrom 0 above -300 by (* 4 zoom) + do (draw-rectangle* pane -300 y 300 (1+ y) :ink +blue+)) + (loop for y from 0 below 300 by (* 4 zoom) + do (draw-rectangle* pane -300 y 300 (1+ y) :ink +blue+)) + (loop for x downfrom 0 above -300 by (* 4 zoom) + do (draw-rectangle* pane x -300 (1+ x) 300 :ink +blue+)) + (loop for x from 0 below 300 by (* 4 zoom) + do (draw-rectangle* pane x -300 (1+ x) 300 :ink +blue+)) + (draw-rectangle* pane -300 0 300 1 :ink +red+) + (draw-rectangle* pane 0 -300 1 300 :ink +red+)))))))) (defun display-entry (frame pane) (with-slots (view) frame

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 31 May '06

31 May '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv5124 Added Files: fontview.lisp Log Message: Half of a new font viewer application. The half that exists is that it shows the resulting anti-aliased design, with or without a reference staff. What remains to write is showing the pixel view with grids and reference points, and perhaps also end points and reference points of the Bezier segments. This should be a relatively simple matter of calling render-to-array and showing the result. --- /project/gsharp/cvsroot/gsharp/fontview.lisp 2006/05/31 19:55:19 NONE +++ /project/gsharp/cvsroot/gsharp/fontview.lisp 2006/05/31 19:55:19 1.1 (in-package :common-lisp-user) (defpackage :fontview (:use :clim :clim-extensions :clim-lisp :sdl)) (in-package :fontview) (define-application-frame fontview () ((font :initform (make-instance 'sdl::font :staff-line-distance 6)) (shape :initform :g-clef) (grid :initform nil) (staff :initform nil) (staff-offset :initform 0) (view :initform :antialiased) (zoom :initform 1) (hoffset :initform 300) (voffset :initform 300)) (:pointer-documentation t) (:panes (fontview :application :width 800 :height 600 :display-function 'display-entry) (interactor :interactor :width 800 :height 100)) (:layouts (default (vertically () fontview interactor)))) (defun display-antialiased-view (frame pane) (with-slots (font shape staff staff-offset hoffset voffset) frame (with-translation (pane hoffset voffset) (sdl::draw-shape pane font shape 0 0) (when staff (with-slots ((slt sdl::staff-line-thickness) (sld sdl::staff-line-distance) (yoff sdl::yoffset)) font (let ((up (round (+ (* 0.5 slt) yoff))) (down (round (- (* 0.5 slt) yoff)))) (loop repeat 5 for y from (* (+ -2 (* 1/2 staff-offset)) sld) by sld do (draw-rectangle* pane (* -10 sld) (- y up) (* 10 sld) (+ y down))))))))) (defun display-pixel-view (frame pane) (declare (ignore pane)) (with-slots (font shape grid zoom hoffset voffset) frame nil)) (defun display-entry (frame pane) (with-slots (view) frame (if (eq view :antialiased) (display-antialiased-view frame pane) (display-pixel-view frame pane)))) (defun fontview () (let ((frame (make-application-frame 'fontview))) (run-frame-top-level frame))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Commands (define-fontview-command (com-quit :name t) () (frame-exit *application-frame*)) (define-fontview-command (com-show :name t) ((symbol 'symbol)) (with-slots (shape) *application-frame* (setf shape symbol))) (define-fontview-command (com-zoom-in :name t :keystroke (#\i :control)) () (with-slots (zoom) *application-frame* (when (< zoom 10) (incf zoom)))) (define-fontview-command (com-zoom-out :name t :keystroke (#\i :control)) () (with-slots (zoom) *application-frame* (when (> zoom 1) (decf zoom)))) (define-fontview-command (com-zoom-to :name t) ((i 'integer)) (with-slots (zoom) *application-frame* (setf zoom (min (max i 1) 10)))) (define-fontview-command (com-size :name t) ((i 'integer)) (with-slots (font) *application-frame* (when (oddp i) (incf i)) (setf font (make-instance 'sdl::font :staff-line-distance (min (max i 6) 20))))) (define-fontview-command (com-grid-on :name t) () (with-slots (grid) *application-frame* (setf grid t))) (define-fontview-command (com-grid-off :name t) () (with-slots (grid) *application-frame* (setf grid nil))) (define-fontview-command (com-staff-on :name t) () (with-slots (staff) *application-frame* (setf staff t))) (define-fontview-command (com-staff-off :name t) () (with-slots (staff) *application-frame* (setf staff nil))) (define-fontview-command (com-staff-up :name t) () (with-slots (staff-offset) *application-frame* (when (> staff-offset -4) (decf staff-offset)))) (define-fontview-command (com-staff-down :name t) () (with-slots (staff-offset) *application-frame* (when (< staff-offset 4) (incf staff-offset)))) (define-fontview-command (com-staff-middle :name t) () (with-slots (staff-offset) *application-frame* (setf staff-offset 0))) (define-fontview-command (com-pixel-view :name t) () (with-slots (view) *application-frame* (setf view :pixel))) (define-fontview-command (com-antialiased-view :name t) () (with-slots (view) *application-frame* (setf view :antialiased)))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 31 May '06

31 May '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv5035 Modified Files: sdl.lisp Log Message: Fixed a bug that calculated the yoffset of the font wrong. Changed the g-clef back to sane values for the ye and yz coordinates, because I now suspect something else is responsible for the funny looks at low resolution. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/05/30 02:13:26 1.16 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/05/31 19:51:58 1.17 @@ -149,11 +149,11 @@ beam-offset-down beam-offset-up beam-hang-sit-offset) font + (setf staff-line-thickness (round (/ (staff-line-distance font) 10))) (setf xoffset (if (oddp (round (* 1.5 staff-line-distance))) 1.5 0)) (setf yoffset - (if (oddp staff-line-distance) 0.5 0)) - (setf staff-line-thickness (round (/ (staff-line-distance font) 10))) + (if (oddp staff-line-thickness) 0.5 0)) (setf dot-diameter (min (- staff-line-distance staff-line-thickness 2) (round (/ staff-line-distance 3)))) @@ -359,6 +359,11 @@ (tr (clim:make-translation-transformation x y))) (clim:draw-design sheet (clim:transform-region tr design)))) +;;; default method +(defmethod compute-design ((font font) shape) + (with-slots (staff-line-distance) font + (scale +unit-square+ staff-line-distance))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Clefs @@ -434,7 +439,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 (- sld)) + (xe (* 1.5 sld)) (ye (+ (- sld) (- (* 0.5 staff-line-thickness)))) (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))))) @@ -453,7 +458,7 @@ (xr xm) (yr (+ ym staff-line-thickness)) (xz xe) ;; yz should be slightly above the upper edge of the staff line - (yz (+ (- sld) (* 1.2 staff-line-thickness))) + (yz (+ (- sld) (* 0.7 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))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 30 May '06

30 May '06

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

1 0

← Newer
1
...
12
13
14
15
16
17
18
...
40
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

gsharp-cvs