/**********************************************************************
 
	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	<fcntl.h>
#include	<stdio.h>
#include	<stdlib.h>
#include	<sys/types.h>
#include	"machine/include.h"
#include	"memory_debug.h"
#include	"memory_routine.h"
#include	"win_flame.h"
#include	"xlerror.h"
#include	"xl.h"
#include	"machine/param_gbview.h"
#include	"lock_level.h"
#include	"proxy.h"
#include	"rcache.h"

extern char* http_client;
extern int fontsize;
extern int default_dgb_pixel;

XL_SEXP * setup_initial_query;

void gc_gb_sexp(XL_SEXP * p);
void loading_file(L_CHAR *, L_CHAR *,int);

void
gc_setup()
{
	gc_gb_sexp(setup_initial_query);
}


XL_SEXP *
gv_default_dgb_pixels(XLISP_ENV * env,XL_SEXP * s)
{
XL_SEXP * px;
	px = get_el(s,1);
	if ( get_type(px) != XLT_INTEGER )
		goto type_missmatch;
	default_dgb_pixel = px->integer.data;
	return 0;
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"default-dgb-pixels"),
		list(	n_get_string(
		"type missmatch"),
			0));
}

XL_SEXP *
initial_query(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a,XL_SYM_FIELD * sf)
{
L_CHAR * opt;
	opt = get_sf_attribute(sf,l_string(std_cm,"dontoverwrite"));
	if ( opt && setup_initial_query )
		return n_get_string("ignore");
	setup_initial_query = 
		gb_quote_trace(env,get_el(s,1),
			get_sf_attribute(sf,l_string(std_cm,"type")));
	return 0;
}

XL_SEXP *
get_initial_query(XLISP_ENV * env,XL_SEXP * s)
{
	return setup_initial_query;
}

XL_SEXP *
image_enhancement(XLISP_ENV * e,XL_SEXP * s)
{
	return 0;
}


XL_SEXP *
window_size(XLISP_ENV * e,XL_SEXP * s)
{
XL_SEXP * width,*height;
int i;
GBVIEW_STATUS sts;
	wf_init_status(&sts);
	width = eval(e,get_el(s,1));
	switch ( get_type(width) ) {
	case XLT_FLOAT:
		sts.width = width->floating.data;
		break;
	case XLT_INTEGER:
		sts.width = width->integer.data;
		break;
	default:
		sts.width = 400;
	}
	height = eval(e,get_el(s,2));
	switch ( get_type(height) ) {
	case XLT_FLOAT:
		sts.height = height->floating.data;
		break;
	case XLT_INTEGER:
		sts.height = height->integer.data;
		break;
	default:
		sts.height = 400;
	}
	sts.flags = SF_WIDTH|SF_HEIGHT;
	wf_set_status(wf_next_gf(0,GVFM_LIVE),&sts);
/* init GBVIEW_FLAME
	env.redraw = d_alloc(env.win_height*env.win_width);
	for ( i = 0 ; i < env.win_height*env.win_width ; i ++ )
		env.redraw[i] = RP_REDRAW;
	env.redraw_plane 
		= d_alloc(env.win_height*env.win_width*sizeof(long));
*/
	return 0;
}

XL_SEXP *
font_size(XLISP_ENV * e,XL_SEXP * s,XLISP_ENV * a,XL_SYM_FIELD * sf)
{
XL_SEXP * fsize;
int i;
L_CHAR * d;
char * dd;
	d = get_sf_attribute(sf,l_string(std_cm,"displaykey"));
	if ( d ) {
		dd = ln_copy_str(std_cm,d);
		v_set_display_key(dd);
		d_f_ree(dd);
	}
	fsize = eval(e,get_el(s,1));
	switch ( get_type(fsize) ) {
	case XLT_FLOAT:
		fontsize = fsize->floating.data;
		break;
	case XLT_INTEGER:
		fontsize = fsize->integer.data;
		break;
	default:
		goto typemissmatch;
	}
	return 0;

typemissmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"font-size"),
		list(	n_get_string(
		"type missmatch"),
			0));
}


