structify glyph

fontland/fontland/font.rkt

@@ -244,13 +244,13 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 ;; 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/contract (getGlyph this glyph [characters null])
-  ((index?) ((listof index?)) . ->*m . (is-a?/c Glyph))
+(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)
-  (make-object TTFGlyph glyph characters this))
+  (+ttf-glyph glyph characters this))
 
 (define current-layout-caching (make-parameter #false))
 
@@ -340,8 +340,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 ;; This is only a one-to-one mapping from characters to glyphs.
 ;; For most uses, you should use font.layout (described below), which
 ;; provides a much more advanced mapping supporting AAT and OpenType shaping.
-(define/contract (glyphsForString this string)
-  (string? . ->m . (listof (is-a?/c Glyph)))
+(define (glyphsForString this string)
+  #;(string? . ->m . (listof glyph?))
 
   ;; todo: make this handle UTF-16 with surrogate bytes
   ;; for now, just use UTF-8
@@ -352,8 +352,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 
 ;; Maps a single unicode code point to a Glyph object.
 ;; Does not perform any advanced substitutions (there is no context to do so).
-(define/contract (glyphForCodePoint this codePoint)
-  (index? . ->m . Glyph?)
+(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)))
 

fontland/fontland/glyph.rkt

@@ -31,49 +31,53 @@ approximates
 https://github.com/mbutterick/fontkit/blob/master/src/glyph/Glyph.js
 |#
 
-(define-subclass object% (Glyph id codePoints font)
+#;(define-subclass object% (Glyph id codePoints font)
     (field [_font font]
            [isMark (andmap is-mark? codePoints)]
            [isLigature (> (length codePoints) 1)]
            [_metrics #f])
 
     (as-methods
-   _getPath
-   _getCBox
-   _getBBox
-   _getTableMetrics
      advanceWidth
      _getMetrics))
 
-(define-stub-stop _getPath)
-(define-stub-stop _getCBox)
-(define-stub-stop _getBBox)
-(define-stub-stop _getTableMetrics)
+(struct glyph (id codePoints font _font isMark isLigature _metrics) #:transparent #:mutable)
 
-(define/contract (advanceWidth this)
-  (->m number?)
-  (hash-ref (_getMetrics this) 'advanceWidth))
+(define (+glyph id codePoints font
+                [_font font]
+                [isMark (andmap is-mark? codePoints)]
+                [isLigature (> (length codePoints) 1)]
+                [_metrics #f]
+                #:constructor [constructor glyph])
+  (constructor id codePoints font _font isMark isLigature _metrics))
+
+#;(define-stub-stop _getPath)
+#;(define-stub-stop _getCBox)
+#;(define-stub-stop _getBBox)
+#;(define-stub-stop _getTableMetrics)
 
+(define (glyph-advance-width g)
+  (hash-ref (_getMetrics g) 'advanceWidth))
 
-(define/contract (_getMetrics this)
-  (->m hash?)
-  (unless (· this _metrics)
-    (define face (· this _font ft-face))
-    (FT_Load_Glyph face (· this id) FT_LOAD_NO_RECURSE)
+
+(define (_getMetrics g)
+  (unless (glyph-_metrics g)
+    (define face (· (glyph-_font g) ft-face))
+    (FT_Load_Glyph face (glyph-id g) FT_LOAD_NO_RECURSE)
     (define glyph (FT_FaceRec-glyph face))
     (define glyph-metrics (FT_GlyphSlotRec-metrics glyph))
-    (set-field! _metrics this (mhash))
-    (hash-set*! (· this _metrics)
+    (set-glyph-_metrics! g (mhash))
+    (hash-set*! (glyph-_metrics g)
                 'advanceWidth (FT_Glyph_Metrics-horiAdvance glyph-metrics)
                 'leftBearing (FT_Glyph_Metrics-horiBearingX glyph-metrics)))
-  (· this _metrics))
+  (glyph-_metrics g))
 
 #|
 approximates
 https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
 |#
 
-(define-subclass Glyph (CFFGlyph)
+#;(define-subclass Glyph (CFFGlyph)
     (error 'cff-glyph-unimplemented)
 
     #;(define/override (_getName this)
@@ -146,15 +150,23 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
          [scale10 0]))
 
 ;; Represents a TrueType glyph.
-(define-subclass Glyph (TTFGlyph)
-  (inherit-field _font id)
+#;(define-subclass Glyph (TTFGlyph)
+    (inherit-field _font id))
+
+(struct ttf-glyph glyph () #:transparent)
+
+(define (+ttf-glyph . args)
+  (apply +glyph #:constructor ttf-glyph args))
+  
+
+
 
 ;; Parses just the glyph header and returns the bounding box
-  (define/override (_getCBox internal)
+#;(define/override (_getCBox internal)
     (unfinished))
 
 ;; Parses a single glyph coordinate
-  (define/public (_parseGlyphCoord port prev short same)
+(define (_parseGlyphCoord port prev short same)
   (unless (input-port? port)
     (raise-argument-error '_parseGlyphCoord "input port" port))
   (unless (number? prev)
@@ -168,14 +180,14 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
 
 ;; Decodes the glyph data into points for simple glyphs,
 ;; or components for composite glyphs
-  (define/public (_decode)
-    (define offsets (· _font loca offsets))
-    (match-define (list glyfPos nextPos) (take (drop offsets id) 2))
+(define (glyph-decode ttfg)
+  (define offsets (· (glyph-_font ttfg) loca offsets))
+  (match-define (list glyfPos nextPos) (take (drop offsets (glyph-id ttfg)) 2))
 
   ;; Nothing to do if there is no data for this glyph
   (and (not (= glyfPos nextPos))
        (let ()
-           (define port (send _font _getTableStream 'glyf))
+         (define port (send (glyph-_font ttfg) _getTableStream 'glyf))
          (pos port (+ (pos port) glyfPos))
          (define startPos (pos port))
          (define glyph (decode GlyfHeader port))
@@ -184,7 +196,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
            [(? negative?) (_decodeComposite glyph port startPos)])
          glyph)))
 
-  (define/public (_decodeSimple glyph port)
+(define (_decodeSimple glyph port)
   (unless (dict? glyph)
     (raise-argument-error 'TTFGlyph-_decodeSimple "decoded RGlyfHeader" glyph))
 
@@ -219,7 +231,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
       (values (cons point points) next-px next-py)))
   (dict-set! glyph 'points (reverse points)))
 
-  (define/public (_decodeComposite glyph port [offset 0])
+(define (_decodeComposite glyph port [offset 0])
   ;; this is a composite glyph
   (dict-set! glyph 'components empty)
   (define haveInstructions #f)
@@ -256,7 +268,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
                           (set-field! scale10 component (read-fixed14 port))
                           (set-field! scaleY component (read-fixed14 port))])
                        component))
-    haveInstructions))
+  haveInstructions)
         
 
 (define (bytes->fixed14 b1 b2)

fontland/fontland/main.rkt

@@ -8,4 +8,5 @@
      "subset.rkt"
      "bbox.rkt"
      "tables.rkt"
-     "glyphrun.rkt")
+     "glyphrun.rkt"
+     "glyph.rkt")

fontland/fontland/subset.rkt

@@ -10,6 +10,7 @@
          "table/loca.rkt"
          "directory.rkt"
          "helper.rkt"
+         fontland/glyph
          xenomorph)
 (provide Subset TTFSubset)
 
@@ -103,12 +104,12 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
   (index? . ->m . index?)
 
   (define glyph (send (· this font) getGlyph gid))
-  ;; _decode unpacks the `glyf` table data corresponding to a certin gid.
+  ;; glyph-decode unpacks the `glyf` table data corresponding to a certin gid.
   ;; here, it's not necessary for non-composite glyphs
   ;; because they just get copied entirely into the subset.
   ;; it's just used to detect composite glyphs and handle them specially.
-  ;; so an optimization would be to detect composite / noncomposite without full _decode.
-  (define glyf (send glyph _decode))
+  ;; so an optimization would be to detect composite / noncomposite without full glyph-decode.
+  (define glyf (glyph-decode glyph))
 
   ;; get the offset to the glyph from the loca table
   (match-define (list curOffset nextOffset) (take (drop (· this font loca offsets) gid) 2))
@@ -132,8 +133,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
                                                  (append os (list (get-field offset this)))))
 
   (hash-update! (get-field hmtx this) 'metrics (λ (ms) (append ms
-                                                               (list (mhash 'advance (· glyph advanceWidth)
-                                                                            'bearing (· (send glyph _getMetrics) leftBearing))))))
+                                                               (list (mhash 'advance (glyph-advance-width glyph)
+                                                                            'bearing (· (_getMetrics glyph) leftBearing))))))
 
   (increment-field! offset this (bytes-length buffer))
   (sub1 (length (· this glyf))))