gsharp-cvs November 2008

gsharp-cvs@common-lisp.net

2 participants
10 discussions

[gsharp-cvs] CVS gsharp
by crhodes 19 Nov '08

19 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv15490 Modified Files: cursor.lisp drawing.lisp gui.lisp packages.lisp Log Message: Export make-key-signature, key-signatures from gsharp-buffer --- /project/gsharp/cvsroot/gsharp/cursor.lisp 2008/11/19 15:45:46 1.7 +++ /project/gsharp/cvsroot/gsharp/cursor.lisp 2008/11/19 16:05:13 1.8 @@ -168,8 +168,8 @@ (defmethod add-element :after ((keysig key-signature) bar position) (let ((staff (staff keysig))) - (setf (gsharp-buffer::key-signatures staff) - (merge 'list (list keysig) (gsharp-buffer::key-signatures staff) + (setf (key-signatures staff) + (merge 'list (list keysig) (key-signatures staff) (lambda (x y) (gsharp::starts-before-p x (bar y) y)))))) (defmethod remove-element :before ((element element) (bar cbar)) --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2008/11/19 15:45:47 1.86 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2008/11/19 16:05:13 1.87 @@ -33,7 +33,7 @@ (format stream "[lyrics staff ~a]" (name object))) (defun key-signature-for-staff (staff measures) - (let ((key-signatures (gsharp-buffer::key-signatures staff)) + (let ((key-signatures (key-signatures staff)) (barno (gsharp-numbering:number (car (measure-bars (car measures)))))) (or (and key-signatures (find barno key-signatures :from-end t :test #'> --- /project/gsharp/cvsroot/gsharp/gui.lisp 2008/11/19 15:45:47 1.95 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2008/11/19 16:05:13 1.96 @@ -942,9 +942,9 @@ (cursor (current-cursor)) (staff (car (staves (layer cursor)))) (keysig (if (keysig cursor) - (gsharp-buffer::make-key-signature + (make-key-signature staff :alterations (copy-seq (alterations (keysig cursor)))) - (gsharp-buffer::make-key-signature staff)))) + (make-key-signature staff)))) ;; FIXME: should only invalidate elements temporally after the ;; cursor. (gsharp-measure::invalidate-everything-using-staff (current-buffer) staff) @@ -957,8 +957,8 @@ (defmethod remove-element :before ((keysig key-signature) (bar bar)) (let ((staff (staff keysig))) - (setf (gsharp-buffer::key-signatures staff) - (remove keysig (gsharp-buffer::key-signatures staff))) + (setf (key-signatures staff) + (remove keysig (key-signatures staff))) (gsharp-measure::invalidate-everything-using-staff (current-buffer) staff))) ;;; FIXME: this isn't quite right (argh) for the case of two @@ -1005,14 +1005,14 @@ ;; in. (assert (eq cursor (current-cursor))) (let* ((staff (car (staves (layer cursor)))) - (key-signatures (gsharp-buffer::key-signatures staff)) + (key-signatures (key-signatures staff)) (bar (bar cursor)) (element-or-nil (cursor-element cursor))) (%keysig staff key-signatures bar element-or-nil))) (defmethod keysig ((note note)) (let* ((staff (staff note)) - (key-signatures (gsharp-buffer::key-signatures staff)) + (key-signatures (key-signatures staff)) (bar (bar (cluster note))) (element-or-nil (cluster note))) (%keysig staff key-signatures bar element-or-nil))) @@ -1024,7 +1024,7 @@ (defmethod keysig ((element element)) (let* ((staff (staff element)) - (key-signatures (gsharp-buffer::key-signatures staff)) + (key-signatures (key-signatures staff)) (bar (bar element))) (%keysig staff key-signatures bar element))) --- /project/gsharp/cvsroot/gsharp/packages.lisp 2008/02/09 16:58:35 1.66 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2008/11/19 16:05:13 1.67 @@ -55,6 +55,7 @@ (:shadow #:rest) (:export #:clef #:name #:lineno #:make-clef #:staff #:fiveline-staff #:make-fiveline-staff + #:key-signatures #:lyrics-staff #:make-lyrics-staff #:gsharp-condition #:pitch #:accidentals #:dots #:note #:make-note @@ -90,7 +91,8 @@ #:clef #:f-position #:b-position #:bottom-line #:keysig #:staff-pos #:xoffset #:read-everything #:read-buffer-from-stream - #:key-signature #:alterations #:more-sharps #:more-flats + #:key-signature #:make-key-signature + #:alterations #:more-sharps #:more-flats #:line-width #:lines-per-page #:min-width #:spacing-style #:right-edge #:left-offset #:left-margin #:text #:append-char #:erase-char

1 0

[gsharp-cvs] CVS gsharp
by crhodes 19 Nov '08

19 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv10002 Modified Files: cursor.lisp drawing.lisp gui.lisp Log Message: Remove gsharp-buffer:: prefix from key-signature (since it's exported). --- /project/gsharp/cvsroot/gsharp/cursor.lisp 2007/07/27 22:28:05 1.6 +++ /project/gsharp/cvsroot/gsharp/cursor.lisp 2008/11/19 15:45:46 1.7 @@ -166,8 +166,7 @@ (when (> (pos cursor) position) (incf (pos cursor))))) -(defmethod add-element :after - ((keysig gsharp-buffer::key-signature) bar position) +(defmethod add-element :after ((keysig key-signature) bar position) (let ((staff (staff keysig))) (setf (gsharp-buffer::key-signatures staff) (merge 'list (list keysig) (gsharp-buffer::key-signatures staff) --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2008/02/09 16:58:35 1.85 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2008/11/19 15:45:47 1.86 @@ -162,7 +162,7 @@ (score-pane:staff-step 5) (score-pane:staff-step 2))) -(defmethod right-bulge ((keysig gsharp-buffer::key-signature) pane) +(defmethod right-bulge ((keysig key-signature) pane) ;; FIXME: shares much code with DRAW-ELEMENT (KEY-SIGNATURE). (let ((old-keysig (keysig keysig))) (let ((bulge 0)) @@ -697,7 +697,7 @@ (defun draw-beam-group (pane elements) (let ((e (car elements))) - (when (typep e 'gsharp-buffer::key-signature) + (when (typep e 'key-signature) (assert (null (cdr elements))) (return-from draw-beam-group (draw-element pane e (final-absolute-element-xoffset e))))) --- /project/gsharp/cvsroot/gsharp/gui.lisp 2008/02/09 16:58:35 1.94 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2008/11/19 15:45:47 1.95 @@ -955,7 +955,7 @@ (define-gsharp-command com-insert-keysig () (insert-keysig)) -(defmethod remove-element :before ((keysig gsharp-buffer::key-signature) (bar bar)) +(defmethod remove-element :before ((keysig key-signature) (bar bar)) (let ((staff (staff keysig))) (setf (gsharp-buffer::key-signatures staff) (remove keysig (gsharp-buffer::key-signatures staff)))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 17 Nov '08

17 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv7837 Modified Files: sdl.lisp Log Message: Time signature digit 8. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/17 07:44:00 1.43 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/17 10:45:22 1.44 @@ -2164,4 +2164,83 @@ pn right (tensions 1 3) po (tensions 3 1) pp down ++ pq down ++ pr left ++ cycle))))) - \ No newline at end of file +;;; +;;; +;;; +;;; w2 +;;; __________ +;;; | | +;;; e _ +;;; ****** | +;;; ************ | +;;; **** i **** | +;;; **** **** | +;;; ***** **** | +;;; ******l j****f | +;;; d****** **** | +;;; ******* **** | +;;; ********** k **** | +;;; ******************* | +;;; ******************g | h1 +;;; c****************** | +;;; ******************** | +;;; ***** o ******** | +;;; ***** ***** | +;;; **** p*****h - | +;;; - b****n ***** | | +;;; | **** ***** | | +;;; | **** ***** | h3 | +;;; h2 | **** m ****** | | +;;; | **************** | | +;;; |_ ********* _| _| +;;; a +;;; +;;; |___________| +;;; w1 +;;; |________| +;;; w3 +;;; +;;; |_____| +;;; w4 + +(defmethod compute-design ((font font) (shape (eql :time-signature-8))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + yoffset) + font + (flet ((c (x y) (complex x y))) + (let* (;; This symbol should 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.23 h1)) + (h3 (* 0.27 h1)) + (w1 (round (* 0.38 h1))) + (w2 (round (* 0.35 h1))) + (w3 (round (* 0.26 h1))) + (w4 (* 0.07 h1)) + (pa (c 0 ya)) + (pb (c (- w1) (+ ya h2))) + (pc (c (- w3) (+ ya (* 0.48 h1)))) + (pd (c (- w2) (+ ya (- h1 h3)))) + (pe (c 0 (+ ya h1))) + (pf (c w2 (+ ya (- h1 h2)))) + (pg (c w3 (+ ya (* 0.52 h1)))) + (ph (c w1 (+ ya h3))) + (pm (+ pa (c 0 (round (* 0.28 sld))))) + (pn (+ pb (round (* 0.33 sld)))) + (po (c (- w4) (+ ya (* 0.43 h1)))) + (pp (- ph (round (* 0.40 sld)))) + (ppi (- pe (c 0 (round (* 0.28 sld))))) + (pj (- pf (round (* 0.33 sld)))) + (pk (c w4 (+ ya (* 0.57 h1)))) + (pl (+ pd (round (* 0.40 sld))))) + (clim:region-difference + (mf pa left ++ pb up (tensions 1 5) pc up (tensions 5 1) pd up ++ + right pe -- ppi left ++ pl down (tensions 1 20) pk right + (tensions 3 1) pj up ++ left ppi -- pe right ++ pf down + (tensions 1 5) pg down (tensions 5 1) ph down ++ cycle) + (mf pm left ++ pn up (tensions 1 3) po right (tensions 20 1) + pp down ++ cycle)))))) + \ No newline at end of file

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 17 Nov '08

17 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv14574 Modified Files: sdl.lisp Log Message: Time signature digit 7. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/17 06:40:26 1.42 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/17 07:44:00 1.43 @@ -2080,4 +2080,88 @@ (mf pa left ++ pb up ++ pc right ++ pd down ++ pe left ++ pf up (tensions 1 20) pg (tensions 20 1) ph down ++ ppi (tensions 5 1) pj right ++ pk down ++ cycle) - (mf pl left ++ pm up ++ pn right ++ po down ++ cycle)))))) \ No newline at end of file + (mf pl left ++ pm up ++ pn right ++ po down ++ cycle)))))) + +;;; +;;; +;;; w1 +;;; __________ +;;; | | +;;; +;;; +;;; k m o _ +;;; * l ************ * | +;;; j******************* * | +;;; ********************n ** | +;;; *********************** | +;;; *** g ************e*** | +;;; ** ********* ** | +;;; i* f d** | +;;; h *** | +;;; **** | +;;; **** | +;;; ***** | +;;; ***** | h1 +;;; ****** | +;;; ****** | +;;; ******* | +;;; ******* | +;;; ******* | +;;; ******* | +;;; ******* | +;;; ********p | +;;; ******** | +;;; ********* | +;;; c ****a****q | +;;; *** *** _| +;;; b r +;;; +;;; +;;; +;;; +;;; +;;; +;;; +;;; + +(defmethod compute-design ((font font) (shape (eql :time-signature-7))) + (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 + (yb (+ (/ slt 2) yoffset)) + ;; if the little notch is to be visible, the top + ;; of this character should hang below the upper staff line. + (h1 (- (* 2 sld) slt)) + (yl (+ yb (- h1 slt))) + (w1 (round (* 0.37 h1))) + (yn (+ yb (- h1 (* 2 slt)))) + (yf (+ yb (round (* 0.65 h1)))) + (ya (+ yb slt)) + (pc (c (round (* -0.20 h1)) (+ yb (* 0.03 h1)))) + (pb (c (+ (realpart pc) (* 0.03 h1)) yb)) + (pd (c (round (* 0.18 h1)) yf)) + (pe (c (realpart pd) (+ (imagpart pd) (* 0.03 h1)))) + (pf (c (* 0.06 h1) yf)) + (pg (c (* -0.21 h1) (+ yf (round (* 0.8 slt))))) + (ph (c (- (* 0.03 h1) w1) (+ yb (* 0.55 h1)))) + (ppi (c (- w1) (+ (imagpart ph) (* 0.03 h1)))) + (pj (c (- w1) (+ yb (- h1 (* 0.03 h1))))) + (pk (c (+ (realpart pj) (* 0.03 h1)) (+ yb h1))) + (pl (c (- (* 0.11 h1) w1) yl)) + (pm (c (* -0.05 h1) (+ yb h1))) + (pn (c (* 0.23 h1) yn)) + (po (c (round (* 0.9 w1)) (+ yb h1))) + (pp (c (round (* 0.15 h1)) (+ yb (* 0.13 h1)))) + (pq (c (realpart pp) (+ yb (* 0.03 h1)))) + (pr (c (- (realpart pp) (* 0.03 h1)) yb)) + (pa (c (* 0.00 h1) ya))) + (mf pa left ++ pb left ++ pc up (tensions 1 5) pd up ++ pe left ++ + pf left ++ pg left ++ ph left ++ ppi up ++ + pj up ++ pk right ++ pl right ++ pm right ++ + pn right (tensions 1 3) po (tensions 3 1) + pp down ++ pq down ++ pr left ++ cycle))))) + + \ No newline at end of file

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 17 Nov '08

