[gsharp-cvs] CVS gsharp

[rstrandh]

Update of /project/gsharp/cvsroot/gsharp
In directory cl-net:/tmp/cvs-serv7755

Modified Files:
	sdl.lisp 
Log Message:
Time signature digit 3.


--- /project/gsharp/cvsroot/gsharp/sdl.lisp	2008/11/15 17:20:07	1.38
+++ /project/gsharp/cvsroot/gsharp/sdl.lisp	2008/11/15 18:22:23	1.39
@@ -1757,4 +1757,77 @@
 	    p5 left ++ p6 down (tensions 3 1) p7 down ++ p8 left ++ p9 up ++
 	    p10 right ++ p11 down (tensions 1 3) p12 down (tensions 3 1) p13 right (tensions 1 3)
 	    p14 (tensions 3 1) cycle)))))
-	     
\ No newline at end of file
+
+;;;                  
+;;;                                w2
+;;;                            _________
+;;;                           |         |
+;;;                                     q                  _
+;;;                                 **********		    |
+;;;                               **************	    |
+;;;                             *****m l ********	    |
+;;;                            *******     *******	    |
+;;;                          p*********n  k********r	    |
+;;;                            *******     ******** 	    |
+;;;                              ***  j   *******	    |
+;;;                               o   | ********	    |
+;;;                          ii-*************s		    |
+;;;                             *************		    | h1
+;;;                              c    | ********	    |
+;;;                             ***   h    *******	    |
+;;;                           *******      ********	    |
+;;;                          *********     *********	    |
+;;;                     b - ***********d  g********* t	    |
+;;;                          ********* f    ********	    |
+;;;                           ******- e|   ********	    |
+;;;                             ****************	    |
+;;;                               ************		   _|
+;;;                                   |
+;;;                                   a
+;;;                  
+;;;                         |___________|
+;;;                              w1
+;;;                  
+;;;                  
+;;;                  
+
+(defmethod compute-design ((font font) (shape (eql :time-signature-3)))
+  (with-slots ((sld staff-line-distance)
+	       (slt staff-line-thickness)
+	       yoffset)
+    font
+    (flet ((c (x y) (complex x y)))
+      (let* (;; This symbol should sit have its lowest point
+	     ;; at the bottom of the staff line
+	     (ya (+ (- (/ slt 2)) yoffset))
+	     ;; it should have its top at the lower edge of the staff line
+	     (h1 (* 2 sld))
+	     (h2 (* 0.25 h1))
+	     (h3 (* 0.75 h1))
+	     (w1 (round (* 0.38 h1)))
+	     (w2 (round (* 0.33 h1)))
+	     (pa (c (* -0.1 w1) ya))
+	     (pb (c (- w1) (+ ya h2)))
+	     (pc (c (* -0.6 w1) (+ ya (min (1- sld) (round (* 0.4 h1))))))
+	     (pd (c (round (* -0.2 w1)) (+ ya h2)))
+	     (pe (c (* -0.5 w1) (+ ya (* 2.1 slt))))
+	     (pf (c (* -0.1 w1) (+ ya slt)))
+	     (pg (c (* 0.2 w1) (+ ya h2)))
+	     (ph (c (* -0.1 w1) (+ ya sld)))
+	     (pii (c (* -0.7 w1) (+ ya sld (* 0.5 slt))))
+	     (pj (+ ph (c 0 slt)))
+	     (pk (c (* 0.18 w1) (+ ya h3)))
+	     (pl (c (* -0.1 w1) (+ ya (round (* 0.88 h1)))))
+	     (pm (c (* -0.3 w1) (+ ya (round (* 0.85 h1)))))
+	     (pn (c (round (* -0.2 w1)) (+ ya h3)))
+	     (po (c (* -0.55 w1) (+ ya (max (1+ sld) (* 0.6 h1)))))
+	     (pp (c (- w2) (+ ya h3)))
+	     (pq (c 0 (+ ya h1)))
+	     (pr (c w2 h3))
+	     (ps (c (* 0.5 w1) (+ ya sld (* 0.5 slt))))
+	     (pt (c w1 (+ ya h2))))
+	(mf pa left ++ pb up ++ pc right ++ pd down ++ pe down ++
+	    pf right ++ pg up ++ ph left (tensions 1 5) pii up (tensions 5 1)
+	    pj right ++ pk up ++ pl left ++ pm down ++ pn down ++
+	    po left ++ pp up ++ pq right ++ pr down (tensions 0.75 10)
+	    ps down (tensions 10 0.75) pt down ++ cycle)))))