diff --git a/pitfall/pitfall/minimal-pdf-source.rkt b/pitfall/pitfall/minimal-pdf-source.rkt index 869c7812..5d0a18eb 100644 --- a/pitfall/pitfall/minimal-pdf-source.rkt +++ b/pitfall/pitfall/minimal-pdf-source.rkt @@ -45,4 +45,5 @@ 0 (co-stream (co-dict '#hasheq((Length . 55))) - #" BT\n /F1 18 Tf\n 0 0 Td\n (Hello World) Tj\n ET")) \ No newline at end of file + #" BT\n /F1 18 Tf\n 0 0 Td\n (Hello World) Tj\n ET")) +(co-trailer (co-dict (hasheq 'Size 5 'Root (co-io-ref 1 0)))) \ No newline at end of file diff --git a/pitfall/pitfall/parser.rkt b/pitfall/pitfall/parser.rkt index bf019b21..375d0ba8 100644 --- a/pitfall/pitfall/parser.rkt +++ b/pitfall/pitfall/parser.rkt @@ -1,6 +1,6 @@ #lang brag -pf-program : pf-header pf-body pf-trailer +pf-program : pf-header pf-body pf-trailer pf-header : PDF-HEADER @pf-body : pf-object* @pf-object : pf-null | CHAR | BOOLEAN | INT | REAL | pf-name | pf-string | pf-array | pf-dict | pf-stream | pf-indirect-object | pf-indirect-object-ref | pf-comment diff --git a/pitfall/pitfall/render.rkt b/pitfall/pitfall/render.rkt index efc84cfe..87794952 100644 --- a/pitfall/pitfall/render.rkt +++ b/pitfall/pitfall/render.rkt @@ -1,6 +1,6 @@ #lang at-exp racket/base (require (for-syntax racket/base) - racket/string pitfall/struct br/define) + racket/string pitfall/struct br/define racket/bytes sugar/debug racket/format) (provide (all-defined-out) (all-from-out pitfall/struct) (except-out (all-from-out racket/base) #%module-begin)) @@ -9,47 +9,76 @@ #'(#%module-begin (render-args . ARGS))) (provide (rename-out [mb #%module-begin])) -(define (render-args . args) - (display - (string-append +(define (make-xref-table locs) + (string->bytes/latin-1 @string-append{ + xref + 0 @(number->string (length locs)) + 0000000000 65535 f + @(let ([sep " 00000 n\n"]) (string-join - (map cosexpr->string (append args (list "%%EOF"))) - "\n\n")))) + (for/list ([loc (in-list (cdr (sort locs < #:key car)))]) + (~r #:min-width 10 #:pad-string "0" (cdr loc))) sep #:after-last sep)) + })) + + +(define (render-args . args) + (define-values (bstrs offset locs) + (for/fold ([cobstrs null] + [offset 0] + [io-locs '((0 . 0))]) + ([cosexpr (in-list args)]) + (define cobstr (cosexpr->bytes cosexpr)) + (values + (cons cobstr cobstrs) + (+ offset (bytes-length cobstr)) + (if (co-io? cosexpr) + (cons (cons (co-io-idx cosexpr) offset) io-locs) + io-locs)))) + (define trailer-str (car bstrs)) + (define other-strs (cdr bstrs)) + (define result (apply bytes-append `(,@(reverse other-strs) ,(make-xref-table locs) ,trailer-str #"\n%%EOF"))) + (display result) + result) -(define (cosexpr->string x) - (let loop ([x x]) - (cond - [(co-version? x) - @string-append{%%PDF-@(number->string (co-version-num x))}] - [(co-header? x) (loop (co-header-string x))] - [(co-array? x) - @string-append{[ @(string-join (map loop (co-array-items x)) " ") ]}] - [(co-io? x) - @string-append{ - @(loop (co-io-idx x)) @(loop (co-io-rev x)) obj - @(loop (co-io-thing x)) - endobj}] - [(co-dict? x) - @string-append{ - << - @(string-join - (for/list ([(k v) (in-hash (co-dict-dict x))]) - @string-append{@(loop k) @(loop v)}) "\n") - >>}] - [(co-io-ref? x) - @string-append{@(loop (co-io-ref-idx x)) @(loop (co-io-ref-rev x)) R}] - [(co-stream? x) - @string-append{ - @(loop (co-stream-dict x)) - stream - @(loop (co-stream-data x)) - endstream}] - #;[(co-comment? x) (co-comment-text x)] - [(co-trailer? x) @string-append{ - trailer - @(loop (co-trailer-dict x)) - }] - [(symbol? x) @string-append{/@(symbol->string x)}] - [(number? x) @number->string{@x}] - [(string? x) (bytes->string/utf-8 (string->bytes/latin-1 x))] - [else (format "~a" x)]))) \ No newline at end of file +(define (cosexpr->bytes x) + (bytes-append + (string->bytes/latin-1 + (let loop ([x x]) + (cond + [(co-version? x) + @string-append{%%PDF-@(number->string (co-version-num x))}] + [(co-header? x) (loop (co-header-string x))] + [(co-array? x) + @string-append{[ @(string-join (map loop (co-array-items x)) " ") ]}] + [(co-io? x) + @string-append{ + @(loop (co-io-idx x)) @(loop (co-io-rev x)) obj + @(loop (co-io-thing x)) + endobj + + }] + [(co-dict? x) + @string-append{ + << + @(string-join + (for/list ([(k v) (in-hash (co-dict-dict x))]) + @string-append{@(loop k) @(loop v)}) "\n") + >>}] + [(co-io-ref? x) + @string-append{@(loop (co-io-ref-idx x)) @(loop (co-io-ref-rev x)) R}] + [(co-stream? x) + @string-append{ + @(loop (co-stream-dict x)) + stream + @(loop (co-stream-data x)) + endstream + }] + #;[(co-comment? x) (co-comment-text x)] + [(co-trailer? x) @string-append{ + trailer + @(loop (co-trailer-dict x)) + }] + [(symbol? x) @string-append{/@(symbol->string x)}] + [(number? x) @number->string{@x}] + [(string? x) x] + [else (format "~a" x)]))) #"\n")) \ No newline at end of file