#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