[gsharp-cvs] CVS gsharp

crhodes crhodes at common-lisp.net
Fri Jun 2 14:11:10 UTC 2006


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 , at 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)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;




More information about the Gsharp-cvs mailing list