From b810c34ba4be961db8204658636ffdf1c9874e18 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 14 Mar 2015 21:54:21 -0700 Subject: [PATCH] render-typed works, so does main-typed-sample --- quad/main-typed-sample.rkt | 4 +- quad/render-typed.rkt | 86 ++++++++++++++++++++++---------------- 2 files changed, 51 insertions(+), 39 deletions(-) diff --git a/quad/main-typed-sample.rkt b/quad/main-typed-sample.rkt index e7728b2c..5cbed3f0 100644 --- a/quad/main-typed-sample.rkt +++ b/quad/main-typed-sample.rkt @@ -1,11 +1,11 @@ #lang typed/racket/base (require "main-typed.rkt" "logger-typed.rkt" "world-typed.rkt" "samples-typed.rkt") -(require "render.rkt" racket/class profile) +(require "render-typed.rkt" racket/class profile) (activate-logger quad-logger) (parameterize ([world:quality-default world:draft-quality] [world:paper-width-default 600.0] [world:paper-height-default 700.0]) (define sample (ti5)) (define to (begin (time (typeset sample)))) - (time (send (new pdf-renderer%) render-to-file to "foo.pdf"))) \ No newline at end of file + (time (send (new pdf-renderer%) render-to-file to "foo-typed.pdf"))) \ No newline at end of file diff --git a/quad/render-typed.rkt b/quad/render-typed.rkt index 3fca71de..c39fb97f 100644 --- a/quad/render-typed.rkt +++ b/quad/render-typed.rkt @@ -2,14 +2,26 @@ (require typed/racket/class racket/file racket/list) (require/typed racket/draw [current-ps-setup (Parameterof (Instance (Class (init-field) - [set-margin (Number Number . -> . Void)] - [set-scaling (Number Number . -> . Void)])))] - [the-color-database Any] + [set-margin (Number Number . -> . Void)] + [set-scaling (Number Number . -> . Void)])))] + [the-color-database (Instance (Class + (find-color (String . -> . (Option (Instance (Class)))))))] [pdf-dc% (Class (init [interactive Boolean][use-paper-bbox Boolean][as-eps Boolean] - [output Output-Port] - [width Flonum][height Flonum]))] + [output Output-Port] + [width Flonum][height Flonum]) + (start-doc (String . -> . Void)) + (set-pen (String Real Symbol . -> . Void)) + (set-brush (String Symbol . -> . Void)) + (set-font ((Instance (Class)) . -> . Void)) + (set-text-foreground ((Instance (Class)) . -> . Void)) + (set-text-background ((Instance (Class)) . -> . Void)) + (set-text-mode (Symbol . -> . Void)) + (draw-text (String Flonum Flonum Boolean . -> . Void)) + (start-page (-> Void)) + (end-page (-> Void)) + (end-doc (-> Void)))] [make-font ((#:size Nonnegative-Flonum) (#:style Symbol) (#:weight Symbol) (#:face String) . -> . (Instance (Class (init-field))))]) -(require/typed sugar/cache [make-caching-proc (Procedure . -> . Procedure)]) +(require/typed sugar/cache [make-caching-proc ((String Nonnegative-Flonum Symbol Symbol -> (Instance (Class))) . -> . (String Nonnegative-Flonum Symbol Symbol -> (Instance (Class))))]) (require "utils-typed.rkt" "quads-typed.rkt" "world-typed.rkt") (define abstract-renderer% @@ -30,7 +42,7 @@ ((inst hash-update! Nonnegative-Integer (Listof Quad)) page-quad-hash (cast (quad-attr-ref q world:page-key) Nonnegative-Integer) (λ(v) ((inst cons Quad (Listof Quad)) q v)) (λ() (cast null (Listof Quad)))))) (map (λ([k : Nonnegative-Integer]) (render-page ((inst hash-ref Nonnegative-Integer (Listof Quad) (Listof Quad)) page-quad-hash k))) (sort (hash-keys page-quad-hash) <))))) - (: render-element (Quad . -> . Quad)) + (: render-element (Quad . -> . Any)) (define/public (render-element q) (cond [(word? q) (render-word q)] @@ -44,37 +56,35 @@ (define/public (render-page qs) (void)) ;; use in lieu of 'abstract' definition - (: render-word (Quad . -> . Quad)) + (: render-word (Quad . -> . Any)) (define/public (render-word x) (word)) (: finalize (Any . -> . Any)) (define/public (finalize x) x))) (define-syntax-rule (map/send method xs) - (map (λ(x) (method x)) xs)) + (map (λ([x : Quad]) (method x)) xs)) +;; this is outside class def'n because if inside, +;; (define dc ...) can't see it and type it correctly. +;; there may be a better way, but for now this is OK +(: dc-output-port Output-Port) +(define dc-output-port (open-output-bytes)) + +(provide pdf-renderer%) (define pdf-renderer% (class abstract-renderer% (super-new) (send* (current-ps-setup) (set-margin 0 0) (set-scaling 1.0 1.0)) - (: dc-output-port Output-Port) - (define dc-output-port (open-output-bytes)) - (define dc (new pdf-dc% [interactive #f][use-paper-bbox #f][as-eps #f] [output dc-output-port] [width (world:paper-width-default)][height (world:paper-height-default)])) - #| restart here with error: -Type Checker: missing type for identifier; - consider adding a type annotation with `:' - identifier: self160170 in: dc-output-port - -|# - #;(define/override (setup tx) + (define/override (setup tx) (send* dc (start-doc "boing") (set-pen "black" 1 'solid) @@ -83,44 +93,46 @@ Type Checker: missing type for identifier; (inherit render-element) - #;(define make-font/caching + (define make-font/caching (make-caching-proc (λ (font size style weight) (make-font #:face font #:size size #:style style #:weight weight)))) - #;(define/override (render-word w) - (define word-font (quad-attr-ref/parameter w world:font-name-key)) - (define word-size (quad-attr-ref/parameter w world:font-size-key)) - (define word-style (quad-attr-ref/parameter w world:font-style-key)) - (define word-weight (quad-attr-ref/parameter w world:font-weight-key)) - (define word-color (quad-attr-ref/parameter w world:font-color-key)) - (define word-background (quad-attr-ref/parameter w world:font-background-key)) + (define/override (render-word w) + (define word-font (cast (quad-attr-ref/parameter w world:font-name-key) String)) + (define word-size (cast (quad-attr-ref/parameter w world:font-size-key) Nonnegative-Flonum)) + (define word-style (cast (quad-attr-ref/parameter w world:font-style-key) Symbol)) + (define word-weight (cast (quad-attr-ref/parameter w world:font-weight-key) Symbol)) + (define word-color (cast (quad-attr-ref/parameter w world:font-color-key) String)) + (define word-background (cast (quad-attr-ref/parameter w world:font-background-key) String)) (send dc set-font (make-font/caching word-font word-size word-style word-weight)) - (send dc set-text-foreground (send the-color-database find-color word-color)) + (define foreground-color (send the-color-database find-color word-color)) + (when foreground-color + (send dc set-text-foreground foreground-color)) (define background-color (send the-color-database find-color word-background)) (if background-color ; all invalid color-string values will return #f (send* dc (set-text-mode 'solid) (set-text-background background-color)) (send dc set-text-mode 'transparent)) - #;(define word-text (quad-car w)) - #;(send dc draw-text word-text (quad-attr-ref w world:x-position-key) + (define word-text (cast (quad-car w) String)) + (send dc draw-text word-text (cast (quad-attr-ref w world:x-position-key) Flonum) ;; we want to align by baseline rather than top of box ;; thus, subtract ascent from y to put baseline at the y coordinate - (- (quad-attr-ref w world:y-position-key) (quad-attr-ref w world:ascent-key 0)) #t)) + (- (cast (quad-attr-ref w world:y-position-key) Flonum) (cast (quad-attr-ref w world:ascent-key 0) Flonum)) #t)) - #;(define/override (render-page elements) + (define/override (render-page elements) (send dc start-page) (map/send render-element (filter-not whitespace/nbsp? elements)) (send dc end-page)) - #;(define/override (finalize xs) + (define/override (finalize xs) (send dc end-doc) (get-output-bytes dc-output-port)) - #| (: render-to-file (Quad . -> . Path-String)) + (: render-to-file (Quad Path-String . -> . Void)) (define/public (render-to-file doc-quad path) (define result-bytes (send this render doc-quad)) (display-to-file result-bytes path #:exists 'replace #:mode 'binary)) - |# - - )) + + + ))