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

XL_SEXP * xl_Word2String();



void
init_Word2String(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"Word2String"),
		get_func_prim(xl_Word2String,FO_APPLICATIVE,0,2,2));
}


char *
get_ex_str_integer(int * size,int s,int w)
{
char * ret;
int i;
	ret = d_alloc(w);
	for ( i = 0 ; i < w ; i ++ )
		ret[i] = (s>>((w-i-1)*8))&0x0ff;
	ret[w] = 0;
	*size = w;
	return ret;
}

char *
get_ex_str_string(int * size,L_CHAR * s,int w)
{
char * ret, * r;
L_CHAR ch;
char * ptr;
int sz;
	ret = d_alloc(*size = w*l_strlen(s));
	ptr = ret;
	for ( ; *s ; s ++ ) {
		ch = *s;
		if ( (ch & LCZM_3BYTE) == LCZ_3BYTE )
			ch &= LCZM_3B_CODE;
		else if ( (ch & LCZM_2BYTE) == LCZ_2BYTE )
			ch &= LCZM_2B_CODE;
		else if ( (ch & LCZM_1BYTE) == LCZ_1BYTE )
			ch &= LCZM_1B_CODE;
		r = get_ex_str_integer(&sz,ch,w);
		memcpy(ptr,r,w);
		ptr += w;
		d_f_ree(r);
	}
	*ptr = 0;
	return ret;
}

char *
get_ex_str(int * size,XL_SEXP * s,int w)
{
char * ret, * r;
int len,pos,get_size;
XL_SEXP * ss;
	ret = 0;
	len = 0;
	for ( ; get_type(s) == XLT_PAIR ; s = cdr(s) ) {
		ss = car(s);
		switch ( get_type(ss) ) {
		case XLT_PAIR:
			r = get_ex_str(&get_size,ss,w);
			break;
		case XLT_INTEGER:
			r = get_ex_str_integer(&get_size,
					ss->integer.data,w);
			break;
		case XLT_STRING:
			r = get_ex_str_string(&get_size,
					ss->string.data,w);
			break;
		default:
			goto err;
		}
		if ( ret == 0 ) {
			ret = d_alloc(get_size);
			memcpy(ret,r,get_size);
			d_f_ree(r);
			len = get_size;
		}
		else {
			ret = d_re_alloc(ret,len+get_size);
			memcpy(&ret[len],r,get_size);
			d_f_ree(r);
			len += get_size;
		}
	}
	*size = len;
	if ( ret == 0 )
		ret = d_alloc(1);
	return ret;
err:
	d_f_ree(ret);
	*size = -1;
	return 0;
}


XL_SEXP *
xl_Word2String(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a,
	XL_SYM_FIELD * sf)
{
L_CHAR * encoding;
L_CHAR * word;
int _word;
CODE_METHOD * cm;
char * str;
XL_SEXP * ex;
XL_SEXP * ret;
int size;
	encoding = get_sf_attribute(sf,
			l_string(std_cm,"encoding"));
	word = get_sf_attribute(sf,
			l_string(std_cm,"word"));
	if ( encoding == 0 )
		cm = std_cm;
	else	cm = search_cm(n_string(std_cm,encoding));
	if ( word == 0 )
		_word = 1;
	else {
		sscanf(n_string(std_cm,word),"%i",&_word);
		if ( _word < 1 )
			_word = 1;
		else if ( _word > 4 )
			_word = 4;
	}
	ex = get_el(s,1);
	switch ( get_type(ex) ) {
	case XLT_STRING:
		str = get_ex_str_string(&size,ex->string.data,_word);
		break;
	case XLT_INTEGER:
		str = get_ex_str_integer(&size,ex->integer.data,_word);
		break;
	case XLT_PAIR:
		str = get_ex_str(&size,ex,_word);
		break;
	default:
		goto type_missmatch;
	}
	str = d_re_alloc(str,size+4);
	str[size] = 0;
	str[size+1] = 0;
	str[size+2] = 0;
	str[size+3] = 0;
	ret = get_string(l_string(cm,str));
	d_f_ree(str);
	return ret;
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"Word2String"),
		n_get_string("type missmatch"));
internal_error:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SYSTEM_INTERNAL,
		l_string(std_cm,"Word2String"),
		n_get_string("shell argments initializing is required"));
}


