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 ,@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")
