/**********************************************************************
 
	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	"memory_routine.h"
#include	"memory_debug.h"
#include	"xlerror.h"
#include	"xl.h"
#include	"gbgraph.h"
#include	"r64.h"

XL_SEXP * r64_Get();
void gc_text();

void
init_r64_Get(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"Get"),
		get_func_prim(r64_Get,FO_APPLICATIVE,0,4,5));
}


XL_SEXP *
load_r64file(XLISP_ENV * env,XL_SEXP * s,L_CHAR * file)
{
XL_SEXP * lev;
XL_SEXP * rec;
int _lev;
I_RECT r;
R64_FILE * f;
unsigned char * raw;
unsigned char * ptr;
int colsize;
int x,y,size;

	lev = get_el(s,2);
	if ( get_type(lev) != XLT_INTEGER )
		goto type_missmatch;
	_lev = lev->integer.data;
	rec = get_el(s,3);
	if ( i_rect_type(rec) )
		goto type_missmatch;
	r = xl_to_i_rect(rec);
	f = r64_open_file(n_string(std_cm,file),O_RDONLY,0644,
		'P',0,0);
	if ( f == 0 )
		return get_error(
			s->h.file,
			s->h.line,
			XLE_PROTO_OPEN_FILE,
			l_string(std_cm,"Get"),
			n_get_string("cannot open the file"));
	if ( f->header.type == 'P' )
		colsize = 3;
	else	colsize = 1;
	size = (r.br.x - r.tl.x)*(r.br.y - r.tl.y)*colsize;
	raw = mmalloc(size,gc_text);
	ptr = raw;
	for ( y = r.tl.y ; y < r.br.y ; y ++ )
		for ( x = r.tl.x ; x < r.br.x ; x ++ ) {
			r64_red(ptr,f,x,y,_lev);
			ptr += colsize;
		}
	r64_close_file(f);
	return get_raw(raw,size);

type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"Get"),
		n_get_string("type missmatch"));
}


XL_SEXP *
load_cr_file(XLISP_ENV * env,XL_SEXP * s,L_CHAR * file)
{
XL_SEXP * lev;
XL_SEXP * _xx;
int _lev;
CR_FILE * f;
unsigned char * raw;
unsigned char * ptr;
int colsize;
int x,y,size;
CR_MEM_TBL tbl;
int err;

	lev = get_el(s,2);
	if ( get_type(lev) != XLT_INTEGER )
		goto type_missmatch;
	_lev = lev->integer.data;
	_xx = get_el(s,3);
	if ( get_type(_xx) != XLT_INTEGER )
		goto type_missmatch;
	x = _xx->integer.data;
	_xx = get_el(s,4);
	if ( get_type(_xx) != XLT_INTEGER )
		goto type_missmatch;
	y = _xx->integer.data;

	f = cr_open_file(n_string(std_cm,file),O_RDONLY,0644,
		256,0,0);
	if ( f == 0 )
		return get_error(
			s->h.file,
			s->h.line,
			XLE_PROTO_OPEN_FILE,
			l_string(std_cm,"Get"),
			n_get_string("cannot open the file"));
	if ( cr_read(&tbl,f,x,y,_lev) < 0 ) {
		err = r64_error;
		goto r64_err;
	}
	size = tbl.size + 4;
	raw = mmalloc(size,gc_text);
	raw[0] = tbl.type;
	raw[1] = tbl.cal[0];
	raw[2] = tbl.cal[1];
	raw[3] = tbl.cal[2];
	memcpy(&raw[4],tbl.buf,tbl.size);
	free_cr_mem_tbl(&tbl);
	cr_close_file(f);
	return get_raw(raw,size);

type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"Get"),
		n_get_string("type missmatch"));
r64_err:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_OBJECT,
		l_string(std_cm,"Get"),
		List(n_get_string("R64(CR) read error"),
			get_integer(err,0),
			-1));
}

XL_SEXP *
r64_Get(XLISP_ENV * env,XL_SEXP * s)
{
XL_SEXP * filename;
XL_SEXP * ret;
int i;
XL_SEXP * lr;
L_CHAR * target[2];
L_CHAR * fn;
L_CHAR * _f;
XL_GETFILE * gf;

	filename = get_el(s,1);
	if ( get_type(filename) != XLT_STRING )
		goto type_missmatch;
	fn = nl_copy_str(std_cm,"Get");
	target[0] = target[1] = 0;
	ret = get_path(target,&gf,filename->string.data,s,fn);
	if ( get_type(ret) == XLT_ERROR )
		goto end;
	d_f_ree(fn);
	if ( l_strcmp(gf->mode,l_string(std_cm,"lod")) )
		return get_error(
			s->h.file,
			s->h.line,
			XLE_PROTO_UNSUPPORT_MODE,
			l_string(std_cm,"Get"),
			n_get_string("unsupport Get mode"));

	for ( i = 0 ; i < 2 ; i ++ ) {
		if ( target[i] == 0 )
			break;

		switch ( gf->flags & XLGFM_LOCK ) {
		case XLGF_FULL_PATH:
			_f = target[i];
			lr = connect_lock(s,target[i],"read");
			if ( get_type(lr) == XLT_ERROR ) {
				ret = lr;
				goto end;
			}
			break;
		case XLGF_URL_PATH:
			_f = filename->string.data;
			lr = connect_lock(s,
				filename->string.data,"read");
			if ( get_type(lr) == XLT_ERROR ) {
				ret = lr;
				goto end;
			}
			break;
		default:
			_f = 0;
		}

		if ( l_strcmp(&target[i][l_strlen(target[i])-4],
				l_string(std_cm,".r64")) == 0 )
			ret = load_r64file(env,s,target[i]);
		else {
			ret = load_cr_file(env,s,target[i]);
		}
		if ( _f )
			connect_unlock(s,lr->integer.data,_f);

		if ( get_type(ret) != XLT_ERROR )
			i = 2;
		else if ( ret->err.code != XLE_PROTO_OPEN_FILE )
				i = 2;
	}
end:
	if ( target[0] )
		d_f_ree(target[0]);
	if ( target[1] )
		d_f_ree(target[1]);
	return ret;
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"Get"),
		n_get_string("type missmatch"));
}

