[gsharp-cvs] CVS gsharp

rstrandh rstrandh at common-lisp.net
Sat Nov 15 17:20:07 UTC 2008


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

Modified Files:
	sdl.lisp 
Log Message:
Time signature digits 1 and 2.


--- /project/gsharp/cvsroot/gsharp/sdl.lisp	2007/09/18 21:19:03	1.37
+++ /project/gsharp/cvsroot/gsharp/sdl.lisp	2008/11/15 17:20:07	1.38
@@ -1610,3 +1610,151 @@
   (climi::close-path
    (mf #c(0 0) -- (complex 16 0) -- (complex 0 -1) -- #c(0 0))))
 
+;;;           w3
+;;;       ___________
+;;;      |           |
+;;;
+;;;             9 *** 10 ** -11			      - 
+;;;              ********** -12			       |
+;;;             ***********			       |
+;;;         8- ************			       |
+;;;           *************			       |
+;;;          **************			       |
+;;;         ***************			       |
+;;;        ***6/ **********			       |
+;;;       **   / **********			       |
+;;;      7    5  **********			       |
+;;;              **********			       |  h2
+;;;              **********			       |
+;;;              **********			       |
+;;;              **********			       |
+;;;              **********			       |
+;;;              **********			       |
+;;;              **********			       |
+;;;           4 -**********- 13             	       |
+;;;        3     **********     14          -	       |
+;;;         \ **************** /             |	       |
+;;;     2 -**********************- 15        | h1      |
+;;;        **********************           _|        _|
+;;;          |       |        |
+;;;          1       0        16
+;;;
+;;;
+;;;              |___|
+;;;                w1
+;;;
+;;;        |_________|
+;;;            w2
+
+(defmethod compute-design ((font font) (shape (eql :time-signature-1)))
+  (with-slots ((sld staff-line-distance)
+	       (slt staff-line-thickness)
+	       yoffset)
+    font
+    (flet ((c (x y) (complex x y)))
+      (let* (;; This symbol should sit on top of a staff line
+	     (y0 (+ (/ slt 2) yoffset))
+	     (p0 (c 0 y0))
+	     ;; if the little notch is to be visible, the top
+	     ;; of this character should hang below the upper staff line.
+	     (h2 (- (* 2 sld) slt))
+	     ;; w1 and w2 should be integers in to avoid fuzziness
+	     (w1 (round (* 0.14 h2)))
+	     (w2 (round (* 0.25 h2)))
+	     (h1 (* 0.5 w2))
+	     (p1 (- p0 (* 0.9 w2)))
+	     (p2 (c (- w2) (+ y0 (* h1 0.25))))
+	     (p3 (+ p1 (c 0 (+ y0 (* h1 0.5)))))
+	     (p4 (c (- w1) (+ y0 (* h1 1.2))))
+	     (p5 (c (- w1) (+ y0 (* h2 0.62))))
+	     (p6 (c (- (* w1 1.09)) (+ y0 (* h2 0.65))))
+	     (p7 (c (- (* w2 1.3)) (+ y0 (* h2 0.52))))
+	     (p8 (c (- (* w1 1.23)) (+ y0 (* h2 0.85))))
+	     (p9 (c (- (* w1 0.91)) (+ y0 h2)))
+	     (p10 (c (* w1 0.18) (+ y0 (* h2 0.97))))
+	     (p11 (c w1 (+ y0 (* h2 0.98))))
+	     (p12 (c w1 (+ y0 (* h2 0.96))))
+	     (p13 (c w1 (imagpart p4)))
+	     (p14 (c (- (realpart p3)) (imagpart p3)))
+	     (p15 (c w2 (imagpart p2)))
+	     (p16 (c (- (realpart p1)) (imagpart p1))))
+	(mf p0 -- p1 left ++ p2 up ++ p3 ++ up p4 -- p5 up ++
+	    p6 (tensions 2 3) p7 (tensions 4 1) 
+	    p8 (tensions 1 2)
+	    p9 (tensions 2 2) p10 ++ p11 ++ down p12 -- p13 down ++
+	    p14 ++ p15 down ++ left p16 -- cycle)))))
+
+	
+;;;           
+;;;                          w2
+;;;                      __________
+;;;                     |          |
+;;;                                10
+;;;                                |                     _
+;;;                            *********                  |
+;;;                         **************                |
+;;;                       ******************              |
+;;;                      ****-6  | **********             |
+;;;                   9 -******  5  **********            |
+;;;                     *******-7  4-*********-11         |
+;;;                      ******      *********            |
+;;;                        ***      *********             |
+;;;                         |      ********               |
+;;;                         8    *******                  |
+;;;                            *****          14          |
+;;;                          *****            |           |  h1
+;;;                         *****-12    13    *           |
+;;;                        *******       |   **    _      |
+;;;                      **********************     |     |
+;;;                     ***********************     |     |
+;;;              _     ***********************      |     |
+;;;             |     ****  |   *************       | h2  |
+;;;             |  3 -***   1    ***********        |     |
+;;;          h3 |     **           ********         |     |
+;;;             |_     \            *****          _|    _| 
+;;;                     2             |
+;;;                                   0
+;;;
+;;;
+;;;
+;;;                   |__________| 
+;;;                        w1
+;;;           
+
+(defmethod compute-design ((font font) (shape (eql :time-signature-2)))
+  (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
+	     (y0 (+ (- (/ slt 2)) yoffset))
+	     ;; it should have its top at the lower edge of the staff line
+	     (h1 (* 2 sld))
+	     (h2 (round (* 0.20 h1)))
+	     (h3 (* 0.14 h1))
+	     (h4 (* 0.65 h1))
+	     (w1 (round (* 0.38 h1)))
+	     (w2 (round (* 0.33 h1)))
+	     (w3 (round (* 0.6 w2)))
+	     (p0 (c (* 0.1 w1) y0))
+	     (p1 (c (- (* 0.5 w1)) (+ y0 h3)))
+	     (p2 (c (- (* 0.9 w1)) (+ y0 slt)))
+	     (p3 (c (- w1) (+ y0 (* 0.5 h3))))
+	     (p4 (c (round (* 0.2 w1)) (+ y0 h4)))
+	     (p5 (c (- (* 0.1 w1)) (+ y0 (round (* 0.88 h1)))))
+	     (p6 (c (- w3) (+ y0 (* 0.78 h1))))
+	     (p7 (c (- (* 0.2 w1)) (+ y0 h4)))
+	     (p8 (c (- w3) (+ y0 (round (* 0.53 h1)))))
+	     (p9 (c (- w2) (+ y0 (* 0.7 h1))))
+	     (p10 (c 0 (+ y0 h1)))
+	     (p11 (c w2 h4))
+	     (p12 (c (- (* 0.01 w1)) (* 0.3 h1)))
+	     (p13 (c (* 0.5 w1) h2))
+	     (p14 (c w1 (* 0.3 h1))))
+	(mf p0 left ++ p1 left ++ p2 left ++ p3 up ++ p4 up (tensions 3 1)
+	    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





More information about the Gsharp-cvs mailing list