unit  utssvr_api_c;
interface
function get_tssvr_api_c();
function get_func_finder_register();
implementation
function get_tssvr_api_c();
begin
    return static new  t_tssvr_api_c();
end 
function get_func_finder_register();
begin
    return static new t_func_finder_register();
end 
type tsl_c_api_const = class()
    {$ifdef linux}
    static const C_TSSVRAPI="libTSSVRAPI.so";
    static const C_PLUGIN="libTSLPlugin.so";
    static const C_TSLInterp="libTSLInterp.so";
    {$else}
    static const C_TSSVRAPI="TSSVRAPI.dll"; 
    static const C_PLUGIN="TSLPlugin.dll"; 
    static const C_TSLInterp="TSLInterp.dll"; 
    {$endif}
end 
type t_func_finder_register = class(tsl_c_api_const) //函数注册类型   
    function create();
    begin
        t :=  C_TSSVRAPI;
        fhookseted := false;
        fhooks := array();
    end 
    function add_hook(f);
    begin
        for i,v in fhooks do 
        begin 
            if v=f then return 0;
        end         
        fhooks[length(fhooks)] := f; 
        if not fhookptr then fhookptr := makeinstance(thisfunction(find_HOOK));
        if not fhookseted then TSL_InterpSetFindFunctionHook(fhookptr); 
    end 
    function del_hook(f);
    begin
        len := length(fhooks)-1;
        for i:= 0 to len do 
        begin 
            if f=fhooks[i] then 
            begin 
                if len=0 then 
                begin 
                    TSL_InterpSetFindFunctionHook(0);  
                    fhookseted := false;  
                end 
                return 1;
            end 
        end 
    end 
    function find_HOOK(L:pointer;iUser:string;iName:string; oResult:object):integer;cdecl;
    begin 
        for i,_f_ in fhooks do 
        begin 
            r :=  ##_f_(L,iUser,iName);             
            if ifstring(r) and r then 
            begin
                oResult := array("body":r);   
                return 1;         
            end 
        end      
    end
    function destroy();
    begin
        if fhookptr then deleteinstance(fhookptr); 
        fhookptr := 0;   
    end 
    private 
    function TSL_InterpSetFindFunctionHook(hook);
    begin
        c := static function(hook:pointer);cdecl;external  getdlsymaddress(C_TSLInterp,functionname(1)) ; 
        return call(c,hook) ; 
    end 
    private 
    fhookseted;
    fhookptr;
    fhooks;    
