/**********************************************************************
 
	Copyright (C) 2003 Hirohisa MORI <joshua@nichibun.ac.jp>
 
	This program is free software; you can redistribute it 
	and/or modify it under the terms of the GLOBALBASE 
	Library General Public License (G-LGPL) as published by 

	http://www.globalbase.org/
 
	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.

**********************************************************************/


#include	<stdlib.h>
#include	<string.h>
#include	"memory_debug.h"
#include	"gbparam.h"
#include	"utils.h"
#include	"resource.h"
#include	"memory_routine.h"
#include	"xlerror.h"

extern SEM res_lock;



XL_SEXP *gv_c_link();
XL_SEXP * gv_coord_status();
XL_SEXP * gv_initial();
XL_SEXP * gv_button_action();
XL_SEXP * gv_set_status_coordinate();
XL_SEXP * gv_relation();

typedef struct geo_type_tbl {
	char *		name;
	int		type;
	int		parameter;
} GEO_TYPE_TBL;

typedef struct gt_macro_tbl {
	char *		name;
	int		type;
	void *		parameter;
	int		axis;
} GT_MACRO_TBL;

double everest_1830_param[2] =	{6337.276,6356.075};
double bessel_1841_param[2] =	{6337.397,6356.079};
double airy_1849_param[2] =	{6337.564,6356.257};
double clarke_1866_param[2] =	{6378.206,6356.584};
double clarke_1880_param[2] =	{6378.249,6356.515};
double hayford_1909_param[2] =	{6378.388,6356.912};
double krasovsky_1940_param[2] ={6378.245,6356.863};
double GRS80_param[2] = 	{6378.137,6356.752};

GEO_TYPE_TBL gt_topology[] = {
	{"2d" , GT_T_2D,0},
	{"globe-sur" , GT_T_GLOBE_SUR,0},
	{"",0,0}
};

GEO_TYPE_TBL gt_distance[] = {
	{"pitagolas", GT_D_PITAGOLAS,0},
	{"globe", GT_D_GLOBE,1},
	{"ellipsoid", GT_D_ELLIPSOID,2},
	{"",0,0}
};

GEO_TYPE_TBL gt_axis[] = {
	{"x-forward",GT_A_X_FOR,0},
	{"y-forward",GT_A_Y_FOR,0},
	{"x-reverse",GT_A_X_REV,0},
	{"y-reverse",GT_A_Y_REV,0},
	{"math",GT_A_MATH,0},
	{"comp",GT_A_COMP,0},
	{"",0,0}
};

GT_MACRO_TBL gt_macro[] = {
	{"e2d", GT_E2D,0,GT_A_COMP},
	{"everest-1830",	GT_ELLIPSOID,	everest_1830_param,GT_A_MATH},
	{"bessel-1841",		GT_ELLIPSOID,	bessel_1841_param,GT_A_MATH},
	{"airy-1849",		GT_ELLIPSOID,	airy_1849_param,GT_A_MATH},
	{"clarke-1866",		GT_ELLIPSOID,	clarke_1866_param,GT_A_MATH},
	{"clarke-1880",		GT_ELLIPSOID,	clarke_1880_param,GT_A_MATH},
	{"hayford-1909",	GT_ELLIPSOID,	hayford_1909_param,GT_A_MATH},
	{"krasovsky-1940",	GT_ELLIPSOID,	krasovsky_1940_param,
								GT_A_MATH},
	{"GRS80",		GT_ELLIPSOID,	GRS80_param,GT_A_MATH},
	{"",0,0,0}
};

