/**********************************************************************
 
	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	<math.h>
#include	<stdlib.h>
#include	"memory_debug.h"
#include	"xl.h"
#include	"gbgraph.h"
#include	"xlerror.h"
/*
#define JUDGE_SIGMA	0.25
*/
STREAM * logout;

typedef struct gm_work {
	REAL1		sr;
	REAL1		dr;
} GM_WORK;

typedef struct gm_ptr {
	struct gm_ptr *		next;
	struct gm_ptr *		prev;
	XL_SEXP * 		src;
	XL_SEXP *		dest;
	GB_POINT		src_ptr;
	GB_POINT		dest_ptr;
	int			name;
} GM_PTR;

typedef struct gm_line {
	struct gm_line *	next;
	GM_PTR *		point[2];
} GM_LINE;


typedef struct gm_triangle {
	struct gm_triangle *	next;
	GM_PTR *		point[3];
	float			round;
} GM_TRIANGLE;


typedef struct select_set {
	GM_TRIANGLE *		tri;
	GM_LINE *		line;
} SELECT_SET;

#define BUF_SIZE	100000
char print_buf[BUF_SIZE];
int buf_ptr;

char *
get_buf(int size)
{
char * ret;
	if ( buf_ptr + size >= BUF_SIZE )
		buf_ptr = 0;
	return &print_buf[buf_ptr];
}

void
set_next(int size)
{
	buf_ptr += size;
	if ( buf_ptr >= BUF_SIZE )
		buf_ptr = 0;
}

char *
print_point(GM_PTR * p)
{
char * b;
	b = get_buf(100);
	sprintf(b,"(%f %f) -> (%f %f)",
		p->src_ptr.x,
		p->src_ptr.y,
		p->dest_ptr.x,
		p->dest_ptr.y);
	set_next(strlen(b)+1);
	return b;
}

char *
print_line(GM_LINE * ll)
{
char * p1,* p2;
char * b;
	p1 = print_point(ll->point[0]);
	p2 = print_point(ll->point[1]);
	b = get_buf(strlen(p1)+strlen(p2)+20);
	sprintf(b,"[%s] - [%s]",p1,p2);
	set_next(strlen(b)+1);
	return b;
}

char *
print_triangle(GM_TRIANGLE * t)
{
char * p[3];
char * b;
int i;
int len;
	len = 0;
	for ( i = 0 ; i < 3 ; i ++ ) {
		p[i] = print_point(t->point[i]);
		len += strlen(p[i]);
	}
	b = get_buf(len+20);
	sprintf(b,"<<%s %s %s>>",p[0],p[1],p[2]);
	set_next(strlen(b)+1);
	return b;
}

void
free_gm_line(GM_LINE * ll)
{
GM_LINE * ll2;
	for ( ; ll ; ) {
		ll2 = ll;
		ll = ll->next;
		d_f_ree(ll2);
	}
}

void
free_gm_ptr(GM_PTR * p)
{
GM_PTR * p1;
	for ( ; p ; ) {
		p1 = p;
		p = p->next;
		d_f_ree(p1);
	}
}

void
free_gm_triangle(GM_TRIANGLE * t)
{
GM_TRIANGLE * t1;
	for ( ; t ; ) {
		t1 = t;
		t = t->next;
		d_f_ree(t1);
	}
}

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

int
get_raw_gbpoint(GB_POINT * p,XL_SEXP * ptr)
{
	if ( get_raw_data(&p->x,get_el(ptr,0)) < 0 )
		return -1;
	if ( get_raw_data(&p->y,get_el(ptr,1)) < 0 )
		return -1;
	return 0;
}

int
check_direction(GM_PTR * p1,GM_PTR * p2,GM_PTR * p3)
{
GB_POINT s1,s2;
GB_POINT d1,d2;
float ss,dd;
	s1 = p_sub(p2->src_ptr,p1->src_ptr);
	s2 = p_sub(p3->src_ptr,p1->src_ptr);
	d1 = p_sub(p2->dest_ptr,p1->dest_ptr);
	d2 = p_sub(p3->dest_ptr,p1->dest_ptr);

	ss = s1.x*s2.y - s1.y*s2.x;
	dd = d1.x*d2.y - d1.y*d2.x;

	if ( ss == 0 || dd == 0 )
		return -1;
	if ( dd/ss < 0 )
		return -1;
	return 0;
}

