add `svg-dc%'
original commit: 6afffb329c6d3cc55239f2f1fdf423be9c24765b
This commit is contained in:
parent
9624a40ecf
commit
3a1b93b05f
|
@ -183,6 +183,7 @@ style-list%
|
|||
style<%>
|
||||
subarea<%>
|
||||
subwindow<%>
|
||||
svg-dc%
|
||||
system-position-ok-before-cancel?
|
||||
tab-snip%
|
||||
text%
|
||||
|
|
|
@ -203,9 +203,9 @@
|
|||
[vp (make-object vertical-panel% f)]
|
||||
[hp0 (make-object horizontal-panel% vp)]
|
||||
[hp (make-object horizontal-panel% vp)]
|
||||
[hp3 (make-object horizontal-panel% vp)]
|
||||
[hp2 hp]
|
||||
[hp2.5 hp0]
|
||||
[hp3 hp]
|
||||
[hp4 (new horizontal-panel% [parent vp]
|
||||
[stretchable-height #f])]
|
||||
[bb (make-object bitmap% (sys-path "bb.gif") 'gif)]
|
||||
|
@ -222,6 +222,7 @@
|
|||
[use-bad? #f]
|
||||
[depth-one? #f]
|
||||
[cyan? #f]
|
||||
[multi-page? #f]
|
||||
[smoothing 'unsmoothed]
|
||||
[save-filename #f]
|
||||
[save-file-format #f]
|
||||
|
@ -995,6 +996,14 @@
|
|||
(let ([dc (if kind
|
||||
(let ([dc (case kind
|
||||
[(print) (make-object printer-dc%)]
|
||||
[(svg)
|
||||
(let ([fn (put-file)])
|
||||
(and fn
|
||||
(new svg-dc%
|
||||
[width (* xscale DRAW-WIDTH)]
|
||||
[height (* yscale DRAW-HEIGHT)]
|
||||
[output fn]
|
||||
[exists 'truncate])))]
|
||||
[(ps pdf)
|
||||
(let ([page?
|
||||
(eq? 'yes (message-box
|
||||
|
@ -1178,7 +1187,12 @@
|
|||
|
||||
(send dc set-clipping-region #f)
|
||||
|
||||
|
||||
(send dc end-page)
|
||||
(when (and kind multi-page?)
|
||||
(send dc start-page)
|
||||
(send dc draw-text "Page 2" 0 0)
|
||||
(send dc end-page))
|
||||
(send dc end-doc)))
|
||||
|
||||
(when save-filename
|
||||
|
@ -1202,6 +1216,28 @@
|
|||
(make-object button% "PDF" hp
|
||||
(lambda (self event)
|
||||
(send canvas on-paint 'pdf)))
|
||||
(make-object button% "SVG" hp
|
||||
(lambda (self event)
|
||||
(send canvas on-paint 'svg)))
|
||||
(make-object check-box% "Multiple Pages" hp
|
||||
(lambda (self event)
|
||||
(set! multi-page? (send self get-value))))
|
||||
(make-object button% "Save" hp
|
||||
(lambda (b e)
|
||||
(unless use-bitmap?
|
||||
(error 'save-file "only available for pixmap/bitmap mode"))
|
||||
(let ([f (put-file)])
|
||||
(when f
|
||||
(let ([format
|
||||
(cond
|
||||
[(regexp-match "[.]xbm$" f) 'xbm]
|
||||
[(regexp-match "[.]xpm$" f) 'xpm]
|
||||
[(regexp-match "[.]jpe?g$" f) 'jpeg]
|
||||
[(regexp-match "[.]png$" f) 'png]
|
||||
[else (error 'save-file "unknown suffix: ~e" f)])])
|
||||
(set! save-filename f)
|
||||
(set! save-file-format format)
|
||||
(send canvas refresh))))))
|
||||
(make-object choice% #f '("1" "*2" "/2" "1,*2" "*2,1") hp
|
||||
(lambda (self event)
|
||||
(send canvas set-scale
|
||||
|
@ -1246,22 +1282,6 @@
|
|||
(make-object check-box% "Kern" hp2.5
|
||||
(lambda (self event)
|
||||
(send canvas set-kern (send self get-value))))
|
||||
(make-object button% "Save" hp0
|
||||
(lambda (b e)
|
||||
(unless use-bitmap?
|
||||
(error 'save-file "only available for pixmap/bitmap mode"))
|
||||
(let ([f (put-file)])
|
||||
(when f
|
||||
(let ([format
|
||||
(cond
|
||||
[(regexp-match "[.]xbm$" f) 'xbm]
|
||||
[(regexp-match "[.]xpm$" f) 'xpm]
|
||||
[(regexp-match "[.]jpe?g$" f) 'jpeg]
|
||||
[(regexp-match "[.]png$" f) 'png]
|
||||
[else (error 'save-file "unknown suffix: ~e" f)])])
|
||||
(set! save-filename f)
|
||||
(set! save-file-format format)
|
||||
(send canvas refresh))))))
|
||||
(make-object choice% "Clip"
|
||||
'("None" "Rectangle" "Rectangle2" "Octagon"
|
||||
"Circle" "Wedge" "Round Rectangle" "Lambda"
|
||||
|
|
|
@ -95,8 +95,8 @@ backward-compatibile. Methods like `get-translation',
|
|||
`set-translation', `scale', etc. help hide the reundancy.
|
||||
|
||||
|
||||
PostScript and PDF Drawing Contexts
|
||||
-----------------------------------
|
||||
PostScript, PDF, and SVG Drawing Contexts
|
||||
-----------------------------------------
|
||||
|
||||
The dimensions for PostScript output are no longer inferred from the
|
||||
drawing. Instead, the width and height must be supplied when the
|
||||
|
@ -105,6 +105,9 @@ drawing. Instead, the width and height must be supplied when the
|
|||
The new `pdf-dc%' drawing context is like `post-script-dc%', but it
|
||||
generates PDF output.
|
||||
|
||||
The new `svg-dc%' drawing context is similar to `post-script-dc%',
|
||||
but it generates SVG output.
|
||||
|
||||
|
||||
Other Drawing-Context Changes
|
||||
-----------------------------
|
||||
|
|
Loading…
Reference in New Issue
Block a user