main
Matthew Butterick 7 years ago
parent f0223c2562
commit f563ea7ee5

@ -1,8 +1,7 @@
#lang pitfall/racket
(provide PDFDocument)
(require "reference.rkt" "struct.rkt" "object.rkt" "page.rkt" "helper.rkt" "params.rkt")
(require "vector.rkt" "color.rkt")
(require "reference.rkt" "object.rkt" "page.rkt" "vector.rkt" "color.rkt")
(define PDFDocument
;; actually is an instance of readable.Stream, which is an input port
@ -205,7 +204,7 @@
;; trailer
(@_write "trailer")
;; todo: make `PDFObject:convert` a static method
(@_write (send (make-object PDFObject) convert
(@_write (convert
(mhash 'Size (add1 (length @_offsets))
'Root @_root
'Info @_info)))

@ -1,112 +1,118 @@
#lang pitfall/racket
(require srfi/19)
(provide PDFObject)
(provide PDFObject convert)
(define PDFObject
(class object%
(super-new)
(define (string-slice 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))
(string-slice newstr (- length)))
(define escaped-chars '(#\newline #\return #\tab #\backspace #\page #\( #\) #\\))
(define escaped-char-strings '("\\n" "\\r" "\\t" "\\b" "\\f" "\\(" "\\)" "\\\\"))
;; note: unlike nodejs, escapableRe does not have `g` option built in
;; so use it with regexp-replace* not regexp-replace
(field [escapableRe
(regexp (format "[~a]" (regexp-quote (list->string escaped-chars))))])
(field [escapable (for/hash ([k (in-list escaped-chars)]
[v (in-list escaped-char-strings)])
(values (string k) v))])
;; 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)])
bs))
(super-new)))
;; moved `number` to helper module
(define escaped-chars '(#\newline #\return #\tab #\backspace #\page #\( #\) #\\))
(define escaped-char-strings '("\\n" "\\r" "\\t" "\\b" "\\f" "\\(" "\\)" "\\\\"))
;; note: unlike nodejs, escapableRe does not have `g` option built in
;; so use it with regexp-replace* not regexp-replace
(define escapableRe (regexp (format "[~a]" (regexp-quote (list->string escaped-chars)))))
(define escapable (for/hash ([k (in-list escaped-chars)]
[v (in-list escaped-char-strings)])
(values (string k) v)))
(define/contract (string-slice str length)
(string? integer? . -> . string?)
(substring str (if (negative? length)
(+ (string-length str) length)
length)))
(define/contract (pad str length)
(string? integer? . -> . string?)
(define newstr (string-append (string-join (make-list (add1 length) "") "0") str))
(string-slice newstr (- length)))
;; Convert little endian UTF-16 to big endian
;; endianness of `bytes-open-converter` is relative to platform, so little endian on all x86
(define/contract (utf8->utf16 bytes)
(bytes? . -> . bytes?)
(define-values (bs bslen bsresult)
(bytes-convert (bytes-open-converter "platform-UTF-8" "platform-UTF-16") bytes))
bs)
(define/contract (swapBytes buff)
(bytes? . -> . bytes?)
(define bufflen (bytes-length buff))
(when (odd? bufflen)
(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))
(define/contract (convert object)
(any/c . -> . string?)
(let loop ([x object])
(cond
;; String literals are converted to the PDF name type
[(string? x) (string-append "/" x)]
;; symbols are used for convenience - convert to string
[(symbol? x) (loop (symbol->string x))]
;; String objects (structs) 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 (= 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
(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))))]
[(object? x) (send x toString)]
[(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) (format "~a" (number x))]
[else (format "~a" x)])))
(define/public (swapBytes buff)
(define bufflen (bytes-length buff))
(when (odd? bufflen)
(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))
;; moved this to helper module
#;(define/public (number n) ···)
(define/public (convert object)
(let loop ([x object])
(cond
;; String literals are converted to the PDF name type
[(string? x) (string-append "/" x)]
;; symbols are used for convenience - convert to string
[(symbol? x) (loop (symbol->string x))]
;; String objects (structs) 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 (= 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
(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))))]
[(object? x) (send x toString)]
[(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) (format "~a" (number x))]
[else (format "~a" x)])))))
(module+ test
(require rackunit )
(define o (new PDFObject))
(check-equal? (send o pad "foobar" -1) "oobar")
(check-equal? (send o pad "foobar" 0) "foobar")
(check-equal? (send o pad "foobar" 3) "bar")
(check-equal? (send o pad "foobar" 6) "foobar")
(check-equal? (send o pad "foobar" 10) "0000foobar")
(check-equal? (regexp-replace* (get-field escapableRe o) "foo\nba\nr" "x") "fooxbaxr")
(check-equal? (regexp-replace* (get-field escapableRe o) "foo\fba\tr" "x") "fooxbaxr")
(check-equal? (pad "foobar" -1) "oobar")
(check-equal? (pad "foobar" 0) "foobar")
(check-equal? (pad "foobar" 3) "bar")
(check-equal? (pad "foobar" 6) "foobar")
(check-equal? (pad "foobar" 10) "0000foobar")
(check-equal? (regexp-replace* escapableRe "foo\nba\nr" "x") "fooxbaxr")
(check-equal? (regexp-replace* escapableRe "foo\fba\tr" "x") "fooxbaxr")
(check-equal? (regexp-replace* (get-field escapableRe o) "foo\nba\tr" (λ (c) (hash-ref (get-field escapable o) c))) "foo\\nba\\tr")
(check-equal? (send o swapBytes #"foobar") #"ofbora")
(check-equal? (send o convert "foobar") "/foobar")
(check-equal? (send o convert (String "foobar")) "(foobar)")
(check-equal? (send o convert (String "öéÿ")) "(þÿ\u0000ö\u0000é\u0000ÿ)")
(check-equal? (send o convert (String "fôobár")) "(þÿ\u0000f\u0000ô\u0000o\u0000b\u0000á\u0000r)")
(check-equal? (send o convert #"foobar") "<666f6f626172>")
#;(check-equal? (send o convert (make-object PDFReference "foobar" 42)) "42 0 R")
(check-equal? (send o convert (seconds->date (quotient 1494483337320 1000) #f)) "(D:20170511061537Z)")
(check-equal? (send o convert (list "foobar" (String "öéÿ") #"foobar")) "[/foobar (þÿ\u0000ö\u0000é\u0000ÿ) <666f6f626172>]")
(check-equal? (send o convert (hash "foo" 42 "bar" "fly")) "<<\n/foo 42\n/bar /fly\n>>")
(check-equal? (send o convert 1234.56789) "1234.56789"))
(check-equal? (regexp-replace* escapableRe "foo\nba\tr" (λ (c) (hash-ref escapable c))) "foo\\nba\\tr")
(check-equal? (swapBytes #"foobar") #"ofbora")
(check-equal? (convert "foobar") "/foobar")
(check-equal? (convert (String "foobar")) "(foobar)")
(check-equal? (convert (String "öéÿ")) "(þÿ\u0000ö\u0000é\u0000ÿ)")
(check-equal? (convert (String "fôobár")) "(þÿ\u0000f\u0000ô\u0000o\u0000b\u0000á\u0000r)")
(check-equal? (convert #"foobar") "<666f6f626172>")
#;(check-equal? (convert (make-object PDFReference "foobar" 42)) "42 0 R")
(check-equal? (convert (seconds->date (quotient 1494483337320 1000) #f)) "(D:20170511061537Z)")
(check-equal? (convert (list "foobar" (String "öéÿ") #"foobar")) "[/foobar (þÿ\u0000ö\u0000é\u0000ÿ) <666f6f626172>]")
(check-equal? (convert (hash "foo" 42 "bar" "fly")) "<<\n/foo 42\n/bar /fly\n>>")
(check-equal? (convert 1234.56789) "1234.56789"))

@ -0,0 +1,4 @@
#lang racket/base
(provide (all-defined-out))
(define test-mode (make-parameter #f))
(define compression-enabled (make-parameter #f))

@ -1,3 +0,0 @@
#lang racket/base
(provide (all-defined-out))
(define test-mode (make-parameter #f))

@ -4,10 +4,11 @@
(define-syntax-rule (r+p id ...) (begin (require id ...) (provide (all-from-out id ...))))
(r+p "helper.rkt"
"params.rkt"
"param.rkt"
"struct.rkt"
sugar/debug
racket/class
racket/file
racket/match
racket/string
racket/format
@ -17,7 +18,7 @@
racket/function)
(module reader syntax/module-reader
#:language "racket.rkt"
#:language 'pitfall/racket
#:read read
#:read-syntax read-syntax
(require (prefix-in @- scribble/reader)))

@ -8,8 +8,7 @@
(init-field document id [data (mhash)])
(field [gen 0]
[deflate #f]
;; #f is debug value below
[compress (and #f
[compress (and (compression-enabled)
(· document compress)
(not (hash-ref data 'Filter #f)))]
[uncompressedLength 0]
@ -58,7 +57,7 @@
(set-field! offset this (· this document _offset))
(send (· this document) _write (format "~a ~a obj" (· this id) (· this gen)))
(send (· this document) _write (send (new PDFObject) convert (· this data)))
(send (· this document) _write (convert (· this data)))
(when (positive? (length (· this chunks)))
(send (· this document) _write "stream")

@ -1,5 +1,5 @@
#lang racket
(require pitfall/document pitfall/params rackunit)
#lang pitfall/racket
(require pitfall/document rackunit)
(test-mode #t)
(check-true

@ -1,6 +1,6 @@
#lang racket
#lang pitfall/racket
(require pitfall/document pitfall/helper pitfall/params rackunit)
(require pitfall/document rackunit)
(require racket/runtime-path)
(define-runtime-path this "test1rkt.pdf")

Loading…
Cancel
Save