void
init_coordinate()
{
XLISP_ENV * e, * e_top;
	e = new_env(gblisp_top_env0);
	e_top = new_env(0);
	set_env(e,l_string(std_cm,"gv-c-link"),
		get_func_prim(gv_c_link,FO_APPLICATIVE,0,2,2));
	set_env(e,l_string(std_cm,"gv-status"),
			get_func_prim(gv_coord_status,
			FO_APPLICATIVE,0,1,1));
	set_env(e,l_string(std_cm,"gv-set-status"),
			get_func_prim(gv_set_status_coordinate,
			FO_APPLICATIVE,0,1,-1));
	set_default_env(e,get_func_prim(gb_null_func,FO_NORMAL,0,1,-1));

	set_env(e_top,l_string(std_cm,"initial"),
		get_func_prim(gv_initial,
			FO_NORMAL,0,1,-1));
	set_env(e_top,l_string(std_cm,"button-action"),
		get_func_prim(gv_button_action,
			FO_NORMAL,0,1,-1));
	set_env(e_top,l_string(std_cm,"relation"),
		get_func_prim(gv_relation,
			FO_APPLICATIVE,0,1,1));

	root_tag(e,l_string(std_cm,"coordinate"),e_top);
	set_env(gblisp_top_env0,l_string(std_cm,"coordinate"),
		get_env(e));
	set_gv_resource(RT_COORDINATE,e);
}


void
gc_gv_coordinate(RESOURCE * r)
{
	gc_gb_sexp(r->c.initial_cmd);
	gc_gb_sexp(r->c.button_action);
}


XL_SEXP *
get_map_list(RING_TYPE * rt)
{
MAP * m;
XL_SEXP * ret, * rec, * el;
	ret = 0;
	for ( m = R_NEXT(MAP*,rt) ;
			m != (MAP*)rt;
			m = R_NEXT(MAP*,&m->h) ) {
		rec = 0;
		if ( m->map_file == 0 )
			continue;
		if ( m->dest )
			rec = cons(
				cons(get_symbol(l_string(std_cm,"dest")),
					get_resource_element(m->dest)),
				rec);
		if ( m->src )
			rec = cons(
				cons(get_symbol(l_string(std_cm,"src")),
					get_resource_element(m->src)),
				rec);
		rec = cons(
			cons(get_symbol(l_string(std_cm,"map")),
				get_resource_element(m->map_file)),
			rec);
		ret = cons(
			cons(get_symbol(l_string(std_cm,"element")),
				rec),
			ret);
	}
	return ret;
}

MAP *
get_mapping(RESOURCE * r,URL * u)
{
MAP * m;
	for ( m = R_NEXT(MAP*,&r->c.map_children) ;
			m != (MAP*)&r->c.map_children;
			m = R_NEXT(MAP*,&m->h) )
		if ( url_cmp(&m->src_url,u) == 0 )
			return m;
	return 0;
}

