#! lua
-- toolbox library
(getmetatable "").__call = string.format
local dim, sys, !, $ in require "riscos"
local toolbox = require "wimp.task"

local push = \ (t, x) t[1+#t] = x end
local pop = \ (t)
      local x = t[#t]
      t[#t] = nil
      => x
      end
do -------------------------------
_ENV = toolbox
obj = { }                     -- object table
obj_name = { }                -- id -> name
job = { push = push, pop = pop }
setbyte = \ (x, n, k)
      local bit = 1<<n
      => (x & (~bit)) | (k & bit)
      end
b = dim (512)
fdesc = dim (16)
idblock = dim (24)
resdir = dim (("\0"):rep (256))

init = \ (self, wmn, tec)
   local msglist, version, flags, resdir, fdesc, idblock in self
   local r0, r1, r2 = sys (0x44ecf, flags or 0, -- Toolbox_Initialise
       version or 310, msglist (wmn), msglist (tec),
       resdir, fdesc, idblock)
    assert (r0, r1)
    self.handle = r1
    self.spritearea = r2
    end -------- init
handler[0] = \ (@)            -- null wimp event handler
   local x = job:pop ( )
   if x then
      local ok, mesg = pcall (x, @)  -- do pending jobs
      if not ok then
         alert (@, mesg)
         => true
      end -- if
   else
     mask = setbyte (mask, 0, 1)     -- turn off null event handling
   end -- if
   end --------- handler

user_redraw = \ (@, redraw)      -- redraw
   local b in @
   local more = sys (0x400c8, 0, b)  --  Wimp_RedrawWindow
    while more ~= 0 do
        redraw (@, ![b+4] - ![b+20], ![b+16] - ![b+24])
        more = sys (0x400ca, 0, b)  -- Wimp_GetRectangle
     end -- while
     end -- handler

handler[512] = \ (@)
      local b in @
      local ecode = ![b + 8]
      local h = @.handler.tbox [ ecode ]
      => h and h (@)
    end
handler.tbox = {
  [0x44ec0] = \ (@) -- Toolbox_Error
      local b in @
       @:alert ($[b + 20])
       => true
       end;
  [0x44ec1] = \ (@)  -- Toolbox_ObjectAutocreated
   local b, obj, idblock in @
   local name = $[b + 16]
     local id = ![idblock + 16]
     obj[name] = {
        self_id = id;
        parent_id = ![idblock +8];
        parent_comp = ![idblock + 12];
      }
     end;
   [0x82a91] = QUIT;  -- Quit.Quit
     }

GetSysInfo = \ (@, reason, r1, r2 ) => sys (0x44ece, reason, r1, r2) end
RaiseToolboxEvent = \ (@, flags, obj_id, comp_id)
           sys (0x44ecd, flags, obj_id, comp_id, @.b)
           end
GetTemplateName = \ (@, flags, obj_id, buf, buflen)
           local r0, r1, r2, r3 = sys   (0x44ecc, flags, obj_id, 0, buflen)
           sys (0x44ecc, flags, obj_id, buf, r3)
           end
GetAncestor = \ (@, flags, obj_id) => sys (0x44ecb, flags, obj_id) end
GetParent = \ (@, flags, obj_id) => sys (0x44eca, flags, obj_id) end
GetObjectClass = \ (@, flags, obj_id) => sys (0x44ec9, flags, obj_id) end
GetClientHandle = \ (@, flags, obj_id) => sys (0x44ec8, flags, obj_id) end
SetClientHandle = \ (@, flags, obj_id, handle) sys (0x44ec7, flags, obj_id, handle)  end
ObjectMiscOp = \ (@, flags, obj_id, method, ... ) sys (0x44ec6, flags, obj_id, method, ... )  end
GetObjectState = \ (@, flags, obj_id) => sys (0x44ec5, flags, obj_id) end
HideObject = \ (@, flags, obj_id) sys (0x44ec4,  flags, obj_id) end
Show_Object = \ (@, flags, obj_id, show, buf, parent_id, parent_comp)
                   sys (0x44ec3, flags, obj_id, show, buf, parent_id, parent_comp) end
DeleteObject = \ (@, flags, obj_id) sys (0x44ec1,  flags, obj_id)  end
CreateObject = \ (@, flags, template) => sys (0x44ec0, flags, template) end
LoadResources = \ (@, flags, namepointer) sys (0x44ed0,  flags, namepointer) end
TemplateLookUp = \ (@, flags, namepointer) => sys (0x44efb,  flags, namepointer) end

winredraw = \ (@, id)
     local b in @
     @:ObjectMiscOp (0, id, 16, b + 256) -- Window_GetExtent
     @:ObjectMiscOp (0, id, 17, b + 256)  -- Window_ForceRedraw
     end
end --------------- do ------
=> toolbox