postscript-dc% interactive and landscape

collects/mred/private/filedialog.rkt

@@ -52,7 +52,9 @@
 	(raise-type-error who "list of 2-string lists" filters))
       (let* ([std? (memq 'common style)]
              [style (if std? (remq 'common style) style)])
-        (if (or std? (eq? (system-type) 'unix))
+        (if (or std? 
+                #t ; for now, always use the manually constructed dialog
+                (eq? (system-type) 'unix))
           (send (new path-dialog%
                   [put?      put?]
                   [dir?      dir?]

collects/mred/private/wx/cocoa/item.rkt

@@ -27,12 +27,12 @@
   (define/public (get-cocoa-control) (get-cocoa))
 
   (define/override (enable on?)
-    (tellv (get-cocoa) setEnabled: #:type _BOOL on?))
+    (tellv (get-cocoa-control) setEnabled: #:type _BOOL on?))
   (define/override (is-window-enabled?)
     (tell #:type _BOOL (get-cocoa-control) isEnabled))
 
   (define/override (gets-focus?)
-    (tell #:type _BOOL (get-cocoa) canBecomeKeyView))
+    (tell #:type _BOOL (get-cocoa-control) canBecomeKeyView))
 
   (define/public (command e)
     (callback this e))

collects/racket/draw/cairo.rkt

@@ -168,6 +168,8 @@
 (define-cairo cairo_ps_surface_create (_fun _path _double* _double* -> _cairo_surface_t)
   #:wrap (allocator cairo_surface_destroy))
 (define-cairo cairo_ps_surface_set_eps (_fun _cairo_surface_t _bool -> _void))
+(define-cairo cairo_ps_surface_dsc_begin_setup (_fun _cairo_surface_t -> _void))
+(define-cairo cairo_ps_surface_dsc_comment (_fun _cairo_surface_t _string -> _void))
 (define-cairo cairo_image_surface_get_data (_fun (s : _cairo_surface_t)
                                                  -> (_bytes o
                                                             (* (cairo_image_surface_get_height s)

collects/racket/draw/dc.rkt

@@ -325,13 +325,10 @@
     
 
     (define/private (do-reset-matrix cr)
-      (if (and (zero? scroll-dx)
+      (cairo_identity_matrix cr)
-               (zero? scroll-dy))
+      (init-cr-matrix cr)
-          (cairo_set_matrix cr matrix)
+      (cairo_translate cr scroll-dx scroll-dy)
-          (begin
+      (cairo_transform cr matrix)
-            (cairo_identity_matrix cr)
-            (cairo_translate cr scroll-dx scroll-dy)
-            (cairo_transform cr matrix)))
       (cairo_translate cr origin-x origin-y)
       (cairo_scale cr scale-x scale-y)
       (cairo_rotate cr (- rotation)))

collects/racket/draw/post-script-dc.rkt

@@ -1,7 +1,10 @@
 #lang scheme/base
 (require scheme/class
          scheme/file
+         racket/path
+         racket/math
          mred/private/syntax
+         racket/gui/dynamic
          "cairo.ss"
 	 "dc.ss"
          "font.ss"
@@ -17,6 +20,47 @@
           [use-paper-bbox #f]
           [as-eps #t])
 
+    (define-values (s width height landscape?)
+      (let ([su (if interactive
+                    ((gui-dynamic-require 'get-ps-setup-from-user))
+                    (current-ps-setup))])
+        (cond
+         [su 
+          (unless (eq? su (current-ps-setup))
+            (send (current-ps-setup) copy-from su))
+          (let* ([pss (current-ps-setup)]
+                 [to-file? (eq? (send pss get-mode) 'file)]
+                 [get-file (lambda (fn)
+                             ((gui-dynamic-require 'put-file)
+                              "Save PostScript As"
+                              #f
+                              (and fn (path-only fn))
+                              (and fn (file-name-from-path fn))
+                              "ps"))]
+                 [fn (if to-file?
+                         (if interactive
+                             (get-file (send pss get-file))
+                             (let ([fn (send pss get-file)])
+                               (or fn (get-file #f))))
+                         #f)])
+            (if (and to-file?
+                     (not fn))
+                (values #f #f #f #f)
+                (let* ([paper (assoc (send pss get-paper-name) paper-sizes)]
+                       [w (cadr paper)]
+                       [h (caddr paper)]
+                       [landscape? (eq? (send pss get-orientation) 'landscape)])
+                  (values
+                   (cairo_ps_surface_create (or fn
+                                                (make-temporary-file "draw~a.ps"))
+                                            w
+                                            h)
+                   w
+                   h
+                   landscape?))))]
+         [else
+          (values #f #f #f #f)])))
+
     (define-values (margin-x margin-y)
       (let ([xb (box 0)] [yb (box 0.0)])
         (send (current-ps-setup) get-margin xb yb)
@@ -25,30 +69,28 @@
       (let ([xb (box 0)] [yb (box 0.0)])
         (send (current-ps-setup) get-scaling xb yb)
         (values (unbox xb) (unbox yb))))
+    (define-values (trans-x trans-y)
+      (let ([xb (box 0)] [yb (box 0.0)])
+        (send (current-ps-setup) get-translation xb yb)
+        (values (unbox xb) (unbox yb))))
 
-    (define-values (s width height)
+    (when (and s as-eps)
-      (let* ([pss (current-ps-setup)]
-             [paper (assoc (send pss get-paper-name) paper-sizes)])
-        (values
-         (cairo_ps_surface_create (or (send pss get-filename)
-                                      (make-temporary-file "draw~a.ps"))
-                                  (cadr paper)
-                                  (caddr paper))
-         (cadr paper)
-         (caddr paper))))
-    (when as-eps
       (cairo_ps_surface_set_eps s #t))
+    (when (and s landscape?)
+      (cairo_ps_surface_dsc_comment s "%%Orientation: Landscape"))
 
-    (define c (cairo_create s))
+    (define c (and s (cairo_create s)))
-    (cairo_surface_destroy s)
+    
-
+    (when s (cairo_surface_destroy s))
-    (init-cr-matrix)
 
     (define/override (get-cr) c)
 
     (def/override (get-size)
-      (values (exact->inexact width)
+      (let ([w (exact->inexact (/ (- width margin-x margin-x) scale-x))]
-              (exact->inexact height)))
+            [h (exact->inexact (/ (- height margin-y margin-y) scale-y))])
+        (if landscape?
+            (values h w)
+            (values w h))))
 
     (define/override (end-cr)
       (cairo_surface_finish s)
@@ -56,9 +98,17 @@
       (set! c #f)
       (set! s #f))
 
-    (define/override (init-cr-matrix)
+    (define/override (init-cr-matrix c)
-      (cairo_translate c margin-x margin-y)
+      (cairo_translate c trans-x trans-y)
-      (cairo_scale c scale-x scale-y))
+      (if landscape?
+          (begin
+            (cairo_translate c 0 height)
+            (cairo_rotate c (/ pi -2))
+            (cairo_translate c margin-y margin-x)
+            (cairo_scale c scale-y scale-x))
+          (begin
+            (cairo_translate c margin-x margin-y)
+            (cairo_scale c scale-x scale-y))))
 
     (define/override (get-pango font)
       (send font get-ps-pango))
@@ -70,5 +120,4 @@
 
     (super-new)))
 
-(define post-script-dc%
+(define post-script-dc% (dc-mixin dc-backend%))
-  (dc-mixin dc-backend%))

collects/racket/draw/ps-setup.rkt

@@ -14,13 +14,13 @@
 
 (define (paper-name-string? s)
   (and (string? s)
-       (assoc paper-sizes s)))
+       (assoc s paper-sizes)))
 
 (define ps-setup%
   (class object%
     (properties
      [[string? command] "lpr"]
-     [[(make-or-false path-string?) filename] #f]
+     [[(make-or-false path-string?) file] #f]
      [[bool? level-2] #t]
      [[(symbol-in preview file printer) mode] 'file]
      [[(symbol-in portrait landscape) orientation] 'portrait]
@@ -35,6 +35,16 @@
     (define scale-y 0.8)
     (define trans-x 0.0)
     (define trans-y 0.0)
+
+    (def/public (copy-from [ps-setup% source]
+                           [any? [filename? #f]])
+      (set! command (send source get-command))
+      (when filename? (set! file (send source get-file)))
+      (set! level-2 (send source get-level-2))
+      (set! mode (send source get-mode))
+      (set! orientation (send source get-orientation))
+      (set! paper-name (send source get-paper-name))
+      (set! preview-command (send source get-preview-command)))
      
     (def/public (get-editor-margin [(make-box nonnegative-real?) x]
                                    [(make-box nonnegative-real?) y])

collects/scribblings/gui/ps-setup-class.scrbl

@@ -22,10 +22,12 @@ Creates a new @scheme[ps-setup%] object with the (platform-specific)
 
 }
 
-@defmethod[(copy-from [source (is-a?/c ps-setup%)])
+@defmethod[(copy-from [source (is-a?/c ps-setup%)]
+                      [copy-filename? any/c #f])
            void?]{
 
-Copies the settings @scheme[copy-from] to @this-obj[].
+Copies the settings @scheme[copy-from] to @this-obj[], excluding the
+filename unless @racket[copy-filename?] is true.
 
 }