XL_SEXP *
gv_set_status_coordinate(XLISP_ENV * e,XL_SEXP * s,
	XLISP_ENV * a,XL_SYM_FIELD * sf)
{
RESOURCE * r;
XL_SEXP * ret, * obj;
char * e_param;
L_CHAR * indicate, * target;
int flags,mask;
MAP * m;
URL u;
L_CHAR * c_url;
L_CHAR * mode;

	r = get_resource_ptr(&ret,e,s->h.file,s->h.line);
	if ( r == 0 )
		return ret;
	flags = 0;
	mask = 0;
	indicate = get_sf_attribute(sf,l_string(std_cm,"indicate"));
	if ( indicate == 0 )
		goto end2;
	if ( l_strcmp(indicate,l_string(std_cm,"on")) == 0 ) {
		flags |= RF_I_ON;
		mask |= RF_INDICATE;
	}
	else if ( l_strcmp(indicate,l_string(std_cm,"off")) == 0 ) {
		flags |= RF_I_OFF;
		mask |= RF_INDICATE;
	}
	else if ( l_strcmp(indicate,l_string(std_cm,"auto")) == 0 ) {
		flags |= RF_I_AUTO;
		mask |= RF_INDICATE;
	}
	else {
		e_param = "indicate";
		goto invalid_param;
	}
	mode = get_sf_attribute(sf,l_string(std_cm,"mode"));
	target = get_sf_attribute(sf,l_string(std_cm,"target"));
	if ( target == 0 ) {
		if ( list_length(s) == 1 ) {
			r->h.flags &= ~mask;
			r->h.flags |= flags;
			if ( mode ) {
				if ( r->c.mode )
					d_f_ree(r->c.mode);
				r->c.mode = ll_copy_str(mode,123);
			}
			goto end;
		}
		goto listed;
	}
	if ( l_strcmp(target,l_string(std_cm,"listed")) == 0 ) {
	listed:

		s = cdr(s);
		for ( ; get_type(s) == XLT_PAIR ; s = cdr(s) ) {
			obj = car(s);
			if ( get_type(obj) != XLT_STRING )
				goto type_missmatch;
			c_url = compose_url(
				get_url_str2(&r->h.entry),
					obj->string.data);
			get_url2(&u,c_url,123);
			m = get_mapping(r,&u);
			free_url(&u);
			d_f_ree(c_url);
			if ( m == 0 )
				continue;
			if ( m->src == 0 )
				continue;
			m->src->h.flags &= ~mask;
			m->src->h.flags |= flags;
		}
	}
	else if ( l_strcmp(target,l_string(std_cm,"all")) == 0 ) {
		r->h.flags &= ~mask;
		r->h.flags |= flags;
		if ( mode ) {
			if ( r->c.mode )
				d_f_ree(r->c.mode);
			r->c.mode = ll_copy_str(mode,111);
		}
		for ( m = R_NEXT(MAP*,&r->c.map_children) ;
				m != (MAP*)&r->c.map_children;
				m = R_NEXT(MAP*,&m->h) ) {
			if ( m->src == 0 )
				continue;
			m->src->h.flags &= ~mask;
			m->src->h.flags |= flags;
		}
	}
	else if ( l_strcmp(target,l_string(std_cm,"object")) == 0 ) {
		for ( m = R_NEXT(MAP*,&r->c.map_children) ;
				m != (MAP*)&r->c.map_children;
				m = R_NEXT(MAP*,&m->h) ) {
			if ( m->src == 0 )
				continue;
			m->src->h.flags &= ~mask;
			m->src->h.flags |= flags;
		}
	}
	else if ( l_strcmp(target,l_string(std_cm,"self")) == 0 ) {
		r->h.flags &= ~mask;
		r->h.flags |= flags;
		if ( mode ) {
			if ( r->c.mode )
				d_f_ree(r->c.mode);
			r->c.mode = ll_copy_str(mode,1245);
		}
		return 0;
	}
	else {
		e_param = "target";
		goto invalid_param;
	}
end:
	gv_set_status_option(r);
end2:
	return 0;
invalid_param:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"gv-set-status"),
		List(n_get_string("invalid parameter"),
			n_get_string(e_param),
			-1));
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"gv-set-status"),
		List(n_get_string("type missmatch"),
			-1));
}


XL_SEXP *
gv_initial(XLISP_ENV * env,XL_SEXP * s)
{
XL_SEXP * ret;
RESOURCE * r;
	r = get_resource_ptr(&ret,env,s->h.file,s->h.line);
	if ( r == 0 )
		return ret;
	r->c.initial_cmd = cdr(s);
	return 0;
}

XL_SEXP *
gv_button_action(XLISP_ENV * env,XL_SEXP * s)
{
XL_SEXP * ret;
RESOURCE * r;
	r = get_resource_ptr(&ret,env,s->h.file,s->h.line);
	if ( r == 0 )
		return ret;
	r->c.button_action = cdr(s);
	return 0;
}

XL_SEXP *
gv_relation(XLISP_ENV * env,XL_SEXP * s,XLISP_ENV * a,XL_SYM_FIELD * sf)
{
XL_SEXP * ret;
RESOURCE * r;
L_CHAR * str;
	r = get_resource_ptr(&ret,env,s->h.file,s->h.line);
	if ( r == 0 )
		return ret;
	str = get_sf_attribute(sf,l_string(std_cm,"master"));
	if ( str ) {
		if ( r->c.relation_master )
			d_f_ree(r->c.relation_master);
		r->c.relation_master = ll_copy_str(str,124);
	}
	str = get_sf_attribute(sf,l_string(std_cm,"slave"));
	if ( str ) {
		if ( r->c.relation_slave )
			d_f_ree(r->c.relation_slave);
		r->c.relation_slave = ll_copy_str(str,125);
	}
	return 0;
}


