/* *********************************************************************

This source file is a part of the standard library of Scol
For the latest info, see http://www.scolring.org

Copyright (c) 2014 Stephane Bisaro aka Iri.

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.

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. See the GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place - Suite 330, Boston, MA 02111-1307, USA, or go to

http://www.gnu.org/copyleft/lesser.txt

********************************************************************* */

/*
 * Functions for 'working'
 * See http://redmine.scolring.org/projects/tutorials/wiki/Scol_usage
 * for more informations
 */
 
/*! \file working.pkg
 * \author Scol team
 * \version 0.1
 * \copyright GNU Lesser General Public License 2.0 or later
 * \brief working API
 * 
 * Dependancies :
 * -  lib/2dos/bitmap.pkg
 *

 * \image html workingprogress.png
 *
 * \example 2dos/working.pkg_
 **/
 
/*! \var L2D_WORKING_szPATH
*
*   \ingroup _2dos_working
* \brief Graphical resource filename for show the activity.
*/
var L2D_WORKING_szPATH = "lib/2dos/rsc/process-working.png";;

/*! \var L2D_WORKING_iSIZE
*
*   \ingroup _2dos_working
* \brief Graphical resource element size, in pixels.
*/
var L2D_WORKING_iSIZE = 36;;

/*! \var L2D_WORKING_iCOLORTRANSP
*
*   \ingroup _2dos_working
* \brief Transparency color, if any (default : no transparency color set)
*/
typeof L2D_WORKING_iCOLORTRANSP = I;;

/*! \var L2D_WORKING_iNSTEP
*
*   \ingroup _2dos_working
* \brief The number of steps. Default : 1
*/
var L2D_WORKING_iNSTEP = 10;;

/*! \var L2D_WORKING_iPERIOD
*
*   \ingroup _2dos_working
* \brief The period (the time bteween each step). Default : 100 ms
*/
var L2D_WORKING_iPERIOD = 100;;

typeof L2d_working_win = ObjWin;;
typeof L2d_working_cb = fun [I] I;;

/*! \brief Set the 2d resources filename.
*
* By default, it is "lib/2dos/rsc/process-working.png"
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [S] I
*
* \param S : the new filename to set.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the given path is nil
**/
fun lib2d_workingSetPath (szPath)=
	if szPath == nil then
		1
	else
	(
		set L2D_WORKING_szPATH = szPath;
		0
	);;

/*! \brief Get the 2d resources filename.
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [] S
*
* \return S : the current 2d resource filename.
**/
fun lib2d_workingGetPath ()=
	L2D_WORKING_szPATH;;
	
/*! \brief Set the 2d resources element size.
*
* By default, it is 36
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [I] I
*
* \param I : the new size to set.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the given size is nil
**/
fun lib2d_workingSetSize (iSize)=
	if iSize == nil then
		1
	else
	(
		set L2D_WORKING_iSIZE = iSize;
		0
	);;

/*! \brief Get the 2d resources element size.
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [] I
*
* \return S : the current 2d resource element size
**/
fun lib2d_workingGetSize ()=
	L2D_WORKING_iSIZE;;
	
/*! \brief Set the transparency color.
*
* By default, it is 36
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [I] I
*
* \param I : the new transparency color to set. It can be nil if no transparency to set
* \return I : always 0
**/
fun lib2d_workingSetTransColor (iColor)=
	set L2D_WORKING_iCOLORTRANSP = iColor;
	0;;

/*! \brief Get the transparency color.
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [] I
*
* \return S : the defined transparency color.
**/
fun lib2d_workingGetTransColor ()=
	L2D_WORKING_iCOLORTRANSP;;
	
/*! \brief Set the number of steps.
*
* By default, it is 11
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [I] I
*
* \param I : the new number to set.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the given size is incorrect
**/
fun lib2d_workingSetNStep (iNstep)=
	if (iNstep == nil) || (iNstep <= 0) then
		1
	else
	(
		set L2D_WORKING_iNSTEP = iNstep;
		0
	);;

/*! \brief Get the number of steps.
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [] I
*
* \return I : the current 2d resource element size
**/
fun lib2d_workingGetNStep ()=
	L2D_WORKING_iNSTEP;;
	
/*! \brief Set the period between steps.
*
* By default, it is 11
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [I] I
*
* \param I : the new period to set.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the given period is invalid
**/
fun lib2d_workingSetPeriod (iPeriod)=
	if (iPeriod == nil) || (iPeriod <= 0) then
		1
	else
	(
		set L2D_WORKING_iPERIOD = iPeriod;
		0
	);;

/*! \brief Get the period between steps.
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [] I
*
* \return I : the current period
**/
fun lib2d_workingGetPeriod ()=
	L2D_WORKING_iPERIOD;;
	
/*! \brief Set the callback.
*
* This function will be called when a new step is done.
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [fun [I] I] I
*
* \param fun [I] I : the callback to set (can be nil (default).
* Its argument is the step number.
* \return I : always 0.
**/
fun lib2d_workingSetCallback (cb)=
	set L2d_working_cb = cb;;

