working minimal font embed

pitfall/pitfall/foo.rkt

@@ -0,0 +1,75 @@
+#lang pitfall/parse
+
+null
+true
+false
+1
+-2
++100
+612
+0.05
+.25
+-3.14159
+300.9001
+/Type
+/ThisIsName37
+/Lime#20Green
+/SSCN_SomeSecondClassName
+/Adobe#20Green
+/The_Key_of_F#23_Minor
+(Testing)
+(A\053B)
+
+%(D:19990209153925-08'00')
+<1C2D3F>
+<1C 2D 3F>
+[0 0 612 792]
+[(T) -20.5 (H) 4 (E)]
+[[1 2 3][4 5 6]]
+<<
+/Type /Example
+/Subtype /DictionaryExample
+/Version 0.01
+/IntegerItem 12
+/StringItem (a string)
+/Subdictionary <<
+/Item1 0.4
+/Item2 true
+/LastItem (not!)
+/VeryLastItem (OK) >> >>
+( This string contains \245two octal characters\307 . )
+(Strings may contain balanced parentheses ( ) and special \ncharacters (*!&}^% and so on).)
+% a more human-readable dictionary
+<<
+  /Type /Page
+  /Author (Leonard Rosenthol)
+  /Resources 42
+>>
+% stripped
+<</Length 3112/Subtype/XML/Type/Metadata>>
+
+<<
+  /Type /Xobject /Subtype /Image /Filter /FlateDecode /Length 4 /Height 32 /Width 32
+>>
+stream
+abcd
+endstream
+
+12 0 obj
+( Brillig )
+endobj
+
+8 0 obj
+63
+endobj
+
+7 0 obj
+<< /Length 8 0 R >>
+stream
+BT
+/F1 12 Tf
+72 712 Td
+(A stream with an indirect length) Tj
+ET
+endstream
+endobj

pitfall/pitfall/minimal-embedded-font.rkt

@@ -0,0 +1,88 @@
+#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 400 400)
+                    #:resources (co-io-ref 4 0)
+                    #:contents (co-io-ref 5 0)
+                    
+                    ; the value of annots must be an array
+                    #:annots (co-array (list (co-io-ref 7 0)))
+                    ))
+#;#:annots (co-io-ref 7 0)
+
+;; resources
+(co-io 4 0
+       (make-co-dict
+        'ProcSet (co-array '(PDF Text))
+        'Font (make-co-dict 'F1 (co-io-ref 6 0))))
+
+;; contents
+(co-io 5 0
+       (make-co-stream
+        #"
+BT
+/F1 24 Tf
+1 0 0 1 100 100 Tm
+1 0 0 RG
+[2] 0 d
+0.75 g
+2 Tr
+(Hello) Tj
+2 0 0 2 160 100 Tm
+0 0 0 RG
+0 g
+(World) Tj
+ET
+"))
+
+
+;; font
+(co-io 6 0
+       (make-co-dict
+        'Type 'Font
+        'Subtype 'Type1
+        'Name 'F1
+        'BaseFont 'Helvetica
+        'FontDescriptor (co-io-ref 9 0)))
+
+
+
+(co-io 7 0
+       (make-co-dict 'Type 'Annot
+                     'Subtype 'Link
+                     'Rect (co-array '(100 100 150 125))
+                     'A (co-io-ref 8 0)))
+
+
+(co-io 8 0
+       (make-co-dict 'Type 'Action
+                     'S 'URI
+                     'URI (co-string "http://practicaltypography.com")))
+
+(co-io 9 0
+       (make-co-dict
+        'Type 'FontDescriptor
+        'FontName 'Miso
+        'FontFile3 (co-io-ref 10 0)
+        'Flags 262178
+        'FontBBox (co-array '(-177 -269 1123 866))
+        'MissingWidth 255
+        'StemV 105
+        'StemH 45
+        'CapHeight 660
+        'XHeight 394
+        'Ascent 720
+        'Descent '270
+        'Leading 83
+        'MaxWidth 1212
+        'AvgWidth 478
+        'ItalicAngle 0))
+
+(co-io 10 0 (make-font-co-stream "miso.otf"))

pitfall/pitfall/render.rkt

@@ -1,8 +1,9 @@
 #lang at-exp racket/base
 (require (for-syntax racket/base)
-         racket/string pitfall/struct br/define racket/bytes sugar/debug racket/format)
+         racket/string pitfall/struct br/define racket/bytes sugar/debug racket/format racket/file)
 (provide (all-defined-out)
          (all-from-out pitfall/struct)
+         file->bytes
          (except-out (all-from-out racket/base) #%module-begin))
 
 (define-macro (mb . ARGS)
@@ -17,7 +18,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 +35,11 @@
        (if (co-io? cosexpr)
            (cons (cons (co-io-idx cosexpr) offset) io-locs)
            io-locs))))
-  (define header-str (cosexpr->bytes (co-header "%PDF-1.3\n%¥±ë")))
+  (define header-str (cosexpr->bytes (co-header "%PDF-1.6\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)))
+                        (bytes-length bstr)))
   (define result (apply bytes-append `(,header-str
                                        ,@(reverse bstrs)
                                        ,(make-xref-table locs)
@@ -46,11 +47,11 @@
                                        #"\nstartxref\n"
                                        ,(string->bytes/latin-1 (number->string last-offset))
                                        #"\n%%EOF")))
-  (display result)
+  #;(display result)
   (let ([op (open-output-file (expand-user-path "~/Desktop/foo.pdf") #:exists 'replace)])
     (write-bytes result op)
     (close-output-port op))
-  result)
+  #;result)
   
 (define (cosexpr->bytes x)
   (bytes-append
@@ -74,7 +75,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}]
@@ -120,7 +121,10 @@
 (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))
+(define (make-co-stream bstr . kvs)
+  (co-stream  (apply make-co-dict 'Length (bytes-length bstr) kvs) (bytes->string/latin-1 bstr)))
 
-(cosexpr->bytes (make-co-dict 'Hello (co-string "World")))
+(define (make-font-co-stream font-path)
+  (make-co-stream (file->bytes font-path) 'Subtype 'OpenType))
+
+#;(cosexpr->bytes (make-co-dict 'Hello (co-string "World")))