[gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/gsharp.asd gsharp/measure.lisp gsharp/packages.lisp
Robert Strandh
rstrandh at common-lisp.net
Mon Nov 21 20:37:46 UTC 2005
Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv20469
Modified Files:
drawing.lisp gsharp.asd measure.lisp packages.lisp
Log Message:
moved the computation of relative x offsets of notes from drawing.lisp
to measure.lisp. This required some reorganization of packages.lisp and
gsharp.asd as well.
Date: Mon Nov 21 21:37:45 2005
Author: rstrandh
Index: gsharp/drawing.lisp
diff -u gsharp/drawing.lisp:1.31 gsharp/drawing.lisp:1.32
--- gsharp/drawing.lisp:1.31 Mon Nov 21 03:11:08 2005
+++ gsharp/drawing.lisp Mon Nov 21 21:37:45 2005
@@ -4,9 +4,7 @@
((yoffset :initform 0 :accessor staff-yoffset)))
(define-added-mixin dnote () note
- (;; the relative x offset of the note with respect to the cluster
- (final-relative-note-xoffset :accessor final-relative-note-xoffset)
- (final-accidental :initform nil :accessor final-accidental)
+ ((final-accidental :initform nil :accessor final-accidental)
;; The relative x offset of the accidental of the note with respect
;; to the cluster. A value of nil indicates that accidental has
;; not been placed yet
@@ -433,36 +431,6 @@
(loop for note in notes do
(draw-note pane note notehead dots (final-absolute-note-xoffset note) (note-position note))))
-;;; given a group of notes (i.e. a list of notes, all displayed on the
-;;; same staff, compute their final x offsets. This is a question of
-;;; determining whether the note goes to the right or to the left of
-;;; the stem. The head-note of the stem goes to the left of an
-;;; up-stem and to the right of a down-stem. The x offset of a cluster
-;;; gives the x position of the head-note.
-(defun compute-final-relative-note-xoffsets (group direction)
- (setf group (sort (copy-list group)
- (if (eq direction :up)
- (lambda (x y) (< (note-position x) (note-position y)))
- (lambda (x y) (> (note-position x) (note-position y))))))
- (score-pane:with-suspended-note-offset offset
- ;; the first element of the group is the head-note
- (setf (final-relative-note-xoffset (car group)) 0)
- ;; OFFSET is a positive quantity that determines the
- ;; absolute difference between the x offset of a suspended
- ;; note and that of a normally positioned note.
- (when (eq direction :down) (setf offset (- offset)))
- (loop for note in (cdr group)
- and old-note = (car group) then note
- do (let* ((pos (note-position note))
- (old-pos (note-position old-note))
- ;; if adjacent notes are just one staff step apart,
- ;; then one must be suspended.
- (dx (if (= (abs (- pos old-pos)) 1) offset 0)))
- (setf (final-relative-note-xoffset note) dx)
- ;; go back to ordinary offset
- (when (= (abs (- pos old-pos)) 1)
- (setf note old-note))))))
-
;;; Given a list of notes to be displayed on the same staff line, for
;;; each note, compute the accidental to be displayed as a function of
;;; the accidentals of the note and the key signature of the staff.
@@ -610,15 +578,6 @@
(setf (final-relative-accidental-xoffset choice)
(accidental-min-xoffset choice notes staff-step))))))
-;;; given a list of notes, group them so that every note in the group
-;;; is displayed on the same staff. Return the list of groups.
-(defun group-notes-by-staff (notes)
- (let ((groups '()))
- (loop while notes do
- (push (remove (staff (car notes)) notes :test-not #'eq :key #'staff) groups)
- (setf notes (remove (staff (car notes)) notes :test #'eq :key #'staff)))
- groups))
-
;;; draw a cluster. The stem direction and the stem position have
;;; already been computed.
;;; 1. Group notes by staff.
@@ -639,7 +598,6 @@
(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-relative-note-xoffsets group direction)
(compute-final-accidentals group)
(compute-final-relative-accidental-xoffset group x direction)
(draw-notes pane group (dots element) (notehead element))
Index: gsharp/gsharp.asd
diff -u gsharp/gsharp.asd:1.1 gsharp/gsharp.asd:1.2
--- gsharp/gsharp.asd:1.1 Tue Nov 1 18:19:51 2005
+++ gsharp/gsharp.asd Mon Nov 21 21:37:45 2005
@@ -27,13 +27,13 @@
"gf"
"sdl"
"charmap"
+ "score-pane"
"buffer"
"numbering"
"Obseq/obseq"
"measure"
"postscript"
"glyphs"
- "score-pane"
"beaming"
"drawing"
"cursor"
Index: gsharp/measure.lisp
diff -u gsharp/measure.lisp:1.11 gsharp/measure.lisp:1.12
--- gsharp/measure.lisp:1.11 Mon Nov 21 03:11:08 2005
+++ gsharp/measure.lisp Mon Nov 21 21:37:45 2005
@@ -18,7 +18,17 @@
;;; Note
(defrclass rnote note
- ())
+ (;; the relative x offset of the note with respect to the cluster
+ (final-relative-note-xoffset :accessor final-relative-note-xoffset)))
+
+;;; given a list of notes, group them so that every note in the group
+;;; is displayed on the same staff. Return the list of groups.
+(defun group-notes-by-staff (notes)
+ (let ((groups '()))
+ (loop while notes do
+ (push (remove (staff (car notes)) notes :test-not #'eq :key #'staff) groups)
+ (setf notes (remove (staff (car notes)) notes :test #'eq :key #'staff)))
+ groups))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -342,6 +352,39 @@
(append (merge 'list (butlast bar1) (butlast bar2) #'<)
(list (max (car (last bar1)) (car (last bar2))))))
+;;; given a group of notes (i.e. a list of notes, all displayed on the
+;;; same staff, compute their final x offsets. This is a question of
+;;; determining whether the note goes to the right or to the left of
+;;; the stem. The head-note of the stem goes to the left of an
+;;; up-stem and to the right of a down-stem. The x offset of a cluster
+;;; gives the x position of the head-note.
+(defun compute-final-relative-note-xoffsets (group direction)
+ (setf group (sort (copy-list group)
+ (if (eq direction :up)
+ (lambda (x y) (< (note-position x) (note-position y)))
+ (lambda (x y) (> (note-position x) (note-position y))))))
+ (score-pane:with-suspended-note-offset offset
+ ;; the first element of the group is the head-note
+ (setf (final-relative-note-xoffset (car group)) 0)
+ ;; OFFSET is a positive quantity that determines the
+ ;; absolute difference between the x offset of a suspended
+ ;; note and that of a normally positioned note.
+ (when (eq direction :down) (setf offset (- offset)))
+ (loop for note in (cdr group)
+ and old-note = (car group) then note
+ do (let* ((pos (note-position note))
+ (old-pos (note-position old-note))
+ ;; if adjacent notes are just one staff step apart,
+ ;; then one must be suspended.
+ (dx (if (= (abs (- pos old-pos)) 1) offset 0)))
+ (setf (final-relative-note-xoffset note) dx)
+ ;; go back to ordinary offset
+ (when (= (abs (- pos old-pos)) 1)
+ (setf note old-note))))))
+
+(defun compute-staff-group-parameters (staff-group stem-direction)
+ (compute-final-relative-note-xoffsets staff-group stem-direction))
+
;;; compute some important parameters of an element
(defgeneric compute-element-parameters (element))
@@ -350,20 +393,26 @@
(defmethod compute-element-parameters ((element cluster))
(when (non-empty-cluster-p element)
- (compute-top-bot-pos element)))
+ (compute-top-bot-pos element)
+ (loop for staff-group in (group-notes-by-staff (notes element))
+ do (compute-staff-group-parameters staff-group (final-stem-direction element)))))
(defun compute-beam-group-parameters (elements)
(let ((any-element-modified nil))
(loop for element in elements
do (when (modified-p element)
- (compute-element-parameters element)
- (setf any-element-modified t)
- (setf (modified-p element) nil)))
+ (when (non-empty-cluster-p element)
+ (compute-top-bot-pos element))
+ (setf any-element-modified t)))
(when any-element-modified
(if (null (cdr elements))
(when (non-empty-cluster-p (car elements))
(compute-final-stem-direction (car elements)))
- (compute-final-stem-directions elements)))))
+ (compute-final-stem-directions elements)))
+ (loop for element in elements
+ do (when (modified-p element)
+ (compute-element-parameters element)
+ (setf (modified-p element) nil)))))
;;; Given a list of the elements of a bar, return a list of beam
;;; groups. A beam group is defined to be either a singleton list or
@@ -416,18 +465,19 @@
;;; to indicate the position of the measure in the sequence of all
;;; measures of the buffer.
(defun compute-measure (bars spacing-style seg-pos bar-pos)
- (loop for bar in bars
- do (when (modified-p bar)
- (compute-bar-parameters bar)
- (setf (modified-p bar) nil)))
- (let* ((start-times (remove-duplicates
- (reduce #'combine-bars
- (mapcar #'start-times bars))))
- (durations (abs-rel start-times))
- (min-dist (reduce #'min durations))
- (coeff (loop for duration in durations
- sum (expt duration spacing-style))))
- (make-measure min-dist coeff start-times seg-pos bar-pos bars)))
+ (score-pane:with-staff-size 6
+ (loop for bar in bars
+ do (when (modified-p bar)
+ (compute-bar-parameters bar)
+ (setf (modified-p bar) nil)))
+ (let* ((start-times (remove-duplicates
+ (reduce #'combine-bars
+ (mapcar #'start-times bars))))
+ (durations (abs-rel start-times))
+ (min-dist (reduce #'min durations))
+ (coeff (loop for duration in durations
+ sum (expt duration spacing-style))))
+ (make-measure min-dist coeff start-times seg-pos bar-pos bars))))
;;; Compute all the measures of a segment by stepping through all the
;;; bars in parallel as long as there is at least one simultaneous bar.
Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.31 gsharp/packages.lisp:1.32
--- gsharp/packages.lisp:1.31 Mon Nov 21 03:11:08 2005
+++ gsharp/packages.lisp Mon Nov 21 21:37:45 2005
@@ -1,3 +1,16 @@
+(defpackage :esa
+ (:use :clim-lisp :clim)
+ (:export #:minibuffer-pane #:display-message
+ #:esa-pane-mixin #:previous-command
+ #:info-pane #:master-pane
+ #:esa-frame-mixin #:windows #:recordingp #:executingp
+ #:*numeric-argument-p* #:*current-gesture*
+ #:esa-top-level #:simple-command-loop
+ #:global-esa-table #:keyboard-macro-table
+ #:help-table
+ #:set-key
+ #:find-applicable-command-table))
+
(defpackage :gsharp-utilities
(:shadow built-in-class)
(:use :clim-lisp :clim-mop)
@@ -33,6 +46,20 @@
#:+glyph-flags-up-two+ #:+glyph-flags-up-three+ #:+glyph-flags-up-four+
#:+glyph-flags-up-five+))
+(defpackage :score-pane
+ (:use :clim :clim-extensions :clim-lisp :sdl :esa)
+ (:shadow #:rest)
+ (:export #:draw-fiveline-staff #:draw-lyrics-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
+ #:draw-flags-up #:draw-flags-down
+ #: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
+ #:clef #:staff #:fiveline-staff #:lyrics-staff #:notehead))
+
(defpackage :gsharp-buffer
(:use :common-lisp :gsharp-utilities)
(:shadow #:rest)
@@ -104,7 +131,8 @@
#:measure-seq-cost
#:note-position #:non-empty-cluster-p
#:top-note #:bot-note #:top-note-pos #:bot-note-pos
- #:beam-groups #:final-stem-direction))
+ #:beam-groups #:final-stem-direction
+ #:group-notes-by-staff #:final-relative-note-xoffset))
(defpackage :gsharp-postscript
(:use :clim :clim-lisp)
@@ -131,33 +159,6 @@
#:8th-flag-down #:extend-flag-down #:whole-rest #:half-rest
#:quarter-rest #:8th-rest #:16th-rest #:32nd-rest #:64th-rest
#:128th-rest #:measure-rest #:double-whole-rest))
-
-(defpackage :esa
- (:use :clim-lisp :clim)
- (:export #:minibuffer-pane #:display-message
- #:esa-pane-mixin #:previous-command
- #:info-pane #:master-pane
- #:esa-frame-mixin #:windows #:recordingp #:executingp
- #:*numeric-argument-p* #:*current-gesture*
- #:esa-top-level #:simple-command-loop
- #:global-esa-table #:keyboard-macro-table
- #:help-table
- #:set-key
- #:find-applicable-command-table))
-
-(defpackage :score-pane
- (:use :clim :clim-extensions :clim-lisp :sdl :esa)
- (:shadow #:rest)
- (:export #:draw-fiveline-staff #:draw-lyrics-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
- #:draw-flags-up #:draw-flags-down
- #: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
- #:clef #:staff #:fiveline-staff #:lyrics-staff #:notehead))
(defpackage :gsharp-beaming
(:use :common-lisp)
More information about the Gsharp-cvs
mailing list