[gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/gui.lisp gsharp/packages.lisp gsharp/score-pane.lisp
Robert Strandh
rstrandh at common-lisp.net
Wed Jul 21 12:43:00 UTC 2004
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
More information about the Gsharp-cvs
mailing list