application/octet-stream
•
2.98 KB
•
96 lines
;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; Contains some functions for working with image data
;;;
;;; Should only contain some basic functions, as well as some
;;; functions which can then be extended via modules, like the
;;; generic functions image/save! and image/load! which by default
;;; will probably only every support BMP files.
;;;
;;; Some simple drawing routines (line/box/circle) and some simple
;;; filters (scale/blur) would also be good to have here.
[def image/decoders @[]]
[def image/encoders @[]]
[defn add-encoder! [ext enc]
:export
[def ext [string->keyword [lower-case ext]]]
[tree/set! image/encoders ext enc]]
[defn add-decoder! [ext dec]
:export
[def ext [string->keyword [lower-case ext]]]
[tree/set! image/decoders ext dec]]
[defn get-encoder [path]
[def ext [string->keyword [lower-case [path/extension path]]]]
[tree/ref image/encoders ext]]
[defn get-decoder [path]
[def ext [string->keyword [lower-case [path/extension path]]]]
[tree/ref image/decoders ext]]
[defn new [width height]
:export
[def buffer [buffer/allocate [* width height 4]]]
@[ :width width
:height height
:buffer buffer
:pixels [buffer/u32* buffer]]]
[defn image/ref [img x y]
:export-as ref
[def i [+ [int x] [* [int y] [tree/ref img :width]]]]
[buffer/ref [tree/ref img :pixels] i]]
[defn image/set! [img x y value]
:export-as set!
[def i [+ [int x] [* [int y] [tree/ref img :width]]]]
[buffer/set! [tree/ref img :pixels] i value]]
[defn fill! [img value]
:export
[def p [tree/ref img :pixels]]
[dotimes [i [* [tree/ref img :width] [tree/ref img :height]] img]
[buffer/set! p i value]]]
[defn map! [img fun]
:export
[def p [tree/ref img :pixels]]
[dotimes [i [* [tree/ref img :width] [tree/ref img :height]] img]
[buffer/set! p i [fun [buffer/ref p i]]]]]
[defn dup [img]
:export
[def ret [image/new [tree/ref img :width]
[tree/ref img :height]]]
[def in [tree/ref img :pixels]]
[def out [tree/ref ret :pixels]]
[dotimes [i [* [tree/ref img :width] [tree/ref img :height]] img]
[buffer/set! out i [buffer/ref in i]]]]
[defn save! [img path]
:export
[def enc [get-encoder path]]
[if enc
[file/write [enc img] path]
[exception :missing-encoder "Currently there is no encoder loaded for that image format" path]]]
[defn adler32 [img]
:export
[import [hash] :crypto/adler32]
[hash [tree/ref img :buffer]]]
[defn test-image-xor []
:export
[def w 256]
[def h 256]
[def out [new w h]]
[dotimes [x w out]
[dotimes [y h]
[image/set! out x y [bit-or x [bit-shift-left y 8] [bit-shift-left [bit-xor x y] 16]]]]]]
[deftest 4040398435 [image/adler32 [image/test-image-xor]]]
