[racket] 2htdp/image: colors and alphas

From: Robby Findler (robby at eecs.northwestern.edu)
Date: Mon Dec 27 22:53:09 EST 2010

On Mon, Dec 27, 2010 at 7:58 AM, Robby Findler
<robby at eecs.northwestern.edu> wrote:
> [ sorry -- hit send too soon. ]
> I like your idea for alphas in colors. I'll add that, hopefully today.

I've added that now (just now pushed) and below is the revised version
of the map-image function to take advantage of it. The example
map-image demonstrate how using the alpha values can improve the

(Still missing good error checking, tho.)


#lang racket/base
(require racket/draw
         (only-in mrlib/image-core render-image))

(define (map-image img f)
  (define w (image-width img))
  (define h (image-height img))
  (define bm (make-bitmap w h))
  (define bdc (make-object bitmap-dc% bm))
  (render-image img bdc 0 0)
  (send bdc set-bitmap #f)
  (define bytes (make-bytes (* w h 4)))
  (send bm get-argb-pixels 0 0 w h bytes)
  (for ([i (in-range 0 (* w h 4) 4)])
    (define nc
      (f (make-color (bytes-ref bytes (+ i 1))
                     (bytes-ref bytes (+ i 2))
                     (bytes-ref bytes (+ i 3))
                     (bytes-ref bytes i))))
    (bytes-set! bytes i (color-alpha nc))
    (bytes-set! bytes (+ i 1) (color-red nc))
    (bytes-set! bytes (+ i 2) (color-green nc))
    (bytes-set! bytes (+ i 3) (color-blue nc)))
  (send bm set-argb-pixels 0 0 w h bytes)
  (make-object image-snip% bm))

(define i
  (overlay (rectangle 100 10 "solid" "red")
           (circle 20 "solid" "lightblue")
           (rectangle 10 100 "solid" "forestgreen")))

(define (grey c)
  (define avg (floor (/ (+ (color-red c)
                           (color-blue c)
                           (color-green c))
  (color avg avg avg))

(define (grey/alpha c)
  (define avg (floor (/ (+ (color-red c)
                           (color-blue c)
                           (color-green c))
  (color avg avg avg (color-alpha c)))

(map-image i grey)
(map-image i grey/alpha)

Posted on the users mailing list.