mmbshmup/splubp.p8

pico-8 cartridge // http://www.pico-8.com
version 42
__lua__
-- splubp data transport
-- by kistaro windrider

-- shrinko-8 hints
DEBUG = true --[[const]]

-- >8
-- utilities

-- generate standard "overlay"
-- constructor for type tt.
-- if tt.init is defined, generated
-- new calls tt.init(ret) after
-- ret is definitely not nil,
-- after calling setmetatable.
-- use to initialize mutables.
--
-- if there was a previous new,
-- it is invoked before
-- setting tt's metatable, so
-- each new will see its
-- inheritance chain.
function mknew(tt)
 local mt,oldinit,more = {__index=tt},tt.superinit,rawget(tt, "init")
 tt.new=function(ret)
  if(not ret) ret = {}
  ret.new = false
  setmetatable(ret, mt)
  if(oldinit) oldinit(ret)
  if (more) more(ret)
  return ret
 end

 if oldinit and more then
  tt.superinit = function(ret)
   oldinit(ret)
   more(ret)
  end
 elseif more then
  tt.superinit = more
 end
 return tt
end

function trim(s)
 local f, e = 1, #s
 while (f <= e and s[f]==" ") f += 1
 while (e >= f and s[e]==" ") e -= 1
 if (f<e) return sub(s,f,e)
 return ""
end

function shatter(s)
 local ret ={}
 for line in all(split(s, "\n")) do
  local row = {}
  for cell in all(split(split(line, "--")[1], " ")) do
   cell = trim(cell)
   if (#cell > 0) add(row, cell)
  end
  if (#row > 0) add(ret, row)
 end
 return ret
end

function crush(s)
 ret = ""
 for line in shatter(s) do
  for tok in line do
   ret..=tok.." "
  end
  ret = sub(ret, 1, -2).."\n"
 end
 if (#ret > 0) return sub(ret, 1, -2)
 return ""
end

-- >8
-- common

--[[preserve-keys]] splubp = mknew{
 ptr = 0x8000,
 init = function(self)
  -- fill from ffile or saved file
  self.fmts = {}
  if (not self.ffile) self.ffile, self.ptr = self:e()
  for f in all(split(self.ffile, "===", false)) do
   local tok = shatter(f)
   if DEBUG then
    assert(#tok > 1, "not enough rows in "..tostr(tok))
    assert(#tok[1] == 1, "bad extension row: "..tostr(tok[1]))
   end
   self.fmts[deli(tok, 1)[1]] = tok
  end
 end,
}

function splubp:ppi(n)
 self.ptr += n
 return self.ptr - n
end

function splubp:op()
 self.cri += 1
 return self.row[self.cri]
end

function splubp:c(n)
 n = n or 1
 return peek(self:ppi(n), n)
end

function splubp:i()
 return %self:ppi(2)
end

function splubp:n()
 return $self:ppi(4)
end

function splubp:e()
 return chr(self:c(self:i()))
end

-- >8
-- writer

function splubp:emit_fmts()
 self:write_e(self.ffile)
end

-- execute next op (write data)
function splubp:wnx(...)
 return self["write_"..self:op()](self, ...)
end

-- write an object of a known type.
-- item must have a field named
-- _file, containing a filename
-- with a correct extension
-- to save the file under.
function splubp:emit_item(obj)
 if DEBUG then
  --[[global]] splubp_last_emit = obj
 end
 -- todo: should _addr skip the
 -- filename, instead?
 obj._addr = self.ptr
 self:write_s(obj._file)
 for row in all(self.fmts[split(filename, ".")[2]]) do
  local alt = self.wdirectives[row[1]]
  if alt then
   alt(self, obj, row)
  else
   self:write_fmt(obj[row[1]], row, 2)
  end
 end
end

-- TODO: splubp.wdirectives -- a
--       table mapping non-key
--       special values to
--       functions to write them     
-- TODO: write_fmt: recursive
--       writing thing

-- Write each argument as one
-- byte at self.ptr, then
-- increment self.ptr by the
-- number of bytes written.
function splubp:write_c(...)
 poke(self:ppi(#{...}), ...)
end

-- Like etch but it takes only
-- a single 2-byte int.
function splubp:write_i(i)
  poke2(self:ppi(2), i)
end

-- Like etch but it takes only
-- a single 4-byte number.
function splubp:write_n(n)
 poke4(self:ppi(4), n)
end

function splubp:write_s(s)
 self:write_c(#s, ord(s, 1, #s))
end

function splubp:write_e(s)
 self:write_i(#s)
 self:write_c(ord(s,1,#s))
end

splubp.write_b = splubp.write_c

function splubp:write_shr(n)
 n <<= self:op()
 self:wnx(n)
end

function splubp:write_a(tbl)
 if (DEBUG) assert(#tbl <= 255, "'a' can't write array of length "..#tbl)
 self:write_c(#tbl)
 local rpt = self.cri
 for item in all(tbl) do
  self.cri = rpt
  self:wnx(item)
 end
end

function splubp:write_t(tbl)
 if DEBUG then
  local want_len = self.row[self.cri]
  assert(#tbl == want_len, "'t' wants "..tostr(want_len).." items, but got "..#tbl..": "..tostr(tbl))
 end
 for i=1,self:op() do
  self:wnx(tbl[i])
 end
end

-->8
-- loader

-- execute next op (read)
function splubp:rnx()
 return self[self:op()](self)
end

function splubp:s()
 return chr(self:c(self:c()))
end

function splubp:b()
 local ret = self:c()
 if (ret < 128) return ret
 return ret-256
end

function splubp:shr()
 local amt = self:op()
 return self:rnx() >>> amt
end

function splubp:a()
 local ret,rpt = {},self.cri
 for i = 1,self:c() do
  self.cri=rpt
  add(ret, self:rnx())
 end
 return ret
end

function splubp:t()
 local ret = {}
 for i=1,self:op() do
  add(ret, self:rnx())
 end
 return ret
end