aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

40
Task/Bitmap-Write-a-PPM-file/Racket/bitmap-write-a-ppm-file.rkt Normal file
View file

@ -0,0 +1,40 @@
;P3
(define (bitmap->ppm bitmap output-port)
(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
(parameterize ([current-output-port output-port])
(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
(call-with-output-file "image.ppm" #:exists 'replace #:mode 'text
(lambda (out)
(bitmap->ppm bm out)))
; P6
(define (bitmap->ppm bitmap output-port)
(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
(parameterize ([current-output-port output-port])
(printf "P6\n~a ~a\n255\n" width height) ;header
(for ([i (* width height)])
(define pixel-position (* 4 i))
(write-byte (bytes-ref buffer (+ pixel-position 1))) ; r
(write-byte (bytes-ref buffer (+ pixel-position 2))) ; g
(write-byte (bytes-ref buffer (+ pixel-position 3)))))) ;b
(call-with-output-file "image.ppm" #:exists 'replace #:mode 'binary
(lambda (out)
(bitmap->ppm bm out)))
;or any other output port