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

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

08 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv31471 Modified Files: score-pane.lisp sdl.lisp Log Message: Change the convention for staff-line-offsets so that the one going down is nonnegative and the one going up is negative. This way, they should both be added to the y-coordinate of the reference point to obtain the lower and upper edge of the staff line respectively. Date: Tue Nov 8 06:16:15 2005 Author: rstrandh Index: gsharp/score-pane.lisp diff -u gsharp/score-pane.lisp:1.16 gsharp/score-pane.lisp:1.17 --- gsharp/score-pane.lisp:1.16 Tue Nov 8 04:15:02 2005 +++ gsharp/score-pane.lisp Tue Nov 8 06:16:12 2005 @@ -304,9 +304,7 @@ (defun draw-staff-line (pane x1 staff-step x2) (multiple-value-bind (down up) (staff-line-offsets *font*) - ;; the staff line offsets are both positive, so subract - ;; the UP value from y and add the DOWN value to y. - (let ((y1 (- (- (staff-step staff-step)) up)) + (let ((y1 (+ (- (staff-step staff-step)) up)) (y2 (+ (- (staff-step staff-step)) down))) (draw-rectangle* pane x1 y1 x2 y2)))) Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.6 gsharp/sdl.lisp:1.7 --- gsharp/sdl.lisp:1.6 Tue Nov 8 04:15:02 2005 +++ gsharp/sdl.lisp Tue Nov 8 06:16:14 2005 @@ -56,7 +56,7 @@ (setf staff-line-offset-down (floor (/ staff-line-thickness 2)) staff-line-offset-up - (- staff-line-thickness staff-line-offset-down))) + (- staff-line-offset-down staff-line-thickness))) (let ((stem-thickness (round (/ staff-line-distance 11.9)))) (setf stem-offset-left (- (floor (/ stem-thickness 2))) @@ -130,14 +130,17 @@ (with-slots (x-offset y-offset) (aref (glyphs font) glyph-no) (values x-offset y-offset))) -;;; the staff line offsets are both positive integers. -;;; if the staff line has a thickness which is an even -;;; number of pixels, then the two values returned are the -;;; same. Otherwise the first value (down) is 1 smaller -;;; than the second value (up). This implies that the -;;; y-value of the reference point for a staff line is either -;;; in the middle of the staff line (if the thickness is even) -;;; or half a pixel BELOW the middle (if the thickness is odd). +;;; the DOWN staff line offset is a nonnegative integer, and the UP +;;; staff line offset is a negative integer. This way, both of them +;;; should be ADDED to a reference y value to obtain the lower and +;;; upper y coordinates of the staff line. If the staff line has a +;;; thickness which is an even number of pixels, then the two values +;;; returned have the same magnitude (but opposite signs). Otherwise +;;; the first value (DOWN) has a magnitude which is one smaller than +;;; that of the second value (UP). This implies that the y-value of the +;;; reference point for a staff line is either in the middle of the +;;; staff line (if the thickness is even) or half a pixel BELOW the +;;; middle (if the thickness is odd). (defmethod staff-line-offsets ((font font)) (with-slots (staff-line-offset-down staff-line-offset-up) font (values staff-line-offset-down staff-line-offset-up)))

1 0

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

08 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv22632 Modified Files: score-pane.lisp sdl.lisp Log Message: more comments Date: Tue Nov 8 04:15:03 2005 Author: rstrandh Index: gsharp/score-pane.lisp diff -u gsharp/score-pane.lisp:1.15 gsharp/score-pane.lisp:1.16 --- gsharp/score-pane.lisp:1.15 Mon Nov 7 19:51:41 2005 +++ gsharp/score-pane.lisp Tue Nov 8 04:15:02 2005 @@ -149,6 +149,9 @@ ;;; Given a staff-step value, determine the corresponding number of ;;; pixels in the current font. The sign of the value returned is ;;; the same as that of the argument. +;;; But is that reasonable? It seems more logical to have it return +;;; the opposite sign, so that the result from staff-step is always +;;; added to some y coordinate. (defun staff-step (n) (* n (/ (staff-line-distance *font*) 2))) @@ -181,6 +184,8 @@ ;;; finally the upper glyph. ;;; It appears that this function increases the staff step in each iteration, ;;; which seems incomptible with the way draw-antialiased-glyph appears to work. +;;; This function is currently used only by the three draw-xxx-stack functions, +;;; which in turn are currently not used. (defun draw-stack (pane glyph-lower glyph-upper glyph-two x staff-step how-many) (draw-antialiased-glyph pane glyph-lower x staff-step) (loop for ss from staff-step by 2 @@ -299,8 +304,10 @@ (defun draw-staff-line (pane x1 staff-step x2) (multiple-value-bind (down up) (staff-line-offsets *font*) + ;; the staff line offsets are both positive, so subract + ;; the UP value from y and add the DOWN value to y. (let ((y1 (- (- (staff-step staff-step)) up)) - (y2 (- (- (staff-step staff-step)) down))) + (y2 (+ (- (staff-step staff-step)) down))) (draw-rectangle* pane x1 y1 x2 y2)))) (defclass staff-output-record (output-record) Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.5 gsharp/sdl.lisp:1.6 --- gsharp/sdl.lisp:1.5 Mon Aug 1 01:36:56 2005 +++ gsharp/sdl.lisp Tue Nov 8 04:15:02 2005 @@ -130,6 +130,14 @@ (with-slots (x-offset y-offset) (aref (glyphs font) glyph-no) (values x-offset y-offset))) +;;; the staff line offsets are both positive integers. +;;; if the staff line has a thickness which is an even +;;; number of pixels, then the two values returned are the +;;; same. Otherwise the first value (down) is 1 smaller +;;; than the second value (up). This implies that the +;;; y-value of the reference point for a staff line is either +;;; in the middle of the staff line (if the thickness is even) +;;; or half a pixel BELOW the middle (if the thickness is odd). (defmethod staff-line-offsets ((font font)) (with-slots (staff-line-offset-down staff-line-offset-up) font (values staff-line-offset-down staff-line-offset-up)))

1 0

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

07 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv22660 Modified Files: buffer.lisp gui.lisp packages.lisp Log Message: Improved on the constructors for buffer-related classes. Date: Mon Nov 7 21:00:52 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.23 gsharp/buffer.lisp:1.24 --- gsharp/buffer.lisp:1.23 Thu Nov 3 04:40:13 2005 +++ gsharp/buffer.lisp Mon Nov 7 21:00:52 2005 @@ -477,6 +477,8 @@ (defmethod print-object :after ((b bar) stream) (format stream ":elements ~W " (elements b))) +(defgeneric make-bar-for-staff (staff &rest args &key elements)) + (defmethod nb-elements ((bar bar)) (length (elements bar))) @@ -518,6 +520,10 @@ (ignore elements)) (apply #'make-instance 'melody-bar args)) +(defmethod make-bar-for-staff ((staff fiveline-staff) &rest args &key elements) + (declare (ignore elements)) + (apply #'make-instance 'melody-bar args)) + (defun read-melody-bar-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'melody-bar (read-delimited-list #\] stream t))) @@ -534,6 +540,10 @@ (ignore elements)) (apply #'make-instance 'lyrics-bar args)) +(defmethod make-bar-for-staff ((staff lyrics-staff) &rest args &key elements) + (declare (ignore elements)) + (apply #'make-instance 'lyrics-bar args)) + (defun read-lyrics-bar-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'lyrics-bar (read-delimited-list #\] stream t))) @@ -672,8 +682,15 @@ (tail :initarg :tail :accessor tail)) (:default-initargs :name "default layer")) -(defmethod initialize-instance :after ((l layer) &rest args) +(defmethod initialize-instance :after ((l layer) &rest args &key head body tail) (declare (ignore args)) + (let ((staff (car (staves l)))) + (unless head + (setf (head l) (make-slice :bars (list (make-bar-for-staff staff))))) + (unless body + (setf (body l) (make-slice :bars (list (make-bar-for-staff staff))))) + (unless tail + (setf (tail l) (make-slice :bars (list (make-bar-for-staff staff)))))) (setf (layer (head l)) l (layer (body l)) l (layer (tail l)) l)) @@ -683,25 +700,19 @@ (format stream ":staves ~W :head ~W :body ~W :tail ~W " staves head body tail))) +(defgeneric make-layer-for-staff (staff &rest args &key staves head body tail)) + +(defun make-layer (staves &rest args &key head body tail) + (declare (type list staves) + (type (or slice null) head body tail) + (ignore head body tail)) + (apply #'make-layer-for-staff (car staves) :staves staves args)) + ;;; melody layer (defclass melody-layer (layer) ((print-character :allocation :class :initform #\_))) -(defmethod make-layer (name (initial-staff fiveline-staff)) - (flet ((make-initialized-slice () - (make-slice :bars (list (make-melody-bar))))) - (let* ((head (make-initialized-slice)) - (body (make-initialized-slice)) - (tail (make-initialized-slice)) - (result (make-instance 'melody-layer - :name name :staves (list initial-staff) - :head head :body body :tail tail))) - (setf (slot-value head 'layer) result - (slot-value body 'layer) result - (slot-value tail 'layer) result) - result))) - (defun read-melody-layer-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'melody-layer (read-delimited-list #\] stream t))) @@ -710,25 +721,15 @@ #'read-melody-layer-v3 *gsharp-readtable-v3*) +(defmethod make-layer-for-staff ((staff fiveline-staff) &rest args &key staves head body tail) + (declare (ignore staves head body tail)) + (apply #'make-instance 'melody-layer args)) + ;;; lyrics layer (defclass lyrics-layer (layer) ((print-character :allocation :class :initform #\M))) -(defmethod make-layer (name (initial-staff lyrics-staff)) - (flet ((make-initialized-slice () - (make-slice :bars (list (make-lyrics-bar))))) - (let* ((head (make-initialized-slice)) - (body (make-initialized-slice)) - (tail (make-initialized-slice)) - (result (make-instance 'lyrics-layer - :name name :staves (list initial-staff) - :head head :body body :tail tail))) - (setf (slot-value head 'layer) result - (slot-value body 'layer) result - (slot-value tail 'layer) result) - result))) - (defun read-lyrics-layer-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'lyrics-layer (read-delimited-list #\] stream t))) @@ -737,6 +738,10 @@ #'read-lyrics-layer-v3 *gsharp-readtable-v3*) +(defmethod make-layer-for-staff ((staff lyrics-staff) &rest args &key staves head body tail) + (declare (ignore staves head body tail)) + (apply #'make-instance 'lyrics-layer args)) + (defmethod slices ((layer layer)) (with-slots (head body tail) layer (list head body tail))) @@ -817,7 +822,7 @@ (with-slots (layers) s (when (null layers) (assert (not (null staff))) - (push (make-layer "Default layer" staff) layers)) + (push (make-layer (list staff)) layers)) (loop for layer in layers do (setf (segment layer) s)))) @@ -864,7 +869,7 @@ (setf layers (delete layer layers :test #'eq)) ;; make sure there is one layer left (unless layers - (add-layer (make-layer "Default layer" (car (staves (buffer segment)))) + (add-layer (make-layer (staves (buffer segment))) segment))) (setf segment nil))) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.39 gsharp/gui.lisp:1.40 --- gsharp/gui.lisp:1.39 Mon Nov 7 06:23:57 2005 +++ gsharp/gui.lisp Mon Nov 7 21:00:52 2005 @@ -441,7 +441,7 @@ (define-gsharp-command (com-add-layer :name t) () (let* ((name (acquire-unique-layer-name "Name of new layer")) (staff (accept 'score-pane:staff :prompt "Initial staff of new layer")) - (new-layer (make-layer name staff))) + (new-layer (make-layer staff :name name))) (add-layer new-layer (segment (cursor *application-frame*))) (select-layer (cursor *application-frame*) new-layer))) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.25 gsharp/packages.lisp:1.26 --- gsharp/packages.lisp:1.25 Mon Nov 7 06:23:57 2005 +++ gsharp/packages.lisp Mon Nov 7 21:00:52 2005 @@ -55,8 +55,9 @@ #:lyrics-bar #:make-lyrics-bar #:layer #:lyrics-layer #:melody-layer #:bars #:nb-bars #:barno #:add-bar #:remove-bar - #:slice + #:slice #:make-slice #:segment #:slices #:sliceno + #:make-layer-for-staff #:make-bar-for-staff #:head #:body #:tail #:make-layer #:buffer #:layers #:nb-layers #:layerno #:add-layer #:remove-layer #:segment

1 0

[gsharp-cvs] CVS update: gsharp/score-pane.lisp
by rstrandh＠common-lisp.net 07 Nov '05

07 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv18103 Modified Files: score-pane.lisp Log Message: Added comments as I re-learn what various functions do and are supposed to do. Date: Mon Nov 7 19:51:41 2005 Author: rstrandh Index: gsharp/score-pane.lisp diff -u gsharp/score-pane.lisp:1.14 gsharp/score-pane.lisp:1.15 --- gsharp/score-pane.lisp:1.14 Fri Oct 28 19:19:50 2005 +++ gsharp/score-pane.lisp Mon Nov 7 19:51:41 2005 @@ -18,12 +18,19 @@ (defparameter *font* nil) (defparameter *fonts* (make-array 100 :initial-element nil)) +;;; Map integer levels of white, represented by the number of white pixels in +;;; a 4x4 pixel grid, to CLIM inks. (defparameter *gray-levels* (loop with result = (make-array '(17)) for i from 0 to 16 do (setf (aref result i) (make-gray-color (/ i 16))) finally (return result))) +;;; Given a pane and a matrix representing a glyph in a font, return a server-side +;;; pixmap that corresponds to that matrix for that pane. Create pixmaps +;;; on demand to avoid initial delays and too many pixmaps in the server. +;;; The elements of the matrix are integers from 0 to 16 inclusive, representing how +;;; many pixels are white in a 4x4 grid. (defun pane-pixmap (pane matrix) (or (gethash matrix (pane-pixmaps pane)) (let* ((dimensions (array-dimensions matrix)) @@ -138,9 +145,23 @@ ;;; ;;; drawing functions +;;; A staff step is half of the distance between two staff lines. +;;; Given a staff-step value, determine the corresponding number of +;;; pixels in the current font. The sign of the value returned is +;;; the same as that of the argument. (defun staff-step (n) (* n (/ (staff-line-distance *font*) 2))) +;;; Given a pane, a glyph number, an x position (measured in pixels) +;;; and a y position (measured in staff steps), draw the glyph +;;; at the position in the pane. +;;; The font is organized so that the normal glyph is immediately +;;; followed by a light version of the glyph. Hence, we add 1 +;;; to the glyph number if a light version is desired. +;;; It appears that the resulting y-coordinate (in pixels) has the +;;; same sign as the staff-step argument, which suggests that this +;;; function must be called with a negated staff-step. It might be +;;; better to have this function do the negation. (defun draw-antialiased-glyph (pane glyph-no x staff-step) (let* ((extra (if *light-glyph* 1 0)) (matrix (glyph *font* (+ glyph-no extra))) @@ -152,6 +173,14 @@ (y1 (+ (staff-step staff-step) dy))) (draw-pixmap* pane pixmap x1 y1))))) +;;; Given a pane, an x position (measured in pixels) a y position +;;; (measured in staff steps), a glyph to draw a the bottom of the stack +;;; a glyph to draw at the top of the stack, a glyph to draws in the middle +;;; of the stack, and the number of elements of the stack, draw the stack +;;; by first drawing the lower glyph, then the intermediate glyphs, and +;;; finally the upper glyph. +;;; It appears that this function increases the staff step in each iteration, +;;; which seems incomptible with the way draw-antialiased-glyph appears to work. (defun draw-stack (pane glyph-lower glyph-upper glyph-two x staff-step how-many) (draw-antialiased-glyph pane glyph-lower x staff-step) (loop for ss from staff-step by 2 @@ -159,14 +188,20 @@ (draw-antialiased-glyph pane glyph-two x ss)) (draw-antialiased-glyph pane glyph-upper x (+ staff-step (* 2 (1- how-many))))) +;;; Draw a stack of whole-note noteheads +;;; This function is currently not used. (defun draw-whole-stack (pane x staff-step how-many) (draw-stack pane +glyph-whole-lower+ +glyph-whole-upper+ +glyph-whole-two+ x staff-step how-many)) +;;; draw a stack of half-note noteheads +;;; This function is currently not used. (defun draw-half-stack (pane x staff-step how-many) (draw-stack pane +glyph-half-lower+ +glyph-half-upper+ +glyph-half-two+ x staff-step how-many)) +;;; draw a stack of filled noteheads. +;;; This function is currently not used. (defun draw-filled-stack (pane x staff-step how-many) (draw-stack pane +glyph-filled-lower+ +glyph-filled-upper+ +glyph-filled-two+ x staff-step how-many))

1 0

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

07 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv25048 Modified Files: gui.lisp numbering.lisp packages.lisp Log Message: remove the numbering stuff in favor of just calling POSITION each time. We are likely going to change the representation of sequences from lists to something more elaborate anyway (where it matters), so the numbering will not be relevant in the future. Date: Mon Nov 7 06:23:58 2005 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.38 gsharp/gui.lisp:1.39 --- gsharp/gui.lisp:1.38 Wed Nov 2 20:28:09 2005 +++ gsharp/gui.lisp Mon Nov 7 06:23:57 2005 @@ -317,7 +317,6 @@ (setf (buffer *application-frame*) buffer (input-state *application-frame*) input-state (cursor *application-frame*) cursor) - (number-all (buffer *application-frame*)) (select-layer cursor (car (layers (segment (cursor *application-frame*))))))) (define-gsharp-command (com-save-buffer-as :name t) () Index: gsharp/numbering.lisp diff -u gsharp/numbering.lisp:1.5 gsharp/numbering.lisp:1.6 --- gsharp/numbering.lisp:1.5 Thu Nov 3 04:40:13 2005 +++ gsharp/numbering.lisp Mon Nov 7 06:23:57 2005 @@ -1,123 +1,20 @@ (in-package :gsharp-numbering) -(defmacro defnclass (name base slots) - `(progn - (define-added-mixin ,name ,() ,base - ((number :accessor number) - ,@slots)))) +(defmethod number ((element element)) + (position element (elements (bar element)))) -(defun number-elements (list) - (loop for elem in list - and i from 0 - do (setf (number elem) i))) +(defmethod number ((bar bar)) + (position bar (bars (slice bar)))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Element +(defmethod number ((slice slice)) + (let ((layer (layer slice))) + (cond ((eq slice (head layer)) 0) + ((eq slice (body layer)) 1) + ((eq slice (tail layer)) 2)))) -(defnclass nelement element - ()) +(defmethod number ((layer layer)) + (position layer (layers (segment layer)))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Bar +(defmethod number ((segment segment)) + (position segment (segments (buffer segment)))) -(defnclass nbar bar - ()) - -(defmethod add-element :after ((element nelement) (bar bar) position) - (declare (ignore position)) - (number-elements (elements bar))) - -(defmethod remove-element :around ((element nelement)) - (let ((bar (bar element))) - (call-next-method) - (number-elements (elements bar)))) - -(defmethod number-all ((bar bar)) - (number-elements (elements bar))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Slice - -(defnclass nslice slice - ()) - -(defmethod add-bar :after ((bar nbar) (slice slice) position) - (declare (ignore position)) - (number-elements (bars slice))) - -(defmethod remove-bar :around ((bar nbar)) - (let ((slice (slice bar))) - (call-next-method) - (number-elements (bars slice)))) - -(defmethod number-all ((slice slice)) - (number-elements (bars slice)) - (mapc #'number-all (bars slice))) - -(defmethod initialize-instance :after ((slice nslice) &rest args) - (declare (ignore args)) - (number-elements (bars slice))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Layer - -(defnclass nlayer layer - ()) - -(defmethod initialize-instance :after ((layer nlayer) &rest args) - (declare (ignore args)) - (setf (number (head layer)) 0 - (number (body layer)) 1 - (number (tail layer)) 2)) - -(defmethod number-all ((layer layer)) - (number-all (head layer)) - (number-all (body layer)) - (number-all (tail layer))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Segment - -(defnclass nsegment segment - ()) - -(defmethod add-layer :after ((layer nlayer) (segment segment)) - (number-elements (layers segment))) - -(defmethod remove-layer :around ((layer nlayer)) - (let ((segment (segment layer))) - (call-next-method) - (number-elements (layers segment)))) - -(defmethod number-all ((segment segment)) - (number-elements (layers segment)) - (mapc #'number-all (layers segment))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Buffer - -(defnclass nbuffer buffer - ()) - -(defmethod initialize-instance :after ((buffer nbuffer) &rest args) - (declare (ignore args)) - (number-elements (segments buffer))) - -(defmethod add-segment :after ((segment nsegment) (buffer buffer) position) - (declare (ignore position)) - (number-elements (segments buffer))) - -(defmethod remove-segment :around ((segment nsegment)) - (let ((buffer (buffer segment))) - (call-next-method) - (number-elements (segments buffer)))) - -(defmethod number-all ((buffer buffer)) - (number-elements (segments buffer)) - (mapc #'number-all (segments buffer))) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.24 gsharp/packages.lisp:1.25 --- gsharp/packages.lisp:1.24 Wed Nov 2 20:28:09 2005 +++ gsharp/packages.lisp Mon Nov 7 06:23:57 2005 @@ -77,7 +77,7 @@ (:use :gsharp-utilities :gsharp-buffer :clim-lisp) (:shadowing-import-from :gsharp-buffer #:rest) (:shadow #:number) - (:export #:number #:number-all)) + (:export #:number)) (defpackage :obseq (:use :common-lisp)

1 0

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

03 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv8429 Modified Files: esa.lisp Log Message: Sync esa with climacs. Date: Thu Nov 3 15:59:23 2005 Author: crhodes Index: gsharp/esa.lisp diff -u gsharp/esa.lisp:1.8 gsharp/esa.lisp:1.9 --- gsharp/esa.lisp:1.8 Tue Nov 1 10:50:16 2005 +++ gsharp/esa.lisp Thu Nov 3 15:59:23 2005 @@ -212,8 +212,11 @@ (defun process-gestures-or-command (frame command-table) (with-input-context - (`(or menu-item (command :command-table ,(command-table (car (windows frame)))))) + ('menu-item) (object) + (with-input-context + (`(command :command-table ,(command-table (car (windows frame))))) + (object) (let ((gestures '())) (multiple-value-bind (numarg numargp) (read-numeric-argument :stream *standard-input*) @@ -234,19 +237,19 @@ (execute-frame-command frame command) (return))) (t nil)))))) - (menu-item - (let ((command (command-menu-item-value object))) - (unless (listp command) - (setq command (list command))) - (when (and (typep (frame-standard-input frame) 'interactor-pane) - (member *unsupplied-argument-marker* command :test #'eq)) - (setq command - (command-line-read-remaining-arguments-for-partial-command - (frame-command-table frame) (frame-standard-input frame) - command 0))) - (execute-frame-command frame command))) (command - (execute-frame-command frame object)))) + (execute-frame-command frame object))) + (menu-item + (let ((command (command-menu-item-value object))) + (unless (listp command) + (setq command (list command))) + (when (and (typep (frame-standard-input frame) 'interactor-pane) + (member *unsupplied-argument-marker* command :test #'eq)) + (setq command + (command-line-read-remaining-arguments-for-partial-command + (frame-command-table frame) (frame-standard-input frame) + command 0))) + (execute-frame-command frame command))))) (defmethod redisplay-frame-panes :around ((frame esa-frame-mixin) &key force-p) (declare (ignore force-p)) @@ -278,7 +281,12 @@ do (restart-case (progn (handler-case - (process-gestures-or-command frame (command-table (car (windows frame)))) + (progn + ;; 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))))) (abort-gesture () (display-message "Quit"))) (redisplay-frame-panes frame)) (return-to-esa () nil))))))

