Created
November 28, 2012 23:46
-
-
Save jbclements/4165617 to your computer and use it in GitHub Desktop.
possibly a bug in get-argb-pixels?
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#lang racket | |
(require 2htdp/image | |
(only-in mred make-bitmap bitmap-dc% color%) | |
(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-bitmap w h)) | |
(define bdc (make-object bitmap-dc% bm)) | |
(render-image image bdc (- x) (- y)) | |
;; 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) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment