honeylisp/editor/tiledraw/init.fnl

(local files (require :game.files))
(local TileDraw {})

(fn TileDraw.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 TileDraw.make-canvas [w h f]
  (local canvas (love.graphics.newCanvas w h))
  (local prevcanvas (love.graphics.getCanvas))
  (canvas:setFilter :nearest :nearest)
  (local scissor [(love.graphics.getScissor)])
  (love.graphics.setScissor)
  (love.graphics.setCanvas canvas)
  (love.graphics.clear 0 0 0)
  (f canvas)
  (love.graphics.setCanvas prevcanvas)
  (love.graphics.setScissor (table.unpack scissor))
  (love.graphics.setColor 1 1 1 1)
  canvas)

(files.platform-methods TileDraw :editor.tiledraw
  :tile-to-sprite :char-to-sprite :portrait-to-sprite :screen-to-sprite :screen-y-to-offset
  :pal-from-bit :pal-from-byte :draw-byte)

(files.default-platform-method TileDraw :editor.tiledraw :tilestrip-to-sprite
  (fn [tiles]
    (let [sprites (icollect [_ tile (ipairs tiles)] (TileDraw.tile-to-sprite tile))]
      (TileDraw.make-canvas (* (: (. sprites 1) :getWidth) (length sprites)) (: (. sprites 1) :getHeight)
        #(each [isprite sprite (ipairs sprites)]
          (love.graphics.draw sprite (* (sprite:getWidth) (- isprite 1)) 0))))))

(files.default-platform-method TileDraw :editor.tiledraw :spritegen-for-style
  (fn [style]
    (match style
       :font TileDraw.char-to-sprite
       :brushes TileDraw.char-to-sprite
       :portraits TileDraw.portrait-to-sprite
       _ TileDraw.tile-to-sprite)))

(fn TileDraw.TileCache [tiles ?spritegen]
  {: tiles
   :spritegen (or ?spritegen TileDraw.tile-to-sprite)
   :tilesprites []
   :tile (fn [self itile] (or (. self.tiles itile) {:flags {}}))
   :cachekey (fn [itile ?key] (.. (or ?key :gfx) itile))
   :update-tile
   (fn [self itile tile ?key]
     (tset self.tiles itile
       (-> (self:tile itile)
         (doto (tset (or ?key :gfx) tile))))
     (tset self.tilesprites (self.cachekey itile ?key) 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 ?key]
     (local key (self.cachekey itile ?key))
     (when (and (= nil (. self.tilesprites key)) (not= nil (. self.tiles itile)))
       (tset self.tilesprites key (self.spritegen (. self.tiles itile (or ?key :gfx)))))
     (. self.tilesprites key))})

TileDraw