void
set_round(GM_TRIANGLE * t)
{
REAL1 d;
	d = 0;
	d += distance(t->point[0]->src_ptr,
			t->point[1]->src_ptr);
	d += distance(t->point[0]->dest_ptr,
			t->point[1]->dest_ptr);
	d += distance(t->point[1]->src_ptr,
			t->point[2]->src_ptr);
	d += distance(t->point[1]->dest_ptr,
			t->point[2]->dest_ptr);
	d += distance(t->point[2]->src_ptr,
			t->point[0]->src_ptr);
	d += distance(t->point[2]->dest_ptr,
			t->point[0]->dest_ptr);
	t->round = d;
}

int
check_inpoint(GM_PTR * p1,GM_PTR * p2,GM_PTR * p3,GM_PTR * ptr)
{
GB_POINT src[3],dest[3];
	src[0] = p1->src_ptr;
	src[1] = p2->src_ptr;
	src[2] = p3->src_ptr;
	dest[0] = p1->dest_ptr;
	dest[1] = p2->dest_ptr;
	dest[2] = p3->dest_ptr;
	for ( ; ptr ; ptr = ptr->next ) {
		if ( ptr == p1 )
			continue;
		if ( ptr == p2 )
			continue;
		if ( ptr == p3 )
			continue;
		if ( inside_triangle(src,ptr->src_ptr) == 0 )
			return -1;
		if ( inside_triangle(dest,ptr->dest_ptr) == 0 )
			return -1;
	}
	return 0;
}


int
amount_distance(GB_POINT p1,GB_POINT p2,REAL1 r)
{
REAL1 d;
	if ( r < 0 )
		return 0;
	d = p1.x - p2.x;
	if ( d < 0 )
		d = -d;
	if ( d >= r )
		return -1;
	d = p1.y - p2.y;
	if ( d < 0 )
		d = -d;
	if ( d >= r )
		return -1;
	return 0;
}

int
check_amount(
	GM_PTR * p1,
	GM_PTR * p2,
	GM_PTR * p3,
	GM_WORK * w)
{
int ret;
	if ( p3 == 0 ) {
		ret = amount_distance(p1->src_ptr,p2->src_ptr,w->sr);
		if ( ret )
			return ret;
		return amount_distance(p1->dest_ptr,p2->dest_ptr,w->dr);
	}
	else {
		ret = amount_distance(p1->src_ptr,p3->src_ptr,w->sr);
		if ( ret )
			return ret;
		ret = amount_distance(p1->dest_ptr,p3->dest_ptr,w->dr);
		if ( ret )
			return ret;
		ret = amount_distance(p2->src_ptr,p3->src_ptr,w->sr);
		if ( ret )
			return ret;
		return amount_distance(p2->dest_ptr,p3->dest_ptr,w->dr);
	}
}


GM_TRIANGLE *
trace_triangle(GM_PTR * ptr,GM_WORK * w)
{
GM_PTR * p1,* p2, * p3;
GM_TRIANGLE * t1, * ret;
int fit_cnt;

int tt1,tt2,total;
int fit_pattern;
int retry_flag;
	ret = 0;
	tt1 = 0;
	total = 0;
	for ( p1 = ptr ; p1 ; p1 = p1->next , tt1 ++ ) {
		total = tt1+tt2;
		tt2 = 0;

		fit_pattern = 0;
		fit_cnt = 0;
		p2 = p1->next;
		retry_flag = 0;
	retry:
		for (  ; p2 ; p2 = p2->next , tt2 ++ ) {
ss_printf("LOOP (%i) %i %i  \r",total,tt1,tt2);
			if ( p2 == p1 )
				continue;
			if ( retry_flag == 0 &&
					check_amount(p1,p2,0,w) )
				continue;
			for ( p3 = p2->next ; p3 ; p3 = p3->next ) {
				if ( p3 == p1 )
					continue;
				if ( retry_flag == 0 &&
						check_amount(p1,p2,p3,w) )
					continue;
if ( fit_pattern == 2 || fit_cnt )
ss_printf("\t\t\t\t\t\t\t%i \r",++fit_cnt );
				if ( check_direction(p1,p2,p3) < 0 )
					continue;
				if ( check_inpoint(p1,p2,p3,ptr) < 0 )
					continue;
				fit_pattern = 1;
				t1 = d_alloc(sizeof(*t1));
				t1->point[0] = p1;
				t1->point[1] = p2;
				t1->point[2] = p3;
				t1->next = ret;
				ret = t1;
				set_round(t1);
			}
		}
		if ( fit_pattern == 0 ) {
fit_cnt = 0;
ss_printf("---------- %x (%f %f) (%f %f)\n",p1,
p1->src_ptr.x,p1->src_ptr.y,
p1->dest_ptr.x,p1->dest_ptr.y);
			p2 = ptr;
			fit_pattern = 2;
			retry_flag = 1;
			goto retry;
		}
	}
ss_printf("\n\n");
	return ret;
}

