diff --git a/fontland/fontland/table/cff/cff-dict.rkt b/fontland/fontland/table/cff/cff-dict.rkt index a1067c99..da33f17a 100644 --- a/fontland/fontland/table/cff/cff-dict.rkt +++ b/fontland/fontland/table/cff/cff-dict.rkt @@ -1,5 +1,10 @@ -#lang debug racket/base -(require racket/class racket/match racket/list racket/dict xenomorph sugar/unstable/dict +#lang racket/base +(require racket/class + racket/match + racket/list + racket/dict + xenomorph + sugar/unstable/dict "cff-operand.rkt") (provide CFFDict) @@ -7,14 +12,12 @@ approximates https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js |# + (define (op->key op) (match (car op) [(list* 0th 1st _) (bitwise-ior (arithmetic-shift 0th 8) 1st)] [val val])) -(define (key->op key) - (list (list (bitwise-and (arithmetic-shift key -8) 255) (bitwise-and key 255)))) - (define CFFDict% (class x:base% (super-new) @@ -22,35 +25,36 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js (field [(@fields fields) (for/hash ([field (in-list @ops)]) - (define key (op->key field)) - (values key field))]) + (values (op->key field) field))]) - (define (decodeOperands type stream ret operands) + (define (decode-operands type stream ret operands) (match type [(? list?) - (for/list ([(op i) (in-indexed operands)]) - (decodeOperands (list-ref type i) stream ret (list op)))] - [(? xenomorphic?) (send type decode stream ret operands)] + (for/list ([op (in-list operands)] + [subtype (in-list type)]) + (decode-operands subtype stream ret (list op)))] + [(? xenomorphic?) (send type x:decode stream ret operands)] [(or 'number 'offset 'sid) (car operands)] ['boolean (if (car operands) #t #f)] [_ operands])) - (define (encodeOperands type stream ctx operands) - (cond - [(list? type) - (for/list ([(op i) (in-indexed operands)]) - (car (encodeOperands (list-ref type i) stream ctx op)))] - [(xenomorphic? type) type (send type encode operands stream ctx)] - [(number? operands) (list operands)] - [(boolean? operands) (list (if operands 1 0))] - [(list? operands) operands] - [else (list operands)])) + (define (encode-operands type stream ctx operands) + (match type + [(? list?) + (for/list ([op (in-list operands)] + [subtype (in-list type)]) + (car (encode-operands subtype stream ctx op)))] + [(? xenomorphic?) type (send type x:encode operands stream ctx)] + [_ (match operands + [(? number?) (list operands)] + [(? boolean?) (list (if operands 1 0))] + [(? list?) operands] + [_ (list operands)])])) (define/override (post-decode val) (dict->mutable-hash val)) - (augment [@decode decode]) - (define (@decode stream parent) + (define/augment (x:decode stream parent) (define end (+ (pos stream) (hash-ref parent 'length))) (define ret (make-hash)) (define operands null) @@ -74,7 +78,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js (unless field (error 'cff-dict-decode (format "unknown operator: ~a" b))) - (define val (decodeOperands (third field) stream ret operands)) + (define val (decode-operands (third field) stream ret operands)) (unless (void? val) ;; ignoring PropertyDescriptor nonsense @@ -86,8 +90,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js ret) - (augment [@size size]) - (define (@size dict parent [includePointers #true]) + (define/augment (x:size dict parent [includePointers #true]) (define ctx (mhasheq x:parent-key parent @@ -103,7 +106,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js #:unless (let ([ res (or (not val) (equal? val (list-ref field 3)))]) res)) - (define operands (encodeOperands (list-ref field 2) #f ctx val)) + (define operands (encode-operands (list-ref field 2) #f ctx val)) (set! len (+ len (for/sum ([op (in-list operands)]) (size CFFOperand op)))) @@ -118,8 +121,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js len) - (augment [@encode encode]) - (define (@encode dict stream parent) + (define/augment (x:encode dict stream parent) (define ctx (mhasheq x:pointers-key null x:start-offset-key (pos stream) @@ -127,7 +129,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js x:val-key dict x:pointer-size-key 0)) - (hash-set! ctx x:pointer-offset-key (+ (pos stream) (@size dict ctx #false))) + (hash-set! ctx x:pointer-offset-key (+ (pos stream) (x:size dict ctx #false))) (for ([field (in-list @ops)]) #;(pos stream) @@ -136,9 +138,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js (cond [(or (not val) (equal? val (list-ref field 3)))] [else - (define operands (encodeOperands (list-ref field 2) stream ctx val)) + (define operands (encode-operands (list-ref field 2) stream ctx val)) (for ([op (in-list operands)]) - (send CFFOperand encode op stream)) + (send CFFOperand x:encode op stream)) (define key (if (list? (list-ref field 0)) (list-ref field 0) @@ -150,7 +152,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js (let loop () (when (< i (length (hash-ref ctx x:pointers-key))) (match (list-ref (hash-ref ctx x:pointers-key) i) - [(x:ptr type val parent) (send type encode val stream parent)]) + [(x:ptr type val parent) (send type x:encode val stream parent)]) (set! i (add1 i)) (loop)))))) diff --git a/fontland/fontland/table/cff/cff-font.rkt b/fontland/fontland/table/cff/cff-font.rkt index 47f7ea6b..fadca44d 100644 --- a/fontland/fontland/table/cff/cff-font.rkt +++ b/fontland/fontland/table/cff/cff-font.rkt @@ -16,8 +16,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js (class x:base% (super-new) - (augride [@decode decode]) - (define (@decode stream parent . _) + (define/augride (x:decode stream parent . _) (define cff-font (make-hasheq)) (hash-set! cff-font 'stream stream) diff --git a/fontland/fontland/table/cff/cff-index.rkt b/fontland/fontland/table/cff/cff-index.rkt index be366629..e39fd6a3 100644 --- a/fontland/fontland/table/cff/cff-index.rkt +++ b/fontland/fontland/table/cff/cff-index.rkt @@ -20,39 +20,37 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFIndex.js [(and ctx (hash-ref ctx 'x:version #f))] [else -1]))) - (augride [@decode decode]) - (define (@decode stream parent) + (define/augride (x:decode stream parent) (match (decode (if (>= (getCFFVersion parent) 2) uint32be uint16be) stream) [0 null] [count (define offSize (decode uint8 stream)) - (define offsetType (match offSize - [1 uint8] - [2 uint16be] - [3 uint24be] - [4 uint32be] - [_ (error (format "bad-offset-size-in-CFFIndex ~a" offSize))])) - (define startPos (+ (pos stream) (* (add1 count) offSize) -1)) - (for/fold ([vals null] - [start (send offsetType decode stream)] - #:result (begin0 (reverse vals) (pos stream (+ startPos start)))) - ([i (in-range count)]) - (define end (send offsetType decode stream)) - (define val - (cond - [@type - (define apos (pos stream)) - (pos stream (+ startPos start)) - (hash-set! parent 'length (- end start)) - (begin0 - (send @type decode stream parent) - (pos stream apos))] - [else - (hasheq 'offset (+ startPos start) - 'length (- end start))])) - (values (cons val vals) end))])) - - (augride [@size size]) - (define (@size arr parent) + (define offsetType (match offSize + [1 uint8] + [2 uint16be] + [3 uint24be] + [4 uint32be] + [_ (error (format "bad-offset-size-in-CFFIndex ~a" offSize))])) + (define startPos (+ (pos stream) (* (add1 count) offSize) -1)) + (for/fold ([vals null] + [start (send offsetType x:decode stream)] + #:result (begin0 (reverse vals) (pos stream (+ startPos start)))) + ([i (in-range count)]) + (define end (send offsetType x:decode stream)) + (define val + (cond + [@type + (define apos (pos stream)) + (pos stream (+ startPos start)) + (hash-set! parent 'length (- end start)) + (begin0 + (send @type x:decode stream parent) + (pos stream apos))] + [else + (hasheq 'offset (+ startPos start) + 'length (- end start))])) + (values (cons val vals) end))])) + + (define/augride (x:size arr parent) (define size 2) (cond [(zero? (length arr)) size] @@ -62,7 +60,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFIndex.js ;; find maximum offset to determinine offset type (define offset 1) (for ([(item i) (in-indexed arr)]) - (set! offset (+ offset (send type size item parent)))) + (set! offset (+ offset (send type x:size item parent)))) (define offsetType (cond @@ -72,14 +70,13 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFIndex.js [(<= offset #xffffffff) uint32be] [else (error 'CFFIndex-size (format "bad offset: ~a" offset))])) - (set! size (+ size 1 (* (send offsetType size) (add1 (length arr))))) + (set! size (+ size 1 (* (send offsetType x:size) (add1 (length arr))))) (set! size (+ size (sub1 offset))) size])) - (augride [@encode encode]) - (define (@encode arr stream parent) - (send uint16be encode (length arr) stream) + (define/augride (x:encode arr stream parent) + (send uint16be x:encode (length arr) stream) (cond [(zero? (length arr))] [else @@ -89,7 +86,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFIndex.js (define sizes null) (define offset 1) (for ([item (in-list arr)]) - (define s (send type size item parent)) + (define s (send type x:size item parent)) (set! sizes (append sizes (list s))) (set! offset (+ offset s))) @@ -107,18 +104,18 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFIndex.js (error 'cff-index-encode-bad-offset!)])) ;; write offset size - (send uint8 encode (size offsetType) stream) + (send uint8 x:encode (size offsetType) stream) ;; write elements (set! offset 1) - (send offsetType encode offset stream) + (send offsetType x:encode offset stream) (for ([size (in-list sizes)]) (set! offset (+ offset size)) - (send offsetType encode offset stream)) + (send offsetType x:encode offset stream)) (for ([item (in-list arr)]) - (send type encode item stream parent))])))) + (send type x:encode item stream parent))])))) (define (CFFIndex [type #f]) (new CFFIndex% [type type])) \ No newline at end of file diff --git a/fontland/fontland/table/cff/cff-operand.rkt b/fontland/fontland/table/cff/cff-operand.rkt index 7a68a571..19346ee4 100644 --- a/fontland/fontland/table/cff/cff-operand.rkt +++ b/fontland/fontland/table/cff/cff-operand.rkt @@ -21,8 +21,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js (class x:base% (super-new) - (augment [@decode decode]) - (define (@decode stream _ value) + (define/augment (x:decode stream _ value) (cond [(<= 32 value 246) (- value 139)] [(<= 247 value 250) (+ (* (- value 247) 256) (read-byte stream) 108)] @@ -50,7 +49,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js (let ([strs (cons (vector-ref FLOAT_LOOKUP n2) strs)]) (values strs #false))]))]))])) - (define/augment (size value-arg _) + (define/augment (x:size value-arg _) ;; if the value needs to be forced to the largest size (32 bit) ;; e.g. for unknown pointers, set to 32768 (define value (cond @@ -69,8 +68,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js [(<= -32768 value 32767) 3] [else 5])) - (augment [@encode encode]) - (define (@encode value-arg stream . _) + (define/augment (x:encode value-arg stream . _) ;; if the value needs to be forced to the largest size (32 bit) ;; e.g. for unknown pointers, save the old value and set to 32768 (define value (if (Ptr? value-arg) (Ptr-val value-arg) value-arg)) diff --git a/fontland/fontland/table/cff/cff-pointer.rkt b/fontland/fontland/table/cff/cff-pointer.rkt index 4411d859..22362513 100644 --- a/fontland/fontland/table/cff/cff-pointer.rkt +++ b/fontland/fontland/table/cff/cff-pointer.rkt @@ -20,33 +20,31 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFPointer.js (class x:pointer% (super-new) - (inherit/super [%encode encode]) (inherit-field type offset-type) - (define/override (decode stream parent operands) + (define/override (x:decode stream parent operands) (set! offset-type (make-object (class x:base% (super-new) - (define/augment (decode . args) (first operands))))) - (super decode stream parent)) + (define/augment (x:decode . args) (first operands))))) + (super x:decode stream parent)) - (override [@encode encode]) - (define (@encode value stream ctx) + (define/override (x:encode value stream ctx) (cond [(not stream) ;; compute the size (so ctx.pointerSize is correct) (set! offset-type (make-object (class x:base% (super-new) - (define/augment (size . args) 0)))) - (send this size value ctx) + (define/augment (x:size . args) 0)))) + (send this x:size value ctx) (list (Ptr 0))] [else (define ptr #false) (set! offset-type (make-object (class x:base% (super-new) - (define/augment (encode val stream . _) (set! ptr val))))) - (super @encode value stream ctx) + (define/augment (x:encode val stream . _) (set! ptr val))))) + (super x:encode value stream ctx) (list (Ptr ptr))])))) diff --git a/fontland/fontland/table/cff/cff-private-dict.rkt b/fontland/fontland/table/cff/cff-private-dict.rkt index e9acfaf0..e6495563 100644 --- a/fontland/fontland/table/cff/cff-private-dict.rkt +++ b/fontland/fontland/table/cff/cff-private-dict.rkt @@ -12,7 +12,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFPrivateDict.js (define CFFBlendOp (class x:base% - (define/augment (decode stream parent operands) + (define/augment (x:decode stream parent operands) (match (reverse operands) [(cons numBlends operands) ;; TODO: actually blend. For now just consume the deltas diff --git a/fontland/fontland/table/cff/cff-top.rkt b/fontland/fontland/table/cff/cff-top.rkt index c56eaf7d..32451327 100644 --- a/fontland/fontland/table/cff/cff-top.rkt +++ b/fontland/fontland/table/cff/cff-top.rkt @@ -25,20 +25,18 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js (hash-set! val 'x:version (hash-ref val 'version)) val)) - (augment [@decode decode]) - (define (@decode stream parent operands) + (define/augment (x:decode stream parent operands) (define idx (car operands)) (cond [(and (< idx (length @predefinedOps)) (list-ref @predefinedOps idx))] [else (decode @type stream #:parent parent operands)])) - (define/augment (size value ctx) + (define/augment (x:size value ctx) (error 'predefined-op-size-not-finished)) - (augment [@encode encode]) - (define (@encode value stream ctx) + (define/augment (x:encode value stream ctx) (or (index-of @predefinedOps value) - (send @type encode value stream ctx))))) + (send @type x:encode value stream ctx))))) (define (PredefinedOp predefinedOps type) (make-object PredefinedOp% predefinedOps type)) @@ -76,7 +74,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js (class x:array% (super-new) (inherit-field [@len len] [@type type]) - (define/override (decode stream parent) + (define/override (x:decode stream parent) (define length (resolve-length @len stream parent)) (for/fold ([res null] [count 0] @@ -134,18 +132,17 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js (class x:base% (super-new) - (augment [@decode decode]) - (define (@decode stream parent operands) + (define/augment (x:decode stream parent operands) (hash-set! parent 'length (list-ref operands 0)) - (send ptr decode stream parent (list (list-ref operands 1)))) + (send ptr x:decode stream parent (list (list-ref operands 1)))) - (define/augment (size dict ctx) - (list (send CFFPrivateDict size dict ctx #false) - (car (send ptr size dict ctx)))) + (define/augment (x:size dict ctx) + (list (send CFFPrivateDict x:size dict ctx #false) + (car (send ptr x:size dict ctx)))) - (define/augment (encode dict stream ctx) - (list (send CFFPrivateDict size dict ctx #false) - (car (send ptr encode dict stream ctx)))))) + (define/augment (x:encode dict stream ctx) + (list (send CFFPrivateDict x:size dict ctx #false) + (car (send ptr x:encode dict stream ctx)))))) (define (CFFPrivateOp) (make-object CFFPrivateOp%))