Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv12067 Modified Files: drawing.lisp gui.lisp packages.lisp score-pane.lisp Log Message: added preseentation types for staff and clef in score pane. score pane is no longer `use'd by other packages, exported symbols from score pane are explicitly prefixed by client code. removed presentation type for staff-line in score pane. Date: Wed Jul 21 05:43:00 2004 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.5 gsharp/drawing.lisp:1.6 --- gsharp/drawing.lisp:1.5 Wed Jul 14 11:07:33 2004 +++ gsharp/drawing.lisp Wed Jul 21 05:42:59 2004 @@ -10,31 +10,43 @@ (accidental-position :initform nil :accessor accidental-position))) (define-presentation-method present - (staff (type staff) stream (view textual-view) &key) - (format stream "[staff ~a]" (name staff))) + (object (type score-pane:clef) stream (view textual-view) &key) + (format stream "[~a clef on staff step ~a]" (name object) (lineno object))) + +(define-presentation-method present + (object (type score-pane:staff) stream (view textual-view) &key) + (format stream "[staff ~a]" (name object))) (defmethod draw-staff-and-clef (pane (staff staff) x1 x2) (when (clef staff) - (draw-clef pane (name (clef staff)) (+ x1 10) (lineno (clef staff))) + (present (clef staff) + `((score-pane:clef) + :name ,(name (clef staff)) + :x ,(+ x1 10) + :staff-step ,(lineno (clef staff))) + :stream pane) (let ((yoffset (ecase (name (clef staff)) (:bass (- (lineno (clef staff)) 4)) (:treble (+ (lineno (clef staff)) 2)) (:c (- (lineno (clef staff))) 1)))) (loop for pitch in '(6 2 5 1 4 0 3) for line in '(0 3 -1 2 -2 1 -3) - for x from (+ x1 10 (staff-step 8)) by (staff-step 2) + for x from (+ x1 10 (score-pane:staff-step 8)) by (score-pane:staff-step 2) while (eq (aref (keysig staff) pitch) :flat) - do (draw-accidental pane :flat x (+ line yoffset)))) + do (score-pane:draw-accidental pane :flat x (+ line yoffset)))) (let ((yoffset (ecase (name (clef staff)) (:bass (lineno (clef staff))) (:treble (+ (lineno (clef staff)) 6)) (:c (+ (lineno (clef staff))) 3)))) (loop for pitch in '(3 0 4 1 5 2 6) for line in '(0 -3 1 -2 -5 -1 -4) - for x from (+ x1 10 (staff-step 8)) by (staff-step 2.5) + for x from (+ x1 10 (score-pane:staff-step 8)) by (score-pane:staff-step 2.5) while (eq (aref (keysig staff) pitch) :sharp) - do (draw-accidental pane :sharp x (+ line yoffset))))) - (draw-staff staff pane x1 x2)) + do (score-pane:draw-accidental pane :sharp x (+ line yoffset))))) + (present staff + `((score-pane:staff) + :x1 ,x1 :x2 ,x2) + :stream pane)) (defun line-cost (measures method) (reduce (lambda (x y) (combine-cost method x y)) measures :initial-value nil)) @@ -85,7 +97,7 @@ (loop for bar in (measure-bars measure) do (if (gsharp-cursor::cursors (slice bar)) (draw-bar pane bar x width time-alist draw-cursor) - (with-light-glyphs pane (draw-bar pane bar x width time-alist draw-cursor)))))) + (score-pane:with-light-glyphs pane (draw-bar pane bar x width time-alist draw-cursor)))))) (defun draw-system (pane measures x widths method staves draw-cursor) (let ((compress (compute-compress-factor measures method)) @@ -94,17 +106,17 @@ for width in widths do (draw-measure pane measure min-dist compress x method draw-cursor) (incf x width) - (draw-bar-line pane x - (staff-step 8) - (staff-yoffset (car (last staves))))))) + (score-pane:draw-bar-line pane x + (score-pane:staff-step 8) + (staff-yoffset (car (last staves))))))) (defmethod draw-buffer (pane (buffer buffer) *cursor* x y draw-cursor) - (with-staff-size 6 + (score-pane:with-staff-size 6 (let* ((staves (staves buffer)) - (timesig-offset (max (* (staff-step 2) + (timesig-offset (max (* (score-pane:staff-step 2) (loop for staff in staves maximize (count :flat (keysig staff)))) - (* (staff-step 2.5) + (* (score-pane:staff-step 2.5) (loop for staff in staves maximize (count :sharp (keysig staff)))))) (method (let ((old-method (buffer-cost-method buffer))) @@ -119,17 +131,17 @@ (gsharp-measure::new-map-over-obseq-subsequences (lambda (measures) (let ((widths (compute-widths measures method))) - (with-vertical-score-position (pane yy) + (score-pane:with-vertical-score-position (pane yy) (draw-system pane measures (+ x (left-offset buffer) timesig-offset) widths method staves draw-cursor) - (draw-bar-line pane x - (staff-step 8) - (staff-yoffset (car (last staves))))) + (score-pane:draw-bar-line pane x + (score-pane:staff-step 8) + (staff-yoffset (car (last staves))))) (loop for staff in staves do - (with-vertical-score-position (pane yy) + (score-pane:with-vertical-score-position (pane yy) (if (member staff (staves (layer (slice (bar *cursor*))))) (draw-staff-and-clef pane staff x right-edge) - (with-light-glyphs pane + (score-pane:with-light-glyphs pane (draw-staff-and-clef pane staff x right-edge)))) (decf yy 90)))) buffer))))) @@ -250,7 +262,9 @@ (start-time 0)) (mapc (lambda (element) (setf (element-xpos element) - (+ x (staff-step (xoffset element)) (cdr (assoc start-time time-alist)))) + (+ x + (score-pane:staff-step (xoffset element)) + (cdr (assoc start-time time-alist)))) (incf start-time (duration element))) (elements bar)))) @@ -296,7 +310,7 @@ (if (eq stem-direction :up) -1000 1000))) dominating-notes)) (x-positions (mapcar (lambda (element) - (/ (element-xpos element) (staff-step 1))) + (/ (element-xpos element) (score-pane:staff-step 1))) elements)) (beaming (beaming-single (mapcar #'list positions x-positions) stem-direction))) (loop for element in elements do @@ -318,23 +332,23 @@ (+ y1 (* slope (- (element-xpos element) x1)))) (setf (final-stem-yoffset element) (staff-yoffset dominating-staff))))) - (with-vertical-score-position (pane (staff-yoffset dominating-staff)) + (score-pane:with-vertical-score-position (pane (staff-yoffset dominating-staff)) (if (eq stem-direction :up) - (with-notehead-right-offsets (right up) + (score-pane:with-notehead-right-offsets (right up) (declare (ignore up)) - (draw-beam pane - (+ (element-xpos (car elements)) right) ss1 offset1 - (+ (element-xpos (car (last elements))) right) ss2 offset2)) - (with-notehead-left-offsets (left down) + (score-pane:draw-beam pane + (+ (element-xpos (car elements)) right) ss1 offset1 + (+ (element-xpos (car (last elements))) right) ss2 offset2)) + (score-pane:with-notehead-left-offsets (left down) (declare (ignore down)) - (draw-beam pane - (+ (element-xpos (car elements)) left) ss1 offset1 - (+ (element-xpos (car (last elements))) left) ss2 offset2)))) + (score-pane:draw-beam pane + (+ (element-xpos (car elements)) left) ss1 offset1 + (+ (element-xpos (car (last elements))) left) ss2 offset2)))) (loop for element in elements do (draw-element pane element (element-xpos element) nil)))))) (defun draw-cursor (pane x) - (draw-line* pane x (staff-step -4) x (staff-step 12) :ink +red+)) + (draw-line* pane x (score-pane:staff-step -4) x (score-pane:staff-step 12) :ink +red+)) (defmethod draw-bar (pane (bar bar) x width time-alist draw-cursor) (compute-element-x-positions bar x time-alist) @@ -376,38 +390,38 @@ (lineno clef)))) (defun draw-ledger-lines (pane x notes) - (with-vertical-score-position (pane (staff-yoffset (staff (car notes)))) + (score-pane:with-vertical-score-position (pane (staff-yoffset (staff (car notes)))) (let* ((positions (mapcar #'note-position notes)) (max-pos (reduce #'max positions)) (min-pos (reduce #'min positions))) (loop for pos from 10 to max-pos by 2 - do (draw-ledger-line pane x pos)) + do (score-pane:draw-ledger-line pane x pos)) (loop for pos from -2 downto min-pos by 2 - do (draw-ledger-line pane x pos))))) + do (score-pane:draw-ledger-line pane x pos))))) (defun draw-flags (pane element x direction pos) (let ((nb (max (rbeams element) (lbeams element)))) (when (and (> nb 0) (eq (notehead element) :filled)) (if (eq direction :up) - (with-notehead-right-offsets (right up) + (score-pane:with-notehead-right-offsets (right up) (declare (ignore up)) - (draw-flags-down pane nb (+ x right) pos)) - (with-notehead-left-offsets (left down) + (score-pane:draw-flags-down pane nb (+ x right) pos)) + (score-pane:with-notehead-left-offsets (left down) (declare (ignore down)) - (draw-flags-up pane nb (+ x left) pos)))))) + (score-pane:draw-flags-up pane nb (+ x left) pos)))))) (defun draw-dots (pane nb-dots x pos) - (let ((staff-step (staff-step 1))) + (let ((staff-step (score-pane:staff-step 1))) (loop with dotpos = (if (evenp pos) (1+ pos) pos) repeat nb-dots for xx from (+ x (* 2 staff-step)) by staff-step do - (draw-dot pane xx dotpos)))) + (score-pane:draw-dot pane xx dotpos)))) (defun draw-note (pane note notehead nb-dots x pos) - (with-vertical-score-position (pane (staff-yoffset (staff note))) - (draw-notehead pane notehead x pos) + (score-pane:with-vertical-score-position (pane (staff-yoffset (staff note))) + (score-pane:draw-notehead pane notehead x pos) (when (final-accidental note) - (draw-accidental pane (final-accidental note) (accidental-position note) pos)) + (score-pane:draw-accidental pane (final-accidental note) (accidental-position note) pos)) (draw-dots pane nb-dots x pos))) (defun draw-notes (pane notes dots notehead) @@ -419,7 +433,7 @@ (if (eq direction :up) (lambda (x y) (< (note-position x) (note-position y))) (lambda (x y) (> (note-position x) (note-position y)))))) - (with-suspended-note-offset offset + (score-pane:with-suspended-note-offset offset (setf (final-xposition (car group)) x) (when (eq direction :down) (setf offset (- offset))) (loop for note in (cdr group) @@ -519,7 +533,7 @@ notes-with-accidentals)) (defun compute-final-accidental-positions (notes x final-stem-direction) - (let* ((staff-step (staff-step 1)) + (let* ((staff-step (score-pane:staff-step 1)) (notes (sort (copy-list notes) (lambda (x y) (> (note-position x) (note-position y))))) (notes-with-accidentals (remove-if-not #'final-accidental notes))) @@ -559,7 +573,7 @@ (stem-yoffset (final-stem-yoffset element)) (groups (group-notes-by-staff (notes element)))) (when flags - (with-vertical-score-position (pane stem-yoffset) + (score-pane:with-vertical-score-position (pane stem-yoffset) (draw-flags pane element x direction stem-pos))) (loop for group in groups do (compute-final-xpositions group x direction) @@ -569,12 +583,12 @@ (draw-ledger-lines pane x group)) (unless (eq (notehead element) :whole) (if (eq direction :up) - (draw-right-stem pane x - (+ (staff-step min-pos) min-yoffset) - (+ (staff-step stem-pos) stem-yoffset)) - (draw-left-stem pane x - (+ (staff-step max-pos) max-yoffset) - (+ (staff-step stem-pos) stem-yoffset))))))) + (score-pane:draw-right-stem pane x + (+ (score-pane:staff-step min-pos) min-yoffset) + (+ (score-pane:staff-step stem-pos) stem-yoffset)) + (score-pane:draw-left-stem pane x + (+ (score-pane:staff-step max-pos) max-yoffset) + (+ (score-pane:staff-step stem-pos) stem-yoffset))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -582,7 +596,7 @@ (defmethod draw-element (pane (element rest) x &optional (flags t)) (declare (ignore flags)) - (with-vertical-score-position (pane (staff-yoffset (staff element))) - (draw-rest pane (notehead-duration element) x (staff-pos element)) + (score-pane:with-vertical-score-position (pane (staff-yoffset (staff element))) + (score-pane:draw-rest pane (notehead-duration element) x (staff-pos element)) (draw-dots pane (dots element) x (1+ (staff-pos element))))) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.12 gsharp/gui.lisp:1.13 --- gsharp/gui.lisp:1.12 Sun Jul 18 23:23:53 2004 +++ gsharp/gui.lisp Wed Jul 21 05:42:59 2004 @@ -94,7 +94,7 @@ (defmethod redisplay-gsharp-panes (frame &key force-p) (loop for pane in (frame-current-panes frame) - do (when (typep pane 'score-pane) + do (when (typep pane 'score-pane:score-pane) (redisplay-frame-pane frame pane :force-p force-p)))) (defvar *gsharp-frame*) @@ -102,7 +102,7 @@ (defparameter *kbd-macro-recording-p* nil) (defparameter *kbd-macro-funs* '()) -(defmethod dispatch-event :around ((pane score-pane) (event key-press-event)) +(defmethod dispatch-event :around ((pane score-pane:score-pane) (event key-press-event)) (when (keyboard-event-character event) (let* ((key (list (keyboard-event-character event) (event-modifier-state event))) @@ -126,16 +126,16 @@ (:menu-bar menubar-command-table :height 25) (:pointer-documentation t) (:panes - (score (make-pane 'score-pane + (score (make-pane 'score-pane:score-pane :width 700 :height 900 :name "score" :display-time :no-clear :display-function 'display-score)) - (state (make-pane 'score-pane + (state (make-pane 'score-pane:score-pane :width 50 :height 200 :name "state" :display-function 'display-state)) - (element (make-pane 'score-pane + (element (make-pane 'score-pane:score-pane :width 50 :height 700 :min-height 100 :max-height 20000 :name "element" @@ -161,43 +161,43 @@ (defmethod display-state ((frame gsharp) pane) (let ((state (input-state *gsharp-frame*))) - (with-score-pane pane - (with-staff-size 10 - (with-vertical-score-position (pane 800) + (score-pane:with-score-pane pane + (score-pane:with-staff-size 10 + (score-pane:with-vertical-score-position (pane 800) (let ((xpos 30)) - (draw-notehead pane (notehead state) xpos 4) + (score-pane:draw-notehead pane (notehead state) xpos 4) (when (not (eq (notehead state) :whole)) (when (or (eq (stem-direction state) :auto) (eq (stem-direction state) :down)) (when (eq (notehead state) :filled) - (with-notehead-left-offsets (left down) + (score-pane:with-notehead-left-offsets (left down) (declare (ignore down)) (let ((x (+ xpos left))) (loop repeat (rbeams state) for staff-step from -4 by 2 do - (draw-beam pane x staff-step 0 (+ x 10) staff-step 0)) + (score-pane:draw-beam pane x staff-step 0 (+ x 10) staff-step 0)) (loop repeat (lbeams state) for staff-step from -4 by 2 do - (draw-beam pane (- x 10) staff-step 0 x staff-step 0))))) - (draw-left-stem pane xpos (staff-step 4) (staff-step -4))) + (score-pane:draw-beam pane (- x 10) staff-step 0 x staff-step 0))))) + (score-pane:draw-left-stem pane xpos (score-pane:staff-step 4) (score-pane:staff-step -4))) (when (or (eq (stem-direction state) :auto) (eq (stem-direction state) :up)) (when (eq (notehead state) :filled) - (with-notehead-right-offsets (right up) + (score-pane:with-notehead-right-offsets (right up) (declare (ignore up)) (let ((x (+ xpos right))) (loop repeat (rbeams state) for staff-step downfrom 12 by 2 do - (draw-beam pane x staff-step 0 (+ x 10) staff-step 0)) + (score-pane:draw-beam pane x staff-step 0 (+ x 10) staff-step 0)) (loop repeat (lbeams state) for staff-step downfrom 12 by 2 do - (draw-beam pane (- x 10) staff-step 0 x staff-step 0))))) - (draw-right-stem pane xpos (staff-step 4) (staff-step 12)))) - (with-notehead-right-offsets (right up) + (score-pane:draw-beam pane (- x 10) staff-step 0 x staff-step 0))))) + (score-pane:draw-right-stem pane xpos (score-pane:staff-step 4) (score-pane:staff-step 12)))) + (score-pane:with-notehead-right-offsets (right up) (declare (ignore up)) (loop repeat (dots state) for dx from (+ right 5) by 5 do - (draw-dot pane (+ xpos dx) 4))))))))) + (score-pane:draw-dot pane (+ xpos dx) 4))))))))) (defun draw-the-cursor (pane x) (let* ((state (input-state *gsharp-frame*)) @@ -206,24 +206,24 @@ (clef (clef staff)) (bottom-line (- (ecase (name clef) (:treble 32) (:bass 24) (:c 35)) (lineno clef))) - (lnote-offset (staff-step (- (last-note state) bottom-line)))) + (lnote-offset (score-pane:staff-step (- (last-note state) bottom-line)))) (draw-line* pane - x (+ (staff-step 12) yoffset) - x (+ (staff-step -4) yoffset) + x (+ (score-pane:staff-step 12) yoffset) + x (+ (score-pane:staff-step -4) yoffset) :ink +yellow+) (draw-line* pane - (- x 1) (+ (staff-step -3.4) yoffset lnote-offset) - (- x 1) (+ (staff-step 3.6) yoffset lnote-offset) + (- x 1) (+ (score-pane:staff-step -3.4) yoffset lnote-offset) + (- x 1) (+ (score-pane:staff-step 3.6) yoffset lnote-offset) :ink +red+) (draw-line* pane - (+ x 1) (+ (staff-step -3.4) yoffset lnote-offset) - (+ x 1) (+ (staff-step 3.6) yoffset lnote-offset) + (+ x 1) (+ (score-pane:staff-step -3.4) yoffset lnote-offset) + (+ x 1) (+ (score-pane:staff-step 3.6) yoffset lnote-offset) :ink +red+))) (defmethod display-score ((frame gsharp) pane) (let* ((buffer (buffer frame))) (recompute-measures buffer) - (with-score-pane pane + (score-pane:with-score-pane pane (flet ((draw-cursor (x) (draw-the-cursor pane x))) (draw-buffer pane buffer (cursor *gsharp-frame*) (left-margin buffer) 800 #'draw-cursor))))) @@ -241,9 +241,9 @@ (defmethod display-element ((frame gsharp) pane) (when (handler-case (cur-cluster) (gsharp-condition () nil)) - (with-score-pane pane - (with-staff-size 10 - (with-vertical-score-position (pane 500) + (score-pane:with-score-pane pane + (score-pane:with-staff-size 10 + (score-pane:with-vertical-score-position (pane 500) (let* ((xpos 30) (cluster (cur-cluster)) (notehead (notehead cluster)) @@ -256,9 +256,9 @@ (declare (ignore stem-direction stem-length notehead lbeams rbeams dots)) (loop for note in notes do (draw-ellipse* pane xpos (* 15 (note-position note)) 7 0 0 7) - (draw-accidental pane (accidentals note) - (- xpos (if (oddp (note-position note)) 15 25)) - (* 3 (note-position note)))) + (score-pane:draw-accidental pane (accidentals note) + (- xpos (if (oddp (note-position note)) 15 25)) + (* 3 (note-position note)))) (when notes (draw-ellipse* pane xpos (* 15 (note-position (cur-note))) 7 0 0 7 :ink +red+)) @@ -447,7 +447,7 @@ (define-gsharp-command (com-insert-layer-after :name t) () (let ((cursor (cursor *gsharp-frame*)) - (staff (accept 'staff :prompt "Staff"))) + (staff (accept 'score-pane:staff :prompt "Staff"))) ;;; (staff (find-staff staff-name (buffer *gsharp-frame*)))) (if (not staff) (message "No such staff in buffer~%") @@ -1068,17 +1068,17 @@ (make-fiveline-staff name (make-clef clef line))))))) (define-gsharp-command (com-add-staff-before :name t) () - (add-staff-before-staff (accept 'staff :prompt "Before staff") + (add-staff-before-staff (accept 'score-pane:staff :prompt "Before staff") (acquire-new-staff) (buffer *gsharp-frame*))) (define-gsharp-command (com-add-staff-after :name t) () - (add-staff-after-staff (accept 'staff :prompt "After staff") + (add-staff-after-staff (accept 'score-pane:staff :prompt "After staff") (acquire-new-staff) (buffer *gsharp-frame*))) (define-gsharp-command (com-delete-staff :name t) () - (remove-staff-from-buffer (accept 'staff :prompt "Staff") + (remove-staff-from-buffer (accept 'score-pane:staff :prompt "Staff") (buffer *gsharp-frame*))) (define-gsharp-command (com-rename-staff :name t) ((name 'string)) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.5 gsharp/packages.lisp:1.6 --- gsharp/packages.lisp:1.5 Sun Jul 18 23:23:53 2004 +++ gsharp/packages.lisp Wed Jul 21 05:43:00 2004 @@ -120,8 +120,8 @@ #:128th-rest #:measure-rest #:double-whole-rest)) (defpackage :score-pane - (:use :clim :clim-extensions :clim-lisp :sdl :gsharp-buffer) - (:shadowing-import-from :gsharp-buffer #:rest) + (:use :clim :clim-extensions :clim-lisp :sdl) + (:shadow #:rest) (:export #:draw-staff #:draw-stem #:draw-right-stem #:draw-left-stem #:draw-ledger-line #:draw-bar-line #:draw-beam #:staff-step #:draw-notehead #:draw-accidental #:draw-clef #:draw-rest #:draw-dot @@ -129,7 +129,8 @@ #:with-score-pane #:with-vertical-score-position #:with-staff-size #:with-notehead-right-offsets #:with-suspended-note-offset - #:with-notehead-left-offsets #:with-light-glyphs #:score-pane )) + #:with-notehead-left-offsets #:with-light-glyphs #:score-pane + #:clef #:staff #:notehead)) (defpackage :gsharp-beaming (:use :common-lisp) @@ -163,7 +164,7 @@ (defpackage :gsharp-drawing (:use :clim :clim-lisp :gsharp-buffer :gsharp-measure :gsharp-cursor - :gsharp-utilities :sdl :score-pane :gsharp-beaming :obseq) + :gsharp-utilities :sdl :gsharp-beaming :obseq) (:shadowing-import-from :gsharp-buffer #:rest) (:export #:draw-buffer)) @@ -185,7 +186,7 @@ (defpackage :gsharp (:use :clim :clim-lisp :gsharp-buffer :gsharp-cursor :gsharp-drawing :gsharp-numbering - :gsharp-measure :score-pane :sdl :midi) + :gsharp-measure :sdl :midi) (:shadowing-import-from :gsharp-numbering #:number) (:shadowing-import-from :gsharp-buffer #:rest)) Index: gsharp/score-pane.lisp diff -u gsharp/score-pane.lisp:1.4 gsharp/score-pane.lisp:1.5 --- gsharp/score-pane.lisp:1.4 Wed Jul 14 11:07:33 2004 +++ gsharp/score-pane.lisp Wed Jul 21 05:43:00 2004 @@ -1,5 +1,7 @@ (in-package :score-pane) +(defclass score-view (view) ()) + (defclass score-pane (application-pane) ((pixmaps :initform (make-hash-table :test #'eq) :reader pane-pixmaps) (darker-gray-progressions :initform (make-array 10 :initial-element nil :adjustable t) @@ -7,6 +9,10 @@ (lighter-gray-progressions :initform (make-array 10 :initial-element nil :adjustable t) :reader lighter-gray-progressions))) +(defmethod initialize-instance :after ((pane score-pane) &rest args) + (declare (ignore args)) + (setf (stream-default-view pane) (make-instance 'score-view))) + (defmethod dispatch-event :before ((pane score-pane) (event pointer-enter-event)) (let ((port (port pane))) (setf (port-keyboard-input-focus port) pane))) @@ -233,6 +239,13 @@ (:half +glyph-half+) (:filled +glyph-filled+))) +(define-presentation-type notehead () :options (name x staff-step)) + +(define-presentation-method present + (object (type notehead) stream (view score-view) &key) + (with-output-as-presentation (stream object 'notehead) + (draw-notehead stream name x staff-step))) + ;;;;;;;;;;;;;;;;;; accidental (define-pixmap-recording (accidental-output-record medium-draw-accidental draw-accidental (name)) @@ -251,6 +264,13 @@ (:bass +glyph-f-clef+) (:c +glyph-c-clef+))) +(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))) + ;;;;;;;;;;;;;;;;;; rest (define-pixmap-recording (rest-output-record medium-draw-rest draw-rest (duration)) @@ -323,18 +343,6 @@ (y2 (+ (staff-step staff-step) up))) (medium-draw-staff-line pane x1 y1 x2 y2)))) -(defclass staff-line () - ((x1 :initarg :x1) - (staff-step :initarg :staff-step) - (x2 :initarg :x2))) - -(define-presentation-type staff-line ()) - -(define-presentation-method present (line (type staff-line) stream view &key) - (declare (ignore view)) - (with-slots (x1 staff-step x2) line - (draw-staff-line stream x1 staff-step x2))) - (defclass staff-output-record (output-record) ((parent :initarg :parent :initform nil :accessor output-record-parent) (x :initarg :x1 :initarg :x-position) @@ -407,16 +415,18 @@ (loop for staff-line in (slot-value record 'staff-lines) do (replay-output-record staff-line stream region x-offset y-offset))) -(define-presentation-method present - (staff (type staff) stream (view textual-view) &key) - (format stream "[staff ~a]" (name staff))) +(define-presentation-type staff () :options (x1 x2)) + +(defun draw-staff (pane x1 x2) + (multiple-value-bind (left right) (bar-line-offsets *font*) + (loop for staff-step from 0 by 2 + repeat 5 + do (draw-staff-line pane (+ x1 left) staff-step (+ x2 right))))) -(defun draw-staff (staff pane x1 x2) - (with-output-as-presentation (pane staff 'staff) - (multiple-value-bind (left right) (bar-line-offsets *font*) - (loop for staff-step from 0 by 2 - repeat 5 - do (draw-staff-line pane (+ x1 left) staff-step (+ x2 right)))))) +(define-presentation-method present + (object (type staff) stream (view score-view) &key) + (with-output-as-presentation (stream object 'staff) + (draw-staff stream x1 x2))) ;;;;;;;;;;;;;;;;;; stem