From rstrandh at common-lisp.net Wed Mar 1 00:15:42 2006 From: rstrandh at common-lisp.net (rstrandh) Date: Tue, 28 Feb 2006 19:15:42 -0500 (EST) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20060301001542.9F3F3690E9@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv12558 Modified Files: gui.lisp packages.lisp Log Message: Make rotate-notehead work again for rests. (thanks to Christophe Rhodes). --- /project/gsharp/cvsroot/gsharp/gui.lisp 2006/02/15 17:46:52 1.56 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2006/03/01 00:15:42 1.57 @@ -14,6 +14,8 @@ (define-command-table total-melody-table :inherit-from (melody-table global-gsharp-table gsharp)) +(define-command-table total-rhythmic-melody-table + :inherit-from (melody-table rhythmic-table global-gsharp-table gsharp)) (define-command-table total-cluster-table :inherit-from (cluster-table melody-table global-gsharp-table gsharp)) (define-command-table total-lyrics-table @@ -368,6 +370,9 @@ (declare (ignore element)) (find-command-table 'total-melody-table)) +(defmethod find-applicable-gsharp-command-table ((layer melody-layer) (element rhythmic-element)) + (find-command-table 'total-rhythmic-melody-table)) + (defmethod find-applicable-gsharp-command-table ((layer melody-layer) (element cluster)) (find-command-table 'total-cluster-table)) --- /project/gsharp/cvsroot/gsharp/packages.lisp 2006/02/26 22:18:39 1.46 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2006/03/01 00:15:42 1.47 @@ -169,7 +169,7 @@ #:pitch #:accidentals #:dots #:note #:make-note #:note-less #:note-equal #:bar #:notehead #:rbeams #:lbeams #:dots #:element - #:melody-element #:notes + #:melody-element #:rhythmic-element #:notes #:add-note #:find-note #:remove-note #:cluster-upper-bound #:cluster-lower-bound #:cluster #:make-cluster From rstrandh at common-lisp.net Thu Mar 2 03:27:33 2006 From: rstrandh at common-lisp.net (rstrandh) Date: Wed, 1 Mar 2006 22:27:33 -0500 (EST) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20060302032733.94CDF681E1@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv18807 Modified Files: drawing.lisp Log Message: Ties in unselected layers are now drawn in gray color. Ties are now drawn before measure bars as they should. --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/02/26 22:18:39 1.63 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/03/02 03:27:33 1.64 @@ -321,6 +321,7 @@ do (compute-measure-coordinates measure x y force) do (incf x (size-at-force (elasticity-function measure) force)))) + ;;; draw the ties in BARS starting at BAR and at most LENGTH bars (defun draw-ties (pane bars bar length) (loop until (eq bar (car bars)) @@ -344,14 +345,17 @@ (x2 (- (final-absolute-note-xoffset n2) (score-pane:staff-step 1.5))) (pos (note-position n1))) (score-pane:with-vertical-score-position (pane (staff-yoffset (staff n1))) - (score-pane:draw-tie-up pane x1 x2 (if (oddp pos) (1+ pos) pos)))))))))))) + (if (gsharp-cursor::cursors (slice (car bars))) + (score-pane:draw-tie-up pane x1 x2 (if (oddp pos) (1+ pos) pos)) + (score-pane:with-light-glyphs pane + (score-pane:draw-tie-up pane x1 x2 (if (oddp pos) (1+ pos) pos)))))))))))))) (defun draw-system (pane measures) - (loop for measure in measures do - (draw-measure pane measure)) (loop with length = (length measures) for bar in (measure-bars (car measures)) - do (draw-ties pane (bars (slice bar)) bar length))) + do (draw-ties pane (bars (slice bar)) bar length)) + (loop for measure in measures do + (draw-measure pane measure))) (defmethod draw-buffer (pane (buffer buffer) *cursor* x y) (score-pane:with-staff-size 6 From crhodes at common-lisp.net Thu Mar 2 09:21:34 2006 From: crhodes at common-lisp.net (crhodes) Date: Thu, 2 Mar 2006 04:21:34 -0500 (EST) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20060302092134.7DAD67C00D@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv31804 Modified Files: buffer.lisp drawing.lisp gui.lisp measure.lisp packages.lisp score-pane.lisp Log Message: Implement octaviated treble clefs. This isn't terribly general, I concede; the clef protocol might need to be rethought. However, it does capture functionality which was previously expressed in multiple places in the functions B-POSITION, F-POSITION and BOTTOM-LINE. --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2006/02/28 23:42:12 1.35 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2006/03/02 09:21:34 1.36 @@ -43,21 +43,29 @@ ;;; The bottom line of the staff is number 1. (defgeneric lineno (clef)) +;;; for key signature drawing calcluations. FIXME: in fact the layout +;;; of key signatures isn't the same across all clefs. +(defgeneric b-position (clef)) +(defgeneric f-position (clef)) + +;;; the note number of the bottom line of this clef. +(defgeneric bottom-line (clef)) + (defclass clef (gsharp-object name-mixin) ((print-character :allocation :class :initform #\K) (lineno :reader lineno :initarg :lineno :type (or (integer 2 6) null)))) (defun make-clef (name &key lineno) - (declare (type (member :treble :bass :c :percussion) name) + (declare (type (member :treble :treble8 :bass :c :percussion) name) (type (or (integer 2 6) null) lineno)) (when (null lineno) (setf lineno (ecase name - (:treble 2) - (:bass 6) - (:c 4) - (:percussion 3)))) + ((:treble :treble8) 2) + (:bass 6) + (:c 4) + (:percussion 3)))) (make-instance 'clef :name name :lineno lineno)) (defmethod print-gsharp-object :after ((c clef) stream) @@ -71,6 +79,26 @@ #'read-clef-v3 *gsharp-readtable-v3*) +(defmethod b-position ((clef clef)) + (ecase (name clef) + (:bass (- (lineno clef) 4)) + ((:treble :treble8) (+ (lineno clef) 2)) + (:c (- (lineno clef) 1)))) + +(defmethod f-position ((clef clef)) + (ecase (name clef) + (:bass (lineno clef)) + ((:treble :treble8) (+ (lineno clef) 6)) + (:c (+ (lineno clef) 3)))) + +(defmethod bottom-line ((clef clef)) + (- (ecase (name clef) + (:treble 32) + (:bass 24) + (:c 28) + (:treble8 25)) + (lineno clef))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Staff --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/03/02 03:27:33 1.64 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/03/02 09:21:34 1.65 @@ -40,19 +40,13 @@ :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))))) + (let ((yoffset (b-position clef))) (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 (score-pane:staff-step 8)) by (score-pane:staff-step 2) while (eq (aref (alterations (keysig staff)) pitch) :flat) 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))))) + (let ((yoffset (f-position clef))) (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 (score-pane:staff-step 8)) by (score-pane:staff-step 2.5) @@ -639,8 +633,7 @@ (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 28)) - (lineno clef))) + (bottom-line (bottom-line clef)) (lnote-offset (score-pane:staff-step (- last-note bottom-line)))) (draw-line* pane x (+ sy (- (+ (score-pane:staff-step 12) yoffset))) --- /project/gsharp/cvsroot/gsharp/gui.lisp 2006/03/01 00:15:42 1.57 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2006/03/02 09:21:34 1.58 @@ -175,9 +175,8 @@ (defmethod note-position ((note note)) (let ((clef (clef (staff note)))) - (+ (- (pitch note) - (ecase (name clef) (:treble 32) (:bass 24) (:c 28))) - (lineno clef)))) + (- (pitch note) + (bottom-line clef)))) (defmethod display-element ((frame gsharp) pane) (when (handler-case (cur-cluster) @@ -1015,7 +1014,7 @@ (lambda (so-far mode) (complete-from-possibilities so-far - '(:treble :bass :c :percussion) + '(:treble :treble8 :bass :c :percussion) '() :action mode :predicate (constantly t) --- /project/gsharp/cvsroot/gsharp/measure.lisp 2006/02/15 02:44:48 1.27 +++ /project/gsharp/cvsroot/gsharp/measure.lisp 2006/03/02 09:21:34 1.28 @@ -119,9 +119,8 @@ (defmethod note-position ((note note)) (let ((clef (clef (staff note)))) - (+ (- (pitch note) - (ecase (name clef) (:treble 32) (:bass 24) (:c 28))) - (lineno clef)))) + (- (pitch note) + (bottom-line clef)))) ;;; given a list of notes, return the one that is at the top (defun top-note (notes) --- /project/gsharp/cvsroot/gsharp/packages.lisp 2006/03/01 00:15:42 1.47 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2006/03/02 09:21:34 1.48 @@ -196,7 +196,8 @@ #:add-staff-to-layer #:remove-staff-from-layer #:stem-direction #:undotted-duration #:duration - #:clef #:keysig #:staff-pos #:xoffset #:read-everything + #:clef #:f-position #:b-position #:bottom-line + #:keysig #:staff-pos #:xoffset #:read-everything #:read-buffer-from-stream #:key-signature #:alterations #:more-sharps #:more-flats #:line-width #:min-width #:spacing-style #:right-edge #:left-offset --- /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/02/26 22:18:39 1.21 +++ /project/gsharp/cvsroot/gsharp/score-pane.lisp 2006/03/02 09:21:34 1.22 @@ -249,7 +249,10 @@ (define-pixmap-recording (draw-clef (name)) (ecase name - (:treble +glyph-g-clef+) + ;; 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) +glyph-g-clef+) (:bass +glyph-f-clef+) (:c +glyph-c-clef+))) From crhodes at common-lisp.net Thu Mar 2 09:29:44 2006 From: crhodes at common-lisp.net (crhodes) Date: Thu, 2 Mar 2006 04:29:44 -0500 (EST) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20060302092944.5B3974D017@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv31984 Modified Files: buffer.lisp gui.lisp packages.lisp play.lisp Log Message: Make the tempo (for playback only, currently) a segment slot; add command-line UI for setting it. --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2006/03/02 09:21:34 1.36 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2006/03/02 09:29:44 1.37 @@ -975,7 +975,8 @@ (defclass segment (gsharp-object) ((print-character :allocation :class :initform #\S) (buffer :initform nil :initarg :buffer :accessor buffer) - (layers :initform '() :initarg :layers :accessor layers))) + (layers :initform '() :initarg :layers :accessor layers) + (tempo :initform 128 :initarg :tempo :accessor tempo))) (defmethod initialize-instance :after ((s segment) &rest args &key staff) (declare (ignore args)) @@ -987,7 +988,7 @@ do (setf (segment layer) s)))) (defmethod print-gsharp-object :after ((s segment) stream) - (format stream "~_:layers ~W " (layers s))) + (format stream "~_:layers ~W ~_:tempo ~W " (layers s) (tempo s))) (defun read-segment-v3 (stream char n) (declare (ignore char n)) --- /project/gsharp/cvsroot/gsharp/gui.lisp 2006/03/02 09:21:34 1.58 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2006/03/02 09:29:44 1.59 @@ -315,6 +315,10 @@ cursor) (forward-segment cursor))) +(define-gsharp-command (com-set-segment-tempo :name t) ((tempo 'integer :prompt "Tempo")) + (let ((segment (segment (current-cursor)))) + (setf (tempo segment) tempo))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; layer menu --- /project/gsharp/cvsroot/gsharp/packages.lisp 2006/03/02 09:21:34 1.48 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2006/03/02 09:29:44 1.49 @@ -183,7 +183,7 @@ #:layer #:lyrics-layer #:melody-layer #:bars #:nb-bars #:barno #:add-bar #:remove-bar #:slice #:make-slice - #:segment #:slices #:sliceno + #:segment #:tempo #:slices #:sliceno #:make-layer-for-staff #:make-bar-for-staff #:head #:body #:tail #:make-layer #:buffer #:layers #:nb-layers #:layerno --- /project/gsharp/cvsroot/gsharp/play.lisp 2006/02/28 23:49:18 1.4 +++ /project/gsharp/cvsroot/gsharp/play.lisp 2006/03/02 09:29:44 1.5 @@ -4,7 +4,13 @@ (+ (* 12 (+ (floor (pitch note) 7) 1)) (ecase (mod (pitch note) 7) (0 0) (1 2) (2 4) (3 5) (4 7) (5 9) (6 11)) (ecase (accidentals note) - (:double-flat -2) (:flat -1) (:natural 0) (:sharp 1) (:double-sharp 2)))) + (:double-flat -2) + (:flat -1) + (:natural 0) + (:sharp 1) + (:double-sharp 2)))) + +(defvar *tempo*) (defun measure-durations (slices) (let ((durations (mapcar (lambda (slice) @@ -27,7 +33,7 @@ (remove-if #'tie-left (notes element))) (mapcar (lambda (note) (make-instance 'note-off-message - :time (+ time (* 128 (duration element))) + :time (+ time (* *tempo* (duration element))) :status (+ #x80 channel) :key (midi-pitch note) :velocity 100)) (remove-if #'tie-right (notes element)))))) @@ -35,7 +41,7 @@ (defun events-from-bar (bar time channel) (mapcan (lambda (element) (prog1 (events-from-element element time channel) - (incf time (* 128 (duration element))))) + (incf time (* *tempo* (duration element))))) (elements bar))) (defun track-from-slice (slice channel durations) @@ -44,12 +50,13 @@ (let ((time 0)) (mapcan (lambda (bar duration) (prog1 (events-from-bar bar time channel) - (incf time (* 128 duration)))) + (incf time (* *tempo* duration)))) (bars slice) durations)))) (defun play-segment (segment) (let* ((slices (mapcar #'body (layers segment))) (durations (measure-durations slices)) + (*tempo* (tempo segment)) (tracks (loop for slice in slices for i from 0 collect (track-from-slice slice i durations))) From crhodes at common-lisp.net Thu Mar 2 09:32:15 2006 From: crhodes at common-lisp.net (crhodes) Date: Thu, 2 Mar 2006 04:32:15 -0500 (EST) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20060302093215.4FB2254071@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv905 Modified Files: drawing.lisp Log Message: Whoops. Fix up the treble-8 patch. --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/03/02 09:21:34 1.65 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/03/02 09:32:15 1.66 @@ -40,13 +40,13 @@ :x ,(+ x1 10) :staff-step ,(lineno (clef staff))) :stream pane) - (let ((yoffset (b-position clef))) + (let ((yoffset (b-position (clef staff)))) (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 (score-pane:staff-step 8)) by (score-pane:staff-step 2) while (eq (aref (alterations (keysig staff)) pitch) :flat) do (score-pane:draw-accidental pane :flat x (+ line yoffset)))) - (let ((yoffset (f-position clef))) + (let ((yoffset (f-position (clef staff)))) (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 (score-pane:staff-step 8)) by (score-pane:staff-step 2.5) From tmoore at common-lisp.net Mon Mar 6 20:46:48 2006 From: tmoore at common-lisp.net (tmoore) Date: Mon, 6 Mar 2006 15:46:48 -0500 (EST) Subject: [gsharp-cvs] CVS gsharp/Flexichain Message-ID: <20060306204648.8289C47012@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory clnet:/tmp/cvs-serv3429 Modified Files: flexirank.lisp utilities.lisp Log Message: Weak pointers for Allegro Common Lisp. Yes, I know this isn't the preferred repository for Flexichains anymore --- /project/gsharp/cvsroot/gsharp/Flexichain/flexirank.lisp 2005/11/28 21:27:02 1.4 +++ /project/gsharp/cvsroot/gsharp/Flexichain/flexirank.lisp 2006/03/06 20:46:48 1.5 @@ -75,5 +75,5 @@ (defmethod insert-vector* :after ((chain flexirank-mixin) position vector) (loop for elem across vector for pos from position - do (setf (index elem) (position-index pos) + do (setf (index elem) (position-index chain pos) (chain elem) chain))) --- /project/gsharp/cvsroot/gsharp/Flexichain/utilities.lisp 2005/01/15 08:43:50 1.3 +++ /project/gsharp/cvsroot/gsharp/Flexichain/utilities.lisp 2006/03/06 20:46:48 1.4 @@ -40,8 +40,11 @@ ;;; ;;; TODO: check other CL implementations behavior wrt. return values (defclass weak-pointer-container-mixin () - (#+openmcl - (weak-hash :initform (make-hash-table :test #'eq :weak :value))) + (#+(or openmcl allegro) + (weak-hash :initform (make-hash-table :test #'eq + ;; Get it together guys! + #+openmcl :weak #+openmcl :value + #+allegro :values #+allegro :weak))) (:documentation "Support for weak references, if needed")) (defgeneric make-weak-pointer (object container)) @@ -52,7 +55,7 @@ #+cmu (extensions:make-weak-pointer object) #+sbcl (sb-ext:make-weak-pointer object)) -#+openmcl +#+(or openmcl allegro) (defmethod make-weak-pointer (object (container weak-pointer-container-mixin)) (let ((key (cons nil nil))) (setf (gethash key (slot-value container 'weak-hash)) object) @@ -66,15 +69,15 @@ #+cmu (extensions:weak-pointer-value weak-pointer) #+sbcl (sb-ext:weak-pointer-value weak-pointer)) -#+openmcl +#+(or openmcl allegro) (defmethod weak-pointer-value (weak-pointer (container weak-pointer-container-mixin)) (gethash weak-pointer (slot-value container 'weak-hash) nil)) -#-(or sbcl cmu openmcl) +#-(or sbcl cmu openmcl allegro) (progn (eval-when (:evaluate :compile-toplevel :load-toplevel) - (warning "No support for weak pointers in this implementation. Things may + (warn "No support for weak pointers in this implementation. Things may get big and slow") ) (defmethod make-weak-pointer (object container) From crhodes at common-lisp.net Sat Mar 25 22:06:35 2006 From: crhodes at common-lisp.net (crhodes) Date: Sat, 25 Mar 2006 17:06:35 -0500 (EST) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20060325220635.D99ED690D9@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv32326 Modified Files: INSTALL gsharp.asd packages.lisp Log Message: Make Gsharp use the external ESA. --- /project/gsharp/cvsroot/gsharp/INSTALL 2005/11/01 17:58:26 1.3 +++ /project/gsharp/cvsroot/gsharp/INSTALL 2006/03/25 22:06:35 1.4 @@ -1,3 +1,19 @@ +;;; Requirements + +* A Common Lisp. Known to work: SBCL 0.9.10 + +* McCLIM. The "Laetare Sunday" release is needed, along with + ** spatial-trees; + ** at least one means of displaying graphics: CLX is recommended, + but the OpenMCL/Cocoa bridge is a possibility. + +* Flexichain. ASDF-INSTALLable or from common-lisp.net CVS, the + flexichain project, flexichain module. + +* ESA. From common-lisp.net CVS, the climacs project, esa module. + +Make sure ASDF knows how to find all of these projects. + ;;; Compile the fonts $ (cd Fonts; make) @@ -16,4 +32,3 @@ ;;; Run Gsharp (gsharp::gsharp) - --- /project/gsharp/cvsroot/gsharp/gsharp.asd 2006/02/15 02:54:26 1.6 +++ /project/gsharp/cvsroot/gsharp/gsharp.asd 2006/03/25 22:06:35 1.7 @@ -20,12 +20,9 @@ :defaults *gsharp-directory*)) collect `(:file ,(pathname-name p) :pathname ,p)))))) -(gsharp-defsystem (:gsharp :depends-on (:mcclim :flexichain)) +(gsharp-defsystem (:gsharp :depends-on (:mcclim :flexichain :esa)) "packages" "clim-patches" - "esa" - "esa-buffer" - "esa-io" "utilities" "gf" "sdl" --- /project/gsharp/cvsroot/gsharp/packages.lisp 2006/03/02 09:29:44 1.49 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2006/03/25 22:06:35 1.50 @@ -1,32 +1,3 @@ -(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 :esa-buffer - (:use :clim-lisp :clim :esa) - (:export #:make-buffer-from-stream #:save-buffer-to-stream - #:filepath #:name #:needs-saving - #:esa-buffer-mixin - #:make-new-buffer - #:read-only-p)) - -(defpackage :esa-io - (:use :clim-lisp :clim :esa :esa-buffer) - (:export #:buffers #:current-buffer - #:find-file #:find-file-read-only - #:set-visited-filename - #:save-buffer #:write-buffer - #:esa-io-table)) - (defpackage :gsharp-utilities (:shadow built-in-class) (:use :clim-lisp :clim-mop) From crhodes at common-lisp.net Sat Mar 25 22:07:59 2006 From: crhodes at common-lisp.net (crhodes) Date: Sat, 25 Mar 2006 17:07:59 -0500 (EST) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20060325220759.4C6B23053@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv32399 Removed Files: esa-buffer.lisp esa-io.lisp esa.lisp Log Message: Remove now-unused ESA files. From crhodes at common-lisp.net Sat Mar 25 22:13:29 2006 From: crhodes at common-lisp.net (crhodes) Date: Sat, 25 Mar 2006 17:13:29 -0500 (EST) Subject: [gsharp-cvs] CVS gsharp/Flexichain Message-ID: <20060325221329.E88E07A001@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory clnet:/tmp/cvs-serv32687 Removed Files: flexichain-package.lisp flexichain.asd flexichain.lisp flexicursor.lisp flexirank.lisp rtester.lisp skiplist-package.lisp skiplist.lisp stupid.lisp tester-package.lisp tester.lisp utilities.lisp Log Message: Remove outdated flexichain stuff, superseded by independent project. From crhodes at common-lisp.net Sat Mar 25 22:13:30 2006 From: crhodes at common-lisp.net (crhodes) Date: Sat, 25 Mar 2006 17:13:30 -0500 (EST) Subject: [gsharp-cvs] CVS gsharp/Flexichain/Doc Message-ID: <20060325221330.37883A0E5@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp/Flexichain/Doc In directory clnet:/tmp/cvs-serv32687/Doc Removed Files: Makefile circular.fig flexichain.tex gap1.fig gap2.fig gap3.fig spec-macros.tex strip-dependence tex-dependencies Log Message: Remove outdated flexichain stuff, superseded by independent project. From rstrandh at common-lisp.net Sun Mar 26 19:28:17 2006 From: rstrandh at common-lisp.net (rstrandh) Date: Sun, 26 Mar 2006 14:28:17 -0500 (EST) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20060326192817.72E9F34014@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv20635 Modified Files: drawing.lisp Log Message: Improved performance considerably by introducing a new output record per system and a new output record per cluster. --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/03/02 09:32:15 1.66 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2006/03/26 19:28:17 1.67 @@ -345,11 +345,12 @@ (score-pane:draw-tie-up pane x1 x2 (if (oddp pos) (1+ pos) pos)))))))))))))) (defun draw-system (pane measures) - (loop with length = (length measures) - for bar in (measure-bars (car measures)) - do (draw-ties pane (bars (slice bar)) bar length)) - (loop for measure in measures do - (draw-measure pane measure))) + (with-new-output-record (pane) + (loop with length = (length measures) + for bar in (measure-bars (car measures)) + do (draw-ties pane (bars (slice bar)) bar length)) + (loop for measure in measures do + (draw-measure pane measure)))) (defmethod draw-buffer (pane (buffer buffer) *cursor* x y) (score-pane:with-staff-size 6 @@ -745,28 +746,29 @@ ;;; 3. If necessary, draw ledger lines for notes in a group ;;; 4. Draw the stem, if any (defmethod draw-element (pane (element cluster) &optional (flags t)) - (unless (null (notes element)) - (let ((direction (final-stem-direction element)) - (stem-pos (final-stem-position element)) - (stem-yoffset (final-stem-yoffset element)) - (groups (group-notes-by-staff (notes element))) - (x (final-absolute-element-xoffset element))) - (when flags - (score-pane:with-vertical-score-position (pane stem-yoffset) - (draw-flags pane element x direction stem-pos))) - (loop for group in groups do - (draw-notes pane group (dots element) (notehead element)) - (draw-ledger-lines pane x group)) - (unless (eq (notehead element) :whole) - (if (eq direction :up) - (score-pane:draw-right-stem - pane x - (- (bot-note-staff-yoffset element) (score-pane:staff-step (bot-note-pos element))) - (- stem-yoffset (score-pane:staff-step stem-pos))) - (score-pane:draw-left-stem - pane x - (- (top-note-staff-yoffset element) (score-pane:staff-step (top-note-pos element))) - (- stem-yoffset (score-pane:staff-step stem-pos)))))))) + (with-new-output-record (pane) + (unless (null (notes element)) + (let ((direction (final-stem-direction element)) + (stem-pos (final-stem-position element)) + (stem-yoffset (final-stem-yoffset element)) + (groups (group-notes-by-staff (notes element))) + (x (final-absolute-element-xoffset element))) + (when flags + (score-pane:with-vertical-score-position (pane stem-yoffset) + (draw-flags pane element x direction stem-pos))) + (loop for group in groups do + (draw-notes pane group (dots element) (notehead element)) + (draw-ledger-lines pane x group)) + (unless (eq (notehead element) :whole) + (if (eq direction :up) + (score-pane:draw-right-stem + pane x + (- (bot-note-staff-yoffset element) (score-pane:staff-step (bot-note-pos element))) + (- stem-yoffset (score-pane:staff-step stem-pos))) + (score-pane:draw-left-stem + pane x + (- (top-note-staff-yoffset element) (score-pane:staff-step (top-note-pos element))) + (- stem-yoffset (score-pane:staff-step stem-pos))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;