Last active
December 19, 2015 17:18
-
-
Save cosmez/5989676 to your computer and use it in GitHub Desktop.
This file contains 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 | |
;; The racket/draw libraries provide imperative drawing functions. | |
;; http://docs.racket-lang.org/draw/index.html | |
(require racket/draw) | |
;; To create an image with width and height, use the make-bitmap | |
;; function. | |
;; For example, let's make a small image here: | |
(define bm (make-bitmap 640 480)) | |
;; We use a drawing context handle, a "dc", to operate on the bitmap. | |
(define dc (send bm make-dc)) | |
;; We can fill the bitmap with a color by using a combination of | |
;; setting the background, and clearing. | |
(send dc set-background (make-object color% 0 0 0)) ;; Color it black. | |
(send dc clear) | |
;; Let's set a few pixels to a greenish color with set-pixel: | |
(define aquamarine (send the-color-database find-color "aquamarine")) | |
(for ([i 480]) | |
(send dc set-pixel i i aquamarine)) | |
;; We can get at the color of a bitmap pixel by using the get-pixel | |
;; method. However, it may be faster to use get-argb-pixels if we | |
;; need a block of the pixels. Let's use get-argb-pixels and look | |
;; at a row starting at (0, 42) | |
(define buffer (make-bytes (* 480 4))) ;; alpha, red, green, blue | |
(send dc get-argb-pixels 0 42 480 1 buffer) | |
; (-> (is-a?/c bitmap%) path-string? any) | |
(define (bitmap->ppm bitmap path) | |
(define height (send bitmap get-height)) | |
(define width (send bitmap get-width)) | |
(define buffer (make-bytes (* width height 4))) ;buffer for storing argb data | |
(send bitmap get-argb-pixels 0 0 width height buffer) ;copy pixels | |
(with-output-to-file ;start writing | |
path #:mode 'text #:exists 'replace | |
(lambda () | |
(printf "P3\n~a ~a\n255" width height) ;header | |
(for ([i (* width height)]) | |
(define pixel-position (* 4 i)) | |
(when (= (modulo i width) 0) (printf "\n")) ;end of row | |
(printf "~s ~s ~s " | |
(bytes-ref buffer (+ pixel-position 1)) ;r | |
(bytes-ref buffer (+ pixel-position 2)) ;g | |
(bytes-ref buffer (+ pixel-position 3))))))) ;b | |
(bitmap->ppm bm "image.ppm") | |
bm |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment