[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