XL_SEXP * 
gv_coord_status(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a,XL_SYM_FIELD * sf)
{
XL_SEXP * ret,* p,*c;
RESOURCE * r;
	ret = get_resource_status_header(&r,env,s,a,0);
	if ( get_type(ret) == XLT_ERROR )
		return ret;
	p = cons(
		get_symbol(l_string(std_cm,"parents")),
		get_map_list(&r->c.map_parents));
	c = cons(
		get_symbol(l_string(std_cm,"children")),
		get_map_list(&r->c.map_children));
	return cons(get_symbol(l_string(std_cm,"coordinate")),
		append(ret,List(p,c,-1)));
}


int
get_fi(REAL1 * ret,XL_SEXP * d)
{
	switch ( get_type(d)) {
	case XLT_INTEGER:
		*ret = d->integer.data;
		break;
	case XLT_FLOAT:
		*ret = d->floating.data;
		break;
	default:
		return -1;
	}
	return 0;
}



void
load_children(RESOURCE * r,XL_SEXP * s)
{
XL_SEXP * cmd;
XL_SEXP * sr;
L_CHAR * name, * map_file, * dest;
int depth;
int ret_name,ret_dp,ret_rs,ret_dest;
XL_SEXP * mod,* mod1,* mod2;
L_CHAR * unit;
MAP * m, * m1;
int status;
URL url_buf;
unsigned int index_time;

	index_time = 0;
	for ( ; get_type(s) ; s = cdr(s) ) {

		sr = car(s);
		if ( get_type(sr) != XLT_PAIR )
			continue;
		cmd = car(sr);
		if ( get_type(cmd) != XLT_SYMBOL )
			continue;
		if ( l_strcmp(cmd->symbol.data,l_string(std_cm,"cindex"))
				 == 0 )	{
ss_printf("************** CINDEX %ls\n",get_url_str2(&r->h.entry));
			mod = get_el(sr,1);
			if ( get_type(mod) != XLT_INTEGER )
				continue;
			index_time = mod->integer.data;
ss_printf("* TIME = %i\n",index_time);
		}
		if ( l_strcmp(cmd->symbol.data,l_string(std_cm,"record"))
				!= 0 )
			continue;
		depth = 0;
		map_file = 0;
		get_field(sr,
			l_string(std_cm,"dest"),"s",&dest,&ret_dest,
			l_string(std_cm,"src"),"s",&name,&ret_name,
			l_string(std_cm,"dp"),"i",&depth,&ret_dp,&unit,
			l_string(std_cm,"map"),"s",&map_file,&ret_rs,
			0);
		if ( ret_name || ret_rs || ret_dest ) {
			fprintf(stderr,"load_map error %i %i\n",
				ret_name,ret_rs);
			goto next;
		}
		get_url2(&url_buf,dest,1604);
		if ( url_cmp(&url_buf,&r->h.entry) != 0 ) {
			free_url(&url_buf);
			goto next;
		}
		free_url(&url_buf);
		get_url2(&url_buf,name,1600);
		for ( m = R_NEXT(MAP*,&r->c.map_children) ;
				m != (MAP*)&r->c.map_children;
				m = R_NEXT(MAP*,&m->h) )
			if ( url_cmp(&m->src_url,&url_buf) == 0 )
				goto next;
		mod = get_el_by_symbol(sr,l_string(std_cm,"mod"),0);
		m1 = d_alloc(sizeof(MAP),40);
		m1->flags = 0;
		m1->src = 0;
		m1->map_file = 0;
		m1->src_url = url_buf;
		m1->clip = 0;
		get_url2(&m1->map_url,map_file,1601);
		m1->dest = r;
		copy_url(&m1->dest_url,&r->h.entry);
		m1->depth = depth;

		if ( mod ) {
			mod1 = get_el(mod,1);
			if ( get_type(mod1) == XLT_INTEGER )
				m1->mod_time_org = mod1->integer.data;
			else	m1->mod_time_org = 0;
			mod2 = get_el(mod,2);
			if ( get_type(mod2) == XLT_INTEGER )
				m1->mod_time = mod2->integer.data;
			else	m1->mod_time = 0;
		}
		else	m1->mod_time = 0;

		mod = get_el_by_symbol(sr,l_string(std_cm,"mr"),0);
		m1->cindex_mr.tl.x = m1->cindex_mr.tl.y = 0;
		m1->cindex_mr.br.x = m1->cindex_mr.br.y = -1;
		if ( mod ) {
		GB_RECT mr;
			if ( get_fi(&mr.tl.x,get_el(mod,1)) < 0 )
				goto err;
			if ( get_fi(&mr.tl.y,get_el(mod,2)) < 0 )
				goto err;
			if ( get_fi(&mr.br.x,get_el(mod,3)) < 0 )
				goto err;
			if ( get_fi(&mr.br.y,get_el(mod,4)) < 0 )
				goto err;
			m1->cindex_mr = mr;
		err:	{}
		}

/*
ss_printf("MOD TIME = %i (%f %f %f %f)\n",m1->mod_time,
m1->cindex_mr.tl.x,
m1->cindex_mr.tl.y,
m1->cindex_mr.br.x,
m1->cindex_mr.br.y
);
*/
		lock_task(res_lock);
		for ( m = R_NEXT(MAP*,&r->c.map_children) ;
				m != (MAP*)&r->c.map_children;
				m = R_NEXT(MAP*,&m->h) )
			if ( m->depth > m1->depth )
				break;
		m = R_PREV(MAP*,&m->h);
		INSERT_RING(&m->h,&m1->h);
/***/
		unlock_task(res_lock,"write_lock");
		load_coordinate_option();
	next:
		{}
	}
end:
	for ( m = R_NEXT(MAP*,&r->c.map_children) ;
			m != (MAP*)&r->c.map_children;
			m = R_NEXT(MAP*,&m->h) ) {
		m->cindex_time = index_time;
	}
}

