working...

pitfall/pitfall/minimal-annotation.rkt

@@ -0,0 +1,34 @@
+#lang at-exp s-exp pitfall/render
+
+;; catalog object
+(co-io 1 0 (co-catalog #:pages (co-io-ref 2 0)))
+
+;; pages
+(co-io 2 0 (co-pages #:kids (list (co-io-ref 3 0))
+                     #:count 1))
+;; page
+(co-io 3 0 (co-page #:parent (co-io-ref 2 0)
+                    #:mediabox '(0 0 612 792)
+                    #:resources (co-io-ref 4 0)
+                    #:contents (co-io-ref 5 0)))
+
+;; resources
+(co-io 4 0
+       (make-co-dict
+        'ProcSet (co-array '(PDF Text))
+        'Font (make-co-dict 'F1 (co-io-ref 6 0))))
+
+;; font
+(co-io 6 0
+       (make-co-dict
+        'Type 'Font 'Subtype 'Type1 'Name 'F1 'BaseFont 'Helvetica))
+
+;; contents
+(co-io 5 0
+       (make-co-stream
+        #"BT
+/F1 24 Tf
+1 0 0 1 260 600 Tm
+(Hello World)Tj
+ET"))
+

pitfall/pitfall/minimal-pdf-source.rkt

@@ -5,45 +5,5 @@
  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"))
-(co-trailer (co-dict (hasheq 'Size 5 'Root (co-io-ref 1 0))))
+
+(co-trailer (co-dict (hasheq 'Size 1 'Root (co-io-ref 1 0))))

pitfall/pitfall/render.rkt

@@ -17,7 +17,7 @@
  @(let ([sep " 00000 n\n"])
     (string-join
      (for/list ([loc (in-list (cdr (sort locs < #:key car)))])
-       (~r #:min-width 10 #:pad-string "0" (cdr loc))) sep #:after-last sep))
+               (~r #:min-width 10 #:pad-string "0" (cdr loc))) sep #:after-last sep))
  }))
 
 
@@ -34,11 +34,13 @@
        (if (co-io? cosexpr)
            (cons (cons (co-io-idx cosexpr) offset) io-locs)
            io-locs))))
-  (define trailer-str (car bstrs))
-  (define other-bstrs (cdr bstrs))
-  (define last-offset (for/sum ([bstr (in-list other-bstrs)])
-                        (bytes-length bstr)))
-  (define result (apply bytes-append `(,@(reverse other-bstrs)
+  (define header-str (cosexpr->bytes (co-header "%PDF-1.1\n%¥±ë")))
+  (define trailer-str (cosexpr->bytes
+                       (co-trailer (co-dict (hasheq 'Size (length bstrs) 'Root (co-io-ref 1 0))))))
+  (define last-offset (for/sum ([bstr (in-list bstrs)])
+                               (bytes-length bstr)))
+  (define result (apply bytes-append `(,header-str
+                                       ,@(reverse bstrs)
                                        ,(make-xref-table locs)
                                        ,trailer-str
                                        #"\nstartxref\n"
@@ -72,7 +74,7 @@
           <<
           @(string-join
             (for/list ([(k v) (in-hash (co-dict-dict x))])
-              @string-append{@(loop k) @(loop v)}) "\n")
+                      @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}]
@@ -91,4 +93,29 @@
         [(symbol? x) @string-append{/@(symbol->string x)}]
         [(number? x) @number->string{@x}]
         [(string? x) x]
-        [else (format "~a" x)]))) #"\n"))
+        [else (format "~a" x)]))) #"\n"))
+
+
+(define (co-catalog #:pages io-ref)
+  (co-dict (hasheq 'Type 'Catalog 'Pages io-ref)))
+
+(define (co-pages #:kids kidslist #:count count)
+  (co-dict (hasheq 'Type 'Pages
+                   'Kids (co-array kidslist)
+                   'Count count)))
+
+(define (co-page #:parent parent
+                 #:mediabox pts
+                 #:resources [rsrcs (co-dict (hasheq))]
+                 #:contents contents)
+  (co-dict (hasheq 'Type 'Page
+                   'Parent parent
+                   'MediaBox (co-array pts)
+                   'Resources rsrcs
+                   'Contents contents)))
+
+(define (make-co-dict . xs)
+  (co-dict (apply hasheq xs)))
+
+(define (make-co-stream bstr)
+  (co-stream  (make-co-dict 'Length (bytes-length bstr)) bstr))