/**********************************************************************
 
	Copyright (C) 2005- 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	"machine/include.h"
#include	"memory_debug.h"
#include	"pri_level.h"
#include	"lock_level.h"
#include	"utils.h"
#include	"task.h"
#include	"matrix.h"
#include	"xl.h"
#include	"xlerror.h"


XL_SEXP *
xl_mxTrigger(XLISP_ENV * env,XL_SEXP * s,XLISP_ENV * a,XL_SYM_FIELD * sf);

void
init_mxTrigger(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"mxTrigger"),
		get_func_prim(xl_mxTrigger,FO_APPLICATIVE,0,1,3));
}


XL_SEXP *
xl_mxTrigger(XLISP_ENV * env,XL_SEXP * s,XLISP_ENV * a,XL_SYM_FIELD * sf)
{
XL_SEXP * c;
MATRIX_TOKEN * t;
L_CHAR * _type;
INTEGER64 * dim_code;
MATRIX_NODE * n;
int err;
MATRIX * m;
XL_SEXP * ret;
INTEGER64 ** p_addr;
L_CHAR * _neturl;
L_CHAR * _filename;
L_CHAR * _key;
int access;
L_CHAR * acc;
XL_SEXP * info;
	info = 0;
	t = get_env_work(env);
	if ( t == 0 )
		return 0;
	acc = get_sf_attribute(sf,l_string(std_cm,"access"));
	if ( acc == 0 ) {
		access = t->access_target_id;
	}
	else {
		if ( l_strcmp(acc,l_string(std_cm,"MI_DEF")) == 0 )
			access = MI_DEF_TP;
		else if ( l_strcmp(acc,l_string(std_cm,"MI_FETCH_1")) == 0 )
			access = MI_FETCH_1_TP;
		else if ( l_strcmp(acc,l_string(std_cm,"MI_FETCH_2")) == 0 )
			access = MI_FETCH_2_TP;
		else if ( l_strcmp(acc,l_string(std_cm,"MI_EDIT_1")) == 0 )
			access = MI_EDIT_1_TP;
		else if ( l_strcmp(acc,l_string(std_cm,"MI_EDIT_2")) == 0 )
			access = MI_EDIT_2_TP;
		else if ( l_strcmp(acc,l_string(std_cm,"MI_VISU_1")) == 0 )
			access = MI_VISU_1_TP;
		else if ( l_strcmp(acc,l_string(std_cm,"MI_VISU_2")) == 0 )
			access = MI_VISU_2_TP;
		else	goto inv_param;
	}


	_type = get_sf_attribute(sf,l_string(std_cm,"type"));
	dim_code = copy_dim_code(t->process_node->matrix,
				 t->process_node->dim_code);
	m = t->process_node->matrix;
	if ( _type == 0 ) {
		goto me;
	}
	else if ( l_strcmp(_type,l_string(std_cm,"me")) == 0 ) {
	me:
		n = t->process_node;
		matrix_trigger_access(n,access,1);
	}
	else if ( l_strcmp(_type,l_string(std_cm,"parent")) == 0 ) {
		dim_code[0] ++;
		if ( dim_code[0] >= 
				t->process_node->matrix->total_levels ) {
			d_f_ree(dim_code);
			dim_code = 0;
			n = 0;
			return 0;
		}
		else {
			err = 0;
			n = get_matrix_node(&err,m,dim_code,
					GN_NODE_CREATE,t);
			info = get_sexp_from_dim_code(m,dim_code);
			d_f_ree(dim_code);
			if ( err != 0 )
				return matrix_error("mxTrigger",
						s,AME_TRAP,info);
			if ( n )
				matrix_trigger_access(n,access,1);
		}
	}
	else if ( l_strcmp(_type,l_string(std_cm,"children")) == 0 ) {
		n = t->process_node;
		if ( n->nlist_dim_addr ) {
			ret = 0;
			for ( p_addr = n->nlist_dim_addr ; *p_addr ; 
			      		p_addr ++ ) {
				dim_code = *p_addr;
				err = 0;
				n = get_matrix_node(&err,m,dim_code,
					GN_NODE_CREATE,t);
				info = get_sexp_from_dim_code(m,dim_code);
				if ( err != 0 )
					return matrix_error("mxTrigger",
							s,AME_TRAP,info);
				if ( n )
					matrix_trigger_access(n,access,1);
			}
			return 0;
		}
		else {
			return 0;
		}
	}
	else if ( l_strcmp(_type,l_string(std_cm,"matrix")) == 0 ) {
		_neturl = get_sf_attribute(sf,l_string(std_cm,"neturl"));
		_filename = get_sf_attribute(sf,l_string(std_cm,"filename"));
		_key = get_sf_attribute(sf,l_string(std_cm,"key"));
	retry:
		err = 0;
		m = search_matrix(&err,_neturl,_filename,_key,t);
		switch ( err ) {
		case ME_PROC_NODE:
			return matrix_error("mxTrigger",s,AME_TRAP,0);
		case ME_NO_NODE:
			open_matrix(_neturl,_filename,_key,
					t->process_node->matrix->p.open_method,0);
			goto retry;
		case ME_ERROR:
			goto matrix_err;
		default:
			er_panic("mxTrigger");
		}
		c = get_el(s,1);
		if ( get_type(c) != XLT_PAIR )
			goto type_missmatch;
		dim_code = get_dim_code_from_sexp(c);
		err = 0;
		n = get_matrix_node(&err,m,dim_code,GN_NODE_CREATE,t);
		info = get_sexp_from_dim_code(m,dim_code);
		d_f_ree(dim_code);
		if ( err != 0 )
			return matrix_error("mxTrigger",s,AME_TRAP,info);
		if ( n )
			matrix_trigger_access(n,access,1);
	}
	else {
		c = get_el(s,1);
		if ( get_type(c) != XLT_PAIR )
			goto type_missmatch;
		dim_code = get_dim_code_from_sexp(c);
		err = 0;
		n = get_matrix_node(&err,m,dim_code,GN_NODE_CREATE,t);
		info = get_sexp_from_dim_code(m,dim_code);
		d_f_ree(dim_code);
		if ( err != 0 )
			return matrix_error("mxTrigger",s,AME_TRAP,info);
		if ( n )
			matrix_trigger_access(n,access,1);
	}
	return 0;
	
type_missmatch:

	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"mxTrigger"),
		0);
inv_param:

	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"mxTrigger"),
		n_get_string("invalid parameter in mxTrigger"));
matrix_err:

	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_OBJECT,
		l_string(std_cm,"mxTrigger"),
		n_get_string("invalid matrix loading"));
}