void
load_parents(RESOURCE * r,XL_SEXP * s)
{
XL_SEXP * sr, * cmd;
L_CHAR * name, * map_file;
int depth;
int ret_name,ret_dp,ret_rs;
L_CHAR * unit;
MAP * m,*m1;
int status;
URL url_buf;


	for ( ; get_type(s) ; s = cdr(s) ) {
		sr = car(s);
		if ( get_type(sr) != XLT_PAIR )
			continue;
		cmd = car(sr);
		if ( get_type(cmd) != XLT_SYMBOL )
			continue;
		if ( l_strcmp(cmd->symbol.data,l_string(std_cm,"record"))
				!= 0 )
			continue;
		depth = 0;
		get_field(sr,
			l_string(std_cm,"dest"),"s",&name,&ret_name,
			l_string(std_cm,"dp"),"i",&depth,&ret_dp,&unit,
			l_string(std_cm,"map"),"s",&map_file,&ret_rs,
			0);
		if ( ret_name || ret_rs ) {
			fprintf(stderr,"load_map error %i %i\n",
				ret_name,ret_rs);
			goto next;
		}
		get_url2(&url_buf,name,1602);
		for ( m = R_NEXT(MAP*,&r->c.map_parents) ;
				m != (MAP*)&r->c.map_parents;
				m = R_NEXT(MAP*,&m->h) )
			if ( url_cmp(&m->src_url,&url_buf) == 0 )
				goto next;


		m1 = d_alloc(sizeof(MAP),41);
		m1->flags = 0;
		m1->dest = 0;
		m1->map_file = 0;
		m1->dest_url = url_buf;
		get_url2(&m1->map_url,map_file,1603);
		m1->src = r;
		copy_url(&m1->src_url,&r->h.entry);
		m1->depth = depth;

		lock_task(res_lock);

		for ( m = R_NEXT(MAP*,&r->c.map_parents) ;
				m != (MAP*)&r->c.map_parents;
				m = R_NEXT(MAP*,&m->h) )
			if ( m->depth > m1->depth )
				break;
		m = R_PREV(MAP*,&m->h);
		INSERT_RING(&m->h,&m1->h);

/***/

		unlock_task(res_lock,"write_");

		load_coordinate_option();
	next:
		{}
	}
end:	{}
}