XL_SEXP *
overlay_transparent(URL * u,XLISP_ENV * e,XL_SEXP * s)
{
XL_SEXP * percent;
REAL1 p;
OVERLAY * ov;
void ovf_transparent();

	percent = eval(e,get_el(s,3));
	switch ( get_type(percent) ) {
	case XLT_ERROR:
		return percent;
	case XLT_INTEGER:
		p = percent->integer.data;
		break;
	case XLT_FLOAT:
		p = percent->floating.data;
		break;
	default:
		goto typemissmatch;
	}
	ov = new_overlay(OVT_TRANSPARENT,u);
	ov->h.filter = ovf_transparent;
	ov->t.rate = p/100;
	return 0;
	
typemissmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"overlay"),
		list(	n_get_string(
		"type missmatch"),
			0));
}

XL_SEXP *
overlay_csuperinpose(URL * u,XLISP_ENV * e,XL_SEXP * s)
{
XL_SEXP * percent,* key_s,* key_r_s,* inp_r_s;
REAL1 p;
unsigned long key;
int key_radius,inpose_radius;
OVERLAY * ov;
void ovf_csuperinpose();
int i;
	percent = eval(e,get_el(s,3));
	switch ( get_type(percent) ) {
	case XLT_ERROR:
		return percent;
	case XLT_INTEGER:
		p = percent->integer.data;
		break;
	case XLT_FLOAT:
		p = percent->floating.data;
		break;
	default:
		goto typemissmatch;
	}
	key_s = eval(e,get_el(s,4));
	switch ( get_type(key_s) ) {
	case XLT_ERROR:
		return key_s;
	case XLT_INTEGER:
		key = key_s->integer.data;
		break;
	default:
		goto typemissmatch;
	}
	key_r_s = eval(e,get_el(s,5));
	switch ( get_type(key_r_s) ) {
	case XLT_ERROR:
		return key_r_s;
	case XLT_INTEGER:
		key_radius = key_r_s->integer.data;
		break;
	default:
		goto typemissmatch;
	}
	inp_r_s = eval(e,get_el(s,6));
	switch ( get_type(inp_r_s) ) {
	case XLT_ERROR:
		return inp_r_s;
	case XLT_INTEGER:
		inpose_radius = inp_r_s->integer.data;
		break;
	default:
		goto typemissmatch;
	}
	ov = new_overlay(OVT_TRANSPARENT,u);
	ov->h.filter = ovf_csuperinpose;
	ov->cs.rate = p/100;
	for ( i = 0 ; i < 3 ; i ++ )
		ov->cs.key[i] = ((key>>(8*i))&0xff)<<(COL_BIT-8);
	ov->cs.key_radius = key_radius<<(COL_BIT-8);
	ov->cs.inpose_radius = inpose_radius<<(COL_BIT-8);
	return 0;
	
typemissmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"overlay"),
		list(	n_get_string(
		"type missmatch"),
			0));
}

XL_SEXP *
overlay(XLISP_ENV * e,XL_SEXP * s)
{
XL_SEXP * coord_name;
XL_SEXP * type;
int inv_par;
URL url_buf;
XL_SEXP * ret;
	coord_name = eval(e,get_el(s,1));
	switch ( get_type(coord_name) ) {
	case XLT_ERROR:
		return coord_name;
	case XLT_STRING:
		break;
	default:
		goto typemissmatch;
	}
	type = eval(e,get_el(s,2));
	switch ( get_type(type) ) {
	case XLT_ERROR:
		return type;
	case XLT_STRING:
		break;
	default:
		goto typemissmatch;
	}
	get_url2(&url_buf,coord_name->string.data);
	if ( l_strcmp(type->string.data,l_string(std_cm,"transparent")) == 0 )
	  			{
		ret = overlay_transparent(&url_buf,e,s);
	}
	else if ( l_strcmp(type->string.data,l_string(std_cm,"csuperinpose"))
				== 0 ) {
		ret = overlay_csuperinpose(&url_buf,e,s);
	}
	else {
		inv_par = 3;
		free_url(&url_buf);
		goto invpar;
	}
	free_url(&url_buf);
	return ret;

typemissmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"overlay"),
		list(	n_get_string(
		"type missmatch"),
			0));
invpar:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"overlay"),
		list(	n_get_string(
		"invalid argments for"),
			get_integer(inv_par,0),
			0));
}

/*
(indicate "coordinate"/"objects" url[string])
*/

