Ben / Nujel

;;; 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))))
      (ref image/encoders ext))

(defn get-decoder (path)
      (def ext (string->keyword (lower-case (path/extension path))))
      (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) (ref img :width))))
      (ref (ref img :pixels) i))

(defn image/set! (img x y value)
      :export-as set!
      (def i (+ (int x) (* (int y) (ref img :width))))
      (buffer/set! (ref img :pixels) i value))

(defn fill! (img value)
      :export
      (def p (ref img :pixels))
      (dotimes (i (* (ref img :width) (ref img :height)) img)
        (buffer/set! p i value)))

(defn map! (img fun)
      :export
      (def p (ref img :pixels))
      (dotimes (i (* (ref img :width) (ref img :height)) img)
        (buffer/set! p i (fun (ref p i)))))

(defn dup (img)
      :export
      (def ret (image/new (ref img :width)
                          (ref img :height)))
      (def in (ref img :pixels))
      (def out (ref ret :pixels))
      (dotimes (i (* (ref img :width) (ref img :height)) img)
        (buffer/set! out i (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 (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)))