XL_SEXP *
gv_c_link(XLISP_ENV * e,XL_SEXP * s,XLISP_ENV * a_env,XL_SYM_FIELD * sf)
{
XL_SEXP * ret;
int parent;
RESOURCE * r;
XL_SEXP * lst;
char * e_param;

	parent = 0;
	for ( ; sf ; sf = sf->next ) {
		if ( l_strcmp(sf->name,l_string(std_cm,"type")) == 0 ) {
			if ( l_strcmp(sf->data,l_string(std_cm,"parents"))
					== 0 )
				parent = 1;
			else if ( l_strcmp(sf->data,l_string(std_cm,
					"children")) == 0 )
				parent = 0;
			else {
				e_param = "attribute(type)";
				goto param_error;
			}
		}
	}
	r = get_resource_ptr(&ret,e,s->h.file,s->h.line);
	if ( r == 0 )
		return ret;
	lst = get_el(s,1);

	if ( parent )
		load_parents(r,lst);
	else	load_children(r,lst);

	return 0;
param_error:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"gv:c:link"),
		List(n_get_string("invalid parameter"),
			get_string(l_string(std_cm,e_param)),
			-1));
}


GEO_TYPE_TBL *
get_geometory_type_byname(GEO_TYPE_TBL * tbl,L_CHAR * type)
{
int i;
int len;
	for ( i = 0 ; tbl[i].name[0] ; i ++ ) {
		len = strlen(tbl[i].name);
		if ( memcmp(type,l_string(std_cm,tbl[i].name),
				len*sizeof(L_CHAR)) )
			continue;
		if ( type[len] && type[len] != ';' )
			continue;
		return &tbl[i];
	}
	return 0;
}

GEO_TYPE_TBL *
get_geometory_type_byflags(GEO_TYPE_TBL * tbl,int flags)
{
int i;
	for ( i = 0; tbl[i].name[0] ; i ++ ) {
		if ( tbl[i].type == flags )
			return &tbl[i];
	}
	return 0;
}

void
get_geometory_type(
	GEO_TYPE_TBL ** top,
	GEO_TYPE_TBL ** dist,
	double ** param,
	int * axis,
	GT_MACRO_TBL ** macro,
	L_CHAR * type)
{
int i;
int len;
char * p, * q;
GT_MACRO_TBL * m;
GEO_TYPE_TBL * a;
	if ( top )
		*top = 0;
	if ( dist )
		*dist = 0;
	if ( param )
		*param = 0;
	if ( macro )
		*macro = 0;
	if ( axis )
		*axis = 0;
	for ( i = 0 ; gt_macro[i].name[0] ; i ++ ) {
		if ( l_strcmp(type,l_string(std_cm,gt_macro[i].name)) )
			continue;
		m = &gt_macro[i];
		*top = get_geometory_type_byflags(
				&gt_topology[0],
				gt_macro[i].type&GT_T_MASK);
		*dist = get_geometory_type_byflags(
				&gt_distance[0],
				gt_macro[i].type&GT_D_MASK);
		if ( (*dist)->parameter ) {
			*param = d_alloc(sizeof(double)*
					(*dist)->parameter,125);
			memcpy(*param,m->parameter,
				sizeof(double)*(*dist)->parameter);
		}
		else	*param = 0;
		if ( macro )
			*macro = m;
		for ( ; *type && *type != ';' ; type ++ );
		if ( *type == 0 ) {
			*axis = gt_macro[i].axis;
		}
		else {
			type ++;
			a = get_geometory_type_byname(
					&gt_axis[0],
					type);
			*axis = a->type;
		}
		return;
	}
	if ( macro )
		*macro = 0;
	*top = get_geometory_type_byname(&gt_topology[0],type);
	for ( ; *type && *type != ';' ; type ++ );
	if ( *type == 0 ) {
		*dist = 0;
		*param = 0;
		return;
	}
	type ++;
	*dist = get_geometory_type_byname(&gt_distance[0],type);
	if ( (*dist)->parameter == 0 ) {
		*param = 0;
		return;
	}
	for ( ; *type && *type != ';' ; type ++ );
	if ( *type == 0 ) {
		*dist = 0;
		*param = 0;
		return;
	}
	type ++;
	*param = d_alloc(sizeof(double)*(*dist)->parameter,135);
	for ( ; *type && *type != ';' ; type ++ );
	if ( *type == 0 ) {
		d_f_ree(*param);
		*param = 0;
		return;
	}
	type ++;
	p = ln_copy_str(std_cm,type);
	for ( i = 0; i < (*dist)->parameter ; ) {
		for ( q = p ; *q && *q != ';' ; q ++ , type ++ );
		if ( *q ) {
			*q = 0;
			*q ++;
			type ++;
		}
		sscanf(p,"%lf",&param[i++]);
		if ( *q == 0 )
			break;
		p = q;
	}
	if ( i != (*dist)->parameter ) {
		d_f_ree(*param);
		*param = 0;
	}

	a = get_geometory_type_byname(&gt_axis[0],type);
	if ( a && axis )
		*axis = a->type;
	else if ( axis )
		*axis = GT_A_MATH;
}

