diff --git a/pitfall/fontkit/font.rkt b/pitfall/fontkit/font.rkt index fbc0ee2f..c9826ddb 100644 --- a/pitfall/fontkit/font.rkt +++ b/pitfall/fontkit/font.rkt @@ -233,7 +233,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. (define/contract (layout this string [userFeatures #f] [script #f] [language #f]) - ((string?) ((or/c (listof symbol?) #f) (or/c symbol? #f) (or/c symbol? #f)) . ->*m . (is-a?/c GlyphRun)) + ((string?) ((or/c (listof symbol?) #f) (or/c symbol? #f) (or/c symbol? #f)) . ->*m . GlyphRun?) (unless (· this _layoutEngine) (set-field! _layoutEngine this (make-object LayoutEngine this))) (report 'in-layout) diff --git a/pitfall/fontkit/glyph-position.rkt b/pitfall/fontkit/glyph-position.rkt index 34b149ff..16b07f29 100644 --- a/pitfall/fontkit/glyph-position.rkt +++ b/pitfall/fontkit/glyph-position.rkt @@ -1,5 +1,5 @@ #lang fontkit/racket -(provide GlyphPosition) +(provide (all-defined-out)) ;; Represents positioning information for a glyph in a GlyphRun. (define-subclass object% (GlyphPosition diff --git a/pitfall/fontkit/glyphrun.rkt b/pitfall/fontkit/glyphrun.rkt index 07c7f520..5dc0f8e8 100644 --- a/pitfall/fontkit/glyphrun.rkt +++ b/pitfall/fontkit/glyphrun.rkt @@ -1,6 +1,6 @@ #lang fontkit/racket (require "bbox.rkt" "script.rkt") -(provide GlyphRun) +(provide (all-defined-out)) ;; Represents a run of Glyph and GlyphPosition objects. ;; Returned by the font layout method. diff --git a/pitfall/pitfall/embedded.rkt b/pitfall/pitfall/embedded.rkt index 87dd9a65..2dca7cb6 100644 --- a/pitfall/pitfall/embedded.rkt +++ b/pitfall/pitfall/embedded.rkt @@ -28,45 +28,47 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee embed toUnicodeCmap)) -(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))) - #;(* width scale) - (send (· this font) measure-string str size)) +(define/contract (widthOfString this string size [features #f]) + ((string? number?) ((option/c list?)) . ->*m . number?) + (cond + [features + (define run (send (· this font) layout string features)) ; todo: features would be passed here + (define width (· run advanceWidth)) + (define scale (/ size (· this font unitsPerEm))) + (* width scale)] + [else (send (· this font) measure-string string size)])) ;; called from text.rkt (define/contract (encode this text [features #f]) - ((string?) ((or/c list? #f)) . ->*m . - (list/c (listof string?) (listof (is-a?/c GlyphPosition)))) + ((string?) ((option/c list?)) . ->*m . + (list/c (listof string?) (listof GlyphPosition?))) (define glyphRun (send (· this font) layout text features)) (define glyphs (· glyphRun glyphs)) (for ([g (in-list glyphs)]) - (· g id)) + (· g id)) (define positions (· glyphRun positions)) (define-values (subset-idxs new-positions) (for/lists (idxs posns) - ([(glyph i) (in-indexed glyphs)] - [posn (in-list positions)]) - (define gid (send (· this subset) includeGlyph (· glyph id))) - (define subset-idx (toHex gid)) - (set-field! advanceWidth posn (· glyph advanceWidth)) + ([(glyph i) (in-indexed glyphs)] + [posn (in-list positions)]) + (define gid (send (· this subset) includeGlyph (· glyph id))) + (define subset-idx (toHex gid)) + (set-field! advanceWidth posn (· glyph advanceWidth)) - (hash-ref! (· this widths) gid (λ () (· posn advanceWidth))) - (hash-ref! (· this unicode) gid (λ () (· glyph codePoints))) + (hash-ref! (· this widths) gid (λ () (· posn advanceWidth))) + (hash-ref! (· this unicode) gid (λ () (· glyph codePoints))) - (send posn scale (· this scale)) - (values subset-idx posn))) + (send posn scale (· this scale)) + (values subset-idx posn))) (list subset-idxs new-positions)) -(require racket/runtime-path) -(define-runtime-path charter-path "test/assets/charter.ttf") + +(define-macro (sum-flags [COND VAL] ...) + #'(for/sum ([c (in-list (list COND ...))] + [v (in-list (list VAL ...))] + #:when c) + v)) (define/contract (embed this) (->m void?) @@ -79,21 +81,25 @@ For now, we'll just measure width of the characters. (send fontFile end (send (send (· this subset) encodeStream) dump)) (define familyClass (let ([val (if (send (· this font) has-table? 'OS/2) - (· this font OS/2 sFamilyClass) - 0)]) + (· this font OS/2 sFamilyClass) + 0)]) (floor (/ val 256)))) ; equivalent to >> 8 - (define flags (+ - (if (not (zero? (· this font post isFixedPitch))) (expt 2 0) 0) - (if (<= 1 familyClass 7) (expt 2 1) 0) - (expt 2 2) ; assume the font uses non-latin characters - (if (= familyClass 10) (expt 2 3) 0) - (if (· this font head macStyle italic) (expt 2 6) 0))) + ;; font descriptor flags + (match-define (list FIXED_PITCH SERIF SYMBOLIC SCRIPT _UNUSED NONSYMBOLIC ITALIC) + (map (curry expt 2) (range 7))) + + (define flags (sum-flags + [(not (zero? (· this font post isFixedPitch))) FIXED_PITCH] + [(<= 1 familyClass 7) SERIF] + [#t SYMBOLIC] ; assume the font uses non-latin characters + [(= familyClass 10) SCRIPT] + [(· this font head macStyle italic) ITALIC])) ;; generate a random tag (6 uppercase letters. 65 is the char code for 'A') (when (test-mode) (random-seed 0)) (define tag (list->string (for/list ([i (in-range 6)]) - (integer->char (random 65 (+ 65 26)))))) + (integer->char (random 65 (+ 65 26)))))) (define name (string-append tag "+" (· this font postscriptName))) (define bbox (· this font bbox)) @@ -132,7 +138,7 @@ For now, we'll just measure width of the characters. 'Supplement 0) 'FontDescriptor descriptor 'W (list 0 (for/list ([idx (in-range (length (hash-keys (· this widths))))]) - (hash-ref (· this widths) idx (λ () (error 'embed (format "hash key ~a not found" idx))))))))) + (hash-ref (· this widths) idx (λ () (error 'embed (format "hash key ~a not found" idx))))))))) (· descendantFont end) #;(report (· descendantFont toString) 'descendantFont) @@ -152,35 +158,39 @@ For now, we'll just measure width of the characters. (define cmap (· this document ref)) (define entries (for/list ([idx (in-range (length (hash-keys (· this unicode))))]) - (define codePoints (hash-ref (· this unicode) idx)) - (define encoded ; encode codePoints to utf16 - ;; todo: full utf16 support. for now just utf8 - (for/list ([value (in-list codePoints)]) - (toHex value))) - (format "<~a>" (string-join encoded " ")))) - - (send cmap end @string-append{ - /CIDInit /ProcSet findresource begin - 12 dict begin - begincmap - /CIDSystemInfo << - /Registry (Adobe) - /Ordering (UCS) - /Supplement 0 - >> def - /CMapName /Adobe-Identity-UCS def - /CMapType 2 def - 1 begincodespacerange - <0000> - endcodespacerange - 1 beginbfrange - <0000> <@(toHex (sub1 (length entries)))> [@(string-join entries " ")] - endbfrange - endcmap - CMapName currentdict /CMap defineresource pop - end - end - }) + (define codePoints (hash-ref (· this unicode) idx)) + (define encoded ; encode codePoints to utf16 + ;; todo: full utf16 support. for now just utf8 + (for/list ([value (in-list codePoints)]) + (toHex value))) + (format "<~a>" (string-join encoded " ")))) + + (define unicode-cmap-str #<> def +/CMapName /Adobe-Identity-UCS def +/CMapType 2 def +1 begincodespacerange +<0000> +endcodespacerange +1 beginbfrange +<0000> <~a> [~a] +endbfrange +endcmap +CMapName currentdict /CMap defineresource pop +end +end +HERE + ) + + (send cmap end (format unicode-cmap-str (toHex (sub1 (length entries))) (string-join entries " "))) + #;(report (· cmap toString) 'cmap-id) cmap) @@ -188,7 +198,7 @@ For now, we'll just measure width of the characters. (() () #:rest (listof number?) . ->*m . string?) (string-append* (for/list ([code (in-list codePoints)]) - (~r code #:base 16 #:min-width 4 #:pad-string "0")))) + (~r code #:base 16 #:min-width 4 #:pad-string "0")))) (module+ test diff --git a/pitfall/pitfall/pdftest.rkt b/pitfall/pitfall/pdftest.rkt index 5ec9ad75..5d3316d9 100644 --- a/pitfall/pitfall/pdftest.rkt +++ b/pitfall/pitfall/pdftest.rkt @@ -16,10 +16,10 @@ (check-equal? (this->pdfkit-control (string->path "test1crkt.pdf")) (string->path "test1c.pdf"))) -(define-syntax-rule (check-copy-equal? this) - (check-true (for/and ([b1 (in-input-port-bytes (open-input-file this))] - [b2 (in-input-port-bytes (open-input-file (this->control this)))]) - (equal? b1 b2)))) +(define-macro (check-copy-equal? THIS) + (syntax/loc caller-stx (check-true (for/and ([b1 (in-input-port-bytes (open-input-file THIS))] + [b2 (in-input-port-bytes (open-input-file (this->control THIS)))]) + (equal? b1 b2))))) (define-syntax-rule (check-pdfkit? this) diff --git a/pitfall/pitfall/racket.rkt b/pitfall/pitfall/racket.rkt index 9cb42828..9a2246c9 100644 --- a/pitfall/pitfall/racket.rkt +++ b/pitfall/pitfall/racket.rkt @@ -23,7 +23,8 @@ sugar/js sugar/dict sugar/stub - sugar/port) + sugar/port + sugar/contract) (module reader syntax/module-reader #:language 'pitfall/racket diff --git a/pitfall/pitfall/test/out.bin b/pitfall/pitfall/test/out.bin index 6a2b7f04..9a630365 100644 Binary files a/pitfall/pitfall/test/out.bin and b/pitfall/pitfall/test/out.bin differ diff --git a/pitfall/pitfall/test/test14rkt copy 2.pdf b/pitfall/pitfall/test/test14rkt copy 2.pdf new file mode 100644 index 00000000..45b1154d Binary files /dev/null and b/pitfall/pitfall/test/test14rkt copy 2.pdf differ diff --git a/pitfall/pitfall/test/test15.pdf b/pitfall/pitfall/test/test15.pdf index a0eb0757..26a36cda 100644 Binary files a/pitfall/pitfall/test/test15.pdf and b/pitfall/pitfall/test/test15.pdf differ diff --git a/pitfall/pitfall/test/test15.rkt b/pitfall/pitfall/test/test15.rkt index 10912049..7257bc8c 100644 --- a/pitfall/pitfall/test/test15.rkt +++ b/pitfall/pitfall/test/test15.rkt @@ -1,6 +1,6 @@ #lang pitfall/pdftest -(define-runtime-path ttf-path "assets/eqbi.ttf") +(define-runtime-path ttf-path "assets/fira.ttf") (define (proc doc) ;; Register a font name for use later @@ -10,18 +10,11 @@ (send* doc [font "the-font"] [fontSize 25] - [text "Hello World" 100 100 (hash 'width #f)])) + [text "ATAVATA" 100 100 (hash 'width #f)])) ;; test against non-subsetted font version -(define-runtime-path this "test14rkt.pdf") -(make-doc this #f proc #:pdfkit #f) +(define-runtime-path this "test15rkt.pdf") +(make-doc this #f proc #:test #f) -(define-runtime-path that "test14crkt.pdf") -(make-doc that #t proc #:pdfkit #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)) +#;(define-runtime-path that "test14crkt.pdf") +#;(make-doc that #t proc #:pdfkit #f) \ No newline at end of file diff --git a/pitfall/pitfall/test/test15rkt.pdf b/pitfall/pitfall/test/test15rkt.pdf index 74b79659..e69de29b 100644 Binary files a/pitfall/pitfall/test/test15rkt.pdf and b/pitfall/pitfall/test/test15rkt.pdf differ diff --git a/pitfall/sugar/contract.rkt b/pitfall/sugar/contract.rkt new file mode 100644 index 00000000..bc694cfd --- /dev/null +++ b/pitfall/sugar/contract.rkt @@ -0,0 +1,5 @@ +#lang racket/base +(require racket/contract) +(provide (all-defined-out)) + +(define (option/c x) (or/c #f x)) \ No newline at end of file