/*! \brief Get the child window.
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [] ObjWin
*
* \return ObjWin : the current window or nil if not created yet
**/	
fun lib2d_workingGetWindow ()=
	L2d_working_win;;
	
fun lib2d_working_cbend (o, p)=
	let p -> [bmpref bmpcur t] in
	(
	_deltimer t;
	_DSbitmap bmpref;
	_DSbitmap bmpcur;
	set L2d_working_win = nil;
	0
	);;
	
fun lib2d_working_cbpaint (o, p)=
	let p -> [win bmpcur] in
	_BLTbitmap win bmpcur 0 0;
	//_BLTwindow bmpcur 0 0 win 0 0 L2D_WORKING_iSIZE L2D_WORKING_iSIZE;
	//_STBLTbitmap win 0 0 L2D_WORKING_iSIZE L2D_WORKING_iSIZE bmpcur 0 0 L2D_WORKING_iSIZE L2D_WORKING_iSIZE;
	0;;
	
fun lib2d_working_cutbmp (bmpref, bmpcur, step)=
	if (bmpref == nil) || (bmpcur == nil) || (step == nil) then
		nil
	else
		_CPbitmap24 bmpcur 0 0 bmpref step*L2D_WORKING_iSIZE 0 L2D_WORKING_iSIZE L2D_WORKING_iSIZE L2D_WORKING_iCOLORTRANSP;;
		
fun lib2d_working_cbtimer (o, p)=
	let p -> [win bmpref bmpcur step] in
	(
	set step = if step <= L2D_WORKING_iNSTEP then step+1 else 0;
	set bmpcur = lib2d_working_cutbmp bmpref bmpcur step;
	_PAINTwindow win;
	mutate p <- [_ _ bmpcur step];
	exec L2d_working_cb with [step];
	0
	);;
	
/*! \brief Create a new object.
*
* This function should be called AFTER the parameter's setting.
*
* \remark One only instance can be created at the time.
* \see lib2d_workingDestroy
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [ObjWin I I] I
*
* \param ObjWin : the mother window
* \param I : the x cordinate, relative to the mother
* \param I : the y cordinate, relative to the mother
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : an instance already running
* - 2 : the mother is nil
* - 3 : unable to load the bitmap resource correctly
* - 4 : unable to create the internal bitmap
* - 5 : unable to create the child window correctly
* - 6 : unable to ctreate the timer
**/
fun lib2d_workingNew (oMother, posx, posy)=
	set posx = if posx == nil then 0 else posx;
	set posy = if posy == nil then 0 else posy;
	if L2d_working_win != nil then
		1
	else
		if oMother == nil then
			2
		else
			let lib2d_bmpLoad L2D_WORKING_szPATH -> bmpref in
			if nil == bmpref then
				3
			else
				let _FILLbitmap 
						_CRbitmap _channel L2D_WORKING_iSIZE L2D_WORKING_iSIZE 
						0xFFFFFF
					-> bmpcur in
				if bmpcur == nil then
				(
					_DSbitmap bmpref;
					4
				)
				else
					let _CRwindow _channel oMother posx posy L2D_WORKING_iSIZE L2D_WORKING_iSIZE WN_CHILDINSIDE "" -> win in
					if win == nil then
					(
						_DSbitmap bmpref;
						_DSbitmap bmpcur;
						5
					)
					else
						let _starttimer _channel L2D_WORKING_iPERIOD -> timer in
						if timer == nil then
						(
							_DSbitmap bmpref;
							_DSbitmap bmpcur;
							_DSwindow win;
							6
						)
						else
						(
							_CBwinPaint win @lib2d_working_cbpaint [win bmpcur];
							_CBwinDestroy win @lib2d_working_cbend [bmpref bmpcur timer];
							_rfltimer timer @lib2d_working_cbtimer [win bmpref bmpcur 0];
							set L2d_working_win = win;
							_PAINTwindow win;
							0
						);;
					
/*! \brief Destroy the object.
*
* You should destroy a such object when no longer needed.
*
* All parameters keep available to a next creation. To change them,
* this API is here !
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [] I
*
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : no instance running
**/
fun lib2d_workingDestroy ()=
	if L2d_working_win == nil then
		1
	else
	(
		_DSwindow L2d_working_win;
		0
	);;
	
	
	
	
	
	


typeof Lib2d_status_obj = [ObjWin ObjBitmap S I];;

/*! \var L2D_STATUS_lRSC
*
*   \ingroup _2dos_working
* \brief List of graphical resources and levels.
*/
var L2D_STATUS_lRSC = ["lib/2dos/rsc/status-0-24.png" 0 24] ::
						["lib/2dos/rsc/status-25-49.png" 25 49] ::
						["lib/2dos/rsc/status-50-74.png" 50 74] ::
						["lib/2dos/rsc/status-75-100.png" 75 100] ::
						nil;;
	