int
get_cid_from_sexp(COORDINATE * c,XL_SEXP * cid)
{
XL_SEXP * sym,* dt;
int len;
int * _cid;
int i;
L_CHAR * b;
	if ( get_type(cid) != XLT_PAIR )
		return -1;
	sym = car(cid);
	if ( get_type(sym) != XLT_SYMBOL )
		return -1;
	len = list_length(cid);
	if ( len < 0 )
		return -1;
	c->cid = _cid = d_alloc(sizeof(int)*len,2436);
	cid = cdr(cid);
	_cid[0] = len;
	for ( i = 1 ; i < len ; i ++, cid = cdr(cid) ) {
		dt = car(cid);
		if ( get_type(dt) != XLT_INTEGER )
			goto err;
		_cid[i] = dt->integer.data;
	}
	b = get_sf_attribute(sym->symbol.field,
		l_string(std_cm,"body"));
	if ( b )
		c->body = ll_copy_str(b,1235);
	b = get_sf_attribute(sym->symbol.field,
		l_string(std_cm,"pri"));
	if ( b )
		c->body_pri = ll_copy_str(b,1356);
	return 0;
err:
	d_f_ree(c->cid);
	c->cid = 0;
	return -1;
}


XL_SEXP *
gv_new_coordinate(RESOURCE * r,XL_SEXP * s,int ds)
{
XL_SEXP * res,* res_data, * geo, * cid;
COORDINATE * c;
int er;
int ret_v,ret_geo,ret_cid;
char * e_param;
MAP * m1;
XL_SEXP * _geo_type;
L_CHAR * geo_type;
GEO_TYPE_TBL * top,* dist;
int axis;
double * geo_param;

	get_field(s,
		l_string(std_cm,"v"),"sexp",&res,&ret_v,
		0);
	cid = get_el_by_symbol(s,l_string(std_cm,"cid"),0);
	if ( ret_v ) {
		e_param = "v";
		goto subtype_error;
	}
	geo = get_el_by_symbol(s,l_string(std_cm,"file"),0);
	if ( geo == 0 ) {
		e_param = "file";
		goto subtype_error;
	}
	if ( get_type(geo) != XLT_PAIR )
		er_panic("gv_new_coordinate");
	_geo_type = car(geo);
	if ( get_type(_geo_type) != XLT_SYMBOL )
		er_panic("gv_new_coordinate");
	geo_type = get_sf_attribute(_geo_type->symbol.field,
			l_string(std_cm,"type"));

	c = &r->c;

	c->flags = 0;
	c->limit_resolution = 0;
	c->weight = 0;
	c->initial_cmd = 0;
	c->button_action = 0;
	c->mode = nl_copy_str(std_cm,"initial");
	get_geometory_type(&top,&dist,&geo_param,&axis,0,geo_type);
	c->geometory_type = top->type|dist->type|axis;
	c->body = 0;
	c->body_pri = 0;
	c->cid = 0;
	c->relation_slave = 0;
	c->relation_master = 0;

	switch ( ds ) {
	case NR_CLEAR:
		for ( ; c->map_children.next != &c->map_children ; ) {
			m1 = R_NEXT(MAP*,&c->map_children);
			free_mapping_from_sd(
				m1->src,
				m1->dest);
		}
		for ( ; c->map_parents.next != &c->map_parents ; ) {
			m1 = R_NEXT(MAP*,&c->map_parents);
			free_mapping_from_sd(
				m1->src,
				m1->dest);
		}
		d_f_ree(c->geometory_param);
		c->geometory_param = 0;
		d_f_ree(c->cid);
	case NR_NEW:
		if ( geo_param )
			c->geometory_param = geo_param;
		else	c->geometory_param = 0;
		c->ov = search_overlay(&r->h.entry);
		if ( c->ov == 0 )
			c->ov = &default_overlay;
		get_cid_from_sexp(c,cid);
		if ( cmp_sexp(get_el(res,0),n_get_symbol("resolution"))
				== 0 ) {
			res_data = get_el(res,1);
/*
printf("----- ");
print_sexp(s_stdout,res_data,0);
printf("\n");
*/
			switch ( get_type(res_data) ) {
			case XLT_INTEGER:
				c->h.visible_resolution
					= conv_unit(
						&er,
						c->h.cu.uenv,
						res_data->integer.data,
						res_data->integer.unit,
						reso_c_unit(&c->h.cu));
				break;
			case XLT_FLOAT:
				c->h.visible_resolution
					= conv_unit(
						&er,
						c->h.cu.uenv,
						res_data->floating.data,
						res_data->floating.unit,
						reso_c_unit(&c->h.cu));
				break;
			default:
				e_param = "resolution data-type error";
				goto invalid_param;
			}
			if ( list_length(res) == 3 ) {
				c->flags |= CF_FIX_LIMIT_RESO;
				res_data = get_el(res,2);
				switch ( get_type(res_data) ) {
				case XLT_INTEGER:
					c->limit_resolution
						= conv_unit(
						&er,
						c->h.cu.uenv,
						res_data->integer.data,
						res_data->integer.unit,
						reso_c_unit(&c->h.cu));
					break;
				case XLT_FLOAT:
					c->limit_resolution
						= conv_unit(
						&er,
						c->h.cu.uenv,
						res_data->floating.data,
						res_data->floating.unit,
						reso_c_unit(&c->h.cu));
					break;
				default:
					break;
				}
			}


		}
		else {
			e_param = "non support visible for coordinate";
			goto invalid_param;
		}
		INIT_RING(&c->map_children);
		INIT_RING(&c->map_parents);
	case NR_KEEP:
		break;
	}
/*
	printf("coordinate %lg %i\n",c->h.visible_resolution,er);
*/
	return 0;
invalid_param:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"gv-new-resource(coordinate)"),
		List(n_get_string("invalid parameter in the meta info"),
			get_string(l_string(std_cm,e_param)),
			n_get_string("argument"),
			-1));
