bitmap rendering behaves strangely....

alpha-channel-experimentation.rkt

#lang racket

(require 2htdp/image
         (only-in mred make-bitmap bitmap-dc% color% bitmap%)
         (only-in 2htdp/private/image-more render-image)
         rackunit)

;; return a portion of the alpha map for the image
(define (image->alpha/cropped image x y w h)
  (define bm (make-object bitmap% w h #f #t))
  (define bdc (make-object bitmap-dc% bm))
  (render-image image bdc (- x) (- y))
  ;; use garbage values to make sure they're changing:
  (define test-color (make-object color% 243 23 9 0.4))
  (send bdc get-pixel 14 5 test-color)
  (let ([ans (send test-color red)])
    (printf "red: ~s\n" ans)
    ans)
  (let ([ans (send test-color green)])
    (printf "red: ~s\n" ans)
    ans)
  (let ([ans (send test-color blue)])
    (printf "red: ~s\n" ans)
    ans)
  (let ([ans (send test-color alpha)])
    (printf "red: ~s\n" ans)
    ans)
  ;; very unpacked, for the moment:
  (define alpha-bytes 
    (make-bytes (* 4 w h)))
  (send bdc get-argb-pixels 0 0 w h alpha-bytes #t)
  
  alpha-bytes)


(define test-image
  (overlay/xy (rotate 20 (star-polygon 15 9 4 "solid" "red"))
              40 20 
              (rectangle 5 7 "solid" "blue")))

test-image

(define (number->color n)
  (cond [(= n 0) (color 255 255 255)]
        [else (color (round (/ (- 255 n) 2))
                     (round (/ (- 255 n) 2))
                     (round (/ (- 255 n) 2))
                     )]))

(define (offset w) (* 4 (+ 16 (* 4 w))))

(define full-alpha-map 
  (image->alpha/cropped test-image 0 0 45 43))
(define cropped-alpha-map 
  (image->alpha/cropped test-image 0 0 24 12))

(check-equal? (bytes-ref full-alpha-map
                         (offset 45))
              (bytes-ref cropped-alpha-map
                         (offset 24)))

(define (every-fourth-byte b)
  (for/list ([i (in-range 0 (bytes-length b) 4)])
    (bytes-ref b i)))
(scale 10
(color-list->bitmap 
 (map number->color 
      (every-fourth-byte (image->alpha/cropped test-image 0 0 45 43)))
  45 43))
(scale 10
(color-list->bitmap 
 (map number->color 
      (every-fourth-byte (image->alpha/cropped test-image 0 0 24 12)))
  24 12))

(scale 10
(color-list->bitmap 
 (map number->color 
      (every-fourth-byte (image->alpha/cropped test-image 21 31 24 12)))
  24 12))



(define (image->cropped-bitmap image x y w h)
  (define bm (make-bitmap w h))
  (define bdc (make-object bitmap-dc% bm))
  (render-image image bdc (- x) (- y))
  bm)

(define cropped1 (image->cropped-bitmap test-image 0 0 24 12))
(define cropped2 (image->cropped-bitmap test-image 0 0 45 43))
(scale 10 cropped1)
(scale 10 cropped2)




(define bdc (make-object bitmap-dc% cropped1))
(define test-color (make-object color% 243 23 9 0.4))
(send bdc get-pixel 13 5 test-color)
(send test-color red)
(send test-color green)
(send test-color blue)
(send test-color alpha)