diff --git a/collects/mred/mred-sig.rkt b/collects/mred/mred-sig.rkt index 1f8aa21788..0b5efef1eb 100644 --- a/collects/mred/mred-sig.rkt +++ b/collects/mred/mred-sig.rkt @@ -143,6 +143,7 @@ open-output-text-editor pane% panel% pasteboard% +pdf-dc% pen% pen-list% play-sound diff --git a/collects/racket/draw.rkt b/collects/racket/draw.rkt index db3c9f1ff3..03abf81407 100644 --- a/collects/racket/draw.rkt +++ b/collects/racket/draw.rkt @@ -27,6 +27,7 @@ dc<%> bitmap-dc% post-script-dc% + pdf-dc% ps-setup% current-ps-setup get-face-list get-family-builtin-face diff --git a/collects/racket/draw/draw-sig.rkt b/collects/racket/draw/draw-sig.rkt new file mode 100644 index 0000000000..0d29b7c2a0 --- /dev/null +++ b/collects/racket/draw/draw-sig.rkt @@ -0,0 +1,32 @@ +#lang racket/signature + +bitmap% +bitmap-dc% +brush% +brush-list% +color% +color-database<%> +current-ps-setup +dc<%> +dc-path% +font% +font-list% +font-name-directory<%> +get-face-list +get-family-builtin-face +gl-config% +gl-context<%> +make-bitmap +make-monochrome-bitmap +pdf-dc% +pen% +pen-list% +point% +post-script-dc% +ps-setup% +region% +the-brush-list +the-color-database +the-font-list +the-font-name-directory +the-pen-list diff --git a/collects/racket/draw/draw-unit.rkt b/collects/racket/draw/draw-unit.rkt new file mode 100644 index 0000000000..84c8f76393 --- /dev/null +++ b/collects/racket/draw/draw-unit.rkt @@ -0,0 +1,8 @@ +#lang racket/base +(require racket/unit + racket/draw + "draw-sig.rkt") + +(provide draw@) +(define-unit-from-context draw@ draw^) + diff --git a/collects/racket/draw/private/post-script-dc.rkt b/collects/racket/draw/private/post-script-dc.rkt index 287466a7c8..727375eb5a 100644 --- a/collects/racket/draw/private/post-script-dc.rkt +++ b/collects/racket/draw/private/post-script-dc.rkt @@ -14,9 +14,10 @@ "local.ss" "ps-setup.ss") -(provide post-script-dc%) +(provide post-script-dc% + pdf-dc%) -(define dc-backend% +(define (make-dc-backend pdf?) (class default-dc-backend% (init [interactive #t] [parent #f] @@ -35,11 +36,13 @@ [to-file? (eq? (send pss get-mode) 'file)] [get-file (lambda (fn) ((gui-dynamic-require 'put-file) - "Save PostScript As" + (if pdf? + "Save PDF As" + "Save PostScript As") parent (and fn (path-only fn)) (and fn (file-name-from-path fn)) - "ps"))] + (if pdf? "pdf" "ps")))] [fn (if to-file? (if interactive (get-file (send pss get-file)) @@ -54,18 +57,26 @@ [h (caddr paper)] [landscape? (eq? (send pss get-orientation) 'landscape)] [file (open-output-file - (or fn (make-temporary-file "draw~a.ps")) + (or fn (make-temporary-file (if pdf? + "draw~a.pdf" + "draw~a.ps"))) #:exists 'truncate/replace)] [port-box (make-immobile file)]) - (values - (cairo_ps_surface_create_for_stream write_port_bytes - port-box - w - h) - port-box ; needs to be accessible as long as `s' - w - h - landscape?))))] + (let-values ([(w h) (if (and pdf? landscape?) + (values h w) + (values w h))]) + (values + ((if pdf? + cairo_pdf_surface_create_for_stream + cairo_ps_surface_create_for_stream) + write_port_bytes + port-box + w + h) + port-box ; needs to be accessible as long as `s' + w + h + landscape?)))))] [else (values #f #f #f #f)]))) @@ -82,10 +93,11 @@ (send (current-ps-setup) get-translation xb yb) (values (unbox xb) (unbox yb)))) - (when (and s as-eps) - (cairo_ps_surface_set_eps s #t)) - (when (and s landscape?) - (cairo_ps_surface_dsc_comment s "%%Orientation: Landscape")) + (unless pdf? + (when (and s as-eps) + (cairo_ps_surface_set_eps s #t)) + (when (and s landscape?) + (cairo_ps_surface_dsc_comment s "%%Orientation: Landscape"))) (define c (and s (cairo_create s))) @@ -98,7 +110,7 @@ (def/override (get-size) (let ([w (exact->inexact (/ (- width margin-x margin-x) scale-x))] [h (exact->inexact (/ (- height margin-y margin-y) scale-y))]) - (if landscape? + (if (and (not pdf?) landscape?) (values h w) (values w h)))) @@ -112,7 +124,7 @@ (define/override (init-cr-matrix c) (cairo_translate c trans-x trans-y) - (if landscape? + (if (and landscape? (not pdf?)) (begin (cairo_translate c 0 height) (cairo_rotate c (/ pi -2)) @@ -138,7 +150,10 @@ (super-new))) -(define post-script-dc% (dc-mixin dc-backend%)) +(define post-script-dc% (class (dc-mixin (make-dc-backend #f)) + (super-new))) +(define pdf-dc% (class (dc-mixin (make-dc-backend #t)) + (super-new))) (define (write-port-bytes port-box bytes len) (write-bytes (scheme_make_sized_byte_string bytes len 0) diff --git a/collects/racket/draw/unsafe/cairo.rkt b/collects/racket/draw/unsafe/cairo.rkt index 78712b5b97..21d8956b08 100644 --- a/collects/racket/draw/unsafe/cairo.rkt +++ b/collects/racket/draw/unsafe/cairo.rkt @@ -201,6 +201,10 @@ ;; allocation. (_fun _fpointer _pointer _double* _double* -> _cairo_surface_t) #:wrap (allocator cairo_surface_destroy)) +(define-cairo cairo_pdf_surface_create_for_stream + ;; As above: + (_fun _fpointer _pointer _double* _double* -> _cairo_surface_t) + #:wrap (allocator cairo_surface_destroy)) (define/provide _cairo_write_func_t (_fun _pointer _pointer _uint -> _int)) (define-cairo cairo_ps_surface_set_eps (_fun _cairo_surface_t _bool -> _void) #:fail (lambda () diff --git a/collects/scribblings/draw/draw-unit.scrbl b/collects/scribblings/draw/draw-unit.scrbl new file mode 100644 index 0000000000..d3eac9b8ba --- /dev/null +++ b/collects/scribblings/draw/draw-unit.scrbl @@ -0,0 +1,26 @@ +#lang scribble/doc +@(require "common.ss" + (for-label racket/draw/draw-unit + racket/draw/draw-sig)) + +@title{Signature and Unit} + +The @racketmodname[racket/draw/draw-sig] and +@racketmodname[racket/draw/draw-unit] libraries define the +@racket[draw^] signature and @racket[draw@] implementation. + +@section{Draw Unit} + +@defmodule[racket/draw/draw-unit] + +@defthing[draw@ unit?]{ +Re-exports all of the exports of @racketmodname[racket/draw].} + + +@section{Draw Signature} + +@defmodule[racket/draw/draw-sig] + +@defsignature[draw^ ()] + +Includes all of the identifiers exported by @racketmodname[racket/draw]. diff --git a/collects/scribblings/draw/pdf-dc-class.scrbl b/collects/scribblings/draw/pdf-dc-class.scrbl new file mode 100644 index 0000000000..5847b8b6d4 --- /dev/null +++ b/collects/scribblings/draw/pdf-dc-class.scrbl @@ -0,0 +1,17 @@ +#lang scribble/doc +@(require "common.ss") + +@defclass/title[pdf-dc% object% (dc<%>)]{ + +Like @racket[post-script-dc%], but generates a PDF file instead of a + PostScript file. + +@defconstructor[([interactive any/c #t] + [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) false/c) #f] + [use-paper-bbox any/c #f] + [as-eps any/c #t])]{ + +See @racket[post-script-dc%] for information on the arguments. The +@racket[as-eps] argument is allowed for consistency with +@racket[post-script-dc%], but its value is ignored.}} + diff --git a/collects/scribblings/draw/pen-class.scrbl b/collects/scribblings/draw/pen-class.scrbl index 2f66d20cde..7ca9b0a576 100644 --- a/collects/scribblings/draw/pen-class.scrbl +++ b/collects/scribblings/draw/pen-class.scrbl @@ -95,17 +95,21 @@ A pen of size @scheme[0] uses the minimum line size for the [style (one-of/c 'transparent 'solid 'xor 'hilite 'dot 'long-dash 'short-dash 'dot-dash 'xor-dot 'xor-long-dash 'xor-short-dash - 'xor-dot-dash)]) + 'xor-dot-dash)] + [cap-style (one-of/c 'round 'projecting 'butt)] + [join-style (one-of/c 'round 'bevel 'miter)]) ([color-name string?] [width (real-in 0 255)] [style (one-of/c 'transparent 'solid 'xor 'dot 'hilite 'long-dash 'short-dash 'dot-dash 'xor-dot 'xor-long-dash 'xor-short-dash - 'xor-dot-dash)]))]{ + 'xor-dot-dash)] + [cap-style (one-of/c 'round 'projecting 'butt)] + [join-style (one-of/c 'round 'bevel 'miter)]))]{ When no argument are provided, the result is a solid black pen of width @scheme[0]. Otherwise, the result is a pen with the given - color, width, and style. For the case that the color is specified + color, width, style, cap style, and join style. For the case that the color is specified using a name, see @scheme[color-database<%>] for information about color names; if the name is not known, the pen's color is black. diff --git a/collects/scribblings/draw/post-script-dc-class.scrbl b/collects/scribblings/draw/post-script-dc-class.scrbl index b27b99beb8..8767e7e0c7 100644 --- a/collects/scribblings/draw/post-script-dc-class.scrbl +++ b/collects/scribblings/draw/post-script-dc-class.scrbl @@ -5,7 +5,7 @@ A @scheme[post-script-dc%] object is a PostScript device context, that can write PostScript files on any platform. See also - @scheme[ps-setup%]. + @scheme[ps-setup%] and @racket[pdf-dc%]. @|PrintNote| diff --git a/collects/scribblings/draw/reference.scrbl b/collects/scribblings/draw/reference.scrbl index f652399ddc..e8e05d6811 100644 --- a/collects/scribblings/draw/reference.scrbl +++ b/collects/scribblings/draw/reference.scrbl @@ -18,6 +18,7 @@ @include-section["font-name-directory-intf.scrbl"] @include-section["gl-config-class.scrbl"] @include-section["gl-context-intf.scrbl"] +@include-section["pdf-dc-class.scrbl"] @include-section["pen-class.scrbl"] @include-section["pen-list-class.scrbl"] @include-section["point-class.scrbl"] @@ -25,3 +26,4 @@ @include-section["ps-setup-class.scrbl"] @include-section["region-class.scrbl"] @include-section["draw-funcs.scrbl"] +@include-section["draw-unit.scrbl"] diff --git a/collects/slideshow/cmdline.rkt b/collects/slideshow/cmdline.rkt index d6b935cada..fe6a77d54e 100644 --- a/collects/slideshow/cmdline.rkt +++ b/collects/slideshow/cmdline.rkt @@ -26,8 +26,7 @@ (define-values (use-screen-w use-screen-h) (values actual-screen-w actual-screen-h)) (define condense? #f) - (define printing? #f) - (define native-printing? #f) + (define printing-mode #f) (define commentary? #f) (define commentary-on-slide? #f) (define show-gauge? #f) @@ -60,12 +59,13 @@ [once-each (("-d" "--preview") "show next-slide preview (useful on a non-mirroring display)" (set! two-frames? #t)) - (("-p" "--print") "print (always to PostScript, except under Windows and Mac OS)" - (set! printing? #t) - (set! native-printing? #t)) + (("-p" "--print") "print" + (set! printing-mode 'print)) (("-P" "--ps") "print to PostScript" - (set! printing? #t)) - (("-o") file "set output file for PostScript printing" + (set! printing-mode 'ps)) + (("-D" "--pdf") "print to PDF" + (set! printing-mode 'pdf)) + (("-o") file "set output file for PostScript or PDF printing" (set! print-target file)) (("-c" "--condense") "condense" (set! condense? #t)) @@ -138,40 +138,50 @@ (length slide-module-file) slide-module-file)])])) - (when (or printing? condense?) + (define printing? (and printing-mode #t)) + + (when (or printing-mode condense?) (set! use-transitions? #f)) - (when printing? + (when printing-mode (set! use-offscreen? #f) (set! use-prefetch? #f) (set! keep-titlebar? #t)) (dc-for-text-size - (if printing? + (if printing-mode (let ([p (let ([pss (make-object ps-setup%)]) (send pss set-mode 'file) (send pss set-file (if print-target print-target - (if file-to-load - (path-replace-suffix (file-name-from-path file-to-load) - (if quad-view? - "-4u.ps" - ".ps")) - "untitled.ps"))) + (let ([suffix + (if (eq? printing-mode 'pdf) + "pdf" + "ps")]) + (if file-to-load + (path-replace-suffix (file-name-from-path file-to-load) + (format + (if quad-view? + "-4u.~a" + ".~a") + suffix)) + (format "untitled.~a" suffix))))) (send pss set-orientation 'landscape) (parameterize ([current-ps-setup pss]) - (if native-printing? - ;; Make printer-dc% - (begin - (when (can-get-page-setup-from-user?) - (let ([v (get-page-setup-from-user)]) - (if v - (send pss copy-from v) - (exit)))) - (make-object printer-dc% #f)) - ;; Make ps-dc%: - (make-object post-script-dc% (not print-target) #f #t #f))))]) + (case printing-mode + [(print) + ;; Make printer-dc% + (when (can-get-page-setup-from-user?) + (let ([v (get-page-setup-from-user)]) + (if v + (send pss copy-from v) + (exit)))) + (make-object printer-dc% #f)] + [(ps) + (make-object post-script-dc% (not print-target) #f #t #f)] + [(pdf) + (make-object pdf-dc% (not print-target) #f #t #f)])))]) ;; Init page, set "screen" size, etc.: (unless (send p ok?) (exit)) (send p start-doc "Slides") diff --git a/collects/slideshow/core.rkt b/collects/slideshow/core.rkt index c343e583a7..f0b2e5987b 100644 --- a/collects/slideshow/core.rkt +++ b/collects/slideshow/core.rkt @@ -3,7 +3,7 @@ (require scheme/class scheme/unit scheme/file - mred + racket/draw texpict/mrpict texpict/utils scheme/math @@ -1019,7 +1019,7 @@ (+ x-space (* xs w))) (>= (send scroll-bm get-height) (+ y-space (* ys h)))) - (set! scroll-bm (make-screen-bitmap + (set! scroll-bm (make-bitmap (inexact->exact (ceiling (+ x-space (* xs w)))) (inexact->exact (ceiling (+ y-space (* ys h)))))) (if (send scroll-bm ok?) diff --git a/collects/slideshow/pict.rkt b/collects/slideshow/pict.rkt index 5f2994cbde..f307fa62ca 100644 --- a/collects/slideshow/pict.rkt +++ b/collects/slideshow/pict.rkt @@ -7,8 +7,8 @@ [pin-line t:pin-line] [pin-arrow-line t:pin-arrow-line] [pin-arrows-line t:pin-arrows-line]) - (only-in scheme/gui/base dc-path%) - (only-in scheme/class new send)) + (only-in racket/draw dc-path%) + (only-in racket/class new send)) (define (hline w h #:segment [seg #f]) (if seg diff --git a/collects/slideshow/slides-to-picts.rkt b/collects/slideshow/slides-to-picts.rkt index f14e2955d1..f4b1e221a3 100644 --- a/collects/slideshow/slides-to-picts.rkt +++ b/collects/slideshow/slides-to-picts.rkt @@ -1,6 +1,6 @@ (module slides-to-picts scheme/base - (require mred + (require racket/draw scheme/class scheme/unit "sig.ss" @@ -14,7 +14,7 @@ (define get-slides-as-picts (lambda (file w h c? [stop-after #f]) - (let ([ns (make-gui-namespace)] + (let ([ns (make-base-namespace)] [orig-ns (namespace-anchor->empty-namespace anchor)] [slides null] [xs (/ w 1024)] diff --git a/collects/tests/gracket/draw.rkt b/collects/tests/gracket/draw.rkt index 389223493b..882d0cb9a1 100644 --- a/collects/tests/gracket/draw.rkt +++ b/collects/tests/gracket/draw.rkt @@ -263,7 +263,7 @@ [on-paint (case-lambda [() (time (on-paint #f))] - [(ps?) + [(kind) (let* ([can-dc (get-dc)] [pen0s (make-object pen% "BLACK" 0 'solid)] [pen1s (make-object pen% "BLACK" 1 'solid)] @@ -811,7 +811,7 @@ (send dc draw-rectangle 180 205 20 20) (send dc set-brush brushs)))) - (when (and pixel-copy? last? (not (or ps? (eq? dc can-dc)))) + (when (and pixel-copy? last? (not (or kind (eq? dc can-dc)))) (let* ([x 100] [y 170] [x2 245] [y2 188] @@ -941,7 +941,7 @@ (send dc draw-rectangle 187 310 20 20) (send dc set-pen p))) - (when (and last? (not (or ps? (eq? dc can-dc))) + (when (and last? (not (or kind (eq? dc can-dc))) (send mem-dc get-bitmap)) (send can-dc draw-bitmap (send mem-dc get-bitmap) 0 0 'opaque))) @@ -950,10 +950,11 @@ (send (get-dc) set-scale 1 1) (send (get-dc) set-origin 0 0) - (let ([dc (if ps? - (let ([dc (if (eq? ps? 'print) - (make-object printer-dc%) - (make-object post-script-dc%))]) + (let ([dc (if kind + (let ([dc (case kind + [(print) (make-object printer-dc%)] + [(ps) (make-object post-script-dc%)] + [(pdf) (make-object pdf-dc%)])]) (and (send dc ok?) dc)) (if (and use-bitmap?) (begin @@ -1112,7 +1113,7 @@ (let-values ([(w h) (send dc get-size)]) (unless (cond - [ps? #t] + [kind #t] [use-bad? #t] [use-bitmap? (and (= w (* xscale DRAW-WIDTH)) (= h (* yscale DRAW-HEIGHT)))] [else (and (= w (* 2 DRAW-WIDTH)) (= h (* 2 DRAW-HEIGHT)))]) @@ -1143,10 +1144,10 @@ '(horizontal)) (make-object button% "PS" hp (lambda (self event) - (send canvas on-paint #t))) - (make-object button% "Print" hp + (send canvas on-paint 'ps))) + (make-object button% "PDF" hp (lambda (self event) - (send canvas on-paint 'print))) + (send canvas on-paint 'pdf))) (make-object choice% #f '("1" "*2" "/2" "1,*2" "*2,1") hp (lambda (self event) (send canvas set-scale @@ -1243,6 +1244,7 @@ (send canvas refresh))))]) (set! do-clock clock) (make-object button% "Clip Clock" hp3 (lambda (b e) (clock #t))) + (make-object button% "Print" hp4 (lambda (self event) (send canvas on-paint 'print))) (make-object button% "Print Setup" hp4 (lambda (b e) (let ([c (get-page-setup-from-user)]) (when c (send (current-ps-setup) copy-from c))))) diff --git a/collects/texpict/balloon.rkt b/collects/texpict/balloon.rkt index d099f4b7f3..efbd448328 100644 --- a/collects/texpict/balloon.rkt +++ b/collects/texpict/balloon.rkt @@ -1,7 +1,7 @@ (module balloon mzscheme (require "mrpict.ss" "utils.ss" - mred + racket/draw mzlib/class mzlib/etc mzlib/math) diff --git a/collects/texpict/code.rkt b/collects/texpict/code.rkt index 3db6931c05..43563488bb 100644 --- a/collects/texpict/code.rkt +++ b/collects/texpict/code.rkt @@ -4,7 +4,7 @@ mzlib/class mzlib/list (only scheme/list last) - mred + racket/draw mzlib/unit) (provide define-code code^ code-params^ code@) diff --git a/collects/texpict/doc.txt b/collects/texpict/doc.txt index afc95dbd2c..8d90e46fcf 100644 --- a/collects/texpict/doc.txt +++ b/collects/texpict/doc.txt @@ -67,7 +67,7 @@ GRacket (or PostScript) output The GRacket texpict function set is loaded by the _mrpict.ss_ library. The library is available in unit form via _mrpict-unit.ss_, which -exports a `mrpict@' unit that imports mred^ and exports +exports a `mrpict@' unit that imports draw^ and exports `texpict-common^' and `mrpict-extra^'. The _mrpict-sig.ss_ library file provides both signatures. diff --git a/collects/texpict/face.rkt b/collects/texpict/face.rkt index 328c2d3cbb..cad9bc968a 100644 --- a/collects/texpict/face.rkt +++ b/collects/texpict/face.rkt @@ -1,5 +1,5 @@ (module face mzscheme - (require mred + (require racket/draw texpict/mrpict texpict/utils mzlib/class diff --git a/collects/texpict/flash.rkt b/collects/texpict/flash.rkt index d86771d678..b58330f7b6 100644 --- a/collects/texpict/flash.rkt +++ b/collects/texpict/flash.rkt @@ -3,7 +3,7 @@ (require "mrpict.ss" mzlib/math mzlib/etc - mred + racket/draw mzlib/class) (provide filled-flash diff --git a/collects/texpict/mrpict-unit.rkt b/collects/texpict/mrpict-unit.rkt index 076bcebeda..135e832706 100644 --- a/collects/texpict/mrpict-unit.rkt +++ b/collects/texpict/mrpict-unit.rkt @@ -2,7 +2,7 @@ (module mrpict-unit mzscheme (require mzlib/unit) - (require mred/mred-sig) + (require racket/draw/draw-sig) (require "private/mrpict-sig.ss" "private/common-sig.ss" @@ -11,6 +11,6 @@ (provide mrpict@) (define-compound-unit/infer mrpict@ - (import mred^) + (import draw^) (export texpict-common^ mrpict-extra^) (link common@ mrpict-extra@))) diff --git a/collects/texpict/mrpict.rkt b/collects/texpict/mrpict.rkt index 6554bb087f..e39bcd73b1 100644 --- a/collects/texpict/mrpict.rkt +++ b/collects/texpict/mrpict.rkt @@ -3,10 +3,10 @@ (require mzlib/unit mzlib/contract mzlib/class - mred) + racket/draw) - (require mred/mred-sig - mred/mred-unit) + (require racket/draw/draw-sig + racket/draw/draw-unit) (require "private/mrpict-sig.ss" "private/common-sig.ss") (require "mrpict-sig.ss" @@ -15,7 +15,7 @@ (define-compound-unit/infer mrpict+mred@ (import) (export texpict-common^ mrpict-extra^) - (link standard-mred@ mrpict@)) + (link draw@ mrpict@)) (define-values/invoke-unit/infer mrpict+mred@) diff --git a/collects/texpict/private/common-unit.rkt b/collects/texpict/private/common-unit.rkt index ddaa775245..bb764d09c6 100644 --- a/collects/texpict/private/common-unit.rkt +++ b/collects/texpict/private/common-unit.rkt @@ -1,6 +1,6 @@ #lang racket/unit - (require racket/gui/base + (require racket/draw racket/class racket/list) diff --git a/collects/texpict/private/mrpict-extra.rkt b/collects/texpict/private/mrpict-extra.rkt index c5195d0593..4e6fd12930 100644 --- a/collects/texpict/private/mrpict-extra.rkt +++ b/collects/texpict/private/mrpict-extra.rkt @@ -4,12 +4,13 @@ (require mzlib/class mzlib/etc) - (require mred/mred-sig) + (require racket/draw/draw-sig + racket/gui/dynamic) (require "mrpict-sig.ss" "common-sig.ss") - (import mred^ + (import draw^ texpict-common^ texpict-internal^) (export mrpict-extra^ @@ -21,7 +22,7 @@ (define pict-drawer (make-pict-drawer the-pict)) (define no-redraw? #f) (define pict-frame% - (class frame% + (class (gui-dynamic-require 'frame%) (define/public (set-pict p) (set! the-pict p) (set! pict-drawer (make-pict-drawer the-pict)) @@ -34,7 +35,7 @@ (send c on-paint)) (super-instantiate ()))) (define pict-canvas% - (class canvas% + (class (gui-dynamic-require 'canvas%) (inherit get-dc) (define/override (on-paint) (unless no-redraw? diff --git a/collects/texpict/utils.rkt b/collects/texpict/utils.rkt index 506549ef46..4fedf0d5f9 100644 --- a/collects/texpict/utils.rkt +++ b/collects/texpict/utils.rkt @@ -1,6 +1,11 @@ -#lang scheme/gui +#lang racket/base - (require "mrpict.ss") + (require racket/contract + racket/class + racket/draw + racket/math + racket/gui/dynamic + "mrpict.ss") ;; Utilities for use with mrpict @@ -886,8 +891,10 @@ (let ([bm (cond [(bitmap-draft-mode) #f] [(filename . is-a? . bitmap%) filename] - [(filename . is-a? . image-snip%) (send filename get-bitmap)] - [else (make-object bitmap% filename 'unknown/mask)])]) + [(path-string? filename) (make-object bitmap% filename 'unknown/mask)] + [(and (gui-available?) + (filename . is-a? . (gui-dynamic-require 'image-snip%))) + (send filename get-bitmap)])]) (if (and bm (send bm ok?)) (let ([w (send bm get-width)] [h (send bm get-height)]) diff --git a/doc/release-notes/racket/Draw_and_GUI_5_1.txt b/doc/release-notes/racket/Draw_and_GUI_5_1.txt index 36c1d1ef75..4c1688c8d3 100644 --- a/doc/release-notes/racket/Draw_and_GUI_5_1.txt +++ b/doc/release-notes/racket/Draw_and_GUI_5_1.txt @@ -112,6 +112,9 @@ that it is installed as a clipping region. The old 'xor mode for pens and brushes is no longer available (since it is not supported by Cairo). +The new `pdf-dc%' drawing context is like `post-script-dc%', but it +generates PDF output. + Editor Changes --------------