/*! \brief Set graphical resources and its level for a 'status'.
 * 
 * Each resource should have the same size.
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [[[S I I] r1]] I
*
* \param [[S I I] r1] : a list : a resource and a level (min and max)  for this resource
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the list is nil
**/
fun lib2d_statusSetRsc (list)=
	if list == nil then
		1
	else
	(
		set L2D_STATUS_lRSC = list;
		0
	);;
	
/*! \brief Get the current graphical resources and its level list
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [] [[S I] r1]
*
* \return [[S I] r1] : the list
**/
fun lib2d_statusGetRsc (list)=
	L2D_STATUS_lRSC;;
	
/*! \brief Get the current level
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [] I
*
* \return I : the current level or nil if error / no instance running
**/
fun lib2d_statusGetLevel (list)=
	let Lib2d_status_obj -> [_ _ _ level] in
	level;;
	
fun lib2d_status_cbend (o, p)=
	if p == nil then
		1
	else
		let p -> [win bmpcur _ _] in
		(
		_DSbitmap bmpcur;
		set Lib2d_status_obj = nil;
		0
		);;
		
fun lib2d_status_cbpaint (o, p)=
	if p == nil then
		1
	else
		let Lib2d_status_obj -> [win bmpcur _ _] in
		(
		_BLTbitmap win bmpcur 0 0;
		0
		);;
		
fun lib2d_status_getrscfromlevel2 (l, level)=
	if nil == l then	// last rsc
		nil
	else
		let hd l -> [b n ne] in
		if (level >= n) && (level <= ne) then
			b
		else
			lib2d_status_getrscfromlevel2 tl l level;;
		
fun lib2d_status_getrscfromlevel (level)=
	if level == nil then
		nil
	else
		lib2d_status_getrscfromlevel2 L2D_STATUS_lRSC level;;
		
/*! \brief Change the current level.
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [I] I
*
* \param I : the level to set
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the given level is nil
* - 2 : unable to load the resource (bad path, no resource defined to this level, ...)
* - 3 : (for info only) : the current resource is unchanged.
**/
fun lib2d_statusChange (level)=
	if level == nil then
		1
	else
		let lib2d_status_getrscfromlevel level -> szRsc in
		let Lib2d_status_obj -> [win bmpcur szRscCur _] in
		if !strcmp szRscCur szRsc then
		(
			// set Lib2d_status_obj = [win bmpcur szRscCur level];
			mutate Lib2d_status_obj <- [_  _ _ level];
			3
		)
		else
			let lib2d_bmpLoad szRsc -> bmpnew in
			if bmpnew == nil then
				2
			else
			(
				_DSbitmap bmpcur;
				//set Lib2d_status_obj = [win bmpnew szRsc level];
				mutate Lib2d_status_obj <- [_  bmpnew szRsc level];
				_PAINTwindow win;
				0
			);;
	
	

/*! \brief Create a new 'status' ''object.
*
* \remark One only instance can be created at the time.
* \see lib2d_statusDestroy
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [ObjWin I I] I
*
* \param ObjWin : the mother window
* \param I : the x cordinate, relative to the mother
* \param I : the y cordinate, relative to the mother
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : an instance already running
* - 2 : the mother is nil
* - 3 : the resources list is nil
* - 4 : unable to load the bitmap resource correctly
* - 5 : unable to create the child window correctly
**/
fun lib2d_statusNew (oMother, posx, posy)=
	set posx = if posx == nil then 0 else posx;
	set posy = if posy == nil then 0 else posy;
	if Lib2d_status_obj != nil then
		1
	else
		if oMother == nil then
			2
		else
			if nil == L2D_STATUS_lRSC then
				3
			else
				let hd L2D_STATUS_lRSC -> [szPath _ _] in
				let lib2d_bmpLoad szPath -> bmpcur in
				if bmpcur == nil then
					4
				else
					let _GETbitmapSize bmpcur -> [w h] in
					let _CRwindow _channel oMother posx posy w h WN_CHILDINSIDE "" -> win in
					if win == nil then
					(
						_DSbitmap bmpcur;
						5
					)
					else
					(
						set Lib2d_status_obj = [win bmpcur szPath 0];
						_CBwinPaint win @lib2d_status_cbpaint Lib2d_status_obj;
						_CBwinDestroy win @lib2d_status_cbend Lib2d_status_obj;
						_PAINTwindow win;
						0
					);;

/*! \brief Destroy the 'status' ''object.
*
* You should destroy a such object when no longer needed.
*
* All parameters keep available to a next creation. To change them,
* the API is here !
*
*   \ingroup _2dos_working
* <b>Prototype :</b> fun [] I
*
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : no instance running
**/
fun lib2d_statusDestroy ()=
	if Lib2d_status_obj == nil then
		1
	else
		let Lib2d_status_obj -> [win _ _ _] in
		(
		_DSwindow win;
		0
		);;