[gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/gui.lisp gsharp/packages.lisp
Robert Strandh
rstrandh at common-lisp.net
Thu Dec 1 01:54:12 UTC 2005
Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv12638
Modified Files:
drawing.lisp gui.lisp packages.lisp
Log Message:
Removed the cursor-drawing code from the score-drawing functions. Instead
we now store the x and y positions and the width of each bar. Cursor
drawing is now implemented as looking up those stored values and draing
the cursor based on them.
Date: Thu Dec 1 02:54:11 2005
Author: rstrandh
Index: gsharp/drawing.lisp
diff -u gsharp/drawing.lisp:1.42 gsharp/drawing.lisp:1.43
--- gsharp/drawing.lisp:1.42 Wed Nov 30 23:23:51 2005
+++ gsharp/drawing.lisp Thu Dec 1 02:54:10 2005
@@ -1,5 +1,14 @@
(in-package :gsharp-drawing)
+(define-added-mixin dbar () bar
+ (;; indicates the absolute y position of the system to which the
+ ;; bar belongs
+ (system-y-position :accessor system-y-position)
+ ;; the absolute x position of the bar
+ (final-absolute-bar-xoffset :accessor final-absolute-bar-xoffset)
+ ;;
+ (final-width :accessor final-width)))
+
(define-added-mixin dmeasure () measure
(;; an elasticity function that describes how the space right after
;; the initial barline of the measure behaves as a function of the
@@ -285,7 +294,7 @@
;;; eventually remove the existing draw-measure and rename this
;;; to draw-measure
-(defun new-draw-measure (pane measure x force draw-cursor)
+(defun new-draw-measure (pane measure x force)
(loop with timelines = (timelines measure)
for i from 0 below (flexichain:nb-elements timelines)
for timeline = (flexichain:element* timelines i)
@@ -296,10 +305,10 @@
do (setf (final-absolute-element-xoffset element) xx)))
(loop for bar in (measure-bars measure)
do (if (gsharp-cursor::cursors (slice bar))
- (new-draw-bar pane bar draw-cursor)
- (score-pane:with-light-glyphs pane (new-draw-bar pane bar draw-cursor)))))
+ (new-draw-bar pane bar)
+ (score-pane:with-light-glyphs pane (new-draw-bar pane bar)))))
-(defun draw-measure (pane measure min-dist compress x y method draw-cursor)
+(defun draw-measure (pane measure min-dist compress x y method)
(let* ((width (/ (nat-width method (measure-coeff measure) min-dist)
compress))
(time-alist (cons (cons 0 (/ (min-width method) compress))
@@ -316,32 +325,32 @@
compress))))))
(loop for bar in (measure-bars measure) do
(if (gsharp-cursor::cursors (slice bar))
- (draw-bar pane bar x y width time-alist draw-cursor)
- (score-pane:with-light-glyphs pane (draw-bar pane bar x y width time-alist draw-cursor))))))
+ (draw-bar pane bar x y width time-alist)
+ (score-pane:with-light-glyphs pane (draw-bar pane bar x y width time-alist))))))
;;; eventually remove the existing draw-system and rename this
;;; to draw-system
-(defun new-draw-system (pane measures x force staves draw-cursor)
+(defun new-draw-system (pane measures x force staves)
(loop for measure in measures
- do (new-draw-measure pane measure x force draw-cursor)
+ do (new-draw-measure pane measure x force)
do (incf x (size-at-force (elasticity-function measure) force))
do (score-pane:draw-bar-line pane x
(- (score-pane:staff-step 8))
(staff-yoffset (car (last staves))))))
-(defun draw-system (pane measures x y widths method staves draw-cursor)
+(defun draw-system (pane measures x y widths method staves)
(let ((compress (compute-compress-factor measures method))
(min-dist (compute-min-dist measures)))
(loop for measure in measures
for width in widths do
- (draw-measure pane measure min-dist compress x y method draw-cursor)
+ (draw-measure pane measure min-dist compress x y method)
(incf x width)
(score-pane:draw-bar-line pane x
(+ y (- (score-pane:staff-step 8)))
(+ y (staff-yoffset (car (last staves))))))))
-(defmethod draw-buffer (pane (buffer buffer) *cursor* x y draw-cursor)
+(defmethod draw-buffer (pane (buffer buffer) *cursor* x y)
(score-pane:with-staff-size 6
(let* ((staves (staves buffer))
(timesig-offset (max (* (score-pane:staff-step 2)
@@ -381,7 +390,7 @@
(let ((widths (compute-widths measures method)))
(draw-system pane measures
(+ x (left-offset buffer) timesig-offset) yy
- widths method staves draw-cursor)
+ widths method staves)
(score-pane:draw-bar-line pane x
(+ yy (- (score-pane:staff-step 8)))
(+ yy (staff-yoffset (car (last staves)))))
@@ -564,44 +573,73 @@
(loop for element in elements do
(draw-element pane element (final-absolute-element-xoffset element) nil))))))
-(defun draw-cursor (pane x)
- (draw-line* pane x (- (score-pane:staff-step -4)) x (- (score-pane:staff-step 12)) :ink +red+))
+(defgeneric new-draw-bar (pane bar))
-(defgeneric new-draw-bar (pane bar draw-cursor))
+(defun draw-the-cursor (pane cursor-element last-note)
+ (let* ((cursor (cursor *application-frame*))
+ (staff (car (staves (layer cursor))))
+ (bar (bar cursor)))
+ (flet ((draw-cursor (x)
+ (let* ((sy (system-y-position bar))
+ ;; Why (- STAFF-YOFFSET)? dunno. -- CSR, 2005-10-28
+ (yoffset (- (gsharp-drawing::staff-yoffset staff))))
+ (if (typep staff 'fiveline-staff)
+ (let* ((clef (clef staff))
+ (bottom-line (- (ecase (name clef) (:treble 32) (:bass 24) (:c 35))
+ (lineno clef)))
+ (lnote-offset (score-pane:staff-step (- last-note bottom-line))))
+ (draw-line* pane
+ x (+ sy (- (+ (score-pane:staff-step 12) yoffset)))
+ x (+ sy (- (+ (score-pane:staff-step -4) yoffset)))
+ :ink +yellow+)
+ (draw-line* pane
+ (- x 1) (+ sy (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset)))
+ (- x 1) (+ sy (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset)))
+ :ink +red+)
+ (draw-line* pane
+ (+ x 1) (+ sy (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset)))
+ (+ x 1) (+ sy (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset)))
+ :ink +red+))
+ (progn (draw-line* pane
+ (+ x 1) (+ sy (- (+ (score-pane:staff-step 2) yoffset)))
+ (+ x 1) (+ sy (- (+ (score-pane:staff-step -2) yoffset)))
+ :ink +red+)
+ (draw-line* pane
+ (- x 1) (+ sy (- (+ (score-pane:staff-step 2) yoffset)))
+ (- x 1) (+ sy (- (+ (score-pane:staff-step -2) yoffset)))
+ :ink +red+))))))
+ (score-pane:with-staff-size 6
+ (let* ((x (final-absolute-bar-xoffset bar))
+ (width (final-width bar))
+ (elements (elements bar)))
+ (if (null cursor-element)
+ (draw-cursor (/ (+ (if (null elements)
+ x
+ (final-absolute-element-xoffset (car (last elements))))
+ x width) 2))
+ (loop for element in elements
+ and xx = x then (final-absolute-element-xoffset element) do
+ (when (eq element cursor-element)
+ (draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2))))))))))
-(defmethod draw-bar (pane (bar melody-bar) x y width time-alist draw-cursor)
+(defmethod draw-bar (pane (bar melody-bar) x y width time-alist)
(compute-element-x-positions bar x time-alist)
+ (setf (system-y-position bar) y
+ (final-absolute-bar-xoffset bar) x
+ (final-width bar) width)
(score-pane:with-vertical-score-position (pane y)
(loop for group in (beam-groups (elements bar))
- do (draw-beam-group pane group))
- (when (eq (cursor-bar *cursor*) bar)
- (let ((elements (elements bar)))
- (if (null (cursor-element *cursor*))
- (funcall draw-cursor (/ (+ (if (null elements)
- x
- (final-absolute-element-xoffset (car (last elements))))
- x width) 2))
- (loop for element in elements
- and xx = x then (final-absolute-element-xoffset element) do
- (when (eq (cursor-element *cursor*) element)
- (funcall draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2)))))))))
+ do (draw-beam-group pane group))))
-(defmethod draw-bar (pane (bar lyrics-bar) x y width time-alist draw-cursor)
+(defmethod draw-bar (pane (bar lyrics-bar) x y width time-alist)
(compute-element-x-positions bar x time-alist)
+ (setf (system-y-position bar) y
+ (final-absolute-bar-xoffset bar) x
+ (final-width bar) width)
(score-pane:with-vertical-score-position (pane y)
(let ((elements (elements bar)))
(loop for element in elements
- do (draw-element pane element (final-absolute-element-xoffset element)))
- (when (eq (cursor-bar *cursor*) bar)
- (if (null (cursor-element *cursor*))
- (funcall draw-cursor (/ (+ (if (null elements)
- x
- (final-absolute-element-xoffset (car (last elements))))
- x width) 2))
- (loop for element in elements
- and xx = x then (final-absolute-element-xoffset element) do
- (when (eq (cursor-element *cursor*) element)
- (funcall draw-cursor (/ (+ xx (final-absolute-element-xoffset element)) 2)))))))))
+ do (draw-element pane element (final-absolute-element-xoffset element))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.46 gsharp/gui.lisp:1.47
--- gsharp/gui.lisp:1.46 Thu Dec 1 01:19:39 2005
+++ gsharp/gui.lisp Thu Dec 1 02:54:10 2005
@@ -103,44 +103,13 @@
for dx from (+ right 5) by 5 do
(score-pane:draw-dot pane (+ xpos dx) 4)))))))))
-(defun draw-the-cursor (pane x)
- (let* ((state (input-state *application-frame*))
- (staff (car (staves (layer (cursor *application-frame*)))))
- ;; Why (- STAFF-YOFFSET)? dunno. -- CSR, 2005-10-28
- (yoffset (- (gsharp-drawing::staff-yoffset staff))))
- (if (typep staff 'fiveline-staff)
- (let* ((clef (clef staff))
- (bottom-line (- (ecase (name clef) (:treble 32) (:bass 24) (:c 35))
- (lineno clef)))
- (lnote-offset (score-pane:staff-step (- (last-note state) bottom-line))))
- (draw-line* pane
- x (- (+ (score-pane:staff-step 12) yoffset))
- x (- (+ (score-pane:staff-step -4) yoffset))
- :ink +yellow+)
- (draw-line* pane
- (- 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) (- (+ (score-pane:staff-step -3.4) yoffset lnote-offset))
- (+ x 1) (- (+ (score-pane:staff-step 3.6) yoffset lnote-offset))
- :ink +red+))
- (progn (draw-line* pane
- (+ x 1) (- (+ (score-pane:staff-step 2) yoffset))
- (+ x 1) (- (+ (score-pane:staff-step -2) yoffset))
- :ink +red+)
- (draw-line* pane
- (- x 1) (- (+ (score-pane:staff-step 2) yoffset))
- (- x 1) (- (+ (score-pane:staff-step -2) yoffset))
- :ink +red+)))))
-
(defmethod display-score ((frame gsharp) pane)
(let* ((buffer (buffer frame)))
(recompute-measures buffer)
(score-pane:with-score-pane pane
- (flet ((draw-cursor (x) (draw-the-cursor pane x)))
- (draw-buffer pane buffer (cursor *application-frame*)
- (left-margin buffer) 100 #'draw-cursor)))))
+ (draw-buffer pane buffer (cursor *application-frame*)
+ (left-margin buffer) 100)
+ (gsharp-drawing::draw-the-cursor pane (cursor-element (cursor *application-frame*)) (last-note (input-state *application-frame*))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.36 gsharp/packages.lisp:1.37
--- gsharp/packages.lisp:1.36 Tue Nov 29 20:37:40 2005
+++ gsharp/packages.lisp Thu Dec 1 02:54:10 2005
@@ -196,7 +196,7 @@
(:use :clim :clim-lisp :gsharp-buffer :gsharp-measure :gsharp-cursor
:gsharp-utilities :sdl :gsharp-beaming :obseq)
(:shadowing-import-from :gsharp-buffer #:rest)
- (:export #:draw-buffer))
+ (:export #:draw-buffer #:draw-the-cursor))
(defpackage :midi
(:use :common-lisp)
More information about the Gsharp-cvs
mailing list