Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv18228
Modified Files:
buffer.lisp drawing.lisp gui.lisp packages.lisp
score-pane.lisp
Log Message:
General:
removed presentation test code. in gui.lisp
Staves as presentations:
draw-staff now also takes a staff object as an argument so that we
can use the CLIM present function inside draw-staff.
added present method for a staff object on a textual view.
modified com-inssert-layer-after to take no arguments, but instead
to use accept to gather a staff object.
Redisplay:
pane is no longer cleared after each interaction, so redisplay is
much smoother.
Filename completion:
added completable-pathname presentation type and an accept method
for this type. The accept method uses a CMUCL-specific function
(ext:ambiguous-files) to complete prefix pathnames. Contributions
for other Lisp systems to make this work would be welcome.
modified com-load-file and com-save-buffer-as to take no arguments, but
instead to use accept to gather its file name. This modification probably
should not have been necessary, as CLIM ought to use accept to
gather unsupplied arguments, no?
Date: Wed Jul 14 11:07:34 2004
Author: rstrandh
Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.2 gsharp/buffer.lisp:1.3
--- gsharp/buffer.lisp:1.2 Mon Feb 16 08:08:00 2004
+++ gsharp/buffer.lisp Wed Jul 14 11:07:33 2004
@@ -72,7 +72,6 @@
(keysig :accessor keysig :initarg :keysig
:initform (make-array 7 :initial-element :natural))))
-
(defmethod print-object ((s staff) stream)
(with-slots (name clef keysig) s
(format stream "[= :name ~W :clef ~W :keysig ~W ] " name clef keysig)))
Index: gsharp/drawing.lisp
diff -u gsharp/drawing.lisp:1.4 gsharp/drawing.lisp:1.5
--- gsharp/drawing.lisp:1.4 Fri Feb 20 00:39:03 2004
+++ gsharp/drawing.lisp Wed Jul 14 11:07:33 2004
@@ -9,6 +9,10 @@
;; nil indicates that accidental has not been placed yet
(accidental-position :initform nil :accessor accidental-position)))
+(define-presentation-method present
+ (staff (type staff) stream (view textual-view) &key)
+ (format stream "[staff ~a]" (name staff)))
+
(defmethod draw-staff-and-clef (pane (staff staff) x1 x2)
(when (clef staff)
(draw-clef pane (name (clef staff)) (+ x1 10) (lineno (clef staff)))
@@ -30,7 +34,7 @@
for x from (+ x1 10 (staff-step 8)) by (staff-step 2.5)
while (eq (aref (keysig staff) pitch) :sharp)
do (draw-accidental pane :sharp x (+ line yoffset)))))
- (draw-staff pane x1 x2))
+ (draw-staff staff pane x1 x2))
(defun line-cost (measures method)
(reduce (lambda (x y) (combine-cost method x y)) measures :initial-value nil))
Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.8 gsharp/gui.lisp:1.9
--- gsharp/gui.lisp:1.8 Fri Feb 27 01:34:30 2004
+++ gsharp/gui.lisp Wed Jul 14 11:07:33 2004
@@ -117,7 +117,7 @@
(setf *commands* *global-command-table*)
(when *kbd-macro-recording-p* (setf *kbd-macro-funs* '()
*kbd-macro-recording-p* nil))))
- (redisplay-gsharp-panes *gsharp-frame* :force-p t))))
+ (redisplay-frame-panes *gsharp-frame*))))
(define-application-frame gsharp ()
((buffer :initarg :buffer :accessor buffer)
@@ -129,6 +129,7 @@
(score (make-pane 'score-pane
:width 700 :height 900
:name "score"
+ :display-time :no-clear
:display-function 'display-score))
(state (make-pane 'score-pane
:width 50 :height 200
@@ -198,41 +199,6 @@
for dx from (+ right 5) by 5 do
(draw-dot pane (+ xpos dx) 4)))))))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Presentation tests for now
-
-(define-presentation-type bla ())
-
-(define-presentation-type blabla () :inherit-from 'bla)
-
-(define-presentation-method present (object (type bla) stream view &key)
- (declare (ignore view))
- (write-string object stream))
-
-(define-presentation-type hello ())
-
-(define-presentation-method present (object (type hello) stream view &key)
- (declare (ignore object view))
- (draw-line* stream 10 40 40 40))
-
-(defmethod medium-draw-line* (stream x1 y1 x2 y2)
- (declare (ignore x1 y1 x2 y2))
- (format stream "[a line]"))
-
-(define-gsharp-command com-accept-x ((x 'bla))
- (format *error-output* "~a~%" x))
-
-(define-gsharp-command com-accept-y ((y 'blabla))
- (format *error-output* "~a~%" y))
-
-(define-gsharp-command com-accept-z ((z 'hello))
- (format *error-output* "~a~%" z))
-
-;;; Presentation tests for now
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
(defun draw-the-cursor (pane x)
(let* ((state (input-state *gsharp-frame*))
(staff (staff state))
@@ -346,8 +312,36 @@
(input-state *gsharp-frame*) input-state
(staves (car (layers (car (segments buffer))))) (list staff))))
-(define-gsharp-command (com-load-file :name t) ((filename 'string :prompt "File Name"))
- (let* ((buffer (read-everything filename))
+(define-presentation-type completable-pathname ()
+ :inherit-from 'pathname)
+
+(define-condition file-not-found (gsharp-condition) ()
+ (:report
+ (lambda (condition stream)
+ (declare (ignore condition))
+ (format stream "File nont found"))))
+
+(define-presentation-method accept
+ ((type completable-pathname) stream (view textual-view) &key)
+ (multiple-value-bind (pathname success string)
+ (complete-input stream
+ (lambda (so-far mode)
+ (complete-from-possibilities
+ so-far (ext:ambiguous-files so-far) '()
+ :action mode
+ :predicate (lambda (obj) (declare (ignore obj)) t)
+ :name-key #'namestring
+ :value-key #'identity))
+ :allow-any-input t)
+ (declare (ignore success))
+ (or pathname string)))
+
+(define-gsharp-command (com-load-file :name t) ()
+ (let* ((stream (frame-standard-input *gsharp-frame*))
+ (filename (handler-case (accept 'completable-pathname :stream stream
+ :prompt "File Name")
+ (simple-parse-error () (error 'file-not-found))))
+ (buffer (read-everything filename))
(staff (car (staves buffer)))
(input-state (make-input-state staff))
(cursor (make-initial-cursor buffer)))
@@ -356,10 +350,14 @@
(cursor *gsharp-frame*) cursor)
(number-all (buffer *gsharp-frame*))))
-(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-save-buffer-as :name t) ()
+ (let* ((stream (frame-standard-input *gsharp-frame*))
+ (filename (handler-case (accept 'completable-pathname :stream stream
+ :prompt "File Name")
+ (simple-parse-error () (error 'file-not-found)))))
+ (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 :name t) ()
(frame-exit *application-frame*))
@@ -445,9 +443,10 @@
(setf (staff (input-state *gsharp-frame*))
staff))))))
-(define-gsharp-command (com-insert-layer-after :name t) ((staff-name 'string :prompt "Staff"))
+(define-gsharp-command (com-insert-layer-after :name t) ()
(let ((cursor (cursor *gsharp-frame*))
- (staff (find-staff staff-name (buffer *gsharp-frame*))))
+ (staff (accept 'staff :prompt "Staff")))
+;;; (staff (find-staff staff-name (buffer *gsharp-frame*))))
(if (not staff)
(message "No such staff in buffer~%")
(progn (insert-layer-after (make-initialized-layer) cursor)
@@ -456,7 +455,6 @@
(add-staff-to-layer staff layer)
(setf (staff (input-state *gsharp-frame*))
staff))))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.2 gsharp/packages.lisp:1.3
--- gsharp/packages.lisp:1.2 Mon Feb 16 08:08:00 2004
+++ gsharp/packages.lisp Wed Jul 14 11:07:33 2004
@@ -115,7 +115,7 @@
#:128th-rest #:measure-rest #:double-whole-rest))
(defpackage :score-pane
- (:use :clim :clim-extensions :clim-lisp :sdl)
+ (:use :clim :clim-extensions :clim-lisp :sdl :gsharp-buffer)
(:export #:draw-staff #:draw-stem #:draw-right-stem #:draw-left-stem
#:draw-ledger-line #:draw-bar-line #:draw-beam #:staff-step
#:draw-notehead #:draw-accidental #:draw-clef #:draw-rest #:draw-dot
Index: gsharp/score-pane.lisp
diff -u gsharp/score-pane.lisp:1.3 gsharp/score-pane.lisp:1.4
--- gsharp/score-pane.lisp:1.3 Thu Apr 8 20:42:12 2004
+++ gsharp/score-pane.lisp Wed Jul 14 11:07:33 2004
@@ -407,13 +407,16 @@
(loop for staff-line in (slot-value record 'staff-lines)
do (replay-output-record staff-line stream region x-offset y-offset)))
-(defun draw-staff (pane x1 x2)
- (multiple-value-bind (left right) (bar-line-offsets *font*)
- (loop for staff-step from 0 by 2
- repeat 5 do
- (present (make-instance 'staff-line :x1 (+ x1 left) :staff-step staff-step :x2 (+ x2 right))
- 'staff-line :stream pane))))
-;;; (draw-staff-line pane (+ x1 left) staff-step (+ x2 right))))
+(define-presentation-method present
+ (staff (type staff) stream (view textual-view) &key)
+ (format stream "[staff ~a]" (name staff)))
+
+(defun draw-staff (staff pane x1 x2)
+ (with-output-as-presentation (pane staff 'staff)
+ (multiple-value-bind (left right) (bar-line-offsets *font*)
+ (loop for staff-step from 0 by 2
+ repeat 5
+ do (draw-staff-line pane (+ x1 left) staff-step (+ x2 right))))))
;;;;;;;;;;;;;;;;;; stem
