honeylisp/editor/8bitsy.fnl

(local util (require :lib.util))
(local actions (require :editor.actions))
(local {: textbox : dropdown : textfield} (util.require :editor.imstate))
(local files (require :game.files))
(local lume (require :lib.lume))
(local style (require :core.style))

(actions.register :say
  (fn [action view x y w i]
    (let [characters (lume.map files.game.portraits #$1.label)
          character (or action.character (. characters 1))
          lines (or action.lines [])
          (character y) (dropdown view [:say :char i] character characters x (+ y style.padding.y) w)
          (line1 y) (textbox view [:say :line1 i] (or (. lines 1) "") x (+ y style.padding.y) w)
          (line2 y) (textbox view [:say :line2 i] (or (. lines 2) "") x y w)
          (line3 y) (textbox view [:say :line3 i] (or (. lines 3) "") x y w)
          (line4 y) (textbox view [:say :line4 i] (or (. lines 4) "") x y w)]
      (set action.character character)
      (util.nested-tset action [:lines 1] (line1:sub 1 33))
      (util.nested-tset action [:lines 2] (line2:sub 1 33))
      (util.nested-tset action [:lines 3] (line3:sub 1 33))
      (util.nested-tset action [:lines 4] (line4:sub 1 33))
      y))
  (fn [action vm]
    (local {: say} (require :bitsy.defs))
    (say action.character (table.unpack (lume.map action.lines #($1:upper))))))

(actions.register :warp
  (fn [action view x y w i]
    (let [maps (icollect [imap _ (ipairs files.game.levels)] (.. :map imap))
          map (or action.map (. maps 1))
          y (+ y style.padding.y)
          map (dropdown view [:warp :map i] map maps x y 100)
          (position-string y) (textbox view [:warp :loc i] (string.format "%x" (or action.position 0)) (+ x 150) y 150)
          position (or (tonumber position-string 16) action.position)]
      (set action.map map)
      (set action.position position)
      y))
  (fn [action vm]
    (values :move-to-responder action.position :lit action.map :map-player-yx-ptr :set :lit action.map :next-level :set)))

(actions.register-const :move-here :move-to-responder)
(actions.register-const :disappear :disappear)

(actions.register :set-flag
  (fn [action view x y w i]
    (let [y (+ y style.padding.y)
          x (renderer.draw_text style.font "Set " x y style.text)
          flag (or action.flag (. files.game.flags 1))
          flag (dropdown view [:set-flag :flag i] flag files.game.flags x y 100)
          x (renderer.draw_text style.font " to " (+ x 100) y style.text)
          options (lume.concat
                    [{:label "<Yes>" :value 0xffff} {:label "<No>" :value 0}]
                    (icollect [_ flag (ipairs files.game.flags)] {:label flag :value (.. :cond- flag)}))
          rhs (or action.rhs (. options 1))
          (rhs y) (dropdown view [:set-flag :rhs i] rhs options x y 100)]
      (set action.flag flag)
      (set action.rhs rhs)
      y))
  (fn [action vm]
    (values action.rhs.value (.. :cond-var- action.flag) :set)))

{}