Skip to content

Instantly share code, notes, and snippets.

@cosmez
Last active December 19, 2015 17:18
Show Gist options
  • Save cosmez/5989676 to your computer and use it in GitHub Desktop.
Save cosmez/5989676 to your computer and use it in GitHub Desktop.
#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