honeylisp/editor/mapedit.fnl

(local GraphicsEditView (require :editor.gfxedit2))
(local style (require :core.style))
(local util (require :lib.util))
(local lume (require :lib.lume))
(local files (require :game.files))
(local {: mouse-inside : activate : active? : checkbox : textfield : textbutton : textbox : dropdown : labelled-dropdown : vert : horiz : begin-group} (util.require :editor.imgui))
(local {: tilestrip-to-sprite} (util.require :editor.tiledraw))
(local {: encode-yx : encode-itile : decode-itile : dimensions} (util.require :game.tiles))
(local actions (require :editor.actions))

(local MapEditView (GraphicsEditView:extend))
(local sprite-scale 3)

(fn platform [?key] (let [p (dimensions)] (if ?key (. p ?key) p)))
(fn MapEditView.layer-type [self ?ilayer] (or (?. (platform :layers) (or ?ilayer self.ilayer)) :tiles))
(fn MapEditView.dimensions [self ?ilayer] (or (platform (self:layer-type)) (platform)))
(fn MapEditView.scaled-dimensions [self ?ilayer]
  (let [dim (lume.clone (self:dimensions))]
    (each [_ key (ipairs [:tilew :tileh :xstagger :ystagger])]
      (when (. dim key) (tset dim key (* sprite-scale (. dim key)))))
    dim))

(fn MapEditView.mapw [self ?ilayer] (. (self:dimensions ?ilayer) :mapw))
(fn MapEditView.maph [self ?ilayer] (. (self:dimensions ?ilayer) :maph))
(fn MapEditView.tilew [self ?ilayer] (. (self:scaled-dimensions ?ilayer) :tilew))
(fn MapEditView.tileh [self ?ilayer] (. (self:scaled-dimensions ?ilayer) :tileh))

(fn MapEditView.empty-map [self] (string.rep "\0" (* (self:mapw) (self:maph))))

(fn MapEditView.new [self]
  (MapEditView.super.new self)
  (set self.sprite-scale sprite-scale)
  (set self.stripcache {})
  (set self.ilevel 1)
  (self:set-ilayer 1)
  (self:reload))

; map is stored bottom-to-top
(fn MapEditView.imap-from-xy [self mx my]
  (+ mx -1 (* (self:mapw) (- (self:maph) my))))

(fn MapEditView.update-map [self map mx my itile]
  (local imap (self:imap-from-xy mx my))
  (local enctile (encode-itile itile))
  (..
    (map:sub 1 imap)
    (string.char enctile)
    (map:sub (+ imap 2))))

(fn MapEditView.map [self]
  (if (platform :layers) (or (?. self.level.layers self.ilayer) (self:empty-map))
    self.level.map))

(fn MapEditView.itile-from-xy [self mx my]
  (local imap (+ (self:imap-from-xy mx my) 1))
  (local enctile (string.byte (string.sub (self:map) imap imap)))
  (decode-itile enctile))

(fn MapEditView.set-tile [self mx my itile]
  (let [updated-map (self:update-map (self:map) mx my itile)]
    (if (platform :layers) (util.nested-tset self.level [:layers self.ilayer] updated-map)
      (set self.level.map updated-map))))

(fn MapEditView.iobject-from-xy [self mx my ?iobj]
  (local iobj (or ?iobj 1))
  (local obj (. self.level.objects iobj))
  (when obj
    (if (and (= obj.x mx) (= obj.y my))
      iobj
      (self:iobject-from-xy mx my (+ iobj 1)))))
(fn MapEditView.object [self] (. self.level.objects self.iobject))

(fn move-object [objects iobjectsrc iobjectdst]
  (each [_ object (pairs objects)]
    (when (= object.link iobjectsrc)
      (set object.link iobjectdst)))
  (tset objects iobjectdst (. objects iobjectsrc))
  (tset objects iobjectsrc nil)
  (when (. objects (+ iobjectsrc 1))
    (move-object objects (+ iobjectsrc 1) iobjectsrc)))

(fn MapEditView.levels [self]
  (when (= files.game.levels nil)
    (set files.game.levels []))
  files.game.levels)

