diff options
author | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
---|---|---|
committer | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
commit | 84adefa331c4159d432d22840663c38f155cd4c1 (patch) | |
tree | bff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/wx/api_gen/gl_gen_c.erl | |
download | otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2 otp-84adefa331c4159d432d22840663c38f155cd4c1.zip |
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/wx/api_gen/gl_gen_c.erl')
-rw-r--r-- | lib/wx/api_gen/gl_gen_c.erl | 596 |
1 files changed, 596 insertions, 0 deletions
diff --git a/lib/wx/api_gen/gl_gen_c.erl b/lib/wx/api_gen/gl_gen_c.erl new file mode 100644 index 0000000000..5c72499790 --- /dev/null +++ b/lib/wx/api_gen/gl_gen_c.erl @@ -0,0 +1,596 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%%%------------------------------------------------------------------- +%%% File : gl_gen_c.erl +%%% Author : Dan Gudmundsson <[email protected]> +%%% Description : +%%% +%%% Created : 25 Apr 2007 by Dan Gudmundsson <[email protected]> +%%%------------------------------------------------------------------- + +-module(gl_gen_c). +-compile(export_all). + +-include("gl_gen.hrl"). + +-import(lists, [foldl/3,foldr/3,reverse/1, keysearch/3, map/2, filter/2, max/1]). +-import(gen_util, [lowercase/1, lowercase_all/1, uppercase/1, uppercase_all/1, + open_write/1, close/0, c_copyright/0, w/2, + args/3, strip_name/2]). +-import(wx_gen, [next_id/1]). + + +gen(GLFuncs, GLUFuncs) -> + gen_defines(GLFuncs,GLUFuncs), + gl_gen_init(GLFuncs), + glu_gen_init(GLUFuncs), + + %% Marshal funcs + open_write("../c_src/gen/gl_funcs.cpp"), + c_copyright(), + w("/***** This file is generated do not edit ****/ ~n~n", []), + w("#include <stdio.h>~n", []), + w("#include <string.h>~n", []), + w("#include \"../wxe_impl.h\"~n", []), + w("#include \"../wxe_gl.h\"~n", []), + w("#include \"gl_fdefs.h\"~n", []), + + w("~nint gl_error_op;~n", []), + w("void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins[]){~n", + []), + w(" gl_error_op = op;~n", []), + w(" if(caller != gl_active) {~n", []), + w(" wxGLCanvas * current = glc[caller];~n", []), + w(" if(current) { gl_active = caller; current->SetCurrent();}~n", []), + w(" else {~n " + " ErlDrvTermData rt[] = // Error msg~n" + " {ERL_DRV_ATOM, driver_mk_atom((char *) \"_wxe_error_\"),~n" + " ERL_DRV_INT, op,~n" + " ERL_DRV_ATOM, driver_mk_atom((char *) \"no_gl_context\"),~n" + " ERL_DRV_TUPLE,3};~n" + " driver_send_term(WXE_DRV_PORT,caller,rt,8);~n" + " return ;~n }~n };~n~n", []), + + w(" switch(op) ~n{~n",[]), + w(" case 5000: ~n wxe_tess_impl(bp, caller); ~n break;~n", []), + w(" case WXE_BIN_INCR:~n driver_binary_inc_refc(bins[0]->bin);~n break;~n",[]), + w(" case WXE_BIN_DECR:~n driver_binary_dec_refc(bins[0]->bin);~n break;~n",[]), + + [funcs(F) || F <- GLUFuncs], + [funcs(F) || F <- GLFuncs], + + w("}} /* The End */~n~n",[]), + + close(). + +funcs([F1|Fs]) when is_list(F1) -> + put(current_func,F1), + func(get(F1)), + erase(current_func), + funcs(Fs); +funcs([]) -> ok; +funcs(F) -> + put(current_func,F), + func(get(F)), + erase(current_func). + +func(#func{where=erl}) -> ok; +func(#func{id=Id,alt={has_vector,_,FuncName}}) -> + #func{name=Name,type=T,params=As} = get(FuncName), + w("case ~p: { // ~s ~n", [Id,Name]), + put(bin_count,-1), + As1 = declare_vars(T, As), + As2 = decode_args(As1), + As3 = call_gl(Name,T,As2), + build_return_vals(T,As3), + free_args(), + w("}; break; ~n", []); +func(#func{name=Name,id=Id,type=T,params=As,alt=_Alt}) -> + w("case ~p: { // ~s ~n", [Id,Name]), + put(bin_count,-1), + As2 = decode_args(As), + declare_vars(T, As), %% Unusal order but it's c++ + As3 = call_gl(Name,T,As2), + build_return_vals(T,As3), + free_args(), + w("}; break; ~n", []). + +declare_vars(void,Ps) -> + [declare_var(P) || P <- Ps]; +declare_vars(T, Ps) -> + declare_var(#arg{name="result",in=false,type=T}), + [declare_var(P) || P <- Ps]. + +declare_var(A=#arg{where=erl}) -> A; + +declare_var(A=#arg{name=N,in=false,type=#type{name=T,base=B,single={tuple,Sz}}}) -> + true = is_number(Sz), %% Assert + w(" ~s ~s[~p] = {~s};~n", [T,N,Sz,args(fun zero/1,",",lists:duplicate(Sz,B))]), + A; +declare_var(A=#arg{name=N,in=false,type=#type{name=T,base=B,single={list,Sz}}}) when is_number(Sz) -> + w(" ~s ~s[~p] = {~s};~n", [T,N,Sz,args(fun zero/1,",",lists:duplicate(Sz,B))]), + A; +declare_var(A=#arg{name=N,in=false,type=#type{name=T,single={list,ASz,_USz},mod=[]}}) -> + true = is_list(ASz), %% Assert + w(" ~s *~s;~n", [T,N]), + w(" ~s = (~s *) driver_alloc(sizeof(~s) * *~s);~n", [N,T,T,ASz]), + store_free(N), + A; +declare_var(A=#arg{name=N,in=false,type=#type{name=T,base=binary,size=Sz}}) -> + true = is_number(Sz), %% Assert + w(" ~s ~s[~p];~n", [T,N,Sz]), + A; +declare_var(A=#arg{name=N,in=false, + type=#type{name=T="GLUquadric",base=B,by_val=false,single=true}}) -> + A; +declare_var(A=#arg{name=N,in=false, + type=#type{name=T,base=B,by_val=false,single=true}}) -> + w(" ~s ~s[1] = {~s};~n", [T,N,zero(B)]), + A; +declare_var(A=#arg{where=_}) -> + A. + +zero(float) -> "0.0"; +zero(_) -> "0". + +store_free(N) -> + case get(free_args) of + undefined -> put(free_args, [N]); + List -> put(free_args, [N|List]) + end. + +free_args() -> + case get(free_args) of + undefined -> ignore; + List -> + erase(free_args), + [w(" driver_free(~s);~n", [Arg]) || Arg <- List] + end. + +decode_args(As0) -> + {As,_Align} = lists:mapfoldl(fun decode_arg/2,0,As0), + As. + +decode_arg(P=#arg{where=erl},A) -> {P,A}; +decode_arg(P=#arg{where=c},A) -> {P,A}; +decode_arg(P=#arg{in=false},A) -> {P,A}; + +decode_arg(P=#arg{name=Name,type=#type{name=Type,base=binary}},A0) -> + w(" ~s *~s = (~s *) bins[~p]->base;~n", [Type,Name,Type,next_id(bin_count)]), + {P, A0}; +decode_arg(P=#arg{name=Name,type=#type{name=Type,base=memory}},A0) -> + w(" ~s *~s = (~s *) bins[~p]->base;~n", [Type,Name,Type,next_id(bin_count)]), + {P, A0}; +decode_arg(P=#arg{name=Name,type=#type{name=T,base=string,single=list}},A0) -> + A = align(4,A0), + w(" int * ~sLen = (int *) bp; bp += 4;~n", [Name]), + w(" int * ~sTotSize = (int *) bp; bp += 4;~n",[Name]), +%% w(" if(*~sLen > 256) *~sLen = 256;", []), + w(" ~s **~s;~n", [T,Name]), + w(" ~s = (~s **) driver_alloc(sizeof(~s *) * *~sLen); ~n",[Name, T, T, Name]), + store_free(Name), + w(" for(int i=0;i<*~sLen;i++) {~n", [Name]), + w(" ~s[i] = (~s *) bp; bp += 1+strlen(bp);};~n",[Name,T]), + w(" bp += (8 - ((~p + *~sTotSize) % 8)) % 8;~n",[A,Name]), + {P, 0}; + +decode_arg(P=#arg{name=Name,type=#type{size=Sz,single=list,name=Type}},A0) -> + A = align(max([Sz,4]),A0), + w(" int * ~sLen = (int *) bp; bp += ~p;~n", [Name, max([4,Sz])]), + w(" ~s * ~s = (~s *) bp; ", [Type,Name,Type]), + w(" bp += (8-((*~sLen*~p+~p)%8))%8;~n", [Name,Sz,A]), + {P, 0}; +decode_arg(P=#arg{name=Name,type=#type{size=TSz,name=Type,single={tuple,undefined}}},A0) -> + A = align(TSz,A0), + w(" int *~sLen = (int *) bp; bp += ~p;~n", [Name, max([4,TSz])]), + if TSz =:= 4 -> + w(" ~s *~s = (~s *) bp; bp += *~sLen*4+((*~sLen)+~p)%2*4;~n", + [Type,Name,Type, Name,Name, A div 4]); + TSz =:= 8 -> + w(" ~s *~s = (~s *) bp; bp += *~sLen*8;~n", [Type,Name,Type,Name]) + end, + {P, 0}; +decode_arg(P=#arg{name=Name,type=#type{size=BSz,name=Type,single={tuple,TSz}}},A0) -> + A = align(BSz,TSz,A0), + w(" ~s * ~s = (~s *) bp; bp += ~p;~n", [Type,Name,Type,BSz*TSz]), + {P, A}; +decode_arg(P=#arg{name=Name,type=#type{size=BSz,name=Type,single={list,TSz}}},A0) -> + A = align(BSz,TSz,A0), + w(" ~s * ~s = (~s *) bp; bp += ~p;~n", [Type,Name,Type,BSz*TSz]), + {P, A}; +decode_arg(P=#arg{name=Name,type=#type{name=Type,base=guard_int}},A0) -> + A = align(4,A0), + w(" ~s *~s = (~s *) * (int *) bp; bp += 4;~n", [Type,Name,Type]), + {P, A}; +decode_arg(P=#arg{name=Name,type=#type{name=Type,base=string,single=true}},A0) -> + w(" ~s *~s = (~s *) bp;~n", [Type,Name,Type]), + w(" int ~sLen = strlen((char *)~s); bp += ~sLen+1+((8-((1+~sLen+~p)%8))%8);~n", + [Name,Name,Name,Name,A0]), + {P, 0}; +decode_arg(P=#arg{name=Name, + type=#type{name=Type,size=8,base=int,by_val=true,ref=undefined}},A0) -> + A = align(8,A0), + w(" ~s ~s = (~s) * (GLuint64EXT *) bp; bp += 8;~n", [Type,Name,Type]), + {P, A}; +decode_arg(P=#arg{name=Name,type=#type{name=Type="GLUquadric",size=8,base=int}},A0) -> + A = align(8,A0), + w(" ~s * ~s = (~s *) * (GLuint64EXT *) bp; bp += 8;~n", [Type,Name,Type]), + {P, A}; +decode_arg(P=#arg{name=Name, + type=#type{name=Type,size=Sz,by_val=true,ref=undefined}},A0) -> + A = align(Sz,A0), + w(" ~s *~s = (~s *) bp; bp += ~p;~n", [Type,Name,Type,Sz]), + {P, A}; +decode_arg(P=#arg{name=Name,type=#type{size=BSz,name=Type,single={tuple_list,TSz}}},A0) -> + A = align(BSz,TSz,A0), + w(" int *~sLen = (int *) bp; bp += ~p;~n", [Name, max([4,BSz])]), + w(" ~s * ~s = (~s *) bp; bp += *~sLen*~p;~n", [Type,Name,Type,Name,BSz*TSz]), + {P, A}; +decode_arg(P=#arg{name=Name, type=#type{name=Type,size=Sz,by_val=false, + ref={pointer,1}, mod=[const]}}, + A0) -> + A = align(Sz,A0), + w(" ~s *~s = (~s *) bp; bp += ~p;~n", [Type,Name,Type,Sz]), + {P, A}; +decode_arg(P, _A) -> + ?error({unhandled_type, {P#arg.name,P#arg.type,_A}}). + +align(Size, PreAlign) -> + align(Size,1,PreAlign). + +align(1,N,A) -> (A+1*N+0) rem 8; + +align(2,N,A) when (A rem 2) =:= 0 -> (A+2*N+0) rem 8; +align(2,N,A) when (A rem 2) =:= 1 -> a_str(1),(A+2*N+1) rem 8; + +align(4,N,A) when (A rem 4) =:= 0 -> (A+4*N+0) rem 8; +align(4,N,A) when (A rem 4) =:= 1 -> a_str(3),(A+4*N+3) rem 8; +align(4,N,A) when (A rem 4) =:= 2 -> a_str(2),(A+4*N+2) rem 8; +align(4,N,A) when (A rem 4) =:= 3 -> a_str(1),(A+4*N+1) rem 8; + +align(8,_,0) -> 0; +align(8,_,1) -> a_str(7),0; +align(8,_,2) -> a_str(6),0; +align(8,_,3) -> a_str(5),0; +align(8,_,4) -> a_str(4),0; +align(8,_,5) -> a_str(3),0; +align(8,_,6) -> a_str(2),0; +align(8,_,7) -> a_str(1),0. + +a_str(P) -> w(" bp += ~p;~n", [P]). + +call_gl(Name,void,As) -> + Args = args(fun call_arg/1, ",", As), + w(" we~s(~s);~n", [Name,Args]), + As; +call_gl(Name,T=#type{},As) -> + Args = args(fun call_arg/1, ",", As), + Type = result_type(T), + w(" ~s result = we~s(~s);~n", [Type,Name,Args]), + As. + +result_type(#type{name=T, ref=undefined}) -> T; +result_type(#type{name=T, ref={pointer,1}, mod=Mods}) -> + mod(Mods) ++ T ++ " * ". + +call_arg(#arg{alt={length,Alt},type=#type{}}) -> + "*" ++ Alt ++ "Len"; +call_arg(#arg{alt={constant,Alt},type=#type{}}) -> + Alt; +call_arg(#arg{name=Name,type=#type{single={tuple, _}}}) -> + Name; +call_arg(#arg{name=Name,type=#type{single={list, _}}}) -> + Name; +call_arg(#arg{name=Name,type=#type{size=8,base=int,ref=undefined}}) -> + Name; +call_arg(#arg{name=Name,type=#type{ref=undefined}}) -> + "*" ++ Name; +call_arg(#arg{name=Name,type=#type{base=guard_int}}) -> + Name; +call_arg(#arg{name=Name,type=#type{base=string,ref={pointer,2},mod=[const]}}) -> + "(const GLchar **) " ++ Name; +call_arg(#arg{name=Name,type=#type{size=8,base=int,ref={pointer,1}}}) -> + Name; +call_arg(#arg{name=Name,type=#type{}}) -> + Name. + +build_return_vals(Type,As) -> + case calc_sizes(Type,As) of + {0,none,0} -> %% Sync memory access functions + Any = fun(#arg{type=#type{base=B}}) -> B =:= memory end, + case lists:any(Any, As) of + false -> ok; + true -> + w(" int AP = 0; ErlDrvTermData rt[6];~n",[]), + w(" rt[AP++]=ERL_DRV_ATOM;" + " rt[AP++]=driver_mk_atom((char *) \"_wxe_result_\");~n",[]), + w(" rt[AP++]=ERL_DRV_ATOM;" + " rt[AP++]=driver_mk_atom((char *) \"ok\");~n",[]), + w(" rt[AP++] = ERL_DRV_TUPLE; rt[AP++] = 2;~n",[]), + w(" driver_send_term(WXE_DRV_PORT,caller,rt,AP);~n",[]), + ok + end; + {Val,Vars,Cnt} -> + ExtraTuple = if Cnt > 1 -> 2; true -> 0 end, + CSize = if Vars =:= none -> + Sz = integer_to_list(Val+4+ExtraTuple), + w(" int AP = 0; ErlDrvTermData rt[~s];~n",[Sz]), + Sz; + true -> + Sz = integer_to_list(Val+4+ExtraTuple) ++ " + " ++ Vars, + w(" int AP = 0; ErlDrvTermData *rt;~n",[]), + w(" rt = (ErlDrvTermData *) " + "driver_alloc(sizeof(ErlDrvTermData)*(~s));~n", [Sz]), + Sz + end, + w(" rt[AP++]=ERL_DRV_ATOM; rt[AP++]=driver_mk_atom((char *) \"_wxe_result_\");~n",[]), + FreeList = build_ret_types(Type,As), + case Cnt of + 1 -> ok; + _ -> + w(" rt[AP++] = ERL_DRV_TUPLE; rt[AP++] = ~p;~n",[Cnt]) + end, + w(" rt[AP++] = ERL_DRV_TUPLE; rt[AP++] = 2;~n",[]), + w(" if (AP != ~s ) fprintf(stderr, \"%d: ERROR AP mismatch %d %d\\r\\n\",__LINE__,AP,~s);~n", + [CSize,CSize]), + w(" driver_send_term(WXE_DRV_PORT,caller,rt,AP);~n",[]), + case Vars of + none -> ignore; + _ -> + w(" driver_free(rt); ~n", []) + end, + [w(" ~s~n", [Name]) || Name <- FreeList], + ok + end. + +calc_sizes(Type,As) -> + TSz = case return_size("result", Type) of + {0, none} -> + {0, none, 0}; + {Sz,Vars} -> + {Sz,Vars, 1} + end, + Calc = fun(#arg{name=N,in=False,where=W,type=T},{Sz,Vars, Cnt}) + when False =/= true, W=/= c -> + case return_size(N, T) of + {Val, none} -> {Sz+Val, Vars, Cnt+1}; + {Val, Var} when Vars =:= none -> + {Sz+Val, Var,Cnt+1}; + {Val, Var} when Vars =:= none -> + {Sz+Val, Var ++ " + " ++ Vars,Cnt+1} + end; + (_,Acc) -> Acc + end, + foldl(Calc, TSz, As). + +return_size(_N,void) -> {0, none}; +return_size(_N,#type{base=binary}) -> {4, none}; +return_size(_N,#type{single=true}) -> {2,none}; +return_size(_N,#type{single={tuple,Sz}}) -> {Sz*2+2, none}; +return_size(_N,#type{name="GLubyte",single={list,null}}) ->{3, none}; +return_size(_N,#type{single={list,Sz}}) -> {Sz*2+3, none}; +return_size(_N,#type{base=string,single={list,_,_}}) -> {3, none}; +return_size(_N,#type{single={list,_,Sz}}) -> {3, "(*" ++Sz++")*2"}. + + +build_ret_types(void,Ps) -> + Calc = fun(#arg{name=N,in=False,where=W,type=T},Free) + when False =/= true, W=/= c -> + case build_ret(N, False, T) of + ok -> Free; + Other -> [Other|Free] + end; + (_,Free) -> Free + end, + lists:foldl(Calc, [], Ps); +build_ret_types(Type,Ps) -> + build_ret("result", out, Type), + Calc = fun(#arg{name=N,in=False,where=W,type=T},Free) + when False =/= true, W=/= c -> + case build_ret(N, False, T) of + ok -> Free; + Other -> [Other|Free] + end; + (_,Free) -> Free + end, + lists:foldl(Calc, [], Ps). + +build_ret(Name,_Q,#type{name=_T,base=int,single=true,by_val=true}) -> + w(" rt[AP++] = ERL_DRV_INT; rt[AP++] = (ErlDrvSInt) ~s;~n", [Name]); +build_ret(Name,_Q,#type{name=_T,base=bool,single=true,by_val=true}) -> + w(" rt[AP++] = ERL_DRV_INT; rt[AP++] = (ErlDrvSInt) ~s;~n", [Name]); +build_ret(Name,_Q,#type{name="GLUquadric",base=int}) -> + w(" rt[AP++] = ERL_DRV_INT; rt[AP++] = (ErlDrvSInt) ~s;~n", [Name]); +build_ret(Name,_Q,#type{name=_T,base=int,single=true,by_val=false}) -> + w(" rt[AP++] = ERL_DRV_INT; rt[AP++] = (ErlDrvSInt) *~s;~n", [Name]); +build_ret(Name,_Q,#type{name=_T,base=bool,single=true,by_val=false}) -> + w(" rt[AP++] = ERL_DRV_INT; rt[AP++] = (ErlDrvSInt) *~s;~n", [Name]); +build_ret(Name,_Q,#type{name=_T,size=4,base=float,single=true,by_val=false}) -> + w(" GLdouble ~sConv = (double) *~s; \n",[Name,Name]), + w(" rt[AP++] = ERL_DRV_FLOAT; rt[AP++] = (ErlDrvTermData) &~sConv;~n", [Name]); +build_ret(Name,_Q,#type{name=_T,size=8,base=float,single=true,by_val=false}) -> + w(" rt[AP++] = ERL_DRV_FLOAT; rt[AP++] = (ErlDrvTermData) ~s;~n", [Name]); + +build_ret(Name,_Q,#type{name=_T,size=FSz,base=float,single={tuple,Sz}}) -> + Temp = Name ++ "Tmp", + case FSz of + 8 -> + w(" GLdouble *~s = ~s;\n", [Temp,Name]); + 4 -> + w(" GLdouble ~sConv[~p], *~s = ~sConv; \n",[Name,Sz,Temp,Name]), + w(" for(int i=0; i < ~p; i++) ~sConv[i] = (GLdouble) ~s[i];\n",[Sz,Name,Name]) + end, + [w(" rt[AP++] = ERL_DRV_FLOAT; rt[AP++] = (ErlDrvTermData) ~s++;~n", [Temp]) + || _ <- lists:seq(1,Sz)], + w(" rt[AP++] = ERL_DRV_TUPLE; rt[AP++] = ~p;~n",[Sz]); +build_ret(Name,_Q,#type{name=T,base=_,single={tuple,Sz}}) -> + Temp = Name ++ "Tmp", + w(" ~s *~s = ~s;\n", [T,Temp,Name]), + [w(" rt[AP++] = ERL_DRV_INT; rt[AP++] = (ErlDrvSInt) *~s++;~n", [Temp]) + || _ <- lists:seq(1,Sz)], + w(" rt[AP++] = ERL_DRV_TUPLE; rt[AP++] = ~p;~n",[Sz]); +build_ret(Name,_Q,#type{name="GLubyte",single={list,null}}) -> + w(" rt[AP++] = ERL_DRV_STRING; rt[AP++] = (ErlDrvTermData) ~s;" + " rt[AP++] = strlen((char *) ~s);\n", [Name, Name]); +build_ret(Name,_Q,#type{base=string,single={list,_,Sz}}) -> + w(" rt[AP++] = ERL_DRV_STRING; rt[AP++] = (ErlDrvTermData) ~s;" + " rt[AP++] = *~s;\n", [Name, Sz]); +build_ret(Name,_Q,#type{name=_T,base=B,single={list,_,Sz}}) when B =/= float -> + w(" for(int i=0; i < *~s; i++) {\n", [Sz]), + w(" rt[AP++] = ERL_DRV_INT; rt[AP++] = (ErlDrvSInt) ~s[i];}~n", [Name]), + w(" rt[AP++] = ERL_DRV_NIL;", []), + w(" rt[AP++] = ERL_DRV_LIST; rt[AP++] = (*~s)+1;~n",[Sz]); +build_ret(Name,_Q,#type{name=_T,size=FSz,base=float,single={list,Sz}}) -> + Temp = Name ++ "Tmp", + case FSz of + 8 -> + w(" GLdouble *~s = ~s;\n", [Temp,Name]); + 4 -> + w(" GLdouble ~sConv[~p], *~s = ~sConv; \n",[Name,Sz,Temp,Name]), + w(" for(int i=0; i < ~p; i++) ~sConv[i] = (GLdouble) ~s[i];\n",[Sz,Name,Name]) + end, + [w(" rt[AP++] = ERL_DRV_FLOAT; rt[AP++] = (ErlDrvTermData) ~s++;~n", [Temp]) + || _ <- lists:seq(1,Sz)], + w(" rt[AP++] = ERL_DRV_NIL;", []), + w(" rt[AP++] = ERL_DRV_LIST; rt[AP++] = ~p+1;~n",[Sz]); +build_ret(Name,_Q,#type{name=T,base=_,single={list,Sz}}) -> + Temp = Name ++ "Tmp", + w(" ~s *~s = ~s;\n", [T,Temp,Name]), + [w(" rt[AP++] = ERL_DRV_INT; rt[AP++] = (ErlDrvSInt) *~s++;~n", [Temp]) + || _ <- lists:seq(1,Sz)], + w(" rt[AP++] = ERL_DRV_NIL;", []), + w(" rt[AP++] = ERL_DRV_LIST; rt[AP++] = ~p+1;~n",[Sz]); +build_ret(Name,_Q,#type{name="GLubyte",base=binary,size=Sz}) -> + w(" ErlDrvBinary * BinCopy = driver_alloc_binary(~p);~n", [Sz]), + w(" memcpy(BinCopy->orig_bytes, ~s, ~p);~n", [Name,Sz]), + w(" rt[AP++] = ERL_DRV_BINARY; rt[AP++] = (ErlDrvTermData) BinCopy;", []), + w(" rt[AP++] = ~p; rt[AP++] = 0;~n", [Sz]), + "driver_free_binary(BinCopy);"; +build_ret(Name,_Q,T=#type{}) -> + io:format("{~p, {~p, {single,{tuple,X}}}}.~n", [get(current_func),Name]), + io:format(" ~p~n",[T]). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +gen_defines(GLFuncs,GLUFuncs) -> + open_write("../c_src/gen/gl_fdefs.h"), + c_copyright(), + w("/***** This file is generated do not edit ****/ ~n~n", []), + w("#ifdef WX_DEF_EXTS~n", []), + w("# define WXE_EXTERN~n", []), + w("#else~n# define WXE_EXTERN extern~n", []), + w("#endif~n~n", []), + [fdefs(F) || F <- GLFuncs], + [fdefs(F) || F <- GLUFuncs], + close(). + +fdefs([F1|_Fs]) when is_list(F1) -> + put(current_func,F1), + fdef(get(F1)), + erase(current_func); +fdefs([]) -> ok; +fdefs(F) -> + put(current_func,F), + fdef(get(F)), + erase(current_func). + +fdef(#func{where=erl}) -> ok; +fdef(#func{alt={has_vector,_,FuncName}}) -> + #func{name=Name,type=T,params=As} = get(FuncName), + w("typedef ~s (APIENTRY * WXE~s)(~s);~n", + [fdef_type(T), uppercase_all(Name), fdef_types(As)]), + w("WXE_EXTERN WXE~s we~s;~n", [uppercase_all(Name), Name]); +fdef(#func{name=Name,type=T,params=As,alt=_Alt}) -> + w("typedef ~s (APIENTRY * WXE~s)(~s);~n", + [fdef_type(T), uppercase_all(Name), fdef_types(As)]), + w("WXE_EXTERN WXE~s we~s;~n", [uppercase_all(Name), Name]). + +fdef_type(void) -> "void"; +fdef_type(#type{name=T, mod=Mod, single=true, ref=undefined}) -> + mod(Mod) ++ T; +fdef_type(#type{name=T, mod=Mod, single={tuple,Sz}, ref=undefined}) -> + mod(Mod) ++ T ++ " m[" ++ integer_to_list(Sz) ++ "]"; +fdef_type(#type{name=T, mod=Mod, ref={pointer,1}}) -> + mod(Mod) ++ T ++ " *"; +fdef_type(#type{name=T, mod=Mod, ref={pointer,2}}) -> + mod(Mod) ++ T ++ " **". + +mod([const]) -> "const "; +mod([]) -> "". + +fdef_types(As) -> + args(fun(#arg{type=T}) -> fdef_type(T) end, ",", As). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +gl_gen_init(Funcs) -> + open_write("../c_src/gen/gl_finit.h"), + c_copyright(), + w("/***** This file is generated do not edit ****/ ~n~n", []), + w("static struct {\n" + " const char * name;\n" + " const char * alt;\n" + " void * func;\n" + "} gl_fns[] = \n" + "{\n", []), + [finits(F) || F <- Funcs], + w(" { NULL, NULL, NULL}};\n",[]), + close(). + +glu_gen_init(Funcs) -> + open_write("../c_src/gen/glu_finit.h"), + c_copyright(), + w("/***** This file is generated do not edit ****/ ~n~n", []), + w("static struct {\n" + " const char * name;\n" + " const char * alt;\n" + " void * func;\n" + "} glu_fns[] = \n" + "{\n", []), + [finits(F) || F <- Funcs], + w(" { NULL, NULL, NULL}};\n",[]), + close(). + + +finits([F1|_Fs]) when is_list(F1) -> + put(current_func,F1), + finit(get(F1)), + erase(current_func); +finits([]) -> ok; +finits(F) -> + put(current_func,F), + finit(get(F)), + erase(current_func). + +finit(#func{where=erl}) -> ok; +finit(#func{alt={has_vector,_,FuncName}, ext=Ext}) -> + #func{name=Name} = get(FuncName), + w(" {~p, ~s, &we~s},\n", [Name, ext(Name,Ext), Name]); +finit(#func{name=Name, ext=Ext}) -> + w(" {~p, ~s, &we~s},\n", [Name, ext(Name,Ext), Name]). + +ext(Name, {ext,Ext}) -> + "\"" ++ Name ++ Ext ++ "\""; +ext(_,_) -> "NULL". + + + + + |