1 0

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

03 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv24392/Doc Modified Files: buffer.tex Log Message: More constructors added. Date: Thu Nov 3 04:40:15 2005 Author: rstrandh Index: gsharp/Doc/buffer.tex diff -u gsharp/Doc/buffer.tex:1.7 gsharp/Doc/buffer.tex:1.8 --- gsharp/Doc/buffer.tex:1.7 Wed Nov 2 06:52:29 2005 +++ gsharp/Doc/buffer.tex Thu Nov 3 04:40:15 2005 @@ -249,6 +249,54 @@ used when two voices share a staff, and one voice has all the stems up and the other has all the stems down. +\Defun {make-rest} {staff \key (staff-pos 4) (notehead :filled) (lbeams 0) (rbeams 0) + (dots 0) (xoffset 0)} + +\Defun {make-lyrics-element} {staff \key (notehead :filled) (lbeams 0) (rbeams 0) + (dots 0) (xoffset 0)} + +%------------------------------------------------------------------- +\subsection{External representation} + + +%=================================================================== +\section{The bar protocol} + +%------------------------------------------------------------------- +\subsection{Description} + + +%------------------------------------------------------------------- +\subsection{Protocol classes and functions} + +\Defclass{bar} + +\Defclass{melody-bar} + +\Defun {make-melody-bar} {\key elements} + +\Defclass{lyrics-bar} + +\Defun {make-lyrics-bar} {\key elements} + +%------------------------------------------------------------------- +\subsection{External representation} + + +%=================================================================== +\section{The slice protocol} + +%------------------------------------------------------------------- +\subsection{Description} + + +%------------------------------------------------------------------- +\subsection{Protocol classes and functions} + +\Defclass{slice} + +\Defun {make-slice} {\key bars} + %------------------------------------------------------------------- \subsection{External representation}