(fn MapEditView.draw-map-selector [self {: x : y &as form}]
  (let [level-count (length (self:levels))
        options (icollect [i (util.countiter (+ level-count 1))] (if (<= i level-count) i :New))
        ilevel (vert form labelled-dropdown {:tag :map-selector :wdropdown (* 100 SCALE)} "Map" self.ilevel options)]
    (when (not= ilevel self.ilevel)
      (set self.ilevel (if (= ilevel :New) (+ level-count 1) ilevel))
      (self:load-level))))

(fn MapEditView.set-ilayer [self ilayer]
  (set self.ilayer ilayer)
  (self:set-style (self:layer-type)))

(fn MapEditView.draw-layer-selector [self {: x : y &as form}]
  (let [mkopt (fn [ilayer] {: ilayer :label (.. ilayer " (" (self:layer-type ilayer) ")")})
        options (icollect [ilayer (ipairs (platform :layers))] (mkopt ilayer))
        selection (vert form labelled-dropdown {:wdropdown (* 100 SCALE) :tag :layer-selector} "Layer" (mkopt self.ilayer) options)]
    (when (not= self.ilayer selection.ilayer)
      (self:set-ilayer selection.ilayer))))

(fn MapEditView.linking-obj [self] (. self.level.objects self.iobject-linking))
(fn MapEditView.draw-link-line [self x y iobjectSrc color toMouse?]
  (local objectSrc (. self.level.objects iobjectSrc))
  (local objectDest (. self.level.objects objectSrc.link))
  (local coord (fn [c m d] (+ c (* (- m 1) d) (/ d 2))))
  (local [tilew tileh] [(self:tilew) (self:tileh)])
  (local xStart (coord x objectSrc.x tilew))
  (local yStart (coord y objectSrc.y tileh))
  (when (or toMouse? objectDest)
    (local xEnd (if toMouse? (love.mouse.getX) (coord x objectDest.x tilew)))
    (local yEnd (if toMouse? (love.mouse.getY) (coord y objectDest.y tileh)))
    (love.graphics.setColor (table.unpack color))
    (love.graphics.line xStart yStart xEnd yEnd)
    (love.graphics.circle :line xEnd yEnd (/ tilew 5))
    (love.graphics.setColor 1 1 1)))

(fn MapEditView.draw-link-lines [self {: x : y} iobject-over]
    (for [iobject 1 (length self.level.objects)]
      (self:draw-link-line x y iobject [0 0 1 0.3]))
    (when (not= iobject-over nil) (self:draw-link-line x y iobject-over [0 0.5 1] false))
    (when (not= self.iobject-linking nil)
      (if (= self.imstate.left :released) (set self.iobject-linking nil)
        (self:draw-link-line x y self.iobject-linking [0 1 0] true))))

(fn MapEditView.draw-tilestrip [self x y my ?ilayer]
  ; stripcache leaks but honestly who cares
  (local tilestrip [])
  (var stripid "")
  (for [mx 1 (self:mapw)]
    (local itile (self:itile-from-xy mx my))
    (local tile (?. self.tilecache.tiles itile :gfx))
    (table.insert tilestrip tile)
    (set stripid (.. stripid  (string.char itile))))
  (var sprite (. self.stripcache stripid))
  (when (= sprite nil)
    (set sprite (tilestrip-to-sprite tilestrip (self:layer-type ?ilayer)))
    (tset self.stripcache stripid sprite))
  (love.graphics.draw sprite x y 0 self.sprite-scale self.sprite-scale))

(fn MapEditView.mapsize [self ilayer]
  (let [{: mapw : maph : tilew : tileh : xstagger : ystagger} (self:scaled-dimensions ilayer)
        intileh (or ystagger tileh)]
    [(+ (or xstagger 0) (* mapw tilew)) (+ tileh (* (- maph 1) intileh))]))

(fn MapEditView.draw-player [self mx my x y]
  (each [_ player (ipairs (or files.game.players [:player]))]
    (match (. self.level player)
      {:x mx :y my} (renderer.draw_text style.font player x y style.text)))
  (love.graphics.setColor 1 1 1))

(fn MapEditView.draw-object-box [self iobject x y w h]
  (when (not= iobject nil)
    (love.graphics.setColor 1 0 (if (and (= self.itile nil) (= iobject self.iobject)) 1 0))
    (love.graphics.setLineWidth 3)
    (love.graphics.rectangle :line x y w h)
    (love.graphics.setColor 1 1 1)))