XL_SEXP * 
indicate(XLISP_ENV * e,XL_SEXP * s)
{
XL_SEXP * type;
XL_SEXP * name;
URL i_url;
int flags;

	flags = 0; 
	type = eval(e,get_el(s,1));
	switch ( get_type(type) ) {
	case XLT_ERROR:
		return type;
	case XLT_STRING:
		break;
	}
	name = eval(e,get_el(s,2));
	switch ( get_type(name) ) {
	case XLT_ERROR:
		return name;
	case XLT_STRING:
		break;
	default:
		goto typemissmatch;
	}
	if ( l_strcmp(type->string.data,l_string(std_cm,"coordinate")) == 0 )
		flags |= IF_COORDINATE;
	else if ( l_strcmp(type->string.data,l_string(std_cm,"object")) == 0 )
		flags |= IF_OBJECT;
	else 	goto typemissmatch;

	get_url2(&i_url,name->string.data);
	set_pointer_indicate(wf_next_gf(0,GVFM_LIVE),flags,&i_url);

	free_url(&i_url);
	return 0;
typemissmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"indicate"),
		list(	n_get_string(
		"type missmatch"),
			0));
}

XL_SEXP * 
set_http_client(XLISP_ENV * e,XL_SEXP * s)
{
XL_SEXP * name;
INDICATE * in, ** inp;
	name = eval(e,get_el(s,1));
	switch ( get_type(name) ) {
	case XLT_ERROR:
		return name;
	case XLT_STRING:
		break;
	default:
		goto typemissmatch;
	}
	http_client = ln_copy_str(std_cm,name->string.data);
	return 0;
typemissmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"set-http-client"),
		list(	n_get_string(
		"type missmatch"),
			0));
}

XL_SEXP *
xl_set_cache(XLISP_ENV * env,XL_SEXP * s,XLISP_ENV * a,XL_SYM_FIELD * sf)
{
L_CHAR * _resource,* _routing;
int flags;
	_resource = get_sf_attribute(
				sf,
				l_string(std_cm,"resource"));
	_routing = get_sf_attribute(
				sf,
				l_string(std_cm,"routing"));
	flags = get_rcache_flags();
	if ( _resource ) {
		flags &= ~RCF_RESOURCE_MASK;
		if ( l_strcmp(_resource,l_string(std_cm,"off")) == 0 ) {
		}
		else if ( l_strcmp(_resource,l_string(std_cm,"w")) == 0 ) {
			flags |= RCF_RESOURCE;
		}
		else if ( l_strcmp(_resource,l_string(std_cm,"r/w")) == 0 ) {
			flags |= RCF_RESOURCE|RCF_RESOURCE_READ;
		}
		else	goto err;
	}
	if ( _routing ) {
		flags &= ~RCF_ROUTING_MASK;
		if ( l_strcmp(_routing,l_string(std_cm,"off")) == 0 ) {
		}
		else if ( l_strcmp(_routing,l_string(std_cm,"w")) == 0 ) {
			flags |= RCF_ROUTING;
		}
		else if ( l_strcmp(_routing,l_string(std_cm,"r/w")) == 0 ) {
			flags |= RCF_ROUTING|RCF_ROUTING_READ;
		}
		else 	goto err;
	}
	enable_rcache(flags);
	return 0;
err:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"gv-set-cache"),
		list(	n_get_string(
		"invalid attribute"),
			0));

}


XL_SEXP *
xl_get_cache(XLISP_ENV * env,XL_SEXP * s)
{
int flags;
XL_SEXP * _routing, * _resource;
	flags = get_rcache_flags();
	if ( flags & RCF_ROUTING_READ ) {
		_routing = n_get_string("r/w");
	}
	else if ( flags & RCF_ROUTING ) {
		_routing = n_get_string("w");
	}
	else {
		_routing = n_get_string("off");
	}
	if ( flags & RCF_RESOURCE_READ ) {
		_resource = n_get_string("r/w");
	}
	else if ( flags & RCF_RESOURCE ) {
		_resource = n_get_string("w");
	}
	else {
		_resource = n_get_string("off");
	}
	return List(
		n_get_symbol("cache"),
		List(n_get_symbol("routing"),
			_routing,
			-1),
		List(n_get_symbol("resource"),
			_resource,
			-1),
		-1);
}


