/*
 * Copyright (c) 1995, 1996 Gunther Schadow.  All rights reserved.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

:- module(desc_names,[cname/2,typname/2,segname/2,msgname/2,grptname/2,
	grpvname/2,tblname/2,cdetname/2,cdevname/2,valname/2,varname/2,
	scopetype/3, grplname/2]).

:- style_check(+string).

cname(Str,Name) :- 
	digit(D),
	concat(D,_,Str), !,
	concat('_',Str,_Str),
	cname(_Str,Name).

cname(Str,Name) :- 
	uniq(Str,Str1),	
	text_to_cname(Str1,3,5,Name).

uniq(X,Y) :-
	text_to_wlist(X,L),
	uniq1(L,M),
	wlist_to_text(M,Y).

uniq1([H|T],[H1|T1]) :- !,
	lowercase(H,L),
	string_to_atom(L,A),
	uniq2(A,H1),
	uniq1(T,T1).
uniq1([],[]).

uniq2(X,Y) :-
	prefix(P),
	concat(P,R,X), !,
	concat_atom([P,' ',R],Y).
uniq2(X,Y) :-
	postfix(P),
	concat(R,P,X), !,
	concat_atom([R,' ',P],Y).
uniq2(X,Y) :-	
	untouchable(X), !,
	concat('\',X,Y).
uniq2(X,X).

prefix(milli).
prefix(con).
prefix(centi).
prefix(kilo).
prefix(dia).
prefix(epi).
prefix(endo).
prefix(intra).
prefix(intro).
prefix(para).
prefix(peri).
prefix(per).
prefix(supra).
prefix(sub).
prefix(trans).

postfix(biology).
postfix(logy).

untouchable(status).  % need came up in v2.2's IN2 segment's ``ChaSta''
untouchable(plasma).  % v2.2 table 70

wlist_to_text([],'').
wlist_to_text([H|T],S) :-
	wlist_to_text(T,S2),
	concat_atom([H,' ',S2],S).

valname(<,'_LTval').
valname(>,'_GTval').
valname(X,Y) :- 
	digit(D),
	concat(D,_,X), !,
	concat('_',X,X1),
	valname(X1,Y).
valname(X,Y) :-
	uppercase(X,X1),
	regsub(X1,'[^a-zA-Z0-9_]+','_',X2),
	concat(X2,'val',Y).

digit('0').
digit('1').
digit('2').
digit('3').
digit('4').
digit('5').
digit('6').
digit('7').
digit('8').
digit('9').

typname(code(Nr),Tn) :- !,
	cdetname(Nr,Tn).

typname(Dt,Tn) :- !,
	uppercase(Dt,UDt),
	concat(UDt,'typ',Tn).

segname(S,Sn) :- nonvar(S),
	uppercase(S,US),
	concat(US,'seg',Sn).
segname(S,Sn) :- nonvar(Sn),
	concat(US,'seg',Sn),
	lowercase(US,S).

msgname(M,Mn) :-
	uppercase(M,UM),
	concat_atom([UM,'msg'],Mn).

/*
grpname(M,E,grp(A),N) :- grpname(M,E,A,N).
grpname(M,E,A,N) :- is_list(A), !,
	uppercase(M,UM),
	uppercase(E,UE),
	concat_atom(A,N1),
	concat_atom([UM,UE,grp,N1], N).

grpvname(grp(A),N) :- is_list(A), !,
	concat_atom(A,N1),
	concat_atom(['Group',N1], N).
grpvname(A,N) :- is_list(A), !,
	concat_atom(A,N1),
	concat_atom(['Group',N1], N).
*/
/* Named Groups will need only this: */

grptname(grp(A),N) :- grptname(A,N).
grptname(grp(A,I),N) :-
	grptname(A,B),
	concat(B,I,N).
grptname(A,N) :- nonvar(A),
	uppercase(A,UA),
	concat(UA,cgrp,N).
grptname(A,N) :- nonvar(N),
	concat(UA,cgrp,N),
	lowercase(UA,A).

grplname(grp(A),N) :- grplname(A,N).
grplname(grp(A,I),N) :-
	grplname(A,B),
	concat(B,I,N).
grplname(A,N) :- nonvar(A),
	uppercase(A,UA),
	concat(UA,grp,N).
grplname(A,N) :- nonvar(N),
	concat(UA,grp,N),
	lowercase(UA,A).

grpvname(grp(A),N) :- grpvname(A,N).
grpvname(grp(A,_),N) :-
	grpvname(A,N).
	%concat(B,I,N). No, the OBRcgrp1 shall be named `OBRgroup'
grpvname(A,N) :- nonvar(A),
	uppercase(A,UA),
	concat(UA,'group',N).
grpvname(A,N) :- nonvar(N),
	concat(UA,'group',N),
	lowercase(UA,A).

cdetname(Num,NameCode) :-
	table(Num,Desc,_),	
	cname(Desc,Name),
	( concat(_,'Code',Name) ->
	    NameCode = Name;
	    concat(Name,'Code',NameCode) ).
	
cdevname(Desc,Name) :-
	cname(Desc,NameCode),
	( concat(Name,'Code',NameCode) ->
	    true ;
	    Name = NameCode ).
	
tblname(Num,Name) :-
	table(Num,Desc,_),
	cname(Desc,Name).

varname([H|_],Name) :-
	varname(H,Name).
varname(H,Name) :-
	uppercase(H,UH),
	concat(UH,'var',Name).

scopetype(Scope,TypeI,TypeO) :-
	member(Sfx,['>','']),
	concat('grp',Sfx,Sfx1),
	concat(Stm1,Sfx1,TypeI),
	concat(Stm1,'grp',Stm),
	!,
	member(Pfx,['repstruc<','']),
	concat(Pfx,Grp,Stm),
	concat_atom([Pfx,Scope,'::',Grp,Sfx],TypeO).

scopetype(_,Type,Type).