start operand

fontland/fontland/table/cff/cff-dict.rkt

@@ -1,5 +1,6 @@
 #lang debug racket/base
-(require racket/class racket/match racket/list xenomorph sugar/unstable/dict)
+(require racket/class racket/match racket/list xenomorph sugar/unstable/dict
+         "cff-operand.rkt")
 (provide CFFDict)
 
 #|

fontland/fontland/table/cff/cff-operand.rkt

@@ -0,0 +1,111 @@
+#lang debug racket/base
+(require racket/class xenomorph)
+(provide CFFOperand)
+
+#|
+approximates
+https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
+|#
+
+(define FLOAT_EOF #xf)
+
+(define FLOAT_LOOKUP (vector "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "." "E" "E-" "" "-"))
+
+(define FLOAT_ENCODE_LOOKUP
+  (hasheq "." 10
+          "E" 11
+          "E-" 12
+          "-" 14))
+
+(define CFFOperand%
+  (class x:base%
+    (super-new)
+
+    (define (decode stream value)
+      (cond
+        [(<= 32 value 246) (- value 139)]
+        [(<= 247 value 250) (+ (* (- value 247) 256) (read-byte stream) 108)]
+        [(<= 251 value 254) (- (* (- (- value 251)) 256) (read-byte stream) 108)]
+        [(= value 28) (decode int16be stream)]
+        [(= value 29) (decode int32be stream)]
+        [(= value 30)
+         (for/fold ([strs null]
+                    [break? #false]
+                    #:result (* (string->number (string-append (reverse strs)) 1.0)))
+                   ([i (in-naturals)]
+                    #:break break?)
+           (define b (read-byte stream))
+
+           (define n1 (arithmetic-shift b -4))
+           (cond
+             [(= n1 FLOAT_EOF) (values strs 'break-now)]
+             [else
+              (let ([strs (cons (vector-ref FLOAT_LOOKUP n1) strs)])
+                (define n2 (bitwise-and b 15))
+                (cond
+                  [(= n2 FLOAT_EOF (values strs 'break-now))]
+                  [else
+                   (let ([strs (cons (vector-ref FLOAT_LOOKUP n2) strs)])
+                     (values strs #false))]))]))]))
+
+    (define (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 (hash-ref value-arg 'forceLarge #f) 32768 value-arg))
+
+      (cond
+        [(not (integer? value)) ; floating point
+         (define str (number->string value))
+         (add1 (ceiling (/ (add1 (string-length str)) 2)))]
+        [(<= -107 value 107) 1]
+        [(<= -1131 value 1131) 2]
+        [(<= -32768 value 32767) 3]
+        [else 5]))
+
+    (define (encode stream value)
+      ;; 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 val (string->number (format "~a" value)))
+
+      (cond
+        [(hash-ref value 'forceLarge #f)
+         (encode uint8 29 stream)
+         (encode int32be val stream)]
+        [(not (integer? val)) ;; floating point
+         (encode uint8 30 stream)
+         (define str (list->vector (regexp-match* #rx"." (number->string val))))
+         (define n2 'nothing)
+         (for ([i (in-range 0 (vector-length str) 2)])
+           (define c1 (vector-ref str i))
+           (define n1 (hash-ref FLOAT_ENCODE_LOOKUP c1 (string->number c1)))
+
+           (cond
+             [(= i (sub1 (vector-length str)))
+              (set! n2 FLOAT_EOF)]
+             [else
+              (define c2 (vector-ref str (add1 i)))
+              (set! n2 (hash-ref FLOAT_ENCODE_LOOKUP c2 (string->number c2)))])
+
+           (encode uint8 (bitwise-ior (arithmetic-shift n1 -4) (bitwise-and n2 15)) stream))
+                    
+         (unless (= n2 FLOAT_EOF)
+           (encode uint8 (arithmetic-shift FLOAT_EOF 4) stream))]
+        [(<= -107 value 107)
+         (encode uint8 (+ val 139) stream)]
+        [(<= 108 value 1131)
+         (encode uint8 (+ (arithmetic-shift val 8) 247) stream)
+         (encode uint8 (bitwise-and val #xff) stream)]
+        [(<= -1131 value -108)
+         (let ([val (- (- val) 108)])
+           (encode uint8 (+ (arithmetic-shift val 8) 251) stream)
+           (encode uint8 (bitwise-and val #xff) stream))]
+        [(<= -32768 value 32767)
+         (encode uint8 28 stream)
+         (encode uint16be val stream)]
+        [else
+         (encode uint8 29 stream)
+         (encode uint32be val stream)]))))
+
+
+(define (CFFOperand . args)
+  (apply make-object CFFOperand% args))