mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

minor refactor

Browse Source
main
Matthew Butterick 5 years ago
parent 81bc91d158
commit 18b058e451
8 changed files with 515 additions and 602 deletions
Show Stats Download Patch File Download Diff File

169
fontland/fontland/cff-glyph.rkt
Unescape Escape View File

@ -18,6 +18,28 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
[(< (length s) 33900) 1131] [(< (length s) 33900) 1131]
[else 32768])) [else 32768]))
(define-syntax-rule (shift ID)
(begin0
(car ID)
(set! ID (cdr ID))))
(define-syntax-rule (push ID VAL ...)
(begin
(set! ID (append ID (list VAL ...)))
ID))
(define-syntax-rule (pop ID)
(cond
[(> (length ID) 0)
(define-values (head last) (split-at-right ID 1))
(set! ID head)
(car last)]))
(define-syntax-rule (case= ID [(NUMS ...) . BODY] ... [else . ELSEBODY])
(cond
[(memq ID (list NUMS ...)) . BODY] ...
[else . ELSEBODY]))
(define (getPath this) (define (getPath this)
(define stream (ttf-font-port (glyph-font this))) (define stream (ttf-font-port (glyph-font this)))
;;;(define pos (pos stream)) ;;;(define pos (pos stream))
@ -52,38 +74,17 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
#;(define vsindex (hash-ref privateDict 'vsindex)) #;(define vsindex (hash-ref privateDict 'vsindex))
#;(define variationProcessor ) #;(define variationProcessor )
(define-syntax-rule (shift ID) (define (check-width)
(begin0
(car ID)
(set! ID (cdr ID))))
(define-syntax-rule (push ID VAL ...)
(begin
(set! ID (append ID (list VAL ...)))
ID))
(define-syntax-rule (pop ID)
(cond
[(> (length ID) 0)
(define-values (head last) (split-at-right ID 1))
(set! ID head)
(car last)]))
(define (checkWidth)
(unless width (unless width
(set! width (+ (shift stack) (hash-ref privateDict 'nominalWidthX))))) (set! width (+ (shift stack) (hash-ref privateDict 'nominalWidthX)))))
(define (parseStems) (define (parse-stems)
(when (not (zero? (modulo (length stack) 2))) (when (odd? (length stack)) (check-width))
(checkWidth))
(set! nStems (+ nStems (arithmetic-shift (length stack) -1))) (set! nStems (+ nStems (arithmetic-shift (length stack) -1)))
(set! stack null) (set! stack null))
(length stack))
(define (moveTo x y) (define (moveTo x y)
(when open (when open (path-closePath path))
(path-closePath path))
(path-moveTo path x y) (path-moveTo path x y)
(set! open #true)) (set! open #true))
@ -94,15 +95,15 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
(define op (read-byte stream)) (define op (read-byte stream))
(cond (cond
[(< op 32) [(< op 32)
(case op (case= op
[(1 ;; hstem [(1 ;; hstem
3 ;; vstem 3 ;; vstem
18 ;; hstemhm 18 ;; hstemhm
23) ;; vstemhm 23) ;; vstemhm
(parseStems)] (parse-stems)]
[(4) ;; vmoveto [(4) ;; vmoveto
(when (> (length stack) 1) (when (> (length stack) 1)
(checkWidth)) (check-width))
(set! y (+ y (shift stack))) (set! y (+ y (shift stack)))
(moveTo x y)] (moveTo x y)]
[(5) ;; rlineto [(5) ;; rlineto
@ -153,7 +154,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
[(>= (hash-ref cff 'version) 2) (void)] [(>= (hash-ref cff 'version) 2) (void)]
[else [else
(when (> (length stack) 0) (when (> (length stack) 0)
(checkWidth)) (check-width))
(when open (when open
(path-closePath path) (path-closePath path)
(set! open #false))])] (set! open #false))])]
@ -166,12 +167,12 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
[(19 ;; hintmask [(19 ;; hintmask
20) ;; cntrmask 20) ;; cntrmask
(parseStems) (parse-stems)
(pos stream (+ (pos stream) (arithmetic-shift (+ nStems 7) -3)))] (pos stream (+ (pos stream) (arithmetic-shift (+ nStems 7) -3)))]
[(21) ;; rmoveto [(21) ;; rmoveto
(when (> (length stack) 2) (when (> (length stack) 2)
(checkWidth)) (check-width))
(set! x (+ x (shift stack))) (set! x (+ x (shift stack)))
(set! y (+ y (shift stack))) (set! y (+ y (shift stack)))
@ -179,7 +180,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
[(22) ;; hmoveto [(22) ;; hmoveto
(when (> (length stack) 1) (when (> (length stack) 1)
(checkWidth)) (check-width))
(set! x (+ x (shift stack))) (set! x (+ x (shift stack)))
(moveTo x y)] (moveTo x y)]
@ -217,7 +218,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
(path-bezierCurveTo path c1x c1y c2x c2y x y)] (path-bezierCurveTo path c1x c1y c2x c2y x y)]
[(26) ;; vvcurveto [(26) ;; vvcurveto
(when (not (zero? (modulo (length stack) 2))) (when (odd? (length stack))
(set! x (+ x (shift stack)))) (set! x (+ x (shift stack))))
(let loop () (let loop ()
@ -232,7 +233,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
(loop)))] (loop)))]
[(27) ;; hhcurveto [(27) ;; hhcurveto
(when (not (zero? (modulo (length stack) 2))) (when (odd? (length stack))
(set! y (+ y (shift stack)))) (set! y (+ y (shift stack))))
(let loop () (let loop ()
@ -267,71 +268,47 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
(define phase (= op 31)) (define phase (= op 31))
(let loop () (let loop ()
(when (>= (length stack) 4) (when (>= (length stack) 4)
(cond (match-define (list c1x c1y)
[phase (if phase
(define c1x (+ x (shift stack))) (list (+ x (shift stack)) y)
(define c1y y) (list x (+ y (shift stack)))))
(define c2x (+ c1x (shift stack))) (define c2x (+ c1x (shift stack)))
(define c2y (+ c1y (shift stack))) (define c2y (+ c1y (shift stack)))
(set! y (+ c2y (shift stack))) (set! y (+ c2y (shift stack)))
(set! x (+ c2x (if (= (length stack) 1) (shift stack) 0))) (set! x (+ c2x (if (= (length stack) 1) (shift stack) 0)))
(path-bezierCurveTo path c1x c1y c2x c2y x y) (path-bezierCurveTo path c1x c1y c2x c2y x y)
(set! phase (not phase))] (set! phase (not phase))
[else
(define c1x x)
(define c1y (+ y (shift stack)))
(define c2x (+ c1x (shift stack)))
(define c2y (+ c1y (shift stack)))
(set! x (+ c2x (shift stack)))
(set! y (+ c2y (if (= (length stack) 1) (shift stack) 0)))
(path-bezierCurveTo path c1x c1y c2x c2y x y)
(set! phase (not phase))])
(loop)))] (loop)))]
[(12) [(12)
(define op (read-byte stream)) (define op (read-byte stream))
(println "warning: check truthiness") (println "warning: check truthiness")
(case op (case= op
[(3) ;; and [(3) ;; and
(define a (pop stack)) (push stack (if (and (pop stack) (pop stack)) 1 0))]
(define b (pop stack))
(push stack (if (and a b) 1 0))]
[(4) ;; or [(4) ;; or
(define a (pop stack)) (push stack (if (or (pop stack) (pop stack)) 1 0))]
(define b (pop stack))
(push stack (if (or a b) 1 0))]
[(5) ;; not [(5) ;; not
(define a (pop stack)) (push stack (if (pop stack) 0 1))]
(push stack (if a 0 1))]
[(9) ;; abs [(9) ;; abs
(define a (pop stack)) (push stack (abs (pop stack)))]
(push stack (abs a))]
[(10) ;; add [(10) ;; add
(define a (pop stack)) (push stack (+ (pop stack) (pop stack)))]
(define b (pop stack))
(push stack (+ a b))]
[(11) ;; sub [(11) ;; sub
(define a (pop stack)) (push stack (- (pop stack) (pop stack)))]
(define b (pop stack))
(push stack (- a b))]
[(12) ;; div [(12) ;; div
(define a (pop stack)) (push stack (/ (pop stack) (pop stack) 1.0))]
(define b (pop stack))
(push stack (/ a b 1.0))]
[(14) ;; neg [(14) ;; neg
(define a (pop stack)) (push stack (- (pop stack)))]
(push stack (- a))]
[(15) ;; eq [(15) ;; eq
(define a (pop stack)) (push stack (if (- (pop stack) (pop stack)) 1 0))]
(define b (pop stack))
(push stack (if (- a b) 1 0))]
[(18) ;; drop [(18) ;; drop
(pop stack)] (pop stack)]
@ -342,8 +319,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
(set! trans (list-set trans idx val))] (set! trans (list-set trans idx val))]
[(21) ;; get [(21) ;; get
(define idx (pop stack)) (push stack (or (list-ref trans (pop stack)) 0))]
(push stack (or (list-ref trans idx) 0))]
[(22) ;; ifelse [(22) ;; ifelse
(define s1 (pop stack)) (define s1 (pop stack))
@ -356,13 +332,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
(push stack (random))] (push stack (random))]
[(24) ;; mul [(24) ;; mul
(define a (pop stack)) (push stack (* (pop stack) (pop stack)))]
(define b (pop stack))
(push stack (* a b))]
[(26) ;; sqrt [(26) ;; sqrt
(define a (pop stack)) (push stack (sqrt (pop stack)))]
(push stack (sqrt a))]
[(26) ;; dup [(26) ;; dup
(define a (pop stack)) (define a (pop stack))
@ -374,39 +347,30 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
(push stack b a)] (push stack b a)]
[(29) ;; index [(29) ;; index
(define idx (pop stack)) (define idx
(cond (min (max 0 (pop stack)) (- (length stack) 1)))
[(< idx 0)
(set! idx 0)]
[(> idx (- (length stack) 1))
(set! idx (- (length stack) 1))])
(push stack (list-ref stack idx))] (push stack (list-ref stack idx))]
[(30) ;; roll [(30) ;; roll
(define n (pop stack)) (define n (pop stack))
(define j (pop stack)) (define j (pop stack))
(cond (cond
[(>= j 0) [(>= j 0)
(let loop () (let loop ([j j])
(when (> j 0) (when (> j 0)
(define t (list-ref stack (- n 1))) (define t (list-ref stack (- n 1)))
(for [(i (in-range (- n 2) (sub1 0) -1))] (for [(i (in-range (- n 2) (sub1 0) -1))]
(set! stack (set! stack (list-set stack (+ i 1) (list-ref stack i))))
(list-set stack (+ i 1) (list-ref stack i))))
(set! stack (list-set stack 0 t)) (set! stack (list-set stack 0 t))
(set! j (sub1 j)) (loop (sub1 j))))]
(loop)))]
[else [else
(let loop () (let loop ([j j])
(when (< j 0) (when (< j 0)
(define t (list-ref stack 0)) (define t (list-ref stack 0))
(for ([i (in-range (add1 n))]) (for ([i (in-range (add1 n))])
(set! stack (list-set stack i (list-ref stack (+ i 1))))) (set! stack (list-set stack i (list-ref stack (+ i 1)))))
(set! stack (list-set stack (- n 1) t))
(set! stack (list-set stack (- n 1) t))))])] (loop (add1 j))))])]
[(34) ;; hflex [(34) ;; hflex
(define c1x (+ x (shift stack))) (define c1x (+ x (shift stack)))
(define c1y y) (define c1y y)
@ -481,19 +445,16 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
[else (error (format "unknown op: ~a" op))])] [else (error (format "unknown op: ~a" op))])]
[(< op 247) (push stack (- op 139))] [(< op 247) (push stack (- op 139))]
[(< op 251) [(< op 251)
(define b1 (read-byte stream)) (push stack (+ (* (- op 247) 256) (read-byte stream) 108))]
(push stack (+ (* (- op 247) 256) b1 108))]
[(< op 255) [(< op 255)
(define b1 (read-byte stream)) (push stack (- (* (- 251 op) 256) (read-byte stream) 108))]
(push stack (- (* (- 251 op) 256) b1 108))]
[else [else
(push stack (/ (decode int32be stream) 65536))]) (push stack (/ (decode int32be stream) 65536))])
(loop))))) (loop)))))
(parse) (parse)
(when open (when open (path-closePath path))
(path-closePath path))
(set-cff-glyph-_usedSubrs! this usedSubrs) (set-cff-glyph-_usedSubrs! this usedSubrs)
(set-cff-glyph-_usedGsubrs! this usedGsubrs) (set-cff-glyph-_usedGsubrs! this usedGsubrs)

65
fontland/fontland/table/cff/cff-dict.rkt
Unescape Escape View File

@ -15,7 +15,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
(define (op->key op) (define (op->key op)
(match (car op) (match (car op)
[(list* 0th 1st _) (bitwise-ior (arithmetic-shift 0th 8) 1st)] [(list* x0 x1 _) (bitwise-ior (arithmetic-shift x0 8) x1)]
[val val])) [val val]))
(define CFFDict% (define CFFDict%
@ -29,8 +29,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
(define (decode-operands type stream ret operands) (define (decode-operands type stream ret operands)
(match type (match type
[(? list?) [(? list?) (for/list ([op (in-list operands)]
(for/list ([op (in-list operands)]
[subtype (in-list type)]) [subtype (in-list type)])
(decode-operands subtype stream ret (list op)))] (decode-operands subtype stream ret (list op)))]
[(? xenomorphic?) (send type x:decode stream ret operands)] [(? xenomorphic?) (send type x:decode stream ret operands)]
@ -57,7 +56,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
(define/augment (x:decode stream parent) (define/augment (x:decode stream parent)
(define end (+ (pos stream) (hash-ref parent 'length))) (define end (+ (pos stream) (hash-ref parent 'length)))
(define ret (make-hash)) (define ret (make-hash))
(define operands null)
;; define hidden properties ;; define hidden properties
(hash-set! ret x:parent-key parent) (hash-set! ret x:parent-key parent)
@ -67,59 +65,45 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
(for ([(key field) (in-hash @fields)]) (for ([(key field) (in-hash @fields)])
(hash-set! ret (second field) (fourth field))) (hash-set! ret (second field) (fourth field)))
(let loop () (let loop ([operands null])
(when (< (pos stream) end) (when (< (pos stream) end)
(define b (read-byte stream)) (define b (read-byte stream))
(let bloop ([b b])
(cond (cond
[(< b 28) [(< b 28)
(when (= b 12) (let ([b (if (= b 12)
(set! b (bitwise-ior (arithmetic-shift b 8) (read-byte stream)))) (bitwise-ior (arithmetic-shift b 8) (read-byte stream))
b)])
(define field (hash-ref @fields b #false)) (define field (hash-ref @fields b #false))
(unless field (unless field
(error 'cff-dict-decode (format "unknown operator: ~a" b))) (error 'cff-dict-decode (format "unknown operator: ~a" b)))
(define val (decode-operands (third field) stream ret operands)) (define val (decode-operands (third field) stream ret operands))
(unless (void? val) (unless (void? val)
;; ignoring PropertyDescriptor nonsense
(hash-set! ret (second field) val)) (hash-set! ret (second field) val))
(set! operands null)] (loop null))]
[else [else
(set! operands (append operands (list (decode CFFOperand stream b))))]) (loop (append operands (list (decode CFFOperand stream b))))]))))
(loop)))
ret) ret)
(define/augment (x:size dict parent [includePointers #true]) (define/augment (x:size dict parent [include-pointers #true])
(define ctx (define ctx
(mhasheq x:parent-key parent (mhasheq x:parent-key parent
x:val-key dict x:val-key dict
x:pointer-size-key 0 x:pointer-size-key 0
x:start-offset-key (hash-ref parent x:start-offset-key 0))) x:start-offset-key (hash-ref parent x:start-offset-key 0)))
(define len 0) (+ (for*/sum ([k (in-list (sort (dict-keys @fields) <))]
(for* ([k (in-list (sort (dict-keys @fields) <))]
[field (in-value (dict-ref @fields k))] [field (in-value (dict-ref @fields k))]
[val (in-value (dict-ref dict (list-ref field 1) #false))] [val (in-value (dict-ref dict (list-ref field 1) #false))]
#:unless (let ([ res (or (not val) (equal? val (list-ref field 3)))]) #:unless (or (not val) (equal? val (list-ref field 3))))
res)) (define operands (encode-operands (list-ref field 2) #false ctx val))
(define operand-size (for/sum ([op (in-list operands)])
(define operands (encode-operands (list-ref field 2) #f ctx val)) (size CFFOperand op)))
(set! len (+ len (define key (if (list? (car field)) (car field) (list (car field))))
(for/sum ([op (in-list operands)]) (+ operand-size (length key)))
(size CFFOperand op)))) (if include-pointers (hash-ref ctx x:pointer-size-key) 0)))
(define key (if (list? (list-ref field 0))
(list-ref field 0)
(list (list-ref field 0))))
(set! len (+ len (length key))))
(when includePointers
(set! len (+ len (hash-ref ctx x:pointer-size-key))))
len)
(define/augment (x:encode dict stream parent) (define/augment (x:encode dict stream parent)
(define ctx (mhasheq (define ctx (mhasheq
@ -132,8 +116,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
(hash-set! ctx x:pointer-offset-key (+ (pos stream) (x:size dict ctx #false))) (hash-set! ctx x:pointer-offset-key (+ (pos stream) (x:size dict ctx #false)))
(for ([field (in-list @ops)]) (for ([field (in-list @ops)])
#;(pos stream)
#;field
(define val (dict-ref dict (list-ref field 1) #false)) (define val (dict-ref dict (list-ref field 1) #false))
(cond (cond
[(or (not val) (equal? val (list-ref field 3)))] [(or (not val) (equal? val (list-ref field 3)))]
@ -141,19 +123,14 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
(define operands (encode-operands (list-ref field 2) stream ctx val)) (define operands (encode-operands (list-ref field 2) stream ctx val))
(for ([op (in-list operands)]) (for ([op (in-list operands)])
(send CFFOperand x:encode op stream)) (send CFFOperand x:encode op stream))
(define key (if (list? (car field)) (car field) (list (car field))))
(define key (if (list? (list-ref field 0))
(list-ref field 0)
(list (list-ref field 0))))
(for ([op (in-list key)]) (for ([op (in-list key)])
(encode uint8 op stream))])) (encode uint8 op stream))]))
(define i 0) (let loop ([i 0])
(let loop ()
(when (< i (length (hash-ref ctx x:pointers-key))) (when (< i (length (hash-ref ctx x:pointers-key)))
(match (list-ref (hash-ref ctx x:pointers-key) i) (match (list-ref (hash-ref ctx x:pointers-key) i)
[(x:ptr type val parent) (send type x:encode val stream parent)]) [(x:ptr type val parent) (send type x:encode val stream parent)])
(set! i (add1 i)) (loop (add1 i)))))))
(loop))))))
(define (CFFDict [name 'unknown] [ops null]) (make-object CFFDict% name ops)) (define (CFFDict [name 'unknown] [ops null]) (make-object CFFDict% name ops))

27
fontland/fontland/table/cff/cff-font.rkt
Unescape Escape View File

@ -42,10 +42,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js
[else (list-ref (hash-ref this 'stringIndex) (- sid (length standardStrings)))])) [else (list-ref (hash-ref this 'stringIndex) (- sid (length standardStrings)))]))
(define (CFFFont-postscriptName this) (define (CFFFont-postscriptName this)
(cond (and (< (hash-ref this 'version) 2) (car (hash-ref this 'nameIndex))))
[(< (hash-ref this 'version) 2)
(list-ref (hash-ref this 'nameIndex) 0)]
[else #false]))
(define CFFFont (make-object CFFFont%)) (define CFFFont (make-object CFFFont%))
@ -56,26 +53,21 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js
(define (fdForGlyph this gid) (define (fdForGlyph this gid)
(cond (cond
[(not (hash-has-key? (hash-ref this 'topDict) 'FDSelect)) [(not (hash-has-key? (hash-ref this 'topDict) 'FDSelect)) #false]
#false]
[else [else
(match (hash-ref* this 'topDict 'FDSelect 'version) (match (hash-ref* this 'topDict 'FDSelect 'version)
[0 (list-ref (hash-ref* this 'topDict 'FDSelect) gid)] [0 (list-ref (hash-ref* this 'topDict 'FDSelect) gid)]
[(or 3 4) [(or 3 4)
(define ranges (hash-ref* this 'topDict 'FDSelect 'ranges)) (define ranges (hash-ref* this 'topDict 'FDSelect 'ranges))
(define low 0) (let loop ([low 0][high (sub1 (length ranges))])
(define high (sub1 (length (ranges))))
(let loop ()
(when (<= low high) (when (<= low high)
(define mid (arithmetic-shift (+ low high) -1)) (define mid (arithmetic-shift (+ low high) -1))
(cond (cond
[(< gid (hash-ref (list-ref ranges mid) 'first)) [(< gid (hash-ref (list-ref ranges mid) 'first))
(set! high (sub1 mid))] (loop low (sub1 mid))]
[(and (< mid high) (> gid (hash-ref (list-ref ranges (add1 mid)) 'first))) [(and (< mid high) (> gid (hash-ref (list-ref ranges (add1 mid)) 'first)))
(set! low (add1 mid))] (loop (add1 mid) high)]
[else (hash-ref (list-ref ranges mid) 'fd)]) [else (hash-ref (list-ref ranges mid) 'fd)])))]
(loop)))]
[default (error 'unknown-select-version)])])) [default (error 'unknown-select-version)])]))
(define (privateDictForGlyph this gid) (define (privateDictForGlyph this gid)
@ -87,11 +79,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js
(if (list-ref (hash-ref* this 'topDict 'FDArray) fd) (if (list-ref (hash-ref* this 'topDict 'FDArray) fd)
(hash-ref (list-ref (hash-ref* 'topDict 'FDArray) fd) 'Private) (hash-ref (list-ref (hash-ref* 'topDict 'FDArray) fd) 'Private)
#false)] #false)]
[(< (hash-ref this 'version) 2) [(< (hash-ref this 'version) 2) (hash-ref* this 'topDict 'Private)]
(hash-ref* this 'topDict 'Private)] [else (hash-ref (list-ref (hash-ref* this 'topDict 'FDArray) 0) 'Private)]))
[else
(hash-ref (list-ref (hash-ref* this 'topDict 'FDArray) 0) 'Private)]))
(module+ test (module+ test
(require rackunit racket/serialize racket/stream fontland/helper) (require rackunit racket/serialize racket/stream fontland/helper)

57
fontland/fontland/table/cff/cff-index.rkt
Unescape Escape View File

@ -51,18 +51,17 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFIndex.js
(values (cons val vals) end))])) (values (cons val vals) end))]))
(define/augride (x:size arr parent) (define/augride (x:size arr parent)
(define size 2) (+ 2
(cond (cond
[(zero? (length arr)) size] [(zero? (length arr)) 0]
[else [else (define type (or @type (x:buffer)))
(define type (or @type (x:buffer)))
;; find maximum offset to determinine offset type ;; find maximum offset to determinine offset type
(define offset 1) (define offset
(for ([(item i) (in-indexed arr)]) (add1 (for/sum ([item (in-list arr)])
(set! offset (+ offset (send type x:size item parent)))) (send type x:size item parent))))
(define offsetType (define offset-type
(cond (cond
[(<= offset #xff) uint8] [(<= offset #xff) uint8]
[(<= offset #xffff) uint16be] [(<= offset #xffff) uint16be]
@ -70,10 +69,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFIndex.js
[(<= offset #xffffffff) uint32be] [(<= offset #xffffffff) uint32be]
[else (error 'CFFIndex-size (format "bad offset: ~a" offset))])) [else (error 'CFFIndex-size (format "bad offset: ~a" offset))]))
(set! size (+ size 1 (* (send offsetType x:size) (add1 (length arr))))) (+ (* (send offset-type x:size) (add1 (length arr))) offset)])))
(set! size (+ size (sub1 offset)))
size]))
(define/augride (x:encode arr stream parent) (define/augride (x:encode arr stream parent)
(send uint16be x:encode (length arr) stream) (send uint16be x:encode (length arr) stream)
@ -83,36 +79,31 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFIndex.js
(define type (or @type (x:buffer))) (define type (or @type (x:buffer)))
;; find maximum offset to detminine offset type ;; find maximum offset to detminine offset type
(define sizes null) (define-values (sizes offset)
(define offset 1) (for/fold ([sizes null]
(for ([item (in-list arr)]) [offset 1]
#:result (values (reverse sizes) offset))
([item (in-list arr)])
(define s (send type x:size item parent)) (define s (send type x:size item parent))
(set! sizes (append sizes (list s))) (values (cons s sizes) (+ offset s))))
(set! offset (+ offset s)))
(define offsetType (define offsetType
(cond (cond
[(<= offset #xff) [(<= offset #xff) uint8]
uint8] [(<= offset #xffff) uint16be]
[(<= offset #xffff) [(<= offset #xffffff) uint24be]
uint16be] [(<= offset #xffffffff) uint32be]
[(<= offset #xffffff) [else (error 'cff-index-encode-bad-offset!)]))
uint24be]
[(<= offset #xffffffff)
uint32be]
[else
(error 'cff-index-encode-bad-offset!)]))
;; write offset size ;; write offset size
(send uint8 x:encode (size offsetType) stream) (send uint8 x:encode (size offsetType) stream)
;; write elements ;; write elements
(set! offset 1) (for/fold ([offset 1])
(send offsetType x:encode offset stream) ([size (in-list (cons 0 sizes))])
(define next-offset (+ offset size))
(for ([size (in-list sizes)]) (send offsetType x:encode next-offset stream)
(set! offset (+ offset size)) next-offset)
(send offsetType x:encode offset stream))
(for ([item (in-list arr)]) (for ([item (in-list arr)])
(send type x:encode item stream parent))])))) (send type x:encode item stream parent))]))))

26
fontland/fontland/table/cff/cff-operand.rkt
Unescape Escape View File

@ -25,7 +25,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
(cond (cond
[(<= 32 value 246) (- value 139)] [(<= 32 value 246) (- value 139)]
[(<= 247 value 250) (+ (* (- value 247) 256) (read-byte stream) 108)] [(<= 247 value 250) (+ (* (- value 247) 256) (read-byte stream) 108)]
[(<= 251 value 254) (- (* (- (- value 251)) 256) (read-byte stream) 108)] [(<= 251 value 254) (- (* (- 251 value) 256) (read-byte stream) 108)]
[(= value 28) (decode int16be stream)] [(= value 28) (decode int16be stream)]
[(= value 29) (decode int32be stream)] [(= value 29) (decode int32be stream)]
[(= value 30) [(= value 30)
@ -35,7 +35,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
([i (in-naturals)] ([i (in-naturals)]
#:break break?) #:break break?)
(define b (read-byte stream)) (define b (read-byte stream))
(define n1 (arithmetic-shift b -4)) (define n1 (arithmetic-shift b -4))
(cond (cond
@ -53,10 +52,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
;; if the value needs to be forced to the largest size (32 bit) ;; if the value needs to be forced to the largest size (32 bit)
;; e.g. for unknown pointers, set to 32768 ;; e.g. for unknown pointers, set to 32768
(define value (cond (define value (cond
[(or (and (hash? value-arg) (hash-ref value-arg 'forceLarge #f)) [(Ptr? value-arg) (if (Ptr-forceLarge value-arg) 32768 (Ptr-val value-arg))]
(and (Ptr? value-arg) (Ptr-forceLarge value-arg)))
32768]
[(Ptr? value-arg) (Ptr-val value-arg)]
[else value-arg])) [else value-arg]))
(cond (cond
@ -81,20 +77,18 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
[(not (integer? val)) ;; floating point [(not (integer? val)) ;; floating point
(encode uint8 30 stream) (encode uint8 30 stream)
(define str (list->vector (regexp-match* #rx"." (number->string val)))) (define str (list->vector (regexp-match* #rx"." (number->string val))))
(define n2 'nothing) (define n2
(for ([i (in-range 0 (vector-length str) 2)]) (for/last ([i (in-range 0 (vector-length str) 2)])
(define c1 (vector-ref str i)) (define c1 (vector-ref str i))
(define n1 (hash-ref FLOAT_ENCODE_LOOKUP c1 (string->number c1))) (define n1 (hash-ref FLOAT_ENCODE_LOOKUP c1 (string->number c1)))
(define n2
(cond (cond
[(= i (sub1 (vector-length str))) [(= i (sub1 (vector-length str))) FLOAT_EOF]
(set! n2 FLOAT_EOF)]
[else [else
(define c2 (vector-ref str (add1 i))) (define c2 (vector-ref str (add1 i)))
(set! n2 (hash-ref FLOAT_ENCODE_LOOKUP c2 (string->number c2)))]) (hash-ref FLOAT_ENCODE_LOOKUP c2 (string->number c2))]))
(encode uint8 (bitwise-ior (arithmetic-shift n1 4) (bitwise-and n2 15)) stream)
(encode uint8 (bitwise-ior (arithmetic-shift n1 4) (bitwise-and n2 15)) stream)) n2))
(unless (= n2 FLOAT_EOF) (unless (= n2 FLOAT_EOF)
(encode uint8 (arithmetic-shift FLOAT_EOF 4) stream))] (encode uint8 (arithmetic-shift FLOAT_EOF 4) stream))]
[(<= -107 value 107) [(<= -107 value 107)
@ -104,7 +98,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
(encode uint8 (+ (arithmetic-shift val -8) 247) stream) (encode uint8 (+ (arithmetic-shift val -8) 247) stream)
(encode uint8 (bitwise-and val #xff) stream))] (encode uint8 (bitwise-and val #xff) stream))]
[(<= -1131 value -108) [(<= -1131 value -108)
(let ([val (- (- val) 108)]) (let ([val (- (+ val 108))])
(encode uint8 (+ (arithmetic-shift val -8) 251) stream) (encode uint8 (+ (arithmetic-shift val -8) 251) stream)
(encode uint8 (bitwise-and val #xff) stream))] (encode uint8 (bitwise-and val #xff) stream))]
[(<= -32768 value 32767) [(<= -32768 value 32767)

6
fontland/fontland/table/cff/cff-struct.rkt
Unescape Escape View File

@ -1,7 +1,3 @@
#lang racket/base #lang racket/base
(require)
(provide (all-defined-out)) (provide (all-defined-out))
(struct Ptr (val [forceLarge #:auto]) #:transparent #:mutable #:auto-value #true)
(struct Ptr (val [forceLarge #:auto]) #:transparent #:mutable #:auto-value #true
;; use prop:procedure instead of JS `valueOf`
#:property prop:procedure (λ (ptr) (Ptr-val ptr)))

31
fontland/fontland/table/cff/cff-top.rkt
Unescape Escape View File

@ -1,5 +1,11 @@
#lang debug racket/base #lang debug racket/base
(require xenomorph racket/list sugar/unstable/dict racket/class racket/dict (require xenomorph
racket/list
racket/vector
racket/match
sugar/unstable/dict
racket/class
racket/dict
"cff-index.rkt" "cff-index.rkt"
"cff-dict.rkt" "cff-dict.rkt"
"cff-charsets.rkt" "cff-charsets.rkt"
@ -18,6 +24,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
(super-new) (super-new)
(init-field [(@predefinedOps predefinedOps)] (init-field [(@predefinedOps predefinedOps)]
[(@type type) #f]) [(@type type) #f])
(field [op-vec (list->vector @predefinedOps)])
(define/override (pre-encode val) (define/override (pre-encode val)
;; because fontkit depends on overloading 'version key, and we don't ;; because fontkit depends on overloading 'version key, and we don't
@ -28,14 +35,14 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
(define/augment (x:decode stream parent operands) (define/augment (x:decode stream parent operands)
(define idx (car operands)) (define idx (car operands))
(cond (cond
[(and (< idx (length @predefinedOps)) (list-ref @predefinedOps idx))] [(and (< idx (vector-length op-vec)) (vector-ref op-vec idx))]
[else (decode @type stream #:parent parent operands)])) [else (decode @type stream #:parent parent operands)]))
(define/augment (x:size value ctx) (define/augment (x:size value ctx)
(error 'predefined-op-size-not-finished)) (error 'predefined-op-size-not-finished))
(define/augment (x:encode value stream ctx) (define/augment (x:encode value stream ctx)
(or (index-of @predefinedOps value) (or (vector-member value op-vec)
(send @type x:encode value stream ctx))))) (send @type x:encode value stream ctx)))))
(define (PredefinedOp predefinedOps type) (make-object PredefinedOp% predefinedOps type)) (define (PredefinedOp predefinedOps type) (make-object PredefinedOp% predefinedOps type))
@ -90,9 +97,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
(define (base-tproc t) (length (hash-ref (hash-ref t 'parent) 'CharStrings))) (define (base-tproc t) (length (hash-ref (hash-ref t 'parent) 'CharStrings)))
(define CFFCustomCharset (define CFFCustomCharset
(let ([tproc (λ (t) (sub1 (base-tproc t)))])
(x:versioned-struct (x:versioned-struct
uint8 uint8
(let ([tproc (λ (t) (sub1 (base-tproc t)))])
(dictify (dictify
0 (dictify 'glyphs (x:array uint16be tproc)) 0 (dictify 'glyphs (x:array uint16be tproc))
1 (dictify 'ranges (RangeArray Range1 tproc)) 1 (dictify 'ranges (RangeArray Range1 tproc))
@ -114,9 +121,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
(x:versioned-struct (x:versioned-struct
uint8 uint8
#:pre-encode #:pre-encode
(λ (val)
;; because fontkit depends on overloading 'version key, and we don't ;; because fontkit depends on overloading 'version key, and we don't
(dict-set val 'x:version (dict-ref val 'version))) (λ (val) (dict-set val 'x:version (dict-ref val 'version)))
(dictify (dictify
0 (dictify 'fds (x:array uint8 base-tproc)) 0 (dictify 'fds (x:array uint8 base-tproc))
3 (dictify 'nRanges uint16be 3 (dictify 'nRanges uint16be
@ -133,8 +139,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
(super-new) (super-new)
(define/augment (x:decode stream parent operands) (define/augment (x:decode stream parent operands)
(hash-set! parent 'length (list-ref operands 0)) (match operands
(send ptr x:decode stream parent (list (list-ref operands 1)))) [(list op1 op2)
(hash-set! parent 'length op1)
(send ptr x:decode stream parent (list op2))]))
(define/augment (x:size dict ctx) (define/augment (x:size dict ctx)
(list (send CFFPrivateDict x:size dict ctx #false) (list (send CFFPrivateDict x:size dict ctx #false)
@ -198,10 +206,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
(define CFFTop (define CFFTop
(x:versioned-struct (x:versioned-struct
#:pre-encode #:pre-encode
(λ (val)
;; because fontkit depends on overloading 'version key, and we don't ;; because fontkit depends on overloading 'version key, and we don't
(hash-set! val 'x:version (hash-ref val 'version)) (λ (val) (hash-set! val 'x:version (hash-ref val 'version)) val)
val)
fixed16be fixed16be
(dictify (dictify
1 (dictify 'hdrSize uint8 1 (dictify 'hdrSize uint8
@ -209,8 +215,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
'nameIndex (CFFIndex (x:string #:length 'length)) 'nameIndex (CFFIndex (x:string #:length 'length))
'topDictIndex (CFFIndex CFFTopDict) 'topDictIndex (CFFIndex CFFTopDict)
'stringIndex (CFFIndex (x:string #:length 'length)) 'stringIndex (CFFIndex (x:string #:length 'length))
'globalSubrIndex (CFFIndex) 'globalSubrIndex (CFFIndex))
)
#| #|
2 (dictify 'hdrSize uint8 2 (dictify 'hdrSize uint8

2
fontland/fontland/test/glyphs.rkt
Unescape Escape View File

@ -11,7 +11,7 @@ https://github.com/mbutterick/fontkit/blob/master/test/glyphs.js
(define-runtime-path source-otf "data/SourceSansPro/SourceSansPro-Regular.otf") (define-runtime-path source-otf "data/SourceSansPro/SourceSansPro-Regular.otf")
(define font (open-font source-otf)) (define font (open-font source-otf))
(define glyph (get-glyph font 5)) (define glyph (get-glyph font 5))
(test-case (test-case
"should get a TTFGlyph" "should get a TTFGlyph"

Write Preview
Loading…
Cancel
Save