structify font

fontland/fontland/font.rkt

@@ -53,7 +53,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
                   [_src (path->string (object-name _port))]
                   [_directory (delay (decode Directory _port #:parent (mhash '_startOffset 0)))]
                   [_ft-face (delay (and _src (FT_New_Face (force ft-library) _src)))]
-                  [_hb-font (delay (and _src (hb_ft_font_create _ft-face)))]
+                  [_hb-font (delay (and _src (hb_ft_font_create (force _ft-face))))]
                   [_hb-buf (delay (hb_buffer_create))]
                   [_crc (begin0 (crc32c-input-port _port) (pos _port 0))]
                   [_get-head-table #f])
@@ -63,55 +63,15 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
     (raise 'probe-fail))
   (define f
     (TTFFont _port _decoded-tables _src _directory _ft-face _hb-font _hb-buf _crc _get-head-table))
-  (set-TTFFont-_get-head-table! f (λ () (get-head-table f)))
-  f)
-
-#;(define-subclass object% (TTFFont _port)
-    (unless (input-port? _port)
-      (raise-argument-error 'TTFFont "input port" _port))
-    (unless (member (peek-bytes 4 0 _port) (list #"true" #"OTTO" (bytes 0 1 0 0)))
-      (raise 'probe-fail))
   
-    ;; skip variationCoords
-    (field [_decoded-tables (mhash)]
-           [_src (path->string (object-name _port))]
-           [_directory (delay (decode Directory _port #:parent (mhash '_startOffset 0)))]
-           [_ft-face (delay (and _src (FT_New_Face (force ft-library) _src)))]
-           [_hb-font (delay (and _src (hb_ft_font_create (· this ft-face))))]
-           [_hb-buf (delay (hb_buffer_create))]
-           [_crc (begin0 (crc32c-input-port _port) (pos _port 0))])
-
     ;; needed for `loca` table decoding cross-reference
-    (define/public (_get-head-table) (get-head-table this))
-
-    (as-methods
-     postscriptName
-     measure-string
-     unitsPerEm
-     ascent
-     descent
-     lineGap
-     underlinePosition
-     underlineThickness
-     italicAngle
-     capHeight
-     xHeight
-     bbox
-     createSubset
-     getGlyph
-     layout
-     glyphsForString
-     glyphForCodePoint
-     directory
-     ft-face
-     hb-font
-     hb-buf))
+  (set-TTFFont-_get-head-table! f (λ () (get-head-table f)))
+  f)
 
 
 (define (directory this) (force (· this _directory)))
-(define (ft-face this) (or (force (TTFFont-_ft-face this)) (error 'ft-face-not-available)))
-(define (hb-font this) (or (force (· this _hb-font)) (error 'hb-font-not-available)))
-(define (hb-buf this) (force (· this _hb-buf)))
+(define (hb-font this) (or (force (TTFFont-_hb-font this)) (error 'hb-font-not-available)))
+(define (hb-buf this) (force (TTFFont-_hb-buf this)))
 
 (require "table-stream.rkt")
 
@@ -127,7 +87,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   (· (get-head-table this) unitsPerEm))
 
 (test-module
- (check-equal? #R (unitsPerEm f) 1000))
+ (check-equal? (unitsPerEm f) 1000))
 
 ;; The font’s [ascender](https://en.wikipedia.org/wiki/Ascender_(typography))
 (define/contract (ascent this)
@@ -135,7 +95,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   (· (get-hhea-table this) ascent))
 
 (test-module
- (check-equal? (· f ascent) 980))
+ (check-equal? (ascent f) 980))
 
 
 ;; The font’s [descender](https://en.wikipedia.org/wiki/Descender)
@@ -144,15 +104,16 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   (· (get-hhea-table this) descent))
 
 (test-module
- (check-equal? (· f descent) -238))
+ (check-equal? (descent f) -238))
 
 ;; The amount of space that should be included between lines
 (define/contract (lineGap this)
   (->m number?)
   (· (get-hhea-table this) lineGap))
+(define line-gap lineGap) ; todo: avoid this name collision in pitfall/embedded
 
 (test-module
- (check-equal? (· f lineGap) 0))
+ (check-equal? (lineGap f) 0))
 
 
 (define/contract (underlinePosition this)
@@ -160,7 +121,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   (· (get-post-table this) underlinePosition))
 
 (test-module
- (check-equal? (· f underlinePosition) -178))
+ (check-equal? (underlinePosition f) -178))
 
 
 (define/contract (underlineThickness this)
@@ -168,7 +129,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   (· (get-post-table this) underlineThickness))
 
 (test-module
- (check-equal? (· f underlineThickness) 58))
+ (check-equal? (underlineThickness f) 58))
 
 
 ;; If this is an italic font, the angle the cursor should be drawn at to match the font design
@@ -177,7 +138,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   (· (get-post-table this) italicAngle))
 
 (test-module
- (check-equal? (· f italicAngle) 0))
+ (check-equal? (italicAngle f) 0))
 
 
 ;; The height of capital letters above the baseline.
@@ -185,10 +146,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   (->m number?)
   (if (has-table? this #"OS/2")
       (· (get-OS/2-table this) capHeight)
-      (· this ascent)))
+      (ascent this)))
 
 (test-module
- (check-equal? (· f capHeight) 671))
+ (check-equal? (capHeight f) 671))
 
 
 ;; The height of lower case letters in the font.
@@ -199,7 +160,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
       0))
 
 (test-module
- (check-equal? (· f xHeight) 481))
+ (check-equal? (xHeight f) 481))
 
 
 ;; The font’s bounding box, i.e. the box that encloses all glyphs in the font.
@@ -208,29 +169,11 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   (define head-table (get-head-table this))
   (make-BBox (· head-table xMin) (· head-table yMin) (· head-table xMax) (· head-table yMax)))
 
+(define font-bbox bbox) ; todo: avoid name collision in pitfall/embedded
+
 (test-module
- (check-equal? (bbox->list (· f bbox)) '(-161 -236 1193 963)))
-
-;; Returns a Subset for this font.
-(define (createSubset this)
-  #;(->m Subset?)
-  ;; no CFF support
-  #;(make-object (if (· this has-cff-table?)
-                     CFFSubset
-                     TTFSubset) this)
-  (+ttf-subset this))
-
-
-;; Returns a glyph object for the given glyph id.
-;; You can pass the array of code points this glyph represents for
-;; your use later, and it will be stored in the glyph object.
-(define (getGlyph this glyph [characters null])
-  #;((index?) ((listof index?)) . ->*m . glyph?)
-  ;; no CFF
-  #;(make-object (if (· this has-cff-table?)
-                     CFFGlyph
-                     TTFGlyph) glyph characters this)
-  (+ttf-glyph glyph characters this))
+ (check-equal? (bbox->list (bbox f)) '(-161 -236 1193 963)))
+
 
 (define current-layout-caching (make-parameter #false))
 
@@ -251,7 +194,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
                  ('hb-positions posns))
      (define glyphs (for/list ([gidx (in-list gidxs)]
                                [cluster (in-list clusters)])
-                      (send this getGlyph gidx cluster)))
+                      (getGlyph this gidx cluster)))
      (define positions (for/list ([pos (in-list posns)])
                          (match pos
                            [(list xad yad xoff yoff _) (+glyph-position xad yad xoff yoff)])))
@@ -260,11 +203,11 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 
 (define (harfbuzz-layout this codepoints userFeatures script language)
   #;(string? (listof symbol?) symbol? symbol? . ->m . GlyphRun?)
-  (define buf (· this hb-buf))
+  (define buf (hb-buf this))
   (hb_buffer_reset buf)
   (hb_buffer_add_codepoints buf codepoints)
   (define chars (map hb_glyph_info_t-codepoint (hb_buffer_get_glyph_infos buf)))
-  (hb_shape (· this hb-font) buf (map tag->hb-feature (or userFeatures null)))
+  (hb_shape (hb-font this) buf (map tag->hb-feature (or userFeatures null)))
   (define gis (hb_buffer_get_glyph_infos buf))
   (dictify 'hb-gids (map hb_glyph_info_t-codepoint gis)
            'hb-clusters (break-at chars (map hb_glyph_info_t-cluster gis))
@@ -292,7 +235,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   (define (get-layout string)
     (define codepoints (map char->integer (string->list string)))
     (define args (list codepoints (if userFeatures (sort userFeatures symbol<?) null) script language))
-    (define key (apply layout-cache-key (· this _crc) args))
+    (define key (apply layout-cache-key (TTFFont-_crc this) args))
     (hash-ref! layout-cache key
                (λ ()
                  #;(encode hb-output (apply harfbuzz-layout this args) #f)
@@ -335,14 +278,14 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 (define (glyphForCodePoint this codePoint)
   #;(index? . ->m . glyph?)
   (define glyph-idx (FT_Get_Char_Index (· this ft-face) codePoint))
-  (send this getGlyph glyph-idx (list codePoint)))
+  (getGlyph this glyph-idx (list codePoint)))
 
 
 (define/contract (measure-char-width this char)
   (char? . ->m . number?)
-  (define glyph-idx (FT_Get_Char_Index (· this ft-face) (char->integer char)))
-  (FT_Load_Glyph (· this ft-face) glyph-idx FT_LOAD_NO_RECURSE)
-  (define width (FT_Vector-x (FT_GlyphSlotRec-advance (FT_FaceRec-glyph (· this ft-face)))))
+  (define glyph-idx (FT_Get_Char_Index (ft-face this) (char->integer char)))
+  (FT_Load_Glyph (ft-face this) glyph-idx FT_LOAD_NO_RECURSE)
+  (define width (FT_Vector-x (FT_GlyphSlotRec-advance (FT_FaceRec-glyph (ft-face this)))))
   (* width 1.0))
   
 
@@ -350,7 +293,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   (string? number? . ->m . number?)
   (/ (* size
         (for/sum ([c (in-string str)])
-          (measure-char-width this c))) (· this unitsPerEm)))
+          (measure-char-width this c))) (unitsPerEm this)))
 
 
 #|
@@ -390,7 +333,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/base.js
 
 
 (test-module
- (check-equal? (measure-string f "f" (· f unitsPerEm)) 321.0)
+ (check-equal? (measure-string f "f" (unitsPerEm f)) 321.0)
  (check-true (has-table? f #"cmap"))
  (check-exn exn:fail:contract? (λ () (get-table f 'nonexistent-table-tag)))
  (check-true

fontland/fontland/glyph.rkt

@@ -3,6 +3,7 @@
          sugar/unstable/dict
          sugar/unstable/js
          "unsafe/freetype.rkt"
+         "struct.rkt"
          "helper.rkt")
 (provide (all-defined-out))
 
@@ -40,7 +41,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/Glyph.js
 
 (define (get-glyph-metrics g)
   (unless (glyph-metrics g)
-    (define face (· (glyph-font g) ft-face))
+    (define face (ft-face (glyph-font g)))
     (FT_Load_Glyph face (glyph-id g) FT_LOAD_NO_RECURSE)
     (define glyph (FT_FaceRec-glyph face))
     (define ft-glyph-metrics (FT_GlyphSlotRec-metrics glyph))
@@ -51,3 +52,22 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/Glyph.js
   (glyph-metrics g))
 
 
+
+;; Represents a TrueType glyph.
+
+(struct ttf-glyph glyph () #:transparent)
+
+(define (+ttf-glyph . args)
+  (apply +glyph #:constructor ttf-glyph args))
+
+
+;; Returns a glyph object for the given glyph id.
+;; You can pass the array of code points this glyph represents for
+;; your use later, and it will be stored in the glyph object.
+(define (getGlyph this glyph [characters null])
+  #;((index?) ((listof index?)) . ->*m . glyph?)
+  ;; no CFF
+  #;(make-object (if (· this has-cff-table?)
+                     CFFGlyph
+                     TTFGlyph) glyph characters this)
+  (+ttf-glyph glyph characters this))

fontland/fontland/struct.rkt

@@ -4,3 +4,5 @@
 
 (struct TTFFont (_port _decoded-tables _src _directory _ft-face _hb-font _hb-buf _crc _get-head-table)
   #:transparent #:mutable)
+
+(define (ft-face this) (or (force (TTFFont-_ft-face this)) (error 'ft-face-not-available)))

fontland/fontland/subset.rkt

@@ -12,7 +12,7 @@
          fontland/ttf-glyph
          xenomorph)
 
-(provide subset +subset ttf-subset +ttf-subset subset-include-glyph encode-to-port)
+(provide subset +subset ttf-subset +ttf-subset subset-include-glyph encode-to-port createSubset)
 
 #|
 approximates
@@ -61,8 +61,21 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
   (subset-include-glyph ss 0)
   ss)
 
+
+;; Returns a Subset for this font.
+(define (createSubset this)
+  #;(->m Subset?)
+  ;; no CFF support
+  #;(make-object (if (· this has-cff-table?)
+                     CFFSubset
+                     TTFSubset) this)
+  (+ttf-subset this))
+
+
+
 (define (ttf-subset-add-glyph ss gid)
-  (define glyph (send (subset-font ss) getGlyph gid))
+  (define glyph (getGlyph (subset-font ss) gid))
+
   
   ;; glyph-decode unpacks the `glyf` table data corresponding to a certin gid.
   ;; here, it's not necessary for non-composite glyphs
@@ -70,7 +83,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
   ;; it's just used to detect composite glyphs and handle them specially.
   ;; so an optimization would be to detect composite / noncomposite without full glyph-decode.
   (define ttf-glyf-data (glyph-decode glyph))
-
+  
   ;; get the offset to the glyph from the loca table
   (match-define (list this-offset next-offset) (take (drop (hash-ref (dump (get-table (subset-font ss) 'loca)) 'offsets) gid) 2))
 

fontland/fontland/table-stream.rkt

@@ -32,8 +32,9 @@
 (define-table-getters)
 
 (define (get-table-stream this tag)
-  (define table (hash-ref (· this directory tables) tag))
-  (and table (pos (· this _port) (· table offset)) (· this _port)))
+  (define directory (force (TTFFont-_directory this)))
+  (define table (hash-ref (· directory tables) tag))
+  (and table (pos (TTFFont-_port this) (· table offset)) (TTFFont-_port this)))
   
 (define  (decode-table this table-tag)
   (unless (hash-has-key? table-codecs table-tag)

fontland/fontland/table/loca.rkt

@@ -5,6 +5,7 @@
          sugar/unstable/dict
          racket/class
          racket/list
+         "../struct.rkt"
          "../helper.rkt")
 (provide (all-defined-out))
 
@@ -43,7 +44,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js
       (dict-update! this 'offsets (λ (offsets) (map (λ (x) (/ x 2)) offsets))))))
 
 (define loca (+Rloca
-              (λ (o) (· o _get-head-table indexToLocFormat)) 
+              ;; todo: address ugliness to cross-ref head table from ttffont
+              (λ (o) (hash-ref (dump ((TTFFont-_get-head-table o))) 'indexToLocFormat)) 
               (dictify
                0 (dictify 'offsets (+Array uint16be))
                1 (dictify 'offsets (+Array uint32be)))))

fontland/fontland/ttf-glyph.rkt

@@ -15,12 +15,6 @@ approximates
 https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
 |#
 
-;; Represents a TrueType glyph.
-
-(struct ttf-glyph glyph () #:transparent)
-
-(define (+ttf-glyph . args)
-  (apply +glyph #:constructor ttf-glyph args))
 
 ;; The header for both simple and composite glyphs
 (define GlyfHeader (+Struct