trivial write achieved

main
Matthew Butterick 7 years ago
parent 8e36831521
commit ebf0fcca0e

@ -6,16 +6,14 @@
;(require "page.rkt") ;(require "page.rkt")
(define PDFDocument (define PDFDocument
(class pdf-dc% (class object% ; actually is an instance of readable.Stream, which is an input port
(init-field [options (hasheq)]) (init-field [options (hasheq)])
(let ([output-file (hash-ref options 'out "outrkt.pdf")]) (let ([output-file (hash-ref options 'out "outrkt.pdf")])
(super-new [interactive #f] (super-new))
[parent #f]
[use-paper-bbox #f] ; list of byte chunks to push onto
[as-eps #f] ; simulates interface of stream.readable
[width #f] (field [byte-strings empty])
[height #f]
[output (open-output-file output-file #:exists 'replace)]))
;; PDF version ;; PDF version
(field [version 1.3]) (field [version 1.3])
@ -58,13 +56,15 @@
(when (hash-ref options 'info #f) (when (hash-ref options 'info #f)
(for ([(key val) (in-hash (hash-ref options 'info))]) (for ([(key val) (in-hash (hash-ref options 'info))])
(hash-set! info key val))) (hash-set! info key val)))
;; Write the header ;; Write the header
;; PDF version ;; PDF version
(_write (format "%PDF-~a" 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 ;; Add the first page
#;(unless (not (hash-ref options 'autoFirstPage #t)) #;(unless (not (hash-ref options 'autoFirstPage #t))
@ -123,20 +123,33 @@
(set! _waiting (add1 _waiting)) (set! _waiting (add1 _waiting))
ref ref
42) 42)
(define/public (_write . xs)
42) ; temp
(define (end-doc) 'done) ; tempo (define/public (push chunk)
(override end-doc) (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 _info #f)
(define/public (end) (define/public (end)
(flushPages) (flushPages)
(end-doc)))) ; temp 'done))) ; temp
(define doc (new PDFDocument))
(define doc (make-object PDFDocument (hasheq 'out "testrkt0.pdf")))
(module+ test (module+ test
(require rackunit) (require rackunit)
(send doc _write "foobar")
(send doc pipe (open-output-file "testrkt0.pdf" #:exists 'replace))
(check-equal? (send doc end) 'done)) (check-equal? (send doc end) 'done))

@ -1,14 +1,15 @@
#lang at-exp br #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 (define PDFObject
(class object% (class object%
(super-new) (super-new)
(define (string-slice str length) (define (string-slice str length)
(if (negative? length) (substring str (if (negative? length)
(string-slice str (+ (string-length str) length)) (+ (string-length str) length)
(substring str length))) length)))
(define/public (pad str length) (define/public (pad str length)
(define newstr (string-append (string-join (make-list (add1 length) "") "0") str)) (define newstr (string-append (string-join (make-list (add1 length) "") "0") str))
@ -26,7 +27,8 @@
[v (in-list escaped-char-strings)]) [v (in-list escaped-char-strings)])
(values (string k) v))]) (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) (define (utf8->utf16 bytes)
(let-values ([(bs bslen bsresult) (let-values ([(bs bslen bsresult)
(bytes-convert (bytes-open-converter "platform-UTF-8" "platform-UTF-16") bytes)]) (bytes-convert (bytes-open-converter "platform-UTF-8" "platform-UTF-16") bytes)])
@ -35,12 +37,12 @@
(define/public (swapBytes buff) (define/public (swapBytes buff)
(define bufflen (bytes-length buff)) (define bufflen (bytes-length buff))
(when (odd? bufflen) (when (odd? bufflen)
(raise-argument-error 'swapBytes "even number of bytes" (bytes-length buff))) (raise-argument-error 'swapBytes "even number of bytes" bufflen))
(define newbuff (make-bytes bufflen)) (for/fold ([newbuff (make-bytes bufflen)])
(for ([bidx (in-range 0 bufflen 2)]) ([bidx (in-range bufflen)] #:when (even? bidx))
(bytes-set! newbuff bidx (bytes-ref buff (add1 bidx))) (bytes-set! newbuff bidx (bytes-ref buff (add1 bidx)))
(bytes-set! newbuff (add1 bidx) (bytes-ref buff bidx))) (bytes-set! newbuff (add1 bidx) (bytes-ref buff bidx))
newbuff) newbuff))
(define/public (number n) (define/public (number n)
(unless (< -1e21 n 1e21) (unless (< -1e21 n 1e21)
@ -56,29 +58,28 @@
;; String objects are converted to PDF strings (UTF-16) ;; String objects are converted to PDF strings (UTF-16)
[(String? x) [(String? x)
;; Escape characters as required by the spec ;; Escape characters as required by the spec
(define string (regexp-replace* escapableRe (String-string x) (define string (regexp-replace* escapableRe (String-string x) (λ (c) (hash-ref escapable c))))
(λ (c) (hash-ref escapable c)))) ;; Detect if this is a unicode string (= contains non-ascii chars)
;; Detect if this is a unicode string (define contains-non-ascii? (for/or ([c (in-string string)])
(define isUnicode (for/or ([c (in-string string)]) (char>? c (integer->char 127))))
(char>? c (integer->char #x7f))))
;; If so, encode it as big endian UTF-16 ;; If so, encode it as big endian UTF-16
(string-append "(" (if isUnicode (format "(~a)" (if contains-non-ascii?
(bytes->string/latin-1 (swapBytes (utf8->utf16 (string->bytes/utf-8 (string-append "\ufeff" string))))) (bytes->string/latin-1 (swapBytes (utf8->utf16 (string->bytes/utf-8 (string-append "\ufeff" string)))))
string) ")")] string))]
;; Buffers are converted to PDF hex strings ;; Buffers (= byte strings) are converted to PDF hex strings
[(bytes? x) (string-append "<" (string-append* [(bytes? x) (format "<~a>" (string-append*
(for/list ([b (in-bytes x)]) (for/list ([b (in-bytes x)])
(number->string b 16))) ">")] (number->string b 16))))]
[(is-a? x PDFReference) (send x toString)] [(is-a? x PDFReference) (send x toString)]
[(date? x) (string-append "(D:" (date->string x "~Y~m~d~H~M~S") "Z)")] [(date? x) (format "(D:~aZ)" (date->string x "~Y~m~d~H~M~S"))]
[(list? x) (string-append "[" (string-join (map loop x) " ") "]")] [(list? x) (format "[~a]" (string-join (map loop x) " "))]
[(hash? x) (string-join (append (list "<<") [(hash? x) (string-join (append (list "<<")
(for/list ([(k v) (in-hash x)]) (for/list ([(k v) (in-hash x)])
(format "~a ~a" (loop k) (loop v))) (format "~a ~a" (loop k) (loop v)))
(list ">>")) (list ">>"))
(string #\newline))] (string #\newline))]
[(number? x) (~a (number x))] [(number? x) (format "~a" (number x))]
[else (~a x)]))))) [else (format "~a" x)])))))
(module+ test (module+ test

@ -0,0 +1,3 @@
%PDF-1.3
%ÿÿÿÿ
foobar

Binary file not shown.

@ -2,7 +2,8 @@
(require pitfall/kit/document) (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) (send doc end)
#| #|

Loading…
Cancel
Save