end 
type t_tssvr_api_c = class(tsl_c_api_const)
    function create();
    begin
        t :=  C_TSSVRAPI;
        isok := 0;
        if not getglobalcache("@@tsl_c_api@@",isok) then 
        begin 
            setglobalcache("@@tsl_c_api@@","tsl_c_api");  
            reg_libpath_funcs();  
        end 
    end 
    class function TSL_ObjToStr(L:pointer;v:pointer):string;
    begin
        _f_ := static function(L:pointer;v:pointer;Topest:integer):string;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
        return ##_f_(L,v,1);
    end 
    class function TSL_DelStrm(d:pointer);
    begin
        _f_ := static procedure(d:pointer);cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
        return ##_f_(d);
    end 
    class function TSL_ObjToStrm(L:pointer;v:pointer);
    begin
        _f_ := static function(L:pointer;v:pointer;PackedTable:integer;precision:integer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
        return ##_f_(L,v,0,-1);
    end
    class function TSL_StrmToObj(L:pointer;v:pointer;ot:pointer);
    begin
        _f_ := static function(L:pointer;v:pointer;ot:pointer):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
        return ##_f_(L,v,ot);
    end     
    class function TS_GetGlobalL();
    begin
        _f_ := static function():pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));  
        return ##_f_();    
    end 
    //注册函数相关 
    class function TSL_SetIntPtr(l:pointer;o:pointer;i:pointer);
    begin
        _f_ := static procedure(l:pointer;o:pointer;i:pointer);cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
        return ##_f_(l,o,i);
    end 
    class function TSL_StringCheck(O:pointer):integer;
    begin
        _f_ := static function(o:pointer):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
        return ##_f_(o);
    end
    
    class function TSL_SetInt(l:pointer;o:pointer;i:integer);
    begin
        _f_ := static procedure(l:pointer;o:pointer;i:integer);cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
        return ##_f_(l,o,i);
    end
    class function get_self_l_i(L:pointer; iArgs:pointer;iNum:integer; oResult:pointer):integer;cdecl;
    begin
        TSL_SetIntPtr(L,oResult,L);
        return 1;
    end
    class function set_self_libpath(L:pointer; iArgs:pointer;iNum:integer; oResult:pointer):integer;cdecl;
    begin
        IF iNum=1 and TSL_StringCheck(iArgs) then 
        begin 
            s := TSL_AsString(iArgs);
            p := TSL_Strdup(s);
            TSL_SetString(L,oResult,TSL_SetLibPath(L, p));
            return 1;
        end 
        return 0;
    end    
    class function get_self_libpath(L:pointer; iArgs:pointer;iNum:integer; oResult:pointer):integer;cdecl;
    begin
        TSL_SetString(L,oResult,TSL_GetLibPath(L));        
        return 1;
    end
    class function tslL_register(l:pointer;n:string;f:pointer);
    begin
        _f_ := static procedure(l:pointer;n:string;f:pointer);cdecl;external getdlsymaddress(C_PLUGIN,functionname(1));
        return ##_f_(l,n,f);
    end
    class function TSL_SetString(L,O,S);
    begin
        _f_ := static function(l:pointer;o:pointer;s:string):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
        return ##_f_(L,O,S);
    end 
    class function TSL_Strdup(s):string;
    begin
        _f_ := static function(s:string):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
        return ##_f_(s);
    end 
    class function TSL_GetLibPath(L);
    begin
        _f_ := static function(L:pointer):string;cdecl;external getdlsymaddress(C_TSLInterp,functionname(1)); 
        return ##_f_(L); 
    end 
    class function TSL_SetLibPath(L,p);
    begin
        _f_ := static function(L:pointer;p:pointer):string;cdecl;external getdlsymaddress(C_TSLInterp,functionname(1)); 
        return ##_f_(L,p); 
    end    
    class function TSL_AsInt(O);
    begin
        _f_ := static function(O:pointer):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1)); 
        return ##_f_(o); 
    end 
    class function TSL_AsIntPtr(O);
    begin
        _f_ := static function(O:pointer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1)); 
        return ##_f_(o); 
    end
    class function TSL_NumberCheck(O);
    begin
        _f_ := static function(O:pointer):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1)); 
        return ##_f_(o); 
    end
    
    class function TSL_AsString(O);
    begin
        _f_ := static function(O:pointer):string;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1)); 
        return ##_f_(o); 
    end
    class function TSL_SetType(L,O,t);
    begin
    {
    #define TSL_TINT	0 //32位整数
    #define TSL_TNUMBER	1 //64位浮点
    #define TSL_TSZSTRING 2 //字符串
    #define TSL_TTABLE	5 //数组
    #define TSL_TSTRING	6 //字符串下标,仅作为数组的下标
    #define TSL_TGRAPH    8 //图形
    #define TSL_TGRAPHGROUP 9 //图形组
    #define TSL_TNIL	10 //NIL类型
    #define TSL_TBINARY 11 //二进制类型
    #define TSL_TUNKNOWN 14 //COM类型IUNKNOWN
    #define TSL_TDISPATCH 15  //COM类型IDISPATCH
    #define TSL_TANY 16       //TSL面向对象类型
    #define TSL_TMatrix 17 //Matrix类型,MSelect返回
    #define TSL_TINT64  20 //64位整数
    #define TSL_TClassFieldRef 22 //类成员引用
    #define TSL_TFUNCTIONSELF	23 //用SELF获得的结果
    #define TSL_TWSTRING 24 //UnicodeString
    #define TSL_TCFUNCTION 25 //二进制函数指针
    #define TSL_TNONE	(-1) //无类型，此类型不会被使用，仅作为特殊用途
    }
        _f_ := static procedure(L:pointer;o:pointer;t:integer);cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1)); 
        return ##_f_(L,O,t); 
    end 
    class function TSL_GetParamRef(L,idx);
    begin
        _f_ := static function(L:pointer;idx:integer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1)); 
        return ##_f_(L,idx); 
    end 
    class function TSL_ReadINTPtrFromPtr(p,idx);
    begin
        _f_ := static function(p:pointer;idx:integer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1)); 
        return ##_f_(p,idx); 
    end 
    class function TSL_ReadTObjectFromPtr(p,idx);
    begin
        _f_ := static function(p:pointer;idx:integer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1)); 
        return ##_f_(p,idx); 
    end   
    private 
    class function reg_libpath_funcs();//注册需要的函数
    begin
        tslL_register(0,"get_self_libpath",makeinstance(thisfunction(get_self_libpath),"cdecl",0));  
        tslL_register(0,"set_self_libpath",makeinstance(thisfunction(set_self_libpath),"cdecl",0));  
    end 
    //        
end 

initialization



end.