/**********************************************************************
 
	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"
#include	"memory_routine.h"
#include	"change_endian.h"

XL_SEXP *
xl_mxSquash(XLISP_ENV * env,XL_SEXP * s,XLISP_ENV * a,XL_SYM_FIELD * sf);
void * mx_glay_compress_1(int * ,MATRIX_DH_SET * d1);
void * mx_glay_compress_2(int * ,MATRIX_DH_SET * d1);
void * mx_jpeg_compress_1(int * ,MATRIX_DH_SET * d1);
void * mx_jpeg_compress_2(int * ,MATRIX_DH_SET * d1);

void
init_mxSquash(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"mxSquash"),
		get_func_prim(xl_mxSquash,FO_APPLICATIVE,0,2,4));
}



XL_SEXP *
xl_mxSquash(XLISP_ENV * env,XL_SEXP * s,XLISP_ENV * a,XL_SYM_FIELD * sf)
{
void * d1, * sq;
MATRIX_TOKEN * t;
XL_SEXP * ret;

char * ptr;

XL_SEXP * inp, * value;
MATRIX_DH_SET ds;

int * start_ofs;
int * ix;
int * inc;
int * ix_size;
MATRIX * m;
int i;
XL_SEXP * pp;
int cpy;
int el_size;

	cpy = 0;
	start_ofs = ix = inc = ix_size = 0;

	t = get_env_work(env);
	if ( t == 0 )
		return 0;

	inp = get_el(s,1);

retry:
	switch ( get_type(inp) ) {
	case XLT_PAIR:
		inp = get_el(inp,2);
		goto retry;
	case XLT_PTR:
	case XLT_RAW:
		d1 = get_vdata_from_sexp(inp);

		if ( d1 == 0 )
			goto inv_param;
		ds.hd = d1;
		if ( (ds.hd->type & MDT_VECTOR) != MDT_VECTOR )
			goto inv_param;
		get_matrix_dh_set(&ds,d1);
		d1 = (*ds.tp->alloc_copy)(ds.tp,d1,MD_MMALLOC,0);
		get_matrix_dh_set(&ds,d1);
		break;
	default:
		goto type_missmatch;
	}
	
	m = t->process_node->matrix;
	start_ofs = d_alloc(m->p.dim*sizeof(int));
	memset(start_ofs,0,sizeof(int)*m->p.dim);
	sq = 0;

	if ( list_length(s) < 3 )
		goto next;
	value = get_el(s,2);
	sq = (*ds.tp->parent->sexp2md)(&cpy,ds.tp,value);
	if ( sq == 0 )
		goto inv_param;
	if ( list_length(s) < 4 )
		goto next;
	
	pp = get_el(s,3);
	for ( i = 0 ; i < m->p.dim && get_type(pp) == XLT_PAIR ; i ++ ) {
		inp = car(pp);
		if ( get_type(inp) != XLT_INTEGER )
			goto inv_param;
		start_ofs[i] = inp->integer.data;
		pp = cdr(pp);
	}
next:
	ix = d_alloc(m->p.dim*sizeof(int));
	inc = d_alloc(m->p.dim*sizeof(int));
	ix_size = ds.ix;
	for ( i = 0 ; i < m->p.dim ; i ++ ) {
		ix[i] = start_ofs[i];
		inc[i] = 1<<m->dim_divide[i];
	}
	ptr = ds.offset;
	el_size = (*ds.tp->parent->get_size)(ds.tp->parent,0);
	for ( ; ; ) {
		if ( sq )
			memcpy(ptr + get_seq_from_ix(ix,ix_size,m->p.dim) * el_size,
					sq,el_size);
		else	(*ds.tp->parent->get_zero)(
				ds.tp->parent,
				ptr + get_seq_from_ix(ix,ix_size,m->p.dim) * el_size);
		if ( inc_ix(ix,start_ofs,inc,ix_size,m->p.dim) )
			break;
	}

	goto end;

type_missmatch:
	ret = get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"mxSquash"),
		0);
	goto end;

inv_param:
	ret = get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"mxSquash"),
		n_get_string("invalid parameter in mxSquash"));
	goto end;
end:
	if ( cpy )
		(*ds.tp->parent->free_data)(
			ds.tp->parent,sq);
	if ( ix )
		d_f_ree(ix);
	if ( inc )
		d_f_ree(inc);
	return ret;
}





