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

XL_SEXP * xl_gv_flame_get_image();
//XL_SEXP * cast_string2integer(XL_SEXP * s);


extern char gv_flame_dirty_flag;

void
init_gv_flame_get_image(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"gv-flame-get-image"),
		get_func_prim(xl_gv_flame_get_image,FO_APPLICATIVE,0,5,5));
}


XL_SEXP * xl_gv_flame_get_image(
	XLISP_ENV * e,
	XL_SEXP * s,
	XLISP_ENV * a_e,
	XL_SYM_FIELD * sf)
{
XL_SEXP * ret;
XL_SEXP *x1,*y1,*w1,*h1;
GBVIEW_STATUS sts;
GBVIEW_PLANE gbp;
GB_RECT rr;
int x,y,w,h;
GBVIEW_FLAME * gf;

	gf = get_gf_from_sf(sf);

	x1 = get_el(s,1);
	y1 = get_el(s,2);
	w1 = get_el(s,3);
	h1 = get_el(s,4);
	if ( get_type(x1) != XLT_INTEGER || get_type(y1) != XLT_INTEGER ||
			get_type(w1) != XLT_INTEGER || get_type(h1) != XLT_INTEGER )
		goto type_mismatch;
	x = x1->integer.data;
	y = y1->integer.data;
	w = w1->integer.data;
	h = h1->integer.data;

	wf_status(gf,&sts);
	if ( x < 0 || y < 0 || x+w > sts.width || y+h > sts.height || w <= 0 || h <= 0 ) {
		wf_free_status(&sts);
		return get_error(
			s->h.file,
			s->h.line,
			XLE_PROTO_INV_PARAM,
			l_string(std_cm,"gv-flame-get-image"),
			List(n_get_string("invalid range"),
				-1));
	}
	wf_free_status(&sts);

	rr.tl.x = x;
	rr.tl.y = y;
	rr.br.x = x+w;
	rr.br.y = y+h;
	set_redraw_rect(gf,&rr);

	gv_flame_dirty_flag = 0;

	if ( ! wf_redraw(gf,&gbp,x,y,w,h) )
		return 0;
	ret = gbp2list(&gbp,sf);
	wf_free_plane(&gbp);
	if ( ret )
		return ret;
	else
		return get_error(
			s->h.file,
			s->h.line,
			XLE_PROTO_INV_PARAM,
			l_string(std_cm,"gv-flame-get-image"),
			List(n_get_string("unknown format"),
			-1));

type_mismatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"gv-flame-get-image"),
		List(n_get_string("type missmatch"),
			-1));
}
