syndicate-lang
/
racket-matrix-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Support png display in vm-pictures.rkt

This commit is contained in:
Tony Garnock-Jones 2012-08-26 17:17:42 -04:00
parent be0878759f
commit 92ee3303c2
1 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
vm-pictures.rkt
View File

@ -80,16 +80,18 @@
(define (local-leg p) (define (local-leg p)
(leg p 0 (default-leg-height))) (leg p 0 (default-leg-height)))
(define (render p #:target [target 'eps]) (define (render p #:target [target (string->symbol (or (getenv "VM_PICTURES_TARGET") "eps"))])
(define final-pict (cc-superimpose (blank (+ (pict-width p) (* 2 (final-border)))
(+ (pict-height p) (* 2 (final-border))))
(panorama p)))
(case target (case target
[(screen) [(screen)
;; FFS. This connects to the display even if you don't use it. ;; FFS. This connects to the display even if you don't use it.
;; (local-require racket/gui/base) ;; (local-require racket/gui/base)
;; (show-pict (panorama p) 800 600) ;; (show-pict final-pict 800 600)
(log-error "You need to uncomment a couple of lines in vm-pictures.rkt") (log-error "You need to uncomment a couple of lines in vm-pictures.rkt")
(void)] (void)]
[(png)
(display (convert final-pict 'png-bytes))]
[(eps) [(eps)
(display (convert (cc-superimpose (blank (+ (pict-width p) (* 2 (final-border))) (display (convert final-pict 'eps-bytes))]))
(+ (pict-height p) (* 2 (final-border))))
(panorama p))
'eps-bytes))]))