void
divide_triangle(GM_TRIANGLE * t,GM_TRIANGLE ** t1,GM_TRIANGLE ** t2)
{
GM_TRIANGLE * t3;
	*t1 = 0;
	*t2 = 0;
	for ( ; t ; ) {
		t3 = t;
		t = t->next;
		t3->next = *t1;
		*t1 = t3;
		if ( t == 0 )
			break;
		t3 = t;
		t = t->next;
		t3->next = *t2;
		*t2 = t3;
	}
}

GM_TRIANGLE*
marge_triangle(GM_TRIANGLE * t1,GM_TRIANGLE * t2)
{
GM_TRIANGLE * t3;
GM_TRIANGLE * ret;
GM_TRIANGLE ** rp;
	ret = 0;
	rp = &ret;
	for ( ; t1 && t2 ; ) {
		if ( t1->round < t2->round ) {
			t3 = t1;
			t1 = t1->next;
		}
		else {
			t3 = t2;
			t2 = t2->next;
		}
		t3->next = 0;
		*rp = t3;
		rp = &t3->next;
	}
	if ( t1 )
		*rp = t1;
	else if ( t2 )
		*rp = t2;
	return ret;
}

GM_TRIANGLE *
sort_triangle(GM_TRIANGLE * t)
{
GM_TRIANGLE * t1, * t2;
	if ( t == 0 )
		return 0;
	if ( t->next == 0 )
		return t;
	divide_triangle(t,&t1,&t2);
	t1 = sort_triangle(t1);
	t2 = sort_triangle(t2);
	return marge_triangle(t1,t2);
}