XL_SEXP *
xl_status_param(XLISP_ENV * env,XL_SEXP * s)
{
char * file;
STREAM * st;
	file = d_alloc(100);
	sprintf(file,"%s%s",get_preference_path(),GBVIEW_PARAM);
	st = s_open_file(file,O_RDONLY);
	d_f_ree(file);
	return cons(get_symbol(l_string(std_cm,"preference")),
		init_parse(st,l_string(std_cm,"gbview parameter file"),0));
}



void
write_proxy_server_list(STREAM * st,XL_SEXP * sl)
{
XL_SEXP * server_type;
XL_SEXP * server_name;
	server_type = get_el(sl,1);
	server_name = get_el(sl,2);
	s_printf(st,"<SetProxy type=\"%ls\" direct=\"%ls\"/>\n",
		server_type->string.data,
		server_name->string.data);
}

void
write_proxy_info(STREAM * st)
{
XL_SEXP * ret;
XL_SEXP * type,* server, * port;
XL_SEXP * sl;
	gc_push(0,0,"write_proxy");
	ret = get_proxyinfo();
	type = get_el(ret,1);
	if ( l_strcmp(type->string.data,
			l_string(std_cm,"NoProxy")) == 0 ) {
		gc_pop(0,0);
		return;
	}
	server = get_el(ret,2);
	port = get_el(ret,3);

	s_printf(st,"<SetProxy type=\"%ls\" server=\"%ls\" port=\"%i\"/>\n",
		type->string.data,
		server->string.data,
		port->integer.data);

	sl = cdr(cdr(cdr(cdr(ret))));

	for ( ; get_type(sl) == XLT_PAIR ; sl = cdr(sl) )
		write_proxy_server_list(st,car(sl));

	gc_pop(0,0);
}

void
write_native_proxy_server_list(STREAM * st,XL_SEXP * sl)
{
XL_SEXP * server_type;
XL_SEXP * server_name;
	server_type = get_el(sl,1);
	server_name = get_el(sl,2);
	s_printf(st,"<SetNativeProxy type=\"%ls\" direct=\"%ls\"/>\n",
		server_type->string.data,
		server_name->string.data);
}

void
write_native_proxy_info(STREAM * st)
{
XL_SEXP * ret;
XL_SEXP * type,* server, * port;
XL_SEXP * sl;
	gc_push(0,0,"write_proxy");
	ret = get_native_proxyinfo();
	type = get_el(ret,1);
	if ( l_strcmp(type->string.data,
			l_string(std_cm,"NoProxy")) == 0 ) {
		gc_pop(0,0);
		return;
	}
	server = get_el(ret,2);
	port = get_el(ret,3);

	s_printf(st,"<SetNativeProxy type=\"%ls\" server=\"%ls\" port=\"%i\"/>\n",
		type->string.data,
		server->string.data,
		port->integer.data);

	sl = cdr(cdr(cdr(cdr(ret))));

	for ( ; get_type(sl) == XLT_PAIR ; sl = cdr(sl) )
		write_native_proxy_server_list(st,car(sl));

	gc_pop(0,0);
}

void
write_cache_info(STREAM * st)
{
int flags;
char * _resource, * _routing;
	flags = get_rcache_flags();
	if ( flags & RCF_RESOURCE_READ ) {
		_resource = "r/w";
	}
	else if ( flags & RCF_RESOURCE ) {
		_resource = "w";
	}
	else {
		_resource = "off";
	}
	if ( flags & RCF_ROUTING_READ ) {
		_routing = "r/w";
	}
	else if ( flags & RCF_ROUTING ) {
		_routing = "w";
	}
	else {
		_routing = "off";
	}
	s_printf(st,"<gv-set-cache routing=\"%s\" resource = \"%s\"/>\n",
		_routing,
		_resource);
}

