diff --git a/xenomorph/xenomorph/redo/bitfield.rkt b/xenomorph/xenomorph/redo/bitfield.rkt new file mode 100644 index 00000000..79877e34 --- /dev/null +++ b/xenomorph/xenomorph/redo/bitfield.rkt @@ -0,0 +1,52 @@ +#lang racket/base +(require "helper.rkt" racket/dict sugar/unstable/dict) +(provide (all-defined-out)) + +#| +approximates +https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee +|# + +(define (xbitfield-decode xb [port-arg (current-input-port)] #:parent [parent #f]) + (define port (->input-port port-arg)) + (define flag-hash (mhasheq)) + (define val (decode (xbitfield-type xb) port)) + (for ([(flag i) (in-indexed (xbitfield-flags xb))] + #:when flag) + (hash-set! flag-hash flag (bitwise-bit-set? val i))) + flag-hash) + +(define (xbitfield-encode xb flag-hash [port-arg (current-output-port)] #:parent [parent #f]) + (define port (if (output-port? port-arg) port-arg (open-output-bytes))) + (define bit-int (for/sum ([(flag i) (in-indexed (xbitfield-flags xb))] + #:when (and flag (dict-ref flag-hash flag #f))) + (arithmetic-shift 1 i))) + (encode (xbitfield-type xb) bit-int port) + (unless port-arg (get-output-bytes port))) + +(define (xbitfield-size xb [val #f] [ctx #f]) + (size (xbitfield-type xb))) + +(struct xbitfield (type flags) #:transparent + #:methods gen:xenomorphic + [(define decode xbitfield-decode) + (define encode xbitfield-encode) + (define size xbitfield-size)]) + +(define (+xbitfield type [flags null]) + (unless (andmap (λ (f) (or (symbol? f) (not f))) flags) + (raise-argument-error '+xbitfield "list of symbols" flags)) + (xbitfield type flags)) + +(module+ test + (require rackunit "number.rkt") + (define bfer (+xbitfield uint16be '(bold italic underline #f shadow condensed extended))) + (define bf (decode bfer #"\0\25")) + (check-equal? (length (dict-keys bf)) 6) ; omits #f flag + (check-true (dict-ref bf 'bold)) + (check-true (dict-ref bf 'underline)) + (check-true (dict-ref bf 'shadow)) + (check-false (dict-ref bf 'italic)) + (check-false (dict-ref bf 'condensed)) + (check-false (dict-ref bf 'extended)) + (check-equal? (encode bfer bf #f) #"\0\25")) \ No newline at end of file diff --git a/xenomorph/xenomorph/redo/test/bitfield-test.rkt b/xenomorph/xenomorph/redo/test/bitfield-test.rkt new file mode 100644 index 00000000..a74e670e --- /dev/null +++ b/xenomorph/xenomorph/redo/test/bitfield-test.rkt @@ -0,0 +1,45 @@ +#lang racket/base +(require rackunit + racket/match + racket/list + sugar/unstable/dict + "../helper.rkt" + "../number.rkt" + "../bitfield.rkt") + +#| +approximates +https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee +|# + +(define bitfield (+xbitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack))) +(match-define (list JACK KACK LACK MACK NACK OACK PACK QUACK) + (map (λ (x) (arithmetic-shift 1 x)) (range 8))) + +(test-case + "bitfield should have the right size" + (check-equal? (size bitfield) 1)) + +(test-case + "bitfield should decode" + (parameterize ([current-input-port (open-input-bytes (bytes (bitwise-ior JACK MACK PACK NACK QUACK)))]) + (check-equal? (decode bitfield) (mhasheq 'Quack #t + 'Nack #t + 'Lack #f + 'Oack #f + 'Pack #t + 'Mack #t + 'Jack #t + 'Kack #f)))) + +(test-case + "bitfield should encode" + (check-equal? (encode bitfield (mhasheq 'Quack #t + 'Nack #t + 'Lack #f + 'Oack #f + 'Pack #t + 'Mack #t + 'Jack #t + 'Kack #f) #f) + (bytes (bitwise-ior JACK MACK PACK NACK QUACK)))) diff --git a/xenomorph/xenomorph/redo/test/main.rkt b/xenomorph/xenomorph/redo/test/main.rkt index 4426421f..146168ab 100644 --- a/xenomorph/xenomorph/redo/test/main.rkt +++ b/xenomorph/xenomorph/redo/test/main.rkt @@ -1,7 +1,7 @@ #lang racket/base (require "array-test.rkt" - ;"bitfield-test.rkt" + "bitfield-test.rkt" ;"buffer-test.rkt" ;"enum-test.rkt" ;"lazy-array-test.rkt"