require 'general/pcall/ole32'

coclass 'pdisp'
coinsert 'pole32'

uucp=: u:@:(7&u:)
ERR_NULL=: 'disp is null'

create=: 3 : 0
  y=. >y
  P=: y
  FLAGS=: DISP_METH
)

destroy=: 3 : 0
  if. 0=P do. r=. 0 else. r=. P iuRelease '' end.
  codestroy''
  r
)

disp=: 3 : 0
  y=. >y
  if. 2=3!:0 y do. y=. CreateObject y end.
  y conew 'pdisp'
)

do=:  4 : 'x invoke y [ FLAGS=: DISP_METH'
get=: 4 : 'x invoke y [ FLAGS=: DISP_GET'
put=: 4 : 'x invoke y [ FLAGS=: DISP_PUT'
set=: 4 : 'x invoke y [ FLAGS=: DISP_SET+DISP_PUT'

dispid=: 3 : 0
  ERR_NULL assert P~:0
  y=. uucp y
  nm=. ,symdat symget <,'y'
  herr P idGetIDsOfNames GUID_NULL;nm;1;0;r=. ,_1
  {.r
)

invoke=: 4 : 0
  ERR_NULL assert P~:0
  if. 0=#y do. params=. 2*0 0 0 0 else.
    y=. |.boxopen y
    varg=. JVar&> y
    params=. (symdat symget <'varg'),0,(#y),0
  end.
  res=. VariantAlloc''
  id=. dispid x
  herr P idInvoke id;GUID_NULL;0;FLAGS;params;res;0;0
  if. #y do. VariantClear"0 <"1 varg end.
  if. 0={.res do. r=. a: else. 
    r=. VarJ res
    if. -.({.res) e. VT_DISPATCH,VT_UNKNOWN do.
      VariantClear <res end.
  end.
  r
)

info=: 3 : 0
  ti=.{.ti [ herr P idGetTypeInfo 0 ; 0 ; ti=.,_2
  ti itGetTypeAttr pta=. ,_2
  funcs=. (#IDispatch) ([+i.@-~) (TYPEATTR si 'Cf') mS pta

  r=. ,:ti GetDoc _1
  f=. ti <@(;:^:_1)@FuncDesc funcs
  d=. ti {:@FuncDoc"0 funcs
  ti iuRelease ''
  }.;<@((LF , (, '   NB. '&,))&>/)"1 r,f,.d
)

as=: 3 : 0
  IID_IDispatch as y
:
  x QueryInterface P
)

dup=: 3 : 0
  P iuAddRef ''
  <P
)

dispgit=: 3 : 0
  o=. disp y
  P__o=: gitGet P__o
  o
)

disp_z_=: disp_pdisp_
dispgit_z_=: dispgit_pdisp_