May 2006 - gsharp-cvs@common-lisp.net - mailman3.common-lisp.net

[gsharp-cvs] CVS gsharp
by rstrandh 31 May '06

31 May '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv5124 Added Files: fontview.lisp Log Message: Half of a new font viewer application. The half that exists is that it shows the resulting anti-aliased design, with or without a reference staff. What remains to write is showing the pixel view with grids and reference points, and perhaps also end points and reference points of the Bezier segments. This should be a relatively simple matter of calling render-to-array and showing the result. --- /project/gsharp/cvsroot/gsharp/fontview.lisp 2006/05/31 19:55:19 NONE +++ /project/gsharp/cvsroot/gsharp/fontview.lisp 2006/05/31 19:55:19 1.1 (in-package :common-lisp-user) (defpackage :fontview (:use :clim :clim-extensions :clim-lisp :sdl)) (in-package :fontview) (define-application-frame fontview () ((font :initform (make-instance 'sdl::font :staff-line-distance 6)) (shape :initform :g-clef) (grid :initform nil) (staff :initform nil) (staff-offset :initform 0) (view :initform :antialiased) (zoom :initform 1) (hoffset :initform 300) (voffset :initform 300)) (:pointer-documentation t) (:panes (fontview :application :width 800 :height 600 :display-function 'display-entry) (interactor :interactor :width 800 :height 100)) (:layouts (default (vertically () fontview interactor)))) (defun display-antialiased-view (frame pane) (with-slots (font shape staff staff-offset hoffset voffset) frame (with-translation (pane hoffset voffset) (sdl::draw-shape pane font shape 0 0) (when staff (with-slots ((slt sdl::staff-line-thickness) (sld sdl::staff-line-distance) (yoff sdl::yoffset)) font (let ((up (round (+ (* 0.5 slt) yoff))) (down (round (- (* 0.5 slt) yoff)))) (loop repeat 5 for y from (* (+ -2 (* 1/2 staff-offset)) sld) by sld do (draw-rectangle* pane (* -10 sld) (- y up) (* 10 sld) (+ y down))))))))) (defun display-pixel-view (frame pane) (declare (ignore pane)) (with-slots (font shape grid zoom hoffset voffset) frame nil)) (defun display-entry (frame pane) (with-slots (view) frame (if (eq view :antialiased) (display-antialiased-view frame pane) (display-pixel-view frame pane)))) (defun fontview () (let ((frame (make-application-frame 'fontview))) (run-frame-top-level frame))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Commands (define-fontview-command (com-quit :name t) () (frame-exit *application-frame*)) (define-fontview-command (com-show :name t) ((symbol 'symbol)) (with-slots (shape) *application-frame* (setf shape symbol))) (define-fontview-command (com-zoom-in :name t :keystroke (#\i :control)) () (with-slots (zoom) *application-frame* (when (< zoom 10) (incf zoom)))) (define-fontview-command (com-zoom-out :name t :keystroke (#\i :control)) () (with-slots (zoom) *application-frame* (when (> zoom 1) (decf zoom)))) (define-fontview-command (com-zoom-to :name t) ((i 'integer)) (with-slots (zoom) *application-frame* (setf zoom (min (max i 1) 10)))) (define-fontview-command (com-size :name t) ((i 'integer)) (with-slots (font) *application-frame* (when (oddp i) (incf i)) (setf font (make-instance 'sdl::font :staff-line-distance (min (max i 6) 20))))) (define-fontview-command (com-grid-on :name t) () (with-slots (grid) *application-frame* (setf grid t))) (define-fontview-command (com-grid-off :name t) () (with-slots (grid) *application-frame* (setf grid nil))) (define-fontview-command (com-staff-on :name t) () (with-slots (staff) *application-frame* (setf staff t))) (define-fontview-command (com-staff-off :name t) () (with-slots (staff) *application-frame* (setf staff nil))) (define-fontview-command (com-staff-up :name t) () (with-slots (staff-offset) *application-frame* (when (> staff-offset -4) (decf staff-offset)))) (define-fontview-command (com-staff-down :name t) () (with-slots (staff-offset) *application-frame* (when (< staff-offset 4) (incf staff-offset)))) (define-fontview-command (com-staff-middle :name t) () (with-slots (staff-offset) *application-frame* (setf staff-offset 0))) (define-fontview-command (com-pixel-view :name t) () (with-slots (view) *application-frame* (setf view :pixel))) (define-fontview-command (com-antialiased-view :name t) () (with-slots (view) *application-frame* (setf view :antialiased)))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 31 May '06

31 May '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv5035 Modified Files: sdl.lisp Log Message: Fixed a bug that calculated the yoffset of the font wrong. Changed the g-clef back to sane values for the ye and yz coordinates, because I now suspect something else is responsible for the funny looks at low resolution. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/05/30 02:13:26 1.16 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/05/31 19:51:58 1.17 @@ -149,11 +149,11 @@ beam-offset-down beam-offset-up beam-hang-sit-offset) font + (setf staff-line-thickness (round (/ (staff-line-distance font) 10))) (setf xoffset (if (oddp (round (* 1.5 staff-line-distance))) 1.5 0)) (setf yoffset - (if (oddp staff-line-distance) 0.5 0)) - (setf staff-line-thickness (round (/ (staff-line-distance font) 10))) + (if (oddp staff-line-thickness) 0.5 0)) (setf dot-diameter (min (- staff-line-distance staff-line-thickness 2) (round (/ staff-line-distance 3)))) @@ -359,6 +359,11 @@ (tr (clim:make-translation-transformation x y))) (clim:draw-design sheet (clim:transform-region tr design)))) +;;; default method +(defmethod compute-design ((font font) shape) + (with-slots (staff-line-distance) font + (scale +unit-square+ staff-line-distance))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Clefs @@ -434,7 +439,7 @@ (xa (+ xcc (max 1.0 (* 0.2 sld)))) (ya (* -0.4 sld)) (xc (+ xb (round (* 0.7 sld)))) (yc (+ sld (max 1.0 (* 0.15 sld)))) (xd (+ xc sld)) (yd 0.0) - (xe (* 1.5 sld)) (ye (- sld)) + (xe (* 1.5 sld)) (ye (+ (- sld) (- (* 0.5 staff-line-thickness)))) (xg (round (* 1.8 sld))) (yg (* 3.8 sld)) (xw (- xg (* 2.0 staff-line-thickness))) (yw (round (* 5.0 sld))) (xh xw) (yh (- yw (max 2.0 (round (* 0.4 sld))))) @@ -453,7 +458,7 @@ (xr xm) (yr (+ ym staff-line-thickness)) (xz xe) ;; yz should be slightly above the upper edge of the staff line - (yz (+ (- sld) (* 1.2 staff-line-thickness))) + (yz (+ (- sld) (* 0.7 staff-line-thickness))) (xaa (- xd (max 1 (round (* 0.3 sld))))) (yaa yd) (xbb xc) (ybb (- sld staff-line-thickness (max 2 (* 0.3 sld)))) (xdd xp) (ydd (* 2 sld))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 30 May '06

