honeylisp/editor/tiledraw.fnl

84 lines
2.7 KiB
Fennel

(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}