-- [ʞ] sirsem.lua
-- ~ lexi hale <lexi@hale.su>
-- glowpelt (hsl conversion)
-- ? utility library with functionality common to
-- cortav.lua and its extensions
-- \ from Ranuir "software utility"
-- > local ss = require 'sirsem.lua'
local ss
do -- pull ourselves up by our own bootstraps
local package = _G.package
-- prevent namespace from being broken by env shenanigans
local function namespace(name, tbl)
local pkg = tbl or {}
if package then
package.loaded[name] = pkg
end
return pkg
end
ss = namespace 'sirsem'
ss.namespace = namespace
end
function ss.map(fn, lst)
local new = {}
for k,v in pairs(lst) do
table.insert(new, fn(v,k))
end
return new
end
function ss.reduce(fn, acc, lst)
for i,v in ipairs(lst) do
acc = fn(acc, v, i)
end
return acc
end
function ss.filter(list, fn)
local new = {}
for i, v in ipairs(list) do
if fn(v,i) then table.insert(new, v) end
end
return new
end
function ss.kmap(fn, list)
local new = {}
for k, v in pairs(list) do
local nk,nv = fn(k,v)
new[nk or k] = nv or v
end
return new
end
function ss.tmap(fn, a, ...)
if a == nil then return end
return fn(a), ss.tmap(fn, ...)
end
function ss.kfilter(list, fn)
local new = {}
for k, v in pairs(list) do
if fn(k,v) then new[k] = v end
end
return new
end
function ss.find(tbl, pred, ...)
pred = pred or function(a,b)
return a == b
end
for k,v in pairs(tbl) do
if pred(v,k,...) then return k,v end
end
return nil
end
function ss.clone(tbl) -- performs a shallow copy
if tbl.clone then return tbl:clone() end
local new = {}
for k,v in pairs(tbl) do
new[k] = v
end
return new
end
function ss.copy(tbl) -- performs a deep copy
local new = {}
for k,v in pairs(tbl) do
if type(v) == 'table' then
if v.clone then
new[k] = v:clone() -- this may or may not do a deep copy!
else
new[k] = ss.copy(v)
end
else
new[k] = v
end
end
return new
end
function ss.push(tbl, ...)
local idx = #tbl + 1
local function rec(v, ...)
tbl[idx] = v
idx = idx + 1
if ss.tuple.any(...) then rec(...) end
end
rec(...)
return tbl
end
function ss.delegate(tbl,tpl) -- returns a table that looks up keys it lacks from
-- tbl (lightweight alternative to shallow copies)
tpl = tpl or {}
return setmetatable({}, {__index=tbl})
end
ss.str = {}
function ss.str.begins(str, pfx)
-- appallingly, this is actually ~2/5ths faster than either
-- of the below. i hate scripting languages so much
return string.find(str, pfx, 1, true) == 1
-- to my shock, disgust, and horror, even writing my own
-- string scanning library for lua IN C only sped this up by
-- a tiny fraction. i am just speechless.
-- return string.sub(str, 1, #pfx) == pfx
-- local pl = string.len(pfx)
-- local sl = string.len(str)
-- if sl < pl then return false end
-- for i=1,pl do
-- if string.byte(str,i) ~= string.byte(pfx,i) then
-- return false
-- end
-- end
-- return true
end
function ss.enum(syms)
local e = {}
for i,v in pairs(syms) do
e[v] = i
e[i] = v
end
return e
end
function ss.bitmask_bytes(n,ofs)
ofs = ofs or 0
local function rec(i)
if i > n then return end
return 1<<(i+ofs), rec(i+1)
end
return 1<<ofs, rec(1)
end
function ss.bitmask(tbl,ofs)
local codes = {ss.bitmask_bytes(#tbl,ofs)}
local m = {}
local maxbit
for i, s in ipairs(tbl) do
m[s] = codes[i]
m[codes[i]] = s
maxbit = i
end
m[true] = {ofs or 0,maxbit}
return m
end
ss.str.charclass = ss.enum {
'numeral'; 'letter'; 'symbol'; 'punct';
'space'; 'ctl'; 'glyph'; -- hanji
}
ss.str.charprop = ss.bitmask({
'hexnumeral', -- character that can be used to write hexadecimal notation
'upper', 'lower';
'diac'; -- diacritic/modifier letter
'wordbreak'; -- char causes following characters to be treated as a separate word (e.g. punctuation)
'wordsep'; -- char causes previous and following characters to be treated as separate words; char constitutes a word of its own in between (e.g. interpunct)
'breakokay'; -- is it okay to break words at this character? (eg hyphen)
'mathop'; -- char is a mathematical operator
'disallow', -- char is not allowed in narrative text
'brack', 'right', 'left', -- brackets
'noprint', -- character deposits no ink
'superimpose' -- character is superimposed over previous
}, 3)
ss.str.enc_generics = {
pfxescape = function(ch, enc, chain)
local bytes = #ch
local codes = enc.len(ch)
return function(s)
if s == ch then
return 0, 0, ch
elseif ss.str.begins(s, ch) then
local nc = enc.char(enc.codepoint(s, bytes + 1))
return bytes, codes, nc
elseif chain then
return chain(s)
end
end
end;
};
local cc,cp = ss.str.charclass, ss.str.charprop
ss.str.enc = {
utf8 = {
char = utf8.char;
codepoint = utf8.codepoint;
len = utf8.len;
encodeUCS = function(str) return str end;
iswhitespace = function(c)
return (c == ' ') or (c == '\t') or (c == '\n')
or (c == '\u{3000}')
or (c == '\u{200B}')
end;
};
ascii = {
len = string.len; char = string.char; codepoint = string.byte;
iswhitespace = function(c)
return (c == ' ') or (c == '\t') or (c == '\n')
end;
ranges = {
{0x00,0x1a, cc.ctl};
{0x1b,0x1b, cc.ctl | cp.disallow};
{0x1c,0x1f, cc.ctl};
{0x20,0x20, cc.space};
{0x21,0x22, cc.punct};
{0x23,0x26, cc.symbol};
{0x27,0x29, cc.punct};
{0x2a,0x2b, cc.symbol};
{0x2c,0x2f, cc.punct};
{0x30,0x39, cc.numeral | cp.hexnumeral};
{0x3a,0x3b, cc.punct};
{0x3c,0x3e, cc.symbol | cp.mathop};
{0x3f,0x3f, cc.punct};
{0x40,0x40, cc.symbol};
{0x41,0x46, cc.letter | cp.upper | cp.hexnumeral};
{0x47,0x5a, cc.letter | cp.upper};
{0x5b,0x5d, cc.symbol | cp.mathop};
{0x5e,0x5e, cc.symbol | cp.mathop};
{0x5f,0x60, cc.symbol};
{0x61,0x66, cc.letter | cp.lower | cp.hexnumeral};
{0x67,0x7a, cc.letter | cp.lower};
{0x7b,0x7e, cc.symbol};
{0x7f,0x7f, cc.ctl, cp.disallow};
}
};
raw = {len = string.len; char = string.char; codepoint = string.byte;
encodeUCS = function(str) return str end;
iswhitespace = function(c)
return (c == ' ') or (c == '\t') or (c == '\n')
end;
};
}
-- unicode ranges are optionally generated from consortium data
-- files and injected through a generated source file. if this
-- part of the build process is disabled (e.g. due to lack of
-- internet access, or to keep the size of the executable as
-- small as possible), we still at least can make the ascii
-- ranges available to UTF8 (UTF8 being a superset of ascii)
ss.str.enc.utf8.ranges = ss.str.enc.ascii.ranges
function ss.str.enc.ascii.encodeUCS(str)
local newstr = ''
for c,p in ss.str.each(ss.str.enc.utf8, str, true) do
if c > 0x7F then
newstr = newstr .. '?'
else
newstr = newstr .. string.char(c)
end
end
end
for _, v in pairs{'utf8','ascii','raw'} do
ss.str.enc[v].parse_escape = ss.str.enc_generics.pfxescape('\\',ss.str.enc[v])
end
function ss.bitmask_expand(ty, v)
local bitrange = ty[true]
local fb
if bitrange[1] ~= 0 then
fb = v & ((1<<bitrange[1]) - 1) -- first N bits
end
local tbl = {}
for j=bitrange[1], bitrange[2] do
if (fb & (1<<j)) ~= 0 then
tbl[ty[1<<j]] = true
end
end
return tbl, fb
end
function ss.str.classify(enc, ch)
if not enc.ranges then return {} end
if type(ch)=='string' then ch = enc.codepoint(ch) end
for _, r in pairs(enc.ranges) do
if ch >= r[1] and ch <= r[2] then
local p,b = ss.bitmask_expand(ss.str.charprop, r[3])
if b then p[ss.str.charclass[b]] = true end
return p
end
end
return {}
end
function ss.str.each(enc, str, ascode)
if enc.each then return enc.each(enc,str,ascode) end
local pm = {
__index = {
esc = function(self)
local ba, bc, nc = enc.parse_escape(str:sub(self.byte))
if ba then
self.next.byte = self.next.byte + ba - 1
self.next.code = self.next.code + bc - 1
return nc
end
end;
};
}
local pos = {
code = 1;
byte = 1;
}
return function()
if pos.byte > #str then return nil end
local thischar = enc.codepoint(str, pos.byte)
local lastpos = setmetatable({
code = pos.code;
byte = pos.byte;
next = pos;
},pm)
if not ascode then
thischar = enc.char(thischar)
pos.byte = pos.byte + #thischar
else
pos.byte = pos.byte + #enc.char(thischar)
end
pos.code = pos.code + 1
return thischar, lastpos
end
end
function ss.str.breakwords(enc, str, max, opts)
if enc.breakwords then return enc.breakwords(str) end
local words = {}
opts = opts or {}
local buf = ''
local flush = function()
if buf ~= '' then table.insert(words,buf) buf = '' end
end
for c, p in ss.str.each(enc,str) do
local nc
if opts.escape then
nc = p:esc()
end
if nc then
buf = buf + nc
elseif enc.iswhitespace(c) then
flush()
if max and #words == max then
local rs = str:sub(p.next.byte)
if rs ~= '' then
table.insert(words, rs)
end
break
end
else
buf = buf .. c
end
end
flush()
return words
end
function ss.str.mergewords(enc, lst)
if enc.mergewords then return enc.mergewords(lst) end
return table.concat(lst, enc.wordsep or ' ')
end
function ss.str.breaklines(enc, str, opts)
if enc.breaklines then return enc.breaklines(lst,opts) end
return ss.str.split(enc, str, enc.encodeUCS'\n', opts)
end
function ss.str.split(enc, str, delim, opts)
if enc.split then return enc.split(str,delim,opts) end
opts = opts or {}
local elts = {}
local buf = ''
local flush = function()
if buf ~= '' or opts.keep_empties then
table.insert(elts,buf)
buf = ''
end
end
local esc = enc.parse_escape
local tryesc if opts.escape then
tryesc = function(str, p)
local ba, ca, escd = enc.parse_escape(str:sub(p.byte))
if ba then
p.next.byte = p.next.byte + ba
p.next.code = p.next.code + ca
buf = buf .. escd
return true
end
end
else
tryesc = function(...) end
end
if type(delim) == 'function' then
for c, p in ss.str.each(enc,str) do
if not tryesc(str,p) then
local skip = delim(str:sub(p.byte))
if skip then
flush()
p.next.byte = p.next.byte + skip - 1
else
buf = buf .. c
end
end
end
elseif enc.len(delim) == 1 then
for c, p in ss.str.each(enc,str) do
if not tryesc(str,p) then
if c == delim then
flush()
else
buf = buf .. c
end
end
end
else
local dlcode = enc.len(delim)
for c, p in ss.str.each(enc,str) do
if not tryesc(str,p) then
if str:sub(p.byte, p.byte+#delim-1) == delim then
flush()
p.next.byte = p.next.byte + #delim - 1
p.next.code = p.next.code + dlcode
else
buf = buf .. c
end
end
end
end
flush()
return elts
end
function ss.str.langmatch(tbl, lang, enc)
-- this performs primitive language matching. NOTE: THIS IS NOT
-- STANDARDS COMPLIANT. it's "good enough" for now, but in the
-- long term it needs to be rewritten to actually understand the
-- format, primarily so that e.g. 'en-US-Latn' and 'en-Latn-US'
-- match -- currently order is significant. it shouldn't be
-- ref: IETF BCP 47 (RFC 5646) https://www.ietf.org/rfc/bcp/bcp47.html
local dash = enc.encodeUCS'-'
local tags = ss.str.split(enc, lang, dash, {escape=true})
local bestlen = 0
local bestmatch
for k,v in pairs(tbl) do
if k ~= true then
local kt = ss.str.split(enc, k, dash, {escape=true})
for i=1,math.min(#kt,#tags) do
if kt[i] ~= tags[i] then goto skip end
end
if #kt > bestlen then
-- match the most specific matching tag
bestmatch = k
bestlen = #kt
end
end
::skip::end
return tbl[bestmatch] or tbl[true], bestmatch
end
function ss.str.b64e(str)
local bytes = {}
local n = 1
for i=1, #str, 3 do
local triple = {string.byte(str, i, i+2)}
local T = function(q)
return triple[q] or 0
end
local B = function(q)
print(q)
if q <= 25 then
return string.char(0x41 + q)
elseif q <= 51 then
return string.char(0x61 + (q-26))
elseif q <= 61 then
return string.char(0x30 + (q-52))
elseif q == 62 then
return '+'
elseif q == 63 then
return '/'
else error('base64 algorithm broken') end
end
local quads = {
((T(1) & 0xFC) >> 2);
((T(1) & 0x03) << 4) | ((T(2) & 0xF0) >> 4);
((T(2) & 0x0F) << 2) | ((T(3) & 0xC0) >> 6);
((T(3) & 0x3F));
}
bytes[n + 0] = B(quads[1])
bytes[n + 1] = B(quads[2])
if triple[2] then
bytes[n + 2] = B(quads[3])
if triple[3] then
bytes[n + 3] = B(quads[4])
else
bytes[n + 3] = '='
end
else
bytes[n + 2] = '='
bytes[n + 3] = '='
end
n = n + 4
end
return table.concat(bytes)
end
function ss.str.b64d(str)
end
ss.math = {}
function ss.math.lerp(t, a, b)
return (1-t)*a + (t*b)
end
function ss.dump(o, state, path, depth)
state = state or {tbls = {}}
depth = depth or 0
local pfx = string.rep(' ', depth)
if type(o) == "table" then
local str = ''
for k,p in pairs(o) do
local done = false
local exp
if type(p) == 'table' then
if state.tbls[p] then
exp = '<' .. state.tbls[p] ..'>'
done = true
else
state.tbls[p] = path and string.format('%s.%s', path, k) or k
end
end
if not done then
local function dodump() return ss.dump(
p, state,
path and string.format("%s.%s", path, k) or k,
depth + 1
) end
-- boy this is ugly
if type(p) ~= 'table' or
getmetatable(p) == nil or
getmetatable(p).__tostring == nil then
exp = dodump()
end
if type(p) == 'table' then
exp = string.format('{\n%s%s}', exp, pfx)
local meta = getmetatable(p)
if meta then
if meta.__tostring then
exp = tostring(p)
end
if meta.__name then
exp = meta.__name .. ' ' .. exp
end
end
end
end
str = str .. pfx .. string.format("%s = %s\n", k, exp)
end
return str
elseif type(o) == "string" then
return string.format('“%s”', o)
else
return tostring(o)
end
end
function ss.hexdump(s)
local hexlines, charlines = {},{}
for i=1,#s do
local line = math.floor((i-1)/16) + 1
hexlines[line] = (hexlines[line] or '') .. string.format("%02x ",string.byte(s, i))
charlines[line] = (charlines[line] or '') .. ' ' .. string.gsub(string.sub(s, i, i), '[^%g ]', '\x1b[;35m·\x1b[36;1m') .. ' '
end
local str = ''
for i=1,#hexlines do
str = str .. '\x1b[1;36m' .. charlines[i] .. '\x1b[m\n' .. hexlines[i] .. '\n'
end
return str
end
function ss.declare(c)
local cls = setmetatable({
__name = c.ident;
}, {
__name = 'class';
__tostring = function() return c.ident or '(class)' end;
__index = c.cfns;
})
cls.__call = c.call
cls.__index = function(self, k)
if c.default and c.default[k] then
return c.default[k]
end
if k == 'clone' then
return function(self)
local new = cls.mk()
for k,v in pairs(self) do
new[k] = v
end
if c.clonesetup then
c.clonesetup(new, self)
end
return new
end
elseif k == 'to' then
return function(self, to, ...)
if to == 'string' then return tostring(self)
elseif to == 'number' then return tonumber(self)
elseif to == 'int' then return math.floor(tonumber(self))
elseif c.cast and c.cast[to] then
return c.cast[to](self, ...)
elseif type(to) == 'table' and getmetatable(to) and getmetatable(to).cvt and getmetatable(to).cvt[cls] then
else error((c.ident or 'class') .. ' is not convertible to ' .. (type(to) == 'string' and to or tostring(to))) end
end
end
if c.fns and c.fns[k] then return c.fns[k] end
if c.index then return c.index(self,k) end
end
if c.cast then
if c.cast.string then
cls.__tostring = c.cast.string
end
if c.cast.number then
cls.__tonumber = c.cast.number
end
end
if c.op then
cls.__add = c.op.sum
cls.__sub = c.op.sub
cls.__div = c.op.div
cls.__mul = c.op.mul
cls.__concat = c.op.cat
cls.__eq = c.op.eq
cls.__lt = c.op.lt
end
cls.mk = function(...)
local val = setmetatable(c.mk and c.mk(...) or {}, cls)
if c.init then
for k,v in pairs(c.init) do
val[k] = v
end
end
if c.construct then
c.construct(val, ...)
end
return val
end
getmetatable(cls).__call = function(_, ...) return cls.mk(...) end
cls.is = function(o) return getmetatable(o) == cls end
cls.__metatable = cls -- lock metatable
return cls
end
-- tidy exceptions
ss.exn = ss.declare {
ident = 'exn';
mk = function(kind, ...)
return {
vars = {...};
kind = kind;
}
end;
cast = {
string = function(me)
return me.kind.report(table.unpack(me.vars))
end;
};
fns = {
throw = function(me) error(me) end;
}
}
ss.exnkind = ss.declare {
ident = 'exn-kind';
mk = function(desc, report)
return {
desc = desc;
report = report or function(msg,...)
return string.format(msg,...)
end;
}
end;
call = function(me, ...)
return ss.exn(me, ...)
end;
}
ss.str.exn = ss.exnkind 'failure while string munging'
ss.bug = ss.exnkind 'tripped over bug'
function ss.str.delimit(encoding, start, stop, s)
local depth = 0
encoding = encoding or ss.str.enc.utf8
if not ss.str.begins(s, start) then return nil end
for c,p in ss.str.each(encoding,s) do
if c == (encoding.escape or '\\') then
p.next.byte = p.next.byte + #encoding.char(encoding.codepoint(s, p.next.byte))
p.next.code = p.next.code + 1
elseif c == start then
depth = depth + 1
elseif c == stop then
depth = depth - 1
if depth == 0 then
return s:sub(1+#start, p.byte - #stop), p.byte -- FIXME
elseif depth < 0 then
ss.str.exn('out of place token “%s”', stop):throw()
end
end
end
ss.str.exn('token “%s” expected before end of line', stop):throw()
end
ss.version = ss.declare {
name = 'version';
mk = function(tbl) return tbl end;
fns = {
pre = function(self,other) end;
post = function(self,other) end;
string = function(self) return tostring(self) end;
};
cast = {
string = function(vers)
if not(next(vers)) then return '0.0' end
local str = ''
for _,v in pairs(vers) do
if type(v) == 'string' then
if str ~= '' then str = str .. '-' end
str = str .. v
else
if str ~= '' then str = str .. '.' end
str = str .. tostring(v)
end
end
return str
end
};
}
function ss.classinstance(o)
local g = getmetatable(o)
if not o then return nil end
local mm = getmetatable(g)
if not o then return nil end
if mm.__name == 'class' then
return g
else
return nil
end
end
function ss.walk(o, key, ...)
if o[key] then
if select('#', ...) == 0 then
return o[key]
else
return ss.walk(o[key], ...)
end
end
return nil
end
function ss.coalesce(x, ...)
if x ~= nil then
return x
elseif select('#', ...) == 0 then
return nil
else
return ss.coalesce(...)
end
end
ss.tuple = {}
function ss.tuple.any(...)
return select('#',...) > 0
end
function ss.tuple.cat(...)
local a = {...}
return function(...)
ss.push(a, ...)
return table.unpack(a)
end
end
function ss.tuple.suffix(sfx,n,...)
if n ~= nil then
return n, ss.tuple.suffix(...)
else
return sfx
end
end
function ss.tuple.cdr(x, ...) return ... end
ss.stack = ss.declare {
ident = 'stack';
mk = function() return {
top = 0;
store = {};
} end;
index = function(me, i)
if i <= 0 then
return me.store[me.top + i]
else
return me.store[i]
end
end;
fns = {
push = function(me, val, ...)
if val~=nil then
me.top = me.top + 1
me.store[me.top] = val
me:push(...)
end
return val, ...
end;
pop = function(me,n) n = n or 1
local r = {}
if n < me.top then
for i = 0,n-1 do
r[i+1] = me.store[me.top - i]
me.store[me.top - i] = nil
end
me.top = me.top - n
else
r = me.store
me.store = {}
end
return table.unpack(r)
end;
set = function(me,val)
if me.top == 0 then
me.top = me.top + 1 --autopush
end
me.store[me.top] = val
end;
all = function(me) return table.unpack(me.store) end;
each = function(me,forward)
if forward then
local idx = 0
return function()
idx = idx + 1
if idx > me.top
then return nil
else return me.store[idx], idx
end
end
else
local idx = me.top + 1
return function()
idx = idx - 1
if idx == 0
then return nil
else return me.store[idx], idx
end
end
end
end;
};
}
ss.automat = ss.declare {
ident = 'automat';
mk = function() return {
state = ss.stack();
states = {};
ttns = {};
mem = {};
match = function(sym, ttn, mach)
if ttn.pred and ttn:pred(mach, sym)~=true then
return false
end
if ttn.on then
return sym == ttn.on
end
return false
end;
} end;
construct = function(me, def)
for k,v in pairs{'states','ttns','mem','syms'} do
if def[k] then me[k] = v end
end
end;
fns = {
react = function(me,sym)
local s = me.states[me.state.id]
if s and s.input then
s:react(me, sym)
end
end;
drop = function(me,n)
for i = 0, math.min(n-1,me.state.top-1) do
local s = me.states[me.state[-i].id]
if s.exit then s:exit(s.mem, me) end
end
if n < me.state.top then
local newtop = me.states[me.state[-n].id]
if newtop.activate then newtop:activate(me.state[-n].mem, me, n) end
end
return me.state:pop(n)
end;
clear = function(me) return me:drop(me.state.top) end;
transition = function(me,ttn,oldstates)
local s = me.state:push {id = ttn.to, mem = {}}
local to = me.states[ttn.to]
if to.enter then
to:enter(s.mem, me)
end
end;
input = function(me,sym)
local ttns = me.ttns[me.state.id]
local _, ttn = ss.find(ttns, function(ttn)
return me.match(sym, ttn, me)
end)
if ttn then
if ttn.pop then
local oldstates = {me.state:drop(ttn.pop)}
me:transition(ttn, sym, oldstates)
else
me:transition(ttn, sym)
end
else
me:react(sym)
end
end;
};
}
function ss.math.clamp(v, l, h)
return math.max(math.min(v, h or 1), l or 0)
end
-- convenience buffer for holding strings under
-- construction, accumulating and compiling then in
-- as quick a way as lua permits
ss.strac = ss.declare {
ident = 'string-accumulator';
mk = function() return {
strs = {};
strc = 0;
plain = true;
} end;
call = function(self, s, ...)
if s == nil then return end
self.strc = self.strc + 1
self.strs[self.strc] = s
if type(s) ~= 'string' then self.plain = false end
self(...)
end;
cast = {
string = function(self)
return self:compile()
end;
};
fns = {
compile = function(self, delim)
if self.plain then
return table.concat(self.strs, delim)
end
local tbl = {}
local function delve(a)
for i=1,a.strc do
local s = a.strs[i]
if type(s) == 'string' then
table.insert(tbl, s)
elseif ss.strac.is(s) then
delve(s)
elseif s ~= nil then
table.insert(tbl, tostring(s))
end
end
end
delve(self)
return table.concat(tbl, delim)
end;
wrap = function(self,a,b)
table.insert(self.strs, 1, a)
table.insert(self.strs, b)
end;
};
}
-- color class based on c.hale.su/sorcery's, hsl conversion
-- code written by glowpelt. TODO switch to LCH
local function clip(v, ...)
if v == nil then return end
return math.max(0,math.min(0xFF,math.floor(v))), clip(...)
end;
local function bytefrac(f, ...)
if f == nil then return end
return clip(f*0xFF), bytefrac(...)
end
ss.color = ss.declare {
ident = 'color';
mk = function(h,s,l,a) return {
hue = h or 0.0;
sat = s or 0.0;
lum = l or 0.0;
alpha = a or 1.0;
} end;
cfns = {
byteclip = clip;
bytefrac = bytefrac;
};
cast = {
string = function(self) return self:hex() end;
number = function(self) return self:u32() end;
};
op = {
sum = function(self, other)
if ss.color.is(other) then
local fac = ss.math.lerp(self.alpha, 1, other.alpha)
return self:blend(other, fac):warp(function(c)
c.alpha = ss.math.clamp(self.alpha+other.alpha)
end)
else -- color + number = brighter color
return self:warp(function(c)
c.lum = c.lum + other
end)
end
end;
mul = function(self, other)
if ss.color.is(other) then
ss.color.exn 'how the heck do you multiply in hsl anyway':throw()
else
return self:warp(function(c)
c.lum = c.lum * other
end)
end
end;
};
fns = {
tuple = function(self)
return self.hue, self.sat, self.lum, self.alpha
end;
warp = function(self, func)
local n = self:clone()
func(n)
return n
end;
blend = function(self, other, fac)
return ss.color(
ss.math.lerp(fac, self.hue, other.hue),
ss.math.lerp(fac, self.sat, other.sat),
ss.math.lerp(fac, self.lum, other.lum),
ss.math.lerp(fac, self.alpha, other.alpha))
end;
hex = function(self)
local r,g,b,a = bytefrac(self:rgb_t())
if self.alpha == 1 then a = nil end
return string.format('#'..string.rep('%02x',a and 4 or 3),
r,g,b,a)
end;
u32 = function(self)
local r,g,b,a = bytefrac(self:rgb_t())
return r<<24 | g << 16 | b << 8 | a
end;
bytes = function(self)
return { bytefrac(self:rgb_t()) }
end;
alt = function(self, fld, new)
if self[fld] then
return self:warp(function(c) c[fld]=new end)
else
ss.color.exn('no such field %s in color', fld):throw()
end
end;
rgb = function(self)
-- convenience function to get a standardized struct
local r,g,b,a = self:rgb_t()
return {
red = r;
green = g;
blue = b;
alpha = a;
}
end;
rgb_t = function(self)
-- returns rgba values as a tuple
local value = function(n1, n2, hue)
if hue > 360 then
hue = hue - 360
elseif hue < 0 then
hue = hue + 360
end
if hue < 60 then
return n1 + (n2 - n1) * hue/60
elseif hue < 180 then
return n2
elseif hue < 240 then
return n1 + (n2 - n1) * (240 - hue)/60
else
return n1
end
end
local h,s,l,alpha = self:tuple()
local m2
if l < 0.5 then
m2 = l * (1 + s)
else
m2 = l + s - l * s
end
local m1 = 2 * l - m2
if s == 0 then
-- Achromatic, there is no hue
-- In book this errors if hue is not undefined, but we set hue to 0 in this case, not nil or something, so
return l, l, l, alpha
else
-- Chromatic case, so there is a hue
return
value(m1, m2, h + 120),
value(m1, m2, h),
value(m1, m2, h - 120),
alpha
end
end;
};
};
ss.color.exn = ss.exnkind 'color error'
ss.cmdfmt = function(cmd, ...)
return string.format(cmd, ss.tmap(function(s)
if typeof(s) == 'string' then
return string.format("%q", s)
-- FIXME this is incredibly lazy and uses lua quoting, not
-- bourne shell quoting. it *will* cause problems if anything
-- exotic finds its way in and needs to be fixed.
-- TODO provide a proper popen in the C wrapper so wrapped
-- versions at least can launch programs in a sane and secure
-- way.
else
return s
end
end, ...))
end
local fetchexn = ss.exnkind 'fetch'
local fetchableProtocols = {
http = {
proto = {
{'http'};
{'https'};
{'http', 'tls'};
};
fetch = function(uri)
fetchexn('cortav must be compiled with the C shim and libcurl support to use http fetch'):throw()
end;
};
file = {
proto = {
{'file'};
{'file', 'txt'};
{'file', 'bin'};
{'asset'};
{'asset', 'txt'};
{'asset', 'bin'};
};
fetch = function(uri, env)
local assetDir = env.asset_base or '.'
if uri.namespace then
fetchexn('authority (hostname) segment is not supported in file: URIs'):throw()
end
if uri.svc then
fetchexn('service segment is not supported in file: URIs'):throw()
end
local mode = 'r'
local path = uri.path
if uri.class[1] == 'asset' then path = assetDir ..'/'.. path end
if uri.class[2] == 'bin' then mode = 'rb' end
local fd,e = io.open(path, mode)
if not fd then
fetchexn('IO error fetching URI “%s” (%s)', tostring(uri), e):throw()
end
local data = fd:read '*a'
fd:close()
return data
end;
};
}
function ss.match(a,b, eq)
if #a ~= #b then return false end
eq = eq or function(p,q) return p == q end
for i = 1, #a do
if not eq(a[i],b[i]) then return false end
end
return true
end
ss.uri = ss.declare {
ident = 'uri';
mk = function() return {
class = nil;
namespace = nil;
path = nil;
query = nil;
frag = nil;
auth = nil;
} end;
construct = function(me, str)
local enc = ss.str.enc.utf8
-- URIs must be either ASCII or utf8, so we read and
-- store as UTF8. to use a URI in another encoding, it
-- must be manually converted to and fro using the
-- appropriate functions, such as encodeUCS
if not str then return end
me.raw = str
local rem = str
local s_class do
local s,r = rem:match '^([^:]+):(.*)$'
s_class, rem = s,r
end
if not rem then
ss.uri.exn('invalid URI “%s”', str):throw()
end
local s_ns do
local s,r = rem:match '^//([^/]*)(.*)$'
if s then s_ns, rem = s,r end
end
local h_query
local s_frag
local s_path if rem ~= '' then
local s,q,r = rem:match '^([^?#]*)([?#]?)(.*)$'
if s == '' then s = nil end
s_path, rem = s,r
if q == '#' then
s_frag = rem
elseif q == '?' then
h_query = true
end
else s_path = '' end
local s_query if h_query then
local s,q,r = rem:match '^([^#]*)(#?)(.*)$'
s_query, rem = s,r
if q~='' then s_frag = rem end
end
local function dec(str)
if not str then return end
return str:gsub('%%([0-9A-Fa-f][0-9A-Fa-f])', function(hex)
return string.char(tonumber(hex,16))
end)
end
local s_auth if s_ns then
local s,r = s_ns:match('^([^@]*)@(.*)$')
if s then
s_ns = r
if s ~= '' then
s_auth = s
end
end
end
local s_svc if s_ns then
local r,s = s_ns:match('^(.*):(.-)$')
if r then
s_ns = r
if s and s ~= '' then
s_svc = s
end
end
end
me.class = ss.str.split(enc, s_class, '+', {keep_empties=true})
for i,v in ipairs(me.class) do me.class[i] = dec(v) end
me.auth = dec(s_auth)
me.svc = dec(s_svc)
me.namespace = dec(s_ns)
me.path = dec(s_path)
me.query = dec(s_query)
me.frag = dec(s_frag)
end;
cast = {
string = function(me)
local function san(str, chars)
-- TODO IRI support
chars = chars or ''
local ptn = '-a-zA-Z0-9_.,;'
ptn = ptn .. chars
return (str:gsub('[^'..ptn..']', function(c)
if c == ' ' then return '+' end
return string.format('%%%02X', string.byte(c))
end))
end
if me.class == nil or next(me.class) == nil then
return 'none:'
end
local parts = {
table.concat(ss.map(san,me.class), '+') .. ':';
}
if me.namespace or me.auth or me.svc then
table.insert(parts, '//')
if me.auth then
table.insert(parts, san(me.auth,':') .. '@')
end
if me.namespace then
table.insert(parts, san(me.namespace))
end
if me.svc then
table.insert(parts, ':' .. san(me.svc))
end
if me.path and not ss.str.begins(me.path, '/') then
table.insert(parts, '/')
end
end
if me.path then
table.insert(parts, san(me.path,'+/=&'))
end
if me.query then
table.insert(parts, '?' .. san(me.query,'?+/=&'))
end
if me.frag then
table.insert(parts, '#' .. san(me.frag,'+/=&'))
end
return table.concat(parts)
end;
};
fns = {
canfetch = function(me)
for id, pr in pairs(fetchableProtocols) do
for _, p in ipairs(pr.proto) do
if ss.match(me.class, p) then return id end
end
end
return false
end;
fetch = function(me, env)
local pid = me:canfetch()
if (not pid) or fetchableProtocols[pid].fetch == nil then
ss.uri.exn("URI “%s” is unfetchable", tostring(me)):throw()
end
local proto = fetchableProtocols[pid]
return proto.fetch(me, env or {})
end;
};
}
ss.uri.exn = ss.exnkind 'URI'
ss.mime = ss.declare {
ident = 'mime-type';
mk = function() return {
class = nil;
kind = nil;
opts = {};
} end;
construct = function(me,str)
if not str then return end
local p,o = str:match '^([^;]+);?%s*(.-)$'
if not p then ss.mime.exn('invalid type syntax %s',str):throw() end
local c,k = p:match '^([^/]+)/?(.-)$'
me.class = (c ~= '') and c or nil
me.kind = (k ~= '') and k or nil
if o and o ~= '' then
for key, e, val in o:gmatch '%s*([^=;]+)(=?)([^;]*)' do
if me.opts[key] then
ss.mime.exn('mime type cannot contain multiple %s options',key):throw()
elseif me.opts.hex and key == 'base64'
or me.opts.base64 and key == 'hex' then
ss.mime.exn('mime type cannot more than one of (base64, hex)',key):throw()
end
if e == '' then val = true end
me.opts[key] = val
end
end
end;
op = {
eq = function(self, other)
-- exact match operator
if not ss.mime.is(other) then return ss.mime.exn("tried to compare MIME type %s against %s (%s)", tostring(self), type(other), tostring(other)):throw() end
if (self.kind == other.kind or (self.kind == '*' or other.kind == '*')) and
(self.class == other.class or (self.class == '*' or other.class == '*')) and
(#self.opts ==#other.opts) then
for k,v in pairs(self.opts) do
if not(other.opts[k] == '*' or (v == '*' and other.opts[k])) then
if other.opts[k] ~= v then return false end
end
end
for k,v in pairs(other.opts) do
if not(self.opts[k] == '*' or (v == '*' and self.opts[k])) then
if self.opts[k] ~= v then return false end
end
end
return true
else
return false
end
end;
lt = function(self,other)
-- lt is the "subset?" operator -- it returns true if self
-- matches at least as many fields as other has. use this
-- when you have a base type and want to check whether
-- another type is compatible with that type. say all you
-- care about is whether a file is "text/plain", and it
-- can be encoded however as long as that much fits.
-- you would then ask ss.mime'text/plain' < file.mime
return other:superset_of(self)
end;
};
cast = {
string = function(me)
local r
if me.kind and me.class then
r = string.format('%s/%s',me.class,me.kind)
elseif me.class then
r = me.class
end
for k,v in pairs(me.opts) do
if v and v ~= true then
r = r .. string.format(';%s=%s',k,v)
elseif v == true then
r = r .. string.format(';%s',k)
end
end
return r
end;
};
fns = {
superset_of = function(self, other)
-- a mime type is greater than another if all the fields
-- other has have a matching field in self. think of this
-- as the "superset?" operator -- all fields and options
-- on other must either match self or be unset
if not ss.mime.is(other) then return ss.mime.exn("tried to compare MIME type %s against %s (%s)", tostring(self), type(other), tostring(other)):throw() end
if (other.class and self.class ~= other.class and other.class ~='*')
or (other.kind and self.kind ~= other.kind and other.kind ~= '*')
then return false end
for k,v in pairs(other.opts) do
if self.opts[k] and self.opts[k] ~= v and v ~='*' then
return false
end
end
return true
end;
is = function(me, pc)
local mimeclasses = {
['application/svg+xml'] = 'image';
['application/x-tar'] = 'archive';
}
local c = me.class
for k,v in pairs(mimeclasses) do
if me > ss.mime(k) then
c = v break
end
end
print(c)
return c == pc
end;
};
}
ss.mime.exn = ss.exnkind 'MIME error'