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)