/* *********************************************************************
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 buttons
* See http://redmine.scolring.org/projects/tutorials/wiki/Scol_usage
* for more informations
*/
/*! \file button.pkg
* \author Scol team
* \version 0.1
* \copyright GNU Lesser General Public License 2.0 or later
* \brief Customized buttons API
*
* Dependancies :
* - lib/std/stdlib.pkg
* - lib/2dos/bitmap.pkg
*
* \example 2dos/button.pkg_
**/
/* misc */
// create a default font, if any
fun lib2d_button_fontdefault ()=
_CRfont _channel 14 0 0 "Arial";;
/*! \brief button is a window
*
* \ingroup _2dos_button
*/
var L2D_BUTTON_WINDOW = 0;;
/*! \brief button is a button
*
* \ingroup _2dos_button
*/
var L2D_BUTTON_BUTTON = 1;;
var L2D_BUTTON_TEXTTOP = 0;;
var L2D_BUTTON_TEXTRIGHT = 1;;
var L2D_BUTTON_TEXTBOTTTOM = 2;;
var L2D_BUTTON_TEXTLEFT = 4;;
var L2D_BUTTON_POSABSOLUTE = 0;;
var L2D_BUTTON_POSRELATIVE = 1;;
var L2D_BUTTON_DISABLE = 0;;
var L2D_BUTTON_ENABLE = 1;;
/*! \brief default spacing value between the graphical elements
*
* \ingroup _2dos_button
*/
var L2D_BUTTON_SPACING = 10;;
/*! \struct L2D_BUTTON
*
* \brief Opaque internal structure. You should not call it directly, use
* API instead !
*
* \ingroup _2dos_button
**/
struct L2D_BUTTON = [
iButType : I,
iButEnable : I,
oButWin : ObjWin,
oButMother : ObjWin,
oButButton : ObjButton,
oButBitmap : ObjBitmap,
oButFont : ObjFont,
tButSize : [I I],
tButPos : [I I],
tButSizeBmp : [I I],
tButPosBmp : [I I],
tButPosText : I,
tButPosTextRef : I,
tButPosTextInternal : [I I], // private !
tButSpacing : I,
tButBgColor : I, /*!< Background color */
tButFoColor : I, /*!< Foreground color (text color) */
tButHasBg : I, /*!< 1 if the 'window' has a bakground, else 0 */
tButBgSets : [I I I],/*!< background is fully visible 1/0), border is visible (1/0), border size (pixels) */
iButWinFlags : I,
szButTitle : S,
funButClick : fun [L2D_BUTTON I I I I] I, /*!< 'Click' callback */
funButDropfile : fun [L2D_BUTTON [P r1] I I] I, /*!< 'Drop files' callback */
funButClose : fun [L2D_BUTTON I] I, /*!< 'Close' callback */
funButDestroy : fun [I] I, /*!< 'Destroy' callback */
funButNew : fun [L2D_BUTTON I] I /*!< not used */
] mkL2D_BUTTON;;
proto lib2d_but_cbdestroy = fun [u0 L2D_BUTTON] I;;
proto lib2d_but_cbdrop = fun [u0 L2D_BUTTON I I [P r1]] I;;
proto lib2d_but_cbpaint = fun [u0 L2D_BUTTON] I;;
proto lib2d_but_cbclick = fun [u0 L2D_BUTTON I I I] I;; // win
proto lib2d_but_cbclick2 = fun [u0 L2D_BUTTON] I;; // button
proto lib2d_but_destroy = fun [L2D_BUTTON] I;;
proto lib2d_butbuildbitmap = fun [L2D_BUTTON] I;;
proto lib2d_but_postext = fun [L2D_BUTTON] [I I];;
/*! \brief Create a new object.
*
* Some parameters take default values (they can be modified with tthis API) :
* - a default font ("Arial", size = 14).
* - a global size (50, 20)
* - a position (0, 0)
* - the text is put to right, relative of the bitmap
* - a spacing (10)
* - a background color (white)
* - a foreground color (black)
* - the background is fully drawn
* - no window flags defined
* - is enabled
*
* \ingroup _2dos_button
* Prototype : fun [I ObjWin fun [L2D_BUTTON I I I I] I] L2D_BUTTON
*
* \param I : the type of the button, one of these following values :
* - L2D_BUTTON_WINDOW : the button will be built in a child window. It can be used
* and customized after
* - L2D_BUTTON_BUTTON : the built button is a classical button
* \param ObjWin : the mother window. It can be nil.
* \param fun [L2D_BUTTON I I I I] I : the callback when a click event occurs.
* The suplemental arguments are (they are always nil if the type is L2D_BUTTON_BUTTON except 'mask') :
* - I : the x click coordinate,
* - I : the y click coordinate,
* - I : the mouse button number,
* - I : the key mask (1 = shift, 2 = control, 4 = alt).
* \return L2D_BUTTON : the new object if success or nil if an error occurs
* (typically, the given type is incorrect).
**/
fun lib2d_butNew (iType, oMother, cbClick)=
if std_tupleIsFound [L2D_BUTTON_WINDOW L2D_BUTTON_BUTTON] iType then
mkL2D_BUTTON [iType
1
nil
oMother
nil
nil
lib2d_button_fontdefault
[50 20]
[0 0]
nil
nil
L2D_BUTTON_TEXTRIGHT
L2D_BUTTON_POSABSOLUTE
nil
L2D_BUTTON_SPACING
0xffffff
0
1
[L2D_BUTTON_ENABLE L2D_BUTTON_ENABLE 1]
0
nil
cbClick
nil
nil
nil
nil]
else
nil;;
/*! \brief Create a new object from another one.
*
* All parameters are copied EXCEPT all callbacks. Callbacks are all at nil.
* This API can set that.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] L2D_BUTTON
*
* \param L2D_BUTTON : the model to copy
* \return L2D_BUTTON : the new object if success or nil if an error occurs
* (typically, the given button is nil).
**/
fun lib2d_buttonNewCopy (strBut)=
if std_objIsNil strBut then
nil
else
mkL2D_BUTTON [
strBut.iButType
strBut.iButEnable
nil
strBut.oButMother
nil
strBut.oButBitmap
strBut.oButFont
tButSize
tButPos
tButSizeBmp
tButPosBmp
tButPosText
tButPosTextRef
tButPosTextInternal
tButSpacing
tButBgColor
tButFoColor
tButBgSets
szButTitle
nil
nil
nil
nil
nil
];;
/*! \brief Set a bitmap file to a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON S] I
*
* \param L2D_BUTTON : a button object
* \param S : a bitmap filename. Can be nil, in this case, the old
* bitmap is destroyed).
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : the given filename is bad : file not found, format unsupported, ...
*
* \remark If a bitmap can be created from the given read reference file,
* its size will be set automatically. The developper can be modified it
* by using 'lib2d_butSetBitmapSize'.
*
* \see lib2d_butSetBitmapSize
**/
fun lib2d_butSetFile (strBut, szPath)=
if std_objIsNil strBut then
1
else
if std_objIsNil szPath then
(
_DSbitmap strBut.oButBitmap;
set strBut.oButBitmap = nil;
0
)
else
let lib2d_bmpLoad szPath -> bmp in
if std_objIsNil bmp then
2
else
(
set strBut.oButBitmap = bmp;
set strBut.tButSizeBmp = _GETbitmapSize bmp;
0
);;
/*! \brief Set a bitmap object to a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON ObjBitmap] I
*
* \param L2D_BUTTON : a button object
* \param ObjBitmap : a bitmap object. Can be nil, in this case, the old
* bitmap is destroyed).
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
*
* \remark If a bitmap can be created from the given read reference file,
* its size will be set automatically. The developper can be modified it
* by using 'lib2d_butSetBitmapSize'.
*
* \see lib2d_butSetBitmapSize
**/
fun lib2d_butSetBitmap (strBut, bmp)=
if std_objIsNil strBut then
1
else
if std_objIsNil bmp then
(
_DSbitmap strBut.oButBitmap;
set strBut.oButBitmap = nil;
0
)
else
(
set strBut.oButBitmap = bmp;
set strBut.tButSizeBmp = _GETbitmapSize bmp;
0
);;
/*! \brief Return the bitmap object to a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] ObjBitmap
*
* \param L2D_BUTTON : a button object
* \return ObjBitmap : the bitmap object if success or nil if an error occurs
* \remark The return will be nil if no bitmap defined to this button object.
**/
fun lib2d_butGetBitmap (strBut)=
if std_objIsNil strBut then
nil
else
strBut.oButBitmap;;
/*! \brief Set a title to a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON S] I
*
* \param L2D_BUTTON : a button object
* \param S : a title. Can be nil, if no title needed.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
**/
fun lib2d_butSetTitle (strBut, szTitle)=
if std_objIsNil strBut then
1
else
(
set strBut.szButTitle = szTitle;
0
);;
/*! \brief Return the title to a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] S
*
* \param L2D_BUTTON : a button object
* \return S : the title if success or nil if an error occurs
* \remark The return will be nil if no title defined to this button object.
**/
fun lib2d_butGetTitle (strBut)=
if std_objIsNil strBut then
nil
else
strBut.szButTitle;;
/*! \brief Set the mother window to a button object.
*
* If the mother is not nil, the button will be built inside it. If
* the mother is nil, the type of button must be L2D_BUTTON_WINDOW.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON ObjWin] I
*
* \param L2D_BUTTON : a button object
* \param ObjWin : a mother window object. Can be nil, if you know really what you do.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : the mother is nil and the type of the button is not L2D_BUTTON_WINDOW
**/
fun lib2d_butSetMother (strBut, mother)=
if std_objIsNil strBut then
1
else if (std_objIsNil mother) && (strBut.iButType != L2D_BUTTON_WINDOW) then
2
else
(
set strBut.oButMother = mother;
0
);;
/*! \brief Set the type to a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON I] I
*
* \param L2D_BUTTON : a button object
* \param I : a type, one of these values :
* - L2D_BUTTON_WINDOW : the button will be built in a child window. It can be used
* and customized after
* - L2D_BUTTON_BUTTON : the built button is a classical button
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : the given type is incorrect
**/
fun lib2d_butSetType (strBut, iType)=
if std_objIsNil strBut then
1
else if !std_tupleIsFound [L2D_BUTTON_WINDOW L2D_BUTTON_BUTTON] iType then
2
else
(
set strBut.iButType = iType;
0
);;
/*! \brief Return the type of a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] I
*
* \param L2D_BUTTON : a button object
* \return I : the type if success or nil if an error occurs
**/
fun lib2d_butGetType (strBut)=
if std_objIsNil strBut then
nil
else
strBut.iButType;;
/*! \brief Set the used font to a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON ObjFont] I
*
* \param L2D_BUTTON : a button object
* \param ObjFont : a font. If nil, a default font will be set.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : no font to set (even the default font)
**/
fun lib2d_butSetFont (strBut, oFont)=
if std_objIsNil strBut then
1
else if std_objIsNil oFont then
let lib2d_button_fontdefault -> font in
if std_objIsNil font then
2
else
(
set strBut.oButFont = font;
0
)
else
(
set strBut.oButFont = oFont;
0
);;
/*! \brief Return the useed font of a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] ObjFont
*
* \param L2D_BUTTON : a button object
* \return ObjFont : the font if success or nil if an error occurs
* \remark The return will be nil if no font defined to this button object.
**/
fun lib2d_butGetFont (strBut)=
if std_objIsNil strBut then
nil
else
strBut.oButFont;;
/*! \brief Define the "drop files" callback to a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON fun [L2D_BUTTON [P r1]] I] I
*
* \param L2D_BUTTON : a button object
* \param fun [L2D_BUTTON [P r1]] I : callback. Can be nil (in this case, the event
* will be ignored).
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
**/
fun lib2d_butSetCbDrop (strBut, cb)=
if std_objIsNil strBut then
1
else
(
set strBut.funButDropfile = cb;
0
);;
/*! \brief Get the "drop files" callback to a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] fun [L2D_BUTTON [P r1] I
*
* \param L2D_BUTTON : a button object
* \return fun [L2D_BUTTON [P r1]] I : the callback if success or nil if an error occurs
* \remark The return will be nil if no callback defined to this button object.
**/
fun lib2d_butGetCbDrop (strBut)=
if std_objIsNil strBut then
nil
else
strBut.funButDropfile;;
/*! \brief Set the size of a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON I I] I
*
* \param L2D_BUTTON : a button object
* \param I : the width. Can be nil, in this case, the old value is kept.
* \param I : the height. Can be nil, in this case, the old value is kept.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : the given values are nil
* - (-1) : the width is nil, it is kept, the height is set
* - (-2) : the height is nil, it is kept, the width is set
**/
fun lib2d_butSetSize (strBut, width, height)=
if std_objIsNil strBut then
1
else if (std_objIsNil width) && (std_objIsNil height) then
2
else if std_objIsNil width then
let strBut.tButSize -> [w _] in
(
set strBut.tButSize = [w height];
neg 1
)
else if std_objIsNil height then
let strBut.tButSize -> [_ h] in
(
set strBut.tButSize = [width h];
neg 2
)
else
(
set strBut.tButSize = [width height];
0
);;
/*! \brief Get the size of a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] [I I]
*
* \param L2D_BUTTON : a button object
* \return [I I] : the size if success or nil if an error occurs.
**/
fun lib2d_butGetSize (strBut)=
if std_objIsNil strBut then
nil
else
if strBut.iButType == L2D_BUTTON_WINDOW then
let _GETwindowSizePosition strBut.oButWin -> [w h _ _] in
if (!std_tupleCmp [w h] strBut.tButSize @std_cmpI) && (!std_objIsNil strBut.oButWin) then
set strBut.tButSize = [w h]
else
strBut.tButSize
else if strBut.iButType == L2D_BUTTON_BUTTON then
let _GETbuttonSizePosition strBut.oButButton -> [w h _ _] in
if (!std_tupleCmp [w h] strBut.tButSize @std_cmpI) && (!std_objIsNil strBut.oButButton) then
set strBut.tButSize = [w h]
else
strBut.tButSize
else
nil;;
/*! \brief Set the position of a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON I I] I
*
* \param L2D_BUTTON : a button object
* \param I : the x coordinate. Can be nil, in this case, the old value is kept.
* \param I : the y coordinate. Can be nil, in this case, the old value is kept.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : the given values are nil
* - (-1) : the x coordinate is nil, it is kept, the y coordinate is set
* - (-2) : the y coordinate is nil, it is kept, the x coordinate is set
**/
fun lib2d_butSetPos (strBut, x, y)=
if std_objIsNil strBut then
1
else if (std_objIsNil x) && (std_objIsNil y) then
2
else if std_objIsNil x then
let strBut.tButPos -> [x_ _] in
(
set strBut.tButPos = [x_ y];
neg 1
)
else if std_objIsNil y then
let strBut.tButPos -> [_ y_] in
(
set strBut.tButPos = [x y_];
neg 2
)
else
(
set strBut.tButPos = [x y];
0
);;
/*! \brief Get the position of a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] [I I]
*
* \param L2D_BUTTON : a button object
* \return [I I] : the position if success or nil if an error occurs.
**/
fun lib2d_butGetPos (strBut)=
if std_objIsNil strBut then
nil
else
if strBut.iButType == L2D_BUTTON_WINDOW then
let _GETwindowSizePosition strBut.oButWin -> [_ _ x y] in
if std_tupleCmp [x y] strBut.tButPos @std_cmpI then
strBut.tButPos
else
set strBut.tButPos = [x y]
else if strBut.iButType == L2D_BUTTON_BUTTON then
let _GETbuttonSizePosition strBut.oButButton -> [_ _ x y] in
if std_tupleCmp [x y] strBut.tButPos @std_cmpI then
strBut.tButPos
else
set strBut.tButPos = [x y]
else
nil;;
/*! \brief Set the bitmap size of a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON I I] I
*
* \param L2D_BUTTON : a button object
* \param I : the width. Can be nil, in this case, the old value is kept.
* \param I : the height. Can be nil, in this case, the old value is kept.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : the given values are nil
* - (-1) : the width is nil, it is kept, the height is set
* - (-2) : the height is nil, it is kept, the width is set
**/
fun lib2d_butSetBitmapSize (strBut, width, height)=
if std_objIsNil strBut then
1
else if (std_objIsNil width) && (std_objIsNil height) then
2
else if std_objIsNil width then
let strBut.tButSizeBmp -> [w _] in
(
set strBut.tButSizeBmp = [w height];
neg 1
)
else if std_objIsNil height then
let strBut.tButSizeBmp -> [_ h] in
(
set strBut.tButSizeBmp = [width h];
neg 2
)
else
(
set strBut.tButSizeBmp = [width height];
0
);;
/*! \brief Get the bitmap size of a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] [I I]
*
* \param L2D_BUTTON : a button object
* \return [I I] : the size if success or nil if an error occurs (this size can be nil itself).
**/
fun lib2d_butGetBitmapSize (strBut)=
if std_objIsNil strBut then
nil
else
strBut.tButSizeBmp;;
/*! \brief Set the bitmap position of a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON I I] I
*
* \param L2D_BUTTON : a button object
* \param I : the x coordinate. Can be nil, in this case, the old value is kept.
* \param I : the y coordinate. Can be nil, in this case, the old value is kept.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : the given values are nil
* - (-1) : the x coordinate is nil, it is kept, the y coordinate is set
* - (-2) : the y coordinate is nil, it is kept, the x coordinate is set
**/
fun lib2d_butSetBitmapPos (strBut, x, y)=
if std_objIsNil strBut then
1
else if (std_objIsNil x) && (std_objIsNil y) then
2
else if std_objIsNil x then
let strBut.tButPosBmp -> [x_ _] in
(
set strBut.tButPosBmp = [x_ y];
neg 1
)
else if std_objIsNil y then
let strBut.tButPosBmp -> [_ y_] in
(
set strBut.tButPosBmp = [x y_];
neg 2
)
else
(
set strBut.tButPosBmp = [x y];
0
);;
/*! \brief Get the bitmap position of a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] [I I]
*
* \param L2D_BUTTON : a button object
* \return [I I] : the position if success or nil if an error occurs.
**/
fun lib2d_butGetBitmapPos (strBut)=
if std_objIsNil strBut then
nil
else
strBut.tButPosBmp;;
/*! \brief From the bitmap, set the text position of a button object.
* If it is no bitmap, the position is from the edge of the window.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON I I] I
*
* \param L2D_BUTTON : a button object
* \param I : the position :
* - L2D_BUTTON_TEXTTOP : centered, above the bitmap if a bitmap is, near the top of the widow else.
* - L2D_BUTTON_TEXTRIGHT : vertically centered, at right of the bitmap if a bitmap is, near the right of the window, else.
* - L2D_BUTTON_TEXTBOTTTOM : centered, below the bitmap if a bitmap is, near the bottom of the widow else.
* - L2D_BUTTON_TEXTLEFT : vertically centered, at left of the bitmap if a bitmap is, near the left of the window, else.
* \param I : the position from the bitmap, if any :
* - L2D_BUTTON_POSABSOLUTE : the given position (below) is relative at the button
* - L2D_BUTTON_POSRELATIVE : the given position (below) is relative at the bitmap
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : the given position is incorrect
**/
fun lib2s_butSetTextPos (strBut, pos, ref)=
if std_objIsNil strBut then
1
else if !std_tupleIsFound [L2D_BUTTON_TEXTTOP L2D_BUTTON_TEXTRIGHT L2D_BUTTON_TEXTBOTTTOM L2D_BUTTON_TEXTLEFT] pos then
2
else
(
set ref = std_clampT ref [L2D_BUTTON_POSABSOLUTE L2D_BUTTON_POSRELATIVE] L2D_BUTTON_POSABSOLUTE;
set strBut.tButPosTextRef = ref;
set strBut.tButPosText = pos;
0
);;
/*! \brief Get the text position of a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] [I I]
*
* \param L2D_BUTTON : a button object
* \return [I I] : the position if success or nil if an error occurs.
* \see lib2s_butSetTextPos for more informations about this tuple.
**/
fun lib2s_butGetTextPos (strBut)=
if std_objIsNil strBut then
nil
else
[strBut.tButPosText strBut.tButPosTextRef];;
/*! \brief Set the spacing between the graphical elements.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON I] I
*
* \param L2D_BUTTON : a button object
* \param I : the spacing to set, in pixels.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : the given spacing is incorrect
**/
fun lib2s_butSetSpacing (strBut, spacing)=
if std_objIsNil strBut then
1
else if (std_objIsNil spacing) || (spacing < 0) then
2
else
(
set strBut.tButSpacing = spacing;
0
);;
/*! \brief Get the spacing between the graphical elements.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] I
*
* \param L2D_BUTTON : a button object
* \return I : the spacing if success or nil if an error occurs.
**/
fun lib2s_butGetSpacing (strBut)=
if std_objIsNil strBut then
nil
else
strBut.tButSpacing;;
/*! \brief Set the callback when a 'Click' event occurs.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON fun [L2D_BUTTON I I I I] I] I
*
* \param L2D_BUTTON : a button object
* \param fun [L2D_BUTTON I I I I] I : the callback. Supplemental arguments are :
* - I : x click coordinate (always nil if type = L2D_BUTTON_BUTTON),
* - I : y click coordinate (always nil if type = L2D_BUTTON_BUTTON),
* - I : mouse buton number (always nil if type = L2D_BUTTON_BUTTON),
* - I : key mask (1 = shift, 2 = control, 4 = alt)
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
**/
fun lib2d_butSetCbClick (strBut, cb)=
if std_objIsNil strBut then
1
else
(
set strBut.funButClick = cb;
0
);;
/*! \brief Set the callback when a 'Drop files' event occurs.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON fun [L2D_BUTTON [P r1] I I] I] I
*
* \param L2D_BUTTON : a button object
* \param fun [L2D_BUTTON [P r1] I I] I : the callback. Supplemental arguments are :
* - [P r1] : a list of read-reference files,
* - I : x click coordinate,
* - I : y click coordinate
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
**/
fun lib2d_butSetCbDropfiles (strBut, cb)=
if std_objIsNil strBut then
1
else
(
set strBut.funButDropfile = cb;
0
);;
/*! \brief Set the callback when a 'Close' event occurs.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON fun [L2D_BUTTON I] I] I
*
* \param L2D_BUTTON : a button object
* \param fun [L2D_BUTTON I] I : the callback. Supplemental argument is :
* - I : the result : 0, button closed with success or a positive value if error
* (see lib2d_butClose to get more informations).
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
**/
fun lib2d_butSetCbClose (strBut, cb)=
if std_objIsNil strBut then
1
else
(
set strBut.funButClose = cb;
0
);;
/*! \brief Set the callback when a 'Destroy' event occurs.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON fun [I] I] I
*
* \param L2D_BUTTON : a button object
* \param fun [I] I : the callback. The argument is :
* - I : the result : 0, button destroyed with success or a positive value if error
* (see lib2d_butDestroy to get more informations).
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
**/
fun lib2d_butSetCbDestroy (strBut, cb)=
if std_objIsNil strBut then
1
else
(
set strBut.funButDestroy = cb;
0
);;
/*! \brief Get the "Click" event callback to a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] fun [L2D_BUTTON I I I I] I
*
* \param L2D_BUTTON : a button object
* \return fun [L2D_BUTTON I I I I] I : the callback if success or nil if an error occurs
* \remark The return will be nil if no callback defined to this button object.
**/
fun lib2d_butGetCbClick (strBut)=
if std_objIsNil strBut then
nil
else
strBut.funButClick;;
/*! \brief Get the "Drop files" event callback to a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] fun [L2D_BUTTON [P r1] I I] I
*
* \param L2D_BUTTON : a button object
* \return fun [L2D_BUTTON [P r1] I I] I : the callback if success or nil if an error occurs
* \remark The return will be nil if no callback defined to this button object.
**/
fun lib2d_butGetCbDropfiles (strBut)=
if std_objIsNil strBut then
nil
else
strBut.funButDropfile;;
/*! \brief Get the "Close" event callback to a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] fun [L2D_BUTTON I] I
*
* \param L2D_BUTTON : a button object
* \return fun [L2D_BUTTON I] I : the callback if success or nil if an error occurs
* \remark The return will be nil if no callback defined to this button object.
**/
fun lib2d_butGetCbClose (strBut)=
if std_objIsNil strBut then
nil
else
strBut.funButClose;;
/*! \brief Get the "Destroy" event callback to a button object.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] fun [I] I
*
* \param L2D_BUTTON : a button object
* \return fun [I] I : the callback if success or nil if an error occurs
* \remark The return will be nil if no callback defined to this button object.
**/
fun lib2d_butGetCbDestroy (strBut)=
if std_objIsNil strBut then
nil
else
strBut.funButDestroy;;
/*! \brief Get the mother window.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] ObjWin
*
* \param L2D_BUTTON : a button object
* \return ObjWin : the mother window if success or nil if an error occurs
* \remark The return will be nil if no mother defined !
**/
fun lib2d_butGetMother (strBut)=
if std_objIsNil strBut then
nil
else
strBut.oButMother;;
/*! \brief Set the background color.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON I] I
*
* \param L2D_BUTTON : a button object
* \param I : the 24-bits color (0 (black) -> 0xFFFFFF (white))
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
**/
fun lib2d_butSetBgColor (strBut, color)=
if std_objIsNil strBut then
1
else
(
set strBut.tButBgColor = std_clamp color 0 0xffffff;
0
);;
/*! \brief Retreive the background color.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] I
*
* \param L2D_BUTTON : a button object
* \return I : this color if success or nil if error
**/
fun lib2d_butGetBgColor (strBut)=
if std_objIsNil strBut then
nil
else
strBut.tButBgColor;;
/*! \brief Set the foreground color, i.e. the title color.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON I] I
*
* \param L2D_BUTTON : a button object
* \param I : the 24-bits color (0 (black) -> 0xFFFFFF (white))
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
**/
fun lib2d_butSetFoColor (strBut, color)=
if std_objIsNil strBut then
1
else
(
set strBut.tButFoColor = std_clamp color 0 0xffffff;
0
);;
/*! \brief Retreive the foreground (title) color.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] I
*
* \param L2D_BUTTON : a button object
* \return I : this color if success or nil if error
**/
fun lib2d_butGetFoColor (strBut)=
if std_objIsNil strBut then
nil
else
strBut.tButFoColor;;
/*! \brief Set the background parameters of the button.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON I I I I] I
*
* \param L2D_BUTTON : a button object
* \param I : define if the background must be drawn :
* - L2D_BUTTON_ENABLE : yes (default),
* - L2D_BUTTON_DISABLE : no.
* \param I : define if the background (except the border) must be drawn :
* - L2D_BUTTON_ENABLE : yes (default),
* - L2D_BUTTON_DISABLE : no.
* \param I : define if the border must be drawn :
* - L2D_BUTTON_ENABLE : yes (default),
* - L2D_BUTTON_DISABLE : no.
* \param I : define the size of the border, in pixels (>= 0, 1 is the default value)
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
**/
fun lib2d_butSetBgParams (strBut, b, fullbg, border, sizeborder)=
if std_objIsNil strBut then
1
else
(
set strBut.tButHasBg = std_clampT b [L2D_BUTTON_DISABLE L2D_BUTTON_ENABLE] L2D_BUTTON_ENABLE;
set strBut.tButBgSets = [
std_clampT fullbg [L2D_BUTTON_DISABLE L2D_BUTTON_ENABLE] L2D_BUTTON_ENABLE
std_clampT border [L2D_BUTTON_DISABLE L2D_BUTTON_ENABLE] L2D_BUTTON_ENABLE
if sizeborder >= 0 then sizeborder else 0
];
0
);;
/*! \brief Get the background parameters of the button.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] [I I I I]
*
* \param L2D_BUTTON : a button object
* \return [I I I I] : these parameters if success or nil if error
* \see lib2d_butSetBgParams
**/
fun lib2d_butGetBgParams (strBut)=
if std_objIsNil strBut then
nil
else
let strBut.tButBgSets -> [fbg border size] in
[strBut.tButHasBg fbg border size];;
/*! \brief Set the flags of the window button.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON I] I
*
* This has an effect with L2D_BUTTON_WINDOW type only (see 'lib2d_butSetType').
* For another type, these flags are ignored.
*
* When the build step is, if a mother window is defined (this case is the mostly current),
* the flag 'WN_CHILDINSIDE' is automatically added. If no mother window set, the flags
* 'WN_NOCAPTION|WN_MENU' are automatically added.
*
* \param L2D_BUTTON : a button object
* \param I : a flag or a combination of flags. The available values are the same
* than _CRwindow ( http://www.scolring.org/files/doc_html/_crwindow.html ). Example : WN_DOWN
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
**/
fun lib2d_butSetWinFlag (strBut, flags)=
if std_objIsNil strBut then
1
else
(
set strBut.iButWinFlags = flags;
0
);;
/*! \brief Get the flags of the window button.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] I
*
* \param L2D_BUTTON : a button object
* \return I : these parameters if success or nil if error or not defined
* \see lib2d_butSetWinFlag
**/
fun lib2d_butGetWinFlag (strBut)=
if std_objIsNil strBut then
nil
else
strBut.iButWinFlags;;
/*! \brief Enable (show) a button.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] I
* \param L2D_BUTTON : a button object
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : the button has a bad type
**/
fun lib2d_butEnable (strBut)=
if std_objIsNil strBut then
1
else
(
set strBut.iButEnable = L2D_BUTTON_ENABLE;
if strBut.iButType == L2D_BUTTON_WINDOW then
(
_SHOWwindow strBut.oButWin WINDOW_UNHIDDEN;
0
)
else if strBut.iButType == L2D_BUTTON_BUTTON then
(
_SHOWbutton strBut.oButButton WINDOW_UNHIDDEN;
0
)
else
2
);;
/*! \brief Disable (hide) a button.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] I
* \param L2D_BUTTON : a button object
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : the button has a bad type
**/
fun lib2d_butDisable (strBut)=
if std_objIsNil strBut then
1
else
(
set strBut.iButEnable = L2D_BUTTON_DISABLE;
if strBut.iButType == L2D_BUTTON_WINDOW then
(
_SHOWwindow strBut.oButWin WINDOW_HIDDEN;
0
)
else if strBut.iButType == L2D_BUTTON_BUTTON then
(
_SHOWbutton strBut.oButButton WINDOW_HIDDEN;
0
)
else
2
);;
/*! \brief Return if a button is shown or hidden (enabled / disabled).
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] I
*
* \param L2D_BUTTON : a button object
* \return I : this state (L2D_BUTTON_ENABLE or L2D_BUTTON_DISABLE) if success
* or nil if error or not defined
* \see lib2d_butSetWinFlag
**/
fun lib2d_butIsEnabled (strBut)=
if std_objIsNil strBut then
nil
else
strBut.iButEnable;;
/*! \brief Build the button.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] I
*
* \param L2D_BUTTON : a button object. It should be set before use this function.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : no bitmap nor title is set. Thus, nothing to build !
* - 3 : one or more needed parameters are nil (all set* functions are not needed,
* according to what you want)
* - 4 : if L2D_BUTTON_WINDOW is set, unable to create the window
* - 5 : if L2D_BUTTON_BUTTON is set, the mother window object is set to nil
* - 6 : if L2D_BUTTON_BUTTON is set, unable to create the button
* - 7 : a bad type is set
**/
fun lib2d_butBuild (strBut)=
if std_objIsNil strBut then
1
else
if (std_objIsNil strBut.oButBitmap) && (std_objIsNil strBut.szButTitle) then
2
else if (std_objIsNil strBut.oButFont) ||
(std_objIsNil strBut.tButSize) ||
(std_objIsNil strBut.tButPos) ||
((std_objIsNil strBut.tButPosBmp) && (!std_objIsNil strBut.oButBitmap)) ||
((std_objIsNil strBut.tButSizeBmp) && (!std_objIsNil strBut.oButBitmap)) ||
(std_objIsNil strBut.tButSpacing) then
3
else
if strBut.iButType == L2D_BUTTON_WINDOW then
let if std_objIsNil strBut.oButMother then WN_NOCAPTION|WN_MENU else WN_CHILDINSIDE -> winflags in
let if std_objIsNil strBut.iButWinFlags then winflags else winflags|strBut.iButWinFlags -> winflags in
let strBut.tButPos -> [x y] in
let strBut.tButSize -> [w h] in
let _CRwindow _channel strBut.oButMother x y w h winflags|WN_DRAGDROP "" -> win in
if std_objIsNil win then
4
else
(
set strBut.oButWin = win;
set strBut.tButPosTextInternal = lib2d_but_postext strBut;
_CBwinClick win @lib2d_but_cbclick strBut;
_CBwinDestroy win @lib2d_but_cbdestroy strBut;
_CBwinDropFile win @lib2d_but_cbdrop strBut;
_CBwinPaint win @lib2d_but_cbpaint strBut;
_PAINTwindow win;
0
)
else if strBut.iButType == L2D_BUTTON_BUTTON then
if std_objIsNil strBut.oButMother then
5
else
let strBut.tButPos -> [x y] in
let strBut.tButSize -> [w h] in
let if std_objIsNil strBut.oButBitmap then
_CRbutton _channel strBut.oButMother x y w h PB_DRAGDROP strBut.szButTitle
else
(
set strBut.tButPosTextInternal = lib2d_but_postext strBut;
lib2d_butbuildbitmap strBut;
_CRbuttonBitmap _channel strBut.oButMother strBut.oButBitmap x y w h PB_DRAGDROP
)
-> button in
if std_objIsNil button then
6
else
(
set strBut.oButButton = button;
_CBbutton button @lib2d_but_cbclick2 strBut;
_CBbuttonDropFile button @lib2d_but_cbdrop strBut;
0
)
else
7;;
/*! \brief Close a button.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] I
*
* When this function is called, the button (window or button) is destroyed itself
* but the structure is kept. The structure can be reused to build the same object
* or it can be modified to build another object. If a full destruction is needed,
* see lib2d_butDestroy.
*
* The 'Close' callback will be ran.
*
* \param L2D_BUTTON : a button object.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : internal error (this case should n't occur)
**/
fun lib2d_butClose (strBut)=
if std_objIsNil strBut then
1
else
if (strBut.iButType == L2D_BUTTON_WINDOW) || (!std_objIsNil strBut.oButWin) then
(
_DSwindow strBut.oButWin;
set strBut.oButWin = nil;
set strBut.iButType = L2D_BUTTON_WINDOW;
0
)
else if (strBut.iButType == L2D_BUTTON_BUTTON) || (!std_objIsNil strBut.oButButton) then
(
_DSbutton strBut.oButButton;
set strBut.oButButton = nil;
set strBut.iButType = L2D_BUTTON_BUTTON;
lib2d_but_cbdestroy nil strBut;
0
)
else
2;;
/*! \brief Destroy a button.
*
* \ingroup _2dos_button
* Prototype : fun [L2D_BUTTON] I
*
* When this function is called, the button is destroyed and and its structure
* is at nil (all parameters are nil). To close the button only, see lib2d_butClose.
*
* The 'Destroy' callback will be ran.
*
* \param L2D_BUTTON : a button object.
* \return I : 0 if success or a positive value if an error occurs :
* - 1 : the button object is nil
* - 2 : internal error (this case should n't occur)
**/
fun lib2d_butDestroy (strBut)=
if std_objIsNil strBut then
1
else
lib2d_but_destroy strBut;;
fun lib2d_but_postext (strBut)=
let strBut.tButSizeBmp -> [wbmp hbmp] in
let strBut.tButPosBmp -> [xbmp ybmp] in
let strBut.tButSize -> [w h] in
let if (std_objIsNil strBut.oButFont) || (std_objIsNil strBut.szButTitle) then
[0 0]
else
let _GETstringSize strBut.oButFont strBut.szButTitle -> [wt ht] in
[wt/2 ht/2]
-> [wtext htext] in
if strBut.tButPosText == L2D_BUTTON_TEXTTOP then
if (std_objIsNil strBut.oButBitmap) || (wbmp == nil) || (strBut.tButPosTextRef == L2D_BUTTON_POSABSOLUTE) then
[w/2 strBut.tButSpacing+htext]
else
[xbmp+(wbmp/2) ybmp-strBut.tButSpacing-htext]
else if strBut.tButPosText == L2D_BUTTON_TEXTBOTTTOM then
if (std_objIsNil strBut.oButBitmap) || (hbmp == nil) || (strBut.tButPosTextRef == L2D_BUTTON_POSABSOLUTE) then
[w/2 h-strBut.tButSpacing-htext]
else
[xbmp+(wbmp/2) ybmp+hbmp+strBut.tButSpacing+htext]
else if strBut.tButPosText == L2D_BUTTON_TEXTLEFT then
if (strBut.tButPosTextRef == L2D_BUTTON_POSABSOLUTE) || (std_objIsNil strBut.oButBitmap) then
[wtext+strBut.tButSpacing h/2]
else
[xbmp-strBut.tButSpacing-wtext ybmp+(hbmp/2)]
else if strBut.tButPosText == L2D_BUTTON_TEXTRIGHT then
if (strBut.tButPosTextRef == L2D_BUTTON_POSABSOLUTE) || (std_objIsNil strBut.oButBitmap) then
[w-strBut.tButSpacing-wtext h/2]
else
[xbmp+wbmp+strBut.tButSpacing+wtext ybmp+(hbmp/2)]
else
nil;;
fun lib2d_butbuildbitmap (strBut)=
if strBut.iButType == L2D_BUTTON_WINDOW then
1
else
let strBut.tButPosTextInternal -> [xtext ytext] in
let lib2d_butGetSize strBut -> [wo ho] in
let lib2d_butGetBitmapSize strBut -> [wbmp hbmp] in
let lib2d_butGetBitmapPos strBut -> [xbmp ybmp] in
let strBut.oButBitmap -> bmp in
( _fooS strcat "x , y = " strcat itoa xtext itoa ytext;
set strBut.oButBitmap = _CPbitmap24
_FILLbitmap
_CRbitmap
_channel wo ho
lib2d_butGetBgColor strBut
xbmp ybmp bmp 0 0 wbmp hbmp nil;
set strBut.oButBitmap = _DRAWtext strBut.oButBitmap strBut.oButFont xtext ytext TD_BASELINE|TD_CENTER lib2d_butGetFoColor strBut strBut.szButTitle;
0
);;
fun lib2d_but_cbdestroy (o, strBut)=
exec strBut.funButClose with [strBut
if std_objIsNil strBut then
1
else
if strBut.iButType == L2D_BUTTON_BUTTON then
if !_DSbutton strBut.oButButton then
0
else
2
else if strBut.iButType == L2D_BUTTON_WINDOW then
if !_DSwindow strBut.oButWin then
0
else
2
else
3
];;
fun lib2d_but_cbdrop (o, strBut, x, y, lFiles)=
if std_objIsNil strBut then
1
else
(
exec strBut.funButDropfile with [strBut lFiles x y];
0
);;
fun lib2d_but_cbclick (o, strBut, x, y, nbutton)=
if std_objIsNil strBut then
1
else
(
exec strBut.funButClick with [strBut x y nbutton _keybdstate];
0
);;
fun lib2d_but_cbclick2 (o, strBut)=
lib2d_but_cbclick nil strBut nil nil nil;;
fun lib2d_but_cbpaint (o, strBut)=
if std_objIsNil strBut then
1
else
if strBut.iButType == L2D_BUTTON_WINDOW then
// let lib2d_but_postext strBut -> [xtext ytext] in
let strBut.tButPosTextInternal -> [xtext ytext] in
let strBut.tButPosBmp -> [xbmp ybmp] in
let strBut.tButSizeBmp -> [wbmp hbmp] in
let strBut.tButSize -> [w h] in
(
if (strBut.tButHasBg == L2D_BUTTON_DISABLE) ||
(std_objIsNil strBut.tButFoColor) ||
(std_objIsNil strBut.tButBgColor) then
nil
else
let strBut.tButBgSets -> [fbg border size] in
let if fbg == L2D_BUTTON_ENABLE then DRAW_SOLID else DRAW_INVISIBLE -> flagbg in
let if border == L2D_BUTTON_ENABLE then DRAW_SOLID else DRAW_INVISIBLE -> flagfo in
_PAINTrectangle strBut.oButWin 0 0 w h flagfo size strBut.tButFoColor flagbg strBut.tButBgColor;
if std_objIsNil strBut.oButBitmap then
nil
else
// _BLTwindow strBut.oButBitmap 0 0 strBut.oButWin xbmp ybmp wbmp hbmp; // not work, I'll check it
// _BLTbitmap strBut.oButWin strBut.oButBitmap xbmp ybmp;
_STBLTbitmap strBut.oButWin xbmp ybmp wbmp hbmp strBut.oButBitmap 0 0 wbmp hbmp;
if std_objIsNil strBut.szButTitle then
nil
else
_TXTout strBut.oButWin strBut.oButFont xtext ytext TD_BASELINE|TD_CENTER lib2d_butGetFoColor strBut strBut.szButTitle;
0
)
else
0;;
fun lib2d_but_destroy (strBut)=
if std_objIsNil strBut then
1
else
let lib2d_but_cbdestroy nil strBut -> res in
(
_DSbitmap strBut.oButBitmap;
_DSfont strBut.oButFont;
set strBut.oButBitmap = nil;
set strBut.oButFont = nil;
set strBut.iButType = nil;
set strBut.oButMother = nil;
set strBut.tButSize =
set strBut.tButPos =
set strBut.tButSizeBmp =
set strBut.tButPosBmp =
set strBut.tButPosTextInternal =
nil;
set strBut.tButPosText =
set strBut.tButSpacing =
set strBut.iButEnable =
set strBut.tButPosTextRef =
set strBut.tButBgColor =
set strBut.tButFoColor =
set strBut.tButHasBg =
set strBut.iButWinFlags =
nil;
set strBut.szButTitle = nil;
set strBut.tButBgSets = nil;
set strBut.funButClick = nil;
set strBut.funButDropfile = nil;
set strBut.funButClose = nil;
set strBut.funButNew = nil;
exec strBut.funButDestroy with [res];
set strBut.funButDestroy = nil;
set strBut = nil;
res
);;