[gsharp-cvs] CVS gsharp

[crhodes]

Update of /project/gsharp/cvsroot/gsharp
In directory clnet:/tmp/cvs-serv10489

Modified Files:
	drawing.lisp gui.lisp packages.lisp 
Log Message:
Printing to file.

It's still somewhat hacky, but the worst of it is gone:

* light glyphs ink is taken from the view, so we can construct a dark
  ink for light glyphs;
* code to draw a single page is shared between the printing and 
  screen-drawing routines;
* new-page is called the right number of times;
* the user is prompted for a filename (with a sensible default).

Remaining stuff to do:

* factor out a little bit more shared code between draw-buffer and 
  print-buffer;
* when creating the view, copy the current view;
* be cleverer about the medium transformation.


--- /project/gsharp/cvsroot/gsharp/drawing.lisp	2007/07/27 22:31:04	1.81
+++ /project/gsharp/cvsroot/gsharp/drawing.lisp	2007/08/07 11:06:09	1.82
@@ -541,27 +541,44 @@
 			    (- (line-width method) timesig-offset)
 			    (lines-per-page method)))
 
+(defun draw-page (pane buffer x y staves maxmethod page-measures)
+  (let* ((systems-per-page (max 1 (floor 12 (length staves))))
+         (measure-seqs (layout-page page-measures systems-per-page maxmethod)))
+    (dolist (measures measure-seqs)
+      (let* ((toffset (compute-timesig-offset staves measures))
+             (method (method-for-timesig (buffer-cost-method buffer) toffset)))
+        (compute-and-draw-system pane buffer staves measures method
+                                 x y toffset (right-edge buffer))
+        (incf y (+ 20 (* 70 (length staves))))))))
+
 (defmethod draw-buffer (pane (buffer buffer) *cursor* x y)
   (score-pane:with-staff-size 6
     (let* ((staves (staves buffer))
 	   (max-timesig-offset (* (score-pane:staff-step 2.5) 7))
-	   (method (method-for-timesig (buffer-cost-method buffer) max-timesig-offset))
-	   (right-edge (right-edge buffer))
-	   (systems-per-page (max 1 (floor 12 (length staves)))))
+	   (method (method-for-timesig 
+                    (buffer-cost-method buffer) max-timesig-offset)))
+      (loop for staff in staves
+	    for offset from 0 by 70 do
+	    (setf (staff-yoffset staff) offset))
+      (dopages (page-measures buffer)
+        (when (cursor-in-measures-p *cursor* page-measures)
+          (draw-page pane buffer x y staves method page-measures))))))
+
+(defmethod print-buffer (pane (buffer buffer) *cursor* x y)
+  (score-pane:with-staff-size 6
+    (let* ((staves (staves buffer))
+	   (max-timesig-offset (* (score-pane:staff-step 2.5) 7))
+	   (method (method-for-timesig 
+                    (buffer-cost-method buffer) max-timesig-offset)))
       (loop for staff in staves
 	    for offset from 0 by 70 do
 	    (setf (staff-yoffset staff) offset))
-      (let ((yy y))
-	(dopages (page-measures buffer)
-	  (when (cursor-in-measures-p *cursor* page-measures)
-	    (let ((measure-seqs (layout-page page-measures systems-per-page method)))
-	      (dolist (measures measure-seqs)
-		(let* ((toffset (compute-timesig-offset staves measures))
-		       (method (method-for-timesig 
-				(buffer-cost-method buffer) toffset)))
-		  (compute-and-draw-system pane buffer staves measures
-					   method x yy toffset right-edge)
-		  (incf yy (+ 20 (* 70 (length staves)))))))))))))
+      (let ((first t))
+        (dopages (page-measures buffer)
+          (unless first
+            (new-page pane))
+          (draw-page pane buffer x y staves method page-measures)
+          (setq first nil))))))
 
 (define-stealth-mixin xelement () element
   ((final-absolute-xoffset :accessor final-absolute-element-xoffset)))
--- /project/gsharp/cvsroot/gsharp/gui.lisp	2007/07/06 14:16:20	1.81
+++ /project/gsharp/cvsroot/gsharp/gui.lisp	2007/08/07 11:06:09	1.82
@@ -200,7 +200,8 @@
     (score-pane:with-score-pane pane
       (draw-buffer pane buffer (current-cursor)
                    (left-margin buffer) 100)
-      (gsharp-drawing::draw-the-cursor pane (current-cursor) (cursor-element (current-cursor)) (last-note (input-state *application-frame*)))
+      (draw-the-cursor pane (current-cursor) (cursor-element (current-cursor))
+                       (last-note (input-state *application-frame*)))
       (multiple-value-bind (minx miny maxx maxy)
           (bounding-rectangle* pane)
         (declare (ignore minx maxx))
@@ -1505,3 +1506,36 @@
 
 (defmethod frame-make-new-buffer ((frame gsharp) &key &allow-other-keys)
   (make-instance 'buffer))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Printing
+
+(defun print-buffer-filename ()
+  (let* ((buffer (current-buffer))
+         (filepath (filepath buffer))
+         (name (name buffer))
+         (defaults (or filepath (merge-pathnames (make-pathname :name name)
+                                                 (user-homedir-pathname)))))
+    (merge-pathnames (make-pathname :type "ps") defaults)))
+
+(define-gsharp-command (com-print-buffer-to-file :name t)
+    ((filepath 'pathname
+               :prompt "Print To: " :prompt-mode :raw
+               :default (print-buffer-filename) :default-type 'pathname
+               :insert-default t))
+  (with-open-file (ps filepath :direction :output :if-exists :supersede)
+    (with-output-to-postscript-stream (s ps)
+      (setf (stream-default-view s)
+            ;; FIXME: should probably get the class of the view from
+            ;; the current buffer or window or something.
+            (make-instance 'orchestra-view :light-glyphs-ink +black+ 
+                           :buffer (current-buffer) :cursor (current-cursor)))
+      (setf (medium-transformation s)
+            ;; FIXME: This scaling works for me (A4 paper, default
+            ;; gsharp buffer sizes.
+            (compose-scaling-with-transformation (medium-transformation s)
+                                                 0.8 0.8))
+      (print-buffer s (current-buffer) (current-cursor) 
+                    (left-margin (current-buffer)) 100))))
+
--- /project/gsharp/cvsroot/gsharp/packages.lisp	2007/07/18 07:51:54	1.61
+++ /project/gsharp/cvsroot/gsharp/packages.lisp	2007/08/07 11:06:09	1.62
@@ -168,7 +168,7 @@
   (:use :clim :clim-lisp :gsharp-buffer :gsharp-measure :gsharp-cursor
 	:gsharp-utilities :sdl :gsharp-beaming :obseq)
   (:shadowing-import-from :gsharp-buffer #:rest)
-  (:export #:draw-buffer #:draw-the-cursor))
+  (:export #:draw-buffer #:draw-the-cursor #:print-buffer))
 
 (defpackage :gsharp-play
   (:use :common-lisp :midi :gsharp-buffer)