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


XL_SEXP *
get_gb_color(GB_COLOR_INT * col,GB_COLOR * gbc)
{
unsigned long color;
REAL1 cc;
unsigned long ccc;
int i;
	color = 0;
	ccc = gbc->r*(1<<COL_BIT);
	if ( ccc >= (1<<COL_BIT) )
		ccc = (1<<COL_BIT)-1;
	color = ccc;
	ccc = gbc->g*(1<<COL_BIT);
	if ( ccc >= (1<<COL_BIT) )
		ccc = (1<<COL_BIT)-1;
	color |= ccc<<COL_BIT;
	ccc = gbc->b*(1<<COL_BIT);
	if ( ccc >= (1<<COL_BIT) )
		ccc = (1<<COL_BIT)-1;
	color |= ccc<<(COL_BIT*2);

	col->c = color;
	col->t = gbc->t;
	col->rev_t = 1-col->t;
	return 0;
}

XL_SEXP *
get_color(GB_COLOR_INT * col,XL_SEXP * s)
{
XL_SEXP * c;
unsigned long color;
REAL1 cc;
unsigned long ccc;
int i;
	if ( list_length(s) != 4 ) {
		return get_error(
			s->h.file,
			s->h.line,
			XLE_SEMANTICS_INV_PARAM_LENGTH,
			l_string(std_cm,"set-color-palette"),
			list(n_get_string("palette parameter length (color)"),
			0));
	}
	color = 0;
	for ( i = 0 ; i < 3 ; i ++ ) {
		c = get_el(s,i);
		switch ( get_type(c) ) {
		case XLT_ERROR:
			return c;
		case XLT_INTEGER:
			cc = c->integer.data;
			break;
		case XLT_FLOAT:
			cc = c->floating.data;
			break;
		default:
			return get_error(
				s->h.file,
				s->h.line,
				XLE_SEMANTICS_TYPE_MISSMATCH,
				l_string(std_cm,"set-color-paleete"),
			list(n_get_string("palette parameter type missmatch"),
				0));
		}
		ccc = cc*(1<<COL_BIT);
		if ( ccc >= (1<<COL_BIT) )
			ccc = (1<<COL_BIT) - 1;
		color = color | (ccc<<(i*COL_BIT));
	}
	c = get_el(s,3);
	switch ( get_type(c) ) {
	case XLT_ERROR:
		return c;
	case XLT_INTEGER:
		cc = c->integer.data;
		break;
	case XLT_FLOAT:
		cc = c->floating.data;
		break;
	default:
		return get_error(
			s->h.file,
			s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"set-color-palette"),
		list(n_get_string("palette parameter type missmatch"),
			0));
	}
/*
	if ( cc >= 1 )
		cc = 1;
*/
cc = 1;
	col->c = color;
	col->t = cc;
	col->rev_t = 1-cc;
	return 0;
}

XL_SEXP *
dgb_line_color(XLISP_ENV * e,XL_SEXP * s,
	XLISP_ENV * a,XL_SYM_FIELD * sf)
{
RESOURCE * r;
XLISP_ENV * ee;
OBJ * obj;
L_CHAR * id;
 unsigned int _id;
XL_SEXP * palette_info;
XL_SEXP * rec,* tag, *err;
XL_SEXP * ret;
	r = get_resource_ptr(&ret,e,s->h.file,s->h.line);
	if ( r == 0 )
		return ret;
	if ( r->h.type != RT_DRAW_GB )
		er_panic("dgb_polygon2d(2)");
	id = get_sf_attribute(sf,l_string(std_cm,"id"));
	if ( id == 0 )
		_id = 0;
	else sscanf(n_string(std_cm,id),"%i",&_id);
	obj = search_obj(r,_id);
	if ( obj == 0 )
		goto no_obj;
	if ( list_length(s) == 2 ) {
		err = get_color(
			&obj->h.palette.line_color,
			get_el(s,1));
	}
	else {
		err = get_color(
			&obj->h.palette.line_color,
			cdr(s));
	}
	if ( get_type(err) == XLT_ERROR )
		return err;
	return 0;
no_obj:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_UNDEF_NAME,
		l_string(std_cm,"set-color-palette"),
		list(n_get_string("no object"),0));
}


XL_SEXP *
dgb_padding_color(XLISP_ENV * e,XL_SEXP * s,
	XLISP_ENV * a,XL_SYM_FIELD * sf)
{
RESOURCE * r;
XLISP_ENV * ee;
OBJ * obj;
L_CHAR * id;
unsigned int _id;
XL_SEXP * palette_info;
XL_SEXP * rec,* tag, *err;
XL_SEXP * ret;
	r = get_resource_ptr(&ret,e,s->h.file,s->h.line);
	if ( r == 0 )
		return ret;
	if ( r->h.type != RT_DRAW_GB )
		er_panic("dgb_polygon2d(2)");
	id = get_sf_attribute(sf,l_string(std_cm,"id"));
	if ( id == 0 )
		_id = 0;
	else	sscanf(n_string(std_cm,id),"%i",&_id);
	obj = search_obj(r,_id);
	if ( obj == 0 )
		goto no_obj;
	if ( list_length(s) == 2 ) {
		err = get_color(
			&obj->h.palette.padding_color,
			get_el(s,1));
	}
	else {
		err = get_color(
			&obj->h.palette.padding_color,
			cdr(s));
	}
	if ( get_type(err) == XLT_ERROR )
		return err;
	return 0;
no_obj:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_UNDEF_NAME,
		l_string(std_cm,"set-color-palette"),
		list(n_get_string("no object"),0));
}