float
_conflict(
	GM_PTR * ln0,GM_PTR *ln1,
	GM_PTR *result0,GM_PTR * result1,
	int src_dest)
{
GB_POINT ll,rr0,rr1,tt1;
double d,om,sg,d1,d2,d3;
GB_POINT a,b;
	if ( result0 == ln0 &&
			result1 != ln1 ) {
		if ( src_dest == 0 ) {
			a = p_sub(result1->src_ptr,
				result0->src_ptr);
			b = p_sub(ln1->src_ptr,
				ln0->src_ptr);
		}
		else {
			a = p_sub(result1->dest_ptr,
				result0->dest_ptr);
			b = p_sub(ln1->dest_ptr,
				ln0->dest_ptr);
		}
		goto over_check;
	}
	if ( result0 == ln1 &&
			result1 != ln0 ) {
		if ( src_dest == 0 ) {
			a = p_sub(result1->src_ptr,
				result0->src_ptr);
			b = p_sub(ln0->src_ptr,
				ln1->src_ptr);
		}
		else {
			a = p_sub(result1->dest_ptr,
				result0->dest_ptr);
			b = p_sub(ln0->dest_ptr,
				ln1->dest_ptr);
		}
		goto over_check;
	}
	if ( result1 == ln0 &&
			result0 != ln1 ) {
		if ( src_dest == 0 ) {
			a = p_sub(result0->src_ptr,
				result1->src_ptr);
			b = p_sub(ln1->src_ptr,
				ln0->src_ptr);
		}
		else {	
			a = p_sub(result0->dest_ptr,
				result1->dest_ptr);
			b = p_sub(ln1->dest_ptr,
				ln0->dest_ptr);
		}
		goto over_check;
	}
	if ( result1 == ln1 &&
			result0 != ln0 ) {
		if ( src_dest == 0 ) {
			a = p_sub(result0->src_ptr,
				result1->src_ptr);
			b = p_sub(ln0->src_ptr,
				ln1->src_ptr);
		}
		else {
			a = p_sub(result0->src_ptr,
				result1->src_ptr);
			b = p_sub(ln0->src_ptr,
				ln1->src_ptr);
		}
		goto over_check;
	}
	if ( result0 == ln0 &&
		result1 == ln1 )
		return 1;
	if ( result1 == ln0 &&
		result0 == ln1 )
		return 1;
	if ( src_dest == 0 ) {
		ll = p_sub(ln1->src_ptr,
				ln0->src_ptr);
		rr0 = p_sub(result0->src_ptr,
				ln0->src_ptr);
		rr1 = p_sub(result1->src_ptr,
				ln0->src_ptr);
	}
	else {
		ll = p_sub(ln1->dest_ptr,
				ln0->dest_ptr);
		rr0 = p_sub(result0->dest_ptr,
				ln0->dest_ptr);
		rr1 = p_sub(result1->dest_ptr,
				ln0->dest_ptr);
	}
	d = rr0.x*rr1.y - rr0.y*rr1.x;
	if ( d == 0 ) {
		d1 = rr0.x * rr1.x;
		d2 = rr0.y * rr1.y;
		if ( d1 == 0 && d2 == 0 )
			return 0;
		if ( d1 == 0 && d2 < 0 )
			return 0.5;
		if ( d2 == 0 && d1 < 0 )
			return 0.5;
		if ( d1 < 0 && d2 < 0 )
			return 0.5;
		d = rr0.x*ll.y - rr0.y*ll.x;
		if ( d )
			return 0;
		d1 = rr0.x * ll.x;
		d2 = rr0.y * ll.y;
		if ( d1 == 0 && d2 == 0 )
			return 0;
		if ( d1 == 0 && d2 < 0 )
			return 0;
		if ( d1 < 0 && d2 == 0 )
			return 0;
		if ( d1 < 0 && d2 < 0 )
			return 0;
		d1 = inner(rr0,rr0);
		d2 = inner(rr1,rr1);
		d = inner(ll,ll);
		if ( d1 > d2 && d1 > d && d > d2 )
			return 0.5;
		if ( d1 < d2 && d1 < d && d < d2 )
			return 0.5;
		return 0;
	}
	sg = (ll.x*rr1.y - ll.y*rr1.x)/d;
	om = (rr0.x*ll.y - rr0.y*ll.x)/d;

	if ( sg + om >= 1 && sg >= 0 && om >= 0 )
		return sg/(sg+om);
	return 0;

over_check:
	d = a.x*b.y - a.y*b.x;
	if ( d )
		return 0;
	d1 = a.x * b.x;
	d2 = a.y * b.y;
	if ( d1 < 0 || d2 < 0 )
		return 0;
	if ( d1 == 0 && d2 == 0 ) {
		if ( a.x == 0 && a.y == 0 )
			return 0.5;
		return 1;
	}
	d1 = inner(a,a);
	d2 = inner(b,b);
	if ( d1 > d2 )
		return 0.5;
	return 1;
}


int
line_conflict(
	GM_PTR * p1,GM_PTR * p2,
	GM_PTR * p3,GM_PTR * p4)
{
	if ( p1 == p3 )
		return 0;
	if ( p1 == p4 )
		return 0;
	if ( p2 == p3 )
		return 0;
	if ( p2 == p4 )
		return 0;
	if ( _conflict(p1,p2,p3,p4,0) != 0 )
		return -1;
	if ( _conflict(p1,p2,p3,p4,1) != 0 )
		return -1;
	return 1;
}

int
triangle_conflict(SELECT_SET * ss,GM_TRIANGLE * t)
{
GM_LINE * ll;
	for ( ll = ss->line ; ll ; ll = ll->next ) {
		switch ( line_conflict(
			ll->point[0],
			ll->point[1],
			t->point[0],
			t->point[1]) ) {
		case -1:
			return -1;
		case 0:
		case 1:
			break;
		}
		switch ( line_conflict(
			ll->point[0],
			ll->point[1],
			t->point[1],
			t->point[2]) ) {
		case -1:
			return -1;
		case 0:
		case 1:
			break;
		}
		switch ( line_conflict(
			ll->point[0],
			ll->point[1],
			t->point[0],
			t->point[2]) ) {
		case -1:
			return -1;
		case 0:
		case 1:
			break;
		}
	}
	return 0;
}

