#lang debug racket/base
(require racket/class racket/match racket/list racket/dict xenomorph sugar/unstable/dict
         "cff-operand.rkt")
(provide CFFDict)

#|
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)
    (init-field [(@name name)] [(@ops ops)])

    (field [(@fields fields)
            (for/hash ([field (in-list @ops)])
              (define key (op->key field))
              (values key field))])
    
    (define (decodeOperands 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)]
        [(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/override (post-decode val)
      (dict->mutable-hash val))
    
    (augment [@decode decode])
    (define (@decode stream parent)
      (define end (+ (pos stream) (hash-ref parent 'length)))
      (define ret (make-hash))
      (define operands null)

      ;; define hidden properties
      (hash-set! ret x:parent-key parent)
      (hash-set! ret x:start-offset-key (pos stream))

      ;; fill in defaults
      (for ([(key field) (in-hash @fields)])
        (hash-set! ret (second field) (fourth field)))

      (let loop ()
        (when (< (pos stream) end)
          (define b (read-byte stream))
          (cond
            [(< b 28)
             (when (= b 12)
               (set! b (bitwise-ior (arithmetic-shift b 8) (read-byte stream))))
             (define field (hash-ref @fields b #false))
             (unless field
               (error 'cff-dict-decode (format "unknown operator: ~a" b)))

             (define val (decodeOperands (third field) stream ret operands))

             (unless (void? val)
               ;; ignoring PropertyDescriptor nonsense
               (hash-set! ret (second field) val))
             (set! operands null)]
            [else
             (set! operands (append operands (list (decode CFFOperand stream b))))])
          (loop)))

      ret)

    (augment [@size size])
    (define (@size dict parent [includePointers #true])
      #RRR @name
      #RRR includePointers
      
      (define ctx
        (mhasheq x:parent-key parent
                 x:val-key dict
                 x:pointer-size-key 0
                 x:start-offset-key (hash-ref parent x:start-offset-key 0)))

      (define len 0)

      (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) #false))]
             #:unless (let ([ res (or (not val) (equal? val (list-ref field 3)))])
                        res))
        #R k
        #R len
        (define operands (encodeOperands (list-ref field 2) #f ctx val))
        (set! len (+ len
                     (for/sum ([op (in-list operands)])
                       (size CFFOperand op))))

        (define key (if (list? (list-ref field 0))
                        (list-ref field 0)
                        (list (list-ref field 0))))
        (set! len (+ len #R (length key))))
      
      (when #R includePointers
        (set! len (+ len #R (hash-ref ctx x:pointer-size-key))))

      (define final-len len)
      #R final-len)

    (augment [@encode encode])
    (define (@encode dict stream parent)
      (error 'cff-dict-encode-undefined))))

(define (CFFDict [name 'unknown] [ops null]) (make-object CFFDict% name ops))