1#lang racket/base
2
3(provide read-xbm)
4
5(define rx:define #rx#"#define[ \t]+[-A-Za-z0-9_]+[ \t]+([0-9]+)")
6(define rx:byte #rx#"0x([0-9a-fA-F][0-9a-fA-F])")
7
8(define (read-xbm in)
9  (let/ec esc
10    (let ([w (regexp-match rx:define in)]
11          [h (regexp-match rx:define in)])
12      (if (and w h)
13          (let ([w (string->number (bytes->string/latin-1 (cadr w)))]
14                [h (string->number (bytes->string/latin-1 (cadr h)))])
15            (if (and (exact-integer? w)
16                     (exact-integer? h)
17                     (positive? w)
18                     (positive? h))
19                (values
20                 w
21                 h
22                 (list->vector
23                  (for/list ([i (in-range h)])
24                    (list->bytes
25                     (for/list ([j (in-range (quotient (+ w 7) 8))])
26                       (let ([m (regexp-match rx:byte in)])
27                         (if m
28                             (string->number (bytes->string/latin-1 (cadr m)) 16)
29                             (esc #f #f #f))))))))
30                (values #f #f #f)))
31          (values #f #f #f)))))
32