structify glyph position

fontland/fontland/font.rkt

@@ -5,7 +5,7 @@
          "subset.rkt"
          "glyph.rkt"
          "bbox.rkt"
-         (except-in "glyphrun.rkt" advanceWidth)
+         "glyphrun.rkt"
          "directory.rkt"
          "db.rkt"
          xenomorph
@@ -274,7 +274,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
                               (send this getGlyph gidx cluster)))
      (define positions (for/list ([pos (in-list posns)])
                                  (match pos
-                                   [(list xad yad xoff yoff _) (+GlyphPosition xad yad xoff yoff)])))
+                                   [(list xad yad xoff yoff _) (+glyph-position xad yad xoff yoff)])))
      (glyphrun glyphs positions)]))
 
 

fontland/fontland/glyph-position.rkt

@@ -1,12 +1,8 @@
 #lang racket/base
-(require sugar/unstable/class
-         sugar/unstable/js
-         racket/class
-         racket/contract)
 (provide (all-defined-out))
 
 ;; Represents positioning information for a glyph in a GlyphRun.
-(define-subclass object% (GlyphPosition
+#;(define-subclass object% (GlyphPosition
                           ;; The amount to move the virtual pen in the X direction after rendering this glyph.
                           [xAdvance 0]
                           ;; The amount to move the virtual pen in the Y direction after rendering this glyph.
@@ -22,12 +18,22 @@
    scale)
   )
 
+(struct glyph-position (x-advance y-advance x-offset y-offset advance-width) #:transparent #:mutable)
 
-(define/contract (scale this factor)
-  (number? . ->m . (is-a?/c GlyphPosition))
-  (set-field! xAdvance this (* factor (· this xAdvance)))
-  (set-field! yAdvance this (* factor (· this yAdvance)))
-  (set-field! xOffset this (* factor (· this xOffset)))
-  (set-field! yOffset this (* factor (· this yOffset)))
-  (set-field! advanceWidth this (* factor (· this advanceWidth)))
-  this)
+(define (+glyph-position [x-advance 0] [y-advance 0] [x-offset 0] [y-offset 0] [advance-width 0])
+  (glyph-position x-advance y-advance x-offset y-offset advance-width))
+
+(define (scale-glyph-position! gp factor)
+  #;(number? . ->m . (is-a?/c GlyphPosition))
+  (set-glyph-position-x-advance! gp (* factor (glyph-position-x-advance gp)))
+  (set-glyph-position-y-advance! gp (* factor (glyph-position-y-advance gp)))
+  (set-glyph-position-x-offset! gp (* factor (glyph-position-x-offset gp)))
+  (set-glyph-position-y-offset! gp (* factor (glyph-position-y-offset gp)))
+  (set-glyph-position-advance-width! gp (* factor (glyph-position-advance-width gp)))
+  gp)
+
+(module+ test
+  (require rackunit)
+  (define gp (+glyph-position 1 2 3 4))
+  (check-true (glyph-position? gp))
+  (check-equal? (scale-glyph-position! gp 2) (+glyph-position 2 4 6 8 0)))

fontland/fontland/glyphrun.rkt

@@ -1,8 +1,7 @@
 #lang racket/base
-(require (prefix-in Script- "script.rkt")
-         sugar/unstable/class
-         sugar/unstable/js
-         racket/class)
+(require sugar/unstable/js
+         racket/class
+         "glyph-position.rkt")
 (provide (all-defined-out))
 
 #|
@@ -10,30 +9,29 @@ approximates
 https://github.com/mbutterick/fontkit/blob/master/src/layout/GlyphRun.js
 |#
 
+
 ;; Represents a run of Glyph and GlyphPosition objects.
 ;; Returned by the font layout method.
-#;(define-subclass object% (GlyphRun
-                            glyphs ; An array of Glyph objects in the run
-                            positions) ; An array of GlyphPosition objects for each glyph in the run
-
-
-    (define/public (advanceWidth)
-      (for/sum ([pos (in-list positions)])
-               (· pos xAdvance))))
-
-
+; An array of Glyph objects in the run
+; An array of GlyphPosition objects for each glyph in the run
 (struct glyphrun (glyphs positions) #:transparent)
 
-(define (advanceWidth gr)
+(define (glyphrun-advance-width gr)
   (for/sum ([pos (in-list (glyphrun-positions gr))])
-           (· pos xAdvance)))
+           (glyph-position-x-advance pos)))
 
 (define (append-glyphruns . grs)
   (for/fold ([glyphss null]
              [positionss null]
-             #:result (make-object glyphrun
+             #:result (glyphrun
                         (apply append (reverse glyphss))
                         (apply append (reverse positionss))))
             ([gr (in-list grs)])
-    (values (cons (get-field glyphs gr) glyphss)
-            (cons (get-field positions gr) positionss))))
+    (values (cons (glyphrun-glyphs gr) glyphss)
+            (cons (glyphrun-positions gr) positionss))))
+
+(module+ test
+  (require rackunit)
+  (define gr (glyphrun null null))
+  (check-true (glyphrun? gr))
+  (check-equal? (append-glyphruns gr gr) gr))