honeylisp/editor/tileedit.fnl

(local core (require :core))
(local command (require :core.command))
(local style (require :core.style))
(local View (require :core.view))
(local tiles (require :game.tiles))
(local tiledraw (require :editor.tiledraw))
(local lume (require :lib.lume))
(local util (require :lib.util))
(local {: attach-imstate : mouse-inside : activate : active? : button} (util.require :editor.imstate))
(local TileView (View:extend))

(local pixel-size 24)
(local sprite-scale 4)

(local xy-to-ibit [])
(for [x 0 15] (tset xy-to-ibit x []))
(for [y 0 15]
  (tset (. xy-to-ibit 0) y (+ (* y 8) 7))
  (for [ibit 0 6]
    (tset (. xy-to-ibit (+ ibit 1)) y (+ (* y 8) ibit))))
(for [y 0 15] (for [x 0 7]
  (tset (. xy-to-ibit (+ x 8)) y (+ (* (+ y 16) 8) x))))
(fn map-bitxy [x y]
  (when (and (>= x 0) (< x 16) (>= y 0) (< y 16))
    (local ibit (. xy-to-ibit x y))
    (values (math.floor (/ ibit 8)) (% ibit 8))))

(fn get-byte [tile ibyte]
  (: (tile:sub (+ ibyte 1) (+ ibyte 1)) :byte))
(fn get-bit [tile ibyte ibit]
  (not= 0 (bit.band (get-byte tile ibyte) (bit.lshift 1 ibit))))
(fn set-bit [tile ibyte ibit is-set]
  (local orval (bit.lshift 1 ibit))
  (-> (get-byte tile ibyte)
    (bit.band (bit.bnot orval))
    (bit.bor (if is-set orval 0))))

(fn set-tile-bit [tile ibyte ibit is-set]
  (..
    (tile:sub 1 ibyte)
    (string.char (set-bit tile ibyte ibit is-set))
    (tile:sub (+ ibyte 2))))

(fn draw-bit-color [bit x y]
  (local (bgcolor color) (tiledraw.pal-from-bit bit))
  (renderer.draw_rect x y pixel-size pixel-size bgcolor)
  (renderer.draw_rect (+ x 3) (+ y 3) (- pixel-size 6) (- pixel-size 6) color))

(fn draw-bit [bit x y even]
  (renderer.draw_rect x y pixel-size pixel-size (if bit [255 255 255] [0 0 0])))

(fn TileView.new [self]
  (TileView.super.new self)
  (set self.tiles (tiles.loadtiles))
  (set self.itile 1)
  (set self.tilesprites [])
  (attach-imstate self))

(fn TileView.tile [self] (or (. self.tiles self.itile) (string.rep "\0" 32)))

(fn TileView.draw-tile [self tile x y]
  (when (not (active? self :tile))
    (set self.bit nil))
  (activate self :tile x y (* (+ pixel-size 1) 16) (* (+ pixel-size 1) 16))
  (for [bitx 0 15] (for [bity 0 15]
    (local (ibyte ibit) (map-bitxy bitx bity))
    (local bit (get-bit tile ibyte ibit))
    (local (px py) (values (+ x (* bitx (+ pixel-size 1))) (+ y (* bity (+ pixel-size 1)))))
    (if (or (= bitx 0) (= bitx 15))
      (draw-bit-color bit px py)
      (draw-bit bit px py (= (% bitx 2) 1)))
    (when (and (active? self :tile) (mouse-inside px py pixel-size pixel-size))
      (when (= self.bit nil) (set self.bit (not bit)))
      (when (not= self.bit bit)
        (self:update-tile (set-tile-bit tile ibyte ibit self.bit))))))
  (love.graphics.setColor 1 1 1 1))

(fn TileView.update-tile [self newtile]
  (tset self.tiles self.itile newtile)
  (tset self.tilesprites self.itile nil))

(fn TileView.save [self] (tiles.savetiles self.tiles))
(fn TileView.select-rel [self ditile]
  (local itile (+ self.itile ditile))
  (when (>= itile 1) (set self.itile itile)))

(fn TileView.tilesprite [self itile]
  (when (and (= nil (. self.tilesprites itile)) (not= nil (. self.tiles itile)))
    (tset self.tilesprites itile (tiledraw.tile-to-sprite (. self.tiles itile))))
  (. self.tilesprites itile))

(fn TileView.draw [self]
  (self:draw_background style.background)
  (local (x y) (values (+ self.position.x 10) (+ self.position.y 10)))
  (self:draw-tile (self:tile) x y)
  (var tilex (+ self.position.x 10))
  (var tiley (+ self.position.y (* 18 (+ pixel-size 1))))
  (local tile-size (* 16 sprite-scale))
  (each [itile _ (ipairs self.tiles)]
    (love.graphics.draw (self:tilesprite itile) tilex tiley 0 sprite-scale sprite-scale)
    (when (= itile self.itile)
      (love.graphics.rectangle :line (- tilex 2) (- tiley 2) (+ (* 14 sprite-scale) 4) (+ tile-size 4)))
    (when (button self [:tile itile] tilex tiley tile-size tile-size)
      (set self.itile itile))
    (set tilex (+ tilex tile-size))
    (when (>= (+ tilex tile-size) (+ self.position.x self.size.x -10))
      (set tilex (+ self.position.x 10))
      (set tiley (+ tiley tile-size 4)))))

(fn TileView.get_name [self] "Tile Editor")

TileView