diff --git a/pitfall/fontkit/font.rkt b/pitfall/fontkit/font.rkt index 5bb6cf76..9e184e49 100644 --- a/pitfall/fontkit/font.rkt +++ b/pitfall/fontkit/font.rkt @@ -209,6 +209,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js ;; provides a much more advanced mapping supporting AAT and OpenType shaping. (define/contract (glyphsForString this string) (string? . ->m . (listof (is-a?/c Glyph))) + (report string 'glyphs-for-string) ;; todo: make this handle UTF-16 with surrogate bytes ;; for now, just use UTF-8 @@ -221,7 +222,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js ;; Does not perform any advanced substitutions (there is no context to do so). (define/contract (glyphForCodePoint this codePoint) (index? . ->m . (is-a?/c Glyph)) + (report codePoint 'glyphs-for-codepoint-cp) (define glyph-idx (FT_Get_Char_Index (· this ft-face) codePoint)) + (report glyph-idx 'glyphs-for-codepoint-idx) (send this getGlyph glyph-idx (list codePoint))) diff --git a/pitfall/fontkit/freetype-ffi.rkt b/pitfall/fontkit/freetype-ffi.rkt index aeaa8237..7e9c3c7d 100644 --- a/pitfall/fontkit/freetype-ffi.rkt +++ b/pitfall/fontkit/freetype-ffi.rkt @@ -352,6 +352,11 @@ (define-freetype FT_Get_Sfnt_Table (_fun _FT_Face _FT_Gettable_Sfnt_Tag -> (p : (_cpointer/null 'table-ptr)) -> (or p (error 'sfnt-table-not-loaded)))) + +(define-freetype FT_Select_Charmap (_fun _FT_Face _FT_Encoding + -> (err : _FT_Error) + -> (and (zero? err) #t))) + (provide tag->int) (define (tag->int tag) (define signed? #f) @@ -361,7 +366,7 @@ (module+ test (require rackunit) (define ft-library (FT_Init_FreeType)) - (define face (FT_New_Face ft-library "test/assets/charter.ttf" 0)) + (define face (FT_New_Face ft-library "../pitfall/test/assets/charter.ttf" 0)) (check-equal? (FT_Get_Postscript_Name face) "Charter") (check-equal? (FT_FaceRec-units_per_EM face) 1000) (check-true (FT_Load_Sfnt_Table face (tag->int #"cmap") 0 0 0)) diff --git a/pitfall/fontkit/layout-engine.rkt b/pitfall/fontkit/layout-engine.rkt index 08615d91..0043be59 100644 --- a/pitfall/fontkit/layout-engine.rkt +++ b/pitfall/fontkit/layout-engine.rkt @@ -2,6 +2,11 @@ (require "script.rkt" "glyph.rkt" "glyphrun.rkt" "glyph-position.rkt") (provide LayoutEngine) +#| +approximates +https://github.com/mbutterick/fontkit/blob/master/src/layout/LayoutEngine.js +|# + (define-subclass object% (LayoutEngine font) (field [unicodeLayoutEngine #f] [kernProcessor #f] @@ -13,7 +18,7 @@ (cond [(· this font has-morx-table?) (error 'morx-layout-unimplemented)] [(or (· this font has-gsub-table?) (· this font has-gpos-table?)) - (error 'ot-layout-unimplemented)] + (displayln 'warning:ot-layout-unimplemented) #f] [else #f])]) (as-methods diff --git a/pitfall/fontkit/subset.rkt b/pitfall/fontkit/subset.rkt index cc9ac830..e04605fe 100644 --- a/pitfall/fontkit/subset.rkt +++ b/pitfall/fontkit/subset.rkt @@ -25,6 +25,7 @@ https://github.com/devongovett/fontkit/blob/master/src/subset/Subset.js (define/contract (includeGlyph this glyph) ((or/c object? index?) . ->m . index?) (let ([glyph (if (object? glyph) (· glyph id) glyph)]) + (report* glyph (· this mapping)) (hash-ref! (· this mapping) glyph (λ () ;; put the new glyph at the end of `glyphs`, diff --git a/pitfall/fontkit/ttfglyph.rkt b/pitfall/fontkit/ttfglyph.rkt index 63d49f9a..1e956222 100644 --- a/pitfall/fontkit/ttfglyph.rkt +++ b/pitfall/fontkit/ttfglyph.rkt @@ -16,29 +16,31 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js 'yMax int16be))) ;; Flags for simple glyphs -(match-define (list ON_CURVE - X_SHORT_VECTOR - Y_SHORT_VECTOR - REPEAT - SAME_X - SAME_Y) - (map (curry expt 2) (range 6))) +(define-macro (define-flag-series . IDS) + #`(match-define (list . IDS) (map (curry expt 2) (range #,(length (syntax->list #'IDS)))))) + +;; Flags for simple glyphs +(define-flag-series ON_CURVE + X_SHORT_VECTOR + Y_SHORT_VECTOR + REPEAT + SAME_X + SAME_Y) ;; Flags for composite glyphs -(match-define (list ARG_1_AND_2_ARE_WORDS - ARGS_ARE_XY_VALUES - ROUND_XY_TO_GRID - WE_HAVE_A_SCALE - ___NO-FLAG___ - MORE_COMPONENTS - WE_HAVE_AN_X_AND_Y_SCALE - WE_HAVE_A_TWO_BY_TWO - WE_HAVE_INSTRUCTIONS - USE_MY_METRICS - OVERLAP_COMPOUND - SCALED_COMPONENT_OFFSET - UNSCALED_COMPONENT_OFFSET) - (map (curry expt 2) (range 13))) +(define-flag-series ARG_1_AND_2_ARE_WORDS + ARGS_ARE_XY_VALUES + ROUND_XY_TO_GRID + WE_HAVE_A_SCALE + __EMPTY-FLAG___ + MORE_COMPONENTS + WE_HAVE_AN_X_AND_Y_SCALE + WE_HAVE_A_TWO_BY_TWO + WE_HAVE_INSTRUCTIONS + USE_MY_METRICS + OVERLAP_COMPOUND + SCALED_COMPONENT_OFFSET + UNSCALED_COMPONENT_OFFSET) ;; Represents a point in a simple glyph (define-subclass object% (Point onCurve endContour [x 0] [y 0]) @@ -52,8 +54,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js [scaleX 1] [scaleY 1] [scale01 0] - [scale10 0]) - ) + [scale10 0])) ;; Represents a TrueType glyph. (define-subclass Glyph (TTFGlyph) @@ -65,6 +66,12 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js ;; Parses a single glyph coordinate (define/public (_parseGlyphCoord stream prev short same) + (unless (DecodeStream? stream) + (raise-argument-error '_parseGlyphCoord "DecodeStream" stream)) + (unless (number? prev) + (raise-argument-error '_parseGlyphCoord "number" prev)) + (unless (and (boolean? short) (boolean? same)) + (raise-argument-error '_parseGlyphCoord "booleans" (list short same))) (+ prev (if short ((if (not same) - +) (send uint8 decode stream)) (if same 0 (send int16be decode stream))))) @@ -73,28 +80,20 @@ 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 (hash-ref (send _font _getTable 'loca) 'offsets)) - (define glyfPos (list-ref offsets id)) - (define nextPos (list-ref offsets (add1 id))) + (define offsets (· (send _font _getTable 'loca) offsets)) + (match-define (list glyfPos nextPos) (take (drop offsets id) 2)) ;; Nothing to do if there is no data for this glyph - (cond - [(= glyfPos nextPos) #f] - [else - (define stream (send _font _getTableStream 'glyf)) - (send stream pos (+ (send stream pos) glyfPos)) - (define startPos (· stream pos)) - - (define glyph (send GlyfHeader decode stream)) - - (let ([contour-count (· glyph numberOfContours)]) - (cond - [(positive? contour-count) - (_decodeSimple glyph stream)] - [(negative? contour-count) - (_decodeComposite glyph stream startPos)])) - - glyph])) + (and (not (= glyfPos nextPos)) + (let () + (define stream (send _font _getTableStream 'glyf)) + (send stream pos (+ (send stream pos) glyfPos)) + (define startPos (· stream pos)) + (define glyph (send GlyfHeader decode stream)) + (match (· glyph numberOfContours) + [(? positive?) (_decodeSimple glyph stream)] + [(? negative?) (_decodeComposite glyph stream startPos)]) + glyph))) (define/public (_decodeSimple glyph stream) (unless (hash? glyph) @@ -105,49 +104,31 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js ;; this is a simple glyph (hash-set! glyph 'points empty) - (define endPtsOfContours (send (+Array uint16be (· glyph numberOfContours)) decode stream)) - (hash-set! glyph 'instructions (send (+Array uint8be uint16be) decode stream)) - - (define numCoords (add1 (list-ref endPtsOfContours (sub1 (length endPtsOfContours))))) + (define numCoords (add1 (last endPtsOfContours))) (define flags - (reverse - (for/fold ([flags empty]) - ([i (in-naturals)] - #:break (= (length flags) numCoords)) - (define flag (send uint8 decode stream)) - - ;; check for repeat flag - (define repeated-flags - (cond - [(not (zero? (bitwise-and flag REPEAT))) - (define count (send uint8 decode stream)) - (make-list count flag)] - [else empty])) - - (append repeated-flags (cons flag flags))))) - - (define glyph-points (mhash)) - (for ([(flag i) (in-indexed flags)]) - (define point (+Point (zero? (bitwise-and flag ON_CURVE)) (and (index-of endPtsOfContours i) #t) 0 0)) - (hash-set! glyph-points i point)) - - (for/fold ([px 0]) - ([(flag i) (in-indexed flags)]) - (define next-px (_parseGlyphCoord stream px (bitwise-and flag X_SHORT_VECTOR) (bitwise-and flag SAME_X))) - (set-field! x (hash-ref glyph-points i) next-px) - next-px) - - (for/fold ([py 0]) - ([(flag i) (in-indexed flags)]) - (define next-py (_parseGlyphCoord stream py (bitwise-and flag Y_SHORT_VECTOR) (bitwise-and flag SAME_Y))) - (set-field! y (hash-ref glyph-points i) next-py) - next-py) - - ;; skip variations shit - ) + (for*/lists (flags) + ([i (in-naturals)] + #:break (= (length flags) numCoords) + [flag (in-value (send uint8 decode stream))] + [count (in-range (add1 (if (not (zero? (bitwise-and flag REPEAT))) + (send uint8 decode stream) + 0)))]) + flag)) + + (match-define-values + (points _ _) + (for/fold ([points empty] [px 0] [py 0]) + ([(flag i) (in-indexed flags)]) + (define point (+Point (zero? (bitwise-and flag ON_CURVE)) (and (index-of endPtsOfContours i) #t) 0 0)) + (define next-px (_parseGlyphCoord stream px (not (zero? (bitwise-and flag X_SHORT_VECTOR))) (not (zero? (bitwise-and flag SAME_X))))) + (define next-py (_parseGlyphCoord stream py (not (zero? (bitwise-and flag Y_SHORT_VECTOR))) (not (zero? (bitwise-and flag SAME_Y))))) + (set-field! x point next-px) + (set-field! y point next-py) + (values (cons point points) next-px next-py))) + (hash-set! glyph 'points (reverse points))) (define/public (_decodeComposite glyph stream [offset 0]) ;; this is a composite glyph @@ -185,11 +166,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js (set-field! scale01 component (read-fixed14 stream)) (set-field! scale10 component (read-fixed14 stream)) (set-field! scaleY component (read-fixed14 stream))]) - component)) - - haveInstructions - )) + haveInstructions)) (define (bytes->fixed14 b1 b2) diff --git a/pitfall/pitfall/alltest.rkt b/pitfall/pitfall/alltest.rkt index f53c3f0c..c3e4ab10 100644 --- a/pitfall/pitfall/alltest.rkt +++ b/pitfall/pitfall/alltest.rkt @@ -12,7 +12,7 @@ pitfall/test/test09 pitfall/test/test10 pitfall/test/test11 - pitfall/test/test12 - pitfall/test/test13 + pitfall/test/test12 ; ttf subset + pitfall/test/test13 ; subset with composites pitfall/page-test (submod pitfall/zlib test))) \ No newline at end of file diff --git a/pitfall/pitfall/embedded.rkt b/pitfall/pitfall/embedded.rkt index 74c5b368..8c0ad9d9 100644 --- a/pitfall/pitfall/embedded.rkt +++ b/pitfall/pitfall/embedded.rkt @@ -45,8 +45,10 @@ For now, we'll just measure width of the characters. (define/contract (encode this text [features #f]) ((string?) ((or/c list? #f)) . ->*m . (list/c (listof string?) (listof (is-a?/c GlyphPosition)))) - (define glyphRun (send (· this font) layout text features)) + (define glyphRun (send (· this font) layout (report text) features)) (define glyphs (· glyphRun glyphs)) + (for ([g (in-list glyphs)]) + (report (· g id))) (define positions (· glyphRun positions)) (define-values (subset-idxs new-positions) (for/lists (idxs posns) @@ -74,7 +76,6 @@ For now, we'll just measure width of the characters. (when isCFF (hash-set! (· fontFile payload) 'Subtype "CIDFontType0C")) - #;(send (send (· this subset) encodeStream) pipe fontFile) (send fontFile end (send (send (· this subset) encodeStream) dump)) (define familyClass (let ([val (if (send (· this font) has-table? 'OS/2) diff --git a/pitfall/pitfall/test/assets/Tahoma.ttf b/pitfall/pitfall/test/assets/Tahoma.ttf new file mode 100644 index 00000000..d204f958 Binary files /dev/null and b/pitfall/pitfall/test/assets/Tahoma.ttf differ diff --git a/pitfall/pitfall/test/assets/eqbi.ttf b/pitfall/pitfall/test/assets/eqbi.ttf new file mode 100644 index 00000000..c97f523a Binary files /dev/null and b/pitfall/pitfall/test/assets/eqbi.ttf differ diff --git a/pitfall/pitfall/test/assets/input.ttf b/pitfall/pitfall/test/assets/input.ttf new file mode 100644 index 00000000..bb7b534e Binary files /dev/null and b/pitfall/pitfall/test/assets/input.ttf differ diff --git a/pitfall/pitfall/test/test13crkt.pdf b/pitfall/pitfall/test/test13crkt.pdf index 5f206284..cce12119 100644 Binary files a/pitfall/pitfall/test/test13crkt.pdf and b/pitfall/pitfall/test/test13crkt.pdf differ diff --git a/pitfall/pitfall/test/test13rkt.pdf b/pitfall/pitfall/test/test13rkt.pdf index 996a1a14..c540795f 100644 Binary files a/pitfall/pitfall/test/test13rkt.pdf and b/pitfall/pitfall/test/test13rkt.pdf differ diff --git a/pitfall/pitfall/test/test14.rkt b/pitfall/pitfall/test/test14.rkt new file mode 100644 index 00000000..7208310f --- /dev/null +++ b/pitfall/pitfall/test/test14.rkt @@ -0,0 +1,27 @@ +#lang pitfall/pdftest + +(define-runtime-path ttf-path "assets/Tahoma.ttf") + +(define (proc doc) + ;; Register a font name for use later + (send doc registerFont "the-font" (path->string ttf-path)) + + ;; Set the font, draw some text + (send* doc + [font "the-font"] + [fontSize 25] + [text "H" 100 100 (hash 'width #f)])) + +;; test against non-subsetted font version +(define-runtime-path this "test14rkt.pdf") +(make-doc this #f proc #:test #f) + +#;(define-runtime-path that "test14crkt.pdf") +#;(make-doc that #t proc #:test #f) + +#;(module+ test + (define doc (make-object PDFDocument)) + (send doc registerFont "Charter" (path->string charter-path)) + (send* doc [font "Charter"]) + (send doc pipe (open-output-string)) + (send doc end)) diff --git a/pitfall/pitfall/test/test14crkt.pdf b/pitfall/pitfall/test/test14crkt.pdf new file mode 100644 index 00000000..c9139729 Binary files /dev/null and b/pitfall/pitfall/test/test14crkt.pdf differ diff --git a/pitfall/pitfall/test/test14rkt.pdf b/pitfall/pitfall/test/test14rkt.pdf new file mode 100644 index 00000000..9db2c7a9 Binary files /dev/null and b/pitfall/pitfall/test/test14rkt.pdf differ