17 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv29936 Modified Files: sdl.lisp Log Message: Time signature digit 6. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/17 05:49:28 1.41 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/17 06:40:26 1.42 @@ -1999,3 +1999,85 @@ pf right ++ pg up ++ ph left ++ ppi left ++ pj up ++ pk up ++ pl right ++ pm right ++ pn right ++ po down ++ pp left ++ pq left ++ pr down ++ ps right ++ pt right ++ pu down ++ cycle))))) + +;;; +;;; w2 +;;; __________ +;;; | | +;;; c _ +;;; **** | +;;; ******g***** | +;;; ***** ******** | +;;; ****** **********d | +;;; ****** f********** | +;;; *******h ******** | +;;; ******** **e* | +;;; ********** j | +;;; ************i********** | +;;; ************************* | +;;; ************* n ********** | h1 +;;; b*********** ********** | +;;; ********** ********** | +;;; ********** **********k | +;;; **********m o********** | +;;; ********** ********** | +;;; ********* ********* | +;;; ********* l ******** | +;;; ******************** | +;;; **************** | +;;; ********* _| +;;; a +;;; +;;; +;;; |____________| +;;; w1 +;;; +;;; + +(defmethod compute-design ((font font) (shape (eql :time-signature-6))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + yoffset) + font + (flet ((c (x y) (complex x y))) + (let* (;; This symbol should 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)) + (w1 (round (* 0.4 h1))) + (w2 (round (* 0.35 h1))) + (xc (* 0.1 w2)) + (xf (round (* 0.05 h1))) + (yf (+ ya (* 0.8 h1))) + (xe (* 0.5 (+ w2 xf))) + (ye (+ ya (* 0.68 h1))) + (xg (+ xf (* 0.02 h1))) + (yg (+ ya (- h1 slt))) + (xh (* -0.12 h1)) + (yh (+ ya (* 0.7 h1))) + (xj (* 0.12 h1)) + (yj (- ye slt)) + (xi (* -0.09 h1)) + (yi (- yj (* 0.5 slt))) + (yn (- yj (* 2 slt))) + (pa (c 0 0)) + (pb (c (- w1) (+ ya (* 0.45 h1)))) + (pc (c xc (+ ya h1))) + (pd (c w2 yf)) + (pe (c xe ye)) + (pf (c xf yf)) + (pg (c xg yg)) + (ph (c xh yh)) + (ppi (c xi yi)) + (pj (c xj yj)) + (pk (c w1 (+ ya (* 0.35 h1)))) + (pl (+ pa (c 0 slt))) + (pm (c (* -0.13 h1) (+ ya (* 0.32 h1)))) + (pn (c 0 yn)) + (po (c (* 0.13 h1) (+ ya (* 0.32 h1))))) + (clim:region-difference + (mf pa left ++ pb up ++ pc right ++ pd down ++ pe left ++ + pf up (tensions 1 20) pg (tensions 20 1) ph down ++ ppi + (tensions 5 1) pj right ++ pk down ++ cycle) + (mf pl left ++ pm up ++ pn right ++ po down ++ cycle)))))) \ No newline at end of file

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 17 Nov '08

