honeylisp/editor/mapedit.fnl

(local GraphicsEditView (require :editor.gfxedit))
(local style (require :core.style))
(local util (require :lib.util))
(local lume (require :lib.lume))
(local files (require :game.files))
(local {: show} (util.require :inspector.debug))
(local {: mouse-inside : activate : active? : checkbox : textfield : textbutton : textbox : dropdown : labelled-dropdown : under : right-of : reform : group-wrapper} (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 ?ilayer)) (platform)))
(fn MapEditView.scaled-dimensions [self ?ilayer]
  (let [dim (lume.clone (self:dimensions ?ilayer))]
    (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 ?ilayer] (string.rep "\0" (* (self:mapw ?ilayer) (self:maph ?ilayer))))

(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 ?ilayer]
  (+ mx -1 (* (self:mapw ?ilayer) (- (self:maph ?ilayer) 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 ?ilayer]
  (if (platform :layers) (or (?. self.level.layers (or ?ilayer self.ilayer)) (self:empty-map ?ilayer))
    self.level.map))

(fn MapEditView.itile-from-xy [self mx my ?ilayer]
  (local imap (+ (self:imap-from-xy mx my ?ilayer) 1))
  (local enctile (or (string.byte (string.sub (self:map ?ilayer) imap imap)) 0))
  (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))))

; todo: objects exist on layers
(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 form]
  (let [level-count (length (self:levels))
        options (icollect [i (util.countiter (+ level-count 1))] (if (<= i level-count) i :New))
        ilevel (labelled-dropdown (reform form {: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 (labelled-dropdown (reform form {: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 (tostring ?ilayer))
  (for [mx 1 (self:mapw ?ilayer)]
    (local itile (self:itile-from-xy mx my ?ilayer))
    (local tile (?. (files.cache (self:layer-type ?ilayer)) :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 ilayer]
  (when (and (active? self [:map ilayer]) (mouse-inside x y w h))
    (let [iobject (self:iobject-from-xy mx my)]
      (match self.imstate.left
        :down (when (= self.iobject-linking nil) (set self.iobject-linking iobject))
        :released
        (do (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 ilayer))]
                (table.insert self.level.objects {:x mx :y my :func (or tile.word "")})
                (set self.iobject (length self.level.objects))))
            (set self.iobject-linking nil))))))

(fn MapEditView.handle-mouseedits-tile [self mx my x y w h ilayer]
  (when (and (active? self [:map ilayer]) (mouse-inside x y w h) (not= (self:itile-from-xy mx my ilayer) 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-layer [self {: x : y &as form} ilayer live]
  (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 ilayer]}))
  (when live (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)
    (when live
      (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 ilayer)
          (self:handle-mouseedits-object mx my tilex intiley tilew intileh ilayer))
        (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 (and live (= self.itile nil))
    (self:draw-link-lines form iobject-over)))

(fn MapEditView.draw-map-editor [self form]
  (let [g (group-wrapper form)]
    (each [ilayer (ipairs (platform :layers))]
      (self:draw-map-layer (g) ilayer (= ilayer self.ilayer)))
    (g)))

(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 (reform form {:x (+ form.x (* 280 SCALE)) :into {}}) "X")
      (set istep-to-delete istep))
    (set step.condition (. (dropdown (reform form {:x (+ form.x (* 150 SCALE)) :w (* 100 SCALE) :tag [:code-condition istep] :into {}}) (condition-label step.condition) (condition-options)) :flag))
    (set step.action (dropdown (reform form {:w (* 100 SCALE) :tag [:code-action istep]}) (or step.action (. actions.actionlist 1)) actions.actionlist))
    (actions.edit step (under form {:w (* 300 SCALE)}) istep)
    (under form))
  (when istep-to-delete (table.remove object.steps istep-to-delete))
  (when (textbutton (under form) "+ 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 (textfield (reform form fieldform) "Word" object.func))
    (set object.name (textfield (under form fieldform) "Name" object.name))
    (set object.linkword (textfield (under form fieldform) "Link word" object.linkword))
    (if object.link
      (when (textbutton (under form) "Unlink")
        (set object.link nil))
      (set object.linkentity (textfield (under form fieldform) "Link entity" object.linkentity)))))

(fn MapEditView.draw-object-editor [self form]
  (let [object (self:object)
        footer (group-wrapper form)]
    (if (advanced? object)
      (self:draw-object-advanced-editor form object)
      (self:draw-object-code-editor form object))
    (set self.new-flag-name (footer textbox (under form {:tag :new-flag-name :w (* 200 SCALE)}) self.new-flag-name))

    (when (footer textbutton (right-of form) "+ 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 ""))
    (when (footer textbutton (under (footer)) "Delete")
      (move-object self.level.objects (+ self.iobject 1) self.iobject)
      (set self.iobject nil))
    (when (footer textbutton (right-of form) (if (advanced? object) "Simple" "Advanced"))
      (set object.advanced (not (advanced? object))))
    (footer)))

(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 (group-wrapper form)
        _ (header #(self:draw-map-selector $...) form)
        _ (when (platform :layers) (header #(self:draw-layer-selector $...) (right-of form)))
        _ (self:draw-map-editor (under (header)))
        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 (under form {:w (if editor-on-side form.w (- self.size.x (* style.padding.x 2)))}))
    (set self.level.tickword (textfield (under form fieldform) "Tick word" self.level.tickword))
    (set self.level.moveword (textfield (under form fieldform) "Move word" self.level.moveword))
    (set self.level.loadword (textfield (under form fieldform) "Load word" self.level.loadword))
    (when (checkbox (under form) "Edit objects" (= self.itile nil))
      (set self.itile nil)
      (set self.playerpos nil))
    (each [_ player (ipairs (or files.game.players [:player]))]
      (when (checkbox (under form) (.. "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 (checkbox (under form) 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