(fn MapEditView.handle-mouseedits-object [self mx my x y w h]
  (when (and (active? self :map) (mouse-inside x y w h))
    (let [iobject (self:iobject-from-xy mx my)]
      (match self.imstate.left
        :pressed (set self.iobject-linking iobject)
        :released
        (if (and (not= iobject nil) (= self.iobject-linking iobject))
            (set self.iobject iobject)

            (not= self.iobject-linking nil)
            (tset (self:linking-obj) :link iobject)

            (not= self.playerpos nil)
            (do (tset self.level self.playerpos {:x mx :y my})
                (set self.playerpos nil))

            (= iobject nil)
            (let [tile (self.tilecache:tile (self:itile-from-xy mx my))]
              (table.insert self.level.objects {:x mx :y my :func (or tile.word "")})
              (set self.iobject (length self.level.objects))))))))

(fn MapEditView.handle-mouseedits-tile [self mx my x y w h]
  (when (and (active? self :map) (mouse-inside x y w h) (not= (self:itile-from-xy mx my) self.itile))
    (self:set-tile mx my self.itile)))

(fn MapEditView.draw-tile-xy-label [self mx my x y h ystagger]
  (local labely (math.floor (+ y (- (or ystagger 0)) (/ (- (if ystagger (* ystagger 2) h) (style.font:get_height)) 2))))
  (renderer.draw_text style.font (string.format "%x" (encode-yx {:x mx :y my})) (+ x 20) labely style.text)
  (love.graphics.setColor 1 1 1))

(fn MapEditView.draw-map-editor [self {: x : y &as form} ilayer]
  (love.graphics.setColor 1 1 1 1)
  (local {: mapw : maph : tilew : tileh : xstagger : ystagger} (self:scaled-dimensions ilayer))
  (local intileh (or ystagger tileh))
  (let [[w h] (self:mapsize ilayer)] (lume.extend form {: w : h :tag :map}))
  (activate form)
  (var iobject-over nil)
  (for [my 1 maph]
    (local tiley (+ y (* (- my 1) (or ystagger tileh))))
    (local intiley (+ tiley (- tileh intileh)))
    (local xoff (if (and xstagger (= (% my 2) 0)) xstagger 0))
    (self:draw-tilestrip (+ x xoff) tiley my ilayer)
    (for [mx 1 mapw]
      (local tilex (+ x (* (- mx 1) tilew) xoff))
      (local iobject (self:iobject-from-xy mx my))
      (when (= self.itile nil)
        (self:draw-player mx my tilex intiley)
        (self:draw-object-box iobject tilex intiley tilew intileh))
      (if self.itile
        (self:handle-mouseedits-tile mx my tilex intiley tilew intileh)
        (self:handle-mouseedits-object mx my tilex intiley tilew intileh))
      (when (mouse-inside tilex intiley tilew intileh)
        (when (not= iobject nil) (set iobject-over iobject))
        (self:draw-tile-xy-label mx my tilex intiley tileh ystagger))))
  (when (= self.itile nil) (self:draw-link-lines form iobject-over))
  (vert form))

(fn condition-label [flag]
  (if flag {:label flag : flag} {:label "<always>"}))

(fn condition-options []
  (let [options [(condition-label nil)]]
    (each [_ flag (ipairs (or files.game.flags []))]
      (table.insert options (condition-label flag)))
    options))

(fn MapEditView.draw-object-code-editor [self form object]
  (var istep-to-delete nil)
  (when (not object.steps) (set object.steps []))
  (each [istep step (ipairs object.steps)]
    (when (textbutton (lume.merge form {:x (+ form.x (* 280 SCALE))}) "X")
      (set istep-to-delete istep))
    (set step.condition (. (dropdown (lume.merge form {:x (+ form.x (* 100 SCALE)) :w (* 100 SCALE) :tag [:code-condition istep]}) (condition-label step.condition) (condition-options)) :flag))
    (set step.action (vert form dropdown {:w (* 100 SCALE) :tag [:code-action istep]} (or step.action (. actions.actionlist 1)) actions.actionlist))
    (vert form actions.edit {:w (* 300 SCALE)} istep))
  (when istep-to-delete (table.remove object.steps istep-to-delete))
  (when (vert form textbutton {} "+ New Step")
    (table.insert object.steps {})))

