From bdbc4f247d7ea50b1beb59b599fb44c43b4abad8 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Mon, 4 Mar 2019 16:10:17 -0800
Subject: [PATCH] start cffindex

---
 fontland/fontland/table/CFF_.rkt      | 12 ++++---
 fontland/fontland/table/cff-index.rkt | 50 +++++++++++++++++++++------
 fontland/fontland/table/cff-top.rkt   |  6 ++--
 3 files changed, 50 insertions(+), 18 deletions(-)

diff --git a/fontland/fontland/table/CFF_.rkt b/fontland/fontland/table/CFF_.rkt
index 4c2a8814..d974cf23 100644
--- a/fontland/fontland/table/CFF_.rkt
+++ b/fontland/fontland/table/CFF_.rkt
@@ -25,11 +25,15 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js
 
 (module+ test
   (require rackunit racket/serialize racket/stream "../helper.rkt")
-  (define dir (deserialize (read (open-input-file #R fira-otf-directory-path))))
-  (define cff-offset (hash-ref (hash-ref (hash-ref dir 'tables) 'CFF_) 'offset))
-  (define cff-length (hash-ref (hash-ref (hash-ref dir 'tables) 'CFF_) 'length))
+  (define dir (deserialize (read (open-input-file fira-otf-directory-path))))
+  (define cff (hash-ref (hash-ref dir 'tables) 'CFF_))
+  (define cff-offset (hash-ref cff 'offset))
+  (check-equal? cff-offset 33472)
+  (define cff-length (hash-ref cff 'length))
+  (check-equal? cff-length 164604)
   (define ip (open-input-file fira-otf-path))
-  (define cff-bytes (peek-bytes #R cff-length #R cff-offset ip))
+  (define cff-bytes (peek-bytes cff-length cff-offset ip))
   (define cff-data (decode CFFFont cff-bytes))
+  (check-equal? (hash-ref cff-data 'nameIndex) '("FiraSans-Book"))
   cff-data
   )
\ No newline at end of file
diff --git a/fontland/fontland/table/cff-index.rkt b/fontland/fontland/table/cff-index.rkt
index fd80f168..836f8942 100644
--- a/fontland/fontland/table/cff-index.rkt
+++ b/fontland/fontland/table/cff-index.rkt
@@ -1,25 +1,53 @@
-#lang racket/base
-(require racket/class xenomorph sugar/unstable/dict)
+#lang debug racket/base
+(require racket/class racket/match xenomorph sugar/unstable/dict)
 (provide CFFIndex)
 
 (define CFFIndex%
   (class xenobase%
     (super-new)
-    (init-field [type type])
+    (init-field [(@type type) #f])
 
     (define (getCFFVersion ctx)
       (let loop ([ctx ctx])
         (if (and ctx (not (hash-ref ctx 'hdrSize)))
             (loop (hash-ref ctx 'parent))
-            (if ctx (hash-ref ctx 'version) -1))))
+            (if ctx (hash-ref ctx 'x:version) -1))))
     
     (define/augride (:decode stream parent)
-      (define version (getCFFVersion parent))
-      (define count (decode (if (>= version 2)
-                                uint32be
-                                uint16be) stream))
-      count
-      )))
+      (match (decode (if (>= (getCFFVersion parent) 2) uint32be uint16be) stream)
+        [0 null]
+        [count (define offSize (decode uint8 stream))
+               (define offsetType (case offSize
+                                    [(1) uint8]
+                                    [(2) uint16be]
+                                    [(3) uint24be]
+                                    [(4) uint32be]
+                                    [else (error 'bad-offset-size-in-CFFIndex)]))
+               (define startPos (+ (pos stream) (* (add1 count) offSize) -1))
+               (for/fold ([vals null]
+                          [start (decode offsetType stream)]
+                          #:result (begin0 (reverse vals) (pos stream (+ startPos start))))
+                         ([i (in-range count)])
+                 (define end (decode offsetType stream))
+                 (define val
+                   (cond
+                     [@type
+                      (define apos (pos stream))
+                      (pos stream (+ startPos start))
+                      (hash-set! parent 'length (- end start))
+                      (begin0
+                        (decode @type stream #:parent parent)
+                        (pos stream apos))]
+                     [else
+                      (hasheq 'offset (+ startPos start)
+                              'length (- end start))]))
+                 (values (cons val vals) end))]))
 
-(define (CFFIndex type)
+    (define/augride (:size arr parent)
+      (error 'cff-index-size-not-implemented))
+
+    (define/augride (:encode stream arr parent)
+      (error 'cff-index-encode-not-implemented))))
+
+(define (CFFIndex [type #f])
   (new CFFIndex% [type type]))
\ No newline at end of file
diff --git a/fontland/fontland/table/cff-top.rkt b/fontland/fontland/table/cff-top.rkt
index e946a586..36593667 100644
--- a/fontland/fontland/table/cff-top.rkt
+++ b/fontland/fontland/table/cff-top.rkt
@@ -1,4 +1,4 @@
-#lang racket/base
+#lang debug racket/base
 (require xenomorph sugar/unstable/dict "cff-index.rkt")
 (provide CFFTop)
 
@@ -13,8 +13,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
    (dictify
     1 (dictify 'hdrSize uint8
                'offSize uint8
-               ;;'nameIndex (CFFIndex (x:string #:length 'length))
-               ;;'topDictIndex (CFFIndex CFFTopDict)
+               'nameIndex (CFFIndex (x:string #:length 'length))
+               ;'topDictIndex (CFFIndex CFFTopDict)
                ;;'stringIndex (CFFIndex (x:string #:length 'length))
                ;;'globalSubrIndex (CFFIndex)
                )