tcl2erl.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 455 行

%% ``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 via the world wide web 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.
%% 
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% 
%%     $Id$
%%
%% ------------------------------------------------------------
%%
%% Handle conversion from tcl string to erlang terms
%% 
%% ------------------------------------------------------------

-module(tcl2erl).

-export([parse_event/1,
	 ret_int/1,
	 ret_atom/1,
	 ret_str/1,
	 ret_tuple/1,
	 ret_pack/2,
	 ret_place/2,
	 ret_x/1,
	 ret_y/1,
	 ret_width/1,
	 ret_height/1,
	 ret_list/1,
	 ret_str_list/1,
	 ret_label/1,
	 ret_mapped/1,
	 ret_iconified/1,
	 ret_focus/2,
	 ret_file/1,
	 ret_bool/1,
	 ret_enable/1,
	 ret_color/1,
	 ret_stipple/1]).

-include("gstk.hrl").



%% ----------------------------------------
%%  Parse an incoming event represented as
%%  a list of bytes
%%
parse_event(Bytes) ->
    {[$#|ID], Cont1} = first_word(Bytes),
    {Etag, Cont} = first_word(Cont1),
    {tokens, Toks} = scan(Cont),
    {term_seq, Args}= parse_term_seq(Toks),
    {list_to_integer(ID), Etag, Args}.


%%---first word returns {Word,Cont}---%%
first_word(Bytes) ->
    fw(Bytes,[]).

fw([],Ack) ->
    {lists:reverse(Ack),[]};
fw([$ |R],Ack) ->
    {lists:reverse(Ack),R};
fw([Char|R],Ack) ->
    fw(R,[Char|Ack]).


%% ---------------------------------------------
%% str_to_term(Str)
%% Transforms a string to the corresponding Erlang
%% term. Note that the string "Hello" will be
%% transformed to an Erlang atom: 'Hello' .
%% If it is impossible to convert the string into
%% a term the original string is just returned.
%% str_to_term(Str)  <--->  {string, Str} or {term, Term}
%% 'so that we can be able to tell if conversion succeded or not.'
%%

str_to_term(Str) ->
    {tokens,Tokens} = scan(Str),
    case catch parse_term(Tokens) of
	{_Type, Term,[]} -> {term,Term};
	_ -> {string, Str}
    end.


%% ---------------------------------------------
%% Simple Parser.  ;-)
%% Parses tokens or fails.
%% Better catch result.
%% Tokens should be generated by scan.
%% parse_term(Toks)  <---->   {term, Term, Cont}
%% parse_call(Toks)  <---->   {call, Mod, Fun, Args, Cont}
%% parse_list(Toks)  <---->   {list, ListTerm, Cont}
%% parse_tuple(Toks) <---->   {tuple, TupleTerm, Cont}
%% parse_fun_args(Toks) <->   {fun_args, FunArgs, Cont}   %% like (arg1, arg2...)
%% parse_term_seq(Toks) <->   {term_seq, Term_Sequence}   %% no continuation
%%

parse_term([{var,Var}|R]) -> {var,Var,R};
parse_term([{atom,Atom}|R]) -> {atom,Atom,R};
parse_term([{float,Float}|R]) -> {float,Float,R};
parse_term([{integer,Integer}|R]) -> {integer,Integer,R};
parse_term([{string,String}|R]) -> {string,String,R};
parse_term(['-',{integer,Integer}|R]) -> {integer,-Integer,R};
parse_term(['-',{float,Float}|R]) -> {float,-Float,R};
parse_term(['+',{integer,Integer}|R]) -> {integer,Integer,R};
parse_term(['+',{float,Float}|R]) -> {float,Float,R};
parse_term(['['|R]) -> {list,_Term,_C}=parse_list(['['|R]);
parse_term(['{'|R]) -> {tuple,_Term,_C}=parse_tuple(['{'|R]);
parse_term([Char|R]) -> {char,Char,R}.

%%--- parse list ---
parse_list(['[',']'|C]) ->
    {list, [], C};
parse_list(['['|R]) ->
    {list,_List,_C}= list_args(R,[]).

list_args(Toks,Ack) ->
    cont_list(parse_term(Toks),Ack).

cont_list({_Tag, Term,[','|C]},Ack) ->
    list_args(C,[Term|Ack]);
cont_list({_Tag, Term,[']'|C]},Ack) ->
    {list,lists:reverse([Term|Ack]),C}.

%%--- parse tuple ---
parse_tuple(['{','}'|C]) ->
    {tuple,{}, C};
parse_tuple(['{'|R]) ->
    {tuple,_Tuple,_C}=tuple_args(R,[]).

tuple_args(Toks,Ack) ->
    cont_tuple(parse_term(Toks),Ack).

cont_tuple({_Tag, Term,[','|C]},Ack) ->
    tuple_args(C,[Term|Ack]);
cont_tuple({_Tag, Term,['}'|C]},Ack) ->
    {tuple,list_to_tuple(lists:reverse([Term|Ack])),C}.

%%--- parse sequence of terms ---
parse_term_seq(Toks) ->
    p_term_seq(Toks,[]).

p_term_seq([],Ack) ->
    {term_seq, lists:reverse(Ack)};    % never any continuation left 
p_term_seq(Toks,Ack) ->
    {_Type,Term,C} = parse_term(Toks),
    p_term_seq(C,[Term|Ack]).



%% ----------------------------------------
%% Simple Scanner

scan(Bytes) ->
    {tokens, scan(Bytes,[])}.

scan([],Ack) ->
    lists:reverse(Ack);
scan([$ |R],Ack) ->       % delete whitespace
    scan(R,Ack);
scan([X|R],Ack) when is_integer(X),X>=$a,X=<$z ->
    scan_atom(R,[X],Ack);
scan([X|R],Ack) when is_integer(X),X>=$A,X=<$Z ->
    scan_var(R,[X],Ack);
scan([X|R],Ack) when is_integer(X),X>=$0,X=<$9 ->
    scan_number(R,[X],Ack);
scan([$"|R],Ack) ->
    scan_string(R,[],Ack);
scan([X|R],Ack) when is_integer(X) ->
    scan(R,[list_to_atom([X])|Ack]).

scan_atom([X|R],Ack1,Ack2) when is_integer(X),X>=$a,X=<$z ->
    scan_atom(R,[X|Ack1],Ack2);
scan_atom([X|R],Ack1,Ack2) when is_integer(X),X>=$A,X=<$Z ->
    scan_atom(R,[X|Ack1],Ack2);
scan_atom([X|R],Ack1,Ack2) when is_integer(X),X>=$0,X=<$9 ->
    scan_atom(R,[X|Ack1],Ack2);
scan_atom([$_|R],Ack1,Ack2) ->
    scan_atom(R,[$_|Ack1],Ack2);
scan_atom(L,Ack1,Ack2) ->
    scan(L,[{atom,list_to_atom(lists:reverse(Ack1))}|Ack2]).

scan_var([X|R],Ack1,Ack2) when is_integer(X),X>=$a,X=<$z ->
    scan_var(R,[X|Ack1],Ack2);
scan_var([X|R],Ack1,Ack2) when is_integer(X),X>=$A,X=<$Z ->
    scan_var(R,[X|Ack1],Ack2);
scan_var([X|R],Ack1,Ack2) when is_integer(X),X>=$0,X=<$9 ->
    scan_var(R,[X|Ack1],Ack2);
scan_var([$_|R],Ack1,Ack2) ->
    scan_var(R,[$_|Ack1],Ack2);
scan_var(L,Ack1,Ack2) ->
    scan(L,[{var,list_to_atom(lists:reverse(Ack1))}|Ack2]).

scan_number([X|R],Ack1,Ack2) when is_integer(X),X>=$0,X=<$9 ->
    scan_number(R,[X|Ack1],Ack2);
scan_number([$.|R],Ack1,Ack2) ->
    scan_float(R,[$.|Ack1],Ack2);
scan_number(L,Ack1,Ack2) ->
    scan(L,[{integer,list_to_integer(lists:reverse(Ack1))}|Ack2]).

scan_float([X|R],Ack1,Ack2) when is_integer(X),X>=$0,X=<$9 ->
    scan_float(R,[X|Ack1],Ack2);
scan_float(L,Ack1,Ack2) ->
    Float = list_to_float(lists:reverse(Ack1)),
    Int = trunc(Float),
    if
	Int==Float ->
	    scan(L,[{integer,Int}|Ack2]);
	true ->
	    scan(L,[{float,Float}|Ack2])
    end.


scan_string([$"|R],Ack1,Ack2) ->
    scan(R,[{string,lists:reverse(Ack1)}|Ack2]);
scan_string([X|R],Ack1,Ack2) when is_integer(X) ->
    scan_string(R,[X|Ack1],Ack2);
scan_string([],_Ack1,_Ack2) ->
    throw({error,"unterminated string."}).



%% ---------- Checking Return values -----------
%% Used by read to return a proper type or fail.

ret_int(Str) ->
    case gstk:call(Str) of
	{result, Result} ->
	    {_,Value} = str_to_term(Result),
	    Value;
	Bad_result -> Bad_result
    end.

ret_atom(Str) ->
    case gstk:call(Str) of
	{result, Result} ->
	    {_,Value} = str_to_term(Result),
	    Value;
	Bad_result -> Bad_result
    end.

ret_str(Str) ->
    case gstk:call(Str) of
	{result, Val} -> Val;
	Bad_result -> Bad_result
    end.

ret_tuple(Str) ->
    case gstk:call(Str) of
	{result,S} ->
	    {tokens,Toks} = scan(S),
	    {term_seq,Seq} = parse_term_seq(Toks),
	    list_to_tuple(Seq);
	Bad_result -> Bad_result
    end.

%%----------------------------------------------------------------------
%% Returns: Coords or error.
%%----------------------------------------------------------------------
ret_pack(Key, TkW) ->
    Str = ret_list(["pack info ", TkW]),
    pick_out(Str, Key).

ret_place(Key, TkW) ->
    Str = ret_list(["place info ", TkW]),
    pick_out(Str, Key).

pick_out([Key, Value | _Rest], Key) -> Value;
pick_out([Key, {} | _Rest], Key)    -> 0;
pick_out(['-' | Rest], Key)        -> pick_out(Rest, Key);
pick_out([_, _ | Rest], Key)       -> pick_out(Rest, Key);
pick_out(Other, _Key) -> Other.


ret_x(Str) ->
    case ret_geometry(Str) of
	{_W,_H,X,_Y} -> X;
	Other -> Other
    end.

ret_y(Str) ->
    case ret_geometry(Str) of
	{_W,_H,_X,Y} -> Y;
	Other -> Other
    end.

ret_width(Str) ->
    case ret_geometry(Str) of
	{W,_H,_X,_Y} -> W;
	Other -> Other
    end.

ret_height(Str) ->
    case ret_geometry(Str) of
	{_W,H,_X,_Y} -> H;
	Other -> Other
    end.



ret_geometry(Str) ->
    case ret_tuple(Str) of
	{W,H,X,Y} when is_atom(H) ->
	    [_|Height]=atom_to_list(H),
	    {W,list_to_integer(Height),X,Y};
	Other -> Other
    end.

ret_list(Str) ->
    case gstk:call(Str) of
	{result,S} ->
	    {tokens,Toks} = scan(S),
	    {term_seq,Seq} = parse_term_seq(Toks),
	    Seq;
	Bad_result -> Bad_result
    end.

ret_str_list(Str) ->
    case gstk:call(Str) of
	{result,S} ->
	    mk_quotes0(S,[]);
	Bad_result -> Bad_result
    end.


ret_label(Str) ->
    case ret_str_list(Str) of
	[[], [$@|Img]] -> {image, Img};
	[Text, []]     -> {text, Text};
	Bad_Result     -> Bad_Result
    end.


	
ret_mapped(Str) ->
    case ret_int(Str) of
	1     -> true;
	0     -> false;
	Bad_Result -> Bad_Result
    end.


ret_iconified(Str) ->
    case ret_atom(Str) of
	iconic     -> true;
	normal     -> false;
	Bad_Result -> Bad_Result
    end.


ret_focus(W, Str) ->
    case gstk:call(Str) of
	{result, W} -> true;
	_           -> false
    end.


ret_file(Str) ->
    case gstk:call(Str) of
	{result, [$@|File]} -> File;
	{result, []}        -> [];
	Bad_result          -> Bad_result
    end.


ret_bool(Str) ->
    case ret_int(Str) of
	1     -> true;
	0     -> false;
	Bad_Result -> Bad_Result
    end.

ret_enable(Str) ->
    case ret_atom(Str) of
	normal     -> true;
	active     -> true;
	disabled   -> false;
	Bad_Result -> Bad_Result
    end.



ret_color(Str) ->
    case gstk:call(Str) of
	{result,[$#,R1,G1,B1]} ->
	    {hex2dec([R1,$0]),hex2dec([G1,$0]),hex2dec([B1,$0])};
	{result,[$#,R1,R2,G1,G2,B1,B2]} ->
	    {hex2dec([R1,R2]),hex2dec([G1,G2]),hex2dec([B1,B2])};
	{result,[$#,R1,R2,_R3,G1,G2,_G3,B1,B2,_B3]} ->
	    {hex2dec([R1,R2]),hex2dec([G1,G2]),hex2dec([B1,B2])};
	{result,[$#,R1,R2,_R3,_R4,G1,G2,_G3,_G4,B1,B2,_B3,_B4]} ->
	    {hex2dec([R1,R2]),hex2dec([G1,G2]),hex2dec([B1,B2])};
	{result,[Char|Word]} when Char>=$A, Char=<$Z ->
	    list_to_atom([Char+32|Word]);
	{result,[Char|Word]} when Char>=$a, Char=<$z ->
	    list_to_atom([Char|Word]);
	{result,Color} ->
	    gs:error("error in tcl2erl:ret_color got ~w.~n",[Color]);
	Bad_result -> Bad_result
    end.


ret_stipple(Str) ->
    case gstk:call(Str) of
	{result, _Any} -> true;
	_Other -> false
    end.


%% ------------------------------------------------------------
%% Hexadecimal to Decimal converter
%%

hex2dec(Hex) -> hex2dec(Hex,0).

hex2dec([H|T],N) when H>=$0,H=<$9 ->
    hex2dec(T,(N bsl 4) bor (H-$0));
hex2dec([H|T],N) when H>=$a,H=<$f ->
    hex2dec(T,(N bsl 4) bor (H-$a+10));
hex2dec([H|T],N) when H>=$A,H=<$F ->
    hex2dec(T,(N bsl 4) bor (H-$A+10));
hex2dec([],N) -> N.


mk_quotes0([${|T],Res) -> mk_quotes2(T,"",Res);
mk_quotes0([$ |T],Res) -> mk_quotes0(T,Res);
mk_quotes0([$\\,X |T],Res) -> mk_quotes1(T,[X],Res);
mk_quotes0([X|T],Res)  -> mk_quotes1(T,[X],Res);
mk_quotes0([],Res)     -> lists:reverse(Res).

mk_quotes1([$}|T],Ack,Res) -> mk_quotes0(T,[lists:reverse(Ack)|Res]);
mk_quotes1([$\\,X |T],Ack,Res) -> mk_quotes1(T,[X|Ack],Res);
mk_quotes1([$ |T],Ack,Res) -> mk_quotes0(T,[lists:reverse(Ack)|Res]);
mk_quotes1([X|T],Ack,Res)  -> mk_quotes1(T,[X|Ack],Res);
mk_quotes1([],Ack,Res)     -> lists:reverse([lists:reverse(Ack)|Res]).

%% grouped using {bla bla} syntax
mk_quotes2([$}|T],Ack,Res) -> mk_quotes0(T,[lists:reverse(Ack)|Res]);
mk_quotes2([$\\,X |T],Ack,Res) -> mk_quotes2(T,[X|Ack],Res);
mk_quotes2([X|T],Ack,Res)  -> mk_quotes2(T,[X|Ack],Res);
mk_quotes2([],Ack,Res)     -> lists:reverse([lists:reverse(Ack)|Res]).