(fn pal-from-bit [bit]
  (if bit
    (values [20 207 253] [255 106 60])
    (values [255 68 253] [20 245 60])))

(fn pal-from-byte [byte]
  (pal-from-bit (not= 0 (bit.band byte 0x80))))

(fn putpixel [x y color]
  (when color
    (love.graphics.setColor (/ (. color 1) 255) (/ (. color 2) 255) (/ (. color 3) 255))
    (love.graphics.points (+ x 0.5) (+ y 0.5))))

(fn tile-to-sprite [tile]
  (local canvas (love.graphics.newCanvas 14 16))
  (canvas:setFilter :nearest :nearest)
  (local scissor [(love.graphics.getScissor)])
  (love.graphics.setScissor)
  (love.graphics.setCanvas canvas)
  (love.graphics.clear 0 0 0)
  (for [y 0 15]
    (local byte1 (string.byte (tile:sub (+ y 1) (+ y 1))))
    (local byte2 (string.byte (tile:sub (+ y 17) (+ y 17))))
    (local pal1 [(pal-from-byte byte1)])
    (local pal2 [(pal-from-byte byte2)])
    (var prevstate :off)
    (var state :off)
    (for [x 0 13]
      (local byte (if (< x 7) byte1 byte2))
      (local bitx (if (< x 7) x (- x 7)))
      (local bit  (not= 0 (bit.band byte (bit.lshift 1 bitx))))
      (local prevpal (if (< x 8) pal1 pal2))
      (local pal     (if (< x 7) pal1 pal2))
      (local prevart (. prevpal (+ 1 (% x 2))))
      (local art     (. pal (+ 1 (% x 2))))
      (set prevstate state)
      (set state
        (match [prevstate bit]
          [:off false]     :off
          [:off true]      :rising
          [:rising false]  :falling
          [:rising true]   :on
          [:falling false] :off
          [:falling true]  :rising
          [:on true]       :on
          [:on false]      :falling))
      (local white [255 255 255])
      (local (prevcolor color)
        (match [prevstate state]
          [_ :on]            (values white white)
          [:off :rising]     (values nil art)
          [:falling :rising] (values prevart art)))
      (putpixel (- x 1) y prevcolor)
      (putpixel x y color)))
  (love.graphics.setCanvas)
  (love.graphics.setScissor (table.unpack scissor))
  (love.graphics.setColor 1 1 1 1)
  canvas)

(fn TileCache [tiles]
  {: tiles
   :tilesprites []
   :tile (fn [self itile] (or (. self.tiles itile) {:flags {}}))
   :update-tile
   (fn [self itile tile]
     (tset self.tiles itile
       (-> (self:tile itile)
         (doto (tset :gfx tile))))
     (tset self.tilesprites itile nil))
   :set-flag
   (fn [self itile flag clear]
     (tset (. self.tiles itile :flags) flag (if clear nil true)))
   :load
   (fn [self tiles]
     (set self.tiles tiles)
     (set self.tilesprites []))
   :sprite
   (fn [self itile]
     (when (and (= nil (. self.tilesprites itile)) (not= nil (. self.tiles itile)))
       (tset self.tilesprites itile (tile-to-sprite (. self.tiles itile :gfx))))
     (. self.tilesprites itile))})

{: tile-to-sprite : pal-from-bit : pal-from-byte : TileCache}