XL_SEXP *
xl_write_status(XLISP_ENV * e,XL_SEXP * s)
{
char * file;
STREAM * st;
GBVIEW_STATUS sts;

	wf_status(wf_next_gf(0,GVFS_ACTIVE),&sts);

	file = d_alloc(100);
	sprintf(file,"%s%s",get_preference_path(),GBVIEW_PARAM);
	st = s_open_file(file,O_RDWR|O_CREAT|O_TRUNC);
	d_f_ree(file);


	s_printf(st,"<?xl version=\"0.1\" encoding=\"UTF-8\"?>\n");
	s_printf(st,"<Env0 type=\"raw\">\n");
	s_printf(st,"<Define> ^gb-ns xlp://isjhp1.nichibun.ac.jp:8080/gb_metadata\n");
	s_printf(st,"</Define>\n");
	s_printf(st,"</Env0>\n\n");
	s_printf(st,"<gv-resource rid=\"4\">\n");

	write_proxy_info(st);
	write_native_proxy_info(st);
	write_cache_info(st);

	s_printf(st,"<initial-query type=\"direct\">\n");
	print_sexp(st,setup_initial_query,PF_XML|PF_INDENT);
	s_printf(st,"\n</initial-query>\n");

	s_printf(st,"<window-size>%i %i </window-size>\n",
		sts.width,sts.height);
/*
	s_printf(st,"<http-client>%s </http-client>\n",http_client);
*/

	s_printf(st,"</gv-resource>\n\n");

	s_close(st);
	wf_free_status(&sts);

	return 0;
}

XL_SEXP *
xl_reset_status(XLISP_ENV * e,XL_SEXP * s)
{
STREAM * st;
char * file;

	file = d_alloc(100);
	sprintf(file,"%s%s",get_preference_path(),GBVIEW_PARAM);
	u_mkdir(get_preference_path(),0700);
	st = s_open_file(file,
		O_RDWR|O_CREAT|O_TRUNC,0644);
	d_f_ree(file);
	init_param_script(st);
	s_close(st);

	loading_file(0,l_string(std_cm,"local"),1);
	return 0;
}


void
init_init()
{
XLISP_ENV * e;
int i;
	e = new_env(gblisp_top_env1);
	set_env(e,l_string(std_cm,"initial-query"),
		get_func_prim(initial_query,FO_NORMAL,0,2,2));
	set_env(e,l_string(std_cm,"get-initial-query"),
		get_func_prim(get_initial_query,FO_NORMAL,0,1,1));
	set_env(e,l_string(std_cm,"window-size"),
		get_func_prim(window_size,FO_NORMAL,0,3,3));
	set_env(e,l_string(std_cm,"font-size"),
		get_func_prim(font_size,FO_NORMAL,0,2,2));
	set_env(e,l_string(std_cm,"image-enhancement"),
		get_func_prim(image_enhancement,FO_NORMAL,0,3,3));
	set_env(e,l_string(std_cm,"overlay"),
		get_func_prim(overlay,FO_NORMAL,0,3,-1));
	set_env(gblisp_top_env0,l_string(std_cm,"indicate"),
		get_func_prim(indicate,FO_NORMAL,0,3,3));
	set_env(e,l_string(std_cm,"http-client"),
		get_func_prim(set_http_client,FO_NORMAL,0,2,2));
	set_env(e,l_string(std_cm,"gv-resource-status"),
		get_func_prim(xl_status_param,FO_APPLICATIVE,0,1,1));
	set_env(e,l_string(std_cm,"default-dgb-pixels"),
		get_func_prim(gv_default_dgb_pixels,
			FO_APPLICATIVE,0,2,2));
	set_env(e,l_string(std_cm,"gv-set-status"),
		get_func_prim(xl_write_status,
			FO_APPLICATIVE,0,1,1));
	set_env(e,l_string(std_cm,"gv-reset-status"),
		get_func_prim(xl_reset_status,
			FO_APPLICATIVE,0,1,1));
	set_env(e,l_string(std_cm,"gv-set-cache"),
		get_func_prim(xl_set_cache,
			FO_APPLICATIVE,0,1,1));
	set_env(e,l_string(std_cm,"gv-get-cache"),
		get_func_prim(xl_get_cache,
			FO_APPLICATIVE,0,1,1));

	set_gv_sp_resource(RID_INIT,e);

	init_gv_resource_option(gblisp_top_env0);

	init_gv_goto_point(gblisp_top_env0);

	init_style();

	init_gv_cpu(gblisp_top_env0);
}


