nits

fontland/fontland/font.rkt

@@ -8,11 +8,9 @@
          "db.rkt"
          "struct.rkt"
          "table-stream.rkt"
-         racket/class
          xenomorph
          racket/match
          sugar/unstable/dict
-         sugar/unstable/js
          "unsafe/harfbuzz.rkt"
          "glyph-position.rkt"
          sugar/list
@@ -25,12 +23,6 @@ approximates
 https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 |#
 
-(test-module
- (define f (open-font charter-path))
- (define fira (open-font (path->string fira-path)))
- (define otf (open-font (path->string fira-otf-path)))
- (check-equal? (font-postscript-name f) "Charter"))
-
 (define ft-library (delay (FT_Init_FreeType)))
 
 (define (+ttf-font port
@@ -53,41 +45,28 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   font)
 
 (define (font-postscript-name font) (FT_Get_Postscript_Name (ft-face font)))
-(define (font-units-per-em font) (· (get-head-table font) unitsPerEm))
-(define (font-ascent font)  (· (get-hhea-table font) ascent))
-(define (font-descent font) (· (get-hhea-table font) descent))
-(define (font-linegap font) (· (get-hhea-table font) lineGap))
-(define (font-underline-position font) (· (get-post-table font) underlinePosition))
-(define (font-underline-thickness font) (· (get-post-table font) underlineThickness))
-(define (font-italic-angle font) (· (get-post-table font) italicAngle))
+(define (font-units-per-em font) (hash-ref (get-head-table font) 'unitsPerEm))
+(define (font-ascent font)  (hash-ref (get-hhea-table font) 'ascent))
+(define (font-descent font) (hash-ref (get-hhea-table font) 'descent))
+(define (font-linegap font) (hash-ref (get-hhea-table font) 'lineGap))
+(define (font-underline-position font) (hash-ref (get-post-table font) 'underlinePosition))
+(define (font-underline-thickness font) (hash-ref (get-post-table font) 'underlineThickness))
+(define (font-italic-angle font) (hash-ref (get-post-table font) 'italicAngle))
 
 (define (font-cap-height font)
   (if (has-table? font #"OS/2")
-      (· (get-OS/2-table font) capHeight)
+      (hash-ref (get-OS/2-table font) 'capHeight)
       (font-ascent font)))
 
 (define (font-x-height font)
   (if (has-table? font #"OS/2")
-      (· (get-OS/2-table font) xHeight)
+      (hash-ref (get-OS/2-table font) 'xHeight)
       0))
 
-(test-module
- (check-equal? (font-units-per-em f) 1000)
- (check-equal? (font-ascent f) 980)
- (check-equal? (font-descent f) -238)
- (check-equal? (font-linegap f) 0)
- (check-equal? (font-underline-position f) -178)
- (check-equal? (font-underline-thickness f) 58)
- (check-equal? (font-italic-angle f) 0)
- (check-equal? (font-cap-height f) 671)
- (check-equal? (font-x-height f) 481))
-
 (define (font-bbox font)
   (define head-table (get-head-table font))
-  (+bbox (· head-table xMin) (· head-table yMin) (· head-table xMax) (· head-table yMax)))
-
-(test-module
- (check-equal? (bbox->list (font-bbox f)) '(-161 -236 1193 963)))
+  (+bbox (hash-ref head-table 'xMin) (hash-ref head-table 'yMin)
+         (hash-ref head-table 'xMax) (hash-ref head-table 'yMax)))
 
 (define current-layout-caching (make-parameter #false))
 
@@ -137,6 +116,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 
 
 ;; Returns a GlyphRun object, which includes an array of Glyphs and GlyphPositions for the given string.
+(init-db) ; make sure db is ready for queries
 (define (layout font string [user-features #f] [script #f] [language #f] #:test [test #f])
   #;((string?) ((option/c (listof symbol?)) (option/c symbol?) (option/c symbol?)) . ->*m . GlyphRun?)
   (define (get-layout string)
@@ -166,35 +146,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
               (hb-layout->glyphrun font (get-layout string)))]))
 
 
-;; Returns an array of Glyph objects for the given string.
-;; 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 (glyphs-for-string font string)
-  #;(string? . ->m . (listof glyph?))
-  ;; todo: make this handle UTF-16 with surrogate bytes
-  ;; for now, just use UTF-8
-  (define codepoints (map char->integer (string->list string)))
-  (for/list ([cp (in-list codepoints)])
-            (glyph-for-codepoint font cp)))
-
-;; Maps a single unicode code point to a Glyph object.
-;; Does not perform any advanced substitutions (there is no context to do so).
-(define (glyph-for-codepoint font codepoint)
-  (define glyph-idx (FT_Get_Char_Index (· font ft-face) codepoint))
-  (get-glyph font glyph-idx (list codepoint)))
-
-(define (measure-char-width font char)
-  (define glyph-idx (FT_Get_Char_Index (ft-face font) (char->integer char)))
-  (FT_Load_Glyph (ft-face font) glyph-idx FT_LOAD_NO_RECURSE)
-  (define width (FT_Vector-x (FT_GlyphSlotRec-advance (FT_FaceRec-glyph (ft-face font)))))
-  (* width 1.0))
-
-(define (measure-string font str size)
-  (/ (* size
-        (for/sum ([c (in-string str)])
-                 (measure-char-width font c))) (font-units-per-em font)))
-
 #|
 approximates
 https://github.com/mbutterick/fontkit/blob/master/src/index.js
@@ -231,12 +182,26 @@ https://github.com/mbutterick/fontkit/blob/master/src/base.js
    (error 'create-font "unknown font format")))
 
 (module+ test
-  (require rackunit racket/dict)
-  (check-equal? (measure-string f "f" (font-units-per-em f)) 321.0)
-  (check-true (has-table? f #"cmap"))
-  (check-exn exn:fail:contract? (λ () (get-table f 'nonexistent-table-tag)))
+  (require rackunit)
+  (define charter (open-font charter-path))
+  (define fira (open-font (path->string fira-path)))
+  (define otf (open-font (path->string fira-otf-path)))
+  (check-equal? (font-postscript-name charter) "Charter")
+  (check-equal? (font-units-per-em charter) 1000)
+  (check-equal? (font-ascent charter) 980)
+  (check-equal? (font-descent charter) -238)
+  (check-equal? (font-linegap charter) 0)
+  (check-equal? (font-underline-position charter) -178)
+  (check-equal? (font-underline-thickness charter) 58)
+  (check-equal? (font-italic-angle charter) 0)
+  (check-equal? (font-cap-height charter) 671)
+  (check-equal? (font-x-height charter) 481)
+  (check-equal? (bbox->list (font-bbox charter)) '(-161 -236 1193 963))
+  (check-equal? (caar (hash-ref (layout charter "f" #:test #t) 'hb-positions)) 321)
+  (check-true (has-table? charter #"cmap"))
+  (check-exn exn:fail:contract? (λ () (get-table charter 'nonexistent-table-tag)))
   (check-true
    (let ([h (layout fira "Rifle" #:test #t)])
-     (and (equal? (dict-ref h 'hb-gids) '(227 480 732 412))
-          (equal? (dict-ref h 'hb-clusters) '((82) (105) (102 108) (101)))
-          (equal? (dict-ref h 'hb-positions) '((601 0 0 0 0) (279 0 0 0 0) (580 0 0 0 0) (547 0 0 0 0)))))))
+     (and (equal? (hash-ref h 'hb-gids) '(227 480 732 412))
+          (equal? (hash-ref h 'hb-clusters) '((82) (105) (102 108) (101)))
+          (equal? (hash-ref h 'hb-positions) '((601 0 0 0 0) (279 0 0 0 0) (580 0 0 0 0) (547 0 0 0 0)))))))