honeylisp/editor/mapedit.fnl

261 lines
11 KiB
Fennel

(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 {: mouse-inside : activate : active? : checkbox : textfield : textbutton : textbox : dropdown} (util.require :editor.imstate))
(local {: tilestrip-to-sprite} (util.require :editor.tiledraw))
(local {: encode-yx : encode-itile : decode-itile} (util.require :game.tiles))
(local actions (require :editor.actions))
(local MapEditView (GraphicsEditView:extend))
(local sprite-scale 3)
(local mapw 20)
(local maph 12)
(local tilew (* sprite-scale 14))
(local tileh (* sprite-scale 16))
(fn MapEditView.new [self]
(MapEditView.super.new self)
(set self.sprite-scale sprite-scale)
(set self.stripcache {})
(set self.ilevel 1)
(self:reload))
; map is stored bottom-to-top
(fn imap-from-xy [mx my]
(+ mx -1 (* mapw (- maph my))))
(fn update-map [map mx my itile]
(local imap (imap-from-xy mx my))
(local enctile (encode-itile itile))
(..
(map:sub 1 imap)
(string.char enctile)
(map:sub (+ imap 2))))
(fn MapEditView.itile-from-xy [self mx my]
(local imap (+ (imap-from-xy mx my) 1))
(local enctile (string.byte (self.level.map:sub imap imap)))
(decode-itile enctile))
(fn MapEditView.set-tile [self mx my itile]
(set self.level.map (update-map self.level.map mx my itile)))
(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.draw-map-selector [self x y]
(renderer.draw_text style.font "Map" x (+ y (/ style.padding.y 2)) style.text)
(let [options {}
level-count (length files.game.levels)
_ (do (for [i 1 level-count] (tset options i i))
(table.insert options :New))
(ilevel yNext) (dropdown self :map-selector self.ilevel options (+ x 50) y 100)]
(when (not= ilevel self.ilevel)
(set self.ilevel (if (= ilevel :New) (+ level-count 1) ilevel))
(self:load-level))
(- yNext y)))
(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 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-tilestrip [self x y my]
; stripcache leaks but honestly who cares
(local tilestrip [])
(var stripid "")
(for [mx 1 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))
(tset self.stripcache stripid sprite))
(love.graphics.draw sprite x y 0 self.sprite-scale self.sprite-scale))
(fn MapEditView.draw-map-editor [self x y]
(love.graphics.setColor 1 1 1 1)
(local button-state self.imstate.left)
(activate self :map x y (* tilew mapw) (* tileh maph))
(var iobject-over nil)
(for [my 1 maph]
(local tiley (+ y (* (- my 1) tileh)))
(self:draw-tilestrip x tiley my)
(for [mx 1 mapw]
(local tilex (+ x (* (- mx 1) tilew)))
(local itile (self:itile-from-xy mx my))
(local iobject (self:iobject-from-xy mx my))
(when (= self.itile nil)
(let [player :player]
(match (. self.level player)
{:x mx :y my} (renderer.draw_text style.font player tilex tiley style.text)))
(love.graphics.setColor 1 1 1))
(when (and (not= iobject nil) (= self.itile nil))
(love.graphics.setColor 1 0 (if (and (= self.itile nil) (= iobject self.iobject)) 1 0))
(love.graphics.setLineWidth 3)
(love.graphics.rectangle :line tilex tiley tilew tileh)
(love.graphics.setColor 1 1 1))
(when (mouse-inside tilex tiley tilew tileh)
(when (not= iobject nil) (set iobject-over iobject))
(renderer.draw_text style.font (string.format "%x" (encode-yx {:x mx :y my})) tilex (+ tiley 15) style.text)
(love.graphics.setColor 1 1 1))
(when (and self.itile (active? self :map) (mouse-inside tilex tiley tilew tileh) (not= itile self.itile))
(self:set-tile mx my self.itile))
(when (and (= self.itile nil) (active? self :map) (mouse-inside tilex tiley tilew tileh))
(match button-state
: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 itile)]
(table.insert self.level.objects {:x mx :y my :func (or tile.word "")})
(set self.iobject (length self.level.objects))))))))
(when (= self.itile nil)
(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 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 object x y]
(var y y)
(var istep-to-delete nil)
(when (not object.steps) (set object.steps []))
(each [istep step (ipairs object.steps)]
(when (textbutton self "X" (+ x 280) y)
(set istep-to-delete istep))
(set step.condition (. (dropdown self [:code-condition istep] (condition-label step.condition) (condition-options)
(+ x 100 style.padding.x) y 100)
:flag))
(set (step.action y) (dropdown self [:code-action istep] (or step.action (. actions.actionlist 1)) actions.actionlist x y 100))
(set y (actions.edit step self x y 300 istep))
(set y (+ y style.padding.y)))
(when istep-to-delete (table.remove object.steps istep-to-delete))
(let [(do-new y) (textbutton self "+ New Step" x (+ y style.padding.y))]
(when do-new (table.insert object.steps {}))
y))
(fn MapEditView.draw-object-advanced-editor [self object x y]
(let [(func y) (textfield self "Word" object.func x y 100 200)
(name y) (textfield self "Name" object.name x (+ y style.padding.y) 100 200)
(linkword y) (textfield self "Link word" object.linkword x (+ y style.padding.y) 100 200)
(do-unlink y) (if object.link (textbutton self "Unlink" x (+ y style.padding.y)) (values false y))
(linkentity y) (if object.link (values object.linkentity y) (textfield self "Link entity" object.linkentity x (+ y style.padding.y) 100 200))]
(lume.extend object {: func : name : linkword : linkentity})
(when do-unlink (set object.link nil))
y))
(fn MapEditView.draw-object-editor [self x y]
(let [object (self:object)
y (if object.advanced
(self:draw-object-advanced-editor object x y)
(self:draw-object-code-editor object x y))
new-flag-name (textbox self :new-flag-name self.new-flag-name x (+ y style.padding.y) 200)
(mk-new-flag y) (textbutton self "+ New Flag" (+ x 200 style.padding.x) (+ y style.padding.y))
do-delete (textbutton self "Delete" x (+ y 40))
(do-advanced y) (textbutton self (if object.advanced "Simple" "Advanced") (+ x 150) (+ y 40))]
(set self.new-flag-name new-flag-name)
(when mk-new-flag
(when (= files.game.flags nil)
(set files.game.flags []))
(table.insert files.game.flags new-flag-name)
(set self.new-flag-name ""))
(when do-delete
(move-object self.level.objects (+ self.iobject 1) self.iobject)
(set self.iobject nil))
(when do-advanced (set object.advanced (not object.advanced)))
y))
(fn MapEditView.load-level [self]
(set self.stripcache {})
(when (= (. files.game.levels self.ilevel) nil)
(tset files.game.levels self.ilevel {:map (string.rep "\0" (* mapw maph)) :objects []}))
(set self.level (. files.game.levels self.ilevel))
(set self.iobject nil))
(fn MapEditView.reload [self]
(MapEditView.super.reload self)
(self:load-level))
(fn MapEditView.draw [self]
(var x (+ self.position.x style.padding.x (- self.scroll.x)))
(var y (+ self.position.y style.padding.y (- self.scroll.y)))
(self:draw_background style.background)
(self:draw_scrollbar)
(local ytop y)
(set y (+ y (self:draw-map-selector x y) style.padding.y))
(self:draw-map-editor x y)
(set y (+ y (* tileh maph) style.padding.y))
(set y (+ y (self:draw-tile-selector x y (- self.size.x (* style.padding.x 2)))))
(set (self.level.tickword y) (textfield self "Tick word" self.level.tickword x (+ y style.padding.y) 100 200))
(set (self.level.moveword y) (textfield self "Move word" self.level.moveword x (+ y style.padding.y) 100 200))
(set (self.level.loadword y) (textfield self "Load word" self.level.loadword x (+ y style.padding.y) 100 200))
(let [(checked y-new) (checkbox self "Edit objects" (= self.itile nil) x (+ y style.padding.y))
_ (when checked
(set self.itile nil)
(set self.playerpos nil))
(checked y-new) (checkbox self (.. "Position " :player) (and (= self.itile nil) (= self.playerpos :player)) x (+ y-new style.padding.y))]
(when checked
(set self.itile nil)
(set self.playerpos :player))
(set y y-new))
(when self.iobject
(set y (math.max y (if (> self.size.x (+ (* tilew mapw) 300))
(self:draw-object-editor (+ x (* tilew mapw) style.padding.x) ytop)
(self:draw-object-editor x (+ y style.padding.y))))))
(set self.scrollheight (- y (+ self.position.y style.padding.y (- self.scroll.y)))))
(fn MapEditView.get_name [self] (.. "Map " self.ilevel))
MapEditView