From 20e9f951734215cf6e145829295329d3beb42665 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 29 May 2017 20:09:30 -0700 Subject: [PATCH] forging ahead --- pitfall/pitfall/{afm.rkt => afm-font.rkt} | 0 pitfall/pitfall/embedded.rkt | 18 +++++++++++++++--- pitfall/pitfall/font-open.rkt | 2 +- pitfall/pitfall/fontkit.rkt | 14 ++++++++++---- pitfall/pitfall/freetype-ffi.rkt | 16 +++++++++++++++- .../{standard-fonts.rkt => standard-font.rkt} | 2 +- pitfall/pitfall/text.rkt | 14 +++++++------- 7 files changed, 49 insertions(+), 17 deletions(-) rename pitfall/pitfall/{afm.rkt => afm-font.rkt} (100%) rename pitfall/pitfall/{standard-fonts.rkt => standard-font.rkt} (98%) diff --git a/pitfall/pitfall/afm.rkt b/pitfall/pitfall/afm-font.rkt similarity index 100% rename from pitfall/pitfall/afm.rkt rename to pitfall/pitfall/afm-font.rkt diff --git a/pitfall/pitfall/embedded.rkt b/pitfall/pitfall/embedded.rkt index bc03291f..4cbe82c8 100644 --- a/pitfall/pitfall/embedded.rkt +++ b/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))) \ No newline at end of file + (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)) \ No newline at end of file diff --git a/pitfall/pitfall/font-open.rkt b/pitfall/pitfall/font-open.rkt index 61edf046..cf3c48de 100644 --- a/pitfall/pitfall/font-open.rkt +++ b/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) diff --git a/pitfall/pitfall/fontkit.rkt b/pitfall/pitfall/fontkit.rkt index 6f0888f9..84345e36 100644 --- a/pitfall/pitfall/fontkit.rkt +++ b/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) diff --git a/pitfall/pitfall/freetype-ffi.rkt b/pitfall/pitfall/freetype-ffi.rkt index afbbc1bf..867830f6 100644 --- a/pitfall/pitfall/freetype-ffi.rkt +++ b/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) + + ) diff --git a/pitfall/pitfall/standard-fonts.rkt b/pitfall/pitfall/standard-font.rkt similarity index 98% rename from pitfall/pitfall/standard-fonts.rkt rename to pitfall/pitfall/standard-font.rkt index b0639b06..563222ef 100644 --- a/pitfall/pitfall/standard-fonts.rkt +++ b/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) diff --git a/pitfall/pitfall/text.rkt b/pitfall/pitfall/text.rkt index 02016633..3f4143e6 100644 --- a/pitfall/pitfall/text.rkt +++ b/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))))))