42 lines
1.5 KiB
Racket
42 lines
1.5 KiB
Racket
#lang racket
|
||
(require racket/draw)
|
||
|
||
(define (gray->color gray-bm)
|
||
(define gray-dc (new bitmap-dc% [bitmap gray-bm]))
|
||
(define-values (w h) (send gray-dc get-size))
|
||
(define width (exact-floor w))
|
||
(define height (exact-floor h))
|
||
(define color-bm (make-bitmap width height))
|
||
(define color-dc (new bitmap-dc% [bitmap color-bm]))
|
||
(define pixels (make-bytes (* 4 width height)))
|
||
(send gray-dc get-argb-pixels 0 0 width height pixels)
|
||
(send color-dc set-argb-pixels 0 0 width height pixels)
|
||
color-bm)
|
||
|
||
(define (color->gray color-bm)
|
||
(define color-dc (new bitmap-dc% [bitmap color-bm]))
|
||
(define-values (w h) (send color-dc get-size))
|
||
(define width (exact-floor w))
|
||
(define height (exact-floor h))
|
||
(define gray-bm (make-bitmap width height))
|
||
(define gray-dc (new bitmap-dc% [bitmap gray-bm]))
|
||
(define pixels (make-bytes (* 4 width height)))
|
||
(send color-dc get-argb-pixels 0 0 width height pixels)
|
||
(for ([i (in-range 0 (* 4 width height) 4)])
|
||
(define α (bytes-ref pixels i))
|
||
(define r (bytes-ref pixels (+ i 1)))
|
||
(define g (bytes-ref pixels (+ i 2)))
|
||
(define b (bytes-ref pixels (+ i 3)))
|
||
(define l (exact-floor (+ (* 0.2126 r) (* 0.7152 g) (* 0.0722 b))))
|
||
(bytes-set! pixels (+ i 1) l)
|
||
(bytes-set! pixels (+ i 2) l)
|
||
(bytes-set! pixels (+ i 3) l))
|
||
(send gray-dc set-argb-pixels 0 0 width height pixels)
|
||
gray-bm)
|
||
|
||
(require images/icons/symbol)
|
||
(define rosetta (text-icon "Rosetta Code" #:color "red" #:height 80))
|
||
rosetta
|
||
(color->gray rosetta)
|
||
(gray->color (color->gray rosetta))
|