An enumeration of all bitmaps

image-enum.rkt

#lang racket
(require data/enumerate)
(require data/enumerate/lib)
(require racket/draw)
(require pict)

;; adjust byte size to shrink the range of colors
(define byte-size 256)
(define byte/e (below/e byte-size))
(define (byte->actual x)
  (* (/ 255 (sub1 byte-size)) x))

(define (row/e /e n) (listof-n/e /e n))
(define (color-bytes/e w h)
   (listof-n/e (row/e (listof-n/e byte/e 3) w) h))

(define (full-color-bytes/e mw mh)
  (dep/e
   (cons/e (nat+/e mh) (nat+/e mw))
   (lambda (w/h)
     (color-bytes/e (car w/h) (cdr w/h)))
   #:f-range-finite? #t))

;; Maps between the enumerations of lists
;; and actual bitmaps
(define (color-img/e mw mh)
  (map/e
   (lambda (l)
     (define w (car (car l)))
     (define h (cdr (car l)))
     (define bytes (make-bytes (* 4 w h) 255))
     (define img (cdr l))
     (for ([y (in-naturals)] [row (in-list img)])
       (for ([x (in-naturals)] [pixel (in-list row)])
         (for ([offset (in-naturals 1)] [component (in-list pixel)])
           (define c (+ offset (* 4 x) (* w 4 y)))
           (bytes-set! bytes c (byte->actual component)))))
     (define b (make-object bitmap% w h))
     (send b set-argb-pixels 0 0 w h bytes)
     b)

   (lambda (b)
     (define w (send b get-width))
     (define h (send b get-height))
     (define bytes (make-bytes (* 4 w h) 0))
     (send b get-argb-pixels 0 0 w h bytes)
     (cons
      (cons w h)
      (for/list ([y (in-range h)])
        (for/list ([x (in-range w)])
          (for/list ([offset (in-range 1 4)])
            (define c (+ offset (* 4 x) (* 4 w y)))
            (bytes-ref bytes c))))))
   #:contract (is-a?/c bitmap%)
   (full-color-bytes/e mw mh)))

(define all-img/e (color-img/e 0 0))

(define (random-image)
  (define i (random-index all-img/e))
  (values
   i
   (from-nat all-img/e i)))

(define (encode p)
  (to-nat all-img/e p))
(define (decode p)
  (from-nat all-img/e p))

(define circ-i (encode (pict->bitmap (circle 100))))
#; circ-i ;; It takes longer to print the index than it does to compute it
(decode circ-i)