From ebf0fcca0e024749eb2b3770cb8d7d742f19badb Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 11 May 2017 11:01:42 -0700 Subject: [PATCH] trivial write achieved --- pitfall/pitfall/kit/document.rkt | 47 +++++++++++++++--------- pitfall/pitfall/kit/foozm.pdf | 0 pitfall/pitfall/kit/object.rkt | 61 ++++++++++++++++--------------- pitfall/pitfall/kit/testrkt0.pdf | 3 ++ pitfall/pktest/outrkt.pdf | Bin 847 -> 0 bytes pitfall/pktest/testrkt0.pdf | 0 pitfall/pktest/testrkt0.rkt | 3 +- 7 files changed, 66 insertions(+), 48 deletions(-) delete mode 100644 pitfall/pitfall/kit/foozm.pdf delete mode 100644 pitfall/pktest/testrkt0.pdf diff --git a/pitfall/pitfall/kit/document.rkt b/pitfall/pitfall/kit/document.rkt index ccd2d9a3..e322e91f 100644 --- a/pitfall/pitfall/kit/document.rkt +++ b/pitfall/pitfall/kit/document.rkt @@ -6,16 +6,14 @@ ;(require "page.rkt") (define PDFDocument - (class pdf-dc% + (class object% ; actually is an instance of readable.Stream, which is an input port (init-field [options (hasheq)]) (let ([output-file (hash-ref options 'out "outrkt.pdf")]) - (super-new [interactive #f] - [parent #f] - [use-paper-bbox #f] - [as-eps #f] - [width #f] - [height #f] - [output (open-output-file output-file #:exists 'replace)])) + (super-new)) + + ; list of byte chunks to push onto + ; simulates interface of stream.readable + (field [byte-strings empty]) ;; PDF version (field [version 1.3]) @@ -58,13 +56,15 @@ (when (hash-ref options 'info #f) (for ([(key val) (in-hash (hash-ref options 'info))]) - (hash-set! info key val))) + (hash-set! info key val))) ;; Write the header ;; PDF version (_write (format "%PDF-~a" version)) - (_write (format "%~a~a~a~a" #xFF #xFF #xFF #xFF)) + ;; 4 binary chars, as recommended by the spec + (let ([c (integer->char #xFF)]) + (_write (string-append "%" (string c c c c)))) ;; Add the first page #;(unless (not (hash-ref options 'autoFirstPage #t)) @@ -123,20 +123,33 @@ (set! _waiting (add1 _waiting)) ref 42) - - (define/public (_write . xs) - 42) ; temp - (define (end-doc) 'done) ; tempo - (override end-doc) + (define/public (push chunk) + (set! byte-strings (cons chunk byte-strings))) + + (define/public (_write data) + (let ([data (if (not (bytes? data)) + ; `string->bytes/latin-1` is equivalent to plain binary encoding + (string->bytes/latin-1 (string-append data "\n")) + data)]) + (push data) + (report byte-strings) + (set! _offset (+ _offset (bytes-length data))))) + + (define/public (pipe op) + (copy-port (open-input-bytes (apply bytes-append (reverse byte-strings))) op) + (close-output-port op)) (define _info #f) (define/public (end) (flushPages) - (end-doc)))) ; temp + 'done))) ; temp + +(define doc (new PDFDocument)) -(define doc (make-object PDFDocument (hasheq 'out "testrkt0.pdf"))) (module+ test (require rackunit) + (send doc _write "foobar") + (send doc pipe (open-output-file "testrkt0.pdf" #:exists 'replace)) (check-equal? (send doc end) 'done)) \ No newline at end of file diff --git a/pitfall/pitfall/kit/foozm.pdf b/pitfall/pitfall/kit/foozm.pdf deleted file mode 100644 index e69de29b..00000000 diff --git a/pitfall/pitfall/kit/object.rkt b/pitfall/pitfall/kit/object.rkt index d5bcdb7c..a48f7669 100644 --- a/pitfall/pitfall/kit/object.rkt +++ b/pitfall/pitfall/kit/object.rkt @@ -1,14 +1,15 @@ #lang at-exp br -(require "struct.rkt" "reference.rkt" srfi/19) +(require racket/class racket/string racket/list srfi/19) +(require "struct.rkt" "reference.rkt") (define PDFObject (class object% (super-new) (define (string-slice str length) - (if (negative? length) - (string-slice str (+ (string-length str) length)) - (substring str length))) + (substring str (if (negative? length) + (+ (string-length str) length) + length))) (define/public (pad str length) (define newstr (string-append (string-join (make-list (add1 length) "") "0") str)) @@ -26,7 +27,8 @@ [v (in-list escaped-char-strings)]) (values (string k) v))]) - ; Convert little endian UTF-16 to big endian + ;; Convert little endian UTF-16 to big endian + ;; endianness of `bytes-open-converter` is relative to platform, so little endian on all x86 (define (utf8->utf16 bytes) (let-values ([(bs bslen bsresult) (bytes-convert (bytes-open-converter "platform-UTF-8" "platform-UTF-16") bytes)]) @@ -35,12 +37,12 @@ (define/public (swapBytes buff) (define bufflen (bytes-length buff)) (when (odd? bufflen) - (raise-argument-error 'swapBytes "even number of bytes" (bytes-length buff))) - (define newbuff (make-bytes bufflen)) - (for ([bidx (in-range 0 bufflen 2)]) + (raise-argument-error 'swapBytes "even number of bytes" bufflen)) + (for/fold ([newbuff (make-bytes bufflen)]) + ([bidx (in-range bufflen)] #:when (even? bidx)) (bytes-set! newbuff bidx (bytes-ref buff (add1 bidx))) - (bytes-set! newbuff (add1 bidx) (bytes-ref buff bidx))) - newbuff) + (bytes-set! newbuff (add1 bidx) (bytes-ref buff bidx)) + newbuff)) (define/public (number n) (unless (< -1e21 n 1e21) @@ -56,29 +58,28 @@ ;; String objects are converted to PDF strings (UTF-16) [(String? x) ;; Escape characters as required by the spec - (define string (regexp-replace* escapableRe (String-string x) - (λ (c) (hash-ref escapable c)))) - ;; Detect if this is a unicode string - (define isUnicode (for/or ([c (in-string string)]) - (char>? c (integer->char #x7f)))) + (define string (regexp-replace* escapableRe (String-string x) (λ (c) (hash-ref escapable c)))) + ;; Detect if this is a unicode string (= contains non-ascii chars) + (define contains-non-ascii? (for/or ([c (in-string string)]) + (char>? c (integer->char 127)))) ;; If so, encode it as big endian UTF-16 - (string-append "(" (if isUnicode - (bytes->string/latin-1 (swapBytes (utf8->utf16 (string->bytes/utf-8 (string-append "\ufeff" string))))) - string) ")")] - ;; Buffers are converted to PDF hex strings - [(bytes? x) (string-append "<" (string-append* - (for/list ([b (in-bytes x)]) - (number->string b 16))) ">")] + (format "(~a)" (if contains-non-ascii? + (bytes->string/latin-1 (swapBytes (utf8->utf16 (string->bytes/utf-8 (string-append "\ufeff" string))))) + string))] + ;; Buffers (= byte strings) are converted to PDF hex strings + [(bytes? x) (format "<~a>" (string-append* + (for/list ([b (in-bytes x)]) + (number->string b 16))))] [(is-a? x PDFReference) (send x toString)] - [(date? x) (string-append "(D:" (date->string x "~Y~m~d~H~M~S") "Z)")] - [(list? x) (string-append "[" (string-join (map loop x) " ") "]")] + [(date? x) (format "(D:~aZ)" (date->string x "~Y~m~d~H~M~S"))] + [(list? x) (format "[~a]" (string-join (map loop x) " "))] [(hash? x) (string-join (append (list "<<") - (for/list ([(k v) (in-hash x)]) - (format "~a ~a" (loop k) (loop v))) - (list ">>")) - (string #\newline))] - [(number? x) (~a (number x))] - [else (~a x)]))))) + (for/list ([(k v) (in-hash x)]) + (format "~a ~a" (loop k) (loop v))) + (list ">>")) + (string #\newline))] + [(number? x) (format "~a" (number x))] + [else (format "~a" x)]))))) (module+ test diff --git a/pitfall/pitfall/kit/testrkt0.pdf b/pitfall/pitfall/kit/testrkt0.pdf index e69de29b..95eee17d 100644 --- a/pitfall/pitfall/kit/testrkt0.pdf +++ b/pitfall/pitfall/kit/testrkt0.pdf @@ -0,0 +1,3 @@ +%PDF-1.3 +%ÿÿÿÿ +foobar diff --git a/pitfall/pktest/outrkt.pdf b/pitfall/pktest/outrkt.pdf index 4c559b7e9e0904bec5364b5d574e7b28c79af272..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 100644 GIT binary patch literal 0 HcmV?d00001 literal 847 zcmb7CL2lbH5DaqUEB0a_K~PJSEu}4t9Aei&kQ6bL-ijVrX)UX8MS-LWC(p>aZ|E&= z=?8Mn3v%f$ZOej_OL?I*+#SyBus54b-^qR~dXLY4Uc>-G(BFTE(FlTTtO~b)Awj7C zfM8lK9U9t~%HaevoufEA6V@42KgH_z$&+|GJUDzf_$#o=H!yuMA+zvKJTl^A{)yV# zm}djVEeOGvyBZ;wsRF%#nKD>8kgcN6n3w8Yuiz^|AtW+_(+?4R^VMTrIV!inrq&KF zjBaWejrg3_hTo%G=$25UDqHhi+1(bt1ZNtrg8Rl)HNjtHhUvvQmymqMQ?$A<8Cqa# zX~z|7-VS!>%KEOWGPmS_ji;^lhK+Uzk`BR`2JW4V}H-g=)B1&!T;#n<#O5)uy!z3PAzq@=BAA7CYfE&%HUjt@Lq)Nf+UUy zG0b6$4HAlu7gQ}KBO1mY7RuL{4C!6%)yW}^Y7ZN}!57D!UT0LfMC0H6ZF!F*+2^UX e12(>XK9|*80|()gwN4r59VTHSdc99KQ}GX%6WWOY diff --git a/pitfall/pktest/testrkt0.pdf b/pitfall/pktest/testrkt0.pdf deleted file mode 100644 index e69de29b..00000000 diff --git a/pitfall/pktest/testrkt0.rkt b/pitfall/pktest/testrkt0.rkt index 30f060a4..1bdd8054 100644 --- a/pitfall/pktest/testrkt0.rkt +++ b/pitfall/pktest/testrkt0.rkt @@ -2,7 +2,8 @@ (require pitfall/kit/document) -(define doc (new PDFDocument [options (hasheq 'out "testrkt0.pdf")])) +(define doc (new PDFDocument)) +(send doc pipe (open-output-file "testrkt0.pdf" #:exists 'replace)) (send doc end) #|