17 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv15942 Modified Files: sdl.lisp Log Message: Time signature digit 5. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/16 06:36:03 1.40 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/17 05:49:28 1.41 @@ -1797,7 +1797,7 @@ yoffset) font (flet ((c (x y) (complex x y))) - (let* (;; This symbol should sit have its lowest point + (let* (;; This symbol should 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 @@ -1909,4 +1909,93 @@ pg left ++ ph ++ ppi (tensions 1 3) pj ++ right pk -- pl right ++ pm ++ pn (tensions 1 5) po down ++ pp right ++ pr up ++ up ps -- pt (direction (- pt ps)) ++ down pv -- pw down ++ px down ++ - py down ++ pz down ++ left paa -- cycle))))) \ No newline at end of file + py down ++ pz down ++ left paa -- cycle))))) + +;;; +;;; w2 +;;; _______ +;;; | | +;;; +;;; l n _ +;;; ******* m *****o | +;;; k******************** | +;;; ******************* | +;;; ****************** | +;;; *****q********** | +;;; **** **p** | +;;; ****r | +;;; **** s **t** - | +;;; *************** | | +;;; ****************** | | h1 +;;; j**** h ********** | | +;;; i ********* | | +;;; c ********* | | +;;; - ***** g*********u | | +;;; | ********* ********* | h2 | +;;; | *********** ********* | | +;;; - | b************d ********* | | +;;; | h4| ********** ********* | | +;;; h3| | ******e f ********* | | +;;; | | ************** | | +;;; |_ |_ ******** _| _| +;;; a +;;; +;;; |___________| +;;; w1 +;;; +;;; + +(defmethod compute-design ((font font) (shape (eql :time-signature-5))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + yoffset) + font + (flet ((c (x y) (complex x y))) + (let* (;; This symbol should 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 (round (* 0.62 h1))) + (h3 (* 0.30 h1)) + (h4 (round (* 0.44 h1))) + (yi (+ ya h4 (max 1 (round (* 0.04 h1))))) + (yp (+ ya h2 (max 1 (round (* 0.08 h1))))) + (ym (+ ya (round (* 0.95 h1)))) + (yn (+ ya (round (* 0.975 h1)))) + (yg (+ ya (* 0.35 h1))) + (yh (+ ya (- h2 (max 1 (round (* 0.07 h1)))))) + (w1 (round (* 0.4 h1))) + (w2 (round (* 0.3 h1))) + (xd 0) + (xc (* 0.5 (- xd w1))) + (xe (- xd (* 0.09 h1))) + (xg (round (* 0.10 h1))) + (xr (- (round (* 0.13 h1)) w2)) + (ys (- h2 (* 0.03 h1))) + (yq (+ yp (* 0.03 h1))) + (pa (c 0 ya)) + (pb (c (- w1) (+ ya h3))) + (pc (c xc (+ ya h4))) + (pd (c xd (+ ya h3))) + (pe (c xe (+ ya (* 0.13 h1)))) + (pf (c (* -0.2 w1) (+ ya slt))) + (pg (c xg (+ ya yg))) + (ph (c (* -0.05 h1) yh)) + (ppi (c (- (* 0.05 h1) w2) yi)) + (pj (c (- w2) (+ yi (* 0.05 h1)))) + (pk (c (- w2) (+ ya (- h1 (* 0.10 h1))))) + (pl (c (- (* 0.07 h1) w2) (+ ya h1))) + (pm (c (* 0.18 h1) ym)) + (pn (c (- w2 (* 0.03 h1)) yn)) + (po (c (round (* 1.1 w2)) (+ ya (- h1 (* 0.03 h1))))) + (pp (c (* 0.05 h1) yp)) + (pq (c (+ xr (* 0.03 h1)) yq)) + (pr (c xr (+ (* 0.7 ys) (* 0.3 yq)))) + (ps (c (+ xr (* 0.03 h1)) ys)) + (pt (c (* 0.1 h1) (+ ya h2))) + (pu (c w1 (+ ya yg)))) + (mf pa left ++ pb up ++ pc right ++ pd down ++ pe (tensions 20 1) + pf right ++ pg up ++ ph left ++ ppi left ++ pj up ++ pk up ++ + pl right ++ pm right ++ pn right ++ po down ++ pp left ++ + pq left ++ pr down ++ ps right ++ pt right ++ pu down ++ cycle)))))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 16 Nov '08