void
init_gbview()
{
XL_SEXP * s;
XL_SEXP * r, * ret;
int len;
STREAM * st;
 
	init_resource(); 
	init_init();
	init_obj_memory();
	init_draw_gb();
	init_luster_r64();

}

XL_SEXP *
loading_from_network(L_CHAR * url, XLISP_ENV * e)
{
URL u;
int ses;
XL_SEXP * ret, * lst;
	if ( get_url2(&u, url) < 0 ) {
		return get_error(
			0,0,
			XLE_PROTO_INV_PARAM,
			l_string(std_cm,"loading-from-network"),
			list(n_get_string("cannot access"),get_string(url),0));
	}

	gc_push(0,0,"loading_from_network");
	ses = open_session(SEST_OPTIMIZE);
	lst = remote_session(
		gblisp_top_env0,
		ses,
		&u,
		l_string(std_cm,"standard"),
		l_string(std_cm,"user"),
		l_string(std_cm,"Get"),
		List(
			List(n_get_symbol("Get"),
				List(n_get_symbol("+"), 
					get_string(u.db),
					get_string(u.resource),
					-1),
				-1),
			-1),
		0,0,1);
	close_session(ses);
	free_url(&u);
	if ( get_type(lst) == XLT_ERROR ) {
		ret = lst;
		goto end;
	}
	for ( ; get_type(lst) == XLT_PAIR ; lst = cdr(lst) ) {
		ret = eval(e,car(lst));
		if ( get_type(ret) == XLT_ERROR ) {
			goto end;
		}
	}
	ret = 0;
end:
	gc_pop(ret,gc_gb_sexp);
	return ret;
}

void
open_control_port()
{
char * file;
int port;
XL_INTERPRETER * xli;
XL_SEXP * ret, * lst;
STREAM * st;

	gc_push(0,0,"open_control_port");

	file = d_alloc(1000);

	port = 9102 + (get_xltime() % (10000 - 9102));
	for ( ; ; ) {
		if ( port > 10000 )
			port = 9102;
		ret = eval(gblisp_top_env1,
			List(n_get_symbol("OpenInterpreter"),
				n_get_string("accept"),
				n_get_symbol("Env0"),
				List(n_get_symbol("Port"),
					get_integer(port,0),
					-1),
				List(n_get_symbol("MaxConnection"),
					get_integer(10,0),
					-1),
				List(n_get_symbol("Permission"),
					List(n_get_symbol("List"),
						n_get_string("user"),
						n_get_string("root"),
						-1),
					List(n_get_symbol("Allow"),
						n_get_string("domain"),
						n_get_string("localhost"),
						-1),
					List(n_get_symbol("Allow"),
						n_get_string("ip"),
						n_get_string("127.0.0.1"),
						n_get_string
							("255.255.255.255"),
						-1),
					List(n_get_symbol("Deny"),
						n_get_string("all"),
						-1),
					-1),
				-1));
		if ( get_type(ret) != XLT_ERROR )
			break;
		port ++;
	}

	sprintf(file,"%sgbview.ap",get_preference_path());

	st = s_open_file(file,O_CREAT|O_TRUNC|O_RDWR,0644);

	if ( st == 0 ) {
		fprintf(stderr,"cannot open the file %s\n",file);
	}
	else {
		s_printf(st,"<port> %i </port>\n",port);
		s_printf(st,"<pid> %i </pid>\n",getpid());
		s_close(st);
	}

	d_f_ree(file);
	gc_pop(0,0);
}