30 May '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv14794 Modified Files: bezier.lisp sdl.lisp score-pane.lisp Log Message: Output recording of Bezier designs seems to be working now. Clefs are now drawn using the new system. There is still considerable ugliness in the code, but I intend to work on that incrementally. Modified the G clef to look a bit better (which is easier to do with the new system than with the Metafont program). --- /project/gsharp/cvsroot/gsharp/bezier.lisp 2006/05/29 19:55:24 1.1 +++ /project/gsharp/cvsroot/gsharp/bezier.lisp 2006/05/30 02:13:26 1.2 @@ -63,10 +63,31 @@ ;;; define the trampoline method from a sheet to a medium (def-graphic-op draw-design (design)) -;;; define output records, etc -(def-grecording draw-design (() design) () - (setf (slot-value climi::graphic 'design) design) - (bounding-rectangle* design)) +(defclass bezier-design-output-record (standard-graphics-displayed-output-record) + ((stream :initarg :stream) + (design :initarg :design))) + +(defmethod initialize-instance :after ((record bezier-design-output-record) &key) + (with-slots (design) record + (setf (rectangle-edges* record) + (bounding-rectangle* design)))) + +(defmethod medium-draw-design* :around ((stream output-recording-stream) design) + (with-sheet-medium (medium stream) + (let ((transformed-design (transform-region (medium-transformation medium) design))) + (when (stream-recording-p stream) + (let ((record (make-instance 'bezier-design-output-record + :stream stream + :design transformed-design))) + (stream-add-output-record stream record))) + (when (stream-drawing-p stream) + (medium-draw-design* medium design))))) + +(defmethod replay-output-record ((record bezier-design-output-record) stream &optional + (region +everywhere+) (x-offset 0) (y-offset 0)) + (declare (ignore x-offset y-offset region)) + (with-slots (design) record + (medium-draw-design* (sheet-medium stream) design))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/05/29 19:55:24 1.15 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/05/30 02:13:26 1.16 @@ -425,7 +425,8 @@ ;;; (defmethod compute-design ((font font) (shape (eql :g-clef))) - (with-slots ((sld staff-line-distance) staff-line-thickness stem-thickness) font + (with-slots ((sld staff-line-distance) staff-line-thickness + stem-thickness yoffset) font (let* ((xf 0.0) (yf (* 0.5 sld)) (xy (max 2.0 (round (* 0.4 sld)))) (yy (* 0.2 sld)) (xb (+ xy (max 2.0 (round (* 0.4 sld))))) (yb (* 0.3 sld)) @@ -433,7 +434,7 @@ (xa (+ xcc (max 1.0 (* 0.2 sld)))) (ya (* -0.4 sld)) (xc (+ xb (round (* 0.7 sld)))) (yc (+ sld (max 1.0 (* 0.15 sld)))) (xd (+ xc sld)) (yd 0.0) - (xe (* 1.5 sld)) (ye (- (+ staff-line-thickness sld))) + (xe (* 1.5 sld)) (ye (- sld)) (xg (round (* 1.8 sld))) (yg (* 3.8 sld)) (xw (- xg (* 2.0 staff-line-thickness))) (yw (round (* 5.0 sld))) (xh xw) (yh (- yw (max 2.0 (round (* 0.4 sld))))) @@ -450,7 +451,9 @@ (xl (+ xs stem-thickness)) (yl ys) (xm (- xp (* 1 staff-line-thickness))) (ym (round (* -2.75 sld))) (xr xm) (yr (+ ym staff-line-thickness)) - (xz xe) (yz (- staff-line-thickness sld)) + (xz xe) + ;; yz should be slightly above the upper edge of the staff line + (yz (+ (- sld) (* 1.2 staff-line-thickness))) (xaa (- xd (max 1 (round (* 0.3 sld))))) (yaa yd) (xbb xc) (ybb (- sld staff-line-thickness (max 2 (* 0.3 sld)))) (xdd xp) (ydd (* 2 sld)) @@ -458,36 +461,37 @@ (xff (floor (* 1.4 sld))) (yff sld) (xgg (+ xff stem-thickness)) (ygg yff)) (flet ((c (x y) (complex x y))) - (mf (c xa ya) ++ (c xb yb) up ++ (c xc yc) right ++ - (c xd yd) down ++ (c xe ye) left ++ (c xf yf) up ++ - (c xee yee) ++ - (c xg yg) up - (tensions 1 1.8) - (c xh yh) - (tensions 1.8 1) - (c xi yi) - (tensions 1.8 1) - (c xgg ygg) (direction #c(1 -4)) - (tensions 1 20) - (c xl yl) down ++ - (c xm ym) left ++ - (c xn yn) up ++ (c xo yo) right ++ (c xp yp) down ++ - (c xq yq) & - (c xq yq) ++ (c xr yr) right ++ - (c xs ys) up - (tensions 20 1) - (c xff yff) (direction #c(-1 4)) - (tensions 1 1.8) - (c xv yv) up - (tensions 1 1.8) - (c xw yw) right - (tensions 1.8 1) - (c xx yx) down ++ - (c xdd ydd) ++ - (c xy yy) down ++ (c xz yz) right ++ - (c xaa yaa) up ++ (c xbb ybb) left ++ - (c xcc ycc) down ++ (c (+ xa 1) ya) & - (c (+ xa 1) ya) ++ cycle))))) ; replace ++ by -- one day + (translate (mf (c xa ya) ++ (c xb yb) up ++ (c xc yc) right ++ + (c xd yd) down ++ (c xe ye) left ++ (c xf yf) up ++ + (c xee yee) ++ + (c xg yg) up + (tensions 1 1.8) + (c xh yh) + (tensions 1.8 1) + (c xi yi) + (tensions 1.8 1) + (c xgg ygg) (direction #c(1 -4)) + (tensions 1 20) + (c xl yl) down ++ + (c xm ym) left ++ + (c xn yn) up ++ (c xo yo) right ++ (c xp yp) down ++ + (c xq yq) & + (c xq yq) ++ (c xr yr) right ++ + (c xs ys) up + (tensions 20 1) + (c xff yff) (direction #c(-1 4)) + (tensions 1 1.8) + (c xv yv) up + (tensions 1 1.8) + (c xw yw) right + (tensions 1.8 1) + (c xx yx) down ++ + (c xdd ydd) ++ + (c xy yy) down ++ (c xz yz) right ++ + (c xaa yaa) up ++ (c xbb ybb) left ++ + (c xcc ycc) down ++ (c (+ xa 1) ya) & + (c (+ xa 1) ya) ++ cycle) + (complex 0 yoffset)))))) ; replace ++ by -- one day ;;; ;;; xa xb --- /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/05/29 19:55:24 1.24 +++ /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/05/30 02:13:26 1.25 @@ -265,16 +265,14 @@ ((:treble :treble8) :g-clef) (:bass :f-clef) (:c :c-clef)) - x (staff-step staff-step))) + x (staff-step (- staff-step)))) - - (define-presentation-type clef () :options (name x staff-step)) (define-presentation-method present (object (type clef) stream (view score-view) &key) (with-output-as-presentation (stream object 'clef) - (draw-clef stream name x staff-step))) + (new-draw-clef stream name x staff-step))) ;;;;;;;;;;;;;;;;;; rest

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 29 May '06

29 May '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv23421 Modified Files: gsharp.asd packages.lisp score-pane.lisp sdl.lisp Added Files: bezier.lisp mf.lisp Log Message: The new font-rendering code is now in there, but is not yet being used. The reason for that is that I still have not managed to get output recording for designs right. Once that problem is fixed, I am planning to gradually move to the new system, debugging the glyphs one at a time. The code for the glyphs has been tested in a separate context, but there might be unforeseen problems. The new system allows designs to be drawn in any color and transformation by being rendered to anti-aliased pixmaps, so there is no need to use special gray pixmaps. It might be worthwhile thinking about moving beam drawing to this new system one day. This font rendering system should be easy for PostScript output, but I haven't attacked that problem yet. --- /project/gsharp/cvsroot/gsharp/gsharp.asd 2006/05/28 21:35:30 1.8 +++ /project/gsharp/cvsroot/gsharp/gsharp.asd 2006/05/29 19:55:24 1.9 @@ -24,6 +24,8 @@ "packages" "utilities" "gf" + "bezier" + "mf" "sdl" "charmap" "score-pane" --- /project/gsharp/cvsroot/gsharp/packages.lisp 2006/03/25 22:06:35 1.50 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2006/05/29 19:55:24 1.51 @@ -13,8 +13,28 @@ #:gf-char-no #:gf-char-min-m #:gf-char-max-m #:gf-char-min-n #:gf-char-max-n #:gf-char-matrix)) +(defpackage :mf + (:use :cl) + (:export #:make-bezier-segment #:bezier-segment + #:make-open-path #:make-closed-path + #:closed-path #:concatenate-paths #:path-start + #:close-path + #:polygonalize + #:path-bounding-box + #:scan-lines + #:first-line #:nb-lines #:crossings + #:translate #:rotate #:scale #:slant #:reverse-path + #:draw-path #:with-pen + #:+razor+ #:+unit-square+ + #:+quarter-circle+ #:+half-circle+ #:+full-circle+ + #:superellipse + ;; mf-like stuff + #:paths #:mf #:paths #:control #:controls #:tension #:tensions + #:& #:-- #:--- #:curl #:direction #:cycle + #:left #:right #:up #:down)) + (defpackage :sdl - (:use :common-lisp :gf) + (:use :common-lisp :gf :mf) (:export #:glyph #:staff-line-distance #:staff-line-offsets #:stem-offsets #:bar-line-offsets #:ledger-line-x-offsets #:ledger-line-y-offsets --- /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/05/28 21:30:29 1.23 +++ /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/05/29 19:55:24 1.24 @@ -256,6 +256,19 @@ (:bass +glyph-f-clef+) (:c +glyph-c-clef+))) +(defun new-draw-clef (stream name x staff-step) + (sdl::draw-shape stream *font* + (ecase name + ;; FIXME: while using the same glyph for :TREBLE and :TREBLE8 is + ;; fine from a musical point of view, some differentiation (by + ;; putting an italic 8 underneath, for instance) would be good. + ((:treble :treble8) :g-clef) + (:bass :f-clef) + (:c :c-clef)) + x (staff-step staff-step))) + + + (define-presentation-type clef () :options (name x staff-step)) (define-presentation-method present --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/01/04 19:08:12 1.14 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2006/05/29 19:55:24 1.15 @@ -34,7 +34,75 @@ (defclass font () ((gf-font :initarg :gf-font :reader gf-font) + ;; The distance in pixels between the upper edge of two + ;; adjacent staff lines. (staff-line-distance :initarg :staff-line-distance :reader staff-line-distance) + ;; An integer value indicating how many non-white pixels are + ;; used to draw a staff line. + (staff-line-thickness) + ;; An integer value indicating how many non-white pixels are + ;; used to draw a stem + (stem-thickness) + ;; The width of filled and half-note noteheads is always 1.5 times the + ;; staff line distance. Since the staff line distance is an even + ;; number, this width is always an integer. This is important, because + ;; we need to position stems very precisely with respect to noteheads. + ;; and we want the left and right edges of noteheads to fall on integer + ;; pixel borders. Moreover, by having a fixed proportion, these + ;; noteheads will have the same proportional width no matter what the + ;; staff line distance is, which makes the characters look similar at + ;; different sizes. However, this means that we cannot make the + ;; heights of these characters integers. That is OK, though, since we + ;; count on anti-aliasing to give the impression of proportional + ;; sizes. + (notehead-width) + ;; While the rule above guarantees that the width of noteheads is an + ;; integer, it sometimes creates an even integer and sometimes an odd + ;; integer. When the width is even, the x-coordinate of the middle of + ;; the character is between two pixels, which is fine because that is + ;; how the MetaFont coordinate system works. When it is odd, however, + ;; the middle of the character is in the middle of a pixel. If we were + ;; to leave it like that, the left and right edges of the character + ;; would be in the middle of a pixel, which defeats the purpose. For + ;; that reason, when the width is odd, we put the reference point of + ;; the character one half pixel to the left of its middle. + ;; + ;; A similar rule holds for vertical reference points. For instance, + ;; the reference point of a staff line is the middle of the line if its + ;; thickness is even and one half pixel below that if it is odd. + ;; + ;; We do this consistently for stems, staff lines, etc. Thus, the + ;; client program can pretend that the reference point is always in the + ;; middle of the object. When the object has an odd size the effect is + ;; simply that everything appears to be off by half a pixel. We just + ;; have to watch out with attach points between stems and noteheads. + ;; In fact, in general, the noteheads may have a different distance + ;; from the reference point to the left attach point from the distance + ;; from the reference point to the right attach point. + + ;; Characters are positioned vertically in multiples of half a staff + ;; line distance. An even multiple indicates that the symbol will be + ;; placed ON A STAFF LINE, and an odd multiple a symbol BETWEEN TWO + ;; STAFF LINES. The bottom staff line of a staff has a multiple of + ;; zero, and the multiple is positive towards the upper edge of the + ;; page and negative towards the lower edge of the page. + ;; + ;; When the staff line thickness is even, the reference point for + ;; placing characters is the middle of the staff line or half way + ;; between two adjacent middles of staff lines. When the staff line + ;; thickness is odd, the reference point is located half a pixel lower + ;; down. + + ;; A certain number of characters are rotationally symmetric. But the + ;; center of the character is usually not the reference point. Since + ;; the reference point is (0, 0), we must draw these characters at an + ;; offset. + (xoffset) + ;; The vertical offset from the reference point to the middle of the + ;; staff line. This is zero for even staff line thicknesses and 0.5 + ;; otherwise. + (yoffset) + (dot-diameter) (staff-line-offset-down) (staff-line-offset-up) (ledger-line-offset-down) @@ -52,11 +120,18 @@ (beam-offset-down) (beam-offset-up) (beam-hang-sit-offset :reader beam-hang-sit-offset) + (designs :initform (make-hash-table :test #'eq)) (glyphs :initarg :glyphs :reader glyphs))) (defmethod initialize-instance :after ((font font) &rest initargs &key &allow-other-keys) (declare (ignore initargs)) (with-slots (staff-line-distance + staff-line-thickness + stem-thickness + notehead-width + xoffset + yoffset + dot-diameter staff-line-offset-down staff-line-offset-up ledger-line-offset-down @@ -74,16 +149,25 @@ beam-offset-down beam-offset-up beam-hang-sit-offset) font - (let ((staff-line-thickness (round (/ (staff-line-distance font) 10)))) - (setf staff-line-offset-down - (floor (/ staff-line-thickness 2)) - staff-line-offset-up - (- staff-line-offset-down staff-line-thickness))) - (let ((stem-thickness (round (/ staff-line-distance 11.9)))) - (setf stem-offset-left - (- (floor (/ stem-thickness 2))) - stem-offset-right - (+ stem-thickness stem-offset-left))) + (setf xoffset + (if (oddp (round (* 1.5 staff-line-distance))) 1.5 0)) + (setf yoffset + (if (oddp staff-line-distance) 0.5 0)) + (setf staff-line-thickness (round (/ (staff-line-distance font) 10))) + (setf dot-diameter + (min (- staff-line-distance staff-line-thickness 2) + (round (/ staff-line-distance 3)))) + (setf staff-line-offset-down + (floor (/ staff-line-thickness 2)) + staff-line-offset-up + (- staff-line-offset-down staff-line-thickness)) + ;; we can't use 12 here, because Lisp rounds 0.5 to 0 which + ;; happens for the smallest staff-line-distance = 6 + (setf stem-thickness (round (/ staff-line-distance 11.999))) + (setf stem-offset-left + (- (floor (/ stem-thickness 2))) + stem-offset-right + (+ stem-thickness stem-offset-left)) (let ((bar-line-thickness (round (/ (staff-line-distance font) 8)))) (setf bar-line-offset-left (- (floor (/ bar-line-thickness 2))) @@ -99,24 +183,22 @@ (- (floor (/ ledger-line-width 2))) ledger-line-offset-right (ceiling (/ ledger-line-width 2)))) - (let* ((notehead-width (* 3/2 staff-line-distance)) - (staff-line-thickness (round (/ (staff-line-distance font) 10))) - (yoffset (if (oddp staff-line-thickness) 0.5 0))) - (setf notehead-right-x-offset - (- (ceiling (/ notehead-width 2)) stem-offset-right)) - (setf notehead-left-x-offset - (- (+ (floor (/ notehead-width 2)) stem-offset-left))) - (setf notehead-right-y-offset - (round (+ (* 0.25 staff-line-distance) yoffset))) - (setf notehead-left-y-offset - (- (round (- (* 0.25 staff-line-distance) yoffset)))) - (setf beam-offset-down - (floor (/ staff-line-distance 2) 2)) - (setf beam-offset-up - (- (ceiling (/ staff-line-distance 2) 2))) - (setf beam-hang-sit-offset - (let ((beam-thickness (- beam-offset-down beam-offset-up))) - (/ (- beam-thickness staff-line-thickness) 2)))))) + (setf notehead-width (* 3/2 staff-line-distance)) + (setf notehead-right-x-offset + (- (ceiling (/ notehead-width 2)) stem-offset-right)) + (setf notehead-left-x-offset + (- (+ (floor (/ notehead-width 2)) stem-offset-left))) + (setf notehead-right-y-offset + (round (+ (* 0.25 staff-line-distance) yoffset))) + (setf notehead-left-y-offset + (- (round (- (* 0.25 staff-line-distance) yoffset)))) + (setf beam-offset-down + (floor (/ staff-line-distance 2) 2)) + (setf beam-offset-up + (- (ceiling (/ staff-line-distance 2) 2))) + (setf beam-hang-sit-offset + (let ((beam-thickness (- beam-offset-down beam-offset-up))) + (/ (- beam-thickness staff-line-thickness) 2))))) (defgeneric gf-char (glyph)) (defgeneric pixmap (glyph)) @@ -226,4 +308,1065 @@ :gf-font gf-font :glyphs glyphs))) - \ No newline at end of file +(defgeneric xyscale (thing kx ky)) + +(defmethod xyscale ((point number) kx ky) + (complex (* (realpart point) kx) + (* (imagpart point) ky))) + +(defmethod xyscale ((region clim:region) kx ky) + (let ((tr (clim:make-scaling-transformation kx ky))) + (clim:transform-region tr region))) + +(defun scale (thing k) + (xyscale thing k k)) + +(defun xscale (thing k) + (xyscale thing k 1.0)) + +(defun yscale (thing k) + (xyscale thing 1.0 k)) + +(defgeneric translate (thing z)) + +(defmethod translate ((region clim:region) z) + (let ((tr (clim:make-translation-transformation (realpart z) (imagpart z)))) + (clim:transform-region tr region))) + +(defgeneric rotate (thing angle)) + +(defmethod rotate ((region clim:region) angle) + (let ((tr (clim:make-rotation-transformation angle))) + (clim:transform-region tr region))) + +(defgeneric slant (thing slant)) + +(defmethod slant ((region clim:region) slant) + (let ((tr (climi::make-slanting-transformation slant))) + (clim:transform-region tr region))) + +(defgeneric compute-design (font shape)) + +(defun ensure-design (font shape) + (or (gethash shape (slot-value font 'designs)) + (setf (gethash shape (slot-value font 'designs)) + (yscale (compute-design font shape) -1)))) + +(defgeneric draw-shape (sheet font shape x y)) + +(defmethod draw-shape (sheet (font font) shape x y) + (let ((design (ensure-design font shape)) + (tr (clim:make-translation-transformation x y))) + (clim:draw-design sheet (clim:transform-region tr design)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Clefs + +;;; w +;;; | +;;; ** +;;; **** +;;; ***** +;;; ** | ** +;;; ** h ** +;;; ** ** +;;; ** g-** +;;; v-**-i ** +;;; ** *** +;;; * *** +;;; * ***-x +;;; * **** +;;; * **** +;;; * **** +;;;************************************************************************* +;;; * ****** +;;; * ****** +;;; * ****** +;;; ****** +;;; ****** +;;; ee\ ******/dd +;;;************************************************************************* +;;; ******** +;;; ******* * +;;; ******* * +;;; ******* * +;;; ******* * +;;; ****** ff\*/gg/c +;;;************************************************************************* +;;; ****** ************ +;;; ***** **************** +;;; f ***** ****************** +;;; \***** ***** * | *** +;;; **** b-**** * bb ** +;;; (0, 0)\ ****/y ***/cc * aa\**/d +;;;************************************************************************* +;;; **** ** * ** +;;; *** * * ** +;;; ** | * ** +;;; ** a z ) * ** +;;; *** | * ** +;;; *************** +;;;************************************************************************* +;;; |e * +;;; o * +;;; | * +;;; *** * +;;; ******* * +;;; ********* * +;;; n-*********-p * +;;; ****** s-*-l +;;; ****-q r * +;;; **** / ** +;;; ******* +;;; | +;;; m +;;; +;;; + +(defmethod compute-design ((font font) (shape (eql :g-clef))) + (with-slots ((sld staff-line-distance) staff-line-thickness stem-thickness) font + (let* ((xf 0.0) (yf (* 0.5 sld)) + (xy (max 2.0 (round (* 0.4 sld)))) (yy (* 0.2 sld)) + (xb (+ xy (max 2.0 (round (* 0.4 sld))))) (yb (* 0.3 sld)) + (xcc (+ xb (max 2.0 (round (* 0.4 sld))))) (ycc 0) + (xa (+ xcc (max 1.0 (* 0.2 sld)))) (ya (* -0.4 sld)) + (xc (+ xb (round (* 0.7 sld)))) (yc (+ sld (max 1.0 (* 0.15 sld)))) + (xd (+ xc sld)) (yd 0.0) + (xe (* 1.5 sld)) (ye (- (+ staff-line-thickness sld))) + (xg (round (* 1.8 sld))) (yg (* 3.8 sld)) + (xw (- xg (* 2.0 staff-line-thickness))) (yw (round (* 5.0 sld))) + (xh xw) (yh (- yw (max 2.0 (round (* 0.4 sld))))) + (xv (round (* 1.0 sld))) (yv (* 3.5 sld)) + (xi (+ xv (max 2.0 (* 0.2 sld)))) (yi yv) + (xx (+ xg (max 2.0 (round (* 0.3 sld))))) (yx (* 3.5 sld)) + (bigdot-diameter sld) + (yo (- (+ sld (round (* 0.5 sld))))) + (xn (round (* 0.5 sld))) (yn (- yo (* 0.5 bigdot-diameter))) + (xo (+ xn (* 0.5 bigdot-diameter))) + (xp (+ xn bigdot-diameter)) (yp yn) + (xq xo) (yq (- yo bigdot-diameter)) + (xs (+ xp (max 1 (floor (* 0.4 sld))))) (ys yp) + (xl (+ xs stem-thickness)) (yl ys) + (xm (- xp (* 1 staff-line-thickness))) (ym (round (* -2.75 sld))) + (xr xm) (yr (+ ym staff-line-thickness)) + (xz xe) (yz (- staff-line-thickness sld)) + (xaa (- xd (max 1 (round (* 0.3 sld))))) (yaa yd) + (xbb xc) (ybb (- sld staff-line-thickness (max 2 (* 0.3 sld)))) + (xdd xp) (ydd (* 2 sld)) + (xee xn) (yee ydd) + (xff (floor (* 1.4 sld))) (yff sld) + (xgg (+ xff stem-thickness)) (ygg yff)) + (flet ((c (x y) (complex x y))) + (mf (c xa ya) ++ (c xb yb) up ++ (c xc yc) right ++ + (c xd yd) down ++ (c xe ye) left ++ (c xf yf) up ++ + (c xee yee) ++ + (c xg yg) up + (tensions 1 1.8) + (c xh yh) + (tensions 1.8 1) + (c xi yi) + (tensions 1.8 1) + (c xgg ygg) (direction #c(1 -4)) + (tensions 1 20) + (c xl yl) down ++ + (c xm ym) left ++ + (c xn yn) up ++ (c xo yo) right ++ (c xp yp) down ++ + (c xq yq) & + (c xq yq) ++ (c xr yr) right ++ + (c xs ys) up + (tensions 20 1) + (c xff yff) (direction #c(-1 4)) + (tensions 1 1.8) + (c xv yv) up + (tensions 1 1.8) + (c xw yw) right + (tensions 1.8 1) + (c xx yx) down ++ + (c xdd ydd) ++ + (c xy yy) down ++ (c xz yz) right ++ + (c xaa yaa) up ++ (c xbb ybb) left ++ + (c xcc ycc) down ++ (c (+ xa 1) ya) & + (c (+ xa 1) ya) ++ cycle))))) ; replace ++ by -- one day + +;;; +;;; xa xb +;;; || +;;; || xc xf +;;; || | | +;;; (0, top) ********* ** **************** +;;; ********* ** ******************** +;;; ********* ** **** | ********** +;;; ********* ** *** | ******** +;;; ********* ** *** (xg,yg) ******* +;;; ********* ** ***** ******** +;;; ********* ** ******* ******** +;;; ********* ** ******** ******** +;;; ********* ** ******** ******** +;;; ********* ** | ****** ******** +;;; ********* ** | **___yd ******** +;;; ********* ** xd ******** +;;; ********* ** (xj,yj)-- ******** +;;; ********* ** ******** +;;; ********* ** (xe,ye) ******** +;;; ********* ** | ********--(xk,yk) +;;; ********* ** ** ******** +;;; ********* ** **** ******** +;;; ********* ** **** (xh,yh) ******** +;;; ********* ** ****** | ******* +;;; ********* ** ******* | ****** +;;; ********* ** ***** ************* +;;; ********* ** **** |_____ +;;; ********* ** ****** (xl,yl) +;;; (0, 0) ********* ***********--xi +;;; ********* *********** +;;; ********* ** ******* +;;; ********* ** **** +;;; ********* ** ***** ************* +;;; ********* ** ******* ****** +;;; ********* ** ****** ******* +;;; ********* ** **** ******** +;;; ********* ** **** ******** +;;; ********* ** ** ******** [842 lines skipped] --- /project/gsharp/cvsroot/gsharp/bezier.lisp 2006/05/29 19:55:24 NONE +++ /project/gsharp/cvsroot/gsharp/bezier.lisp 2006/05/29 19:55:24 1.1 [1648 lines skipped] --- /project/gsharp/cvsroot/gsharp/mf.lisp 2006/05/29 19:55:25 NONE +++ /project/gsharp/cvsroot/gsharp/mf.lisp 2006/05/29 19:55:25 1.1 [2240 lines skipped]

1 0

[gsharp-cvs] CVS gsharp/Scores
by crhodes 28 May '06

28 May '06

Update of /project/gsharp/cvsroot/gsharp/Scores In directory clnet:/tmp/cvs-serv1358 Added Files: humoresque.gsh Log Message: Dvorak's Humoresque. Mostly for partial beams, but note that it's also a convincing demo of the use of keyboard macros. --- /project/gsharp/cvsroot/gsharp/Scores/humoresque.gsh 2006/05/28 21:38:21 NONE +++ /project/gsharp/cvsroot/gsharp/Scores/humoresque.gsh 2006/05/28 21:38:21 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 #(:SHARP :NATURAL :NATURAL :SHARP :NATURAL :NATURAL :NATURAL) ] ]) :segments ([GSHARP-BUFFER:SEGMENT :layers ([GSHARP-BUFFER:MELODY-LAYER :name "default layer" :staves (#1#) :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 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 29 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 2 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 30 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 29 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 2 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 30 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 31 :staff #1# :head :FILLED :accidentals :SHARP :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 2 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 33 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 34 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 2 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 33 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 36 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 2 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 35 :staff #1# :head :FILLED :accidentals :SHARP :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 37 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 2 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 36 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 35 :staff #1# :head :FILLED :accidentals :SHARP :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 2 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 37 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 36 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 2 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 34 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 33 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 2 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 33 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 34 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 2 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 33 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 36 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 2 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 34 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 33 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 2 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 31 :staff #1# :head :FILLED :accidentals :SHARP :dots 0 ]) ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 30 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:REST :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos 4 ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 29 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 0 :lbeams 2 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 30 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 29 :staff #1# :head :FILLED :accidentals :NATURAL [1585 lines skipped]

1 0

[gsharp-cvs] CVS gsharp
by crhodes 28 May '06

28 May '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv1187 Modified Files: gsharp.asd Removed Files: clim-patches.lisp Log Message: With McCLIM output records having been reworked, the clim patches (which didn't work anyway) are no longer necessary. Delete the whole clim-patches file, in the hope that no future clim patches are necessary either... --- /project/gsharp/cvsroot/gsharp/gsharp.asd 2006/03/25 22:06:35 1.7 +++ /project/gsharp/cvsroot/gsharp/gsharp.asd 2006/05/28 21:35:30 1.8 @@ -22,7 +22,6 @@ (gsharp-defsystem (:gsharp :depends-on (:mcclim :flexichain :esa)) "packages" - "clim-patches" "utilities" "gf" "sdl"

1 0

[gsharp-cvs] CVS gsharp
by crhodes 28 May '06

28 May '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv32040 Modified Files: score-pane.lisp Log Message: Beam output records need to store the clipping-region, and use it when replaying. Fixes sloping partial beams. --- /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/03/02 09:21:34 1.22 +++ /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/05/28 21:30:29 1.23 @@ -453,6 +453,7 @@ (defclass beam-output-record (score-output-record) ((light-glyph-p :initarg :light-glyph-p) + (clipping-region :initarg :clipping-region) (thickness :initarg :thickness))) ;;; draw a horizontal beam around the vertical reference @@ -553,14 +554,15 @@ (x-offset 0) (y-offset 0)) (declare (ignore x-offset y-offset region)) (with-bounding-rectangle* (x1 y1 x2 y2) record - (with-slots (thickness ink light-glyph-p) record + (with-slots (thickness ink clipping-region light-glyph-p) record (let ((medium (sheet-medium stream))) (let ((*light-glyph* light-glyph-p)) - (with-drawing-options (medium :ink ink) + (with-drawing-options + (medium :ink ink :clipping-region clipping-region) (let ((*lighter-gray-progressions* (lighter-gray-progressions stream)) (*darker-gray-progressions* (darker-gray-progressions stream))) - (draw-downward-beam medium x1 y1 y2 thickness - (/ (- x2 x1) (- y2 y1)))))))))) + (draw-downward-beam medium x1 y1 y2 thickness + (/ (- x2 x1) (- y2 y1)))))))))) (defclass upward-beam-output-record (beam-output-record) ()) @@ -570,10 +572,11 @@ (x-offset 0) (y-offset 0)) (declare (ignore x-offset y-offset region)) (with-bounding-rectangle* (x1 y1 x2 y2) record - (with-slots (thickness ink light-glyph-p) record + (with-slots (thickness ink clipping-region light-glyph-p) record (let ((medium (sheet-medium stream))) (let ((*light-glyph* light-glyph-p)) - (with-drawing-options (medium :ink ink) + (with-drawing-options + (medium :ink ink :clipping-region clipping-region) (let ((*lighter-gray-progressions* (lighter-gray-progressions stream)) (*darker-gray-progressions* (darker-gray-progressions stream))) (draw-upward-beam medium x1 y2 y1 thickness @@ -596,7 +599,8 @@ *pane* (make-instance 'downward-beam-output-record :x1 xx1 :y1 yy1 :x2 xx2 :y2 yy2 :light-glyph-p *light-glyph* - :thickness thickness :ink (medium-ink medium)))))) + :thickness thickness :ink (medium-ink medium) + :clipping-region (medium-clipping-region medium)))))) (when (stream-drawing-p *pane*) (draw-downward-beam medium x1 y1 y2 thickness inverse-slope))) (t @@ -609,7 +613,9 @@ *pane* (make-instance 'upward-beam-output-record :x1 xx1 :y1 yy2 :x2 xx2 :y2 yy1 :light-glyph-p *light-glyph* - :thickness thickness :ink (medium-ink medium)))))) + :thickness thickness + :ink (medium-ink medium) + :clipping-region (medium-clipping-region medium)))))) (when (stream-drawing-p *pane*) (draw-upward-beam medium x1 y1 y2 thickness inverse-slope)))))))

1 0

[gsharp-cvs] CVS gsharp
by crhodes 23 May '06

23 May '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv9606 Modified Files: gui.lisp Log Message: Make the File menu basically work. I couldn't find a way of graying out or invalidating commands, but that's not a big deal really yet. --- /project/gsharp/cvsroot/gsharp/gui.lisp 2006/05/23 10:55:26 1.62 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2006/05/23 11:43:29 1.63 @@ -99,7 +99,7 @@ (default (vertically () (horizontally () - score + score (vertically () (scrolling (:width 80 :height 200) state) (scrolling (:width 80 :height 300 @@ -248,9 +248,9 @@ (make-command-table 'file-command-table :errorp nil - :menu '(("Find" :command com-find-file) - ("Save" :command com-save-buffer) - ("Save as" :command com-write-buffer) + :menu `(("Find" :command (esa-io::com-find-file ,esa::*unsupplied-argument-marker*)) + ("Save" :command esa-io::com-save-buffer) + ("Save as" :command (esa-io::com-write-buffer ,esa::*unsupplied-argument-marker*)) ("Quit" :command com-quit))) (define-gsharp-command (com-new-buffer :name t) ()

1 0

[gsharp-cvs] CVS gsharp
by crhodes 23 May '06

23 May '06

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv3492 Modified Files: gui.lisp modes.lisp Log Message: Make the Measure menu work again; have only one definition of com-forward/backward-measure. Document one or two commands; make com-erase-element take a numeric prefix parameter. --- /project/gsharp/cvsroot/gsharp/gui.lisp 2006/05/22 13:39:30 1.61 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2006/05/23 10:55:26 1.62 @@ -451,14 +451,8 @@ (make-command-table 'measure-command-table :errorp nil - :menu '(("Forward" :command com-forward-measure) - ("Backward" :command com-backward-measure))) - -(define-gsharp-command (com-forward-measure :name t) () - (forward-bar (current-cursor))) - -(define-gsharp-command (com-backward-measure :name t) () - (backward-bar (current-cursor))) + :menu '(("Forward" :command (com-forward-measure 1)) + ("Backward" :command (com-backward-measure 1)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -806,7 +800,7 @@ (setf *current-note* (or (cluster-lower-bound cluster note) (cluster-upper-bound cluster note))) (unless *current-note* - (com-erase-element))))) + (com-erase-element 1))))) (define-gsharp-command com-tie-note-left () (let ((note (cur-note))) @@ -832,11 +826,15 @@ ;;; ;;; motion by element -(define-gsharp-command com-forward-element ((count 'integer :prompt "Number of Elements")) +(define-gsharp-command com-forward-element + ((count 'integer :prompt "Number of Elements")) + "Move forward by element." (loop repeat count do (forward-element (current-cursor)))) -(define-gsharp-command com-backward-element ((count 'integer :prompt "Number of Elements")) +(define-gsharp-command com-backward-element + ((count 'integer :prompt "Number of Elements")) + "Move backward by element." (loop repeat count do (backward-element (current-cursor)))) @@ -844,17 +842,15 @@ ;;; ;;; motion by measure -(define-gsharp-command com-forward-measure ((count 'integer :prompt "Number of Measures")) - (let ((cursor (current-cursor))) - (loop repeat count do - (loop do (forward-element cursor) - until (end-of-bar-p cursor)))) - -(define-gsharp-command com-backward-measure ((count 'integer :prompt "Number of Measures")) - (let ((cursor (current-cursor))) - (loop repeat count do - (loop do (backward-element cursor) - until (beginning-of-bar-p cursor)))) +(define-gsharp-command com-forward-measure + ((count 'integer :prompt "Number of Measures")) + "Move forward by measure." + (loop repeat count do (forward-bar (current-cursor)))) + +(define-gsharp-command com-backward-measure + ((count 'integer :prompt "Number of Measures")) + "Move backward by measure." + (loop repeat count do (backward-bar (current-cursor)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -880,7 +876,9 @@ (insert-element element cursor) (forward-element cursor)))) -(define-gsharp-command com-delete-element ((count 'integer :prompt "Number of Elements")) +(define-gsharp-command com-delete-element + ((count 'integer :prompt "Number of Elements")) + "Delete element forwards." (let ((cursor (current-cursor))) (loop repeat count do (progn @@ -892,12 +890,16 @@ (fuse-bar-with-next cursor) (delete-element cursor)))))) -(define-gsharp-command com-erase-element () +(define-gsharp-command com-erase-element + ((count 'integer :prompt "Number of Elements")) + "Delete element backwards." (let ((cursor (current-cursor))) - (backward-element cursor) - (if (end-of-bar-p cursor) - (fuse-bar-with-next cursor) - (delete-element cursor)))) + (loop repeat count + do (progn + (backward-element cursor) + (if (end-of-bar-p cursor) + (fuse-bar-with-next cursor) + (delete-element cursor)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/gsharp/cvsroot/gsharp/modes.lisp 2006/05/22 13:39:30 1.13 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2006/05/23 10:55:26 1.14 @@ -8,9 +8,9 @@ (set-key `(com-forward-measure ,*numeric-argument-marker*) 'global-gsharp-table '((#\f :control :meta))) (set-key `(com-backward-measure ,*numeric-argument-marker*) 'global-gsharp-table '((#\b :control :meta))) (set-key `(com-delete-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\d :control))) +(set-key `(com-erase-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\h :control))) (set-key 'com-insert-measure-bar '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)))

1 0

[gsharp-cvs] CVS gsharp/Scores
by crhodes 22 May '06

22 May '06

Update of /project/gsharp/cvsroot/gsharp/Scores In directory clnet:/tmp/cvs-serv5633/Scores Modified Files: cris.gsh Log Message: Make it the first 73 bars, now that scrolling works. No lyrics yet. --- /project/gsharp/cvsroot/gsharp/Scores/cris.gsh 2006/05/14 17:49:58 1.1 +++ /project/gsharp/cvsroot/gsharp/Scores/cris.gsh 2006/05/22 13:40:20 1.2 @@ -322,18 +322,8 @@ :staff #4# :head :HALF :accidentals :NATURAL - :dots 0 ]) ]) ]) ] - :tail [GSHARP-BUFFER:SLICE - :bars ([GSHARP-BUFFER:MELODY-BAR - :elements COMMON-LISP:NIL ]) ] ] - [GSHARP-BUFFER:MELODY-LAYER - :name "ten" - :staves (#3#) - :head [GSHARP-BUFFER:SLICE - :bars ([GSHARP-BUFFER:MELODY-BAR - :elements COMMON-LISP:NIL ]) ] - :body [GSHARP-BUFFER:SLICE - :bars ([GSHARP-BUFFER:MELODY-BAR + :dots 0 ]) ]) ] + [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :WHOLE @@ -343,66 +333,37 @@ :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 25 - :staff #3# - :head :WHOLE + :staff #4# + :head :FILLED :accidentals :NATURAL :dots 0 :tie-right COMMON-LISP:T ]) ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 - :notehead :WHOLE + :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 25 - :staff #3# - :head :WHOLE + :staff #4# + :head :FILLED :accidentals :NATURAL :dots 0 - :tie-left COMMON-LISP:T ]) ]) ] - [GSHARP-BUFFER:MELODY-BAR - :elements ([GSHARP-BUFFER:CLUSTER - :xoffset 0 - :notehead :WHOLE - :rbeams 0 - :lbeams 0 - :dots 0 - :stem-direction :AUTO - :notes ([GSHARP-BUFFER:NOTE - :pitch 28 - :staff #3# - :head :WHOLE - :accidentals :NATURAL - :dots 0 ]) ]) ] - [GSHARP-BUFFER:MELODY-BAR - :elements ([GSHARP-BUFFER:CLUSTER + :tie-left COMMON-LISP:T ]) ] + [GSHARP-BUFFER:CLUSTER :xoffset 0 - :notehead :WHOLE + :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 27 - :staff #3# - :head :WHOLE - :accidentals :NATURAL - :dots 0 ]) ]) ] - [GSHARP-BUFFER:MELODY-BAR - :elements ([GSHARP-BUFFER:CLUSTER - :xoffset 0 - :notehead :HALF - :rbeams 0 - :lbeams 0 - :dots 1 - :stem-direction :AUTO - :notes ([GSHARP-BUFFER:NOTE - :pitch 26 - :staff #3# - :head :WHOLE + :pitch 24 + :staff #4# + :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER @@ -413,8 +374,8 @@ :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 25 - :staff #3# + :pitch 23 + :staff #4# :head :FILLED :accidentals :NATURAL :dots 0 ]) ]) ] @@ -427,8 +388,8 @@ :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 26 - :staff #3# + :pitch 22 + :staff #4# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] @@ -440,8 +401,8 @@ :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 27 - :staff #3# + :pitch 21 + :staff #4# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] @@ -453,8 +414,8 @@ :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 28 - :staff #3# + :pitch 22 + :staff #4# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] @@ -466,38 +427,41 @@ :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 29 - :staff #3# + :pitch 23 + :staff #4# :head :FILLED :accidentals :NATURAL :dots 0 ]) ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 - :notehead :FILLED + :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 30 - :staff #3# + :pitch 24 + :staff #4# :head :FILLED :accidentals :NATURAL - :dots 0 ]) ] - [GSHARP-BUFFER:CLUSTER + :dots 0 + :tie-right COMMON-LISP:T ]) ]) ] + [GSHARP-BUFFER:MELODY-BAR + :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 - :notehead :FILLED + :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 29 - :staff #3# + :pitch 24 + :staff #4# :head :FILLED :accidentals :NATURAL - :dots 0 ]) ] + :dots 0 + :tie-left COMMON-LISP:T ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 :notehead :FILLED @@ -506,8 +470,8 @@ :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 28 - :staff #3# + :pitch 23 + :staff #4# :head :FILLED :accidentals :NATURAL :dots 0 ]) ] @@ -519,8 +483,8 @@ :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 27 - :staff #3# + :pitch 22 + :staff #4# :head :FILLED :accidentals :NATURAL :dots 0 ]) ]) ] @@ -533,8 +497,8 @@ :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 26 - :staff #3# + :pitch 21 + :staff #4# :head :FILLED :accidentals :NATURAL :dots 0 ]) ]) ] @@ -545,50 +509,53 @@ :rbeams 0 :lbeams 0 :dots 0 - :staff #3# + :staff #4# :staff-pos 4 ]) ] [GSHARP-BUFFER:MELODY-BAR - :elements ([GSHARP-BUFFER:CLUSTER + :elements ([GSHARP-BUFFER:REST :xoffset 0 :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 - :stem-direction :AUTO - :notes ([GSHARP-BUFFER:NOTE - :pitch 26 - :staff #3# - :head :WHOLE - :accidentals :NATURAL - :dots 0 ]) ]) ] + :staff #4# + :staff-pos 4 ]) ] [GSHARP-BUFFER:MELODY-BAR - :elements ([GSHARP-BUFFER:CLUSTER + :elements ([GSHARP-BUFFER:REST :xoffset 0 :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 - :stem-direction :AUTO - :notes ([GSHARP-BUFFER:NOTE - :pitch 26 - :staff #3# - :head :WHOLE - :accidentals :NATURAL - :dots 0 ]) ]) ] + :staff #4# + :staff-pos 4 ]) ] [GSHARP-BUFFER:MELODY-BAR - :elements ([GSHARP-BUFFER:CLUSTER + :elements ([GSHARP-BUFFER:REST :xoffset 0 :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 - :stem-direction :AUTO - :notes ([GSHARP-BUFFER:NOTE - :pitch 26 - :staff #3# - :head :WHOLE - :accidentals :NATURAL - :dots 0 ]) ]) ] + :staff #4# + :staff-pos 4 ]) ] + [GSHARP-BUFFER:MELODY-BAR + :elements ([GSHARP-BUFFER:REST + :xoffset 0 + :notehead :WHOLE + :rbeams 0 + :lbeams 0 + :dots 0 + :staff #4# + :staff-pos 4 ]) ] + [GSHARP-BUFFER:MELODY-BAR + :elements ([GSHARP-BUFFER:REST + :xoffset 0 + :notehead :WHOLE + :rbeams 0 + :lbeams 0 + :dots 0 + :staff #4# + :staff-pos 4 ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 @@ -598,9 +565,9 @@ :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 28 - :staff #3# - :head :WHOLE + :pitch 22 + :staff #4# + :head :FILLED :accidentals :NATURAL :dots 0 ]) ]) ] [GSHARP-BUFFER:MELODY-BAR @@ -612,9 +579,9 @@ :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 27 - :staff #3# - :head :HALF + :pitch 19 + :staff #4# + :head :FILLED :accidentals :NATURAL :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER @@ -625,79 +592,64 @@ :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 26 - :staff #3# - :head :HALF + :pitch 22 + :staff #4# + :head :FILLED :accidentals :NATURAL - :dots 0 - :tie-right COMMON-LISP:T ]) ]) ] + :dots 0 ]) ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :xoffset 0 - :notehead :HALF + :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 26 - :staff #3# - :head :HALF + :pitch 21 + :staff #4# + :head :FILLED :accidentals :NATURAL - :dots 0 - :tie-left COMMON-LISP:T ]) ] + :dots 0 ]) ] [GSHARP-BUFFER:CLUSTER :xoffset 0 - :notehead :HALF + :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 25 - :staff #3# - :head :HALF + :pitch 20 + :staff #4# + :head :FILLED :accidentals :NATURAL - :dots 0 ]) ]) ] - [GSHARP-BUFFER:MELODY-BAR - :elements ([GSHARP-BUFFER:CLUSTER + :dots 0 ]) ] + [GSHARP-BUFFER:CLUSTER :xoffset 0 - :notehead :WHOLE + :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE - :pitch 26 [5514 lines skipped]

1 0