From ef571714476068081e93b94d1242cd728c0b9f80 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 29 Mar 2017 19:16:08 -0700 Subject: [PATCH] parse / render --- pitfall/pitfall/minimal-pdf-source.rkt | 22 ++++++++++ pitfall/pitfall/minimal-pdf.rkt | 46 ++++++++++++++++++++ pitfall/pitfall/minimal.pdf | 58 ++++++++++++++++++++++++++ pitfall/pitfall/parse.rkt | 52 ++++++++++++++--------- pitfall/pitfall/parser.rkt | 19 +++++---- pitfall/pitfall/render.rkt | 22 ++++++++++ pitfall/pitfall/struct.rkt | 3 ++ pitfall/pitfall/tokenizer.rkt | 9 ++-- 8 files changed, 198 insertions(+), 33 deletions(-) create mode 100644 pitfall/pitfall/minimal-pdf-source.rkt create mode 100644 pitfall/pitfall/minimal-pdf.rkt create mode 100644 pitfall/pitfall/minimal.pdf create mode 100644 pitfall/pitfall/render.rkt create mode 100644 pitfall/pitfall/struct.rkt diff --git a/pitfall/pitfall/minimal-pdf-source.rkt b/pitfall/pitfall/minimal-pdf-source.rkt new file mode 100644 index 00000000..4efdffe8 --- /dev/null +++ b/pitfall/pitfall/minimal-pdf-source.rkt @@ -0,0 +1,22 @@ +#lang racket/base +(require pitfall/struct pitfall/render) + +(define (io1) + (hasheq 'Pages "2 0 R" 'Type 'Catalog)) + +(define (io2) + (hasheq 'Count 1 'Kids '("3 0 R") 'Type 'Pages 'MediaBox '(0 0 300 144))) + +(define (io3) + (hasheq 'Resources + (hasheq 'Font + (hasheq 'F1 (hasheq 'Subtype 'Type1 'BaseFont 'Times-Roman + 'Type 'Font))) + 'Parent "2 0 R" + 'Contents "4 0 R" + 'Type 'Page)) + +(define (io4) + ($stream (hasheq 'Length 55) #" BT\n /F1 18 Tf\n 0 0 Td\n (Hello World) Tj\n ET")) + +(display (cosexpr->string (list io1 io2 io3 io4))) \ No newline at end of file diff --git a/pitfall/pitfall/minimal-pdf.rkt b/pitfall/pitfall/minimal-pdf.rkt new file mode 100644 index 00000000..e6e0080c --- /dev/null +++ b/pitfall/pitfall/minimal-pdf.rkt @@ -0,0 +1,46 @@ +#lang pitfall/parse +%PDF-1.1 +%¥±ë + +1 0 obj + << /Type /Catalog + /Pages 2 0 R + >> +endobj + +2 0 obj + << /Type /Pages + /Kids [3 0 R] + /Count 1 + /MediaBox [0 0 300 144] + >> +endobj + +3 0 obj + << /Type /Page + /Parent 2 0 R + /Resources + << /Font + << /F1 + << /Type /Font + /Subtype /Type1 + /BaseFont /Times-Roman + >> + >> + >> + /Contents 4 0 R + >> +endobj + +4 0 obj + << /Length 55 >> +stream + BT + /F1 18 Tf + 0 0 Td + (Hello World) Tj + ET +endstream +endobj + +%%EOF \ No newline at end of file diff --git a/pitfall/pitfall/minimal.pdf b/pitfall/pitfall/minimal.pdf new file mode 100644 index 00000000..1c641810 --- /dev/null +++ b/pitfall/pitfall/minimal.pdf @@ -0,0 +1,58 @@ +%PDF-1.1 +%¥±ë + +1 0 obj + << /Type /Catalog + /Pages 2 0 R + >> +endobj + +2 0 obj + << /Type /Pages + /Kids [3 0 R] + /Count 1 + /MediaBox [0 0 300 144] + >> +endobj + +3 0 obj + << /Type /Page + /Parent 2 0 R + /Resources + << /Font + << /F1 + << /Type /Font + /Subtype /Type1 + /BaseFont /Times-Roman + >> + >> + >> + /Contents 4 0 R + >> +endobj + +4 0 obj + << /Length 55 >> +stream + BT + /F1 18 Tf + 0 0 Td + (Hello World) Tj + ET +endstream +endobj + +xref +0 5 +0000000000 65535 f +0000000018 00000 n +0000000077 00000 n +0000000178 00000 n +0000000457 00000 n +trailer + << /Root 1 0 R + /Size 5 + >> +startxref +565 +%%EOF diff --git a/pitfall/pitfall/parse.rkt b/pitfall/pitfall/parse.rkt index 23015978..38675d11 100644 --- a/pitfall/pitfall/parse.rkt +++ b/pitfall/pitfall/parse.rkt @@ -1,5 +1,5 @@ #lang at-exp br/quicklang -(require "parser.rkt" "tokenizer.rkt" gregor racket/bytes) +(require "parser.rkt" "tokenizer.rkt" "struct.rkt" gregor racket/bytes) (provide (matching-identifiers-out #rx"pf-" (all-defined-out))) (module+ test (require rackunit)) @@ -12,14 +12,15 @@ #`(module pitfall-parse-mod pitfall/parse #,parse-tree))) -(define-macro (my-mb PARSE-TREE) - #'(#%module-begin PARSE-TREE)) -(provide (rename-out [my-mb #%module-begin])) +(define-macro (my-mb ARG ...) + #'(#%module-begin ARG ...)) +(provide (rename-out [my-mb #%module-begin]) + require) (provide null) -(define-macro (pf-program ARG ...) - #'(list ARG ...)) +(define-macro (pf-program COS-OBJECT ...) + #'(begin COS-OBJECT ...)) (define (pf-name str) (let* ([str (string-trim str "/" #:right? #f)] @@ -52,7 +53,7 @@ (module+ test (check-equal? @pf-string{(Testing)} "Testing") - (check-equal? (pf-string @string-append{(Test\ + (check-equal? (pf-string @string-append{(Test\ ing)}) "Testing") (check-equal? @pf-string{(Test\)ing)} "Test)ing") (check-equal? @pf-string{(Test\ning)} "Test\ning") @@ -66,22 +67,33 @@ (define (pf-array . xs) xs) (define (pf-dict . args) - (apply hash args)) + (apply hasheq args)) + -(struct $stream (dict data) #:transparent) (define (pf-stream dict str) (define data (string->bytes/utf-8 str)) (when (not (equal? (hash-ref dict 'Length) (bytes-length data))) - (raise-argument-error 'pf-stream (format "~a bytes of data" (hash-ref dict 'Length)) (format "~a = ~a" (bytes-length data) data))) + (raise-argument-error 'pf-stream + (format "~a bytes of data" (hash-ref dict 'Length)) + (format "~a = ~v" (bytes-length data) data))) ($stream dict data)) -(define indirect-objects (make-hash)) -(provide indirect-objects) - -(define (pf-indirect-object obj-num generation-num thing) - (hash-set! indirect-objects (vector obj-num generation-num) thing)) - -(define-macro (pf-indirect-object-ref (OBJ-NUM GENERATION-NUM "R")) - #'(hash-ref (report indirect-objects) (vector (string->number OBJ-NUM) - (string->number GENERATION-NUM)))) - \ No newline at end of file +(define-macro (pf-indirect-object OBJ-NUM GEN-NUM THING) + (with-syntax ([IO-ID (prefix-id "io" #'OBJ-NUM)]) + #'(begin + (define (IO-ID #:name [name #f]) + (if name + (string-join (map ~a '(OBJ-NUM GEN-NUM R)) " ") + THING)) + (provide IO-ID) + IO-ID))) + +(define-macro (pf-indirect-object-ref (OBJ-NUM GEN-NUM "R")) + (with-syntax ([IO-ID (prefix-id "io" #'OBJ-NUM)]) + #'(string-join '(OBJ-NUM GEN-NUM "R") " "))) + +(define-macro (pf-version NUM) + (with-pattern ([VERSION-ID (prefix-id "" #'version #:context #'NUM)]) + #'(begin + (define VERSION-ID NUM) + (provide version)))) diff --git a/pitfall/pitfall/parser.rkt b/pitfall/pitfall/parser.rkt index 4d46e715..ffc1bed4 100644 --- a/pitfall/pitfall/parser.rkt +++ b/pitfall/pitfall/parser.rkt @@ -1,14 +1,15 @@ #lang brag -pf-program : pf-thing* -@pf-thing : pf-null | CHAR | BOOLEAN | INT | REAL | pf-name | pf-string | pf-array | pf-dict | pf-stream | pf-indirect-object | pf-indirect-object-ref +pf-program : 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-version @pf-null : NULL pf-name : NAME -pf-string : STRING-TOK | /"<" HEX-DIGIT-PAIR+ /">" -pf-array : /"[" pf-thing* /"]" -pf-dict : /"<<" (pf-dict-key pf-dict-value)* /">>" -@pf-dict-key : pf-thing -@pf-dict-value : pf-thing +pf-string : STRING-TOK | /"<" HEX-DIGIT-PAIR* /">" +pf-array : /"[" pf-object* /"]" +pf-dict : /"<" /"<" (pf-dict-key pf-dict-value)* /">" /">" +@pf-dict-key : pf-object +@pf-dict-value : pf-object pf-stream : pf-dict STREAM-DATA -pf-indirect-object : INT INT /"obj" pf-thing /"endobj" -pf-indirect-object-ref : INDIRECT-OBJECT-REF-TOK \ No newline at end of file +pf-indirect-object : INT INT /"obj" pf-object /"endobj" +pf-indirect-object-ref : INDIRECT-OBJECT-REF-TOK +pf-version : PDF-VERSION \ No newline at end of file diff --git a/pitfall/pitfall/render.rkt b/pitfall/pitfall/render.rkt new file mode 100644 index 00000000..5babff18 --- /dev/null +++ b/pitfall/pitfall/render.rkt @@ -0,0 +1,22 @@ +#lang racket/base +(require racket/string pitfall/struct) +(provide (all-defined-out)) + +(define (cosexpr->string x) + (define str + (let loop ([x x]) + (cond + [(list? x) (string-append "[" (string-join (map loop x) " ") "]")] + [(procedure? x) (string-join (list (string-append (x #:name #t) " obj") (loop (x)) "endobj\n\n") "\n")] + [(string? x) x] + [(hash? x) (string-append + "\n<< " + (string-join + (for/list ([(k v) (in-hash x)]) + (string-join (list (loop k) (loop v)) " ")) " ") + " >> ")] + [(symbol? x) (format "/~a" x)] + [(number? x) (number->string x)] + [($stream? x) (string-append (loop ($stream-dict x)) (string-join (list "\nstream" (format "~a" ($stream-data x)) "endstream") "\n"))] + [else x]))) + (string-join (list "%%PDF1.1" str "%%EOF") "\n")) \ No newline at end of file diff --git a/pitfall/pitfall/struct.rkt b/pitfall/pitfall/struct.rkt new file mode 100644 index 00000000..68052a17 --- /dev/null +++ b/pitfall/pitfall/struct.rkt @@ -0,0 +1,3 @@ +#lang racket/base +(provide (struct-out $stream)) +(struct $stream (dict data) #:transparent) \ No newline at end of file diff --git a/pitfall/pitfall/tokenizer.rkt b/pitfall/pitfall/tokenizer.rkt index 33751114..ac2e4cc2 100644 --- a/pitfall/pitfall/tokenizer.rkt +++ b/pitfall/pitfall/tokenizer.rkt @@ -21,9 +21,10 @@ (define lex-one-token (lexer-srcloc [(eof) eof] + [(:seq "%%EOF" any-string) eof] [(:seq digits (:+ pdf-whitespace) digits (:+ pdf-whitespace) "R") - (begin (println (string-split lexeme)) - (token 'INDIRECT-OBJECT-REF-TOK (string-split lexeme)))] + (token 'INDIRECT-OBJECT-REF-TOK (string-split lexeme))] + [(:seq "%PDF-" digits "." digits) (token 'PDF-VERSION (string->number (trim-ends "%PDF-" lexeme "")))] [(:or pdf-whitespace (from/stop-before "%" #\newline)) (token 'IGNORE lexeme #:skip? #t)] [(:or "true" "false") (token 'BOOLEAN (equal? lexeme "true"))] @@ -35,8 +36,8 @@ ["null" (token 'NULL 'null)] [(:seq "(" (:* (:or not-right-paren substring)) ")") (token 'STRING-TOK lexeme)] [(:seq hex-digit hex-digit) (token 'HEX-DIGIT-PAIR (string->number lexeme 16))] - [(:or "<" ">" "<<" ">>" "[" "]" "obj" "endobj") (token lexeme lexeme)] - [(from/to "stream" "endstream") (token 'STREAM-DATA (string-trim (trim-ends "stream" lexeme "endstream")))] + [(:or "<" ">" "[" "]" "obj" "endobj") (token lexeme lexeme)] + [(from/to "stream" "endstream") (token 'STREAM-DATA (string-trim (trim-ends "stream" lexeme "endstream") "\n"))] [any-char (token 'CHAR lexeme)])) (λ () (lex-one-token port)))