From 2410f6398e0797824eecf382ca967acd0782b148 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 21 Dec 2018 08:46:31 -0800 Subject: [PATCH] terser --- pitfall/pitfall/document.rkt | 105 ++++++++++++++++------------------- 1 file changed, 49 insertions(+), 56 deletions(-) diff --git a/pitfall/pitfall/document.rkt b/pitfall/pitfall/document.rkt index dca71eff..4b73c038 100644 --- a/pitfall/pitfall/document.rkt +++ b/pitfall/pitfall/document.rkt @@ -1,17 +1,15 @@ -#lang debug at-exp racket/base +#lang debug racket/base (require "param.rkt" "struct.rkt" racket/class racket/format - racket/contract racket/generator racket/match racket/list sugar/unstable/class sugar/unstable/js sugar/unstable/dict - sugar/unstable/port "reference.rkt" "object.rkt" "page.rkt" @@ -25,34 +23,28 @@ (define mixed% (annotation-mixin (image-mixin (text-mixin (fonts-mixin (color-mixin (vector-mixin object%))))))) -(define-subclass mixed% (PDFDocument [options (mhash)]) - (current-compress-streams? (hash-ref options 'compress #t)) - (current-auto-first-page (hash-ref options 'autoFirstPage #t)) - (current-doc-offset 0) - - (field [_pageBuffer null] - [_offsets (mhasheqv)] ; The PDF object store - [_ended #f] +(define-subclass mixed% (PDFDocument [options (mhash)]) + (field [@pageBuffer null] + [@offsets (mhasheqv)] ; The PDF object store + [ref-gen (generator () (let loop ([refid 1]) - (hash-set! _offsets refid 'missing-ref-offset) + (hash-set! @offsets refid 'missing-ref-offset) (yield refid) (loop (add1 refid))))] - [_root (ref (mhasheq 'Type "Catalog" - 'Pages (ref (mhasheq 'Type "Pages" - 'Count 0 - 'Kids empty))))] ; top object - [page #f] ; The current page - [x 0] - [y 0] - [info (mhash - 'Producer "PITKIT" - 'Creator "PITKIT" - 'CreationDate (seconds->date (if (test-mode) - 0 - (current-seconds)) #f))] ; Initialize the metadata - ) ; for `pipe` - + [(@root _root) (ref (mhasheq 'Type "Catalog" + 'Pages (ref (mhasheq 'Type "Pages" + 'Count 0 + 'Kids empty))))] ; top object + [(@page page) #f] ; The current page + [(@x x) 0] + [(@y y) 0] + [(@info info) (mhasheq + 'Producer "PITKIT" + 'Creator "PITKIT" + 'CreationDate (seconds->date (if (test-mode) + 0 + (current-seconds)) #f))]) ; Initialize the metadata ;; Initialize mixins (· this initColor) @@ -62,15 +54,18 @@ (· this initText) (· this initImages) + ;; initialize params + (current-compress-streams? (hash-ref options 'compress #t)) + (current-auto-first-page (hash-ref options 'autoFirstPage #t)) + (current-doc-offset 0) + (define/public (ref [payload (mhash)]) (make-object PDFReference this (ref-gen) payload)) (define/public (write x) - (define bstr (if (not (bytes? x)) - (string->bytes/latin-1 (string-append x "\n")) - x)) + (define bstr (if (bytes? x) x (string->bytes/latin-1 (string-append x "\n")))) (write-bytes bstr) - (current-doc-offset (+ (current-doc-offset) (bytes-length bstr)))) + (current-doc-offset (file-position (current-output-port)))) (define/public (addPage [options-arg options]) ;; end the current page if needed @@ -78,53 +73,55 @@ (flushPages)) ;; create a page object - (set! page (make-object PDFPage this options-arg)) - (set! _pageBuffer (cons page _pageBuffer)) + (set! @page (make-object PDFPage this options-arg)) + (set! @pageBuffer (cons @page @pageBuffer)) ;; in Kids, store page dictionaries in correct order ;; this determines order in document - (define pages (· _root payload Pages payload)) - (hash-update! pages 'Kids (λ (val) (append val (list (· page dictionary))))) + (define pages (· @root payload Pages payload)) + (hash-update! pages 'Kids (λ (val) (append val (list (· @page dictionary))))) (hash-set! pages 'Count (length (hash-ref pages 'Kids))) ;; reset x and y coordinates - (set! x (· page margins left)) - (set! y (· page margins top)) + (set! @x (· @page margins left)) + (set! @y (· @page margins top)) ;; flip PDF coordinate system so that the origin is in ;; the top left rather than the bottom left (set-field! _ctm this default-ctm-value) - (send this transform 1 0 0 -1 0 (· this page height)) + (send this transform 1 0 0 -1 0 (· @page height)) this) (define/public (flushPages) - (for-each (λ (p) (· p end)) _pageBuffer) - (set! _pageBuffer empty)) + (for-each (λ (p) (· p end)) @pageBuffer) + (set! @pageBuffer empty)) (define/public (addContent data) - (send page write data) + (send @page write data) this) (define/public (_refEnd aref) - (hash-set! _offsets (· aref id) (· aref offset))) + (hash-set! @offsets (· aref id) (· aref offset))) (define/public (end) ; called from source file to finish doc + ;; Write the header + (write (format "%PDF-~a" (current-pdf-version))) ; PDF version + (write (string-append "%" (list->string (map integer->char (make-list 4 #xFF))))) ; 4 binary chars, as recommended by the spec + (flushPages) (define _info (ref)) - (for ([(key val) (in-hash info)]) + (for ([(key val) (in-hash @info)]) ;; upgrade string literal to String struct (hash-set! (· _info payload) key (if (string? val) (String val) val))) - (· _info end) - + (for ([font (in-hash-values _fontFamilies)]) (· font finalize)) - - (· _root end) - (· _root payload Pages end) + (· @root end) + (· @root payload Pages end) (define xref-offset (current-doc-offset)) (match-define (list this-idxs this-offsets) - (match (sort (hash->list _offsets) < #:key car) ; sort by refid + (match (sort (hash->list @offsets) < #:key car) ; sort by refid [(list (cons idxs offsets) ...) (list idxs offsets)])) (write "xref") (write (format "0 ~a" (add1 (length this-offsets)))) @@ -137,12 +134,12 @@ (raise-argument-error 'document:end "numerical offsets" missing-offsets))) (for ([offset (in-list this-offsets)] [idx (in-list this-idxs)]) - (write @string-append{@(~r offset #:min-width 10 #:pad-string "0") 00000 n })) + (write (string-append (~r offset #:min-width 10 #:pad-string "0") " 00000 n "))) (write "trailer") (write (convert (mhash 'Size (add1 (length this-offsets)) - 'Root _root + 'Root @root 'Info _info))) (write "startxref") (write (number xref-offset)) @@ -150,11 +147,7 @@ ; if no 'info key, nothing will be copied from (hash) (for ([(key val) (in-hash (hash-ref options 'info (hash)))]) - (hash-set! info key val)) - - ;; Write the header - (write (format "%PDF-~a" (current-pdf-version))) ; PDF version - (write (string-append "%" (list->string (map integer->char (make-list 4 #xFF))))) ; 4 binary chars, as recommended by the spec + (hash-set! @info key val)) ;; Add the first page (when (current-auto-first-page) (addPage)))