30 lines
1 KiB
Racket
30 lines
1 KiB
Racket
(define (read-ppm port)
|
|
(parameterize ([current-input-port port])
|
|
(define magic (read-line))
|
|
(match-define (list w h) (string-split (read-line) " "))
|
|
(define width (string->number w))
|
|
(define height (string->number h))
|
|
(define maxcol (string->number (read-line)))
|
|
(define bm (make-object bitmap% width height))
|
|
(define dc (new bitmap-dc% [bitmap bm]))
|
|
(send dc set-smoothing 'unsmoothed)
|
|
(define (adjust v) (* 255 (/ v maxcol)))
|
|
(for/list ([x width])
|
|
(for/list ([y height])
|
|
(define red (read-byte))
|
|
(define green (read-byte))
|
|
(define blue (read-byte))
|
|
(define color (make-object color% (adjust red) (adjust green) (adjust blue)))
|
|
(send dc set-pen color 1 'solid)
|
|
(send dc draw-point x y)))
|
|
bm))
|
|
|
|
(define (image->bmp filename)
|
|
(define command (format "convert ~a ppm:-" filename))
|
|
(match-define (list in out pid err ctrl) (process command))
|
|
(define bmp (read-ppm in))
|
|
(close-input-port in)
|
|
(close-output-port out)
|
|
bmp)
|
|
|
|
(image->bmp "input.jpg")
|