1 0

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

03 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv24392 Modified Files: buffer.lisp numbering.lisp Log Message: More constructors added. Date: Thu Nov 3 04:40:14 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.22 gsharp/buffer.lisp:1.23 --- gsharp/buffer.lisp:1.22 Wed Nov 2 20:28:08 2005 +++ gsharp/buffer.lisp Thu Nov 3 04:40:13 2005 @@ -513,8 +513,10 @@ (defclass melody-bar (bar) ((print-character :allocation :class :initform #\|))) -(defun make-melody-bar () - (make-instance 'melody-bar)) +(defun make-melody-bar (&rest args &key elements) + (declare (type list elements) + (ignore elements)) + (apply #'make-instance 'melody-bar args)) (defun read-melody-bar-v3 (stream char n) (declare (ignore char n)) @@ -527,8 +529,10 @@ (defclass lyrics-bar (bar) ((print-character :allocation :class :initform #\C))) -(defun make-lyrics-bar () - (make-instance 'lyrics-bar)) +(defun make-lyrics-bar (&rest args &key elements) + (declare (type list elements) + (ignore elements)) + (apply #'make-instance 'lyrics-bar args)) (defun read-lyrics-bar-v3 (stream char n) (declare (ignore char n)) @@ -570,6 +574,11 @@ (loop for bar in (bars s) do (setf (slice bar) s))) +(defun make-slice (&rest args &key bars) + (declare (type list bars) + (ignore bars)) + (apply #'make-instance 'slice args)) + (defmethod print-object :after ((s slice) stream) (format stream ":bars ~W " (bars s))) @@ -681,9 +690,7 @@ (defmethod make-layer (name (initial-staff fiveline-staff)) (flet ((make-initialized-slice () - (let ((slice (make-instance 'slice))) - (add-bar (make-melody-bar) slice 0) - slice))) + (make-slice :bars (list (make-melody-bar))))) (let* ((head (make-initialized-slice)) (body (make-initialized-slice)) (tail (make-initialized-slice)) @@ -710,9 +717,7 @@ (defmethod make-layer (name (initial-staff lyrics-staff)) (flet ((make-initialized-slice () - (let ((slice (make-instance 'slice))) - (add-bar (make-lyrics-bar) slice 0) - slice))) + (make-slice :bars (list (make-lyrics-bar))))) (let* ((head (make-initialized-slice)) (body (make-initialized-slice)) (tail (make-initialized-slice)) Index: gsharp/numbering.lisp diff -u gsharp/numbering.lisp:1.4 gsharp/numbering.lisp:1.5 --- gsharp/numbering.lisp:1.4 Sun Aug 15 17:49:41 2004 +++ gsharp/numbering.lisp Thu Nov 3 04:40:13 2005 @@ -57,6 +57,10 @@ (number-elements (bars slice)) (mapc #'number-all (bars slice))) +(defmethod initialize-instance :after ((slice nslice) &rest args) + (declare (ignore args)) + (number-elements (bars slice))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Layer

1 0

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

02 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv19750 Modified Files: buffer.lisp gui.lisp packages.lisp Log Message: Put back some more constructors. Two things need to be fixed ultimately: * Clefs should not be named objects. Instead, the exact type should probably be identified by subclassing * There is not compelling reason for bars to be subclassed. The distinction between melody and lyrics (and percussion, ultimately) is enough to enforce at the level of the layer. Date: Wed Nov 2 20:28:09 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.21 gsharp/buffer.lisp:1.22 --- gsharp/buffer.lisp:1.21 Wed Nov 2 06:01:10 2005 +++ gsharp/buffer.lisp Wed Nov 2 20:28:08 2005 @@ -406,6 +406,19 @@ (setf text (make-array length :adjustable t :element-type 'fixnum :fill-pointer length :initial-contents text)))))) +(defun make-lyrics-element (staff &rest args + &key (notehead :filled) (lbeams 0) (rbeams 0) + (dots 0) (xoffset 0)) + (declare (type staff staff) + (type (member :whole :half :filled) notehead) + (type (integer 0 5) lbeams) + (type (integer 0 5) rbeams) + (type (integer 0 3) dots) + (type number xoffset) + (ignore notehead lbeams rbeams dots xoffset)) + (apply #'make-instance 'lyrics-element + :staff staff args)) + (defmethod print-object :after ((elem lyrics-element) stream) (with-slots (staff text) elem (format stream ":staff ~W :text ~W " staff text))) @@ -500,6 +513,9 @@ (defclass melody-bar (bar) ((print-character :allocation :class :initform #\|))) +(defun make-melody-bar () + (make-instance 'melody-bar)) + (defun read-melody-bar-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'melody-bar (read-delimited-list #\] stream t))) @@ -511,6 +527,9 @@ (defclass lyrics-bar (bar) ((print-character :allocation :class :initform #\C))) +(defun make-lyrics-bar () + (make-instance 'lyrics-bar)) + (defun read-lyrics-bar-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'lyrics-bar (read-delimited-list #\] stream t))) @@ -594,7 +613,7 @@ (setf bars (delete bar bars :test #'eq)) (unless bars ;; make sure there is one bar left - (add-bar (make-instance 'melody-bar) slice 0))) + (add-bar (make-melody-bar) slice 0))) (setf slice nil))) (defmethod remove-bar ((bar lyrics-bar)) @@ -604,7 +623,7 @@ (setf bars (delete bar bars :test #'eq)) (unless bars ;; make sure there is one bar left - (add-bar (make-instance 'lyrics-bar) slice 0))) + (add-bar (make-lyrics-bar) slice 0))) (setf slice nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -663,7 +682,7 @@ (defmethod make-layer (name (initial-staff fiveline-staff)) (flet ((make-initialized-slice () (let ((slice (make-instance 'slice))) - (add-bar (make-instance 'melody-bar) slice 0) + (add-bar (make-melody-bar) slice 0) slice))) (let* ((head (make-initialized-slice)) (body (make-initialized-slice)) @@ -692,7 +711,7 @@ (defmethod make-layer (name (initial-staff lyrics-staff)) (flet ((make-initialized-slice () (let ((slice (make-instance 'slice))) - (add-bar (make-instance 'lyrics-bar) slice 0) + (add-bar (make-lyrics-bar) slice 0) slice))) (let* ((head (make-initialized-slice)) (body (make-initialized-slice)) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.37 gsharp/gui.lisp:1.38 --- gsharp/gui.lisp:1.37 Wed Nov 2 06:01:10 2005 +++ gsharp/gui.lisp Wed Nov 2 20:28:09 2005 @@ -1118,12 +1118,11 @@ (defun insert-lyrics-element () (let* ((state (input-state *application-frame*)) (cursor (cursor *application-frame*)) - (element (make-instance 'lyrics-element + (element (make-lyrics-element (car (staves (layer (cursor *application-frame*)))) :rbeams (if (eq (notehead state) :filled) (rbeams state) 0) :lbeams (if (eq (notehead state) :filled) (lbeams state) 0) :dots (dots state) - :notehead (notehead state) - :staff (car (staves (layer (cursor *application-frame*))))))) + :notehead (notehead state)))) (insert-element element cursor) (forward-element cursor) element)) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.23 gsharp/packages.lisp:1.24 --- gsharp/packages.lisp:1.23 Wed Nov 2 06:01:10 2005 +++ gsharp/packages.lisp Wed Nov 2 20:28:09 2005 @@ -51,7 +51,8 @@ #:slice #:elements #:nb-elements #:elementno #:add-element #:remove-element #:bar #:make-bar - #:melody-bar #:lyrics-bar + #:melody-bar #:make-melody-bar + #:lyrics-bar #:make-lyrics-bar #:layer #:lyrics-layer #:melody-layer #:bars #:nb-bars #:barno #:add-bar #:remove-bar #:slice

1 0

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

02 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv26451 Modified Files: buffer.tex Log Message: Fixed a minor problem preventing compilation Date: Wed Nov 2 06:52:29 2005 Author: rstrandh Index: gsharp/Doc/buffer.tex diff -u gsharp/Doc/buffer.tex:1.6 gsharp/Doc/buffer.tex:1.7 --- gsharp/Doc/buffer.tex:1.6 Wed Nov 2 06:01:18 2005 +++ gsharp/Doc/buffer.tex Wed Nov 2 06:52:29 2005 @@ -199,7 +199,7 @@ \Defclass{cluster} -\Defun {make-cluster} {&key (notehead :filled) (lbeams 0) (rbeams 0) +\Defun {make-cluster} {\key (notehead :filled) (lbeams 0) (rbeams 0) (dots 0) (xoffset 0) notes (stem-direction :auto))} Create a cluster.

1 0