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