- gsharp-cvs@common-lisp.net - mailman3.common-lisp.net

[gsharp-cvs] CVS update: gsharp/Flexichain/flexirank.lisp gsharp/Flexichain/flexichain-package.lisp gsharp/Flexichain/flexichain.asd gsharp/Flexichain/flexichain.lisp
by rstrandh＠common-lisp.net 15 Nov '05

15 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv23816 Modified Files: flexichain-package.lisp flexichain.asd flexichain.lisp Added Files: flexirank.lisp Log Message: The code in the new file flexirank.lisp makes it possible for client code to define a `ranked flexichain' which is a flexichain or a cursorchain in which the elements know their position. Also removed a useless defgeneric from flexichain.lisp Date: Wed Nov 16 04:06:59 2005 Author: rstrandh Index: gsharp/Flexichain/flexichain-package.lisp diff -u gsharp/Flexichain/flexichain-package.lisp:1.3 gsharp/Flexichain/flexichain-package.lisp:1.4 --- gsharp/Flexichain/flexichain-package.lisp:1.3 Wed Mar 2 05:19:27 2005 +++ gsharp/Flexichain/flexichain-package.lisp Wed Nov 16 04:06:59 2005 @@ -36,4 +36,6 @@ #:at-beginning-p #:at-end-p #:move> #:move< #:insert #:insert-sequence - #:element< #:element> #:delete< #:delete>)) + #:element< #:element> #:delete< #:delete> + #:flexirank-mixin #:element-rank-mixin #:rank)) + Index: gsharp/Flexichain/flexichain.asd diff -u gsharp/Flexichain/flexichain.asd:1.3 gsharp/Flexichain/flexichain.asd:1.4 --- gsharp/Flexichain/flexichain.asd:1.3 Wed Mar 2 05:19:27 2005 +++ gsharp/Flexichain/flexichain.asd Wed Nov 16 04:06:59 2005 @@ -32,5 +32,6 @@ :components ((:file "flexichain-package") (:file "utilities" :depends-on ("flexichain-package")) (:file "flexichain" :depends-on ("utilities")) - (:file "flexicursor" :depends-on ("flexichain")))) + (:file "flexicursor" :depends-on ("flexichain")) + (:file "flexirank" :depends-on ("flexichain")))) Index: gsharp/Flexichain/flexichain.lisp diff -u gsharp/Flexichain/flexichain.lisp:1.6 gsharp/Flexichain/flexichain.lisp:1.7 --- gsharp/Flexichain/flexichain.lisp:1.6 Tue Dec 28 07:57:00 2004 +++ gsharp/Flexichain/flexichain.lisp Wed Nov 16 04:06:59 2005 @@ -199,9 +199,6 @@ (defmethod flexi-empty-p ((chain standard-flexichain)) (zerop (nb-elements chain))) -(defgeneric insert-object (chain position object) - (:documentation "Inserts an object at gap-start of a chain.")) - (defun position-index (chain position) "Returns the (0 indexed) index of the POSITION-th element of the CHAIN in the buffer."

1 0

[gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/measure.lisp
by rstrandh＠common-lisp.net 15 Nov '05

15 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv16112 Modified Files: buffer.lisp measure.lisp Log Message: added more comments to improve maintainability Date: Wed Nov 16 02:27:34 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.25 gsharp/buffer.lisp:1.26 --- gsharp/buffer.lisp:1.25 Thu Nov 10 18:36:36 2005 +++ gsharp/buffer.lisp Wed Nov 16 02:27:34 2005 @@ -916,7 +916,12 @@ (segments :initform '() :initarg :segments :accessor segments) (staves :initform (list (make-fiveline-staff)) :initarg :staves :accessor staves) + ;; the min width determines the preferred geographic distance after the + ;; timetlime with the shortest duration on a line. (min-width :initform *default-min-width* :initarg :min-width :accessor min-width) + ;; the spacing style of the buffer determines the how geographic distance + ;; between adjacent timelines is related to temporal distance. + ;; a value of 0 means constant spacing, a value of 1 means proportional spacing (spacing-style :initform *default-spacing-style* :initarg :spacing-style :accessor spacing-style) (right-edge :initform *default-right-edge* :initarg :right-edge :accessor right-edge) (left-offset :initform *default-left-offset* :initarg :left-offset :accessor left-offset) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.4 gsharp/measure.lisp:1.5 --- gsharp/measure.lisp:1.4 Mon Oct 31 03:16:27 2005 +++ gsharp/measure.lisp Wed Nov 16 02:27:34 2005 @@ -125,8 +125,22 @@ ;;; ;;; Measure +;;; A measure represents the set of simultaneous bars. +;;; Define a TIMELINE of a measure to be the set of all +;;; simultaneous elements of the bars of the measure. +;;; The DURATION of a timeline is either the distance to +;;; the next closest timeline following it, or, in case +;;; it is the last timeline of the measure, the duration +;;; of the longest element of the timeline. + (defclass measure (obseq-elem) - ((min-dist :initarg :min-dist :reader measure-min-dist) + (;; the smallest temporal distance between either two adjacent + ;; timelines in the measure or between the last timeline + ;; and the end of the mesure. The temporal distance between + ;; the last timeline and the end of the measure is the same + ;; as the duration of the longest element of the last timeline. + (min-dist :initarg :min-dist :reader measure-min-dist) + ;; the coefficient of a measure is the sum of (coeff :initarg :coeff :reader measure-coeff) (start-times :initarg :start-times :reader measure-start-times) (seg-pos :initarg :seg-pos :reader measure-seg-pos) @@ -304,8 +318,11 @@ ;;; Cost functions (defclass measure-cost-method (cost-method) - ((min-width :initarg :min-width :reader min-width) + (;; the min width is taken from the min width of the buffer + (min-width :initarg :min-width :reader min-width) + ;; the spaceing style is taken from the spacing style of the buffer (spacing-style :initarg :spacing-style :reader spacing-style) + ;; the amount of horizontal space available to music material (line-width :initarg :line-width :reader line-width))) (defun make-measure-cost-method (min-width spacing-style line-width)

1 0

[gsharp-cvs] CVS update: gsharp/Doc/gsharp.tex
by rstrandh＠common-lisp.net 15 Nov '05

15 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv21136 Modified Files: gsharp.tex Log Message: fixed minor typos in the documentation. Date: Tue Nov 15 20:14:58 2005 Author: rstrandh Index: gsharp/Doc/gsharp.tex diff -u gsharp/Doc/gsharp.tex:1.5 gsharp/Doc/gsharp.tex:1.6 --- gsharp/Doc/gsharp.tex:1.5 Tue Nov 1 18:56:51 2005 +++ gsharp/Doc/gsharp.tex Tue Nov 15 20:14:58 2005 @@ -702,7 +702,7 @@ There is a slight problem with \emph{head slices} and \emph{tail slices} which is why they are not implemented yet. While -conceptually these slices below to the segment of their +conceptually these slices belong to the segment of their corresponding layer, the layout algorithm must align them with the last measure of the previous segment and the first measure of the next segment. To make it impossible for those slices to stick out @@ -738,7 +738,7 @@ but that is not all there is to it. In fact, we also know that \emph{on a given line}, the smallest geographic distance possible (a global parameter of the score that determines denseness and that we -will call $w_min$) is assigned to the shortest temporal distance on +will call $w_{min}$) is assigned to the shortest temporal distance on that line, \emph{independently of the absolute value of that temporal distance}. The other geographic distances are adjusted accordingly. Thus, a measure can take up a lot more space on a line if other

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/sdl.lisp
by rstrandh＠common-lisp.net 15 Nov '05

15 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv19808 Modified Files: drawing.lisp sdl.lisp Log Message: Added more comments in an attempt to improve maintainability. Plus, it helps me understand what I meant when I initially wrote the code. Date: Tue Nov 15 19:49:52 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.19 gsharp/drawing.lisp:1.20 --- gsharp/drawing.lisp:1.19 Sat Nov 12 08:14:28 2005 +++ gsharp/drawing.lisp Tue Nov 15 19:49:52 2005 @@ -534,6 +534,16 @@ (defun element-has-suspended-notes (element) (not (apply #'= (mapcar #'final-xposition (notes element))))) +;;; table of x offsets (in staff steps) of accendentals. +;;; The first index represents a notehead or a type of accidental. +;;; The second index represents a type of accidentsl. +;;; The third index is a vertical distance, measured in difference +;;; in staff steps between the two. +;;; The table entry gives how much the accidental represented by +;;; the second parameter must be positioned to the left of the +;;; first one. +;;; Entries in the table are offset by 5 in the last dimension +;;; so that vertical distances between -5 and 5 can be represented (defparameter *accidental-offset* ;;; -5 -4 -3 -2 -1 0 1 2 3 4 5 #3A((( 0 0 0 3.5 3.5 3.5 3.5 3.5 3.5 1 0) ; notehead - dbl flat @@ -567,6 +577,11 @@ ( 0 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 0) ; dbl sharp - sharp ( 0 0 0 2.8 2.8 2.8 2.8 2.8 0 0 0)))) ; dbl sharp - dbl sharp +;;; given 1) a type of accidental 2) its position (in staff steps) 3) +;;; a type of accidental or a type of notehead, and 4) its position, +;;; return the x offset of the first accidental, i.e., how many staff +;;; steps to the left that it must be moved in order to avoid overlap +;;; with the second one. (defun accidental-distance (acc1 pos1 acc2 pos2) (let ((dist (- pos2 pos1))) (if (> (abs dist) 5) @@ -587,6 +602,13 @@ (:double-sharp 4)) (+ dist 5))))) +;;; given two notes (where the first one has an accidental, and the +;;; second one may or may not have an accidental) and the conversion +;;; factor between staff steps and x positions, compute the x offset +;;; of the accidental of the first note. If the second note has +;;; an accidental, but that has not been given a final x offset, then +;;; use the x offset of the notehead instead. +;;; (this funtction should probably be renamed accidental-xoffset) (defun accidental-xpos (note1 note2 staff-step) (let* ((acc1 (final-accidental note1)) (pos1 (note-position note1)) @@ -599,9 +621,18 @@ (final-xposition note2)))) (- xpos2 (* staff-step (accidental-distance acc1 pos1 acc2 pos2))))) +;;; given a note and a list of notes, compute x offset of the accidental +;;; of the note as required by each of the notes in the list. In order +;;; for the accidental of the note not to overlap any of the others, +;;; we must use the minimum of all the x offsets thus computed. +;;; (this function shoudl probably be renamed accidental-min-xoffset) (defun accidental-min-xpos (note1 notes staff-step) (reduce #'min notes :key (lambda (note) (accidental-xpos note1 note staff-step)))) +;;; given a list of notes that have accidentals to place, and a list of +;;; notes that either have no accidentals or with already-placed accidentals, +;;; compute the note in the first list that can be placed as far to the right +;;; as possible. (defun best-accidental (notes-with-accidentals notes staff-step) (reduce (lambda (note1 note2) (if (>= (accidental-min-xpos note1 notes staff-step) (accidental-min-xpos note2 notes staff-step)) @@ -609,14 +640,20 @@ note2)) notes-with-accidentals)) +;;; for each note in a list of notes, if it has an accidental, compute +;;; the position of that accidental and store it in the note. (defun compute-final-accidental-positions (notes x final-stem-direction) (let* ((staff-step (score-pane:staff-step 1)) + ;; sort the notes from top to bottom (notes (sort (copy-list notes) (lambda (x y) (> (note-position x) (note-position y))))) (notes-with-accidentals (remove-if-not #'final-accidental notes))) ;; initially, no accidental has been placed (loop for note in notes do (setf (accidental-position note) nil)) (when (eq final-stem-direction :up) + ;; when the stem direction is :up and there is a suspended note + ;; i.e., one to the right of the stem, then the accidental of the topmost + ;; suspended note is placed first. (let ((first-suspended-note (find x notes-with-accidentals :test #'/= :key #'final-xposition))) (when first-suspended-note @@ -641,6 +678,16 @@ (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. +;;; 2. Determine which notes in each group go to the left and which notes +;;; go to the right of the stem. +;;; 3. Determine which notes in each group should be displayed with an accidental. +;;; 4. Compute the x offset of each accidental to be displayed. +;;; 5. Draw the notes in each group +;;; 6. If necessary, draw ledger lines for notes in a group +;;; 7. Draw the stem, if any (defmethod draw-element (pane (element cluster) x &optional (flags t)) (when (notes element) (let ((direction (final-stem-direction element)) Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.11 gsharp/sdl.lisp:1.12 --- gsharp/sdl.lisp:1.11 Mon Nov 14 23:52:13 2005 +++ gsharp/sdl.lisp Tue Nov 15 19:49:52 2005 @@ -110,6 +110,9 @@ (declare (ignore initargs)) (with-slots (gf-char x-offset y-offset) glyph (setf x-offset (floor (gf-char-min-m gf-char) 4) + ;; adding 1 to gv-char-max-n is necessary because + ;; of a discrepancy between the GF documentation + ;; and the GF file format y-offset (- (ceiling (1+ (gf-char-max-n gf-char)) 4))))) (defmethod glyph ((font font) glyph-no) @@ -117,6 +120,9 @@ (let ((left (floor (gf-char-min-m gf-char) 4)) (right (ceiling (1+ (gf-char-max-m gf-char)) 4)) (down (floor (gf-char-min-n gf-char) 4)) + ;; adding 1 to gv-char-max-n is necessary because + ;; of a discrepancy between the GF documentation + ;; and the GF file format (up (ceiling (1+ (gf-char-max-n gf-char)) 4)) (matrix (gf-char-matrix gf-char))) (unless pixmap

1 0

[gsharp-cvs] CVS update: gsharp/sdl.lisp
by rstrandh＠common-lisp.net 14 Nov '05

14 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv28082 Modified Files: sdl.lisp Log Message: re-inserted a `1+' to compensate for the fact that GF's max-n is off by 1. Date: Mon Nov 14 23:52:14 2005 Author: rstrandh Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.10 gsharp/sdl.lisp:1.11 --- gsharp/sdl.lisp:1.10 Mon Nov 14 22:51:26 2005 +++ gsharp/sdl.lisp Mon Nov 14 23:52:13 2005 @@ -110,7 +110,7 @@ (declare (ignore initargs)) (with-slots (gf-char x-offset y-offset) glyph (setf x-offset (floor (gf-char-min-m gf-char) 4) - y-offset (- (ceiling (gf-char-max-n gf-char) 4))))) + y-offset (- (ceiling (1+ (gf-char-max-n gf-char)) 4))))) (defmethod glyph ((font font) glyph-no) (with-slots (gf-char pixmap) (aref (glyphs font) glyph-no)

1 0

[gsharp-cvs] CVS update: gsharp/sdl.lisp
by rstrandh＠common-lisp.net 14 Nov '05

14 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv23570 Modified Files: sdl.lisp Log Message: Fixed off-by-one-pixel but in pixmap drawing. Date: Mon Nov 14 22:51:26 2005 Author: rstrandh Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.9 gsharp/sdl.lisp:1.10 --- gsharp/sdl.lisp:1.9 Fri Nov 11 20:19:39 2005 +++ gsharp/sdl.lisp Mon Nov 14 22:51:26 2005 @@ -110,7 +110,7 @@ (declare (ignore initargs)) (with-slots (gf-char x-offset y-offset) glyph (setf x-offset (floor (gf-char-min-m gf-char) 4) - y-offset (- (floor (1+ (gf-char-max-n gf-char)) 4))))) + y-offset (- (ceiling (gf-char-max-n gf-char) 4))))) (defmethod glyph ((font font) glyph-no) (with-slots (gf-char pixmap) (aref (glyphs font) glyph-no)

1 0

[gsharp-cvs] CVS update: gsharp/esa.lisp
by crhodes＠common-lisp.net 14 Nov '05

14 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv19149 Modified Files: esa.lisp Log Message: Sync esa with climacs; M-x now works properly again. Date: Mon Nov 14 21:49:35 2005 Author: crhodes Index: gsharp/esa.lisp diff -u gsharp/esa.lisp:1.10 gsharp/esa.lisp:1.11 --- gsharp/esa.lisp:1.10 Mon Nov 14 15:27:32 2005 +++ gsharp/esa.lisp Mon Nov 14 21:49:34 2005 @@ -379,8 +379,7 @@ () (let ((item (handler-case (accept - `(command :command-table - ,(command-table (car (windows *application-frame*)))) + `(command :command-table ,(find-applicable-command-table *application-frame*)) :prompt "Extended Command") (error () (progn (beep) (display-message "No such command")

1 0

[gsharp-cvs] CVS update: gsharp/gui.lisp
by rstrandh＠common-lisp.net 14 Nov '05

14 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv16937 Modified Files: gui.lisp Log Message: Fixed prompt bug in com-delete-staff-from-layer. (thanks to Robert J. Macomber) Date: Mon Nov 14 21:26:34 2005 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.42 gsharp/gui.lisp:1.43 --- gsharp/gui.lisp:1.42 Mon Nov 14 15:27:32 2005 +++ gsharp/gui.lisp Mon Nov 14 21:26:14 2005 @@ -1072,7 +1072,7 @@ ;;; FIXME restrict to staves that are actually in the layer. (define-gsharp-command (com-delete-staff-from-layer :name t) () - (let ((staff (accept 'score-pane:staff :prompt "Add staff to layer")) + (let ((staff (accept 'score-pane:staff :prompt "Delete staff from layer")) (layer (layer (cursor *application-frame*)))) (remove-staff-from-layer staff layer)))

1 0

[gsharp-cvs] CVS update: gsharp/Fonts/viewer.lisp
by rstrandh＠common-lisp.net 14 Nov '05

14 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Fonts In directory common-lisp.net:/tmp/cvs-serv14746 Modified Files: viewer.lisp Log Message: make the viewer slightly more CL-compliant Date: Mon Nov 14 20:59:46 2005 Author: rstrandh Index: gsharp/Fonts/viewer.lisp diff -u gsharp/Fonts/viewer.lisp:1.1 gsharp/Fonts/viewer.lisp:1.2 --- gsharp/Fonts/viewer.lisp:1.1 Thu Mar 25 07:50:26 2004 +++ gsharp/Fonts/viewer.lisp Mon Nov 14 20:59:46 2005 @@ -39,7 +39,7 @@ :initial-element 16 :element-type '(unsigned-byte 8)))) (unless (aref vector index) (loop for r from 0 below height - for y from (gf-char-max-n char) by -1 do + for y downfrom (gf-char-max-n char) by 1 do (loop for c from 0 below width for x from (gf-char-min-m char) do (decf (aref glyph

1 0

[gsharp-cvs] CVS update: gsharp/esa.lisp gsharp/gui.lisp gsharp/packages.lisp
by crhodes＠common-lisp.net 14 Nov '05

14 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv22545 Modified Files: esa.lisp gui.lisp packages.lisp Log Message: Sync esa with climacs. Implement FIND-APPLICABLE-COMMAND-TABLE. Date: Mon Nov 14 15:27:32 2005 Author: crhodes Index: gsharp/esa.lisp diff -u gsharp/esa.lisp:1.9 gsharp/esa.lisp:1.10 --- gsharp/esa.lisp:1.9 Thu Nov 3 15:59:23 2005 +++ gsharp/esa.lisp Mon Nov 14 15:27:32 2005 @@ -215,7 +215,7 @@ ('menu-item) (object) (with-input-context - (`(command :command-table ,(command-table (car (windows frame))))) + (`(command :command-table ,command-table)) (object) (let ((gestures '())) (multiple-value-bind (numarg numargp) @@ -263,6 +263,11 @@ (car command) command))) +(defgeneric find-applicable-command-table (frame)) + +(defmethod find-applicable-command-table ((frame esa-frame-mixin)) + (command-table (car (windows frame)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Top level @@ -281,12 +286,12 @@ do (restart-case (progn (handler-case - (progn + (let ((command-table (find-applicable-command-table frame))) ;; for presentation-to-command-translators, ;; which are searched for in ;; (frame-command-table *application-frame*) - (setf (frame-command-table frame) (command-table (car (windows frame)))) - (process-gestures-or-command frame (command-table (car (windows frame))))) + (setf (frame-command-table frame) command-table) + (process-gestures-or-command frame command-table)) (abort-gesture () (display-message "Quit"))) (redisplay-frame-panes frame)) (return-to-esa () nil)))))) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.41 gsharp/gui.lisp:1.42 --- gsharp/gui.lisp:1.41 Thu Nov 10 18:37:16 2005 +++ gsharp/gui.lisp Mon Nov 14 15:27:32 2005 @@ -423,12 +423,12 @@ (declare (ignore string)) (if success layer (error 'no-such-layer)))) -(defmethod select-layer :after (cursor (layer layer)) - (typecase layer - (lyrics-layer (setf (command-table (first (windows *application-frame*))) - (find-command-table 'total-lyrics-table))) - (melody-layer (setf (command-table (first (windows *application-frame*))) - (find-command-table 'total-melody-table))))) +(defmethod find-applicable-command-table ((frame gsharp)) + (let* ((layer (layer (cursor *application-frame*)))) + ;; F-A-C-T-WITH-LAYER? + (typecase layer + (lyrics-layer (find-command-table 'total-lyrics-table)) + (melody-layer (find-command-table 'total-melody-table))))) (define-gsharp-command (com-select-layer :name t) () (let ((selected-layer (accept 'layer :prompt "Select layer"))) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.26 gsharp/packages.lisp:1.27 --- gsharp/packages.lisp:1.26 Mon Nov 7 21:00:52 2005 +++ gsharp/packages.lisp Mon Nov 14 15:27:32 2005 @@ -138,7 +138,8 @@ #:esa-top-level #:simple-command-loop #:global-esa-table #:keyboard-macro-table #:help-table - #:set-key)) + #:set-key + #:find-applicable-command-table)) (defpackage :score-pane (:use :clim :clim-extensions :clim-lisp :sdl :esa)

1 0