application/octet-stream
•
2.26 KB
•
53 lines
;; Contains a simple BMP en-/decoder
;;
;; Since Nujel is still quite small we can leave this in the stdlib, would
;; be put into a separate module though as soon as it becomes necessary.
[defn buffer/view/le/set! [u8v offset bytes val]
[while [> bytes 0]
[buffer/view/set! u8v [++ offset] [logand #xFF val]]
[-- bytes]
[set! val [ash val -8]]]
offset]
[defn image/bmp/row-padding [width pixel-length]
[def ret [- 4 [logand [* width pixel-length] 3]]]
[if [== ret 4] 0 ret]]
[defn image/bmp/encode [image]
[def image-size [* [tree/ref image :height]
3
[+ [tree/ref image :width]
[image/bmp/row-padding [tree/ref image :width] 3]]]]
[def header-size [+ 14 40]]
[def file-size [+ image-size header-size]]
[def out [buffer/allocate file-size]]
[def b [buffer/view/u8* out]]
[def i -1]
[buffer/view/set! b [++ i] #\B]
[buffer/view/set! b [++ i] #\M]
[set! i [buffer/view/le/set! b i 4 file-size]]
[set! i [buffer/view/le/set! b i 4 0]]
[set! i [buffer/view/le/set! b i 4 header-size]]
[set! i [buffer/view/le/set! b i 4 40]] ; BITMAPINFOHEADER
[set! i [buffer/view/le/set! b i 4 [tree/ref image :width]]]
[set! i [buffer/view/le/set! b i 4 [tree/ref image :height]]]
[set! i [buffer/view/le/set! b i 2 1]] ; Planes
[set! i [buffer/view/le/set! b i 2 24]] ; BPP
[set! i [buffer/view/le/set! b i 4 0]] ; Compression method
[set! i [buffer/view/le/set! b i 4 image-size]]
[set! i [buffer/view/le/set! b i 4 8192]] ; h. resolution
[set! i [buffer/view/le/set! b i 4 8192]] ; v. resolution
[set! i [buffer/view/le/set! b i 4 0]] ; Palette size, 0 for [^ 2 n]
[set! i [buffer/view/le/set! b i 4 0]] ; Important colors, 0 for all
[def row-padding [image/bmp/row-padding [tree/ref image :width] 3]]
[def pixels [- header-size 1]] ; Pixel data comes immediatly after the header
[for [y [- [tree/ref image :height] 1] -1 -1]
[for [x 0 [tree/ref image :width]]
[set! pixels [buffer/view/le/set! b pixels 3 [image/ref image x y]]]]
[set! pixels [+ pixels row-padding]]]
out]
[image/add-encoder! "bmp" image/bmp/encode]
