gsharp-cvs February 2006

gsharp-cvs@common-lisp.net

1 participants
19 discussions

[gsharp-cvs] CVS gsharp
by rstrandh 01 Mar '06

01 Mar '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv10738 Modified Files: play.lisp Log Message: Improved midi-rendering of tied notes. (thanks to Christophe Rhodes) --- /project/gsharp/cvsroot/gsharp/play.lisp 2006/02/14 18:16:03 1.3 +++ /project/gsharp/cvsroot/gsharp/play.lisp 2006/02/28 23:49:18 1.4 @@ -24,13 +24,13 @@ :time time :status (+ #x90 channel) :key (midi-pitch note) :velocity 100)) - (notes element)) + (remove-if #'tie-left (notes element))) (mapcar (lambda (note) (make-instance 'note-off-message :time (+ time (* 128 (duration element))) :status (+ #x80 channel) :key (midi-pitch note) :velocity 100)) - (notes element))))) + (remove-if #'tie-right (notes element)))))) (defun events-from-bar (bar time channel) (mapcan (lambda (element)

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 01 Mar '06

01 Mar '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv9336 Modified Files: buffer.lisp Log Message: Save ties when writing a buffer to disk. (thanks to Christophe Rhodes) --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2006/02/15 02:54:26 1.34 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2006/02/28 23:42:12 1.35 @@ -199,10 +199,11 @@ (apply #'make-instance 'note :pitch pitch :staff staff args)) (defmethod print-gsharp-object :after ((n note) stream) - (with-slots (pitch staff head accidentals dots) n + (with-slots (pitch staff head accidentals dots %tie-right %tie-left) n (format stream - "~_:pitch ~W ~_:staff ~W ~_:head ~W ~_:accidentals ~W ~_:dots ~W " - pitch staff head accidentals dots))) + "~_:pitch ~W ~_:staff ~W ~_:head ~W ~_:accidentals ~W ~_:dots ~W ~ + ~@[~_:tie-right ~W ~]~@[~_:tie-left ~W ~]" + pitch staff head accidentals dots %tie-right %tie-left))) (defun read-note-v3 (stream char n) (declare (ignore char n))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 26 Feb '06

26 Feb '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv11186 Modified Files: packages.lisp drawing.lisp charmap.lisp score-pane.lisp Log Message: The code for drawing ties is basically done (score-pane.lisp). The code in drawing.lisp that actually decides how to call the tie-drawing functions is only rudimentary (only upward ties are drawn at the moment). --- /project/gsharp/cvsroot/gsharp/packages.lisp 2006/02/15 02:54:27 1.45 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2006/02/26 22:18:39 1.46 @@ -61,7 +61,87 @@ #:+glyph-flags-down-one+ #:+glyph-flags-down-two+ #:+glyph-flags-down-three+ #:+glyph-flags-down-four+ #:+glyph-flags-down-five+ #:+glyph-flags-up-one+ #:+glyph-flags-up-two+ #:+glyph-flags-up-three+ #:+glyph-flags-up-four+ - #:+glyph-flags-up-five+)) + #:+glyph-flags-up-five+ + #:+glyph-small-tie-one-up+ + #:+glyph-small-tie-one-up-light+ + #:+glyph-small-tie-two-up+ + #:+glyph-small-tie-two-up-light+ + #:+glyph-small-tie-three-up+ + #:+glyph-small-tie-three-up-light+ + #:+glyph-small-tie-four-up+ + #:+glyph-small-tie-four-up-light+ + #:+glyph-small-tie-five-up+ + #:+glyph-small-tie-five-up-light+ + #:+glyph-small-tie-six-up+ + #:+glyph-small-tie-six-up-light+ + #:+glyph-small-tie-seven-up+ + #:+glyph-small-tie-seven-up-light+ + #:+glyph-small-tie-eight-up+ + #:+glyph-small-tie-eight-up-light+ + #:+glyph-small-tie-one-down+ + #:+glyph-small-tie-one-down-light+ + #:+glyph-small-tie-two-down+ + #:+glyph-small-tie-two-down-light+ + #:+glyph-small-tie-three-down+ + #:+glyph-small-tie-three-down-light+ + #:+glyph-small-tie-four-down+ + #:+glyph-small-tie-four-down-light+ + #:+glyph-small-tie-five-down+ + #:+glyph-small-tie-five-down-light+ + #:+glyph-small-tie-six-down+ + #:+glyph-small-tie-six-down-light+ + #:+glyph-small-tie-seven-down+ + #:+glyph-small-tie-seven-down-light+ + #:+glyph-small-tie-eight-down+ + #:+glyph-small-tie-eight-down-light+ + #:+glyph-large-tie-one-up+ + #:+glyph-large-tie-one-up-light+ + #:+glyph-large-tie-two-up+ + #:+glyph-large-tie-two-up-light+ + #:+glyph-large-tie-three-up+ + #:+glyph-large-tie-three-up-light+ + #:+glyph-large-tie-four-up+ + #:+glyph-large-tie-four-up-light+ + #:+glyph-large-tie-five-up+ + #:+glyph-large-tie-five-up-light+ + #:+glyph-large-tie-six-up+ + #:+glyph-large-tie-six-up-light+ + #:+glyph-large-tie-seven-up+ + #:+glyph-large-tie-seven-up-light+ + #:+glyph-large-tie-eight-up+ + #:+glyph-large-tie-eight-up-light+ + #:+glyph-large-tie-nine-up+ + #:+glyph-large-tie-nine-up-light+ + #:+glyph-large-tie-ten-up+ + #:+glyph-large-tie-ten-up-light+ + #:+glyph-large-tie-left-up+ + #:+glyph-large-tie-left-up-light+ + #:+glyph-large-tie-right-up+ + #:+glyph-large-tie-right-up-light+ + #:+glyph-large-tie-one-down+ + #:+glyph-large-tie-one-down-light+ + #:+glyph-large-tie-two-down+ + #:+glyph-large-tie-two-down-light+ + #:+glyph-large-tie-three-down+ + #:+glyph-large-tie-three-down-light+ + #:+glyph-large-tie-four-down+ + #:+glyph-large-tie-four-down-light+ + #:+glyph-large-tie-five-down+ + #:+glyph-large-tie-five-down-light+ + #:+glyph-large-tie-six-down+ + #:+glyph-large-tie-six-down-light+ + #:+glyph-large-tie-seven-down+ + #:+glyph-large-tie-seven-down-light+ + #:+glyph-large-tie-eight-down+ + #:+glyph-large-tie-eight-down-light+ + #:+glyph-large-tie-nine-down+ + #:+glyph-large-tie-nine-down-light+ + #:+glyph-large-tie-ten-down+ + #:+glyph-large-tie-ten-down-light+ + #:+glyph-large-tie-left-down+ + #:+glyph-large-tie-left-down-light+ + #:+glyph-large-tie-right-down+ + #:+glyph-large-tie-right-down-light+)) (defpackage :score-pane (:use :clim :clim-extensions :clim-lisp :sdl :esa) @@ -71,7 +151,7 @@ #:draw-ledger-line #:draw-bar-line #:draw-beam #:staff-step #:draw-notehead #:draw-accidental #:draw-clef #:draw-rest #:draw-dot #:draw-flags-up #:draw-flags-down - #:draw-tie + #:draw-tie-up #:draw-tie-down #:with-score-pane #:with-vertical-score-position #:with-staff-size #:with-notehead-right-offsets #:with-suspended-note-offset --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/02/14 03:00:52 1.62 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/02/26 22:18:39 1.63 @@ -340,11 +340,11 @@ (= (pitch n1) (pitch n2)) (eq (staff n1) (staff n2)) (accidentals n1) (accidentals n2)) - (let ((x1 (final-absolute-note-xoffset n1)) - (x2 (final-absolute-note-xoffset n2)) - (y (- (score-pane:staff-step (note-position n1))))) + (let ((x1 (+ (final-absolute-note-xoffset n1) (score-pane:staff-step 1.5))) + (x2 (- (final-absolute-note-xoffset n2) (score-pane:staff-step 1.5))) + (pos (note-position n1))) (score-pane:with-vertical-score-position (pane (staff-yoffset (staff n1))) - (score-pane:draw-tie pane x1 x2 y))))))))))) + (score-pane:draw-tie-up pane x1 x2 (if (oddp pos) (1+ pos) pos)))))))))))) (defun draw-system (pane measures) (loop for measure in measures do --- /project/gsharp/cvsroot/gsharp/charmap.lisp 2004/02/16 15:46:10 1.1.1.1 +++ /project/gsharp/cvsroot/gsharp/charmap.lisp 2006/02/26 22:18:39 1.2 @@ -87,3 +87,88 @@ (defconstant +glyph-flags-up-four-light+ 127) (defconstant +glyph-flags-up-five+ 128) (defconstant +glyph-flags-up-five-light+ 129) + +(defconstant +glyph-small-tie-one-up+ 130) +(defconstant +glyph-small-tie-one-up-light+ 131) +(defconstant +glyph-small-tie-two-up+ 132) +(defconstant +glyph-small-tie-two-up-light+ 133) +(defconstant +glyph-small-tie-three-up+ 134) +(defconstant +glyph-small-tie-three-up-light+ 135) +(defconstant +glyph-small-tie-four-up+ 136) +(defconstant +glyph-small-tie-four-up-light+ 137) +(defconstant +glyph-small-tie-five-up+ 138) +(defconstant +glyph-small-tie-five-up-light+ 139) +(defconstant +glyph-small-tie-six-up+ 140) +(defconstant +glyph-small-tie-six-up-light+ 141) +(defconstant +glyph-small-tie-seven-up+ 142) +(defconstant +glyph-small-tie-seven-up-light+ 143) +(defconstant +glyph-small-tie-eight-up+ 144) +(defconstant +glyph-small-tie-eight-up-light+ 145) + +(defconstant +glyph-small-tie-one-down+ 146) +(defconstant +glyph-small-tie-one-down-light+ 147) +(defconstant +glyph-small-tie-two-down+ 148) +(defconstant +glyph-small-tie-two-down-light+ 149) +(defconstant +glyph-small-tie-three-down+ 150) +(defconstant +glyph-small-tie-three-down-light+ 151) +(defconstant +glyph-small-tie-four-down+ 152) +(defconstant +glyph-small-tie-four-down-light+ 153) +(defconstant +glyph-small-tie-five-down+ 154) +(defconstant +glyph-small-tie-five-down-light+ 155) +(defconstant +glyph-small-tie-six-down+ 156) +(defconstant +glyph-small-tie-six-down-light+ 157) +(defconstant +glyph-small-tie-seven-down+ 158) +(defconstant +glyph-small-tie-seven-down-light+ 159) +(defconstant +glyph-small-tie-eight-down+ 160) +(defconstant +glyph-small-tie-eight-down-light+ 161) + +(defconstant +glyph-large-tie-one-up+ 162) +(defconstant +glyph-large-tie-one-up-light+ 163) +(defconstant +glyph-large-tie-two-up+ 164) +(defconstant +glyph-large-tie-two-up-light+ 165) +(defconstant +glyph-large-tie-three-up+ 166) +(defconstant +glyph-large-tie-three-up-light+ 167) +(defconstant +glyph-large-tie-four-up+ 168) +(defconstant +glyph-large-tie-four-up-light+ 169) +(defconstant +glyph-large-tie-five-up+ 170) +(defconstant +glyph-large-tie-five-up-light+ 171) +(defconstant +glyph-large-tie-six-up+ 172) +(defconstant +glyph-large-tie-six-up-light+ 173) +(defconstant +glyph-large-tie-seven-up+ 174) +(defconstant +glyph-large-tie-seven-up-light+ 175) +(defconstant +glyph-large-tie-eight-up+ 176) +(defconstant +glyph-large-tie-eight-up-light+ 177) +(defconstant +glyph-large-tie-nine-up+ 178) +(defconstant +glyph-large-tie-nine-up-light+ 179) +(defconstant +glyph-large-tie-ten-up+ 180) +(defconstant +glyph-large-tie-ten-up-light+ 181) +(defconstant +glyph-large-tie-left-up+ 182) +(defconstant +glyph-large-tie-left-up-light+ 183) +(defconstant +glyph-large-tie-right-up+ 184) +(defconstant +glyph-large-tie-right-up-light+ 185) + +(defconstant +glyph-large-tie-one-down+ 186) +(defconstant +glyph-large-tie-one-down-light+ 187) +(defconstant +glyph-large-tie-two-down+ 188) +(defconstant +glyph-large-tie-two-down-light+ 189) +(defconstant +glyph-large-tie-three-down+ 190) +(defconstant +glyph-large-tie-three-down-light+ 191) +(defconstant +glyph-large-tie-four-down+ 192) +(defconstant +glyph-large-tie-four-down-light+ 193) +(defconstant +glyph-large-tie-five-down+ 194) +(defconstant +glyph-large-tie-five-down-light+ 195) +(defconstant +glyph-large-tie-six-down+ 196) +(defconstant +glyph-large-tie-six-down-light+ 197) +(defconstant +glyph-large-tie-seven-down+ 198) +(defconstant +glyph-large-tie-seven-down-light+ 199) +(defconstant +glyph-large-tie-eight-down+ 200) +(defconstant +glyph-large-tie-eight-down-light+ 201) +(defconstant +glyph-large-tie-nine-down+ 202) +(defconstant +glyph-large-tie-nine-down-light+ 203) +(defconstant +glyph-large-tie-ten-down+ 204) +(defconstant +glyph-large-tie-ten-down-light+ 205) +(defconstant +glyph-large-tie-left-down+ 206) +(defconstant +glyph-large-tie-left-down-light+ 207) +(defconstant +glyph-large-tie-right-down+ 208) +(defconstant +glyph-large-tie-right-down-light+ 209) + --- /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/02/14 03:00:52 1.20 +++ /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/02/26 22:18:39 1.21 @@ -168,12 +168,10 @@ (defun draw-antialiased-glyph (pane glyph-no x staff-step) (let* ((extra (if *light-glyph* 1 0)) (matrix (glyph *font* (+ glyph-no extra))) - (pixmap (pane-pixmap pane matrix)) - (width (pixmap-width pixmap)) - (height (pixmap-height pixmap))) + (pixmap (pane-pixmap pane matrix))) (multiple-value-bind (dx dy) (glyph-offsets *font* (+ glyph-no extra)) (let ((x1 (+ x dx)) - (y1 (+ (staff-step staff-step) dy))) + (y1 (- dy (staff-step staff-step)))) (draw-pixmap* pane pixmap x1 y1))))) ;;; Given a pane, an x position (measured in pixels) a y position @@ -627,9 +625,65 @@ (draw-horizontal-beam pane xx1 y1 xx2) (draw-sloped-beam medium xx1 y1 xx2 y2)))))) -;;; FIXME obviously -(defun draw-tie (pane x1 x2 y) - (draw-rectangle* pane x1 (1- y) x2 (1+ y) :ink +blue+)) +(defun draw-tie-up (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))))) + (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) + (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))))) + +(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))))) + (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) + (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))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[gsharp-cvs] CVS gsharp/Fonts
by rstrandh 26 Feb '06

26 Feb '06

Update of /project/gsharp/cvsroot/gsharp/Fonts In directory clnet:/tmp/cvs-serv9721 Modified Files: charmap.mf ties.mf Log Message: Cleaned up the ties. --- /project/gsharp/cvsroot/gsharp/Fonts/charmap.mf 2004/03/26 14:25:34 1.4 +++ /project/gsharp/cvsroot/gsharp/Fonts/charmap.mf 2006/02/26 22:14:30 1.5 @@ -120,103 +120,53 @@ global_variable(numeric)(small_tie_eight_down)(160) global_variable(numeric)(small_tie_eight_down_light)(161) -global_variable(numeric)(large_tie_line_one_up)(162) -global_variable(numeric)(large_tie_line_one_up_light)(163) -global_variable(numeric)(large_tie_line_two_up)(164) -global_variable(numeric)(large_tie_line_two_up_light)(165) -global_variable(numeric)(large_tie_line_three_up)(166) -global_variable(numeric)(large_tie_line_three_up_light)(167) -global_variable(numeric)(large_tie_line_four_up)(168) -global_variable(numeric)(large_tie_line_four_up_light)(169) -global_variable(numeric)(large_tie_line_five_up)(170) -global_variable(numeric)(large_tie_line_five_up_light)(171) -global_variable(numeric)(large_tie_line_six_up)(172) -global_variable(numeric)(large_tie_line_six_up_light)(173) -global_variable(numeric)(large_tie_line_seven_up)(174) -global_variable(numeric)(large_tie_line_seven_up_light)(175) -global_variable(numeric)(large_tie_line_eight_up)(176) -global_variable(numeric)(large_tie_line_eight_up_light)(177) -global_variable(numeric)(large_tie_line_nine_up)(178) -global_variable(numeric)(large_tie_line_nine_up_light)(179) -global_variable(numeric)(large_tie_line_ten_up)(180) -global_variable(numeric)(large_tie_line_ten_up_light)(181) -global_variable(numeric)(large_tie_line_left_up)(182) -global_variable(numeric)(large_tie_line_left_up_light)(183) -global_variable(numeric)(large_tie_line_right_up)(184) -global_variable(numeric)(large_tie_line_right_up_light)(185) +global_variable(numeric)(large_tie_one_up)(162) +global_variable(numeric)(large_tie_one_up_light)(163) +global_variable(numeric)(large_tie_two_up)(164) +global_variable(numeric)(large_tie_two_up_light)(165) +global_variable(numeric)(large_tie_three_up)(166) +global_variable(numeric)(large_tie_three_up_light)(167) +global_variable(numeric)(large_tie_four_up)(168) +global_variable(numeric)(large_tie_four_up_light)(169) +global_variable(numeric)(large_tie_five_up)(170) +global_variable(numeric)(large_tie_five_up_light)(171) +global_variable(numeric)(large_tie_six_up)(172) +global_variable(numeric)(large_tie_six_up_light)(173) +global_variable(numeric)(large_tie_seven_up)(174) +global_variable(numeric)(large_tie_seven_up_light)(175) +global_variable(numeric)(large_tie_eight_up)(176) +global_variable(numeric)(large_tie_eight_up_light)(177) +global_variable(numeric)(large_tie_nine_up)(178) +global_variable(numeric)(large_tie_nine_up_light)(179) +global_variable(numeric)(large_tie_ten_up)(180) +global_variable(numeric)(large_tie_ten_up_light)(181) +global_variable(numeric)(large_tie_left_up)(182) +global_variable(numeric)(large_tie_left_up_light)(183) +global_variable(numeric)(large_tie_right_up)(184) +global_variable(numeric)(large_tie_right_up_light)(185) -global_variable(numeric)(large_tie_space_one_up)(186) -global_variable(numeric)(large_tie_space_one_up_light)(187) -global_variable(numeric)(large_tie_space_two_up)(188) -global_variable(numeric)(large_tie_space_two_up_light)(189) -global_variable(numeric)(large_tie_space_three_up)(190) -global_variable(numeric)(large_tie_space_three_up_light)(191) -global_variable(numeric)(large_tie_space_four_up)(192) -global_variable(numeric)(large_tie_space_four_up_light)(193) -global_variable(numeric)(large_tie_space_five_up)(194) -global_variable(numeric)(large_tie_space_five_up_light)(195) -global_variable(numeric)(large_tie_space_six_up)(196) -global_variable(numeric)(large_tie_space_six_up_light)(197) -global_variable(numeric)(large_tie_space_seven_up)(198) -global_variable(numeric)(large_tie_space_seven_up_light)(199) -global_variable(numeric)(large_tie_space_eight_up)(200) -global_variable(numeric)(large_tie_space_eight_up_light)(201) -global_variable(numeric)(large_tie_space_nine_up)(202) -global_variable(numeric)(large_tie_space_nine_up_light)(203) -global_variable(numeric)(large_tie_space_ten_up)(204) -global_variable(numeric)(large_tie_space_ten_up_light)(205) -global_variable(numeric)(large_tie_space_left_up)(206) -global_variable(numeric)(large_tie_space_left_up_light)(207) -global_variable(numeric)(large_tie_space_right_up)(208) -global_variable(numeric)(large_tie_space_right_up_light)(209) - -global_variable(numeric)(large_tie_line_one_down)(210) -global_variable(numeric)(large_tie_line_one_down_light)(211) -global_variable(numeric)(large_tie_line_two_down)(212) -global_variable(numeric)(large_tie_line_two_down_light)(213) -global_variable(numeric)(large_tie_line_three_down)(214) -global_variable(numeric)(large_tie_line_three_down_light)(215) -global_variable(numeric)(large_tie_line_four_down)(216) -global_variable(numeric)(large_tie_line_four_down_light)(217) -global_variable(numeric)(large_tie_line_five_down)(218) -global_variable(numeric)(large_tie_line_five_down_light)(219) -global_variable(numeric)(large_tie_line_six_down)(220) -global_variable(numeric)(large_tie_line_six_down_light)(221) -global_variable(numeric)(large_tie_line_seven_down)(222) -global_variable(numeric)(large_tie_line_seven_down_light)(223) -global_variable(numeric)(large_tie_line_eight_down)(224) -global_variable(numeric)(large_tie_line_eight_down_light)(225) -global_variable(numeric)(large_tie_line_nine_down)(226) -global_variable(numeric)(large_tie_line_nine_down_light)(227) -global_variable(numeric)(large_tie_line_ten_down)(228) -global_variable(numeric)(large_tie_line_ten_down_light)(229) -global_variable(numeric)(large_tie_line_left_down)(230) -global_variable(numeric)(large_tie_line_left_down_light)(231) -global_variable(numeric)(large_tie_line_right_down)(232) -global_variable(numeric)(large_tie_line_right_down_light)(233) - -global_variable(numeric)(large_tie_space_one_down)(234) -global_variable(numeric)(large_tie_space_one_down_light)(235) -global_variable(numeric)(large_tie_space_two_down)(236) -global_variable(numeric)(large_tie_space_two_down_light)(237) -global_variable(numeric)(large_tie_space_three_down)(238) -global_variable(numeric)(large_tie_space_three_down_light)(239) -global_variable(numeric)(large_tie_space_four_down)(240) -global_variable(numeric)(large_tie_space_four_down_light)(241) -global_variable(numeric)(large_tie_space_five_down)(242) -global_variable(numeric)(large_tie_space_five_down_light)(243) -global_variable(numeric)(large_tie_space_six_down)(244) -global_variable(numeric)(large_tie_space_six_down_light)(245) -global_variable(numeric)(large_tie_space_seven_down)(246) -global_variable(numeric)(large_tie_space_seven_down_light)(247) -global_variable(numeric)(large_tie_space_eight_down)(248) -global_variable(numeric)(large_tie_space_eight_down_light)(249) -global_variable(numeric)(large_tie_space_nine_down)(250) -global_variable(numeric)(large_tie_space_nine_down_light)(251) -global_variable(numeric)(large_tie_space_ten_down)(252) -global_variable(numeric)(large_tie_space_ten_down_light)(253) -global_variable(numeric)(large_tie_space_left_down)(254) -global_variable(numeric)(large_tie_space_left_down_light)(255) -global_variable(numeric)(large_tie_space_right_down)(256) -global_variable(numeric)(large_tie_space_right_down_light)(257) +global_variable(numeric)(large_tie_one_down)(186) +global_variable(numeric)(large_tie_one_down_light)(187) +global_variable(numeric)(large_tie_two_down)(188) +global_variable(numeric)(large_tie_two_down_light)(189) +global_variable(numeric)(large_tie_three_down)(190) +global_variable(numeric)(large_tie_three_down_light)(191) +global_variable(numeric)(large_tie_four_down)(192) +global_variable(numeric)(large_tie_four_down_light)(193) +global_variable(numeric)(large_tie_five_down)(194) +global_variable(numeric)(large_tie_five_down_light)(195) +global_variable(numeric)(large_tie_six_down)(196) +global_variable(numeric)(large_tie_six_down_light)(197) +global_variable(numeric)(large_tie_seven_down)(198) +global_variable(numeric)(large_tie_seven_down_light)(199) +global_variable(numeric)(large_tie_eight_down)(200) +global_variable(numeric)(large_tie_eight_down_light)(201) +global_variable(numeric)(large_tie_nine_down)(202) +global_variable(numeric)(large_tie_nine_down_light)(203) +global_variable(numeric)(large_tie_ten_down)(204) +global_variable(numeric)(large_tie_ten_down_light)(205) +global_variable(numeric)(large_tie_left_down)(206) +global_variable(numeric)(large_tie_left_down_light)(207) +global_variable(numeric)(large_tie_right_down)(208) +global_variable(numeric)(large_tie_right_down_light)(209) --- /project/gsharp/cvsroot/gsharp/Fonts/ties.mf 2004/03/26 14:25:35 1.3 +++ /project/gsharp/cvsroot/gsharp/Fonts/ties.mf 2006/02/26 22:14:30 1.4 @@ -4,11 +4,15 @@ (round(0.33 * staff_line_distance)); local_variable(numeric)(small_tie_height) (round(0.5 * staff_line_distance)); + local_variable(numeric)(large_tie_height) + (round(1.0 * staff_line_distance)); save small_tie_up; def small_tie_up(expr width) = local_variable(numeric)(top) - (round(0.33 * staff_line_distance)-1); + (round(0.5 * (staff_line_distance + + staff_line_thickness + + small_tie_height))); fill ((0, top){right} .. (width, top-small_tie_height) -- (width-1, top-small_tie_height) .. @@ -29,7 +33,9 @@ save small_tie_down; def small_tie_down(expr width) = local_variable(numeric)(bot) - (round(0.33 * staff_line_distance)); + (round(0.5 * (staff_line_distance - + staff_line_thickness + + small_tie_height))); fill ((0, -bot){right} .. (width, small_tie_height-bot) -- (width-1, small_tie_height-bot) .. @@ -175,127 +181,111 @@ small_tie_down_light(round(2.67 * staff_line_distance)); end_character; - local_variable(numeric)(large_tie_line_height) - (round(0.5 * staff_line_distance)); - - local_variable(numeric)(large_tie_space_height) - (round(0.5 * staff_line_distance)); - save large_tie_up; - def large_tie_up(expr width_multiplier, height) = + def large_tie_up(expr width_multiplier) = local_variable(numeric)(top) - (round(0.33 * staff_line_distance)-1); + (round(11.0/6.0 * staff_line_distance)); local_variable(numeric)(width) (round(width_multiplier * staff_line_distance)); fill ((0, top){right} .. - (width, top-height) -- - (width-1, top-height) .. + (width, top-large_tie_height) -- + (width-1, top-large_tie_height) .. (0.3*width, top-tie_thickness) .. (0, top-tie_thickness) .. (-0.3*width, top-tie_thickness) .. - (-(width-1), top-height) -- - (-width, top-height) .. cycle) + (-(width-1), top-large_tie_height) -- + (-width, top-large_tie_height) .. cycle) scaled magnification; enddef; save large_tie_up_light; - def large_tie_up_light(expr width, height) = - large_tie_up(width, height); - stripes(width, 2*height); - enddef; - - save large_tie_line_up; - def large_tie_line_up(expr width_multiplier) = - large_tie_up(width_multiplier, round(1.0 * staff_line_distance)); - enddef; - - save large_tie_line_up_light; - def large_tie_line_up_light(expr width_multiplier) = - large_tie_up_light(width_multiplier, round(1.0 * staff_line_distance)); + def large_tie_up_light(expr width) = + large_tie_up(width); + stripes(width, 2*large_tie_height); enddef; - begin_character(large_tie_line_one_up) - large_tie_line_up(2.0); + begin_character(large_tie_one_up) + large_tie_up(2.0); end_character; - begin_character(large_tie_line_one_up_light) - large_tie_line_up_light(2.0); + begin_character(large_tie_one_up_light) + large_tie_up_light(2.0); end_character; - begin_character(large_tie_line_two_up) - large_tie_line_up(2.33); + begin_character(large_tie_two_up) + large_tie_up(2.33); end_character; - begin_character(large_tie_line_two_up_light) - large_tie_line_up_light(2.33); + begin_character(large_tie_two_up_light) + large_tie_up_light(2.33); end_character; - begin_character(large_tie_line_three_up) - large_tie_line_up(2.67); + begin_character(large_tie_three_up) + large_tie_up(2.67); end_character; - begin_character(large_tie_line_three_up_light) - large_tie_line_up_light(2.67); + begin_character(large_tie_three_up_light) + large_tie_up_light(2.67); end_character; - begin_character(large_tie_line_four_up) - large_tie_line_up(3.0); + begin_character(large_tie_four_up) + large_tie_up(3.0); end_character; - begin_character(large_tie_line_four_up_light) - large_tie_line_up_light(3.0); + begin_character(large_tie_four_up_light) + large_tie_up_light(3.0); end_character; - begin_character(large_tie_line_five_up) - large_tie_line_up(3.33); + begin_character(large_tie_five_up) + large_tie_up(3.33); end_character; - begin_character(large_tie_line_five_up_light) - large_tie_line_up_light(3.33); + begin_character(large_tie_five_up_light) + large_tie_up_light(3.33); end_character; - begin_character(large_tie_line_six_up) - large_tie_line_up(3.67); + begin_character(large_tie_six_up) + large_tie_up(3.67); end_character; - begin_character(large_tie_line_six_up_light) - large_tie_line_up_light(3.67); + begin_character(large_tie_six_up_light) + large_tie_up_light(3.67); end_character; - begin_character(large_tie_line_seven_up) - large_tie_line_up(4.0); + begin_character(large_tie_seven_up) + large_tie_up(4.0); end_character; - begin_character(large_tie_line_seven_up_light) - large_tie_line_up_light(4.0); + begin_character(large_tie_seven_up_light) + large_tie_up_light(4.0); end_character; - begin_character(large_tie_line_eight_up) - large_tie_line_up(4.33); + begin_character(large_tie_eight_up) + large_tie_up(4.33); end_character; - begin_character(large_tie_line_eight_up_light) - large_tie_line_up_light(4.33); + begin_character(large_tie_eight_up_light) + large_tie_up_light(4.33); end_character; - begin_character(large_tie_line_nine_up) - large_tie_line_up(4.67); + begin_character(large_tie_nine_up) + large_tie_up(4.67); end_character; - begin_character(large_tie_line_nine_up_light) - large_tie_line_up_light(4.67); + begin_character(large_tie_nine_up_light) + large_tie_up_light(4.67); end_character; - begin_character(large_tie_line_ten_up) - large_tie_line_up(5.0); + begin_character(large_tie_ten_up) + large_tie_up(5.0); end_character; - begin_character(large_tie_line_ten_up_light) - large_tie_line_up_light(5.0); + begin_character(large_tie_ten_up_light) + large_tie_up_light(5.0); end_character; - begin_character(large_tie_line_left_up) - large_tie_line_up(5.0); + begin_character(large_tie_left_up) + large_tie_up(5.0); erase fill ((0, -2 * staff_line_distance) -- (6 * staff_line_distance, -2 * staff_line_distance) -- (6 * staff_line_distance, 2 * staff_line_distance) -- @@ -303,8 +293,8 @@ scaled magnification; end_character; - begin_character(large_tie_line_left_up_light) - large_tie_line_up(5.0); + begin_character(large_tie_left_up_light) + large_tie_up(5.0); erase fill ((0, -2 * staff_line_distance) -- (6 * staff_line_distance, -2 * staff_line_distance) -- (6 * staff_line_distance, 2 * staff_line_distance) -- @@ -313,8 +303,8 @@ stripes(6 * staff_line_distance, 2 * staff_line_distance); end_character; - begin_character(large_tie_line_right_up) - large_tie_line_up(5.0); + begin_character(large_tie_right_up) + large_tie_up(5.0); erase fill ((0, -2 * staff_line_distance) -- (-6 * staff_line_distance, -2 * staff_line_distance) -- (-6 * staff_line_distance, 2 * staff_line_distance) -- @@ -322,8 +312,8 @@ scaled magnification; end_character; - begin_character(large_tie_line_right_up_light) - large_tie_line_up(5.0); + begin_character(large_tie_right_up_light) + large_tie_up(5.0); erase fill ((0, -2 * staff_line_distance) -- (-6 * staff_line_distance, -2 * staff_line_distance) -- (-6 * staff_line_distance, 2 * staff_line_distance) -- @@ -332,377 +322,112 @@ stripes(6 * staff_line_distance, 2 * staff_line_distance); end_character; - save large_tie_space_up; - def large_tie_space_up(expr width_multiplier) = - large_tie_up(width_multiplier, round(1.33 * staff_line_distance)); - enddef; - - save large_tie_space_up_light; - def large_tie_space_up_light(expr width_multiplier) = - large_tie_up_light(width_multiplier, round(1.33 * staff_line_distance)); - enddef; - - begin_character(large_tie_space_one_up) - large_tie_space_up(2.0); - end_character; - - begin_character(large_tie_space_one_up_light) - large_tie_space_up_light(2.0); - end_character; - - begin_character(large_tie_space_two_up) - large_tie_space_up(2.33); - end_character; - - begin_character(large_tie_space_two_up_light) - large_tie_space_up_light(2.33); - end_character; - - begin_character(large_tie_space_three_up) - large_tie_space_up(2.67); - end_character; - - begin_character(large_tie_space_three_up_light) - large_tie_space_up_light(2.67); - end_character; - - begin_character(large_tie_space_four_up) - large_tie_space_up(3.0); - end_character; - - begin_character(large_tie_space_four_up_light) - large_tie_space_up_light(3.0); - end_character; - - begin_character(large_tie_space_five_up) - large_tie_space_up(3.33); - end_character; - - begin_character(large_tie_space_five_up_light) - large_tie_space_up_light(3.33); - end_character; - - begin_character(large_tie_space_six_up) - large_tie_space_up(3.67); - end_character; - - begin_character(large_tie_space_six_up_light) - large_tie_space_up_light(3.67); - end_character; - - begin_character(large_tie_space_seven_up) - large_tie_space_up(4.0); - end_character; - - begin_character(large_tie_space_seven_up_light) - large_tie_space_up_light(4.0); - end_character; - - begin_character(large_tie_space_eight_up) - large_tie_space_up(4.33); - end_character; - - begin_character(large_tie_space_eight_up_light) - large_tie_space_up_light(4.33); - end_character; - - begin_character(large_tie_space_nine_up) - large_tie_space_up(4.67); - end_character; - - begin_character(large_tie_space_nine_up_light) - large_tie_space_up_light(4.67); - end_character; - - begin_character(large_tie_space_ten_up) - large_tie_space_up(5.0); - end_character; - - begin_character(large_tie_space_ten_up_light) - large_tie_space_up_light(5.0); - end_character; - - begin_character(large_tie_space_left_up) - large_tie_space_up(5.0); - erase fill ((0, -2 * staff_line_distance) -- - (6 * staff_line_distance, -2 * staff_line_distance) -- - (6 * staff_line_distance, 2 * staff_line_distance) -- - (0, 2 * staff_line_distance) -- cycle) - scaled magnification; - end_character; - - begin_character(large_tie_space_left_up_light) - large_tie_space_up(5.0); - erase fill ((0, -2 * staff_line_distance) -- - (6 * staff_line_distance, -2 * staff_line_distance) -- - (6 * staff_line_distance, 2 * staff_line_distance) -- - (0, 2 * staff_line_distance) -- cycle) - scaled magnification; - stripes(6 * staff_line_distance, 2 * staff_line_distance); - end_character; - - begin_character(large_tie_space_right_up) - large_tie_space_up(5.0); - erase fill ((0, -2 * staff_line_distance) -- - (-6 * staff_line_distance, -2 * staff_line_distance) -- - (-6 * staff_line_distance, 2 * staff_line_distance) -- - (0, 2 * staff_line_distance) -- cycle) - scaled magnification; - end_character; - - begin_character(large_tie_space_right_up_light) - large_tie_space_up(5.0); - erase fill ((0, -2 * staff_line_distance) -- - (-6 * staff_line_distance, -2 * staff_line_distance) -- - (-6 * staff_line_distance, 2 * staff_line_distance) -- - (0, 2 * staff_line_distance) -- cycle) - scaled magnification; - stripes(6 * staff_line_distance, 2 * staff_line_distance); - end_character; save large_tie_down; - def large_tie_down(expr width_multiplier, height) = + def large_tie_down(expr width_multiplier) = local_variable(numeric)(bot) - (round(0.33 * staff_line_distance)); + (round(11.0/6.0 * staff_line_distance) - staff_line_thickness); local_variable(numeric)(width) (round(width_multiplier * staff_line_distance)); fill ((0, -bot){right} .. - (width, height-bot) -- - (width-1, height-bot) .. + (width, large_tie_height-bot) -- + (width-1, large_tie_height-bot) .. (0.3*width, tie_thickness-bot) .. (0, tie_thickness-bot) .. (-0.3*width, tie_thickness-bot) .. - (-(width-1), height-bot) -- - (-width, height-bot) .. cycle) + (-(width-1), large_tie_height-bot) -- + (-width, large_tie_height-bot) .. cycle) scaled magnification; enddef; save large_tie_down_light; - def large_tie_down_light(expr width, height) = - large_tie_down(width, height); [310 lines skipped]

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 20 Feb '06

20 Feb '06

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp:/tmp/cvs-serv4071 Modified Files: modes.lisp Log Message: Introduced a new command table `rhythmic-table' that contains commands that are common for all rhythmic elements. `cluster-table' and `lyrics-table' now inherit from `rhythmic-table'. Moved some key bindings around to more appropriate command tables. --- /project/gsharp/cvsroot/gsharp/modes.lisp 2006/02/15 03:18:03 1.10 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2006/02/20 20:19:37 1.11 @@ -7,12 +7,12 @@ (set-key `(com-backward-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\b :control))) (set-key `(com-delete-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\d :control))) (set-key 'com-insert-measure-bar 'global-gsharp-table '(#\|)) -(set-key 'com-more-dots 'global-gsharp-table '((#\.))) -(set-key 'com-more-lbeams 'global-gsharp-table '((#\[))) -(set-key 'com-more-rbeams 'global-gsharp-table '((#\]))) +(set-key 'com-erase-element 'global-gsharp-table '((#\h :control))) + +;;; FIXME where are the corresponding commands? (set-key 'com-left 'global-gsharp-table '((#\l :meta))) (set-key 'com-right 'global-gsharp-table '((#\r :meta))) -(set-key 'com-rotate-notehead 'global-gsharp-table '((#\r :control))) + (set-key 'com-istate-more-dots 'global-gsharp-table '((#\i) (#\.))) (set-key 'com-istate-more-lbeams 'global-gsharp-table '((#\i) (#\[))) (set-key 'com-istate-more-rbeams 'global-gsharp-table '((#\i) (#\]))) @@ -38,22 +38,28 @@ (set-key 'com-insert-note-g 'melody-table '(#\g)) (set-key 'com-insert-rest 'melody-table '((#\,))) (set-key 'com-insert-empty-cluster 'melody-table '((#\Space))) -(set-key 'com-current-increment 'melody-table '((#\p))) -(set-key 'com-current-decrement 'melody-table '((#\n))) -(set-key 'com-fewer-dots 'melody-table '((#\x) (#\.))) -(set-key 'com-fewer-lbeams 'melody-table '((#\x) (#\[))) -(set-key 'com-fewer-rbeams 'melody-table '((#\x) (#\]))) -(set-key 'com-erase-element 'melody-table '((#\h :control))) -(set-key 'com-rotate-notehead 'melody-table '((#\h :meta))) -(set-key 'com-rotate-stem-direction 'melody-table '((#\s :meta))) (set-key 'com-more-sharps 'melody-table '((#\# :meta))) (set-key 'com-more-sharps 'melody-table '((#\# :meta :shift))) (set-key 'com-more-flats 'melody-table '((#\@ :meta :shift))) +;;; the rhythmic table contains command that are specific +;;; to rhythmic elements +(define-command-table rhythmic-table) + +(set-key 'com-more-dots 'rhythmic-table '((#\.))) +(set-key 'com-more-lbeams 'rhythmic-table '((#\[))) +(set-key 'com-more-rbeams 'rhythmic-table '((#\]))) +(set-key 'com-fewer-dots 'rhythmic-table '((#\x) (#\.))) +(set-key 'com-fewer-lbeams 'rhythmic-table '((#\x) (#\[))) +(set-key 'com-fewer-rbeams 'rhythmic-table '((#\x) (#\]))) +(set-key 'com-rotate-notehead 'rhythmic-table '((#\h :meta))) +(set-key 'com-rotate-notehead 'rhythmic-table '((#\r :control))) ; why this one too? + ;;; the cluster table contains commands that are specific to ;;; clusters -(define-command-table cluster-table) +(define-command-table cluster-table + :inherit-from (rhythmic-table)) (set-key 'com-sharper 'cluster-table '((#\#))) (set-key 'com-flatter 'cluster-table '(#\@)) @@ -70,10 +76,14 @@ (set-key 'com-tie-note-right 'cluster-table '((#\}))) (set-key 'com-untie-note-left 'cluster-table '((#\x) (#\{))) (set-key 'com-untie-note-right 'cluster-table '((#\x) (#\}))) +(set-key 'com-rotate-stem-direction 'cluster-table '((#\s :meta))) +(set-key 'com-current-increment 'cluster-table '((#\p))) +(set-key 'com-current-decrement 'cluster-table '((#\n))) ;;; lyrics mode table -(define-command-table lyrics-table) +(define-command-table lyrics-table + :inherit-from (rhythmic-table)) (set-key (lambda () (erase-char (cur-element))) 'lyrics-table '((#\h :control))) (set-key 'com-erase-element 'lyrics-table '((#\h :meta)))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 15 Feb '06

15 Feb '06

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp:/tmp/cvs-serv6974 Modified Files: gui.lisp Log Message: Gsharp now has an info pane (what Emacs calls a "mode-line"). --- /project/gsharp/cvsroot/gsharp/gui.lisp 2006/02/15 03:18:03 1.55 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2006/02/15 17:46:52 1.56 @@ -26,6 +26,38 @@ (defclass gsharp-pane (score-pane:score-pane) ((view :initarg :view :accessor view))) +(defvar *info-bg-color* +gray85+) +(defvar *info-fg-color* +black+) + +(defclass gsharp-info-pane (info-pane) + () + (:default-initargs + :height 20 :max-height 20 :min-height 20 + :display-function 'display-info + :incremental-redisplay t)) + +(defun display-info (frame pane) + (declare (ignore frame)) + (let* ((master-pane (master-pane pane)) + (view (view master-pane)) + (buffer (buffer view))) + (princ " " pane) + (princ (cond ((and (needs-saving buffer) + (read-only-p buffer) + "%*")) + ((needs-saving buffer) "**") + ((read-only-p buffer) "%%") + (t "--")) + pane) + (princ " " pane) + (with-text-face (pane :bold) + (format pane "~25A" (name buffer))) + (with-text-family (pane :sans-serif) + (princ (if (recordingp *application-frame*) + "Def" + "") + pane)))) + (define-application-frame gsharp (standard-application-frame esa-frame-mixin) ((views :initarg :views :initform '() :accessor views) @@ -33,16 +65,24 @@ (:menu-bar menubar-command-table :height 25) (:pointer-documentation t) (:panes - (score (let ((win (make-pane 'gsharp-pane - :width 400 :height 500 - :name "score" - ;; :incremental-redisplay t - :double-buffering t - :display-function 'display-score - :command-table 'total-melody-table))) + (score (let* ((win (make-pane 'gsharp-pane + :width 400 :height 500 + :name "score" + ;; :incremental-redisplay t + :double-buffering t + :display-function 'display-score + :command-table 'total-melody-table)) + (info (make-pane 'gsharp-info-pane + :master-pane win + :background *info-bg-color* + :foreground *info-fg-color*))) (setf (windows *application-frame*) (list win)) (setf (view win) (car (views *application-frame*))) - win)) + (vertically () + (scrolling (:width 750 :height 500 + :min-height 400 :max-height 20000) + win) + info))) (state (make-pane 'score-pane:score-pane :width 50 :height 200 :name "state" @@ -57,9 +97,7 @@ (default (vertically () (horizontally () - (scrolling (:width 750 :height 500 - :min-height 400 :max-height 20000) - score) + score (vertically () (scrolling (:width 80 :height 200) state) (scrolling (:width 80 :height 300

1 0

[gsharp-cvs] CVS gsharp/Scores
by rstrandh 15 Feb '06

15 Feb '06

Update of /project/gsharp/cvsroot/gsharp/Scores In directory common-lisp:/tmp/cvs-serv30685 Added Files: fiji.gsh Log Message: An attempt to engrave a horrible tune heard on a commercial for Air Pacific on NZ TV. It is not complete yet, but you get the idea. --- /project/gsharp/cvsroot/gsharp/Scores/fiji.gsh 2006/02/15 03:36:25 NONE +++ /project/gsharp/cvsroot/gsharp/Scores/fiji.gsh 2006/02/15 03:36:25 1.1 G#V4 [GSHARP-BUFFER:BUFFER :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 :left-margin 20 :staves (#1=[GSHARP-BUFFER:FIVELINE-STAFF :name "default staff" :clef [GSHARP-BUFFER:CLEF :name :TREBLE :lineno 2 ] :keysig [GSHARP-BUFFER:KEY-SIGNATURE :xoffset 0 :staff #1# :alterations #(:NATURAL :NATURAL :NATURAL :NATURAL :NATURAL :NATURAL :NATURAL) ] ] #2=[GSHARP-BUFFER:LYRICS-STAFF :name "lyrics" ] #3=[GSHARP-BUFFER:FIVELINE-STAFF :name "lower" :clef [GSHARP-BUFFER:CLEF :name :BASS :lineno 6 ] :keysig [GSHARP-BUFFER:KEY-SIGNATURE :xoffset 0 :staff #3# :alterations #(:NATURAL :NATURAL :NATURAL :NATURAL :NATURAL :NATURAL :NATURAL) ] ]) :segments ([GSHARP-BUFFER:SEGMENT :layers ([GSHARP-BUFFER:LYRICS-LAYER :name "lyrics" :staves (#2#) :head [GSHARP-BUFFER:SLICE :bars ([GSHARP-BUFFER:LYRICS-BAR :elements COMMON-LISP:NIL ]) ] :body [GSHARP-BUFFER:SLICE :bars ([GSHARP-BUFFER:LYRICS-BAR :elements ([GSHARP-BUFFER:LYRICS-ELEMENT :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :text #() ] [GSHARP-BUFFER:LYRICS-ELEMENT :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :text #(116 104 97 116) ]) ] [GSHARP-BUFFER:LYRICS-BAR :elements ([GSHARP-BUFFER:LYRICS-ELEMENT :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :text #(102 105) ] [GSHARP-BUFFER:LYRICS-ELEMENT :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :text #(106 105) ] [GSHARP-BUFFER:LYRICS-ELEMENT :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :staff #2# :text #(104 111) ] [GSHARP-BUFFER:LYRICS-ELEMENT :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :staff #2# :text #(108 105) ] [GSHARP-BUFFER:LYRICS-ELEMENT :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :text #(100 97 121) ]) ] [GSHARP-BUFFER:LYRICS-BAR :elements ([GSHARP-BUFFER:LYRICS-ELEMENT :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :text #(102 101 101) ] [GSHARP-BUFFER:LYRICS-ELEMENT :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #2# :text #(108 105 110 103) ]) ]) ] :tail [GSHARP-BUFFER:SLICE :bars ([GSHARP-BUFFER:LYRICS-BAR :elements COMMON-LISP:NIL ]) ] ] [GSHARP-BUFFER:MELODY-LAYER :name "bass" :staves (#3#) :head [GSHARP-BUFFER:SLICE :bars ([GSHARP-BUFFER:MELODY-BAR :elements COMMON-LISP:NIL ]) ] :body [GSHARP-BUFFER:SLICE :bars ([GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes COMMON-LISP:NIL ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 0 :stem-direction :AUTO :notes COMMON-LISP:NIL ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 17 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 19 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 20 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 21 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] [GSHARP-BUFFER:NOTE :pitch 23 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 18 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 21 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 22 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 23 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 17 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 19 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 20 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 21 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] [GSHARP-BUFFER:NOTE :pitch 23 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 22 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] [GSHARP-BUFFER:NOTE :pitch 24 :staff #3# :head :FILLED :accidentals :SHARP :dots 0 ]) ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 18 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] [GSHARP-BUFFER:NOTE :pitch 22 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 19 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 20 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 17 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER [888 lines skipped]

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 15 Feb '06

15 Feb '06

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp:/tmp/cvs-serv29109 Modified Files: gui.lisp modes.lisp Log Message: Cleaned up some dead code. --- /project/gsharp/cvsroot/gsharp/gui.lisp 2006/02/15 02:54:26 1.54 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2006/02/15 03:18:03 1.55 @@ -198,9 +198,9 @@ (make-command-table 'file-command-table :errorp nil - :menu '(("Load" :command com-load-file) + :menu '(("Find" :command com-find-file) ("Save" :command com-save-buffer) - ("Save as" :command com-save-buffer-as) + ("Save as" :command com-write-buffer) ("Quit" :command com-quit))) (define-gsharp-command (com-new-buffer :name t) () @@ -216,101 +216,6 @@ (setf (input-state *application-frame*) input-state (staves (car (layers (car (segments buffer))))) (list staff)))) -(define-presentation-type completable-pathname () - :inherit-from 'pathname) - -(define-condition file-not-found (gsharp-condition) () - (:report - (lambda (condition stream) - (declare (ignore condition)) - (format stream "File nont found")))) - -(defun filename-completer (so-far mode) - (flet ((remove-trail (s) - (subseq s 0 (let ((pos (position #\/ s :from-end t))) - (if pos (1+ pos) 0))))) - (let* ((directory-prefix - (if (and (plusp (length so-far)) (eql (aref so-far 0) #\/)) - "" - (namestring #+sbcl (car (directory ".")) #+cmu (ext:default-directory)))) - (full-so-far (concatenate 'string directory-prefix so-far)) - (pathnames - (loop with length = (length full-so-far) - for path in (directory (concatenate 'string - (remove-trail so-far) - "*.*")) - when (let ((mismatch (mismatch (namestring path) full-so-far))) - (or (null mismatch) (= mismatch length))) - collect path)) - (strings (mapcar #'namestring pathnames)) - (first-string (car strings)) - (length-common-prefix nil) - (completed-string nil) - (full-completed-string nil)) - (unless (null pathnames) - (setf length-common-prefix - (loop with length = (length first-string) - for string in (cdr strings) - do (setf length (min length (or (mismatch string first-string) length))) - finally (return length)))) - (unless (null pathnames) - (setf completed-string - (subseq first-string (length directory-prefix) - (if (null (cdr pathnames)) nil length-common-prefix))) - (setf full-completed-string - (concatenate 'string directory-prefix completed-string))) - (case mode - ((:complete-limited :complete-maximal) - (cond ((null pathnames) - (values so-far nil nil 0 nil)) - ((null (cdr pathnames)) - (values completed-string t (car pathnames) 1 nil)) - (t - (values completed-string nil nil (length pathnames) nil)))) - (:complete - (cond ((null pathnames) - (values so-far nil nil 0 nil)) - ((null (cdr pathnames)) - (values completed-string t (car pathnames) 1 nil)) - ((find full-completed-string strings :test #'string-equal) - (let ((pos (position full-completed-string strings :test #'string-equal))) - (values completed-string - t (elt pathnames pos) (length pathnames) nil))) - (t - (values completed-string nil nil (length pathnames) nil)))) - (:possibilities - (values nil nil nil (length pathnames) - (loop with length = (length directory-prefix) - for name in pathnames - collect (list (subseq (namestring name) length nil) - name)))))))) - - -(define-presentation-method accept - ((type completable-pathname) stream (view textual-view) &key) - (multiple-value-bind (pathname success string) - (complete-input stream - #'filename-completer - :partial-completers '(#\Space) - :allow-any-input t) - (declare (ignore success)) - (or pathname string))) - -(define-gsharp-command (com-load-file :name t) () - (let* ((stream (frame-standard-input *application-frame*)) - (filename (handler-case (accept 'completable-pathname :stream stream - :prompt "File Name") - (simple-parse-error () (error 'file-not-found)))) - (buffer (read-everything filename)) - (input-state (make-input-state)) - (cursor (make-initial-cursor buffer)) - (view (make-instance 'orchestra-view - :buffer buffer - :cursor cursor))) - (setf (view (car (windows *application-frame*))) view) - (setf (input-state *application-frame*) input-state) - (select-layer cursor (car (layers (segment (current-cursor))))))) - (defmethod find-file :around (filepath (application-frame gsharp)) (declare (ignore filepath)) (let* ((buffer (call-next-method)) @@ -324,15 +229,6 @@ (filepath buffer) filepath) (select-layer cursor (car (layers (segment (current-cursor))))))) -(define-gsharp-command (com-save-buffer-as :name t) () - (let* ((stream (frame-standard-input *application-frame*)) - (filename (handler-case (accept 'completable-pathname :stream stream - :prompt "File Name") - (simple-parse-error () (error 'file-not-found))))) - (with-open-file (stream filename :direction :output) - (save-buffer-to-stream (current-buffer *application-frame*) stream) - (message "Saved buffer to ~A~%" filename)))) - (define-gsharp-command (com-quit :name t) () (frame-exit *application-frame*)) --- /project/gsharp/cvsroot/gsharp/modes.lisp 2006/02/15 02:54:26 1.9 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2006/02/15 03:18:03 1.10 @@ -13,7 +13,6 @@ (set-key 'com-left 'global-gsharp-table '((#\l :meta))) (set-key 'com-right 'global-gsharp-table '((#\r :meta))) (set-key 'com-rotate-notehead 'global-gsharp-table '((#\r :control))) -;;; (set-key 'com-load-file 'global-gsharp-table '((#\x :control) (#\f :control))) (set-key 'com-istate-more-dots 'global-gsharp-table '((#\i) (#\.))) (set-key 'com-istate-more-lbeams 'global-gsharp-table '((#\i) (#\[))) (set-key 'com-istate-more-rbeams 'global-gsharp-table '((#\i) (#\])))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 15 Feb '06

15 Feb '06

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp:/tmp/cvs-serv24313 Modified Files: buffer.lisp gsharp.asd gui.lisp modes.lisp packages.lisp Added Files: esa-buffer.lisp esa-io.lisp Log Message: Added a new package and a new file ESA-BUFFER allowing buffers to be named, to be associated with a file name, and to have a `needs-saving' and a `read-only' flag. Added a new package and a new file ESA-IO containing application-independent functionality to create buffers from files, and to save buffers to files. This package also supplies filename completion. Most of the code was adapted from Climacs. Abstracted out all Gsharp-specific I/O to ESA-IO. In particular, this means that we now have commands such as C-x C-s, and C-x C-w, which we didn't before. The old I/O code is still there. Cleanup is next. --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2006/02/13 23:51:34 1.33 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2006/02/15 02:54:26 1.34 @@ -1042,7 +1042,7 @@ (defvar *default-left-offset* 30) (defvar *default-left-margin* 20) -(defclass buffer (gsharp-object) +(defclass buffer (gsharp-object esa-buffer-mixin) ((print-character :allocation :class :initform #\B) (segments :initform '() :initarg :segments :accessor segments) (staves :initform (list (make-fiveline-staff)) @@ -1214,7 +1214,15 @@ (*readtable* readtable)) (read stream))))) -(defun save-buffer-to-stream (buffer stream) +(defun read-buffer-from-stream (stream) + (let* ((version (read-line stream)) + (readtable (cdr (assoc version *readtables* :test #'string=)))) + (assert readtable () 'unknown-file-version) + (let ((*read-eval* nil) + (*readtable* readtable)) + (read stream)))) + +(defmethod save-buffer-to-stream ((buffer buffer) stream) (let ((*print-circle* t) (*package* (find-package :keyword))) ;; (format stream "G#V3~%") --- /project/gsharp/cvsroot/gsharp/gsharp.asd 2005/12/07 03:38:27 1.5 +++ /project/gsharp/cvsroot/gsharp/gsharp.asd 2006/02/15 02:54:26 1.6 @@ -24,6 +24,8 @@ "packages" "clim-patches" "esa" + "esa-buffer" + "esa-io" "utilities" "gf" "sdl" --- /project/gsharp/cvsroot/gsharp/gui.lisp 2006/02/13 23:51:34 1.53 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2006/02/15 02:54:26 1.54 @@ -68,8 +68,11 @@ interactor))) (:top-level (esa-top-level))) -(defun current-buffer () - (buffer (view (car (windows *application-frame*))))) +(defmethod buffers ((application-frame gsharp)) + (remove-duplicates (mapcar #'buffer (views application-frame)) :test #'eq)) + +(defmethod current-buffer ((application-frame gsharp)) + (buffer (view (car (windows application-frame))))) (defun current-cursor () (cursor (view (car (windows *application-frame*))))) @@ -308,13 +311,26 @@ (setf (input-state *application-frame*) input-state) (select-layer cursor (car (layers (segment (current-cursor))))))) +(defmethod find-file :around (filepath (application-frame gsharp)) + (declare (ignore filepath)) + (let* ((buffer (call-next-method)) + (input-state (make-input-state)) + (cursor (make-initial-cursor buffer)) + (view (make-instance 'orchestra-view + :buffer buffer + :cursor cursor))) + (setf (view (car (windows *application-frame*))) view + (input-state *application-frame*) input-state + (filepath buffer) filepath) + (select-layer cursor (car (layers (segment (current-cursor))))))) + (define-gsharp-command (com-save-buffer-as :name t) () (let* ((stream (frame-standard-input *application-frame*)) (filename (handler-case (accept 'completable-pathname :stream stream :prompt "File Name") (simple-parse-error () (error 'file-not-found))))) (with-open-file (stream filename :direction :output) - (save-buffer-to-stream (current-buffer) stream) + (save-buffer-to-stream (current-buffer *application-frame*) stream) (message "Saved buffer to ~A~%" filename)))) (define-gsharp-command (com-quit :name t) () @@ -354,13 +370,13 @@ (define-gsharp-command (com-insert-segment-before :name t) () (let ((cursor (current-cursor))) - (insert-segment-before (make-instance 'segment :staff (car (staves (current-buffer)))) + (insert-segment-before (make-instance 'segment :staff (car (staves (current-buffer *application-frame*)))) cursor) (backward-segment cursor))) (define-gsharp-command (com-insert-segment-after :name t) () (let ((cursor (current-cursor))) - (insert-segment-after (make-instance 'segment :staff (car (staves (current-buffer)))) + (insert-segment-after (make-instance 'segment :staff (car (staves (current-buffer *application-frame*)))) cursor) (forward-segment cursor))) @@ -996,7 +1012,7 @@ (lambda (so-far mode) (complete-from-possibilities so-far - (staves (current-buffer)) + (staves (current-buffer *application-frame*)) '() :action mode :predicate (constantly t) @@ -1013,7 +1029,7 @@ (lambda (so-far mode) (complete-from-possibilities so-far - (staves (current-buffer)) + (staves (current-buffer *application-frame*)) '() :action mode :predicate (lambda (obj) (typep obj 'fiveline-staff)) @@ -1080,7 +1096,7 @@ (defun acquire-unique-staff-name (prompt) (let ((name (accept 'string :prompt prompt))) - (assert (not (member name (staves (current-buffer)) :test #'string= :key #'name)) + (assert (not (member name (staves (current-buffer *application-frame*)) :test #'string= :key #'name)) () `staff-name-not-unique) name)) @@ -1096,21 +1112,21 @@ (define-gsharp-command (com-insert-staff-before :name t) () (add-staff-before-staff (accept 'score-pane:staff :prompt "Insert staff before staff") (acquire-new-staff) - (current-buffer))) + (current-buffer *application-frame*))) (define-gsharp-command (com-insert-staff-after :name t) () (add-staff-after-staff (accept 'score-pane:staff :prompt "Insert staff after staff") (acquire-new-staff) - (current-buffer))) + (current-buffer *application-frame*))) (define-gsharp-command (com-delete-staff :name t) () (remove-staff-from-buffer (accept 'score-pane:staff :prompt "Staff") - (current-buffer))) + (current-buffer *application-frame*))) (define-gsharp-command (com-rename-staff :name t) () (let* ((staff (accept 'score-pane:staff :prompt "Rename staff")) (name (acquire-unique-staff-name "New name of staff")) - (buffer (current-buffer))) + (buffer (current-buffer *application-frame*))) (rename-staff name staff buffer))) (define-gsharp-command (com-add-staff-to-layer :name t) () @@ -1145,3 +1161,13 @@ (insert-element element cursor) (forward-element cursor) element)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; I/O + +(defmethod make-buffer-from-stream (stream (frame gsharp)) + (read-buffer-from-stream stream)) + +(defmethod make-new-buffer ((frame gsharp)) + (make-instance 'buffer)) \ No newline at end of file --- /project/gsharp/cvsroot/gsharp/modes.lisp 2006/02/13 23:51:34 1.8 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2006/02/15 02:54:26 1.9 @@ -1,7 +1,7 @@ (in-package :gsharp) (define-command-table global-gsharp-table - :inherit-from (global-esa-table keyboard-macro-table)) + :inherit-from (global-esa-table esa-io-table keyboard-macro-table)) (set-key `(com-forward-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\f :control))) (set-key `(com-backward-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\b :control))) @@ -13,7 +13,7 @@ (set-key 'com-left 'global-gsharp-table '((#\l :meta))) (set-key 'com-right 'global-gsharp-table '((#\r :meta))) (set-key 'com-rotate-notehead 'global-gsharp-table '((#\r :control))) -(set-key 'com-load-file 'global-gsharp-table '((#\x :control) (#\f :control))) +;;; (set-key 'com-load-file 'global-gsharp-table '((#\x :control) (#\f :control))) (set-key 'com-istate-more-dots 'global-gsharp-table '((#\i) (#\.))) (set-key 'com-istate-more-lbeams 'global-gsharp-table '((#\i) (#\[))) (set-key 'com-istate-more-rbeams 'global-gsharp-table '((#\i) (#\]))) --- /project/gsharp/cvsroot/gsharp/packages.lisp 2006/02/14 03:00:52 1.44 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2006/02/15 02:54:27 1.45 @@ -11,6 +11,22 @@ #:set-key #:find-applicable-command-table)) +(defpackage :esa-buffer + (:use :clim-lisp :clim :esa) + (:export #:make-buffer-from-stream #:save-buffer-to-stream + #:filepath #:name #:needs-saving + #:esa-buffer-mixin + #:make-new-buffer + #:read-only-p)) + +(defpackage :esa-io + (:use :clim-lisp :clim :esa :esa-buffer) + (:export #:buffers #:current-buffer + #:find-file #:find-file-read-only + #:set-visited-filename + #:save-buffer #:write-buffer + #:esa-io-table)) + (defpackage :gsharp-utilities (:shadow built-in-class) (:use :clim-lisp :clim-mop) @@ -64,7 +80,7 @@ #:score-view)) (defpackage :gsharp-buffer - (:use :common-lisp :gsharp-utilities) + (:use :common-lisp :gsharp-utilities :esa-buffer) (:shadow #:rest) (:export #:clef #:name #:lineno #:make-clef #:staff #:fiveline-staff #:make-fiveline-staff @@ -100,12 +116,13 @@ #:add-staff-to-layer #:remove-staff-from-layer #:stem-direction #:undotted-duration #:duration - #:clef #:keysig #:staff-pos #:xoffset #:read-everything #:save-buffer-to-stream + #:clef #:keysig #:staff-pos #:xoffset #:read-everything + #:read-buffer-from-stream #:key-signature #:alterations #:more-sharps #:more-flats #:line-width #:min-width #:spacing-style #:right-edge #:left-offset #:left-margin #:text #:append-char #:erase-char #:tie-right #:tie-left - )) + #:needs-saving)) (defpackage :gsharp-numbering (:use :gsharp-utilities :gsharp-buffer :clim-lisp) @@ -226,7 +243,7 @@ #:play-buffer)) (defpackage :gsharp - (:use :clim :clim-lisp :gsharp-utilities :esa + (:use :clim :clim-lisp :gsharp-utilities :esa :esa-buffer :esa-io :gsharp-buffer :gsharp-cursor :gsharp-drawing :gsharp-numbering :gsharp-measure :sdl :midi :gsharp-play) --- /project/gsharp/cvsroot/gsharp/esa-buffer.lisp 2006/02/15 02:54:28 NONE +++ /project/gsharp/cvsroot/gsharp/esa-buffer.lisp 2006/02/15 02:54:28 1.1 ;;; -*- Mode: Lisp; Package: ESA-IO -*- ;;; (c) copyright 2006 by ;;; Robert Strandh (strandh(a)labri.fr) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. (in-package :esa-buffer) (defgeneric make-buffer-from-stream (stream application-frame) (:documentation "Create a fresh buffer by reading the external representation from STREAM")) (defgeneric make-new-buffer (application-frame) (:documentation "Create a empty buffer for the application frame")) (defgeneric save-buffer-to-stream (buffer stream) (:documentation "Save the entire BUFFER to STREAM in the appropriate external representation")) (defgeneric filepath (buffer)) (defgeneric (setf filepath) (filepath buffer)) (defgeneric name (buffer)) (defgeneric (setf name) (name buffer)) (defgeneric needs-saving (buffer)) (defgeneric (setf needs-saving) (needs-saving buffer)) (defclass esa-buffer-mixin () ((%filepath :initform nil :accessor filepath) (%name :initarg :name :initform "*scratch*" :accessor name) (%needs-saving :initform nil :accessor needs-saving) (%read-only-p :initform nil :accessor read-only-p))) --- /project/gsharp/cvsroot/gsharp/esa-io.lisp 2006/02/15 02:54:28 NONE +++ /project/gsharp/cvsroot/gsharp/esa-io.lisp 2006/02/15 02:54:28 1.1 ;;; -*- Mode: Lisp; Package: ESA-IO -*- ;;; (c) copyright 2006 by ;;; Robert Strandh (strandh(a)labri.fr) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. (in-package :esa-io) (defgeneric buffers (application-frame) (:documentation "Return a list of all the buffers of the application")) (defgeneric current-buffer (application-frame) (:documentation "Return the current buffer of APPLICATION-FRAME")) (defgeneric find-file (file-path application-frame)) (defgeneric find-file-read-only (file-path application-frame)) (defgeneric set-visited-filename (filepath buffer application-frame)) (defgeneric save-buffer (buffer application-frame)) (defgeneric write-buffer (buffer filepath application-frame)) (make-command-table 'esa-io-table :errorp nil) (defgeneric find-file (file-path application-frame) (:documentation "if a buffer with the file-path already exists, return it, else if a file with the right name exists, return a fresh buffer created from the file, else return a new empty buffer having the associated file name.")) (defun filename-completer (so-far mode) (flet ((remove-trail (s) (subseq s 0 (let ((pos (position #\/ s :from-end t))) (if pos (1+ pos) 0))))) (let* ((directory-prefix (if (and (plusp (length so-far)) (eql (aref so-far 0) #\/)) "" (namestring #+sbcl *default-pathname-defaults* #+cmu (ext:default-directory) #-(or sbcl cmu) *default-pathname-defaults*))) (full-so-far (concatenate 'string directory-prefix so-far)) (pathnames (loop with length = (length full-so-far) and wildcard = (concatenate 'string (remove-trail so-far) "*.*") for path in #+(or sbcl cmu lispworks) (directory wildcard) #+openmcl (directory wildcard :directories t) #+allegro (directory wildcard :directories-are-files nil) #+cormanlisp (nconc (directory wildcard) (cl::directory-subdirs dirname)) #-(or sbcl cmu lispworks openmcl allegro cormanlisp) (directory wildcard) when (let ((mismatch (mismatch (namestring path) full-so-far))) (or (null mismatch) (= mismatch length))) collect path)) (strings (mapcar #'namestring pathnames)) (first-string (car strings)) (length-common-prefix nil) (completed-string nil) (full-completed-string nil)) (unless (null pathnames) (setf length-common-prefix (loop with length = (length first-string) for string in (cdr strings) do (setf length (min length (or (mismatch string first-string) length))) finally (return length)))) (unless (null pathnames) (setf completed-string (subseq first-string (length directory-prefix) (if (null (cdr pathnames)) nil length-common-prefix))) (setf full-completed-string (concatenate 'string directory-prefix completed-string))) (case mode ((:complete-limited :complete-maximal) (cond ((null pathnames) (values so-far nil nil 0 nil)) ((null (cdr pathnames)) (values completed-string t (car pathnames) 1 nil)) (t (values completed-string nil nil (length pathnames) nil)))) (:complete (cond ((null pathnames) (values so-far t so-far 1 nil)) ((null (cdr pathnames)) (values completed-string t (car pathnames) 1 nil)) ((find full-completed-string strings :test #'string-equal) (let ((pos (position full-completed-string strings :test #'string-equal))) (values completed-string t (elt pathnames pos) (length pathnames) nil))) (t (values completed-string nil nil (length pathnames) nil)))) (:possibilities (values nil nil nil (length pathnames) (loop with length = (length directory-prefix) for name in pathnames collect (list (subseq (namestring name) length nil) name)))))))) (define-presentation-method present (object (type pathname) stream (view textual-view) &key) (princ (namestring object) stream)) (define-presentation-method accept ((type pathname) stream (view textual-view) &key (default nil defaultp) (default-type type)) (multiple-value-bind (pathname success string) (complete-input stream #'filename-completer :allow-any-input t) (cond (success (values pathname type)) ((and (zerop (length string)) defaultp) (values default default-type)) (t (values string 'string))))) ;;; Adapted from cl-fad/PCL (defun directory-pathname-p (pathspec) "Returns NIL if PATHSPEC does not designate a directory." (let ((name (pathname-name pathspec)) (type (pathname-type pathspec))) (and (or (null name) (eql name :unspecific)) (or (null type) (eql type :unspecific))))) (defun filepath-filename (pathname) (if (null (pathname-type pathname)) (pathname-name pathname) (concatenate 'string (pathname-name pathname) "." (pathname-type pathname)))) (defmethod find-file (filepath application-frame) (cond ((null filepath) (display-message "No file name given.") (beep)) ((directory-pathname-p filepath) (display-message "~A is a directory name." filepath) (beep)) (t (or (find filepath (buffers *application-frame*) :key #'filepath :test #'equal) (let ((buffer (if (probe-file filepath) (with-open-file (stream filepath :direction :input) (make-buffer-from-stream stream *application-frame*)) (make-new-buffer *application-frame*)))) (setf (filepath buffer) filepath (name buffer) (filepath-filename filepath) (needs-saving buffer) nil) buffer))))) (define-command (com-find-file :name t :command-table esa-io-table) () (let* ((filepath (accept 'pathname :prompt "Find File"))) (find-file filepath *application-frame*))) (set-key 'com-find-file 'esa-io-table '((#\x :control) (#\f :control))) (defmethod find-file-read-only (filepath application-frame) (cond ((null filepath) (display-message "No file name given.") (beep)) ((directory-pathname-p filepath) (display-message "~A is a directory name." filepath) (beep)) (t (or (find filepath (buffers *application-frame*) :key #'filepath :test #'equal) (if (probe-file filepath) (with-open-file (stream filepath :direction :input) (let ((buffer (make-buffer-from-stream stream *application-frame*))) (setf (filepath buffer) filepath (name buffer) (filepath-filename filepath) (read-only-p buffer) t (needs-saving buffer) nil))) (progn (display-message "No such file: ~A" filepath) (beep) nil)))))) (define-command (com-find-file-read-only :name t :command-table esa-io-table) () (let ((filepath (accept 'pathname :Prompt "Find file read only"))) (find-file-read-only filepath *application-frame*))) (set-key 'com-find-file-read-only 'esa-io-table '((#\x :control) (#\r :control))) (define-command (com-read-only :name t :command-table esa-io-table) () (let ((buffer (current-buffer *application-frame*))) (setf (read-only-p buffer) (not (read-only-p buffer))))) (set-key 'com-read-only 'esa-io-table '((#\x :control) (#\q :control))) (defmethod set-visited-file-name (filename buffer application-frame) (setf (filepath buffer) filename (name buffer) (filepath-filename filename) (needs-saving buffer) t)) (define-command (com-set-visited-file-name :name t :command-table esa-io-table) () (let ((filename (accept 'pathname :prompt "New file name"))) (set-visited-file-name filename (current-buffer *application-frame*) *application-frame*))) (defmethod save-buffer (buffer application-frame) (let ((filepath (or (filepath buffer) (accept 'pathname :prompt "Save Buffer to File")))) (cond ((directory-pathname-p filepath) (display-message "~A is a directory." filepath) (beep)) (t (when (probe-file filepath) (let ((backup-name (pathname-name filepath)) (backup-type (concatenate 'string (pathname-type filepath) "~"))) (rename-file filepath (make-pathname :name backup-name :type backup-type)))) (with-open-file (stream filepath :direction :output :if-exists :supersede) (save-buffer-to-stream buffer stream)) (setf (filepath buffer) filepath (name buffer) (filepath-filename filepath)) (display-message "Wrote: ~a" (filepath buffer)) (setf (needs-saving buffer) nil))))) (define-command (com-save-buffer :name t :command-table esa-io-table) () (let ((buffer (current-buffer *application-frame*))) (if (or (null (filepath buffer)) (needs-saving buffer)) (save-buffer buffer *application-frame*) (display-message "No changes need to be saved from ~a" (name buffer))))) (set-key 'com-save-buffer 'esa-io-table '((#\x :control) (#\s :control))) (defmethod write-buffer (buffer filepath application-frame) (cond ((directory-pathname-p filepath) (display-message "~A is a directory name." filepath)) (t (with-open-file (stream filepath :direction :output :if-exists :supersede) (save-buffer-to-stream buffer stream)) (setf (filepath buffer) filepath (name buffer) (filepath-filename filepath) (needs-saving buffer) nil) (display-message "Wrote: ~a" (filepath buffer))))) (define-command (com-write-buffer :name t :command-table esa-io-table) () (let ((filepath (accept 'pathname :prompt "Write Buffer to File")) (buffer (current-buffer *application-frame*))) (write-buffer buffer filepath *application-frame*))) (set-key 'com-write-buffer 'esa-io-table '((#\x :control) (#\w :control)))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 15 Feb '06

15 Feb '06

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp:/tmp/cvs-serv22978 Modified Files: measure.lisp Log Message: Added an :after method to the append-char generic-function so that the buffer is marked as modified when lyrics change. --- /project/gsharp/cvsroot/gsharp/measure.lisp 2006/02/09 03:17:25 1.26 +++ /project/gsharp/cvsroot/gsharp/measure.lisp 2006/02/15 02:44:48 1.27 @@ -113,6 +113,10 @@ (declare (ignore direction)) (mark-modified element)) +(defmethod append-char :after ((element lyrics-element) char) + (declare (ignore char)) + (mark-modified element)) + (defmethod note-position ((note note)) (let ((clef (clef (staff note)))) (+ (- (pitch note) @@ -763,7 +767,8 @@ (1- (nb-measures (segmentno buf (1- (nb-segments buf))))))) (defmethod mark-modified ((buffer rbuffer)) - (setf (modified-p buffer) t)) + (setf (modified-p buffer) t) + (setf (needs-saving buffer) t)) (defmethod add-segment :after ((segment segment) (buffer rbuffer) position) (declare (ignore position))

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 February 2006