structify

pitfall/pitfall/minimal-pdf-source.rkt

@@ -1,2 +1,49 @@
-#lang racket/base
-(require pitfall/struct pitfall/render)
+#lang s-exp pitfall/render
+
+(co-version 1.1)
+(co-comment "%¥±ë")
+(co-io
+ 1
+ 0
+ (co-dict (hasheq 'Pages (co-io-ref 2 0) 'Type 'Catalog)))
+(co-io
+ 2
+ 0
+ (co-dict
+  (hasheq
+   'Count
+   1
+   'Kids
+   (co-array (list (co-io-ref 3 0)))
+   'Type
+   'Pages
+   'MediaBox
+   (co-array '(0 0 300 144)))))
+(co-io
+ 3
+ 0
+ (co-dict
+  (hasheq
+   'Resources
+   (co-dict
+    (hasheq
+     'Font
+     (co-dict
+      (hasheq
+       'F1
+       (co-dict
+        '#hasheq((Subtype . Type1)
+                 (BaseFont . Times-Roman)
+                 (Type . Font)))))))
+   'Parent
+   (co-io-ref 2 0)
+   'Contents
+   (co-io-ref 4 0)
+   'Type
+   'Page)))
+(co-io
+ 4
+ 0
+ (co-stream
+  (co-dict '#hasheq((Length . 55)))
+  #"  BT\n    /F1 18 Tf\n    0 0 Td\n    (Hello World) Tj\n  ET"))

pitfall/pitfall/parse.rkt

@@ -85,3 +85,5 @@
   #'(co-io-ref OBJ GEN))
 
 (define (pf-version num) (co-version num))
+
+(define (pf-comment text) (co-comment text))

pitfall/pitfall/parser.rkt

@@ -1,7 +1,7 @@
 #lang brag
 
 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-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-comment
 @pf-null : NULL
 pf-name : NAME
 pf-string : STRING-TOK | /"<" HEX-DIGIT-PAIR* /">"
@@ -12,4 +12,5 @@ pf-dict : /"<" /"<" (pf-dict-key pf-dict-value)* /">" /">"
 pf-stream : pf-dict STREAM-DATA
 pf-indirect-object : INT INT /"obj" pf-object /"endobj"
 pf-indirect-object-ref : INDIRECT-OBJECT-REF-TOK
-pf-version : PDF-VERSION
+pf-version : PDF-VERSION
+pf-comment : COMMENT

pitfall/pitfall/render.rkt

@@ -1,4 +1,4 @@
-#lang racket/base
+#lang at-exp racket/base
 (require (for-syntax racket/base)
          racket/string pitfall/struct br/define)
 (provide (all-defined-out)
@@ -6,25 +6,45 @@
          (except-out (all-from-out racket/base) #%module-begin))
 
 (define-macro (mb . ARGS)
-  #'(#%module-begin
-     (cosexpr->string (list . ARGS))))
+  #'(#%module-begin (render-args . ARGS)))
 (provide (rename-out [mb #%module-begin]))
 
+(define (render-args . args)
+  (display
+   (string-append
+    (string-join
+     (map cosexpr->string (append args (list "%%EOF")))
+     "\n\n"))))
+  
 (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)]
-        [(co-stream? x) (string-append (loop (co-stream-dict x)) (string-join (list "\nstream" (format "~a" (co-stream-data x)) "endstream") "\n"))]
-        [else x])))
-  (string-join (list "%%PDF1.1" str "%%EOF") "\n"))
+  (let loop ([x x])
+    (cond
+      [(co-version? x)
+       @string-append{%%PDF-@(number->string (co-version-num 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)]
+      [(symbol? x) @string-append{/@(symbol->string x)}]
+      [(number? x) @number->string{@x}]
+      [(string? x) x]
+      [else (format "~a" x)])))

pitfall/pitfall/struct.rkt

@@ -5,5 +5,6 @@
 (struct co-array (items) #:transparent)
 (struct co-stream (dict data) #:transparent)
 (struct co-version (num) #:transparent)
-(struct co-io (obj gen thing) #:transparent)
-(struct co-io-ref (obj gen) #:transparent)
+(struct co-io (idx rev thing) #:transparent)
+(struct co-io-ref (idx rev) #:transparent)
+(struct co-comment (text) #:transparent)

pitfall/pitfall/tokenizer.rkt

@@ -23,10 +23,10 @@
      [(eof) eof]
      [(:seq "%%EOF" any-string) eof]
      [(:seq digits (:+ pdf-whitespace) digits (:+ pdf-whitespace) "R")
-      (token 'INDIRECT-OBJECT-REF-TOK (string-split lexeme))]
+      (token 'INDIRECT-OBJECT-REF-TOK (map string->number (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)]
+     [pdf-whitespace (token 'IGNORE lexeme #:skip? #t)]
+     [(from/stop-before "%" #\newline) (token 'COMMENT lexeme)]
      [(:or "true" "false") (token 'BOOLEAN (equal? lexeme "true"))]
      [(:seq optional-sign digits) (token 'INT (string->number lexeme))]
      [(:seq optional-sign (:or (:seq digits "." (:? digits))