forging ahead

pitfall/pitfall/embedded.rkt

@@ -2,10 +2,10 @@
 (require "font.rkt")
 (provide EmbeddedFont)
 
-
 (define-subclass PDFFont (EmbeddedFont document font id)
   (super-new)
-  (field [name (· font postscriptName)]
+  (field [subset (· this font createSubset)]
+         [name (· font postscriptName)]
          [scale (/ 1000 (· font unitsPerEm))]
          [ascender (* (· font ascent) scale)]
          [descender (* (· font descent) scale)])
@@ -16,6 +16,10 @@
 
 (define/contract (widthOfString this str size [features #f])
   ((string? number?) ((or/c list? #f)) . ->*m . number?)
+  #|
+PDFKit makes a whole layout here and measures that.
+For now, we'll just measure width of the characters.
+|#
   #;(define run (send (· this font) layout string)) ; todo: features would be passed here
   #;(define width (· run advanceWidth))
   #;(define scale (/ size (· this font unitsPerEm)))
@@ -25,4 +29,12 @@
 ;; called from text.rkt
 (define/contract (encode this text [features #f])
   ((string?) ((or/c list? #f)) . ->*m . list?)
-  (report '(0)))
+  (report '(0)))
+
+(module+ test
+  (require rackunit "fontkit.rkt")
+  (define f (openSync "test/assets/Charter.ttf" #f))
+  (define ef (make-object EmbeddedFont #f f #f))
+  (check-equal? (send ef widthOfString "f" 1000) 321.0)
+  (check-equal? (· ef ascender) 980)
+  (check-equal? (· ef descender) -238))

pitfall/pitfall/font-open.rkt

@@ -1,5 +1,5 @@
 #lang pitfall/racket
-(require "standard-fonts.rkt" "font.rkt" "fontkit.rkt" "embedded.rkt")
+(require "standard-font.rkt" "font.rkt" "fontkit.rkt" "embedded.rkt")
 (provide PDFFont-open)
 
 (define/contract (PDFFont-open document src family id)

pitfall/pitfall/fontkit.rkt

@@ -28,7 +28,12 @@
    measure-string
    unitsPerEm
    ascent
-   descent))
+   descent
+   createSubset))
+
+(define/contract (postscriptName this)
+  (->m string?)
+  (FT_Get_Postscript_Name (· this ft-face)))
 
 (define/contract (unitsPerEm this)
   (->m number?)
@@ -42,9 +47,10 @@
   (->m number?)
   (FT_FaceRec-descender (· this ft-face)))
 
-(define/contract (postscriptName this)
-  (->m string?)
-  (FT_Get_Postscript_Name (· this ft-face)))
+(define/contract (createSubset this)
+  (->m object?)
+(void)
+  )
 
 
 (define/contract (measure-char-width this char)

pitfall/pitfall/freetype-ffi.rkt

@@ -242,12 +242,26 @@
 
 (define-freetype FT_Get_Postscript_Name (_fun _FT_Face -> _string))
 
+(define-freetype FT_Load_Sfnt_Table (_fun _FT_Face _FT_ULong _FT_Long
+                                          (buffer : (_ptr o _FT_Byte))
+                                          (len : (_ptr o _FT_ULong))
+                                          -> (err : _FT_Error)
+                                          -> (and (zero? err) (list buffer len))))
+
+(define (tag->int tag)
+  (define signed? #f)
+  (define big-endian? #t)
+  (integer-bytes->integer tag signed? big-endian?))
+
 (module+ test
   (require rackunit)
   (define ft-library (FT_Init_FreeType))
   (define face (FT_New_Face ft-library "test/assets/charter.ttf" 0))
   (check-equal? (FT_Get_Postscript_Name face) "Charter")
-  (check-equal? (FT_FaceRec-units_per_EM face) 1000))
+  (check-equal? (FT_FaceRec-units_per_EM face) 1000)
+  (FT_Load_Sfnt_Table face (tag->int #"cmap") 0)
+
+  )
 
 
          

pitfall/pitfall/standard-font.rkt

@@ -1,5 +1,5 @@
 #lang pitfall/racket
-(require  "afm.rkt" "font.rkt")
+(require "afm-font.rkt" "font.rkt")
 (require racket/runtime-path (for-syntax racket/base racket/path racket/syntax sugar/debug))
 (provide isStandardFont standard-fonts StandardFont)
 

pitfall/pitfall/text.rkt

@@ -57,7 +57,7 @@
          (error 'unimplemented-branch-of-_text)] ; todo
       [else ; render paragraphs as single lines
        (for ([line (in-list (string-split text "\n"))])
-         (lineCallback line options))]))
+            (lineCallback line options))]))
   
   this)
 
@@ -82,7 +82,7 @@
     (when (· this _textOptions)
       (for ([(key val) (in-hash (· this _textOptions))]
             #:unless (equal? (key "continued")))
-        (hash-ref! options key val)))
+           (hash-ref! options key val)))
 
     ;; Update the current position
     (when x (set-field! x this x))
@@ -182,10 +182,10 @@
   ;; If we have a word spacing value, we need to encode each word separately
   ;; since the normal Tw operator only works on character code 32, which isn't
   ;; used for embedded fonts.
-  (match-define (list encoded positions)
-    (cond
-      [(not (zero? wordSpacing)) (error 'unimplemented-brach)] ; todo
-      [else (send (· this _font) encode text (hash-ref options 'features #f))]))
+  (match-define (list encoded-char-strs positions)
+    (if (not (zero? wordSpacing))
+        (error 'unimplemented-brach) ; todo
+        (send (· this _font) encode text (hash-ref options 'features #f))))
 
   (define scale (/ (· this _fontSize) 1000.0))
   (define commands empty)
@@ -194,7 +194,7 @@
   ;; Adds a segment of text to the TJ command buffer
   (define (addSegment cur)
     (when (< last cur)
-      (let* ([hex (string-append* (sublist encoded last cur))]
+      (let* ([hex (string-append* (sublist encoded-char-strs last cur))]
              [posn (list-ref positions (sub1 cur))]
              [advance (- (· posn xAdvance) (· posn advanceWidth))])
         (push-end! commands (format "<~a> ~a" hex (number (- advance))))))