16 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv1372 Modified Files: sdl.lisp Log Message: Time signature digit 4. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/15 18:22:23 1.39 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/16 06:36:03 1.40 @@ -1831,3 +1831,82 @@ 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))))) + +;;; +;;; +;;; +;;; k l +;;; ************* - +;;; j*************m | +;;; ************* | +;;; ************* | +;;; ************ | +;;; ************ | +;;; *********** *** | +;;; **********n t****v | +;;; ********* ****** | +;;; ******** ******** | +;;; i******* s********** | h2 +;;; ****** ********** | +;;; ***** ********** | +;;; ***** r**********w | +;;; ******o p ********** | +;;; ****************************** | +;;; h*********************************x | +;;; ****************************** - | +;;; g f e**********y | | +;;; d**************** | | +;;; c -**********************z | h1 | +;;; ********************** _| _| +;;; b a aa +;;; +;;; |_ _| +;;; w2 +;;; |_________| +;;; w1 +;;; + +(defmethod compute-design ((font font) (shape (eql :time-signature-4))) + (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 + (ya (+ (/ slt 2) yoffset)) + ;; Its top should hang under the staff line + (h2 (- (* 2 sld) slt)) + (xa (round (* 0.02 h2))) + (h1 (round (* 0.15 h2))) + (w1 (round (* 0.25 h2))) + (w2 (round (* 0.14 h2))) + (pa (c xa ya)) + (pb (c (- xa (* 0.90 w1)) ya)) + (pc (c (- xa w1) (+ ya (* 0.25 h1)))) + (pd (+ pb (c 0 (* 1/2 h1)))) + (pe (c (- xa w2) (+ ya (* 0.75 h1)))) + (pf (+ pd (c 0 (* 1/2 h1)))) + (pg (c (* -0.45 h2) (+ ya h1))) + (ph (c (* -0.47 h2) (+ ya (* 1.1 h1)))) + (ppi (c (* -0.38 h2) (+ ya (* 0.5 h2)))) + (pj (c (* -0.20 h2) (+ ya (* 0.95 h2)))) + (pk (c (* -0.12 h2) (+ ya h2))) + (pl (c (* 0.17 h2) (+ ya h2))) + (pm (c (* 0.17 h2) (+ ya (* 0.9 h2)))) + (pn (c (* -0.1 h2) (+ ya (* 0.55 h2)))) + (po (c (* -0.35 h2) (+ ya (* 1.75 h1)))) + (pp (c (* -0.3 h2) (+ ya (* 1.5 h1)))) + (pr (c (- xa w2) (+ ya (* 2.2 h1)))) + (ps (c (- xa w2) (+ ya (* 2.5 h1)))) + (pt (c (+ xa (* 0.70 w2)) (+ ya (* 0.65 h2)))) + (pv (c (+ xa w2) (+ ya (* 0.65 h2)))) + (pw (c (+ xa w2) (+ ya (* 2.0 h1)))) + (px (c (+ xa w1) (+ ya (* 1.1 h1)))) + (py (c (+ xa w2) (+ ya (* 0.75 h1)))) + (pz (c (+ xa w1) (+ ya (* 0.25 h1)))) + (paa (c (+ xa (* 0.90 w1)) ya))) + (mf pa -- pb left ++ pc up ++ pd right ++ pe up ++ left pf -- + pg left ++ ph ++ ppi (tensions 1 3) pj ++ right pk -- pl right ++ pm ++ + pn (tensions 1 5) po down ++ pp right ++ pr up ++ up ps -- pt + (direction (- pt ps)) ++ down pv -- pw down ++ px down ++ + py down ++ pz down ++ left paa -- cycle))))) \ No newline at end of file

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 15 Nov '08

15 Nov '08

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)))))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 15 Nov '08

15 Nov '08

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

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 15 Nov '08

15 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv27245 Modified Files: mf.lisp Log Message: Make it possible to use cycle after --. --- /project/gsharp/cvsroot/gsharp/mf.lisp 2007/07/17 06:36:32 1.2 +++ /project/gsharp/cvsroot/gsharp/mf.lisp 2008/11/15 17:19:38 1.3 @@ -136,8 +136,10 @@ (setf (curl (right-context x)) (slot-value y 'curl)) (setf (direction (right-context x)) (slot-value y 'direction))) (if (typep y 'curl) - (setf (curl (left-context z)) (slot-value y 'curl)) - (setf (direction (left-context z)) (slot-value y 'direction))))))) + (setf (curl (left-context (if (eq z *cycle*) (car path) z))) + (slot-value y 'curl)) + (setf (direction (left-context (if (eq z *cycle*) (car path) z))) + (slot-value y 'direction))))))) (defun propagate-tensions-controls (path) (loop for (x y z) on path

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

gsharp-cvs November 2008