· 4 years ago · Jan 09, 2021, 01:32 AM
1----------------------------------------------------------------------------------------
2-- Wojbies API 5.0 - Utility - assorted functions that don't deserver their own place --
3----------------------------------------------------------------------------------------
4--LICENCE: ZLIB/libpng Licence (Zlib)
5-- Copyright (c) 2015-2020 Wojbie (wojbie@wojbie.net)
6-- This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages arising from the use of this software.
7-- Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions:
8-- 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required.
9-- 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software.
10-- 3. This notice may not be removed or altered from any source distribution.
11
12--### Initializing
13local u = shell and {} or (_ENV or getfenv())
14u.versionName = "Utility By Wojbie"
15u.versionNum = 4.009 --2020-01-13
16
17--### Random Functions
18
19--# [[Adaptation of the Secure Hashing Algorithm (SHA-244/256) Found Here: http://lua-users.org/wiki/SecureHashAlgorithm Using an adapted version of the bit library Found Here: https://bitbucket.org/Boolsheet/bslf/src/1ee664885805/bit.lua Taken from http://www.computercraft.info/forums2/index.php?/topic/8169-sha-256-in-pure-lua/ and http://pastebin.com/gsFrNjbt]]
20do local MOD = 2 ^ 32 local MODM = MOD - 1 local function memoize(f) local mt = {} local t = setmetatable({}, mt) function mt:__index(k) local v = f(k) t[k] = v return v end return t end local function make_bitop_uncached(t, m) local function bitop(a, b) local res, p = 0, 1 while a ~= 0 and b ~= 0 do local am, bm = a % m, b % m res = res + t[am][bm] * p a = (a - am) / m b = (b - bm) / m p = p * m end res = res + (a + b) * p return res end return bitop end local function make_bitop(t) local op1 = make_bitop_uncached(t, 2 ^ 1) local op2 = memoize(function(a) return memoize(function(b) return op1(a, b) end) end) return make_bitop_uncached(op2, 2 ^ (t.n or 1)) end local bxor1 = make_bitop({[0] = {[0] = 0, [1] = 1}, [1] = {[0] = 1, [1] = 0}, n = 4}) local function bxor(a, b, c, ...) local z = nil if b then a = a % MOD b = b % MOD z = bxor1(a, b) if c then z = bxor(z, c, ...) end return z elseif a then return a % MOD else return 0 end end local function band(a, b, c, ...) local z if b then a = a % MOD b = b % MOD z = (a + b - bxor1(a, b)) / 2 if c then z = bit32_band(z, c, ...) end return z elseif a then return a % MOD else return MODM end end local function bnot(x) return (-1 - x) % MOD end local function rshift1(a, disp) if disp < 0 then return lshift(a, -disp) end return math.floor(a % 2 ^ 32 / 2 ^ disp) end local function rshift(x, disp) if disp > 31 or disp < -31 then return 0 end return rshift1(x % MOD, disp) end local function lshift(a, disp) if disp < 0 then return rshift(a, -disp) end return a * 2 ^ disp % 2 ^ 32 end local function rrotate(x, disp) x = x % MOD disp = disp % 32 local low = band(x, 2 ^ disp - 1) return rshift(x, disp) + lshift(low, 32 - disp) end local k = { 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5, 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174, 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da, 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967, 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85, 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070, 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3, 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2 } local function str2hexa(s) return (string.gsub(s, ".", function(c) return string.format("%02x", string.byte(c)) end)) end local function num2s(l, n) local s = "" for _ = 1, n do local rem = l % 256 s = string.char(rem) .. s l = (l - rem) / 256 end return s end local function s232num(s, i) local n = 0 for i = i, i + 3 do n = n * 256 + string.byte(s, i) end return n end local function preproc(msg, len) local extra = 64 - (len + 9) % 64 len = num2s(8 * len, 8) msg = msg .. "\128" .. string.rep("\0", extra) .. len assert(#msg % 64 == 0) return msg end local function initH256(H) H[1] = 0x6a09e667 H[2] = 0xbb67ae85 H[3] = 0x3c6ef372 H[4] = 0xa54ff53a H[5] = 0x510e527f H[6] = 0x9b05688c H[7] = 0x1f83d9ab H[8] = 0x5be0cd19 return H end local function digestblock(msg, i, H) local w = {} for j = 1, 16 do w[j] = s232num(msg, i + (j - 1) * 4) end for j = 17, 64 do local v = w[j - 15] local s0 = bxor(rrotate(v, 7), rrotate(v, 18), rshift(v, 3)) v = w[j - 2] w[j] = w[j - 16] + s0 + w[j - 7] + bxor(rrotate(v, 17), rrotate(v, 19), rshift(v, 10)) end local a, b, c, d, e, f, g, h = H[1], H[2], H[3], H[4], H[5], H[6], H[7], H[8] for i = 1, 64 do local s0 = bxor(rrotate(a, 2), rrotate(a, 13), rrotate(a, 22)) local maj = bxor(band(a, b), band(a, c), band(b, c)) local t2 = s0 + maj local s1 = bxor(rrotate(e, 6), rrotate(e, 11), rrotate(e, 25)) local ch = bxor (band(e, f), band(bnot(e), g)) local t1 = h + s1 + ch + k[i] + w[i] h, g, f, e, d, c, b, a = g, f, e, d + t1, c, b, a, t1 + t2 end H[1] = band(H[1] + a) H[2] = band(H[2] + b) H[3] = band(H[3] + c) H[4] = band(H[4] + d) H[5] = band(H[5] + e) H[6] = band(H[6] + f) H[7] = band(H[7] + g) H[8] = band(H[8] + h) end local function sha256(msg) msg = preproc(msg, #msg) local H = initH256({}) for i = 1, #msg, 64 do digestblock(msg, i, H) end return str2hexa(num2s(H[1], 4) .. num2s(H[2], 4) .. num2s(H[3], 4) .. num2s(H[4], 4) .. num2s(H[5], 4) .. num2s(H[6], 4) .. num2s(H[7], 4) .. num2s(H[8], 4)) end u.hash = sha256 end
21
22--# Default Colors list
23
24u.tHex = {[ colors.white ] = "0", [ colors.orange ] = "1", [ colors.magenta ] = "2", [ colors.lightBlue ] = "3", [ colors.yellow ] = "4", [ colors.lime ] = "5", [ colors.pink ] = "6", [ colors.gray ] = "7", [ colors.lightGray ] = "8", [ colors.cyan ] = "9", [ colors.purple ] = "a", [ colors.blue ] = "b", [ colors.brown ] = "c", [ colors.green ] = "d", [ colors.red ] = "e", [ colors.black ] = "f"} local tHex = u.tHex
25
26u.tPaint = {[ "0" ] = 15, [ "1" ] = 14, [ "2" ] = 13, [ "3" ] = 12, [ "4" ] = 11, [ "5" ] = 10, [ "6" ] = 9, [ "7" ] = 8, [ "8" ] = 7, [ "9" ] = 6, [ "a" ] = 5, [ "b" ] = 4, [ "c" ] = 3, [ "d" ] = 2, [ "e" ] = 1, [ "f" ] = 0} --minecraft:dye
27
28u.tRGB = {[ "0" ] = 0xF0F0F0, [ "1" ] = 0xF2B233, [ "2" ] = 0xE57FD8, [ "3" ] = 0x99B2F2, [ "4" ] = 0xDEDE6C, [ "5" ] = 0x7FCC19, [ "6" ] = 0xF2B2CC, [ "7" ] = 0x4C4C4C, [ "8" ] = 0x999999, [ "9" ] = 0x4C99B2, [ "a" ] = 0xB266E5, [ "b" ] = 0x3366CC, [ "c" ] = 0x7F664C, [ "d" ] = 0x57A64E, [ "e" ] = 0xCC4C4C, [ "f" ] = 0x111111}
29
30u.palette = {}
31
32u.palette.default = {}
33for i=0,15 do
34 local col = 2^i
35 u.palette.default[col] = colors.packRGB(term.nativePaletteColour(col))
36end
37
38u.palette.classic = {[ colors.white ] = 0xF0F0F0, [ colors.orange ] = 0xF2B233, [ colors.magenta ] = 0xE57FD8, [ colors.lightBlue ] = 0x99B2F2, [ colors.yellow ] = 0xDEDE6C, [ colors.lime ] = 0x7FCC19, [ colors.pink ] = 0xF2B2CC, [ colors.gray ] = 0x4C4C4C, [ colors.lightGray ] = 0x999999, [ colors.cyan ] = 0x4C99B2, [ colors.purple ] = 0xB266E5, [ colors.blue ] = 0x3366CC, [ colors.brown ] = 0x7F664C, [ colors.green ] = 0x57A64E, [ colors.red ] = 0xCC4C4C, [ colors.black ] = 0x111111}
39
40u.palette.vibrant = {[ colors.white ] = 0xFFFFFF, [ colors.orange ] = 0xFF6300, [ colors.magenta ] = 0xFF00DE, [ colors.lightBlue ] = 0x00C3FF, [ colors.yellow ] = 0xFFFF00, [ colors.lime ] = 0x91FF00, [ colors.pink ] = 0xFF6DA8, [ colors.gray ] = 0x383737, [ colors.lightGray ] = 0xA9A9A9, [ colors.cyan ] = 0x00FFFF, [ colors.purple ] = 0x7700FF, [ colors.blue ] = 0x0000FF, [ colors.brown ] = 0x4C2700, [ colors.green ] = 0x00FF00, [ colors.red ] = 0xFF0000, [ colors.black ] = 0x000000} --# See: https://pastebin.com/uV1LGLTC
41
42u.palette.zeromini = {[ colors.white ] = 0xabb2bf, [ colors.orange ] = 0xda8548, [ colors.magenta ] = 0xc678dd, [ colors.lightBlue ] = 0x4174ae, [ colors.yellow ] = 0xddbd78, [ colors.lime ] = 0x9eac8c, [ colors.pink ] = 0xF2B2CC, [ colors.gray ] = 0x5a5a5a, [ colors.lightGray ] = 0x666666, [ colors.cyan ] = 0x61afef, [ colors.purple ] = 0x64446d, [ colors.blue ] = 0x1f5582, [ colors.brown ] = 0x4a473d, [ colors.green ] = 0x98be65, [ colors.red ] = 0xff6c6b, [ colors.black ] = 0x282c34} --# Note: Pink is default. see: https://github.com/SquidDev-CC/random-programs/blob/master/zeromini-palette.lua
43
44u.palette.amber = {[ colors.white ] = 0xFFBE00, [ colors.orange ] = 0xC39200, [ colors.magenta ] = 0xB48600, [ colors.lightBlue ] = 0xE1A800, [ colors.yellow ] = 0xF0B300, [ colors.lime ] = 0xA57B00, [ colors.pink ] = 0xD29D00, [ colors.gray ] = 0x2D2100, [ colors.lightGray ] = 0x876500, [ colors.cyan ] = 0x785900, [ colors.purple ] = 0x4B3800, [ colors.blue ] = 0x5A4300, [ colors.brown ] = 0x3C2C00, [ colors.green ] = 0x694E00, [ colors.red ] = 0x967000, [ colors.black ] = 0x1E1600} --# Amber. see: https://github.com/LDDestroier/CC/blob/master/windont/ghost.lua
45
46--# Palette reseter
47u.resetPalette = function(parent, palette)
48 if type(parent) == "string" then parent, palette = nil, parent end
49 if not parent then parent = term end
50 if not palette then palette = "default" end
51 if not u.palette[palette] then error("Invalid palette selected ", 2) end
52 if type(parent) ~= "table" or not parent.setPaletteColour then error("Malformed terminal object", 2) end
53
54 for c, hex in pairs(u.palette[palette]) do
55 parent.setPaletteColour( c, hex )
56 end
57end
58
59--# Asks yes/no type of question.
60u.yn = function(sQuestion)
61 if not sQuestion then return false end
62 local _, key
63 write(sQuestion .. "[y/n]:")
64 while true do
65 _, key = os.pullEvent("char")
66 if key == "y" then print(key) return true
67 elseif key == "n" then print(key) return false
68 end
69 end
70end
71
72--# Serialization functions.
73local g_tLuaKeywords = {[ "and" ] = true, [ "break" ] = true, [ "do" ] = true, [ "else" ] = true, [ "elseif" ] = true, [ "end" ] = true, [ "false" ] = true, [ "for" ] = true, [ "function" ] = true, [ "if" ] = true, [ "in" ] = true, [ "local" ] = true, [ "nil" ] = true, [ "not" ] = true, [ "or" ] = true, [ "repeat" ] = true, [ "return" ] = true, [ "then" ] = true, [ "true" ] = true, [ "until" ] = true, [ "while" ] = true}
74
75local function serializeImplFlat( t, tTracking )
76 local sType = type(t)
77 if sType == "table" then
78 if tTracking[t] ~= nil then
79 error( "Cannot serialize table with recursive entries", 0 )
80 end
81 tTracking[t] = true
82
83 if next(t) == nil then
84 -- Empty tables are simple
85 return "{}"
86 else
87 -- Other tables take more work
88 local sResult = "{"
89 local tSeen = {}
90 for k, v in ipairs(t) do
91 tSeen[k] = true
92 local sEntry = serializeImplFlat( v, tTracking )
93 if sEntry then
94 sResult = sResult .. sEntry .. ","
95 end
96 end
97 for k, v in pairs(t) do
98 if not tSeen[k] then
99 if type(k) == "string" and not g_tLuaKeywords[k] and string.match( k, "^[%a_][%a%d_]*$" ) then
100 local sEntry = serializeImplFlat( v, tTracking )
101 if sEntry then
102 sResult = sResult .. k .. "=" .. sEntry .. ","
103 end
104 else
105 local sEntry1, sEntry2 = serializeImplFlat( k, tTracking ), serializeImplFlat( v, tTracking )
106 if sEntry1 and sEntry2 then
107 sResult = sResult .. "[" .. sEntry1 .. "]=" .. sEntry2 .. ","
108 end
109 end
110 end
111 end
112 if string.sub(sResult, -1) == "," then --remove last , Saving world one char at time.
113 sResult = string.sub(sResult, 1, -2)
114 end
115 return sResult .. "}"
116 end
117
118 elseif sType == "string" then
119 return string.format( "%q", t )
120
121 elseif sType == "number" or sType == "boolean" or sType == "nil" then
122 return tostring(t)
123
124 else
125 --This way if tTracking is empty that means unserializable was passed into the function. If not then something inside table is unserializabe and will be skipped.
126 if not next(tTracking) then
127 error( "Cannot serialize type " .. sType, 0 )
128 end
129 end
130end
131
132--# Serializes tables into flat string
133u.serializeFlat = function( t )
134 local tTracking = {}
135 return serializeImplFlat( t, tTracking )
136end local serializeFlat = u.serializeFlat
137
138--# Serializes recursive tables into flat textutils.unserialize valid program string.
139u.serializeRec = function(t)
140 if type(t) ~= "table" then
141 return serializeFlat(t) --it was not table - do normal serialize
142 end
143 local tImput = {t}
144 local tList = {}
145 local tLook = {}
146 local tMark = {}
147 local tOutp = {"(function() "}
148 local cur, nTab
149 while #tImput > 0 do
150 cur = table.remove(tImput)
151 nTab = #tList + 1
152 tList[nTab] = cur
153 nTab = "t" .. nTab
154 tLook[cur] = nTab
155 if next(cur) == nil then
156 -- Empty tables are simple
157 tOutp[#tOutp + 1] = nTab .. "={};"
158 else
159 --Look over the table, make copy
160 local Basic = {}
161 for k, v in pairs(cur) do
162 if type(k) == "table" or type(v) == "table" then
163 table.insert(tMark, {cur, k, v})
164 if type(k) == "table" and not tLook[k] then tImput[#tImput + 1] = k end
165 if type(v) == "table" and not tLook[v] then tImput[#tImput + 1] = v end
166 else
167 Basic[k] = v
168 end
169 end
170 tOutp[#tOutp + 1] = nTab .. "=" .. serializeFlat(Basic) .. ";"
171 end
172 end
173 while #tMark > 0 do
174 cur = table.remove(tMark)
175 tOutp[#tOutp + 1] = tLook[cur[1]] .. "[" .. (type(cur[2]) == "table" and tLook[cur[2]] or serializeFlat(cur[2])) .. "]=" .. (type(cur[3]) == "table" and tLook[cur[3]] or serializeFlat(cur[3])) .. ";"
176 end
177 tOutp[#tOutp + 1] = "return t1 end)()"
178 return table.concat(tOutp)
179end
180
181--# Number clamp
182u.clamp = function(nMin, nNumber, nMax)
183 if type(nMin) ~= "number" or type(nNumber) ~= "number" or type(nMax) ~= "number" then error("Not a number.", 2) end
184 return math.min(math.max( nMin, nNumber ), nMax )
185end local clamp = u.clamp
186
187--# Copy table - if more than one merge them - in case of overwriting values last one gets its way
188local function copyTable(...)
189 local tArgs = {...}
190 local copy = {}
191 for _, piece in pairs(tArgs) do
192 if piece and type(piece) == "table" then
193 for key, val in pairs(piece) do
194 if type(val) == "table" then copy[key] = copyTable( copy[key] or {}, val)
195 else copy[key] = val end
196 end
197 end
198 end
199 return copy
200end u.copyTable = copyTable
201
202--# Clone table - duplicates single table preserving all recursive setups.
203u.cloneTable = function(source)
204 local lookup = {}
205 local output = {}
206 lookup[source] = output
207
208 local todo = {}
209 table.insert(todo, {source, output})
210
211 while #todo > 0 do
212 local job = table.remove(todo, 1)
213 local out = job[2]
214 for i, k in pairs(job[1]) do
215 if type(k) == "table" then
216 if not lookup[k] then lookup[k] = {} table.insert(todo, {k, lookup[k]}) end
217 out[i] = lookup[k]
218 else out[i] = k end
219 end
220 end
221
222 return output
223end
224
225--# Write on Center - writes proveided text centered horizontally or vertically on term object (defaults to term)
226u.writeOnCenter = function(tTerminal, tData, nX, nY)
227 if tTerminal and not tData then
228 tData = tTerminal
229 tTerminal = nil
230 end
231 tTerminal = tTerminal or term
232 if type(tData) == "string" then tData = {{tData}} end
233 local oX, oY = tTerminal.getSize()
234 local cX, cY = #tData[1][1], #tData[1]
235 nX = nX or math.floor((oX - cX) / 2) + 1
236 nY = nY or math.floor((oY - cY) / 2) + 1
237
238 for i = 1, cY do
239 if i > 1 and nY + i - 1 > oY then term.scroll(1) nY = nY - 1 end
240 tTerminal.setCursorPos(nX, nY + i - 1)
241 tTerminal.blit(tData[1][i], tData[2] and tData[2][i] or string.rep(tHex[tTerminal.getTextColor()], #tData[1][i]) , tData[3] and tData[3][i] or string.rep(tHex[tTerminal.getBackgroundColor()], #tData[1][i]))
242 end
243end
244
245--# Spacial table that will transferr all functions call to each and every sub table. If first argument is true then tables are treated as fluid otherwise contents are memoized.
246u.createMultitable = function(...)
247 local output = {}
248 local tab = {...}
249 local fluid = false
250 if tab[1] and type(tab[1]) == "boolean" and tab[1] then fluid = table.remove(tab, 1) end
251 if #tab == 1 and tab[1] and type(tab[1]) == "table" then tab = tab[1] end
252 if #tab == 0 then error("Expected [bool] and table of tables or tables to table. I know it makes no sense.", 2) end
253
254 local function makeWrap(tab, key)
255 return function(...)
256 local ret = {}
257 local tArgs = table.pack(...)
258 for _, k in ipairs(tab) do
259 if k[key] then
260 if #ret == 0 then ret = table.pack(k[key](table.unpack(tArgs))) --ret contains returns from first table that returned anything.
261 else k[key](table.unpack(tArgs)) end
262 end
263 end
264 return table.unpack(ret)
265 end
266 end
267
268 local function repopulate()
269 for key in pairs(tab[1]) do --create static table of multitable functions using first one as template
270 rawset(output, key, makeWrap(tab, key))
271 end
272 end
273 local function clean()
274 for key in pairs(output) do --remove all parts of static table that stopped existing.
275 if not tab[1][key] then rawset(output, key, nil) end
276 end
277 end
278
279 local manymeta = { --Anytime index is requested fist table is used as refference.
280 ["__index"] = function(_, key)
281 if tab and tab[1] and tab[1][key] then --If it has value it tested then
282 if type(tab[1][key]) == "function" then --If its function then a function that calls all tables in row is made
283 local wrap = makeWrap(tab, key)
284 if not fluid then rawset(output, key, wrap) end --If for some reason called function don't exists add it to static table
285 return wrap
286 else
287 return tab[1][key] --If its not a function then its just given out.
288 end
289 else
290 return nil --Of it not exist in first table give nothing
291 end
292 end,
293 ["__newindex"] = function() end, --If someone wants to add anything to the table do nothing.
294 ["__call"] = function(_, nTab) --If someone calls table like function give him direct acces to table list.
295 if nTab then tab = nTab if not fluid then clean() repopulate() end end --Allows swapping source table. WARNING If tab is changed using different method repopulate will fail. NO SANITY CHECKS!!
296 return tab
297 end,
298 ["__len"] = function() --Not sure if it works but this is giving the leanght of first table or 0 if there is no first table.
299 return tab[1] and #tab[1] or 0
300 end,
301 ["__metatable"] = false, --No touching the metatable.
302 }
303
304 if not fluid then repopulate() end
305
306 return setmetatable(output, manymeta) --create actual manymeta table and return it
307
308end
309
310--# Basic Menu implementation (List mode) (tFunctions is optional and will run function assigned to number selected from tOptions is exists)
311u.simpleMenu = function(tOptions, nStartPoint, tFunctions, nTimeout)
312
313 if type( tOptions ) ~= "table" or
314 nStartPoint ~= nil and type( nStartPoint ) ~= "number" or
315 tFunctions ~= nil and (type( tFunctions ) ~= "table" and type( tFunctions ) ~= "function") then
316 error( "Expected table, [number], [table/function]", 2 )
317 end
318 tFunctions = tFunctions or {}
319
320 local _, y = term.getSize()
321 local cText, CBack = term.getTextColor(), term.getBackgroundColor()
322 local selected = clamp(1, nStartPoint or 1, #tOptions)
323 local offset = 0
324
325 local function list()
326 offset = #tOptions <= y and 0 or clamp(0, selected - math.floor(y / 2), #tOptions - y)
327 term.clear()
328 for i = 1, #tOptions do
329 term.setCursorPos(1, i)
330 if i + offset == selected then term.setTextColor(CBack) term.setBackgroundColor(cText) term.clearLine()
331 elseif i + offset == selected + 1 then term.setTextColor(cText) term.setBackgroundColor(CBack) end
332 term.write(tOptions[i + offset])
333 end
334 term.setTextColor(cText) term.setBackgroundColor(CBack)
335 end
336 list()
337 local event, _, y, timer
338 if nTimeout then timer = os.startTimer(nTimeout) end
339 while true do
340 event = {os.pullEvent()}
341 _, y = term.getSize()
342 if event[1] == "key" then
343 if event[2] == keys.numPadEnter or event[2] == keys.enter then
344 if type(tFunctions) == "function" then -- If table of functions is a function then run it with seleced number
345 return tFunctions(selected)
346 elseif tFunctions[selected] then --If not function (like true) its non selectable entry. If a function run it.
347 if type(tFunctions[selected]) == "function" then return selected, tFunctions[selected]() end
348 else
349 return selected
350 end
351 elseif event[2] == keys.down then
352 selected = math.min(selected + 1, #tOptions)
353 list()
354 elseif event[2] == keys.up then
355 selected = math.max(selected - 1, 1)
356 list()
357 elseif event[2] == keys.pageDown then
358 selected = math.min(selected + y, #tOptions)
359 list()
360 elseif event[2] == keys.pageUp then
361 selected = math.max(selected - y, 1)
362 list()
363 end
364 elseif event[1] == "mouse_click" then
365 local line = offset + event[4]
366 if line == selected then
367 if type(tFunctions) == "function" then -- If table of functions is a function then run it with seleced number
368 return tFunctions(selected)
369 elseif tFunctions[selected] then --If not function (like true) its non selectable entry. If a function run it.
370 if type(tFunctions[selected]) == "function" then return selected, tFunctions[selected]() end
371 else
372 return selected
373 end
374 else
375 selected = clamp(1, line, #tOptions)
376 list()
377 end
378 elseif event[1] == "mouse_scroll" then
379 selected = clamp(1, selected + event[2], #tOptions)
380 list()
381 elseif event[1] == "timer" and event[2] == timer then
382 return -1
383 end
384 end
385
386end
387
388--# Basic motivator
389local tQuotes = {[[1. Pillage, then burn.]], [[2. A Sergeant in motion outranks a Lieutenant who doesn't know what's going on .]], [[3. An ordnance technician at a dead run outranks everybody .]], [[4. Close air support covereth a multitude of sins.]], [[5. Close air support and friendly fire should be easier to tell apart.]], [[6. If violence wasn't your last resort, you failed to resort to enough of it.]], [[7. If the food is good enough the grunts will stop complaining about the incoming fire.]], [[8. Mockery and derision have their place. Usually, it's on the far side of the airlock.]], [[9. Never turn your back on an enemy.]], [[10. Sometimes the only way out is through... through the hull.]], [[11. Everything is air-droppable at least once.]], [[12. A soft answer turneth away wrath. Once wrath is looking the other way, shoot it in the head.]], [[13. Do unto others.]], [[14. "Mad Science" means never stopping to ask "what's the worst thing that could happen?".]], [[15. Only you can prevent friendly fire.]], [[16. Your name is in the mouth of others: be sure it has teeth.]], [[17. The longer everything goes according to plan, the bigger the impending disaster.]], [[18. If the officers are leading from in front, watch for an attack from the rear.]], [[19. The world is richer when you turn enemies into friends, but that's not the same as you being richer.]], [[20. If you're not willing to shell your own position, you're not willing to win.]], [[21. Give a man a fish, feed him for a day. Take his fish away and tell him he's lucky just to be alive, and he'll figure out how to catch another one for you to take tomorrow.]], [[22. If you can see the whites of their eyes, somebody's done something wrong.]], [[23. The company mess and friendly fire should be easier to tell apart.]], [[24. Any sufficiently advanced technology is indistinguishable from a big gun.]], [[25. If a manufacturer's warranty covers the damage you do, you didn't do enough damage.]], [[26. "Fire and Forget" is fine, provided you never actually forget.]], [[27. Don't be afraid to be the first to resort to violence.]], [[28. If the price of collateral damage is high enough, you might be able to get paid to bring ammunition home with you.]], [[29. The enemy of my enemy is my enemy's enemy, no more, no less.]], [[30. A little trust goes a long way. The less you use, the further you'll go.]], [[31. Only cheaters prosper.]], [[32. Anything is amphibious if you can get it back out of the water.]], [[33. If you're leaving tracks, you're being followed]], [[34. If you're leaving scorch-marks, you need a bigger gun.]], [[35. That which does not kill me has made a tactical error.]], [[36. When the going gets tough, the tough call for close air support.]], [[37. There is no 'overkill.' There is only 'open fire' and 'reload.']], [[38. What's easy for you can still be hard on your clients.]], [[39. There is a difference between "spare" parts and "extra" parts.]], [[40. Not all good news is enemy action.]], [[41. "Do you have a backup?" means "I can't fix this."]], [[42. "They'll never expect this" means "I want to try something stupid".]], [[43. If it's stupid and it works, it's still stupid and you're lucky.]], [[44. If it will blow a hole in the ground, it will double as an entrenching tool.]], [[45. The size of the combat bonus is inversely proportional to the likelihood of surviving to collect it.]], [[46. Don't try to save money by conserving ammunition.]], [[47. Don't expect the enemy to cooperate in the creation of your dream engagement.]], [[48. If it ain't broke, it hasn't been issued to the infantry.]], [[49. Every client is one missed payment from becoming a target.]], [[50. Every target is one bribe away from becoming a client.]], [[51. Let them see you sharpen the sword before you fall on it.]], [[52. The army you've got is never the army you want.]], [[53. The intel you've got is never the intel you want.]], [[54. It's only too many troops if you can't pay them.]], [[55. It's only too many weapons if they're pointing in the wrong direction.]], [[56. Infantry exists to paint targets for people with real guns.]], [[57. Artillery exists to launch large chunks of budget at an enemy it cannot actually see.]], [[58. The pen is mightiest when it writes orders for swords.]], [[59. Two wrongs is probably not going to be enough.]], [[60. Any weapon's rate of fire is inversely proportional to the number of available targets.]], [[61. Don't bring big grenades into small rooms.]], [[62. Anything labeled "This End Toward Enemy" is dangerous at both ends.]], [[63. The brass knows how to do it by knowing who can do it.]], [[64. An ounce of sniper is worth a pound of suppressing fire.]], [[65. After the toss, be the one with the pin, not the one with the grenade.]], [[66. Necessity is the mother of deception.]], [[67. If you can't carry cash, carry a weapon.]], [[68. Negotiating from a position of strength does not mean you shouldn't also negotiate from a position near the exits.]], [[69. Sometimes rank is a function of firepower.]], [[70. Failure is not an option. It is mandatory. The option is whether or not to let failure be the last thing you do.]] }
390
391u.motivate = function(nNum) return tQuotes[nNum or math.random(#tQuotes)] end
392
393--# 24h clock display
394u.clockTime = function(nTime, nOh, nOm)
395 if type( nTime ) ~= "number" then nTime = os.time() end
396 local nHour = math.floor(nTime) + (nOh or 0)
397 local nMinute = math.floor((nTime - nHour) * 60) + (nOm or 0)
398 return string.format( "%02d:%02d", nHour, nMinute )
399end
400
401--# Epoch in seconds
402u.secondsEpoch = function(nTime)
403 if type( nTime ) ~= "number" then nTime = os.epoch("utc") end
404 return math.floor(nTime / 1000)
405end
406
407--# Wait for time and display countdown.
408u.wait = function(nTime)
409 if type( nTime ) ~= "number" then
410 error( "bad argument #1 (expected number, got " .. type( nTime ) .. ")", 2 )
411 end
412 local x, y = term.getCursorPos()
413 local endTimer = os.startTimer(nTime)
414 local endTime = os.clock() + nTime
415 local updateTimer = os.startTimer(0)
416 local event
417 while true do
418 event = {os.pullEvent()}
419 if event[1] == "timer" then
420 if event[2] == endTimer then break
421 elseif event[2] == updateTimer then
422 updateTimer = os.startTimer(0.1)
423 term.setCursorPos(x, y)
424 term.clearLine()
425 term.write( string.format( "%.1f" , math.floor((endTime - os.clock()) * 10) / 10 ) )
426 end
427 end
428 end
429 term.setCursorPos(1, y)
430 term.clearLine()
431end
432
433--# Wait for time and display a bar.
434u.waitBar = function(nTime)
435 if type( nTime ) ~= "number" then
436 error( "bad argument #1 (expected number, got " .. type( nTime ) .. ")", 2 )
437 end
438 local sX = term.getSize()
439 local _, y = term.getCursorPos()
440 local endTimer = os.startTimer(nTime)
441 local endTime = os.clock() + nTime
442 local updateInter = math.max(nTime / (sX * 2), 0.05)
443 local updateTimer = os.startTimer(0)
444 local size = -1
445 local event
446 while true do
447 event = {os.pullEvent()}
448 if event[1] == "timer" then
449 if event[2] == endTimer then break
450 elseif event[2] == updateTimer then
451 updateTimer = os.startTimer(updateInter)
452 size = math.floor( ( endTime - os.clock() ) * sX * 2 / nTime )
453 term.setCursorPos(1, y)
454 term.clearLine()
455 term.write( string.rep( "\140" , math.floor(size / 2) ) )
456 if size % 2 == 1 then term.write( "\132" ) end
457 end
458 end
459 end
460 term.setCursorPos(1, y)
461 term.clearLine()
462end
463
464--# Explode the string into table
465u.explode = function(sString, sDiv)
466 if sDiv == "" then return {sString} end
467 local tOut = {}
468 local nPos = 0
469 local fSearcher = function() return string.find(sString, sDiv, nPos, false) end
470 for nStart, nStop in fSearcher do
471 table.insert(tOut, string.sub(sString, nPos, nStart - 1))
472 nPos = nStop + 1
473 end
474 table.insert(tOut, string.sub(sString, nPos))
475 return tOut
476end
477
478--### File operations
479
480--# Append
481u.append = function(name, data, binary) local file = fs.open(tostring(name), binary and "ab" or "a") if not file then return false end file.write(data) file.close() return true end
482
483--# Save
484u.save = function(name, data, binary) local file = fs.open(tostring(name), binary and "wb" or "w") if not file then return false end file.write(data) file.close() return true end local save = u.save
485u.saveT = function(name, data) return save(name, textutils.serialize(data)) end
486u.saveTL = function(name, data) return save(name, string.gsub(textutils.serialize(data), "\n%s*", "")) end
487u.saveLines = function(name, data) local file = fs.open(tostring(name), "w") if not file then return false end for i = 1, #data, 1 do file.writeLine(data[i]) end file.close() return true end
488u.saveBinTable = function(name, binTable) local file = fs.open(tostring(name), "wb") if file then for i = 1, #binTable, 1 do file.write(binTable[i]) end file.close() return true else return false end end
489--function saveDump(name,data) return save(name,data,true) end
490
491--# Get
492u.get = function(name, binary) local file = fs.open(tostring(name), binary and "rb" or "r") if not file then return false end local data = file.readAll() file.close() if data then return data end end local get = u.get
493u.getT = function(name) local data = get(name) if data then data = textutils.unserialize(data) end if data then return data end end
494u.getLines = function(name) local file = fs.open(tostring(name), "r") if not file then return false end local data = {} for k in file.readLine do data[#data + 1] = k end file.close() return data end
495--function getDump(name) return get(name,true) end
496
497--# Http
498u.getHttp = function(source, post, header, binary) if not http.checkURL(source) then return false end local file = post and http.post(source, post, header, binary) or http.get(source, header, binary) if not file then return false end local data = file.readAll() file.close() if data then return data end end local getHttp = u.getHttp
499--WARNING-- By default downloads in binary mode - ensures support for fast getting all kind of files.
500u.saveHttp = function(name, source, post, header, binary) if binary == nil then binary = true end local file = getHttp(source, post, header, binary) if not file then return false end return save(name, file, binary) end
501
502--# Log
503u.makeLog = function(name) local file = fs.open(tostring(name), "a") if not file then return false end local on = true return function(m) if not on then return false end file.writeLine(m) file.flush() return true end, function() on = false file.close() end end local makeLog = u.makeLog
504u.makePrintLog = function(name) local logfile, logstop = makeLog(name) if not logfile then return false end return function(m) print(m) logfile(m) end, logstop, logfile end
505
506--[[--# Append
507local function append(name, data, binary) local file = fs.open(tostring(name), binary and "ab" or "a") if not file then return false end file.write(data) file.close() return true end
508
509--# Save
510local function save(name, data, binary) local file = fs.open(tostring(name), binary and "wb" or "w") if not file then return false end file.write(data) file.close() return true end
511local function saveT(name, data) return save(name, textutils.serialize(data)) end
512local function saveTL(name, data) return save(name, string.gsub(textutils.serialize(data), "\n%s*", "")) end
513local function saveLines(name, data) local file = fs.open(tostring(name), "w") if not file then return false end for i = 1, #data, 1 do file.writeLine(data[i]) end file.close() return true end
514local function saveBinTable(name, binTable) local file = fs.open(tostring(name), "wb") if file then for i = 1, #binTable, 1 do file.write(binTable[i]) end file.close() return true else return false end end
515--function saveDump(name,data) return save(name,data,true) end
516
517--# Get
518local function get(name, binary) local file = fs.open(tostring(name), binary and "rb" or "r") if not file then return false end local data = file.readAll() file.close() if data then return data end end
519local function getT(name) local data = get(name) if data then data = textutils.unserialize(data) end if data then return data end end
520local function getLines(name) local file = fs.open(tostring(name), "r") if not file then return false end local data = {} for k in file.readLine do data[#data + 1] = k end file.close() return data end
521--function getDump(name) return get(name,true) end
522
523--# Http
524local function getHttp(source, post, header, binary) if not http.checkURL(source) then return false end local file = post and http.post(source, post, header, binary) or http.get(source, header, binary) if not file then return false end local data = file.readAll() file.close() if data then return data end end
525--WARNING-- By default downloads in binary mode - ensures support for fast getting all kind of files.
526local function saveHttp(name, source, post, header, binary) if binary == nil then binary = true end local file = getHttp(source, post, header, binary) if not file then return false end return save(name, file, binary) end
527
528--# Log
529local function makeLog(name) local file = fs.open(tostring(name), "a") if not file then return false end local on = true return function(m) if not on then return false end file.writeLine(m) file.flush() return true end, function() on = false file.close() end end
530local function makePrintLog(name) local logfile, logstop = makeLog(name) if not logfile then return false end return function(m) print(m) logfile(m) end, logstop, logfile end
531]]
532
533u.w = {{
534"\159\140\144\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\159\140\144",
535"\149\128\149\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\149\128\149",
536"\149\128\149\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\149\128\149",
537"\149\128\149\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\149\128\149",
538"\149\128\149\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\149\128\149",
539"\149\128\149\128\128\128\128\128\159\140\144\128\128\128\128\128\128\128\128\128\149\128\149",
540"\149\128\149\128\128\128\128\152\129\128\130\155\128\128\128\128\128\128\128\128\149\128\149",
541"\149\128\149\128\128\159\134\128\152\155\128\128\137\144\128\128\128\128\128\128\149\128\149",
542"\149\128\149\128\128\137\143\134\152\155\137\144\128\130\155\128\128\128\128\128\149\128\149",
543"\149\128\149\128\128\128\159\134\128\128\149\130\155\128\128\137\144\128\128\128\149\128\149",
544"\149\128\149\128\128\152\129\128\159\134\128\128\128\137\144\128\130\155\128\128\149\128\149",
545"\149\128\149\159\134\128\128\152\129\128\128\128\128\128\130\155\128\128\137\144\149\128\149",
546"\149\128\138\129\128\159\134\128\128\128\128\128\128\128\128\128\137\144\128\130\133\128\149",
547"\149\128\128\128\152\129\128\128\128\128\128\128\128\128\128\128\128\130\155\128\128\128\149",
548"\149\128\159\134\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\137\144\128\149",
549"\130\140\129\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\128\130\140\129",
550}, {
551"f0000000000000000000f00",
552"00f0000000000000000000f",
553"00f0000000000000000000f",
554"00f0000000000000000000f",
555"00f0000000000000000000f",
556"00f00000f0000000000000f",
557"00f00000000f0000000000f",
558"00f00f000f000000000000f",
559"00f000f00f0000f0000000f",
560"00f000f00000f000000000f",
561"00f00000f00000000f0000f",
562"00ff00000000000f000000f",
563"00000f0000000000000000f",
564"000000000000000000f000f",
565"00f0000000000000000000f",
566"00000000000000000000000",
567}, {}, } for i = 1, #u.w[2] do u.w[3][i] = string.gsub(u.w[2][i], "[0f]", {["0"] = "f", ["f"] = "0"}) end
568
569--### Finalizing
570return u