bitfield finito

pitfall/fontkit/head.rkt

@@ -2,6 +2,11 @@
 (require restructure)
 (provide (all-defined-out))
 
+#|
+approximates
+https://github.com/mbutterick/fontkit/blob/master/src/tables/head.js
+|#
+
 (define-subclass RStruct (Rhead))
 
 (define head (make-object Rhead
@@ -18,17 +23,11 @@
                 'yMin               int16be                   ;; for all glyph bounding boxes
                 'xMax               int16be                   ;; for all glyph bounding boxes
                 'yMax               int16be                   ;; for all glyph bounding boxes
-                'macStyle           uint16be
-                #|
-new Bitfield(uint16be [
-                                                           '  'bold' 'italic' 'underline' 'outline'
-                                                                   '  'shadow' 'condensed' 'extended'
-                                                                   '])
-|#
+                'macStyle           (make-object RBitfield uint16be '(bold italic underline outline shadow condensed extended))
                 'lowestRecPPEM      uint16be                  ;; smallest readable size in pixels
-                'fontDirectionHint int16be
+                'fontDirectionHint  int16be
                 'indexToLocFormat   int16be                   ;; 0 for short offsets 1 for long
-                'glyphDataFormat    int16be                    ;; 0 for current format
+                'glyphDataFormat    int16be                   ;; 0 for current format
                 )))
 
 (test-module
@@ -48,5 +47,12 @@ new Bitfield(uint16be [
  (check-equal? (· table-data yMax) 963)
  (check-equal? (· table-data xMax) 1193)
  (check-equal? (· table-data xMin) -161)
+ (check-equal? (· table-data macStyle) (make-hash '((shadow . #f)
+                                                    (extended . #f)
+                                                    (condensed . #f)
+                                                    (underline . #f)
+                                                    (outline . #f)
+                                                    (bold . #f)
+                                                    (italic . #f))))
  (check-equal? (· table-data magicNumber) #x5F0F3CF5))
 

pitfall/restructure/bitfield.rkt

@@ -0,0 +1,41 @@
+#lang restructure/racket
+(require "streamcoder.rkt")
+(provide RBitfield)
+
+#|
+approximates
+https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
+|#
+
+(define-subclass RStreamcoder (RBitfield type [flags empty])
+          
+  (define/augment (decode stream [parent #f])
+    (for*/fold ([res (mhash)])
+               ([val (in-value (send type decode stream))]
+                [(flag i) (in-indexed flags)])
+      (hash-set! res flag (bitwise-bit-set? val i))
+      res))
+
+  (define/public (size) (send type size))
+
+  (define/augment (encode stream flag-hash)
+    (send type encode stream (for/sum ([(flag i) (in-indexed flags)]
+                                       #:when (hash-ref flag-hash flag))
+                               (expt 2 i)))))
+
+
+(test-module
+ (require "number.rkt" "decodestream.rkt" "encodestream.rkt")
+ (define bfer (make-object RBitfield uint16be '(bold italic underline outline shadow condensed extended)))
+ (define bf (send bfer decode #"\0\25"))
+ (check-true (hash-ref bf 'bold))
+ (check-true (hash-ref bf 'underline))
+ (check-true (hash-ref bf 'shadow))
+ (check-false (hash-ref bf 'italic))
+ (check-false (hash-ref bf 'outline))
+ (check-false (hash-ref bf 'condensed))
+ (check-false (hash-ref bf 'extended))
+
+ (define os (make-object REncodeStream))
+ (send bfer encode os bf)
+ (check-equal? (send os dump) #"\0\25"))

pitfall/restructure/main.rkt

@@ -4,5 +4,6 @@
      "struct.rkt"
      "string.rkt"
      "array.rkt"
+     "bitfield.rkt"
      "decodestream.rkt"
      "encodestream.rkt")

pitfall/restructure/racket.rkt

@@ -8,6 +8,7 @@
 (r+p "helper.rkt"
      sugar/debug
      racket/class
+     racket/list
      racket/string
      br/define
      sugar/define

pitfall/restructure/streamcoder.rkt

@@ -4,39 +4,17 @@
 
 (define-subclass RBase (RStreamcoder)
 
-  (define/overment (decode stream . args)
-    (unless (is-a? stream RDecodeStream)
-      (raise-argument-error 'decode "RDecodeStream" stream))
-    (inner (void) decode stream . args))
+  (define/overment (decode x . args)
+    (let loop ([x x])
+      (cond
+        [(bytes? x) (loop (open-input-bytes x))]
+        [(input-port? x) (loop (make-object RDecodeStream x))]
+        [(is-a? x RDecodeStream) (inner (void) decode x . args)]
+        [else (raise-argument-error 'decode "item that can become RDecodeStream" x)])))
 
-  (define/overment (encode stream . args)
-    (when stream
-      (unless (is-a? stream REncodeStream)
-        (raise-argument-error 'encode "REncodeStream" stream)))
-    (inner (void) encode stream  . args)))
-
-#|
-(define-subclass RBase (RStreamcoder)
-
-  (define/overment (decode stream-or-port . args)
-    (unless (or (is-a? stream RDecodeStream) (input-port? stream-or-port))
-      (raise-argument-error 'decode "RDecodeStream or input port" stream))
-    (define stream (and stream-or-port
-                        (if (input-port? stream-or-port)
-                            (make-object RDecodeStream stream-or-port)
-                            stream-or-port)))
-    (inner (void) decode stream . args))
-
-  (define/overment (encode stream-or-port . args)
-    (report stream-or-port)
-    (when stream-or-port
-      (unless (or (is-a? stream-or-port REncodeStream) (output-port? stream-or-port))
-        (raise-argument-error 'encode "REncodeStream or output port" stream-or-port)))
-
-    (define stream (and stream-or-port
-                        (if (output-port? stream-or-port)
-                            (make-object REncodeStream stream-or-port)
-                            stream-or-port)))
-    
-    (inner (void) encode stream  . args)))
-|#
+  (define/overment (encode x . args)
+    (let loop ([x x])
+      (cond
+        [(output-port? x) (loop (make-object REncodeStream x))]
+        [(is-a? x REncodeStream) (inner (void) encode x  . args)]
+        [else (raise-argument-error 'encode "item that can become REncodeStream" x)]))))