(fn advanced? [object]
  (or object.advanced
      (and (= object.advanced nil)
           (not= object.func "")
           (not= object.func nil))))

(fn MapEditView.draw-object-advanced-editor [self form object]
  (let [fieldform {:wlabel (* 100 SCALE) :wtext (* 200 SCALE)}]
    (set object.func (vert form textfield fieldform "Word" object.func))
    (set object.name (vert form textfield fieldform "Name" object.name))
    (set object.linkword (vert form textfield fieldform "Link word" object.linkword))
    (if object.link
      (when (vert form textbutton {} "Unlink")
        (set object.link nil))
      (set object.linkentity (vert form textfield fieldform "Link entity" object.linkentity)))))

(fn MapEditView.draw-object-editor [self form]
  (let [object (self:object)
        footer (begin-group)]
    (if (advanced? object)
      (self:draw-object-advanced-editor form object)
      (self:draw-object-code-editor form object))
    (set self.new-flag-name (footer horiz form textbox {:tag :new-flag-name :w (* 200 SCALE)} self.new-flag-name))
    (when (footer horiz form textbutton {} "+ New Flag")
      (when (= files.game.flags nil)
        (set files.game.flags []))
      (table.insert files.game.flags self.new-flag-name)
      (set self.new-flag-name ""))
    (footer form)
    (when (footer vert form textbutton {} "Delete")
      (move-object self.level.objects (+ self.iobject 1) self.iobject)
      (set self.iobject nil))
    (when (footer textbutton (lume.merge form {:x (+ form.x (* 150 SCALE))}) (if (advanced? object) "Simple" "Advanced"))
      (set object.advanced (not (advanced? object))))
    (footer form)
    (vert form)))

(fn MapEditView.load-level [self]
  (set self.stripcache {})
  (when (= (. (self:levels) self.ilevel) nil)
    (tset (self:levels) self.ilevel {:map (self:empty-map) :objects []}))
  (set self.level (. (self:levels) self.ilevel))
  (set self.iobject nil))

(fn MapEditView.reload [self]
  (MapEditView.super.reload self)
  (self:load-level))

(fn MapEditView.draw [self]
  (self:draw_background style.background)
  (self:draw_scrollbar)
  (let [form (self:form)
        form-editor (self:form)
        header (begin-group)
        _ (self:draw-map-selector form header)
        _ (when (platform :layers) (self:draw-layer-selector form header))
        _ (self:draw-map-editor form)
        editor-on-side (> self.size.x (+ form.w (* 300 SCALE)))
        fieldform {:wlabel (* 100 SCALE) :wtext (* 200 SCALE)}]
    (when editor-on-side
      (set form-editor.x (+ form.x form.w style.padding.x))
      (set form-editor.w (- form-editor.w form.w style.padding.x)))
    (self:draw-tile-selector (lume.extend form {:w (if editor-on-side form.w (- self.size.x (* style.padding.x 2)))}))
    (set self.level.tickword (vert form textfield fieldform "Tick word" self.level.tickword))
    (set self.level.moveword (vert form textfield fieldform "Move word" self.level.moveword))
    (set self.level.loadword (vert form textfield fieldform "Load word" self.level.loadword))
    (when (vert form checkbox {} "Edit objects" (= self.itile nil))
      (set self.itile nil)
      (set self.playerpos nil))
    (each [_ player (ipairs (or files.game.players [:player]))]
      (when (vert form checkbox {} (.. "Position " player) (and (= self.itile nil) (= self.playerpos player)))
        (set self.itile nil)
        (set self.playerpos player)))
    (each [_ levelflag (ipairs (or files.game.levelflags []))]
      (when (vert form checkbox {} levelflag (. self.level levelflag))
        (tset self.level levelflag (not (. self.level levelflag)))))
    (when (not editor-on-side) (set form-editor.y (+ form.y form.h style.padding.y)))
    (when self.iobject (self:draw-object-editor form-editor))
    (self:end-scroll (if (> (+ form.y form.h) (+ form-editor.y (or form-editor.h 0))) form form-editor))))

(fn MapEditView.get_name [self] (.. "Map " self.ilevel))

MapEditView