void
set_ssline(SELECT_SET * ss,GM_PTR * p1,GM_PTR * p2)
{
GM_LINE * ll;
	for ( ll = ss->line ; ll ; ll = ll->next ) {
		if ( ll->point[0] == p1 &&
				ll->point[1] == p2 )
			return;
		if ( ll->point[1] == p1 &&
				ll->point[0] == p2 )
			return;
	}
	ll = d_alloc(sizeof(*ll));
	ll->point[0] = p1;
	ll->point[1] = p2;
	ll->next = ss->line;
	ss->line = ll;
}

void
check_conflict(SELECT_SET * ss,GM_TRIANGLE * t)
{
GM_TRIANGLE * t1;
	for ( ; t ; ) {
		t1 = t;
		t = t->next;
		if ( triangle_conflict(ss,t1) < 0 ) {
			t1->next = 0;
			free_gm_triangle(t1);
		}
		else {
			t1->next = ss->tri;
			ss->tri = t1;
			set_ssline(ss,t1->point[0],t1->point[1]);
			set_ssline(ss,t1->point[2],t1->point[1]);
			set_ssline(ss,t1->point[0],t1->point[2]);
		}
	}
}

XL_SEXP *
get_lisp_list(GM_TRIANGLE * tri)
{
XL_SEXP * ret,* ret1, * r1, * r2;
int i;
int name;
GM_PTR * p1;
char buf[3][10];
	ret1 = 0;
	name = 1;
	for ( ; tri ; tri = tri->next ) {
		r2 = 0;
		for ( i = 0 ; i < 3 ; i ++ ) {
			if ( tri->point[i]->name )
				continue;
			p1 = tri->point[i];
			p1->name = name++;
			sprintf(buf[0],"%i",p1->name);
			r1 = list(
				n_get_symbol("point-map"),
				n_get_string(buf[0]),
				cons(
					n_get_symbol("list"),
					p1->src),
				cons(
					n_get_symbol("list"),
					p1->dest),
				0);
			r2 = cons(r1,r2);
		}
		for ( i = 0 ; i < 3 ; i ++ )
			sprintf(buf[i],"%i",tri->point[i]->name);
		r1 = list(
			n_get_symbol("triangle-map"),
			n_get_string(buf[0]),
			n_get_string(buf[1]),
			n_get_string(buf[2]),
			0);
		ret1 = append(r2,ret1);
		ret1 = cons(r1,ret1);
	}
	ret = 0;
	for ( ; get_type(ret1) ; ret1 = cdr(ret1) )
		ret = cons(car(ret1),ret);
	return ret;
}

XL_SEXP *
gen_triangle_map(GM_PTR * ptr,GM_WORK * w)
{
GM_TRIANGLE * tri;
SELECT_SET ss;
XL_SEXP * ret;

	tri = trace_triangle(ptr,w);
	tri = sort_triangle(tri);
	ss.tri = 0;
	ss.line = 0;
	check_conflict(&ss,tri);
	ret = get_lisp_list(ss.tri);
	free_gm_triangle(ss.tri);
	free_gm_line(ss.line);
	free_gm_ptr(ptr);
	return ret;
}

