honeylisp/editor/tileedit/init.fnl

(local GraphicsEditView (require :editor.gfxedit))
(local style (require :core.style))
(local tiles (require :game.tiles))
(local files (require :game.files))
(local util (require :lib.util))
(local lume (require :lib.lume))
(local {: show} (util.require :inspector.debug))
(local {: mouse-inside : activate : active? : checkbox : textfield : button : dropdown : with-style
        : under : right-of : reform : horiz-wrapper : group-wrapper} (util.require :editor.imgui))

(local TileView (GraphicsEditView:extend))

(set TileView.pixel-size 24)
(local pixel-size TileView.pixel-size)

(fn TileView.tilekeys [self]
  (if files.game.tilesets (icollect [_ key (pairs files.game.tilesets)] key)
    [:gfx]))
(fn TileView.tilebytelen [self] (let [(w h) (self:tilesize)] (/ (* w h) (self:pixel-storage-divisor))))

(fn get-byte [tile ibyte]
  (or (: (tile:sub (+ ibyte 1) (+ ibyte 1)) :byte) 0))
(fn get-bits [tile ibyte ibit mask]
  (-> (get-byte tile ibyte)
      (bit.band (bit.lshift mask ibit))
      (bit.rshift ibit)))
(fn set-bits [tile ibyte ibit mask bits]
  (local orval (bit.lshift mask ibit))
  (-> (get-byte tile ibyte)
    (bit.band (bit.bnot orval))
    (bit.bor (bit.lshift bits ibit))))

(fn set-tile-bits [tile ibyte ibit mask bits]
  (util.splice tile ibyte (string.char (set-bits tile ibyte ibit mask bits))))

(files.platform-methods TileView :editor.tileedit :map-bitxy :pixel-color :draw-on :draw-off :draw-bits
  :palette :pixel-storage-divisor)

(files.default-platform-method TileView :editor.tileedit :preview-locations
  (fn [self] (let [(w h) (self:tilesize)] [[0 0] [w 0] [0 h] [w h]])))

(files.default-platform-method TileView :editor.tileedit :blank-tile-byte #"\0")

(fn TileView.tile [self]
  (local (w h) (self:tilesize))
  (or (-?> self.tilecache.tiles (. self.itile) (. (or self.tilekey :gfx)))
      (string.rep (self:blank-tile-byte) (/ (* w h) (self:pixel-storage-divisor)))))

(fn TileView.draw-pixel [self x y colorbg ?colorfg]
  (renderer.draw_rect x y pixel-size pixel-size colorbg)
  (when ?colorfg (renderer.draw_rect (+ x 3) (+ y 3) (- pixel-size 6) (- pixel-size 6) ?colorfg)))

(fn tile-editor [{:view self : x : y &as form} tile]
  (local {: tag} (with-style form :tag :tile))
  (when (not (active? self tag)) (self:draw-off))
  (local (w h) (self:tilesize))
  (set form.w (* (+ pixel-size 1) w))
  (set form.h (* (+ pixel-size 1) h))
  (activate form)
  (for [bitx 0 (- w 1)] (for [bity 0 (- h 1)]
    (local (ibyte ibit mask) (self:map-bitxy bitx bity w h))
    (local b (get-bits tile ibyte ibit mask))
    (local (px py) (values (+ x (* bitx (+ pixel-size 1))) (+ y (* bity (+ pixel-size 1)))))
    (local (colorbg colorfg) (self:pixel-color b ibyte ibit))
    (self:draw-pixel px py colorbg colorfg)
    (when (and (active? self tag) (mouse-inside px py pixel-size pixel-size))
      (self:draw-on b)
      (local bits (self:draw-bits))
      (when (not= bits b)
        (self:update-tile (set-tile-bits tile ibyte ibit mask bits))))))
  (love.graphics.setColor 1 1 1 1))

(fn TileView.draw-tile-editor [self form tile] (tile-editor form tile))

(fn tile-flag [form tile flagname]
  (local flagset (?. tile :flags flagname))
  (when (checkbox form flagname flagset)
    (tset tile :flags flagname (if flagset nil true))))

(fn TileView.draw-tile-flags [self form]
  (let [tile (-?> self.tilecache.tiles (. self.itile))
        fieldform {:wlabel (* 100 SCALE) :wtext (* 200 SCALE)}]
    (when tile
      (set tile.word (textfield (reform form fieldform) "Default word" tile.word))
      (set tile.label (textfield (under form fieldform) "Label" tile.label)))
    (each [iflag flagname (ipairs (tiles.flags))]
      (tile-flag (under form) tile flagname))))

(fn tile-preview [{:view self : x : y &as form} itile tilekey]
  (each [_ [tx ty] (ipairs (self:preview-locations))]
    (let [dx (* tx self.sprite-scale) dy (* ty self.sprite-scale)
          (w h) (self:draw-sprite (+ x dx) (+ y dy) itile tilekey)]
      (when (and w (or (= form.w nil) (< form.w (+ w dx)))) (set form.w (+ w dx)))
      (when (and h (or (= form.h nil) (< form.h (+ h dy)))) (set form.h (+ h dy))))))
(fn TileView.draw-tile-preview [self form] (tile-preview form self.itile self.tilekey))

(fn tile-palette [{:view self : x : y : w &as form} pal selected-color]
  (let [g (group-wrapper (with-style form))
        wrap (horiz-wrapper form)]
    (var selected-color selected-color)
    (each [icolor color (ipairs pal)]
      (renderer.draw_rect form.x form.y pixel-size pixel-size color)
      (when (= icolor selected-color)
        (love.graphics.setColor 1 1 1 1)
        (love.graphics.rectangle :line (- form.x 2) (- form.y 2) (+ pixel-size 4) (+ pixel-size 4)))
      (when (g button (reform form {:tag [:pal icolor] :w pixel-size :h pixel-size}))
        (set selected-color icolor))
      (wrap form))
    (g)
    selected-color))

(fn TileView.draw-tile-palette [self form]
  (match (self:palette)
    pal (set self.icolor (tile-palette form pal self.icolor))))

(fn TileView.update-tile [self newtile]
    (self.tilecache:update-tile self.itile newtile self.tilekey))

(fn style-selector [form current-style]
  (let [{:view self : x : y : font : color : ypad} (with-style form)
        form-drop (lume.merge form {:x (+ x (* 50 SCALE)) :w (* 100 SCALE) :tag :layer-selector})
        selection (dropdown form-drop current-style (tiles.tile-styles))]
    (renderer.draw_text font "Style" x (+ y (/ ypad 2)) color)
    (set form.w (- (+ form-drop.x form-drop.w) x))
    (set form.h form-drop.h)
    (when (not= current-style selection) selection)))

(fn TileView.draw-style-selector [self form]
  (match (style-selector form self.style)
    new-style (self:set-style new-style)))

(fn TileView.draw [self]
  (self:draw_background style.background)
  (self:draw_scrollbar)
  (let [form (self:form)
        form-side (self:form)
        full-width {:w form.w}]
    (self:draw-tile-editor form (self:tile))

    ; layout sidebar
    (self:draw-tile-flags (right-of form {:into form-side}))
    (self:draw-tile-preview (under form-side))

    ; continue laying out under tile editor
    (self:draw-tile-palette (under form full-width))
    (when (> (length (tiles.tile-styles)) 1)
      (self:draw-style-selector (under form)))
    (each [_ key (ipairs (self:tilekeys))]
      (self:draw-tile-selector (under form full-width) key))
    (self:end-scroll form)))

(fn TileView.initial-style [self] :tiles)
(fn TileView.get_name [self] "Tile Editor")

TileView