subtype_error:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"gv-new-resource(coordinate)"),
		List(n_get_string("invalid subtype in the meta info"),
			get_string(l_string(std_cm,e_param)),
			n_get_string("argument"),
			-1));
}


RESOURCE *
get_map_between(int ses,L_CHAR * obj,L_CHAR * crd)
{
RESOURCE * c;
URL u;
RESOURCE * ret;
MAP * m;
	get_url2(&u,crd,1229);
	c = load_resource(ses,&u,Q_PRI_OBJ);
	free_url(&u);
	if ( c == 0 ) {
		ret = 0;
		goto end;
	}
	get_url2(&u,obj,1230);
	for ( m = R_NEXT(MAP*,&c->c.map_children) ;
			m != (MAP*)&c->c.map_children;
			m = R_NEXT(MAP*,&m->h) ) {
		if ( url_cmp(&m->src_url,&u)  )
			continue;
		if ( m->map_file )
			ret = m->map_file;
		else	ret = m->map_file = load_resource(ses,&m->map_url,
							Q_PRI_OBJ);
		break;
	}
	free_url(&u);
end:
	return ret;
}


RESOURCE *
get_map_between2(RESOURCE * obj,RESOURCE * crd)
{
MAP * m;
	for ( m = R_NEXT(MAP*,&crd->c.map_children) ;
			m != (MAP*)&crd->c.map_children;
			m = R_NEXT(MAP*,&m->h) ) {
		if ( m->src != obj )
			continue;
		return m->map_file;
	}
	return 0;
}