XL_SEXP *
xl_GenMap(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * aa,XL_SYM_FIELD * sf)
{
XL_SEXP * point_list;
XL_SEXP * min_rect;
XL_SEXP * a,* b1, * b2;
GM_PTR * ptr, * p;
int cnt;
char num[2];
AFFEN2D af;
GB_RECT mr;
GB_POINT tr,bl;
GM_WORK w;
L_CHAR * base_unit;
COORDINATE_UNIT cu,* cup;
XL_SEXP * s_ret;
/*
if ( logout == 0 )
logout = s_open_file("foo2","w+");
*/
	w.sr = -1;
	w.dr = -1;
	for ( ; sf ; sf = sf->next ) {
		if ( l_strcmp(sf->name,l_string(std_cm,"src-r")) == 0 ) {
			sscanf(n_string(std_cm,sf->data),
				"%f",&w.sr);
		}
		else if ( l_strcmp(sf->name,l_string(std_cm,"dest-r"))
			== 0 ) {
			sscanf(n_string(std_cm,sf->data),
				"%f",&w.dr);
		}
	}

	ptr = 0;
	cnt = 0;
	point_list = get_el(s,2);
	if ( get_type(point_list) != XLT_PAIR )
		goto type_missmatch;
	for ( ; get_type(point_list) ; point_list = cdr(point_list) ) {
		if ( get_type(point_list) != XLT_PAIR )
			goto format_error;
		a = car(point_list);
		if ( list_length(a) != 2 )
			goto format_error;
		p = d_alloc(sizeof(*p));
		p->src = get_el(a,0);
		p->dest = get_el(a,1);
		if ( get_raw_gbpoint(&p->src_ptr,p->src) < 0 )
			goto type_missmatch;
		if ( get_raw_gbpoint(&p->dest_ptr,p->dest) < 0 )
			goto type_missmatch;
		p->next = 0;
		p->name = 0;

		p->next = ptr;
		ptr = p;
		cnt ++;
	}
	if ( cnt <= 2 ) {
		a = 0;
		num[1] = 0;
		num[0] = '1';
		for ( p = ptr ; p ; p = p->next ) {
			b1 = list(n_get_symbol("point-map"),
				n_get_string(num),
				cons(n_get_symbol("list"),
					p->src),
				cons(n_get_symbol("list"),
					p->dest),
				0);
			a = cons(b1,a);
			num[0] ++;
		}
		free_gm_ptr(ptr);
		return a;
	}
	min_rect = get_el(s,1);
	if ( get_type(min_rect) == XLT_NULL )
		goto next;
	if ( get_type(min_rect) != XLT_PAIR )
		goto type_missmatch;

	base_unit = get_base_unit(get_el(s,1));
	zero_c_unit(&cu);
	if ( base_unit ) {
		cu.unit = base_unit;
		cu.uenv = get_uenv(env);
		cup = &cu;
	}
	else	cup = 0;

	get_minrect(cup,&mr,min_rect);
	get_rol(&af,
		list2gbpoint(cup,ptr->src),list2gbpoint(cup,ptr->dest),
		list2gbpoint(cup,ptr->next->src),
			list2gbpoint(cup,ptr->next->dest));

	tr.x = mr.br.x;
	tr.y = mr.tl.y;
	bl.x = mr.tl.x;
	bl.y = mr.br.y;

	p = d_alloc(sizeof(*p));
	p->src_ptr = bl;
	p->dest_ptr = caffen2d(&af,bl);
	p->src = gbpoint2list(bl);
	p->dest = gbpoint2list(p->dest_ptr);
	p->next = ptr;
	p->name = 0;
	ptr = p;

	p = d_alloc(sizeof(*p));
	p->src_ptr = mr.br;
	p->dest_ptr = caffen2d(&af,mr.br);
	p->src = gbpoint2list(mr.br);
	p->dest = gbpoint2list(p->dest_ptr);
	p->next = ptr;
	p->name = 0;
	ptr = p;

	p = d_alloc(sizeof(*p));
	p->src_ptr = tr;
	p->dest_ptr = caffen2d(&af,tr);
	p->src = gbpoint2list(tr);
	p->dest = gbpoint2list(p->dest_ptr);
	p->next = ptr;
	p->name = 0;
	ptr = p;

	p = d_alloc(sizeof(*p));
	p->src_ptr = mr.tl;
	p->dest_ptr = caffen2d(&af,mr.tl);
	p->src = gbpoint2list(mr.tl);
	p->dest = gbpoint2list(p->dest_ptr);
	p->next = ptr;
	p->name = 0;
	ptr = p;


next:	
	return gen_triangle_map(ptr,&w);
format_error:
	free_gm_ptr(ptr);
	return 0;
type_missmatch:
	free_gm_ptr(ptr);
	return get_error(
		s->h.file,
		s->h.line,		
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"GenMap"),
		List(n_get_string("type missmatch"),
			-1));
}

void
init_GenMap(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"GenMap"),
		get_func_prim(xl_GenMap,FO_APPLICATIVE,0,3,3));
}
