diff --git a/fontland/fontland/table/cff/cff-dict.rkt b/fontland/fontland/table/cff/cff-dict.rkt index 59442553..f83edc91 100644 --- a/fontland/fontland/table/cff/cff-dict.rkt +++ b/fontland/fontland/table/cff/cff-dict.rkt @@ -1,5 +1,5 @@ #lang debug racket/base -(require racket/class racket/match racket/list xenomorph sugar/unstable/dict +(require racket/class racket/match racket/list racket/dict xenomorph sugar/unstable/dict "cff-operand.rkt") (provide CFFDict) @@ -7,15 +7,16 @@ 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 CFFDict% (class x:base% (super-new) (init-field [(@ops ops)]) - (define (op->key op) - (match (car op) - [(list* 0th 1st _) (bitwise-ior (arithmetic-shift 0th 8) 1st)] - [val val])) + (field [(@fields fields) (for/hash ([field (in-list @ops)]) (define key (op->key field)) @@ -38,7 +39,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js [(list? type) (for/list ([(op i) (in-indexed operands)]) (car (encodeOperands (list-ref type i) stream ctx op)))] - [(xenomorphic? type) #R type (send type encode operands #R stream ctx)] + [(xenomorphic? type) #RRR type (send type encode operands #RRR stream ctx)] [(number? operands) (list operands)] [(boolean? operands) (list (if operands 1 0))] [(list? operands) operands] @@ -95,16 +96,17 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js x:start-offset-key (hash-ref parent x:start-offset-key 0))) (define len 0) + #RRR len - (for* ([k (in-list (sort (hash-keys @fields) <))] - [field (in-value (hash-ref @fields k))] - [val (in-value (hash-ref dict (list-ref field 1)))] + (for* ([k (in-list (sort (dict-keys @fields) <))] + [field (in-value (dict-ref @fields k))] + [val (in-value (dict-ref dict (list-ref field 1)))] #:unless (let ([ res (or (not val) (equal? val (list-ref field 3)))]) (and res #R 'skipped #R k))) - #R k - #R len + #RR k + #RR len (define operands (encodeOperands (list-ref field 2) #f ctx val)) - #R operands + #RR operands (set! len (+ len (for/sum ([op (in-list operands)]) #R (size CFFOperand op)))) diff --git a/fontland/fontland/table/cff/cff-index.rkt b/fontland/fontland/table/cff/cff-index.rkt index 8eef4c7a..44a5a3c8 100644 --- a/fontland/fontland/table/cff/cff-index.rkt +++ b/fontland/fontland/table/cff/cff-index.rkt @@ -48,11 +48,13 @@ (augride [@size size]) (define (@size arr parent) + #RRR 'in-cfff-index-size (define size 2) (cond [(zero? (length arr)) size] [else - (define type (or @type (bytes))) + (define type (or #RR @type (x:buffer))) + #RR type ;; find maximum offset to determinine offset type (define offset 1) diff --git a/fontland/fontland/table/cff/cff-operand.rkt b/fontland/fontland/table/cff/cff-operand.rkt index 040778aa..b4ac9e97 100644 --- a/fontland/fontland/table/cff/cff-operand.rkt +++ b/fontland/fontland/table/cff/cff-operand.rkt @@ -1,5 +1,5 @@ #lang debug racket/base -(require racket/class xenomorph) +(require racket/class xenomorph "cff-struct.rkt") (provide CFFOperand) #| @@ -53,9 +53,13 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js (define/augment (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 (if (and (hash? value-arg) (hash-ref value-arg 'forceLarge #f)) - 32768 - value-arg)) + #RRR value-arg + (define value (cond + [(or (and (hash? value-arg) (hash-ref value-arg 'forceLarge #f)) + (and (Ptr? value-arg) (Ptr-forceLarge value-arg))) + 32768] + [(Ptr? value-arg) (Ptr-val value-arg)] + [else value-arg])) (cond [(not (integer? value)) ; floating point diff --git a/fontland/fontland/table/cff/cff-pointer.rkt b/fontland/fontland/table/cff/cff-pointer.rkt index 547f3d6c..5823dc03 100644 --- a/fontland/fontland/table/cff/cff-pointer.rkt +++ b/fontland/fontland/table/cff/cff-pointer.rkt @@ -1,5 +1,5 @@ #lang debug racket/base -(require racket/class racket/list xenomorph) +(require racket/class racket/list xenomorph "cff-struct.rkt") (provide CFFPointer) #| @@ -30,33 +30,29 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFPointer.js (super decode stream parent)) (override [@encode encode]) - (inherit/super encode) (define (@encode value stream ctx) - #R (get-field offset-type this) - #R (get-field type this) - #R stream + #RRR 'entering-cff-pointer-encode + #RR (get-field offset-type this) + #RR (get-field type this) + #RR stream (cond - [#R (not stream) + [#RR (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) - (list (Ptr 0))] + #RR (list (Ptr 0))] [else - #R value - #R stream + #RRR value + #RRR stream (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) + (error 'branch-not-impl) + #;(super encode value stream ctx) (list (Ptr ptr))])))) - - -(struct Ptr (val [forceLarge #:auto]) #:transparent #:mutable #:auto-value #true - ;; use prop:procedure instead of JS `valueOf` - #:property prop:procedure (λ (ptr) (Ptr-val ptr))) \ No newline at end of file diff --git a/fontland/fontland/table/cff/cff-struct.rkt b/fontland/fontland/table/cff/cff-struct.rkt new file mode 100644 index 00000000..039047a7 --- /dev/null +++ b/fontland/fontland/table/cff/cff-struct.rkt @@ -0,0 +1,7 @@ +#lang racket/base +(require) +(provide (all-defined-out)) + +(struct Ptr (val [forceLarge #:auto]) #:transparent #:mutable #:auto-value #true + ;; use prop:procedure instead of JS `valueOf` + #:property prop:procedure (λ (ptr) (Ptr-val ptr))) \ No newline at end of file diff --git a/fontland/fontland/table/cff/cff-top.rkt b/fontland/fontland/table/cff/cff-top.rkt index 075a9f9a..aaf9dcb0 100644 --- a/fontland/fontland/table/cff/cff-top.rkt +++ b/fontland/fontland/table/cff/cff-top.rkt @@ -38,11 +38,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js (augment [@encode encode]) (define (@encode value stream ctx) - #R 'encode-pdop - #R value - #R stream + #RRR 'encode-pdop + #RR '--------------------- (or (index-of @predefinedOps value) - (send @type encode value stream ctx))))) + #RRR (send #RR @type encode #RR value #RR stream ctx))))) (define (PredefinedOp predefinedOps type) (make-object PredefinedOp% predefinedOps type)) @@ -80,7 +79,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js (class x:array% (super-new) (inherit-field [@len len] [@type type]) + #RRR @type (define/override (decode stream parent) + #RRR 'in-RangeArray%-decode (define length (resolve-length @len stream parent)) (for/fold ([res null] [count 0] @@ -90,6 +91,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js (define range (decode @type stream parent)) (hash-set! range 'offset count) (values (cons range res) (+ count (hash-ref range 'nLeft) 1)))))) + (define (RangeArray . args) (apply x:array #:base-class RangeArray% args)) (define (base-tproc t) (length (hash-ref (hash-ref t 'parent) 'CharStrings)))