honeylisp/game/files.fnl

(local util (require :lib.util))
(local lume (require :lib.lume))

(local files (util.hot-table ...))

(local default-filename "neutgs/game.json")

(local encoded-tile-fields [:gfx :mask])
(fn convert [tile field method]
  (local oldval (. tile field))
  (when oldval
    (tset tile field (: oldval method)))
  tile)
(fn convert-all [tile method root]
  (let [encoded-tile-fields [:mask]]
    (each [_ key (pairs (or root.tilesets {:tileset :gfx}))]
      (table.insert encoded-tile-fields key))
    (each [_ field (ipairs encoded-tile-fields)]
      (convert tile field method))
    tile))

(fn tile-deserialize [tile root]
  (match (type tile)
    :string {:gfx (tile:fromhex) :flags {}}
    :table  (convert-all tile :fromhex root)))

(fn tile-serialize [tile root] (convert-all (lume.clone tile) :tohex root))

(fn deserialize [key value root]
  (match key
    (where (or :tiles :portraits :font :brushes)) (tile-deserialize value root)
    :levels (do (set value.map (value.map:fromhex))
                (set value.layers (icollect [_ layer (ipairs (or value.layers []))] (layer:fromhex)))
                value)
    _ value))

(fn serialize [key value root]
  (match key
    (where (or :tiles :portraits :font :brushes)) (tile-serialize value root)
    :levels (do (set value.map (value.map:tohex))
                (set value.layers (icollect [_ layer (ipairs (or value.layers []))] (layer:tohex)))
                value)
    _ value))

(fn clone [v]
  (match (type v)
    :table (lume.clone v)
    _ v))

(fn filename [] (or files.filename default-filename))
(fn files.load [?filename]
  (when ?filename (set files.filename ?filename))
  (set files.game
       (if (util.file-exists (filename))
         (let [game (util.readjson (filename))]
           (each [k v (pairs game)]
             (when (= (type v) :table)
               (tset game k (lume.map v #(deserialize k (clone $1) game)))))
           game)
         {:tiles [] :portraits [] :font [] :levels []}))
  files.game)

(fn files.save [?filename]
  (when ?filename (set files.filename ?filename))
  (let [game {}]
    (each [k v (pairs files.game)]
      (tset game k (if (= (type v) :table) (lume.map v #(serialize k (clone $1) files.game)) v)))
    (util.writejson (filename) game)))

(fn new-cache [game key]
  (let [tiledraw (require :editor.tiledraw)
        tiles (require :game.tiles)
        spritegen (tiledraw.spritegen-for-style key)
        gfx (. game key)]
    (tiledraw.TileCache gfx spritegen)))

(fn files.cache [key]
  (when (= (. files.game key) nil)
    (tset files.game key []))
  (when (= (?. files :tilecaches key) nil)
    (util.nested-tset files [:tilecaches key] (new-cache files.game key)))
  (. files.tilecaches key))

(fn files.reload [?filename]
  (files.load ?filename)
  (when files.tilecaches
    (each [key cache (pairs files.tilecaches)]
      (cache:load (. files.game key)))))

(fn files.module []
  (or files.game.module (: (filename) :match "^[^/]+")))

(fn files.platform [] (or files.game.platform :ii))
(fn files.default-platform-method [cls module-prefix method default]
  (tset cls method (fn [...] (let [f (. (require (.. module-prefix :. (files.platform))) method)] (if f (f ...) (default ...))))))
(fn files.platform-methods [cls module-prefix ...]
  (each [_ key (ipairs [...])] (files.default-platform-method cls module-prefix key #nil)))

(when (= files.game nil)
  (files.load))

files.hot