void
load_parameter(L_CHAR * parameter, int initialize_on_err)
{
char * file;
L_CHAR * file_l;
XLISP_ENV * e;
XL_SEXP * ret;
STREAM * st;
	
	gc_push(0,0,"load_parameter");
	
	e = new_env(gblisp_top_env1);
	file = d_alloc(1000);

	if ( parameter && l_strcmp(parameter, l_string(std_cm,"local")) != 0 ) {
		ret = loading_from_network(parameter, e);
		if ( get_type(ret) == XLT_ERROR ) {
			print_sexp(s_stdout,ret,0);
			s_printf(s_stdout,"\n");
			exit(1);
		}
		goto end;
	}
	
	sprintf(file,"%s%s",get_preference_path(),GBVIEW_PARAM);
printf("!!!!!!!!!! %s\n",file);
	file_l = l_string(std_cm,file);
	ret = load_file(e,0,2,file_l,0,0,0,0,0);
	if ( get_type(ret) != XLT_ERROR )
		goto end;
fflush(stdout);
ss_printf("ERROR :: ");
print_sexp(s_stdout,ret,0);
ss_printf("\n");
	if ( ! initialize_on_err ) {
		print_sexp(s_stdout,ret,0);
		s_printf(s_stdout,"\n");
		fprintf(stderr,"error in the preference file %s\n",
				file);
		exit(1);
	}
	u_mkdir(get_preference_path(),0700);
	st = s_open_file(file,
		O_RDWR|O_CREAT|O_TRUNC,0644);
	init_param_script(st);
	s_close(st);
	ret = load_file(e,0,2,l_string(std_cm,file),0,0,0,0,0);
	if ( get_type(ret) == XLT_ERROR ) {
		print_sexp(s_stdout,ret,0);
		s_printf(s_stdout,"\n");
		fprintf(stderr,"cannot open the preference file %s\n",
				file);
		exit(1);
	}
end:
	d_f_ree(file);
	gc_pop(0,0);
}


void
load_peripheral(L_CHAR * peripheral) {
char * file;
STREAM * st;
XLISP_ENV * env;
XL_SEXP * lst, * ret;
DIR * dd;
struct dirent * d;

	/* setup peripheral path ( ./peripheral/* ) */

	if ( peripheral == 0 )
		return;

	gc_push(0,0,"load_peripheral");

	env = new_env(gblisp_top_env1);
	file = d_alloc(1000);

	if ( l_strcmp(peripheral, l_string(std_cm, "local")) != 0 ) {
		ret = loading_from_network(peripheral, env);
		if ( get_type(ret) == XLT_ERROR ) {
			print_sexp(s_stdout,ret,0);
			s_printf(s_stdout,"\n");
			exit(1);
		}
	} else {
		dd = u_opendir(get_peripheral_path());
		if ( dd == 0 ) {
			fprintf(stderr,"cannot open the path %s\n",
				get_peripheral_path());
			perror("");
			exit(1);
		}

		for ( ; ; ) {
			d = u_readdir(dd);
			if ( d == 0 )
				break;
			if ( d->d_name[0] == '.' )
				continue;

			if ( d->d_name[strlen(d->d_name)-1] == '~' )
				continue;

			sprintf(file,"%s%s",get_peripheral_path(),d->d_name);
			env = new_env(gblisp_top_env1);
			lst = load_file(env,0,2,l_string(std_cm,file),0,0,0,0,0);
			for ( ; get_type(lst) == XLT_PAIR ; lst = cdr(lst) ) {
				gc_push(0,0,"loop2");
				ret = eval(env,car(lst));
				if ( get_type(ret) == XLT_ERROR ) {
					print_sexp(s_stderr,ret,0);
					s_printf(s_stderr,"\n");
					closedir(dd);
					exit(1);
				}
				gc_pop(0,0);
			}
		}

		closedir(dd);

	}
end:
	d_f_ree(file);
	gc_pop(0,0);
}

void
loading_file(
	L_CHAR *	parameter1,
	L_CHAR *	peripheral1,
	int		initailize_on_err)
{
XL_INTERPRETER * xli;
char * file;
int pid;
extern char preference_script[];
extern int preference_script_length;
L_CHAR * parameter = 0, * peripheral = 0;
	
	if ( parameter1 )
		parameter = ll_copy_str(parameter1);
	if ( peripheral1 )
		peripheral = ll_copy_str(peripheral1);

	/* setup preference path (gbview.param / gbview.ap) */

	file = d_alloc(1000);
	pid = getpid();
	sprintf(file,"%s",get_preference_path());
	set_env(gblisp_top_env1,l_string(std_cm,"gv-initdir"),
				n_get_string(file));
	set_env(gblisp_top_env1,l_string(std_cm,"gv-selfpid"),
				get_integer(pid,0));
	d_f_ree(file);

	load_parameter(parameter, initailize_on_err);
	load_peripheral(peripheral);
	
	if ( parameter )
		d_f_ree(parameter);
	if ( peripheral )
		d_f_ree(peripheral);
}

