From rstrandh at common-lisp.net Mon Feb 16 15:47:24 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 16 Feb 2004 10:47:24 -0500 Subject: [gsharp-cvs] CVS update: Module imported: gsharp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv3901 Log Message: import of 0.2 Status: Vendor Tag: strandh Release Tags: release-0-dot-2 N gsharp/INSTALL N gsharp/beaming.lisp N gsharp/buffer.lisp N gsharp/charmap.lisp N gsharp/cursor.lisp N gsharp/drawing.lisp N gsharp/gf.lisp N gsharp/glyphs.lisp N gsharp/gui.lisp N gsharp/input-state.lisp N gsharp/measure.lisp N gsharp/midi.lisp N gsharp/numbering.lisp N gsharp/packages.lisp N gsharp/postscript.lisp N gsharp/score-pane.lisp N gsharp/sdl.lisp N gsharp/system.lisp N gsharp/utilities.lisp N gsharp/Doc/Makefile N gsharp/Doc/accidentals.tex N gsharp/Doc/beaming-algo.tex N gsharp/Doc/beaming.tex N gsharp/Doc/commands.tex N gsharp/Doc/gsharp.tex N gsharp/Doc/history.tex N gsharp/Doc/intro.tex N gsharp/Doc/linebreak.tex N gsharp/Doc/model.tex N gsharp/Doc/obseq.tex N gsharp/Doc/old-beaming.tex N gsharp/Doc/plans.tex N gsharp/Doc/release-notes.tex N gsharp/Doc/spec-macros.tex N gsharp/Doc/strip-dependence N gsharp/Doc/tex-dependencies N gsharp/Fonts/Makefile N gsharp/Fonts/accents.mf N gsharp/Fonts/accidentals.mf N gsharp/Fonts/beams.mf N gsharp/Fonts/c_clef.mf N gsharp/Fonts/charmap.mf N gsharp/Fonts/clefs.mf N gsharp/Fonts/dot.mf N gsharp/Fonts/double-flat.mf N gsharp/Fonts/double-sharp.mf N gsharp/Fonts/eighth_rest.mf N gsharp/Fonts/f_clef.mf N gsharp/Fonts/flags.mf N gsharp/Fonts/flat.mf N gsharp/Fonts/g_clef.mf N gsharp/Fonts/half_rest.mf N gsharp/Fonts/macros.mf N gsharp/Fonts/natural.mf N gsharp/Fonts/noteheads.mf N gsharp/Fonts/quarter_rest.mf N gsharp/Fonts/rests.mf N gsharp/Fonts/sdl.mf N gsharp/Fonts/sharp.mf N gsharp/Fonts/whole_rest.mf N gsharp/Obseq/obseq.lisp N gsharp/Obseq/obseq.x86f N gsharp/Scores/alundavisan.gsh N gsharp/Scores/bach181.gsh N gsharp/Scores/bach262.gsh N gsharp/Scores/blomsteroffret.gsh N gsharp/Scores/clusters.gsh N gsharp/Scores/clusters2.gsh N gsharp/Scores/elise2.gsh N gsharp/Scores/rapsoden-sjunger.gsh N gsharp/Scores/smaland.gsh N gsharp/Scores/stuff.gsh N gsharp/Scores/test.gsh N gsharp/Scores/tomtegubbar.gsh N gsharp/Scores/tomtegubbar2.gsh N gsharp/Scores/vinter-adjo.gsh No conflicts created by this import Date: Mon Feb 16 10:47:23 2004 Author: rstrandh New module gsharp added From rstrandh at common-lisp.net Mon Feb 16 15:51:18 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 16 Feb 2004 10:51:18 -0500 Subject: [gsharp-cvs] CVS update: gsharp/Obseq/obseq.x86f Message-ID: Update of /project/gsharp/cvsroot/gsharp/Obseq In directory common-lisp.net:/tmp/cvs-serv20865 Removed Files: obseq.x86f Log Message: Sorry. This made it to the repository by accident. Date: Mon Feb 16 10:51:18 2004 Author: rstrandh From rstrandh at common-lisp.net Mon Feb 16 16:08:02 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 16 Feb 2004 11:08:02 -0500 Subject: [gsharp-cvs] CVS update: gsharp/Doc/model.tex gsharp/Doc/plans.tex gsharp/Doc/release-notes.tex Message-ID: Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv24224/Doc Modified Files: model.tex plans.tex release-notes.tex Log Message: Updates since 0.2 release. Date: Mon Feb 16 11:08:02 2004 Author: rstrandh Index: gsharp/Doc/model.tex diff -u gsharp/Doc/model.tex:1.1.1.1 gsharp/Doc/model.tex:1.2 --- gsharp/Doc/model.tex:1.1.1.1 Mon Feb 16 10:46:28 2004 +++ gsharp/Doc/model.tex Mon Feb 16 11:08:01 2004 @@ -45,7 +45,7 @@ corresponding roughly to a \emph{voice} \index{voice} or a \emph{part} \index{part} of the music. -The difference between a layer and a part ({gs} does not know about +The difference between a layer and a part ({\gs} does not know about parts) is that a layer has a particular \emph{instrument} \index{instrument} assigned to it, whereas a part can have several different instruments, for instance when the same musician plays Index: gsharp/Doc/plans.tex diff -u gsharp/Doc/plans.tex:1.1.1.1 gsharp/Doc/plans.tex:1.2 --- gsharp/Doc/plans.tex:1.1.1.1 Mon Feb 16 10:46:31 2004 +++ gsharp/Doc/plans.tex Mon Feb 16 11:08:01 2004 @@ -90,8 +90,86 @@ the notes of the element. \end{itemize} +\subsection{Other minor projects} + +\begin{itemize} +\item multi-buffer, multi-frame +\item display additional information around current element (beaming + information, stem information (auto or not)), etc +\end{itemize} + \section{Major projects} +\subsection{Improved spacing algorithm} + +There are two aspects of the spacing algorithm: + +\begin{enumerate} +\item Determining how to divide a sequence of measures into pages and + lines based on the amount of space each measure will require on a + given line, +\item Rendering the page(s) actually visible by the user at any given + time. +\end{enumerate} + +We can spend relatively much time on rendering since it is supposedly +only done for a small fraction of the entire score and relatively +little time on dividing sequences of measures into pages and lines. +Also, we can accept a rough estimate of the space that a measure needs +for the purpose of dividing into pages and lines, whereas the +rendering phase needs to be very precise so as to avoid overlapping +characters. + +For rendering, we can assume that we have a bunch of \emph{lines}, +each one being a \emph{sequence of measures}. For this phase, one +idea would be to compute an \emph{elasticity function} for each +measure indicating how willing it is to stretch or compress given that +a certain force is applied to it. In fact it would indicate the width +as a function of force applied. Such a function would be piecewise +linear with rational coordinates to avoid rounding errors. The +elasticity function of a line would be the sum of the elasticity +functions of the measures of the line, again a piecewise linear +function. The combined function would then be solved for the line +length which gives a force to be applied to each measure (elementary +mechanics give that each measure in the sequence would have the same +force applied to it). To render each measure, that force would be +applied to it. + +The problem with dividing a sequence of measures into lines and pages +is that the elasticity function depends on the context. Specifically, +the \emph{natural width} (the width that the measure would take when +given a force of 0) depends on the smallest distance between two +adjacent time lines \emph{of all of the time lines in all of the +measures on a line}. This gets messy, since currently, we depend on +the cost function of a line to be combined in constant time, i.e., the +cost function of a line with a new measure added to the beginning or +to the end of it is possible to compute in constant time from the cost +function of the existing line and that of the new measure. Either I +am being to conservative here, and we can afford to spend more time +computing the cost function of a line, or else, we need to find an +approximation of the elasticity function that will combine in constant +time. This is hard to know until we have tested {\gs} on large +scores, and until we have implemented the page-breaking algorithm (as +opposed to the line-breaking algorithm that we now have). An example +of an approximation of the elasticity function would be to use the +current estimate with an additional value called \emph{additional +constant space}. The cost combination function would add the constant +spaces required by each measure as long as newly added measures have +the same smallest time-line distance (min-dist). As soon as a measure +with smaller min-dist is added to the line, the additional constant +space of the existing line is set to 0. The assumption is that the +existing line is going to have to expand as a result of the smaller +min-dist which will eliminate the need for the additional constant +space. Adding a measure with a larger min-dist than that of the +existing line would simply ignore the additional constant space of +that measure. Again, the assumption is that the new measure will have +to expand so that the additional space will not be needed. + +The additional constant spaced of a measure would be computed as if it +would be inserted into a line having the same min-dist as the measure +itself. Such space would include space for lyrics, accidentals of +complicated clusters, etc. + \subsection{Menu items with arguments} This is a {\clim} project. Currently {\clim} does not know how to @@ -141,3 +219,41 @@ \item Pages with an arbitrary number of pages, but the number must be of the form $n = ax + b$. \end{itemize} + +\subsection{Other major projects} + +\begin{itemize} +\item presentations everywhere (note heads, clusters, beam groups). +\item context menus on notes, etc +\item allow mouse-based input of new notes by making staff steps + around cursor into presentations. Move pointer to horizontal + location of cursor after interaction. +\item allow mouse-based addition and deletion of notes in existing + clusters by making staff steps around cluster into presentations +\item make sure user can use either keyboard or mouse without changing + too often +\item add new views of score, especially to manipulate staves, + brackets, braces, instruments, etc. +\item perhaps hide interactor by default and use something like M-x to + make it visible. +\item use output recording (hierarchical records) to reorganize pixmaps + and to substitute combined pixmaps. +\end{itemize} + +\section{McCLIM issues and projects} + +\begin{itemize} +\item add better system for Emacs-style commands and key + bindings +\item fix problem of input focus being retained (also a + problem for Goatee) +\item make sure gestures work as announced +\item perhaps make it possible to use something like M-x to change + input focus +\item make setf of frame-layout work +\item multiple top-level frames (as in Franz CLIM). +\item remove compilation warnings in McCLIM +\item remove dead code +\item remove reasons for remarks such as XXX:, FIXME, etc, or at least + put a name in their place +\end{itemize} \ No newline at end of file Index: gsharp/Doc/release-notes.tex diff -u gsharp/Doc/release-notes.tex:1.1.1.1 gsharp/Doc/release-notes.tex:1.2 --- gsharp/Doc/release-notes.tex:1.1.1.1 Mon Feb 16 10:46:31 2004 +++ gsharp/Doc/release-notes.tex Mon Feb 16 11:08:01 2004 @@ -1,5 +1,34 @@ \chapter{Release notes} +\section{Release 0.3 (2003-??-??)} + +\subsection{Features added from 0.2} + +\begin{itemize} +\item right edge of staff is no longer hard wired. +\item left margin is now a parameter of the buffer (and on disk). +\item x-position of first measure on line now depends on the size of + the key signature. This means that wide key signatures no longer + overlap with notes of the first measure on the line. +\item Improved MIDI generation making it no longer necessary to pad +measures with empty clusters. +\item Fixed a problem that made {\gs} crash on new versions of + McCLIM (thanks to Andy Hefner for figuring this out). +\item {\gs} can now use asdf instead of mk:defystem (thanks to + Christophe Rhodes). +\item {\gs} now runs on SBCL as well as on CMUCL (thanks to Christophe + Rhodes). +\end{itemize} + +\subsection{Bug fixes from 0.2} + +\begin{itemize} +\item last sharp sign in key signature with seven sharp signs is now + drawn. +\item fixed conformance bugs in some \texttt{loop} constructs (thanks to + Christophe Rhodes). +\end{itemize} + \section{Release 0.2 (2003-09-06)} \subsection{Features added from 0.1} From rstrandh at common-lisp.net Mon Feb 16 16:08:01 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 16 Feb 2004 11:08:01 -0500 Subject: [gsharp-cvs] CVS update: gsharp/beaming.lisp gsharp/buffer.lisp gsharp/drawing.lisp gsharp/gui.lisp gsharp/measure.lisp gsharp/packages.lisp gsharp/system.lisp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv24224 Modified Files: beaming.lisp buffer.lisp drawing.lisp gui.lisp measure.lisp packages.lisp system.lisp Log Message: Updates since 0.2 release. Date: Mon Feb 16 11:08:00 2004 Author: rstrandh Index: gsharp/beaming.lisp diff -u gsharp/beaming.lisp:1.1.1.1 gsharp/beaming.lisp:1.2 --- gsharp/beaming.lisp:1.1.1.1 Mon Feb 16 10:46:06 2004 +++ gsharp/beaming.lisp Mon Feb 16 11:08:00 2004 @@ -9,10 +9,10 @@ ;;; The result of the computation is a VALID BEAMING. Such a beaming ;;; is represented as a list of two elements representing the left and -;;; the right end of the beam, respectively. Each element is a cons -;;; of two integers, the fist representing the staff line where the -;;; lower line is numbered 0, and so on in steps of two so that the -;;; upper one is numbered 8. The second of the two integers +;;; the right end of the primary beam, respectively. Each element is +;;; a cons of two integers, the fist representing the staff line where +;;; the lower line is numbered 0, and so on in steps of two so that +;;; the upper one is numbered 8. The second of the two integers ;;; represents the position of the beam with respect to the staff ;;; line, where 0 means straddle, 1 means sit and -1 means hang. This ;;; representation makes it easy to transform the constellation by Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.1.1.1 gsharp/buffer.lisp:1.2 --- gsharp/buffer.lisp:1.1.1.1 Mon Feb 16 10:46:10 2004 +++ gsharp/buffer.lisp Mon Feb 16 11:08:00 2004 @@ -815,7 +815,7 @@ (defgeneric staves (buffer)) ;;; Find a staff based on its name -(defgeneric find-staff (staff-name buffer &optional (errorp t))) +(defgeneric find-staff (staff-name buffer &optional errorp)) ;;; Add a segment to the buffer at the position given (defgeneric add-segment (segment buffer position)) @@ -826,7 +826,8 @@ (defvar *default-spacing-style* 0.4) (defvar *default-min-width* 17) (defvar *default-right-edge* 700) -(defvar *default-left-offset* 70) +(defvar *default-left-offset* 30) +(defvar *default-left-margin* 20) (defclass buffer () ((segments :initform '() :initarg :segments :accessor segments) @@ -834,12 +835,13 @@ (min-width :initform *default-min-width* :initarg :min-width :accessor min-width) (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))) + (left-offset :initform *default-left-offset* :initarg :left-offset :accessor left-offset) + (left-margin :initform *default-left-margin* :initarg :left-margin :accessor left-margin))) (defmethod print-object ((b buffer) stream) - (with-slots (staves segments min-width spacing-style right-edge left-offset) b - (format stream "[B :staves ~W :segments ~W :min-width ~W :spacing-style ~W :right-edge ~W :left-offset ~W ] " - staves segments min-width spacing-style right-edge left-offset))) + (with-slots (staves segments min-width spacing-style right-edge left-offset left-margin) b + (format stream "[B :staves ~W :segments ~W :min-width ~W :spacing-style ~W :right-edge ~W :left-offset ~W :left-margin ~W ] " + staves segments min-width spacing-style right-edge left-offset left-margin))) (defun make-empty-buffer () (make-instance 'buffer)) Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.1.1.1 gsharp/drawing.lisp:1.2 --- gsharp/drawing.lisp:1.1.1.1 Mon Feb 16 10:46:11 2004 +++ gsharp/drawing.lisp Mon Feb 16 11:08:00 2004 @@ -25,7 +25,7 @@ (:bass (lineno (clef staff))) (:treble (+ (lineno (clef staff)) 6)) (:c (+ (lineno (clef staff))) 3)))) - (loop for pitch in '(3 0 4 1 5 2) + (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 (staff-step 8)) by (staff-step 2.5) while (eq (aref (keysig staff) pitch) :sharp) @@ -96,28 +96,38 @@ (staff-yoffset (car (last staves))))))) (defmethod draw-buffer (pane (buffer buffer) *cursor* x y draw-cursor) - (let ((method (buffer-cost-method buffer)) - (staves (staves buffer))) - (loop for staff in staves - for offset from 0 by -90 do - (setf (staff-yoffset staff) offset)) - (with-staff-size 6 + (with-staff-size 6 + (let* ((staves (staves buffer)) + (timesig-offset (max (* (staff-step 2) + (loop for staff in staves + maximize (count :flat (keysig staff)))) + (* (staff-step 2.5) + (loop for staff in staves + maximize (count :sharp (keysig staff)))))) + (method (let ((old-method (buffer-cost-method buffer))) + (make-measure-cost-method (min-width old-method) + (spacing-style old-method) + (- (line-width old-method) timesig-offset)))) + (right-edge (right-edge buffer))) + (loop for staff in staves + for offset downfrom 0 by 90 do + (setf (staff-yoffset staff) offset)) (let ((yy y)) (gsharp-measure::new-map-over-obseq-subsequences (lambda (measures) (let ((widths (compute-widths measures method))) (with-vertical-score-position (pane yy) - (draw-system pane measures (+ x (left-offset buffer)) + (draw-system pane measures (+ x (left-offset buffer) timesig-offset) widths method staves draw-cursor) - (draw-bar-line pane (+ x 20) + (draw-bar-line pane x (staff-step 8) (staff-yoffset (car (last staves))))) (loop for staff in staves do (with-vertical-score-position (pane yy) (if (member staff (staves (layer (slice (bar *cursor*))))) - (draw-staff-and-clef pane staff (+ x 20) 700) + (draw-staff-and-clef pane staff x right-edge) (with-light-glyphs pane - (draw-staff-and-clef pane staff (+ x 20) 700)))) + (draw-staff-and-clef pane staff x right-edge)))) (decf yy 90)))) buffer))))) @@ -351,7 +361,7 @@ ;;; ;;; Cluster -(defgeneric draw-element (pane element x &optional (flags t))) +(defgeneric draw-element (pane element x &optional flags)) (defmethod note-difference ((note1 note) (note2 note)) (- (pitch note1) (pitch note2))) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.1.1.1 gsharp/gui.lisp:1.2 --- gsharp/gui.lisp:1.1.1.1 Mon Feb 16 10:46:17 2004 +++ gsharp/gui.lisp Mon Feb 16 11:08:00 2004 @@ -81,9 +81,10 @@ (add-command '(#\[) 'com-fewer-lbeams *x-command-table*) (add-command '(#\]) 'com-fewer-rbeams *x-command-table*) -(defmethod redisplay-frame-panes (frame &key force-p) - (loop for pane in (frame-panes frame) - do (redisplay-frame-pane frame pane :force-p force-p))) +(defmethod redisplay-gsharp-panes (frame &key force-p) + (loop for pane in (frame-current-panes frame) + do (when (typep pane 'score-pane) + (redisplay-frame-pane frame pane :force-p force-p)))) (defvar *gsharp-frame*) @@ -99,7 +100,7 @@ (setf *commands* *global-command-table*)) (t (format *error-output* "no command for ~a~%" key) (setf *commands* *global-command-table*))) - (redisplay-frame-panes *gsharp-frame* :force-p t)))) + (redisplay-gsharp-panes *gsharp-frame* :force-p t)))) (define-application-frame gsharp () ((buffer :initarg :buffer :accessor buffer) @@ -109,16 +110,17 @@ (:pointer-documentation t) (:panes (score (make-pane 'score-pane - :width 700 - :height 900 + :width 700 :height 900 + :name "score" :display-function 'display-score)) (state (make-pane 'score-pane - :width 50 :height 200 :display-function 'display-state)) + :width 50 :height 200 + :name "state" + :display-function 'display-state)) (element (make-pane 'score-pane - :width 50 - :height 700 - :min-height 100 - :max-height 20000 + :width 50 :height 700 + :min-height 100 :max-height 20000 + :name "element" :display-function 'display-element)) (interactor :interactor :height 100 :min-height 50 :max-height 200)) (:layouts @@ -167,10 +169,10 @@ (declare (ignore up)) (let ((x (+ xpos right))) (loop repeat (rbeams state) - for staff-step from 12 by -2 do + for staff-step downfrom 12 by 2 do (draw-beam pane x staff-step 0 (+ x 10) staff-step 0)) (loop repeat (lbeams state) - for staff-step from 12 by -2 do + for staff-step downfrom 12 by 2 do (draw-beam pane (- x 10) staff-step 0 x staff-step 0))))) (draw-right-stem pane xpos (staff-step 4) (staff-step 12)))) (with-notehead-right-offsets (right up) @@ -240,7 +242,8 @@ (recompute-measures buffer) (with-score-pane pane (flet ((draw-cursor (x) (draw-the-cursor pane x))) - (draw-buffer pane buffer (cursor *gsharp-frame*) 0 800 #'draw-cursor))))) + (draw-buffer pane buffer (cursor *gsharp-frame*) + (left-margin buffer) 800 #'draw-cursor))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -300,7 +303,7 @@ ("Segment" :menu segment-command-table) ("Layer" :menu layer-command-table) ("Slice" :menu slice-command-table) - ("Bar" :menu bar-command-table) + ("Measure" :menu measure-command-table) ("Modes" :menu modes-command-table) ("Play" :menu play-command-table))) @@ -316,7 +319,7 @@ ("Save as" :command com-save-buffer-as) ("Quit" :command com-quit))) -(define-gsharp-command com-new-buffer () +(define-gsharp-command (com-new-buffer :name t) () (let* ((buffer (make-initialized-buffer)) (cursor (make-initial-cursor buffer)) (staff (car (staves buffer))) @@ -326,7 +329,7 @@ (input-state *gsharp-frame*) input-state (staves (car (layers (car (segments buffer))))) (list staff)))) -(define-gsharp-command com-load-file ((filename 'string :prompt "File Name")) +(define-gsharp-command (com-load-file :name t) ((filename 'string :prompt "File Name")) (let* ((buffer (read-everything filename)) (staff (car (staves buffer))) (input-state (make-input-state staff)) @@ -336,14 +339,14 @@ (cursor *gsharp-frame*) cursor) (number-all (buffer *gsharp-frame*)))) -(define-gsharp-command com-save-buffer-as ((filename 'string :prompt "File Name")) +(define-gsharp-command (com-save-buffer-as :name t) ((filename 'string :prompt "File Name")) (with-open-file (stream filename :direction :output) (save-buffer-to-stream (buffer *gsharp-frame*) stream) (message "Saved buffer to ~A~%" filename))) -(define-gsharp-command com-quit () - (unix::unix-exit)) -;; (frame-exit *application-frame*)) +(define-gsharp-command (com-quit :name t) () + #+cmu (unix::unix-exit) + #+sbcl (frame-exit *application-frame*)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -368,21 +371,21 @@ ("Insert After Current" :command com-insert-segment-after) ("Insert Before Current" :command com-insert-segment-before))) -(define-gsharp-command com-forward-segment () +(define-gsharp-command (com-forward-segment :name t) () (forward-segment (cursor *gsharp-frame*))) -(define-gsharp-command com-backward-segment () +(define-gsharp-command (com-backward-segment :name t) () (backward-segment (cursor *gsharp-frame*))) -(define-gsharp-command com-delete-segment () +(define-gsharp-command (com-delete-segment :name t) () (delete-segment (cursor *gsharp-frame*))) -(define-gsharp-command com-insert-segment-before () +(define-gsharp-command (com-insert-segment-before :name t) () (let ((cursor (cursor *gsharp-frame*))) (insert-segment-before (make-initialized-segment) cursor) (backward-segment cursor))) -(define-gsharp-command com-insert-segment-after () +(define-gsharp-command (com-insert-segment-after :name t) () (let ((cursor (cursor *gsharp-frame*))) (insert-segment-after (make-initialized-segment) cursor) (forward-segment cursor))) @@ -400,21 +403,21 @@ ("Insert After Current" :command com-insert-layer-after) ("Insert Before Current" :command com-insert-layer-before))) -(define-gsharp-command com-next-layer () +(define-gsharp-command (com-next-layer :name t) () (next-layer (cursor *gsharp-frame*)) (setf (staff (input-state *gsharp-frame*)) (car (staves (layer (slice (bar (cursor *gsharp-frame*)))))))) -(define-gsharp-command com-previous-layer () +(define-gsharp-command (com-previous-layer :name t) () (previous-layer (cursor *gsharp-frame*)) (setf (staff (input-state *gsharp-frame*)) (car (staves (layer (slice (bar (cursor *gsharp-frame*)))))))) -(define-gsharp-command com-delete-layer () +(define-gsharp-command (com-delete-layer :name t) () (delete-layer (cursor *gsharp-frame*))) -(define-gsharp-command com-insert-layer-before ((staff-name 'string :prompt "Staff")) +(define-gsharp-command (com-insert-layer-before :name t) ((staff-name 'string :prompt "Staff")) (let ((cursor (cursor *gsharp-frame*)) (staff (find-staff staff-name (buffer *gsharp-frame*)))) (if (not staff) @@ -426,7 +429,7 @@ (setf (staff (input-state *gsharp-frame*)) staff)))))) -(define-gsharp-command com-insert-layer-after ((staff-name 'string :prompt "Staff")) +(define-gsharp-command (com-insert-layer-after :name t) ((staff-name 'string :prompt "Staff")) (let ((cursor (cursor *gsharp-frame*)) (staff (find-staff staff-name (buffer *gsharp-frame*)))) (if (not staff) @@ -450,19 +453,19 @@ ("Body" :command com-body-slice) ("Tail" :command com-tail-slisce))) -(define-gsharp-command com-head-slice () +(define-gsharp-command (com-head-slice :name t) () (head-slice (cursor *gsharp-frame*))) -(define-gsharp-command com-body-slice () +(define-gsharp-command (com-body-slice :name t) () (body-slice (cursor *gsharp-frame*))) -(define-gsharp-command com-tail-slice () +(define-gsharp-command (com-tail-slice :name t) () (tail-slice (cursor *gsharp-frame*))) -(define-gsharp-command com-forward-slice () +(define-gsharp-command (com-forward-slice :name t) () (forward-slice (cursor *gsharp-frame*))) -(define-gsharp-command com-backward-slice () +(define-gsharp-command (com-backward-slice :name t) () (backward-slice (cursor *gsharp-frame*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -470,16 +473,15 @@ ;;; bar menu (make-command-table - 'bar-command-table + 'measure-command-table :errorp nil - :menu '(("Forward" :command com-forward-bar) - ("Backward" :command com-backward-bar) - ("Delete Current" :command com-delete-bar))) + :menu '(("Forward" :command com-forward-measure) + ("Backward" :command com-backward-measure))) -(define-gsharp-command com-forward-bar () +(define-gsharp-command (com-forward-measure :name t) () (forward-bar (cursor *gsharp-frame*))) -(define-gsharp-command com-backward-bar () +(define-gsharp-command (com-backward-measure :name t) () (backward-bar (cursor *gsharp-frame*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -491,7 +493,7 @@ :errorp nil :menu '(("Fundamental" :command com-fundamental))) -(define-gsharp-command com-fundamental () +(define-gsharp-command (com-fundamental :name t) () nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -510,52 +512,80 @@ (ecase (accidentals note) (:double-flat -2) (:flat -1) (:natural 0) (:sharp 1) (:double-sharp 2)))) -(defun track-from-slice (slice channel) +(defun measure-durations (slices) + (let ((durations (mapcar (lambda (slice) + (mapcar (lambda (bar) + (reduce #'+ (elements bar) + :key #'element-duration)) + (bars slice))) + slices))) + (loop while durations + collect (reduce #'max (mapcar #'car durations)) + do (setf durations (remove nil (mapcar #'cdr durations)))))) + +(defun events-from-element (element time channel) + (when (typep element 'cluster) + (append (mapcar (lambda (note) + (make-instance 'note-on-message + :time time + :status (+ #x90 channel) + :key (midi-pitch note) :velocity 100)) + (notes element)) + (mapcar (lambda (note) + (make-instance 'note-off-message + :time (+ time (* 128 (element-duration element))) + :status (+ #x80 channel) + :key (midi-pitch note) :velocity 100)) + (notes element))))) + +(defun events-from-bar (bar time channel) + (mapcan (lambda (element) + (prog1 (events-from-element element time channel) + (incf time (* 128 (element-duration element))))) + (elements bar))) + +(defun track-from-slice (slice channel durations) (cons (make-instance 'program-change-message :time 0 :status (+ #xc0 channel) :program 0) (let ((time 0)) - (mapcan - (lambda (bar) - (mapcan - (lambda (element) - (prog1 (when (typep element 'cluster) - (append (mapcar (lambda (note) - (make-instance 'note-on-message - :time time - :status (+ #x90 channel) - :key (midi-pitch note) :velocity 100)) - (notes element)) - (mapcar (lambda (note) - (make-instance 'note-off-message - :time (+ time (* 128 (element-duration element))) - :status (+ #x80 channel) - :key (midi-pitch note) :velocity 100)) - (notes element)))) - (incf time (* 128 (element-duration element))))) - (elements bar))) - (bars slice))))) - -(define-gsharp-command com-play-segment () + (mapcan (lambda (bar duration) + (prog1 (events-from-bar bar time channel) + (incf time (* 128 duration)))) + (bars slice) durations)))) + +(define-gsharp-command (com-play-segment :name t) () (let* ((slices (mapcar #'body (layers (car (segments (buffer *gsharp-frame*)))))) + (durations (measure-durations slices)) (tracks (loop for slice in slices for i from 0 - collect (track-from-slice slice i))) + collect (track-from-slice slice i durations))) (midifile (make-instance 'midifile :format 1 :division 25 :tracks tracks))) (write-midi-file midifile "test.mid") - (ext:run-program "timidity" '("test.mid")))) + #+cmu + (ext:run-program "timidity" '("test.mid")) + #+sbcl + (sb-ext:run-program "timidity" '("test.mid")) + #-(or cmu sbcl) + (error "write compatibility layer for RUN-PROGRAM"))) -(define-gsharp-command com-play-layer () +(define-gsharp-command (com-play-layer :name t) () (let* ((slice (body (layer (slice (bar (cursor *gsharp-frame*)))))) - (tracks (list (track-from-slice slice 0))) + (durations (measure-durations (list slice))) + (tracks (list (track-from-slice slice 0 durations))) (midifile (make-instance 'midifile :format 1 :division 25 :tracks tracks))) (write-midi-file midifile "test.mid") - (ext:run-program "timidity" '("test.mid")))) + #+cmu + (ext:run-program "timidity" '("test.mid")) + #+sbcl + (sb-ext:run-program "timidity" '("test.mid")) + #-(or cmu sbcl) + (error "write compatibility layer for RUN-PROGRAM"))) (defun run-gsharp () (loop for port in climi::*all-ports* @@ -926,7 +956,7 @@ (:up :down) (:down :auto)))) -(define-gsharp-command com-set-clef ((name '(member :treble :bass :c)) +(define-gsharp-command (com-set-clef :name t) ((name '(member :treble :bass :c)) (line '(or integer null) :prompt "Line")) (setf (clef (staff (input-state *gsharp-frame*))) (make-clef name line))) @@ -952,23 +982,23 @@ ;;; ;;; Adding, deleting, and modifying staves -(define-gsharp-command com-add-staff ((name 'string)) +(define-gsharp-command (com-add-staff :name t) ((name 'string)) (add-new-staff-to-buffer name (buffer *gsharp-frame*))) -(define-gsharp-command com-delete-staff ((name 'string)) +(define-gsharp-command (com-delete-staff :name t) ((name 'string)) (remove-staff-from-buffer name (buffer *gsharp-frame*))) -(define-gsharp-command com-rename-staff ((name 'string)) +(define-gsharp-command (com-rename-staff :name t) ((name 'string)) (let ((buffer (buffer *gsharp-frame*)) (state (input-state *gsharp-frame*))) (rename-staff name (staff state) buffer))) -(define-gsharp-command com-add-layer-staff ((name 'string)) +(define-gsharp-command (com-add-layer-staff :name t) ((name 'string)) (let ((staff (find-staff name (buffer *gsharp-frame*))) (layer (layer (slice (bar (cursor *gsharp-frame*)))))) (add-staff-to-layer staff layer))) -(define-gsharp-command com-delete-layer-staff ((name 'string)) +(define-gsharp-command (com-delete-layer-staff :name t) ((name 'string)) (let ((staff (find-staff name (buffer *gsharp-frame*))) (layer (layer (slice (bar (cursor *gsharp-frame*)))))) (remove-staff-from-layer staff layer))) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.1.1.1 gsharp/measure.lisp:1.2 --- gsharp/measure.lisp:1.1.1.1 Mon Feb 16 10:46:17 2004 +++ gsharp/measure.lisp Mon Feb 16 11:08:00 2004 @@ -295,7 +295,7 @@ (setf (obseq-cost-method buffer) (make-measure-cost-method (min-width buffer) (spacing-style buffer) - (- (right-edge buffer) (left-offset buffer)))) + (- (right-edge buffer) (left-margin buffer) (left-offset buffer)))) (obseq-solve buffer) (setf (modified-p buffer) nil))) Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.1.1.1 gsharp/packages.lisp:1.2 --- gsharp/packages.lisp:1.1.1.1 Mon Feb 16 10:46:20 2004 +++ gsharp/packages.lisp Mon Feb 16 11:08:00 2004 @@ -60,7 +60,8 @@ #:remove-staff-from-layer #:stem-direction #:stem-length #:notehead-duration #:element-duration #:clef #:keysig #:staff-pos #:xoffset #:read-everything #:save-buffer-to-stream - #:min-width #:spacing-style #:right-edge #:left-offset + #:line-width #:min-width #:spacing-style #:right-edge #:left-offset + #:left-margin )) (defpackage :gsharp-numbering @@ -82,7 +83,7 @@ #:measure-min-dist #:measure-coeff #:measure-start-times #:measure-bar-pos #:measure-seg-pos #:measure-bars #:measures #:nb-measures #:measureno - #:recompute-measures #:measure-cost-method + #:recompute-measures #:measure-cost-method #:make-measure-cost-method #:buffer-cost-method #:reduced-width #:natural-width #:compress-factor #:measure-seq-cost)) Index: gsharp/system.lisp diff -u gsharp/system.lisp:1.1.1.1 gsharp/system.lisp:1.2 --- gsharp/system.lisp:1.1.1.1 Mon Feb 16 10:46:21 2004 +++ gsharp/system.lisp Mon Feb 16 11:08:00 2004 @@ -2,26 +2,40 @@ (defparameter *gsharp-directory* (directory-namestring *load-truename*)) -(defsystem :gsharp +(defmacro gsharp-defsystem ((module &key depends-on) &rest components) + `(defsystem ,module :source-pathname *gsharp-directory* - :source-extension "lisp" - :components - (:serial - "packages" - "utilities" - "gf" - "sdl" - "charmap" - "buffer" - "numbering" - "Obseq/obseq" - "measure" - "postscript" - "glyphs" - "score-pane" - "beaming" - "drawing" - "cursor" - "input-state" - "midi" - "gui")) + ,@(and depends-on `(:depends-on ,depends-on)) + :components (:serial , at components))) + +#+asdf +(defmacro gsharp-defsystem ((module &key depends-on) &rest components) + `(asdf:defsystem ,module + ,@(and depends-on `(:depends-on ,depends-on)) + :serial t + :components (,@(loop for c in components + for p = (merge-pathnames + (parse-namestring c) + (make-pathname :type "lisp" + :defaults *gsharp-directory*)) + collect `(:file ,(pathname-name p) :pathname ,p))))) + +(gsharp-defsystem (:gsharp) + "packages" + "utilities" + "gf" + "sdl" + "charmap" + "buffer" + "numbering" + "Obseq/obseq" + "measure" + "postscript" + "glyphs" + "score-pane" + "beaming" + "drawing" + "cursor" + "input-state" + "midi" + "gui") From rstrandh at common-lisp.net Mon Feb 16 16:08:03 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 16 Feb 2004 11:08:03 -0500 Subject: [gsharp-cvs] CVS update: gsharp/Scores/alundavisan.gsh gsharp/Scores/bach181.gsh gsharp/Scores/bach262.gsh gsharp/Scores/blomsteroffret.gsh gsharp/Scores/clusters.gsh gsharp/Scores/rapsoden-sjunger.gsh gsharp/Scores/smaland.gsh gsharp/Scores/tomtegubbar.gsh gsharp/Scores/vinter-adjo.gsh Message-ID: Update of /project/gsharp/cvsroot/gsharp/Scores In directory common-lisp.net:/tmp/cvs-serv24224/Scores Modified Files: alundavisan.gsh bach181.gsh bach262.gsh blomsteroffret.gsh clusters.gsh rapsoden-sjunger.gsh smaland.gsh tomtegubbar.gsh vinter-adjo.gsh Log Message: Updates since 0.2 release. Date: Mon Feb 16 11:08:02 2004 Author: rstrandh Index: gsharp/Scores/alundavisan.gsh diff -u gsharp/Scores/alundavisan.gsh:1.1.1.1 gsharp/Scores/alundavisan.gsh:1.2 --- gsharp/Scores/alundavisan.gsh:1.1.1.1 Mon Feb 16 10:46:44 2004 +++ gsharp/Scores/alundavisan.gsh Mon Feb 16 11:08:02 2004 @@ -42,4 +42,4 @@ [% :notehead :FILLED :rbeams 0 :lbeams 1 :dots 0 :stem-direction :AUTO :notes ([N :pitch 27 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos 4 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos 4 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] Index: gsharp/Scores/bach181.gsh diff -u gsharp/Scores/bach181.gsh:1.1.1.1 gsharp/Scores/bach181.gsh:1.2 --- gsharp/Scores/bach181.gsh:1.1.1.1 Mon Feb 16 10:46:48 2004 +++ gsharp/Scores/bach181.gsh Mon Feb 16 11:08:02 2004 @@ -191,4 +191,4 @@ [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #3# :head :FILLED :accidentals :SHARP :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 19 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :DOWN :notes ([N :pitch 22 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 21 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :DOWN :notes ([N :pitch 22 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 21 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] Index: gsharp/Scores/bach262.gsh diff -u gsharp/Scores/bach262.gsh:1.1.1.1 gsharp/Scores/bach262.gsh:1.2 --- gsharp/Scores/bach262.gsh:1.1.1.1 Mon Feb 16 10:46:52 2004 +++ gsharp/Scores/bach262.gsh Mon Feb 16 11:08:02 2004 @@ -206,4 +206,4 @@ [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 20 :staff #3# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 23 :staff #3# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 24 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 20 :staff #3# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 21 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 20 :staff #3# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 21 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] Index: gsharp/Scores/blomsteroffret.gsh diff -u gsharp/Scores/blomsteroffret.gsh:1.1.1.1 gsharp/Scores/blomsteroffret.gsh:1.2 --- gsharp/Scores/blomsteroffret.gsh:1.1.1.1 Mon Feb 16 10:46:57 2004 +++ gsharp/Scores/blomsteroffret.gsh Mon Feb 16 11:08:02 2004 @@ -237,4 +237,4 @@ [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 19 :staff #3# :head :FILLED :accidentals :SHARP :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 19 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 18 :staff #3# :head :FILLED :accidentals :SHARP :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 18 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 18 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] Index: gsharp/Scores/clusters.gsh diff -u gsharp/Scores/clusters.gsh:1.1.1.1 gsharp/Scores/clusters.gsh:1.2 --- gsharp/Scores/clusters.gsh:1.1.1.1 Mon Feb 16 10:46:57 2004 +++ gsharp/Scores/clusters.gsh Mon Feb 16 11:08:02 2004 @@ -17,4 +17,4 @@ [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 30 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 31 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] [N :pitch 33 :staff #1# :head :FILLED :accidentals :SHARP :dots 0 ] - [N :pitch 36 :staff #1# :head :FILLED :accidentals :SHARP :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [N :pitch 36 :staff #1# :head :FILLED :accidentals :SHARP :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] Index: gsharp/Scores/rapsoden-sjunger.gsh diff -u gsharp/Scores/rapsoden-sjunger.gsh:1.1.1.1 gsharp/Scores/rapsoden-sjunger.gsh:1.2 --- gsharp/Scores/rapsoden-sjunger.gsh:1.1.1.1 Mon Feb 16 10:47:05 2004 +++ gsharp/Scores/rapsoden-sjunger.gsh Mon Feb 16 11:08:02 2004 @@ -191,15 +191,14 @@ [N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -6 ] [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 24 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] - [N :pitch 28 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] - [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([- :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos 4 ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :UP :notes NIL ] ) ] + [N :pitch 28 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] ) ] + [| :elements NIL ] + [| :elements NIL ] + [| :elements NIL ] + [| :elements NIL ] + [| :elements NIL ] + [| :elements NIL ] + [| :elements NIL ] [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #1# :staff-pos -12 ] [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #1# :head :HALF :accidentals :FLAT :dots 0 ] [N :pitch 27 :staff #1# :head :HALF :accidentals :FLAT :dots 0 ] ) ] @@ -355,16 +354,16 @@ [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 15 :staff #3# :head :FILLED :accidentals :FLAT :dots 0 ] [N :pitch 19 :staff #3# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #3# :staff-pos 0 ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] - [| :elements ([% :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes NIL ] ) ] + [| :elements NIL ] + [| :elements NIL ] + [| :elements NIL ] + [| :elements NIL ] + [| :elements NIL ] + [| :elements NIL ] + [| :elements NIL ] + [| :elements NIL ] + [| :elements NIL ] [| :elements ([- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #3# :staff-pos 0 ] [% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :stem-direction :DOWN :notes ([N :pitch 19 :staff #3# :head :FILLED :accidentals :FLAT :dots 0 ] ) ] [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #3# :staff-pos 0 ] ) ] - [| :elements ([- :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #3# :staff-pos 0 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [| :elements ([- :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 :staff #3# :staff-pos 0 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 :left-margin 20 ] Index: gsharp/Scores/smaland.gsh diff -u gsharp/Scores/smaland.gsh:1.1.1.1 gsharp/Scores/smaland.gsh:1.2 --- gsharp/Scores/smaland.gsh:1.1.1.1 Mon Feb 16 10:47:08 2004 +++ gsharp/Scores/smaland.gsh Mon Feb 16 11:08:02 2004 @@ -129,4 +129,4 @@ [% :notehead :FILLED :rbeams 1 :lbeams 0 :dots 1 :stem-direction :AUTO :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :notehead :FILLED :rbeams 2 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :AUTO :notes ([N :pitch 29 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos 4 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #1# :staff-pos 4 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] Index: gsharp/Scores/tomtegubbar.gsh diff -u gsharp/Scores/tomtegubbar.gsh:1.1.1.1 gsharp/Scores/tomtegubbar.gsh:1.2 --- gsharp/Scores/tomtegubbar.gsh:1.1.1.1 Mon Feb 16 10:47:12 2004 +++ gsharp/Scores/tomtegubbar.gsh Mon Feb 16 11:08:02 2004 @@ -116,4 +116,4 @@ [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 27 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 28 :staff #3# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] - [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #3# :staff-pos 4 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [- :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :staff #3# :staff-pos 4 ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] Index: gsharp/Scores/vinter-adjo.gsh diff -u gsharp/Scores/vinter-adjo.gsh:1.1.1.1 gsharp/Scores/vinter-adjo.gsh:1.2 --- gsharp/Scores/vinter-adjo.gsh:1.1.1.1 Mon Feb 16 10:47:14 2004 +++ gsharp/Scores/vinter-adjo.gsh Mon Feb 16 11:08:02 2004 @@ -65,4 +65,4 @@ [| :elements ([% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 25 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 26 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] [% :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :stem-direction :DOWN :notes ([N :pitch 27 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] - [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :DOWN :notes ([N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 70 ] + [| :elements ([% :notehead :HALF :rbeams 0 :lbeams 0 :dots 1 :stem-direction :DOWN :notes ([N :pitch 28 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ] ) ] ) ] ) ] :tail [/ :bars ([| :elements NIL ] ) ] ] ) ] ) :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 ] From rstrandh at common-lisp.net Mon Feb 16 17:38:11 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 16 Feb 2004 12:38:11 -0500 Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv20560 Modified Files: drawing.lisp Log Message: Fixed the annoying bug that sometimes made spacing completely wrong in the presence of dotted notes. Had to fix it twice, though, because there is code duplication in there. Some factoring would be a good idea at some point. Date: Mon Feb 16 12:38:11 2004 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.2 gsharp/drawing.lisp:1.3 --- gsharp/drawing.lisp:1.2 Mon Feb 16 11:08:00 2004 +++ gsharp/drawing.lisp Mon Feb 16 12:38:10 2004 @@ -51,11 +51,11 @@ (defun compute-widths (measures method) (let* ((compress (compute-compress-factor measures method)) - (start-times (sort (remove-duplicates - (apply #'append (mapcar #'measure-start-times - measures))) - #'<)) - (min-dist (reduce #'min (gsharp-measure::abs-rel start-times)))) + (min-dists (mapcar (lambda (measure) + (reduce #'min (gsharp-measure::abs-rel + (measure-start-times measure)))) + measures)) + (min-dist (reduce #'min min-dists))) (loop for measure in measures collect (/ (nat-width method (measure-coeff measure) min-dist) compress)))) @@ -82,11 +82,11 @@ (defun draw-system (pane measures x widths method staves draw-cursor) (let* ((compress (compute-compress-factor measures method)) - (start-times (sort (remove-duplicates - (apply #'append (mapcar #'measure-start-times - measures))) - #'<)) - (min-dist (reduce #'min (gsharp-measure::abs-rel start-times)))) + (min-dists (mapcar (lambda (measure) + (reduce #'min (gsharp-measure::abs-rel + (measure-start-times measure)))) + measures)) + (min-dist (reduce #'min min-dists))) (loop for measure in measures for width in widths do (draw-measure pane measure min-dist compress x method draw-cursor) From crhodes at common-lisp.net Mon Feb 16 18:43:55 2004 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Mon, 16 Feb 2004 13:43:55 -0500 Subject: [gsharp-cvs] CVS update: gsharp/gui.lisp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv4973 Modified Files: gui.lisp Log Message: Make the sbcl version of run-program search through $PATH for timidity Date: Mon Feb 16 13:43:55 2004 Author: crhodes Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.2 gsharp/gui.lisp:1.3 --- gsharp/gui.lisp:1.2 Mon Feb 16 11:08:00 2004 +++ gsharp/gui.lisp Mon Feb 16 13:43:54 2004 @@ -567,7 +567,7 @@ #+cmu (ext:run-program "timidity" '("test.mid")) #+sbcl - (sb-ext:run-program "timidity" '("test.mid")) + (sb-ext:run-program "timidity" '("test.mid") :search t) #-(or cmu sbcl) (error "write compatibility layer for RUN-PROGRAM"))) @@ -583,7 +583,7 @@ #+cmu (ext:run-program "timidity" '("test.mid")) #+sbcl - (sb-ext:run-program "timidity" '("test.mid")) + (sb-ext:run-program "timidity" '("test.mid") :search t) #-(or cmu sbcl) (error "write compatibility layer for RUN-PROGRAM"))) From crhodes at common-lisp.net Mon Feb 16 18:50:20 2004 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Mon, 16 Feb 2004 13:50:20 -0500 Subject: [gsharp-cvs] CVS update: gsharp/sdl.lisp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv11405 Modified Files: sdl.lisp Log Message: add *FONTS-DIRECTORY* to allow running GSharp when not in the gsharp directory; essentially, we address the path relative to the path of sdl.lisp or sdl.fasl (note: may break if this is subjected to Debian's common-lisp-controller) One remaining LOOP BY -1 that slipped through the net Date: Mon Feb 16 13:50:20 2004 Author: crhodes Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.1.1.1 gsharp/sdl.lisp:1.2 --- gsharp/sdl.lisp:1.1.1.1 Mon Feb 16 10:46:21 2004 +++ gsharp/sdl.lisp Mon Feb 16 13:50:20 2004 @@ -1,5 +1,9 @@ (in-package :sdl) +(defvar *fonts-directory* + (merge-pathnames (make-pathname :directory '(relative "Fonts")) + (make-pathname :directory (pathname-directory *load-truename*)))) + (defgeneric glyph (font glyph-no)) (defgeneric glyph-offsets (font glyph-no)) (defgeneric staff-line-distance (font)) @@ -113,7 +117,7 @@ :element-type '(unsigned-byte 8) :initial-element 16)) (loop for r from 0 below (car (array-dimensions matrix)) - for y from (gf-char-max-n gf-char) by -1 do + for y downfrom (gf-char-max-n gf-char) by 1 do (loop for c from 0 below (cadr (array-dimensions matrix)) for x from (gf-char-min-m gf-char) do (decf (aref pixmap @@ -159,7 +163,9 @@ (- notehead-right-x-offset notehead-left-x-offset))) (defun load-font (staff-line-distance) - (let* ((gf-font (parse-gf-file (format nil "Fonts/sdl~a.gf" staff-line-distance))) + (let* ((gf-font (parse-gf-file (merge-pathnames + (format nil "sdl~a.gf" staff-line-distance) + *fonts-directory*))) (maxchar (reduce #'max (gf-font-chars gf-font) :key #'gf-char-no)) (glyphs (make-array (list (1+ maxchar)) :initial-element nil))) (loop for char in (gf-font-chars gf-font) do From crhodes at common-lisp.net Mon Feb 16 18:50:59 2004 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Mon, 16 Feb 2004 13:50:59 -0500 Subject: [gsharp-cvs] CVS update: gsharp/system.lisp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv7473 Modified Files: system.lisp Log Message: Make GSHARP-DEFSYSTEM define systems for both mk-defsystem and asdf if both are present in the image in question Date: Mon Feb 16 13:50:59 2004 Author: crhodes Index: gsharp/system.lisp diff -u gsharp/system.lisp:1.2 gsharp/system.lisp:1.3 --- gsharp/system.lisp:1.2 Mon Feb 16 11:08:00 2004 +++ gsharp/system.lisp Mon Feb 16 13:50:59 2004 @@ -3,22 +3,22 @@ (defparameter *gsharp-directory* (directory-namestring *load-truename*)) (defmacro gsharp-defsystem ((module &key depends-on) &rest components) - `(defsystem ,module - :source-pathname *gsharp-directory* - ,@(and depends-on `(:depends-on ,depends-on)) - :components (:serial , at components))) - -#+asdf -(defmacro gsharp-defsystem ((module &key depends-on) &rest components) - `(asdf:defsystem ,module - ,@(and depends-on `(:depends-on ,depends-on)) - :serial t - :components (,@(loop for c in components - for p = (merge-pathnames - (parse-namestring c) - (make-pathname :type "lisp" - :defaults *gsharp-directory*)) - collect `(:file ,(pathname-name p) :pathname ,p))))) + `(progn + #+mk-defsystem + (mk:defsystem ,module + :source-pathname *gsharp-directory* + ,@(and depends-on `(:depends-on ,depends-on)) + :components (:serial , at components)) + #+asdf + (asdf:defsystem ,module + ,@(and depends-on `(:depends-on ,depends-on)) + :serial t + :components (,@(loop for c in components + for p = (merge-pathnames + (parse-namestring c) + (make-pathname :type "lisp" + :defaults *gsharp-directory*)) + collect `(:file ,(pathname-name p) :pathname ,p)))))) (gsharp-defsystem (:gsharp) "packages" From root at common-lisp.net Tue Feb 17 13:01:03 2004 From: root at common-lisp.net (root) Date: Tue, 17 Feb 2004 08:01:03 -0500 Subject: [gsharp-cvs] CVS update: CVSROOT/config Message-ID: Update of /project/gsharp/cvsroot/CVSROOT In directory common-lisp.net:/tmp/CVSROOT Modified Files: config Log Message: changing lockdir Date: Tue Feb 17 08:01:02 2004 Author: root Index: CVSROOT/config diff -u CVSROOT/config:1.1 CVSROOT/config:1.2 --- CVSROOT/config:1.1 Wed Feb 11 10:22:54 2004 +++ CVSROOT/config Tue Feb 17 08:01:01 2004 @@ -2,7 +2,7 @@ #SystemAuth=no # Put CVS lock files in this directory rather than directly in the repository. -#LockDir=/var/lock/cvs +LockDir=/var/lock/gsharp # Set `TopLevelAdmin' to `yes' to create a CVS directory at the top # level of the new working directory when using the `cvs checkout' From crhodes at common-lisp.net Wed Feb 18 18:15:46 2004 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Wed, 18 Feb 2004 13:15:46 -0500 Subject: [gsharp-cvs] CVS update: gsharp/midi.lisp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv13115 Modified Files: midi.lisp Log Message: Fix for MIDI files already existing: make WITH-MIDI-INPUT/OUTPUT slightly more flexible, and specify :if-exists :supersede Date: Wed Feb 18 13:15:46 2004 Author: crhodes Index: gsharp/midi.lisp diff -u gsharp/midi.lisp:1.1.1.1 gsharp/midi.lisp:1.2 --- gsharp/midi.lisp:1.1.1.1 Mon Feb 16 10:46:18 2004 +++ gsharp/midi.lisp Wed Feb 18 13:15:46 2004 @@ -105,16 +105,18 @@ (write-fixed-length-quantity (ash quantity -8) (1- nb-bytes)) (write-bytes (logand quantity #xff)))) -(defmacro with-midi-input (filename &body body) - "execute body with *midi-input* assigned to a stream from filename" - `(with-open-file (*midi-input* ,filename - :direction :input :element-type '(unsigned-byte 8)) +(defmacro with-midi-input ((pathname &rest open-args &key &allow-other-keys) &body body) + "execute body with *midi-input* assigned to a stream from pathname" + `(with-open-file (*midi-input* ,pathname + :direction :input :element-type '(unsigned-byte 8) + , at open-args) , at body)) -(defmacro with-midi-output (filename &body body) - "execute body with *midi-output* assigned to a stream from filename" - `(with-open-file (*midi-output* ,filename - :direction :output :element-type '(unsigned-byte 8)) +(defmacro with-midi-output ((pathname &rest open-args &key &allow-other-keys) &body body) + "execute body with *midi-output* assigned to a stream from pathname" + `(with-open-file (*midi-output* ,pathname + :direction :output :element-type '(unsigned-byte 8) + , at open-args) , at body)) (defun read-variable-length-quantity () @@ -225,7 +227,7 @@ (defun read-midi-file (filename) "read an entire Midifile from the file with name given as argument" (setf *time* 0) - (with-midi-input filename + (with-midi-input (filename) (let ((type (read-fixed-length-quantity 4)) (length (read-fixed-length-quantity 4)) (format (read-fixed-length-quantity 2)) @@ -241,7 +243,7 @@ collect (read-track)))))) (defun write-midi-file (midifile filename) - (with-midi-output filename + (with-midi-output (filename :if-exists :supersede) (write-fixed-length-quantity +header-mthd+ 4) (write-fixed-length-quantity +header-mthd-length+ 4) (with-slots (format division tracks) midifile From crhodes at common-lisp.net Wed Feb 18 18:16:16 2004 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Wed, 18 Feb 2004 13:16:16 -0500 Subject: [gsharp-cvs] CVS update: gsharp/gui.lisp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv14720 Modified Files: gui.lisp Log Message: Workaround the :shift problem with #\# commands: add an unshifted variant. Date: Wed Feb 18 13:16:16 2004 Author: crhodes Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.3 gsharp/gui.lisp:1.4 --- gsharp/gui.lisp:1.3 Mon Feb 16 13:43:54 2004 +++ gsharp/gui.lisp Wed Feb 18 13:16:16 2004 @@ -50,8 +50,10 @@ (add-command '(#\.) 'com-more-dots *global-command-table*) (add-command '(#\[) 'com-more-lbeams *global-command-table*) (add-command '(#\]) 'com-more-rbeams *global-command-table*) +(add-command '(#\#) 'com-sharper *global-command-table*) (add-command '(#\# :shift) 'com-sharper *global-command-table*) (add-command '(#\@ :shift) 'com-flatter *global-command-table*) +(add-command '(#\# :meta) 'com-more-sharps *global-command-table*) (add-command '(#\# :meta :shift) 'com-more-sharps *global-command-table*) (add-command '(#\@ :meta :shift) 'com-more-flats *global-command-table*) (add-command '(#\u :meta) 'com-up *global-command-table*) From rstrandh at common-lisp.net Thu Feb 19 05:57:22 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Thu, 19 Feb 2004 00:57:22 -0500 Subject: [gsharp-cvs] CVS update: gsharp/sdl.lisp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv21441 Modified Files: sdl.lisp Log Message: Fixed the :relative problem according to Andras Simon. Date: Thu Feb 19 00:57:22 2004 Author: rstrandh Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.2 gsharp/sdl.lisp:1.3 --- gsharp/sdl.lisp:1.2 Mon Feb 16 13:50:20 2004 +++ gsharp/sdl.lisp Thu Feb 19 00:57:22 2004 @@ -1,7 +1,7 @@ (in-package :sdl) (defvar *fonts-directory* - (merge-pathnames (make-pathname :directory '(relative "Fonts")) + (merge-pathnames (make-pathname :directory '(:relative "Fonts")) (make-pathname :directory (pathname-directory *load-truename*)))) (defgeneric glyph (font glyph-no)) From rstrandh at common-lisp.net Thu Feb 19 06:39:42 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Thu, 19 Feb 2004 01:39:42 -0500 Subject: [gsharp-cvs] CVS update: gsharp/gui.lisp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv24530 Modified Files: gui.lisp Log Message: Added Emacs-style keboard macro facility. Date: Thu Feb 19 01:39:41 2004 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.4 gsharp/gui.lisp:1.5 --- gsharp/gui.lisp:1.4 Wed Feb 18 13:16:16 2004 +++ gsharp/gui.lisp Thu Feb 19 01:39:41 2004 @@ -11,6 +11,7 @@ (defparameter *x-command-table* (make-hash-table :test #'equal)) (defparameter *i-command-table* (make-hash-table :test #'equal)) (defparameter *ix-command-table* (make-hash-table :test #'equal)) +(defparameter *c-x-command-table* (make-hash-table :test #'equal)) (defparameter *commands* *global-command-table*) (defun add-command (gesture command table) @@ -64,6 +65,7 @@ (add-command '(#\n :meta) 'com-next-layer *global-command-table*) (add-command '(#\x) *x-command-table* *global-command-table*) (add-command '(#\i) *i-command-table* *global-command-table*) +(add-command '(#\x :control) *c-x-command-table* *global-command-table*) ;;; i command table (add-command '(#\.) 'com-istate-more-dots *i-command-table*) @@ -83,6 +85,13 @@ (add-command '(#\[) 'com-fewer-lbeams *x-command-table*) (add-command '(#\]) 'com-fewer-rbeams *x-command-table*) +;;; c-x-command-table +(add-command '(#\( :shift) 'com-start-kbd-macro *c-x-command-table*) +(add-command '(#\() 'com-start-kbd-macro *c-x-command-table*) +(add-command '(#\) :shift) 'com-end-kbd-macro *c-x-command-table*) +(add-command '(#\)) 'com-end-kbd-macro *c-x-command-table*) +(add-command '(#\e) 'com-call-last-kbd-macro *c-x-command-table*) + (defmethod redisplay-gsharp-panes (frame &key force-p) (loop for pane in (frame-current-panes frame) do (when (typep pane 'score-pane) @@ -90,18 +99,24 @@ (defvar *gsharp-frame*) +(defparameter *kbd-macro-recording-p* nil) +(defparameter *kbd-macro-keys* '()) + (defmethod dispatch-event :around ((pane score-pane) (event key-press-event)) (when (keyboard-event-character event) (let* ((key (list (keyboard-event-character event) (event-modifier-state event))) (command (gethash key *commands*))) + (when *kbd-macro-recording-p* (push key *kbd-macro-keys*)) (cond ((hash-table-p command) (setf *commands* command)) ((fboundp command) (handler-case (funcall command) (gsharp-condition (condition) (format *error-output* "~a~%" condition))) (setf *commands* *global-command-table*)) (t (format *error-output* "no command for ~a~%" key) - (setf *commands* *global-command-table*))) + (setf *commands* *global-command-table*) + (when *kbd-macro-recording-p* (setf *kbd-macro-keys* '() + *kbd-macro-recording-p* nil)))) (redisplay-gsharp-panes *gsharp-frame* :force-p t)))) (define-application-frame gsharp () @@ -1038,3 +1053,24 @@ ((eq (aref keysig 4) :natural) (setf (aref keysig 4) :flat)) ((eq (aref keysig 0) :natural) (setf (aref keysig 0) :flat)) ((eq (aref keysig 3) :natural) (setf (aref keysig 3) :flat))))) + +;;; macro processing +(define-gsharp-command com-start-kbd-macro () + (message "defining keyboad macro~%") + (setf *kbd-macro-recording-p* t + *kbd-macro-keys* '())) + +(define-gsharp-command com-end-kbd-macro () + (message "keyboad macro defined~%") + (setf *kbd-macro-recording-p* nil + *kbd-macro-keys* (nreverse *kbd-macro-keys*))) + +(define-gsharp-command com-call-last-kbd-macro () + (loop with commands = *global-command-table* + for key in *kbd-macro-keys* do + (let ((command (gethash key commands))) + (cond ((hash-table-p command) (setf commands command)) + ((fboundp command) + (handler-case (funcall command) + (gsharp-condition (condition) (format *error-output* "~a~%" condition)))) + (t (message "no command for ~a~%" key)))))) From rstrandh at common-lisp.net Thu Feb 19 06:48:09 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Thu, 19 Feb 2004 01:48:09 -0500 Subject: [gsharp-cvs] CVS update: gsharp/Doc/commands.tex Message-ID: Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv9894 Modified Files: commands.tex Log Message: Added keyboard macros to reference manual. Date: Thu Feb 19 01:48:09 2004 Author: rstrandh Index: gsharp/Doc/commands.tex diff -u gsharp/Doc/commands.tex:1.1.1.1 gsharp/Doc/commands.tex:1.2 --- gsharp/Doc/commands.tex:1.1.1.1 Mon Feb 16 10:46:23 2004 +++ gsharp/Doc/commands.tex Thu Feb 19 01:48:08 2004 @@ -174,3 +174,17 @@ & & (currently wipes the current buffer)\\ \hline \end{tabular} + +\section{Keyboard macros} + +\begin{tabular}{|l|l|l|} +\hline +Key & Command name & Description\\ +\hline +C-x ( & Start Keyboard Macro & Start recording keystrokes \\ + & & for later execution \\ +C-x ) & End Keyboard Macro & Stop recording keystrokes \\ +C-x e & Call Last Keyboard Macro & Execute recorded keystrokes \\ +\hline +\end{tabular} + From rstrandh at common-lisp.net Thu Feb 19 08:50:28 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Thu, 19 Feb 2004 03:50:28 -0500 Subject: [gsharp-cvs] CVS update: gsharp/gui.lisp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv22319 Modified Files: gui.lisp Log Message: Forgot to save buffer before committing. Date: Thu Feb 19 03:50:27 2004 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.5 gsharp/gui.lisp:1.6 --- gsharp/gui.lisp:1.5 Thu Feb 19 01:39:41 2004 +++ gsharp/gui.lisp Thu Feb 19 03:50:27 2004 @@ -1063,7 +1063,7 @@ (define-gsharp-command com-end-kbd-macro () (message "keyboad macro defined~%") (setf *kbd-macro-recording-p* nil - *kbd-macro-keys* (nreverse *kbd-macro-keys*))) + *kbd-macro-keys* (nreverse (cddr *kbd-macro-keys*)))) (define-gsharp-command com-call-last-kbd-macro () (loop with commands = *global-command-table* From rstrandh at common-lisp.net Fri Feb 20 06:06:20 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Fri, 20 Feb 2004 01:06:20 -0500 Subject: [gsharp-cvs] CVS update: gsharp/Doc/release-notes.tex Message-ID: Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv12480 Modified Files: release-notes.tex Log Message: Updated release notes according to recent fixes. Date: Fri Feb 20 01:06:20 2004 Author: rstrandh Index: gsharp/Doc/release-notes.tex diff -u gsharp/Doc/release-notes.tex:1.2 gsharp/Doc/release-notes.tex:1.3 --- gsharp/Doc/release-notes.tex:1.2 Mon Feb 16 11:08:01 2004 +++ gsharp/Doc/release-notes.tex Fri Feb 20 01:06:20 2004 @@ -5,8 +5,9 @@ \subsection{Features added from 0.2} \begin{itemize} -\item right edge of staff is no longer hard wired. -\item left margin is now a parameter of the buffer (and on disk). +\item An Emacs-style keyboard macro facility has been added. +\item Right edge of staff is no longer hard wired. +\item Left margin is now a parameter of the buffer (and on disk). \item x-position of first measure on line now depends on the size of the key signature. This means that wide key signatures no longer overlap with notes of the first measure on the line. @@ -23,6 +24,9 @@ \subsection{Bug fixes from 0.2} \begin{itemize} +\item fixed pathname-related problems for MIDI and fonts. +\item fixed annoying bug that ruined the spacing of unevenly timed + music. \item last sharp sign in key signature with seven sharp signs is now drawn. \item fixed conformance bugs in some \texttt{loop} constructs (thanks to From rstrandh at common-lisp.net Fri Feb 20 08:39:04 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Fri, 20 Feb 2004 03:39:04 -0500 Subject: [gsharp-cvs] CVS update: gsharp/drawing.lisp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv21473 Modified Files: drawing.lisp Log Message: Introduced new function `compute-min-dist' in order to factor previously duplicated code. Date: Fri Feb 20 03:39:03 2004 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.3 gsharp/drawing.lisp:1.4 --- gsharp/drawing.lisp:1.3 Mon Feb 16 12:38:10 2004 +++ gsharp/drawing.lisp Fri Feb 20 03:39:03 2004 @@ -49,13 +49,16 @@ (defvar *cursor* nil) +(defun compute-min-dist (measures) + (let ((min-dists (mapcar (lambda (measure) + (reduce #'min (gsharp-measure::abs-rel + (measure-start-times measure)))) + measures))) + (reduce #'min min-dists))) + (defun compute-widths (measures method) - (let* ((compress (compute-compress-factor measures method)) - (min-dists (mapcar (lambda (measure) - (reduce #'min (gsharp-measure::abs-rel - (measure-start-times measure)))) - measures)) - (min-dist (reduce #'min min-dists))) + (let ((compress (compute-compress-factor measures method)) + (min-dist (compute-min-dist measures))) (loop for measure in measures collect (/ (nat-width method (measure-coeff measure) min-dist) compress)))) @@ -81,12 +84,8 @@ (with-light-glyphs pane (draw-bar pane bar x width time-alist draw-cursor)))))) (defun draw-system (pane measures x widths method staves draw-cursor) - (let* ((compress (compute-compress-factor measures method)) - (min-dists (mapcar (lambda (measure) - (reduce #'min (gsharp-measure::abs-rel - (measure-start-times measure)))) - measures)) - (min-dist (reduce #'min min-dists))) + (let ((compress (compute-compress-factor measures method)) + (min-dist (compute-min-dist measures))) (loop for measure in measures for width in widths do (draw-measure pane measure min-dist compress x method draw-cursor) From rstrandh at common-lisp.net Tue Feb 24 05:30:47 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 24 Feb 2004 00:30:47 -0500 Subject: [gsharp-cvs] CVS update: gsharp/Doc/gsharp.bib gsharp/Doc/Makefile gsharp/Doc/gsharp.tex Message-ID: Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv11457 Modified Files: Makefile gsharp.tex Added Files: gsharp.bib Log Message: Added bibliography. Modified the Makefile to compile Bibtex file. Date: Tue Feb 24 00:30:47 2004 Author: rstrandh Index: gsharp/Doc/Makefile diff -u gsharp/Doc/Makefile:1.1.1.1 gsharp/Doc/Makefile:1.2 --- gsharp/Doc/Makefile:1.1.1.1 Mon Feb 16 10:46:21 2004 +++ gsharp/Doc/Makefile Tue Feb 24 00:30:47 2004 @@ -16,6 +16,7 @@ $(NAME).dvi: $(TEXFILES) $(PSTEX_T) $(VERBATIM) latex $< makeindex $(NAME) + bibtex gsharp latex $< $(NAME).ps: $(NAME).dvi $(PSTEX) @@ -27,7 +28,6 @@ clean: rm -f *.aux *.log *~ -spotless: - make clean - rm -f *.ps *.dvi *.pstex *.pstex_t *.toc *.idx *.ilg *.ind +spotless: clean + rm -f *.ps *.dvi *.pstex *.pstex_t *.toc *.idx *.ilg *.ind *.bbl Index: gsharp/Doc/gsharp.tex diff -u gsharp/Doc/gsharp.tex:1.1.1.1 gsharp/Doc/gsharp.tex:1.2 --- gsharp/Doc/gsharp.tex:1.1.1.1 Mon Feb 16 10:46:26 2004 +++ gsharp/Doc/gsharp.tex Tue Feb 24 00:30:47 2004 @@ -800,5 +800,16 @@ Talk about frames, panes, streams, etc. +\nocite{ross-1987} \nocite{haken-1993} \nocite{haken-1995} +\nocite{aho-hopcroft-ullman} \nocite{blostein-1991} +\nocite{blostein-1994} \nocite{gourlay-1987-spacing} +\nocite{gourlay-1987-formatting} \nocite{hegazy-1987} +\nocite{hegazy-1987-breaking} \nocite{rader-1996} \nocite{tex} + + \printindex + +\newpage +\bibliographystyle{alpha} +\bibliography{gsharp} \end{document} From crhodes at common-lisp.net Wed Feb 25 22:24:56 2004 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Wed, 25 Feb 2004 17:24:56 -0500 Subject: [gsharp-cvs] CVS update: gsharp/score-pane.lisp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv28640 Modified Files: score-pane.lisp Log Message: fix for pixmaps bogusly being cached across different connections to the X server. (as seen on gsharp-devel "Problem of second gsharp" on 2004-02-25). Date: Wed Feb 25 17:24:56 2004 Author: crhodes Index: gsharp/score-pane.lisp diff -u gsharp/score-pane.lisp:1.1.1.1 gsharp/score-pane.lisp:1.2 --- gsharp/score-pane.lisp:1.1.1.1 Mon Feb 16 10:46:21 2004 +++ gsharp/score-pane.lisp Wed Feb 25 17:24:56 2004 @@ -1,7 +1,11 @@ (in-package :score-pane) (defclass score-pane (application-pane) - ((pixmaps :initform (make-hash-table :test #'eq) :reader pane-pixmaps))) + ((pixmaps :initform (make-hash-table :test #'eq) :reader pane-pixmaps) + (darker-gray-progressions :initform (make-array 10 :initial-element nil :adjustable t) + :reader darker-gray-progressions) + (lighter-gray-progressions :initform (make-array 10 :initial-element nil :adjustable t) + :reader lighter-gray-progressions))) (defmethod dispatch-event :before ((pane score-pane) (event pointer-enter-event)) (let ((port (port pane))) @@ -474,10 +478,8 @@ (when (stream-drawing-p *pane*) (medium-draw-rectangle* medium x1 y1 x2 y2 t)))) -(defparameter *darker-gray-progressions* - (make-array 10 :initial-element nil :adjustable t)) -(defparameter *lighter-gray-progressions* - (make-array 10 :initial-element nil :adjustable t)) +(defvar *darker-gray-progressions*) +(defvar *lighter-gray-progressions*) ;;; don't delete this yet, since I don't know how the other one will work out. ;; (defun ensure-gray-progressions (index) @@ -563,7 +565,7 @@ (defclass upward-beam-output-record (beam-output-record) ()) -(defmethod replay-output-record ((record upward-beam-output-record) stream +(defmethod replay-output-record ((record upward-beam-output-record) (stream score-pane) &optional (region +everywhere+) (x-offset 0) (y-offset 0)) (declare (ignore x-offset y-offset region)) @@ -572,15 +574,17 @@ (let ((medium (sheet-medium stream))) (let ((*light-glyph* (not (eq ink +black+)))) (with-drawing-options (medium :ink ink) - ;; we replay with the identity tranformation, so - ;; we have to draw the other way - (draw-downward-beam medium x1 (1- y2) (1- (+ y1 thickness)) thickness - (/ (- x2 x1) (- y2 y1 thickness))))))))) + (let ((*lighter-gray-progressions* (lighter-gray-progressions stream)) + (*darker-gray-progressions* (darker-gray-progressions stream))) + ;; we replay with the identity tranformation, so + ;; we have to draw the other way + (draw-downward-beam medium x1 (1- y2) (1- (+ y1 thickness)) thickness + (/ (- x2 x1) (- y2 y1 thickness)))))))))) (defclass downward-beam-output-record (beam-output-record) ()) -(defmethod replay-output-record ((record downward-beam-output-record) stream +(defmethod replay-output-record ((record downward-beam-output-record) (stream score-pane) &optional (region +everywhere+) (x-offset 0) (y-offset 0)) (declare (ignore x-offset y-offset region)) @@ -589,10 +593,12 @@ (let ((medium (sheet-medium stream))) (let ((*light-glyph* (not (eq ink +black+)))) (with-drawing-options (medium :ink ink) - ;; we replay with the identity tranformation, so - ;; we have to draw the other way - (draw-upward-beam medium x1 (1- (+ y1 thickness)) (1- y2) thickness - (/ (- x2 x1) (- y2 y1 thickness))))))))) + (let ((*lighter-gray-progressions* (lighter-gray-progressions stream)) + (*darker-gray-progressions* (darker-gray-progressions stream))) + ;; we replay with the identity tranformation, so + ;; we have to draw the other way + (draw-upward-beam medium x1 (1- (+ y1 thickness)) (1- y2) thickness + (/ (- x2 x1) (- y2 y1 thickness)))))))))) (defun draw-sloped-beam (medium x1 y1 x2 y2 thickness inverse-slope) (let ((transformation (medium-transformation *pane*))) @@ -658,6 +664,8 @@ (let ((pixmap (gensym)) (mirror (gensym))) `(let* ((*pane* ,pane) + (*lighter-gray-progressions* (lighter-gray-progressions pane)) + (*darker-gray-progressions* (darker-gray-progressions pane)) (,pixmap (allocate-pixmap *pane* 800 900)) (,mirror (sheet-direct-mirror *pane*))) (draw-rectangle* ,pixmap 0 0 800 900 :filled t :ink +white+) From crhodes at common-lisp.net Wed Feb 25 22:24:56 2004 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Wed, 25 Feb 2004 17:24:56 -0500 Subject: [gsharp-cvs] CVS update: gsharp/Doc/release-notes.tex Message-ID: Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv28640/Doc Modified Files: release-notes.tex Log Message: fix for pixmaps bogusly being cached across different connections to the X server. (as seen on gsharp-devel "Problem of second gsharp" on 2004-02-25). Date: Wed Feb 25 17:24:56 2004 Author: crhodes Index: gsharp/Doc/release-notes.tex diff -u gsharp/Doc/release-notes.tex:1.3 gsharp/Doc/release-notes.tex:1.4 --- gsharp/Doc/release-notes.tex:1.3 Fri Feb 20 01:06:20 2004 +++ gsharp/Doc/release-notes.tex Wed Feb 25 17:24:56 2004 @@ -24,6 +24,7 @@ \subsection{Bug fixes from 0.2} \begin{itemize} +\item fixed a bug in pixmap cacheing \item fixed pathname-related problems for MIDI and fonts. \item fixed annoying bug that ruined the spacing of unevenly timed music. From rstrandh at common-lisp.net Fri Feb 27 09:27:42 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Fri, 27 Feb 2004 04:27:42 -0500 Subject: [gsharp-cvs] CVS update: gsharp/gui.lisp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv26137 Modified Files: gui.lisp Log Message: Changed the implementation of keyboard macros to store functions instead of keys. Once we get numeric arguments, we must store thunks that call the commands with appropriate arguments. Date: Fri Feb 27 04:27:42 2004 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.6 gsharp/gui.lisp:1.7 --- gsharp/gui.lisp:1.6 Thu Feb 19 03:50:27 2004 +++ gsharp/gui.lisp Fri Feb 27 04:27:42 2004 @@ -100,22 +100,22 @@ (defvar *gsharp-frame*) (defparameter *kbd-macro-recording-p* nil) -(defparameter *kbd-macro-keys* '()) +(defparameter *kbd-macro-funs* '()) (defmethod dispatch-event :around ((pane score-pane) (event key-press-event)) (when (keyboard-event-character event) (let* ((key (list (keyboard-event-character event) (event-modifier-state event))) (command (gethash key *commands*))) - (when *kbd-macro-recording-p* (push key *kbd-macro-keys*)) (cond ((hash-table-p command) (setf *commands* command)) ((fboundp command) + (when *kbd-macro-recording-p* (push command *kbd-macro-funs*)) (handler-case (funcall command) (gsharp-condition (condition) (format *error-output* "~a~%" condition))) (setf *commands* *global-command-table*)) (t (format *error-output* "no command for ~a~%" key) (setf *commands* *global-command-table*) - (when *kbd-macro-recording-p* (setf *kbd-macro-keys* '() + (when *kbd-macro-recording-p* (setf *kbd-macro-funs* '() *kbd-macro-recording-p* nil)))) (redisplay-gsharp-panes *gsharp-frame* :force-p t)))) @@ -1058,19 +1058,13 @@ (define-gsharp-command com-start-kbd-macro () (message "defining keyboad macro~%") (setf *kbd-macro-recording-p* t - *kbd-macro-keys* '())) + *kbd-macro-funs* '())) (define-gsharp-command com-end-kbd-macro () (message "keyboad macro defined~%") (setf *kbd-macro-recording-p* nil - *kbd-macro-keys* (nreverse (cddr *kbd-macro-keys*)))) + *kbd-macro-funs* (nreverse (cdr *kbd-macro-funs*)))) (define-gsharp-command com-call-last-kbd-macro () - (loop with commands = *global-command-table* - for key in *kbd-macro-keys* do - (let ((command (gethash key commands))) - (cond ((hash-table-p command) (setf commands command)) - ((fboundp command) - (handler-case (funcall command) - (gsharp-condition (condition) (format *error-output* "~a~%" condition)))) - (t (message "no command for ~a~%" key)))))) + (handler-case (mapc #'funcall *kbd-macro-funs*) + (gsharp-condition (condition) (format *error-output* "~a~%" condition)))) From rstrandh at common-lisp.net Fri Feb 27 09:34:30 2004 From: rstrandh at common-lisp.net (Robert Strandh) Date: Fri, 27 Feb 2004 04:34:30 -0500 Subject: [gsharp-cvs] CVS update: gsharp/gui.lisp Message-ID: Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv8801 Modified Files: gui.lisp Log Message: Now that it is possible to start a second Gsharp after the first one exits, make the quit command call frame-exit in both CMUCL and SBCL. Date: Fri Feb 27 04:34:30 2004 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.7 gsharp/gui.lisp:1.8 --- gsharp/gui.lisp:1.7 Fri Feb 27 04:27:42 2004 +++ gsharp/gui.lisp Fri Feb 27 04:34:30 2004 @@ -362,8 +362,7 @@ (message "Saved buffer to ~A~%" filename))) (define-gsharp-command (com-quit :name t) () - #+cmu (unix::unix-exit) - #+sbcl (frame-exit *application-frame*)) + (frame-exit *application-frame*)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;