/*
-----------------------------------------------------------------------------
This source file is part of OpenSpace3D
For the latest info, see http://www.openspace3d.com
Copyright (c) 2012 I-maginer
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
-----------------------------------------------------------------------------
*/
/* ********************************************************************************************* /
Graphic / os mixed 2D library
Version: 1.0
Author: Bastien BOURINEAU / I-maginer
Last update: 05.11.2010
TODO :
- size bar (jauge)
/ ********************************************************************************************* */
// Doxygen groups
/*! @defgroup g2dlib OpenSpace3D high level 2D library
* OpenSpace3D high level 2D library
* @{
*/
/*! @defgroup g2dcolorTools Color manipulation
* Color manipulation
* @{
*/
/** @} */
/*! @defgroup g2dbmpTools Bitmap manipulation
* Bitmap manipulation
* @{
*/
/** @} */
/*! @defgroup g2dWindow Window control
* Window control
* @{
*/
/** @} */
/*! @defgroup g2dtabTools Tab control
* Tab control
* @{
*/
/** @} */
/*! @defgroup g2dToolbar Toolbar control
* Toolbar control
* @{
*/
/** @} */
/*! @defgroup g2dLabel Text label control
* Text label control
* @{
*/
/** @} */
/*! @defgroup g2dText Text control
* Text control
* @{
*/
/** @} */
/*! @defgroup g2dLineText Text line control
* Text line control
* @{
*/
/** @} */
/*! @defgroup g2dEditText Edit text control
* Edit text control
* @{
*/
/** @} */
/*! @defgroup g2dButton Button control
* Button control
* @{
*/
/** @} */
/*! @defgroup g2dCheck Check box control
* Check box control
* @{
*/
/** @} */
/*! @defgroup g2dList List control
* List control
* @{
*/
/** @} */
/*! @defgroup g2dSelect Select control
* Select control
* @{
*/
/** @} */
/*! @defgroup g2dTree Tree control
* Tree control
* @{
*/
/** @} */
/*! @defgroup g2dBitmap Bitmap control
* Bitmap control
* @{
*/
/** @} */
/*! @defgroup g2dFloat Float/Int control
* Float/Int control
* @{
*/
/** @} */
/*! @defgroup g2dDate Date control
* Date control
* @{
*/
/** @} */
/*! @defgroup g2d3D 3D control
* 3D control
* @{
*/
/** @} */
/*! @defgroup g2dColormap Color map control
* Color map control
* @{
*/
/** @} */
/*! @defgroup g2dColorBtn Color button control
* Color button control
* @{
*/
/** @} */
/*! @defgroup g2dSlider Slider control
* Slider control
* @{
*/
/** @} */
/** @} */
/* ********************************************************************************************* /
Default resources
/ ********************************************************************************************* */
var iG2DDEFAULTBACKGROUNDCOLOR = 0x373737;;
var iG2DDEFAULTFONTCOLOR = 0x0;;
var iG2DDEFAULTLABELFONTCOLOR = 0xffffff;;
var iG2DDEFAULTFRAMEFONTCOLOR = 0xffffff;;
var iG2DDEFAULTTIMELINEEDITORBGCOLOR = 0x373737;;
var iG2DDEFAULTTIMELINEEDITORTRACKONCOLOR = 0x888888;;
var iG2DDEFAULTTIMELINEEDITORKEYINTERONCOLOR = 0xaaaaaa;;
var iG2DDEFAULTTIMELINEEDITORKEYINTEROFFCOLOR = 0x7d7d7d;;
var iG2DDEFAULTTIMELINEEDITORKEYONCOLOR = 0x888888;;
var iG2DDEFAULTTIMELINEEDITORKEYBORDERONCOLOR = 0xffffff;;
var iG2DDEFAULTTIMELINEEDITORTRACKOFFCOLOR = 0x373737;;
var iG2DDEFAULTTIMELINEEDITORKEYOFFCOLOR = 0x373737;;
var iG2DDEFAULTTIMELINEEDITORKEYBORDEROFFCOLOR = 0xeeeeee;;
var iG2DDEFAULTTIMELINEEDITORBORDERWIDTH = 1;;
var iG2DDEFAULTMODULEEDITORBGCOLOR = 0x7d7d7d;;
var iG2DDEFAULTMODULEEDITORDOTCOLOR = 0xffffff;;
var iG2DDEFAULTMODULEEDITORBOXBORDEROFFCOLOR = 0xeeeeee;;
var iG2DDEFAULTMODULEEDITORBOXBORDERONCOLOR = 0xffffff;;
var iG2DDEFAULTMODULEEDITORBOXOFFCOLOR = 0x373737;;
var iG2DDEFAULTMODULEEDITORBOXONCOLOR = 0x888888;;
var iG2DDEFAULTMODULEEDITORBOXDISABLEOFFCOLOR = 0x000099;;
var iG2DDEFAULTMODULEEDITORBOXDISABLEONCOLOR = 0x0000bf;;
var iG2DDEFAULTMODULEEDITORBOXTEXTONCOLOR = 0xffffff;;
var iG2DDEFAULTMODULEEDITORBOXTEXTOFFCOLOR = 0xeeeeee;;
var iG2DDEFAULTMODULEEDITORLINKOFFCOLOR = 0xaaaaaa;;
var iG2DDEFAULTMODULEEDITORLINKONCOLOR = 0xffffff;;
var iG2DDEFAULTMODULEEDITORROUNDLINKSIZE = 24;;
var iG2DDEFAULTMODULEEDITORBORDERWIDTH = 1;;
var sG2DDEFAULTRESOURCESPATH = "tools/os3dlib/res/";;
var sG2DUPDOWNVALUECURSOR = "valuesupdown_cursor.bmp";;
var sG2DHCOLORPICKERCURSOR = "colorpicker_cursor.bmp";;
var sG2DHSIZECURSOR = "hsize_cursor.bmp";;
var sG2DWSIZECURSOR = "wsize_cursor.bmp";;
var sG2DDEFAULTCHKTAB = "edit/chktab.png";;
var sG2DDEFAULTCLOSETAB = "edit/btnclosetab.png";;
var sG2DDEFAULTBTNTABLEFT = "edit/btnleft.png";;
var sG2DDEFAULTBTNTABRIGHT = "edit/btnright.png";;
var sG2DDEFAULTBTNVALUP = "edit/btnup.png";;
var sG2DDEFAULTBTNVALDOWN = "edit/btndown.png";;
var sG2DDEFAULTBTNCOLORPICKER = "edit/btncolorpicker.png";;
var sG2DDEFAULTCHKFRAMEFOLD = "edit/chkframeminmax.png";;
var sG2DDEFAULTCHKSFOLDER = "edit/tb_sfolder.png";;
var sG2DDEFAULTCHKLFOLDER = "edit/tb_lfolder.png";;
var sG2DDEFAULTBTNNFOLDER = "edit/tb_nfolder.png";;
var sG2DCOLORMAP = "edit/work.png";;
var sG2DCOLORMAPCROSS = "edit/cross.png";;
/* ********************************************************************************************* /
structs
/ ********************************************************************************************* */
struct EdTheme=[
EDT_channel : Chn,
EDT_fontLabel : ObjFont,
EDT_iMainBackgroundColor : I,
EDT_iLabelColor : I,
EDT_iToolBarColor : I,
EDT_lAlphaResources : [[S AlphaBitmap] r1],
EDT_cursorColorPicker : ObjCursor,
EDT_sColorMap : S,
EDT_abmpColorMapCross : AlphaBitmap,
EDT_abmpColorMapPickerBtn : AlphaBitmap,
EDT_iTabBarColor : I,
EDT_abmpTabCheck : AlphaBitmap,
EDT_abmpTabClose : AlphaBitmap,
EDT_abmpTabLeft : AlphaBitmap,
EDT_abmpTabRight : AlphaBitmap,
EDT_fontTab : ObjFont,
EDT_iTabFontColor : I,
EDT_cursorUpDownValue : ObjCursor,
EDT_cursorHSize : ObjCursor,
EDT_cursorWSize : ObjCursor,
EDT_abmpValUp : AlphaBitmap,
EDT_abmpValDown : AlphaBitmap,
EDT_abmpFrameFold : AlphaBitmap,
EDT_sFrameFontName : S,
EDT_iFrameFontSize : I,
EDT_iFrameFontColor : I,
EDT_iFrameBarColor : I,
EDT_iFrameBarHeight : I,
EDT_fontToolTip : ObjFont,
EDT_fontModuleEditor : ObjFont,
EDT_iModuleEditorBg : I,
EDT_iModuleEditorDot : I,
EDT_iModuleEditorBoxOff : I,
EDT_iModuleEditorBoxOn : I,
EDT_iModuleEditorBoxDisableOff: I,
EDT_iModuleEditorBoxDisableOn : I,
EDT_iModuleEditorBoxTextOff : I,
EDT_iModuleEditorBoxTextOn : I,
EDT_iModuleEditorLinkOff : I,
EDT_iModuleEditorLinkOn : I,
EDT_iModuleEditorRLinkSize : I,
EDT_iModuleEditorBorderWidth : I,
EDT_iModuleEditorBoxBorderOff : I,
EDT_iModuleEditorBoxBorderOn : I,
EDT_fontTimeLineEditor : ObjFont,
EDT_iTimeLineEditorBg : I,
EDT_iTimeLineEditorTrackOff : I,
EDT_iTimeLineEditorTrackOn : I,
EDT_iTimeLineEditorKeyOff : I,
EDT_iTimeLineEditorKeyOn : I,
EDT_iTimeLineEditorBorderWidth : I,
EDT_iTimeLineEditorKeyInterOff : I,
EDT_iTimeLineEditorKeyInterOn : I,
EDT_iTimeLineEditorKeyBorderOff : I,
EDT_iTimeLineEditorKeyBorderOn : I
] mkEdTheme;;
typeof EdDefaultTheme = EdTheme;;
struct EdTreeItem=[
EDTITEM_item : ObjTreeItem,
EDTITEM_sLabel : S,
EDTITEM_sValue : S,
EDTITEM_iType : I,
EDTITEM_iState : I,
EDTITEM_father : EdTreeItem,
EDTITEM_bmpIdx : BitmapIndex,
EDTITEM_lSons : [EdTreeItem r1]
] mkEdTreeItem;;
struct EdSlider=[
EDSLIDER_cont : ObjContainer,
EDSLIDER_cbmpBack : CompBitmap,
EDSLIDER_abmpBack : AlphaBitmap,
EDSLIDER_cbmpCursor : CompBitmap,
EDSLIDER_abmpCursor : AlphaBitmap,
EDSLIDER_nodeCursor : ObjNode,
EDSLIDER_tooltip : [ObjContainer CompText],
EDSLIDER_fValue : F,
EDSLIDER_fMinValue : F,
EDSLIDER_fMaxValue : F,
EDSLIDER_cbValue : fun [EdControl F] I
] mkEdSlider;;
struct EdTLKey=[
EDTLK_sName : S,
EDTLK_track : EdTLTrack,
EDTLK_cbmpKey : CompBitmap,
EDTLK_abmpKey : AlphaBitmap,
EDTLK_bmpOn : ObjBitmap,
EDTLK_bmpOff : ObjBitmap,
EDTLK_node : ObjNode,
EDTLK_fKeyPos : F,
EDTLK_fKeyLength : F
] mkEdTLKey;;
struct EdTLTrack=[
EDTLT_timeLineEditor : EdTimeLineEditor,
EDTLT_cont : ObjContainer,
EDTLT_lKey : [EdTLKey r1]
] mkEdTLTrack;;
struct EdTimeLineEditor=[
EDTLE_win : EdWindow,
EDTLE_winDmi : EdWindow,
EDTLE_slider : EdControl,
EDTLE_iLeftStatus : I,
EDTLE_statusBar : EdToolBar,
EDTLE_statusText : CompText,
EDTLE_iTrackHeight : I,
EDTLE_iPixelPerUnit : I,
EDTLE_fZoomCoef : F,
EDTLE_fLength : F,
EDTLE_fValue : F,
EDTLE_lTrack : [EdTLTrack r1],
EDTLE_selectedTrack : EdTLTrack,
EDTLE_selectedKey : EdTLKey,
EDTLE_tooltip : [ObjContainer CompText],
EDTLE_cbValue : fun [EdControl F] I,
EDTLE_cbSelectTrack : fun [EdControl EdTLTrack] I,
EDTLE_cbSelectKey : fun [EdControl EdTLKey] I
] mkEdTimeLineEditor;;
struct EdControl=[
EDC_channel : Chn,
EDC_father : EdWindow,
EDC_resizeFlag : I,
EDC_theme : EdTheme,
EDC_coords : [I I I I I I],
EDC_label : ObjText,
EDC_colorLabel : [ObjContainer CompText],
EDC_text : ObjText,
EDC_editText : ObjText,
EDC_editLine : ObjText,
EDC_editFloat : [ObjText ObjContainer CompRollOver CompRollOver F F F F I I ObjCursor I fun [EdControl F] I fun [EdControl F] I fun [EdControl F F] I Timer],
EDC_editDate : [EdControl EdControl EdControl EdControl EdControl fun [EdControl I I I] I],
EDC_button : [ObjButton fun [EdControl] I],
EDC_colorButton : [ObjButton ObjBitmap EdWindow I I fun[EdControl I] I],
EDC_check : ObjCheck,
EDC_list : [ObjList [[I [S [[S r1] I]]] r1]],
EDC_tree : [ObjTree [[[ObjTreeItem EdTreeItem] r1] [[S EdTreeItem] r1] ObjBitmapList [[S BitmapIndex] r1]] EdTreeItem EdTreeItem fun [EdControl EdTreeItem EdTreeItem S I] I],
EDC_bitmap : [ObjContainer AlphaBitmap CompBitmap ObjBitmap S I I fun [EdControl I I I I] I fun [EdControl I I I] I],
EDC_select : ObjBox,
EDC_bitmapList : [ObjContainer I I I [[I [AlphaBitmap CompBitmap CompBitmap S S]] r1] fun [EdControl S I I] I fun [EdControl S I I] I],
EDC_modulesEditor : EdModuleEditor,
EDC_view3d : V3Dview,
EDC_slider : EdSlider,
EDC_timeLineEditor : EdTimeLineEditor,
EDC_toolTip : [ObjContainer CompText I],
EDC_fParam : F,
EDC_iParam : I
] mkEdControl;;
struct EdModuleEditor=[
EDM_channel : Chn,
EDM_winScroll : EdWindow,
EDM_winDmi : EdWindow,
EDM_bmpBack : EdControl,
EDM_cont : ObjContainer,
EDM_abmpLinks : AlphaBitmap,
EDM_cbmpLinks : CompBitmap,
EDM_abmpLayer : AlphaBitmap,
EDM_cbmpLayer : CompBitmap,
EDM_node : ObjNode,
EDM_info : EdControl,
EDM_bSortMenus : I,
EDM_fScale : F,
EDM_iSnap : I,
EDM_iBoxMode : I,
EDM_bBoxClicked : I,
EDM_bLinkClicked : I,
EDM_moveCoords : [I I],
EDM_sizeSurface : [I I],
EDM_tLastClickPos : [I I],
EDM_tLastCursorPos : [I I],
EDM_tLastLocalClickPos : [I I],
EDM_tLastLocalCursorPos : [I I],
EDM_iLinkMode : I, // link creation
EDM_iLinkInfos : [S r1],
EDM_bLinksFilter : I,
EDM_bLinksCurved : I,
EDM_selectedBox : [EdModuleBox r1],
EDM_lastSelectedBox : [EdModuleBox r1],
EDM_mnuBox : EdModuleBox,
EDM_selectedRoundLink : [EdModuleRoundLink r1],
EDM_lBox : [[S EdModuleBox] r1],
EDM_lLinks : [EdModuleLink r1],
EDM_lRoundLinks : [EdModuleRoundLink r1],
EDM_cbRoundLinkClick : fun [EdControl EdModuleRoundLink I I] I,
EDM_cbRoundLinkUnClick : fun [EdControl EdModuleRoundLink I I] I,
EDM_cbRoundLinkDbClick : fun [EdControl EdModuleRoundLink I I] I,
EDM_cbRoundLinkDestroy : fun [EdControl EdModuleRoundLink] I,
EDM_cbRoundLinkUpdate : fun [EdControl EdModuleRoundLink] I,
EDM_cbBoxSelect : fun [EdControl EdModuleBox] I,
EDM_cbBoxClick : fun [EdControl EdModuleBox I I] I,
EDM_cbBoxUnClick : fun [EdControl EdModuleBox I I] I,
EDM_cbBoxDbClick : fun [EdControl EdModuleBox I I] I,
EDM_cbBoxMove : fun [EdControl EdModuleBox I I] I,
EDM_cbBoxMenu : fun [EdControl EdModuleBox [S r1] [S r1]] I,
EDM_cbSelectedBoxMoving : fun [EdControl I I I] I,
EDM_cbClick : fun [EdControl I I I I] I,
EDM_cbUnClick : fun [EdControl I I I I] I,
EDM_cbDbClick : fun [EdControl I I I I] I,
EDM_cbKeyDown : fun [EdControl I I] I,
EDM_cbKeyUp : fun [EdControl I] I
] mkEdModuleEditor;;
struct EdModuleBox=[
EDB_father : EdModuleEditor,
EDB_sName : S,
EDB_sLabel : S,
EDB_sToolTip : S,
EDB_sDesc : S,
EDB_lParams : [S r1],
EDB_compBmp : CompBitmap,
EDB_alphaBmp : AlphaBitmap,
EDB_bmpOn : ObjBitmap,
EDB_bmpOff : ObjBitmap,
EDB_node : ObjNode,
EDB_pos : [I I],
EDB_bHasMoved : I,
EDB_iKeybState : I,
EDB_iWidth : I,
EDB_iHeight : I,
EDB_lMenus : [[I [[S [S r1]] r1]] r1],
EDB_tooltip : [ObjContainer CompText],
EDB_iFlags : I,
EDB_iColorOn : I,
EDB_iColorOff : I,
EDB_bState : I,
EDB_bEnable : I
] mkEdModuleBox;;
struct EdModuleRoundLink=[
EDRL_srcModuleBox : EdModuleBox,
EDRL_dstModuleBox : EdModuleBox,
EDRL_lLinks : [EdModuleLink r1],
EDRL_compBmp : CompBitmap,
EDRL_alphaBmp : AlphaBitmap,
EDRL_bmpOn : ObjBitmap,
EDRL_bmpOff : ObjBitmap,
EDRL_node : ObjNode,
EDRL_tooltip : [ObjContainer CompText],
EDRL_iFlag : I,
EDRL_bState : I
] mkEdModuleRoundLink;;
struct EdModuleLink=[
EDL_srcModuleBox : EdModuleBox,
EDL_dstModuleBox : EdModuleBox,
EDL_lParams : [S r1],
EDL_sParams : S,
EDL_rLink : EdModuleRoundLink,
EDL_bState : I
] mkEdModuleLink;;
struct EdWindow=[
EDW_channel : Chn,
EDW_father : EdWindow,
EDW_prevFather : EdWindow,
EDW_fatherWin : ObjWin,
EDW_lSons : [EdWindow r1],
EDW_win : ObjWin,
EDW_virtualWin : ObjWin,
EDW_bIsAx : I,
EDW_lToolbar : [EdToolBar r1],
EDW_resizeFlag : I,
EDW_bMinimize : I,
EDW_tMdecal : [I I],
EDW_coords : [I I I I I I],
EDW_initCoords : [I I I I I I],
EDW_tLastCursorPos : [I I],
EDW_tLastClickPos : [I I],
EDW_modeFlag : I, // 0 normal 1 popup 2 inside popup 4 frame with title bar 8 group
EDW_bVisible : I,
EDW_iBackColor : I,
EDW_lControl : [EdControl r1],
EDW_cbSize : fun [EdWindow I I] I,
EDW_cbMove : fun [EdWindow I I] I,
EDW_cbVirtualSize : fun [EdWindow I I] I,
EDW_cbVirtualMove : fun [EdWindow I I] I,
EDW_cbDestroy : fun [EdWindow] I,
EDW_cbClose : fun [EdWindow] I,
EDW_cbKeyDown : fun [EdWindow I I] I,
EDW_cbKeyUp : fun [EdWindow I] I,
EDW_cbCursorMove : fun [EdWindow I I I] I,
EDW_cbMouseClick : fun [EdWindow I I I] I,
EDW_cbMouseUnClick : fun [EdWindow I I I] I,
EDW_cbDrop : fun [EdWindow I I [P r1]] I,
EDW_cbFocus : fun [EdWindow] I
] mkEdWindow;;
struct EdFileDialog=[
EDFD_channel : Chn,
EDFD_dialog : EdWindow,
EDFD_toolBar : EdToolBar,
EDFD_dirTree : EdControl,
EDFD_fileList : EdControl,
EDFD_fileName : EdControl,
EDFD_fileType : EdControl,
EDFD_fileInfo : EdControl,
EDFD_openBtn : EdControl,
EDFD_lFiletypes : [[S [S r1]] r1],
EDFD_lFileExt : [S r1],
EDFD_sBasePath : S,
EDFD_sPath : S,
EDFD_cbMulti : fun [[P r1]] I,
EDFD_cbFile : fun [P] I,
EDFD_cbSave : fun [W] I,
EDFD_cbInfo : fun [P] S,
EDFD_cbFilter : fun [P] I,
EDFD_iFlags : I,
EDFD_bSave : I
] mkEdFileDialog;;
var EDFILE_DIALOG_MULTI = 1;;
var EDFILE_DIALOG_LIST_FOLDERS = 2;;
var EDFILE_DIALOG_SHOW_INFOS = 4;;
var EDFILE_DIALOG_SHOW_TOOLBAR = 8;;
var EDFILE_DIALOG_SYSTEM_FILES = 16;;
var EDFILE_DIALOG_FILTER_BITMAP = 32;;
var lEDFILE_DIALOG_SYSTEM_PATHS = "/tools"::"/tmp"::"/locked"::"/lib"::nil;;
/*! @ingroup g2dWindow
* @defgroup 2DresizeFlags EdWindow and EdControl resize flags
* EdWindow and EdControl resize flags
* @{
*/
var EDWIN_RESIZE_NONE = 0;;
var EDWIN_RESIZE_LW = 1;; //!< left border is at a flexible distance from the left border of the parent zone
var EDWIN_RESIZE_MW = 2;; //!< width is a flexible value
var EDWIN_RESIZE_RW = 4;; //!< right border is at a flexible distance from the right border of the parent zone
var EDWIN_RESIZE_LH = 8;; //!< top border is at a flexible distance from the top border of the parent zone
var EDWIN_RESIZE_MH = 16;; //!< height is a flexible value
var EDWIN_RESIZE_RH = 32;; //!< bottom border is at a flexible distance from the bottom border of the parent zone
var EDWIN_RESIZE_ALL = 64;; //!< all flexible
/** @} */
/*! @ingroup g2dWindow
* @defgroup 2DtypeFlags EdWindow types flags
* EdWindow types flags
* @{
*/
var EDWIN_DIALOG = 1;;
var EDWIN_POPUP = 2;;
var EDWIN_FRAME = 4;;
var EDWIN_GROUP = 8;;
var EDWIN_TAB = 16;;
var EDWIN_MODAL = 32;;
/** @} */
proto crEdWindow = fun [Chn EdWindow I I I I I I I S] EdWindow;;
proto dsEdWindow = fun [EdWindow] I;;
proto resizeEdWindowVirtualSize = fun [EdWindow] I;;
proto getEdWindowToolBarSize = fun [EdWindow] [I I];;
proto setEdWindowVisible = fun [EdWindow I] EdWindow;;
proto dsEdWindowCtrlList = fun [[EdControl r1]] I;;
struct EdToolBar=[
ETB_channel : Chn,
ETB_win : ObjWin,
ETB_cont : ObjContainer,
ETB_pos : [I I],
ETB_size : [I I],
ETB_modeflag : I,
ETB_iBgColor : I,
ETB_iHmargin : I,
ETB_iVmargin : I,
ETB_iCurrentLpos : I,
ETB_iCurrentRpos : I,
ETB_iCurrentTpos : I,
ETB_iCurrentBpos : I,
ETB_lButton : [CompRollOver r1], // cb ctrl btn mask
ETB_lBmp : [CompBitmap r1], // cb ctrl btn mask isdbclick
ETB_lCheck : [CompCheck r1], // cb ctrl btn mask state
ETB_lText : [[CompText ObjFont] r1], // cb ctrl btn mask
ETB_tabBar : EdTabBar,
ETB_lTooltip : [[ObjNode [ObjContainer CompText]] r1],
ETB_lControl : [[ObjNode I] r1],
ETB_fontTooltip : ObjFont,
ETB_bVisible : I
] mkEdToolBar ;;
/*! @ingroup g2dToolbar
* @defgroup TBtypeFlags EdToolBar flags
* EdToolBar flags
* @{
*/
var ETB_HORIZONTAL = 1;;
var ETB_VERTICAL = 2;;
var ETB_BOTTOM = 4;;
var ETB_ALIGN_LEFT = 1;;
var ETB_ALIGN_RIGHT = 2;;
var ETB_ALIGN_TOP = 4;;
var ETB_ALIGN_BOTTOM = 8;;
/** @} */
struct EdTabBar=[
ETABBAR_channel : Chn,
ETABBAR_cont : ObjContainer,
ETABBAR_node : ObjNode,
ETABBAR_targetWin : EdWindow,
ETABBAR_iHeight : I, // height of the toolbar
ETABBAR_pos : [I I],
ETABBAR_size : [I I],
ETABBAR_rightPos : I,
ETABBAR_iMargin : I,
ETABBAR_iCurrentLpos : I,
ETABBAR_lTab : [EdTab r1],
ETABBAR_theme : EdTheme,
ETABBAR_lastTab : EdTab,
ETABBAR_currentTab : EdTab,
ETABBAR_contScroll : ObjContainer,
ETABBAR_btnScrollL : CompRollOver,
ETABBAR_btnScrollR : CompRollOver,
ETABBAR_iScrollPos : I
] mkEdTabBar ;;
struct EdTab=[
ETAB_channel : Chn,
ETAB_tabBar : EdTabBar,
ETAB_abmpTab : AlphaBitmap,
ETAB_sName : S,
ETAB_win : EdWindow,
ETAB_chk : CompCheck,
ETAB_closeBtn : CompRollOver,
ETAB_cbShow : fun [EdTab] I,
ETAB_cbHide : fun [EdTab] I,
ETAB_cbFocused : fun [EdTab] I,
ETAB_cbClosed : fun [EdTab] I,
ETAB_modeFlag : I,
ETAB_bState : I
] mkEdTab ;;
proto focusEdTab = fun [EdTabBar EdTab] I;;
proto dsEdTab = fun [EdTabBar EdTab] I;;
proto setEdCtrlSize = fun [EdControl I I] I;;
proto setEdCtrlPositionSize = fun [EdControl I I I I] I;;
proto selectEdCtrlTimeLineTrack = fun [EdControl EdTLTrack] EdTLTrack;;
proto selectEdCtrlTimeLineKey = fun [EdControl EdTLKey] EdTLKey;;
proto setEdCtrlVisible = fun [EdControl I] I;;
proto setEdCtrlEnable = fun [EdControl I] I;;
var ETAB_CLOSEBTN = 1;;
/* ********************************************************************************************* /
Common part
/ ********************************************************************************************* */
fun G2DcrFont(chan, fontsize, rot, flags, fontname)=
if (!strcmpi currentLanguage "chinese") then
_CRfontExt chan fontsize rot flags fontname 134
else if (!strcmpi currentLanguage "russian") then
_CRfontExt chan fontsize rot flags fontname 204
else
_CRfont chan fontsize rot flags fontname;;
/*! \brief Get the width and height size of a string list calculated using font
*
* Used by G2DgetStringSize, you shoud use G2DgetStringSize only
* Prototype: fun [ObjFont [S r1] I I] [I I]
*
* \param ObjFont : font
* \param [S r1] : string list to calculate
* \param I : should be 0
* \param I : should be 0
*
* \return [I I] : [width height] in pixel size
**/
fun G2DgetStringSize2(font, txtList, w, h)=
if txtList == nil then [w+1 h]
else let txtList -> [first next] in
let _GETstringSize font (if first != nil then first else "") -> [nw nh] in
let if (!strcmpi currentLanguage "chinese") then [nw nh + 2] else [nw nh] -> [nw nh] in
G2DgetStringSize2 font next (if nw>w then nw else w) (nh+h)
;;
/*! \brief Get the width and height size of a string calculated using font
*
* Prototype: fun [ObjFont S] [I I]
*
* \param ObjFont : font
* \param S : string to calculate
*
* \return [I I] : [width height] in pixel size
**/
fun G2DgetStringSize(font, str)= G2DgetStringSize2 font (lineextr str) 0 0;;
/*! \brief Get the width and height size of a string list calculated using font
*
* Used by G2DgetStringSize, you shoud use G2DgetStringSize only
* Prototype: fun [ObjFont [S r1] I I] [I I]
*
* \param ObjBTFont : font
* \param [S r1] : string list to calculate
* \param I : should be 0
* \param I : should be 0
*
* \return [I I] : [width height] in pixel size
**/
fun G2DgetStringSize2BT(font, txtList, w, h)=
if txtList == nil then [w+1 h]
else let txtList -> [first next] in
let _BTGETtextSize font first -> [nw nh] in
let if (!strcmpi currentLanguage "chinese") then [nw nh + 2] else [nw nh] -> [nw nh] in
G2DgetStringSize2BT font next (if nw>w then nw else w) (nh+h)
;;
/*! \brief Get the width and height size of a string calculated using font
*
* Prototype: fun [ObjFont S] [I I]
*
* \param ObjBTFont : font
* \param S : string to calculate
*
* \return [I I] : [width height] in pixel size
**/
fun G2DgetStringSizeBT(font, str)= G2DgetStringSize2BT font (lineextr str) 0 0;;
/*! \brief Get the width size of a string calculated using font
*
* Prototype: fun [ObjFont S] I
*
* \param ObjFont : font
* \param S : string to calculate
*
* \return I : width in pixel size
**/
fun G2DgetStrWidth(font,str) =
let G2DgetStringSize font str-> [width _] in
width
;;
/*! @ingroup g2dcolorTools
* \brief Add missed colors in hexa format
*
* Prototype: fun [S] S
*
* \param S : hexa color
* \return S : formated color
**/
fun G2DformatHexaColor(s)=
let 6 - (strlen s) -> size in
while size > 0 do
(
set s = strcat s "0";
set size = size - 1;
);
s;;
/*! @ingroup g2dcolorTools
* \brief format color to hexadecimal value
*
* Prototype: fun [I] S
*
* \param I : color
* \return S : formated color
**/
fun G2DformatHexaColorI(c)=
let c & 255 -> r in
let (c>>8) & 255 -> g in
let (c>>16) & 255 -> b in
let itoh r -> hr in
let itoh g -> hg in
let itoh b -> hb in
let if (strlen hr) != 2 then strcat "0" hr else hr -> hr in
let if (strlen hg) != 2 then strcat "0" hg else hg -> hg in
let if (strlen hb) != 2 then strcat "0" hb else hb -> hb in
strcatn hr::hg::hb::nil;;
/*! @ingroup g2dcolorTools
* \brief Convert an rgba or bgra color to rgba or bgra color
*
* Prototype: fun [I] I
*
* \param I : rgba or bgra color
* \return I : invert rgba or bgra color
**/
fun G2Drgba2bgra(c)=
let c & 0xffffffff -> c in
let get_rgba c -> [r g b a] in
make_rgba b g r a;;
/*! @ingroup g2dcolorTools
* \brief get the alpha from a alpha color
*
* Prototype: fun [I] I
*
* \param I : rgba or bgra color
*
* \return I : alpha
**/
fun G2DgetAlphaFromColor(c)=
let c & 0xffffffff -> c in
let get_rgba c -> [r g b a] in
a;;
/*! @ingroup g2dcolorTools
* \brief set the alpha of a color
*
* Prototype: fun [I I] I
*
* \param I : rgba or bgra color
* \param I : alpha
*
* \return I : new color
**/
fun G2DsetColorAlpha(c, a)=
let c & 0xffffffff -> c in
let get_rgba c -> [r g b _] in
make_rgba r b g a;;
/*! @ingroup g2dcolorTools
* \brief Convert an bgra or bgr color
*
* Prototype: fun [I] I
*
* \param I : bgr color
*
* \return I : bgr color
**/
fun G2Dbgra2bgr(c)=
let c & 0xffffffff -> c in
let get_rgba c -> [b g r a] in
make_rgb b g r ;;
/*! @ingroup g2dcolorTools
* \brief Convert an rgba or rgb color
*
* Prototype: fun [I] I
*
* \param I : rgba color
*
* \return I : rgb color
**/
fun G2Drgba2rgb(c)=
let c & 0xffffffff -> c in
let get_rgba c -> [r g b a] in
make_rgb r g b;;
/*! @ingroup g2dcolorTools
* \brief Convert an bgr to bgra color
*
* Prototype: fun [I I] I
*
* \param I : bgr color
* \param I : alpha
*
* \return I : bgra color
**/
fun G2Dbgr2bgra(c, a)=
let c & 0xffffff -> c in
let c & 255 -> b in
let (c>>8) & 255 -> g in
let (c>>16) & 255 -> r in
make_rgba b g r a;;
/*! @ingroup g2dcolorTools
* \brief Convert an rgb to rgba color
*
* Prototype: fun [I I] I
*
* \param I : rgb color
* \param I : alpha
*
* \return I : rgba color
**/
fun G2Drgb2rgba(c, a)=
let c & 0xffffff -> c in
let c & 255 -> r in
let (c>>8) & 255 -> g in
let (c>>16) & 255 -> b in
make_rgba r g b a;;
/*! @ingroup g2dcolorTools
* \brief Convert an rgb or bgr color to rgb or bgr color
*
* Prototype: fun [I] I
*
* \param I : rgb or bgr color
*
* \return I : invert rgb or bgr color
**/
fun G2Drgb2bgr(c)=
let c & 0xffffff -> c in
let c & 255 -> r in
let (c>>8) & 255 -> g in
let (c>>16) & 255 -> b in
make_rgb b g r;;
/*! @ingroup g2dcolorTools
* \brief Get bgr color
*
* Prototype: fun [I] [I I I]
*
* \param I : rgb color or nil for black
*
* \return [I I I] : [b g r] tuple
**/
fun G2Dgetbgr(c)=
if c == nil then
[0 0 0]
else
let c & 0xffffff -> c in
[(c>>16)&255 (c>>8)&255 c&255];;
/*! @ingroup g2dcolorTools
* \brief Get rgb color
*
* Prototype: fun [I] [I I I]
*
* \param I : rgb color
*
* \return [I I I] : [r g b] tuple
**/
fun G2Dgetrgb(c)=
if c == nil then
[0 0 0]
else
let c & 0xffffff -> c in
[c&255 (c>>8)&255 (c>>16)&255];;
/*! @ingroup g2dcolorTools
* \brief Convert an hsv color to rgb color
*
* Prototype: fun [F F F] I
*
* \param F : h float
* \param F : s float
* \param F : v float
*
* \return I : rgb color
**/
fun G2Dhsv2rgb (h, s, v) = /* rgb 24bits, 0 <= h <= 360, 0 <= s <= 1, 0 <= v <= 1 */
set v = v *. 255.0;
if (s == 0.0)
then
(ftoi v)+((ftoi v)<<8)+((ftoi v)<<16)
else
{
while h >=. 360.0 do set h = h -. 360.0;
while h <. 0.0 do set h = h +. 360.0;
set h = h /. 60.0;
let h -. (itof (ftoi h)) -> f in
let v *. (1.0 -. s) -> p in
let v *. (1.0 -. s *. f) -> q in
let v *. (1.0 -. s *. (1.0 -. f)) -> t in
if ((ftoi h) == 0) then
(ftoi v)+((ftoi t)<<8)+((ftoi p)<<16)
else if (ftoi h)==1 then
(ftoi q)+((ftoi v)<<8)+((ftoi p)<<16)
else if (ftoi h)==2 then
(ftoi p)+((ftoi v)<<8)+((ftoi t)<<16)
else if (ftoi h)==3 then
(ftoi p)+((ftoi q)<<8)+((ftoi v)<<16)
else if (ftoi h)==4 then
(ftoi t)+((ftoi p)<<8)+((ftoi v)<<16)
else if (ftoi h)==5 then
(ftoi v)+((ftoi p)<<8)+((ftoi q)<<16)
else nil;
};;
/*! @ingroup g2dcolorTools
* \brief Convert an rgb color to hsv color
*
* Prototype: fun [I] [F F F]
*
* \param I : rgb color
*
* \return [F F F] : [h s v] color
**/
fun G2Drgb2hsv (c) = /* c = 24 bits color */
let c & 0xffffff -> c in
let (c>>16) & 255 -> b in
let (c>>8) & 255 -> g in
let c & 255 -> r in
let
if r>g
then
if b>r
then
b
else
r
else
if b>g
then
b
else
g
-> mx in
let
if r mn in
let itof mx-mn -> delta in
let
if mx==0
then
itof 0
else
(itof mx-mn) /. itof mx
-> s in
let
if (s>.itof 0) || (s<.itof 0) || (delta>.itof 0) || (delta<.itof 0) /* s != 0 || delta != 0 */
then
(itof 60) *.
if r==mx
then
(itof g-b)/.delta
else if g==mx
then
(itof 2)+.(itof b-r)/.delta
else (itof 4)+.(itof r-g)/.delta
else
itof 0
-> h in
[
// h
if h<.itof 0 then h+.itof 360 else h
// s
s
// v
(itof mx)/.itof 255
];;
/*! @ingroup g2dcolorTools
* \brief Add colors
*
* Prototype: fun [I I] I
*
* \param I : color 1
* \param I : color 2
*
* \return I : new color
**/
fun G2DaddColor(c1, c2)=
let c1 & 255 -> cr1 in
let (c1>>8) & 255 -> g1 in
let (c1>>16) & 255 -> b1 in
let c2 & 255 -> cr2 in
let (c2>>8) & 255 -> g2 in
let (c2>>16) & 255 -> b2 in
make_rgb (min (cr1 + cr2) 255) (min (g1 + g2) 255) (min (b1 + b2) 255);;
/*! @ingroup g2dcolorTools
* \brief Substract colors
*
* Prototype: fun [I I] I
*
* \param I : color 1
* \param I : color 2
*
* \return I : new color
**/
fun G2DsubColor(c1, c2)=
let c1 & 255 -> cr1 in
let (c1>>8) & 255 -> g1 in
let (c1>>16) & 255 -> b1 in
let c2 & 255 -> cr2 in
let (c2>>8) & 255 -> g2 in
let (c2>>16) & 255 -> b2 in
make_rgb (max 0 (min (cr1 - cr2) 255)) (max 0 (min (g1 - g2) 255)) (max 0 (min (b1 - b2) 255));;
/*! @ingroup g2dcolorTools
* \brief Multiply colors
*
* Prototype: fun [I I] I
*
* \param I : color 1
* \param I : color 2
*
* \return I : new color
**/
fun G2DmulColor(c1, c2)=
let 1.0 /. 255.0 -> coef in
let itof (c1 & 255) -> cr1 in
let itof ((c1>>8) & 255) -> g1 in
let itof ((c1>>16) & 255) -> b1 in
let (itof (c2 & 255)) *. coef -> cr2 in
let (itof ((c2>>8) & 255)) *. coef -> g2 in
let (itof ((c2>>16) & 255)) *. coef -> b2 in
make_rgb ftoi (cr1 *. cr2) ftoi (g1 *. g2) ftoi (b1 *. b2);;
/*! @ingroup g2dcolorTools
* \brief Multiply a Color by coef
*
* Prototype: fun [I F] I
*
* \param I : RGB color
* \param F : coef
*
* \return I : new color
**/
fun G2DColorCoef(c1, coef)=
let G2Dgetrgb c1 -> [r g b] in
let min (ftoi ((itof r) *. coef)) 255 -> r in
let min (ftoi ((itof g) *. coef)) 255 -> g in
let min (ftoi ((itof b) *. coef)) 255 -> b in
make_rgb r g b;;
/*! \brief Convert a float into an number of zero limited string
*
* Prototype: fun [F I] S
*
* \param F : float to convert
* \param I : number of 0 after the coma
*
* \return S : float in string
**/
fun G2DgetFtoA(val, nbdec)=
if nbdec >= 6 then
ftoa val
else if nbdec == 0 then
itoa (ftoi val)
else if nbdec == 1 then
ftoa1d val
else if nbdec == 2 then
ftoa2d val
else if nbdec == 3 then
ftoa3d val
else if nbdec == 4 then
ftoa4d val
else if nbdec == 5 then
ftoa5d val
else nil;;
fun G2DcolorIsClear(c)=
let G2Dgetrgb c -> [r g b] in
let r + g + b -> f in
if (f >= 500) then 1 else 0;;
/*! \brief Concat two list to one
*
* Prototype: fun [[u0 r1] [u0 r1]] [u0 r1]
*
* \param [u0 r1] : first list to concat
* \param [u0 r1] : second list to concat
*
* \return [u0 r1] : concatened list
**/
fun G2Dlcat(p, q)=
if p==nil
then
q
else let p -> [h nxt] in
h::G2Dlcat nxt q;;
/*! \brief Test if an element exist in a list
*
* Prototype: fun [[u0 r1] u0] I
*
* \param [u0 r1] : list
* \param u0 : elem to find
*
* \return I : 1 if found else 0
**/
fun G2DisInList(p, q)=
if p==nil
then
0
else let p -> [h nxt] in
if h == q then
1
else G2DisInList nxt q;;
/*! \brief Remove an element from a list
*
* Prototype: fun [[u0 r1] u0] [u0 r1]
*
* \param [u0 r1] : list
* \param u0 : element to remove
*
* \return [u r1] : list without the element
**/
fun G2DremoveFromList(l, elt)=
if l==nil
then
nil
else
let hd l -> elm in
if elm == elt then
tl l
else
(hd l)::G2DremoveFromList tl l elt;;
/*! \brief Remove a string from a list case unsensivity
*
* Prototype: fun [[S r1] S] [S r1]
*
* \param [S r1] : string list
* \param S : string to remove
*
* \return [S r1] : list without the element
**/
fun G2DremoveStringFromList(l, elt)=
if l==nil
then
nil
else
let hd l -> elm in
if !strcmpi elm elt then
tl l
else
(hd l)::G2DremoveStringFromList tl l elt;;
/*! \brief Remove an element from an int indexed list
*
* Prototype: fun [[[I u0] r1] I] [[I u0] r1]
*
* \param [[I u0] r1] : list
* \param I : index
*
* \return [[I u0] r1] : list without the indexed element
**/
fun G2DremoveEdIdxFromList(l, idx)=
if l==nil
then
nil
else
let hd l -> [id _] in
if id == idx then
tl l
else
(hd l)::G2DremoveEdIdxFromList tl l idx;;
/*! \brief Remove an element from an string indexed list
*
* Prototype: fun [[[S u0] r1] S] [[S u0] r1]
*
* \param [[S u0] r1] : list
* \param S : string index
*
* \return [[S u0] r1] : list without the indexed element
**/
fun G2DremoveEdSidFromList(l, sid)=
if l==nil
then
nil
else
let hd l -> [id _] in
if (!strcmp id sid) then
tl l
else
(hd l)::G2DremoveEdSidFromList tl l sid;;
/*! \brief Remove an element from an string indexed list case unsensivity
*
* Prototype: fun [[[S u0] r1] S] [[S u0] r1]
*
* \param [[S u0] r1] : list
* \param S : string index
*
* \return [[S u0] r1] : list without the indexed element
**/
fun G2DremoveEdSidFromListi(l, sid)=
if l==nil
then
nil
else
let hd l -> [id _] in
if (!strcmpi id sid) then
tl l
else
(hd l)::G2DremoveEdSidFromListi tl l sid;;
/*! \brief Get an element from an indexed list by index
*
* Prototype: fun [[[I u0] r1] I] [I u0]
*
* \param [[I u0] r1] : list
* \param I : index
*
* \return [I u0] : the element if found else return NIL
**/
fun G2DgetElemFromListByIndex(l, idx)=
if l==nil
then
nil
else
let hd l -> [id _] in
if idx == id then
hd l
else
G2DgetElemFromListByIndex tl l idx
;;
/*! \brief Split a list in two list at given position
*
* Prototype: fun [[u0 r1] I] [[u0 r1] [u0 r1]]
*
* \param [u0 r1] : list to split
* \param I : position (start at 0), use a negative value for a position from the list end
*
* \return [[u0 r1] [u0 r1]] : splited list
**/
fun G2DsplitList(l, pos)=
let if pos < 0 then ((sizelist l) + (pos + 1)) else pos -> pos in
if (((pos + 1) > (sizelist l)) || (pos == 0)) then [nil l] else
let nil -> l1 in
let nil -> l2 in
(
let sizelist l -> size in
let size - 1 -> i in
while (i >= 0) do
(
let nth_list l i -> elt in
if (i < pos) then
set l1 = elt::l1
else
set l2 = elt::l2;
set i = i - 1;
);
[l1 l2];
);;
/*! \brief Get a cutted string limited by pixel size with a possible concated string at end
*
* Prototype: fun [S I ObjFont S] S
*
* \param S : string to cut
* \param I : max width in pixel
* \param ObjFont : font used
* \param S : string concatened with the cutted string ("...")
*
* \return S : the cutted string
**/
fun G2DgetAbreviation(str,size,font,endstr) =
if (G2DgetStrWidth font str) <= size then
[(G2DgetStrWidth font str) str]
else
G2DgetAbreviation (strcat (substr str 0 ((strlen str)-4)) endstr) size font endstr
;;
/*! @ingroup g2dbmpTools
* \brief Create a resized alpha bitmap
*
* Prototype: fun [AlphaBitmap I I I I I I I I] AlphaBitmap
*
* \param AlphaBitmap : source alpha bitmap
* \param I : x decal
* \param I : y decal
* \param I : left marge
* \param I : right marge
* \param I : fixed width
* \param I : fixed height
* \param I : final width
* \param I : final height
*
* \return AlphaBitmap : the resized alpha bitmap
**/
fun G2DcreateAlphaBitmap(alphabmp, x, y, left, right, ww, hh, w, h)=
let _GETalphaBitmapSize alphabmp -> [aw ah] in
if aw == w && ah == h then
alphabmp
else
let _GETalphaBitmaps alphabmp -> [_ bmpalpha] in
let _FILLbitmap _CRbitmap _channel w h 0 -> bmp in
let _FILLbitmap8 _CRbitmap8 _channel w h 0 -> bmp8 in
(
// create fixed part of bitmap
_CPalphaBitmap bmp left 0 alphabmp x y ww+x hh+y ; /* haut gauche */
_CPalphaBitmap bmp left h-hh alphabmp x y+hh ww+x hh+y ; /* bas gauche */
_CPalphaBitmap bmp w-(ww+right) 0 alphabmp aw-(ww+x) y ww+x hh+y ; /* haut droite */
_CPalphaBitmap bmp w-(ww+right) h-hh alphabmp aw-(ww+x) y+hh ww+x hh+y ; /* bas droite */
// create streched part of bitmap
_SCPalphaBitmap bmp left hh-1 ww+left-1 h-hh alphabmp x hh+y ww+x hh+y ; /* gauche */
_SCPalphaBitmap bmp w-(ww+right) hh w-(right+1) h-hh alphabmp aw-ww+x hh+y aw-1+x hh+y ; /* droite */
_SCPalphaBitmap bmp ww-1+left 0 w-(ww+right) hh-1 alphabmp ww+x y ww+x hh+y ; /* haut */
_SCPalphaBitmap bmp ww+left-1 h-hh w-(ww+right) h-1 alphabmp ww+x ah-(hh+y) ww+x ah-(1+y) ; /* bas */
_SCPalphaBitmap bmp ww+left-1 hh-1 w-(ww+right) h-hh alphabmp ww+x hh+y ww+x hh+y ; /* centre */
// create fixed part of bitmap
_CPbitmap8 bmp8 left 0 bmpalpha x y ww+x hh+y nil; /* haut gauche */
_CPbitmap8 bmp8 left h-hh bmpalpha x y+hh ww+x hh+y nil; /* bas gauche */
_CPbitmap8 bmp8 w-(ww+right) 0 bmpalpha aw-(ww+x) y ww+x hh+y nil; /* haut droite */
_CPbitmap8 bmp8 w-(ww+right) h-hh bmpalpha aw-(ww+x) y+hh ww+x hh+y nil; /* bas droite */
// create streched part of bitmap
_SCPbitmap8 bmp8 left hh-1 ww+left-1 h-hh bmpalpha x hh+y ww+x hh+y nil; /* gauche */
_SCPbitmap8 bmp8 w-(ww+right) hh w-(right+1) h-hh bmpalpha aw-ww+x hh+y aw-1+x hh+y nil; /* droite */
_SCPbitmap8 bmp8 ww-1+left 0 w-(ww+right) hh-1 bmpalpha ww+x y ww+x hh+y nil; /* haut */
_SCPbitmap8 bmp8 ww+left-1 h-hh w-(ww+right) h-1 bmpalpha ww+x ah-(hh+y) ww+x ah-(1+y) nil; /* bas */
_SCPbitmap8 bmp8 ww+left-1 hh-1 w-(ww+right) h-hh bmpalpha ww+x hh+y ww+x hh+y nil; /* centre */
let _CRalphaBitmap _channel bmp bmp8 nil nil -> nalphabmp in
(
_DSalphaBitmap alphabmp;
_DSbitmap bmp;
_DSbitmap8 bmp8;
nalphabmp
);
);;
/*! @ingroup g2dbmpTools
* \brief Create a resized alpha bitmap rollover (5 states)
*
* Prototype: fun [AlphaBitmap I I I I I I I I] AlphaBitmap
*
* \param AlphaBitmap : source alpha bitmap
* \param I : x decal
* \param I : y decal
* \param I : left marge
* \param I : right marge
* \param I : fixed width
* \param I : fixed height
* \param I : final width
* \param I : final height
*
* \return AlphaBitmap : the resized alpha bitmap rollover (5 states)
**/
fun G2DcreateAlphaBitmapRollover(alphabmp, x, y, left, right, ww, hh, w, h)=
let _GETalphaBitmapSize alphabmp -> [aw ah] in
let ah / 5 -> bmph in
let _FILLbitmap _CRbitmap _channel w h nil -> bmp in
let _FILLbitmap8 _CRbitmap8 _channel w h nil -> bmp8 in
let _GETalphaBitmaps alphabmp -> [_ bmpalpha8] in
(
// create fixed part of bitmap
_CPalphaBitmap bmp left 0 alphabmp x y ww+x hh+y ; /* haut gauche */
_CPalphaBitmap bmp left h-hh alphabmp x y+bmph-hh ww+x hh+y ; /* bas gauche */
_CPalphaBitmap bmp w-(ww+right) 0 alphabmp aw-(ww+x) y ww+x hh+y ; /* haut droite */
_CPalphaBitmap bmp w-(ww+right) h-hh alphabmp aw-(ww+x) y+bmph-hh ww+x hh+y ; /* bas droite */
// create streched part of bitmap
_SCPalphaBitmap bmp left hh-1 ww+left-1 h-hh alphabmp x hh+y ww+x hh+y ; /* gauche */
_SCPalphaBitmap bmp w-(ww+right) hh w-(right+1) h-hh alphabmp aw-ww+x hh+y aw-1+x hh+y ; /* droite */
_SCPalphaBitmap bmp ww-1+left 0 w-(ww+right) hh-1 alphabmp ww+x y aw-(ww+x) hh+y ; /* haut */
_SCPalphaBitmap bmp ww+left-1 h-hh w-(ww+right) h-1 alphabmp ww+x y+bmph-hh aw-(ww+x) y+bmph ; /* bas */
_SCPalphaBitmap bmp ww+left-1 hh-1 w-(ww+right) h-hh alphabmp ww+x hh+y aw-(ww+x) hh+y ; /* centre */
// create fixed part of bitmap
_CPbitmap8 bmp8 left 0 bmpalpha8 x y ww+x hh+y nil; /* haut gauche */
_CPbitmap8 bmp8 left h-hh bmpalpha8 x y+bmph-hh ww+x hh+y nil; /* bas gauche */
_CPbitmap8 bmp8 w-(ww+right) 0 bmpalpha8 aw-(ww+x) y ww+x hh+y nil; /* haut droite */
_CPbitmap8 bmp8 w-(ww+right) h-hh bmpalpha8 aw-(ww+x) y+bmph-hh ww+x hh+y nil; /* bas droite */
// create streched part of bitmap
_SCPbitmap8 bmp8 left hh-1 ww+left-1 h-hh bmpalpha8 x hh+y ww+x hh+y nil; /* gauche */
_SCPbitmap8 bmp8 w-(ww+right) hh w-(right+1) h-hh bmpalpha8 aw-ww+x hh+y aw-1+x hh+y nil; /* droite */
_SCPbitmap8 bmp8 ww-1+left 0 w-(ww+right) hh-1 bmpalpha8 ww+x y aw-(ww+x) hh+y nil; /* haut */
_SCPbitmap8 bmp8 ww+left-1 h-hh w-(ww+right) h-1 bmpalpha8 ww+x y+bmph-hh aw-(ww+x) y+bmph nil; /* bas */
_SCPbitmap8 bmp8 ww+left-1 hh-1 w-(ww+right) h-hh bmpalpha8 ww+x hh+y aw-(ww+x) hh+y nil; /* centre */
let _CRalphaBitmap _channel bmp bmp8 nil nil -> nalphabmp in
(
_DSbitmap8 bmp8;
_DSbitmap bmp;
nalphabmp
);
);;
/*! @ingroup g2dbmpTools
* \brief Load an alpha bitmap file (png) to a bitmap
*
* Prototype: fun [Chn P] ObjBitmap
*
* \param Chn : channel
* \param P : file
*
* \return ObjBitmap : the loaded bitmap
**/
fun G2DloadPngToBmpFile (chan, file)=
let _LDalphaBitmap chan file -> alpha in
let _GETalphaBitmapSize alpha -> [w h] in
let _FILLbitmap _CRbitmap chan w h 0xffffff -> newbmp in
(
if alpha == nil then nil else
(
_CPalphaBitmap newbmp 0 0 alpha 0 0 w h;
_DSalphaBitmap alpha;
newbmp;
);
);;
/*! @ingroup g2dbmpTools
* \brief Load an alpha bitmap file (png) to a bitmap
*
* Prototype: fun [Chn S] ObjBitmap
*
* \param Chn : channel
* \param S : file path in scol partition
*
* \return ObjBitmap : the loaded bitmap
**/
fun G2DloadPngToBmp (chan, path)=
G2DloadPngToBmpFile chan (_checkpack path);;
/*! @ingroup g2dbmpTools
* \brief Load an bitmap (bmp, jpg, tga) or alphabitmap (png) file to a bitmap
*
* Prototype: fun [Chn P] ObjBitmap
*
* \param Chn : channel
* \param S : file path
*
* \return ObjBitmap : the loaded bitmap
**/
fun G2DloadBmpFile (chan, file)=
let _LDbitmap chan file -> bmp in
let if bmp == nil then _LDjpeg chan file else bmp -> bmp in
let if bmp == nil then _LDtga chan file else bmp -> bmp in
let if bmp == nil then G2DloadPngToBmpFile chan file else bmp -> bmp in
bmp;;
fun G2DloadBmpPack (chan, file)=
G2DloadBmpFile chan file;;
/*! @ingroup g2dbmpTools
* \brief Load an bitmap (bmp, jpg, tga) or alphabitmap (png) file to a bitmap
*
* Prototype: fun [Chn S] ObjBitmap
*
* \param Chn : channel
* \param S : file path in scol partition
*
* \return ObjBitmap : the loaded bitmap
**/
fun G2DloadBmp (chan, path)=
let _checkpack path -> file in
G2DloadBmpFile chan file;;
/*! @ingroup g2dbmpTools
* \brief Load an bitmap (bmp, jpg, tga) or alphabitmap (png) file to a AlphaBitmap
*
* Prototype: fun [Chn P] AlphaBitmap
*
* \param Chn : channel
* \param P : file path
*
* \return AlphaBitmap : the loaded AlphaBitmap
**/
fun G2DloadAlphaBmpFile(chan, file)=
let nil -> newalpha in
(
let _LDbitmap chan file -> bmp in
let if bmp == nil then _LDjpeg chan file else bmp -> bmp in
let if bmp == nil then _LDtga chan file else bmp -> bmp in
if bmp != nil then
(
let _GETbitmapSize bmp -> [w h] in
let _FILLbitmap8 _CRbitmap8 chan w h 0xff -> bmp8 in
(
set newalpha = _CRalphaBitmap chan bmp bmp8 0 0;
_DSbitmap bmp;
_DSbitmap8 bmp8;
);
0;
)
else
(
set newalpha = _LDalphaBitmap chan file;
0;
);
newalpha;
);;
/*! @ingroup g2dbmpTools
* \brief Load an bitmap (bmp, jpg, tga) or alphabitmap (png) file to a AlphaBitmap
*
* Prototype: fun [Chn S] AlphaBitmap
*
* \param Chn : channel
* \param S : file path in scol partition
*
* \return AlphaBitmap : the loaded AlphaBitmap
**/
fun G2DloadAlphaBmp(chan, path)=
let _checkpack path -> file in
G2DloadAlphaBmpFile chan file;;
/*! @ingroup g2dbmpTools
* \brief Convert a bitmap to a AlphaBitmap
*
* Prototype: fun [Chn ObjBitmap] AlphaBitmap
*
* \param Chn : channel
* \param ObjBitmap : bitmap to convert
*
* \return AlphaBitmap : the AlphaBitmap
**/
fun G2DconvertBmpToAlphaBmp (chan, bmp)=
if bmp != nil then
(
let _GETbitmapSize bmp -> [w h] in
let _FILLbitmap8 _CRbitmap8 chan w h 0xff -> bmp8 in
let _CRalphaBitmap chan bmp bmp8 0 0 -> newalpha in
(
_DSbitmap bmp;
_DSbitmap8 bmp8;
newalpha;
);
)
else nil;;
/*! @ingroup g2dbmpTools
* \brief Strech a bitmap to a new size and keep ratio
*
* Prototype: fun [Chn ObjBitmap I I I] ObjBitmap
*
* \param Chn : channel
* \param ObjBitmap : source bitmap
* \param I : destination width
* \param I : destination height
* \param I : background color
*
* \return ObjBitmap : the bitmap in new size
**/
fun G2DstrechBitmap(chan, bmp, width, height, bcolor)=
let _GETbitmapSize bmp -> [bw bh] in
if (bw == width) && (bh == height) then bmp else
let _FILLbitmap _CRbitmap chan width height bcolor -> newbmp in
let if bh >= bw then ftoi ((itof height) /. ((itof bh) /. (itof bw))) else width -> fw in
let if bh >= bw then height else ftoi ((itof width) /. ((itof bw) /. (itof bh))) -> fh in
_SCPbitmap newbmp ((width / 2) - (fw / 2)) ((height / 2) - (fh / 2)) ((width / 2) + (fw / 2)) ((height / 2) + (fh / 2)) bmp 0 0 bw bh nil
;;
/*! @ingroup g2dbmpTools
* \brief Strech a bitmap to a new size and keep ratio without borders
*
* Prototype: fun [Chn ObjBitmap I I] ObjBitmap
*
* \param Chn : channel
* \param ObjBitmap : source bitmap
* \param I : destination max width
* \param I : destination max height
*
* \return ObjBitmap : the bitmap in new size
**/
fun G2DstrechBitmapToMaxSize(chan, bmp, width, height)=
let _GETbitmapSize bmp -> [bw bh] in
if (bw == width) && (bh == height) then bmp else
let if bh >= bw then ftoi ((itof height) /. ((itof bh) /. (itof bw))) else width -> fw in
let if bh >= bw then height else ftoi ((itof width) /. ((itof bw) /. (itof bh))) -> fh in
let _FILLbitmap _CRbitmap chan fw fh 0 -> newbmp in
_SCPbitmap newbmp 0 0 fw fh bmp 0 0 bw bh nil
;;
/*! @ingroup g2dbmpTools
* \brief Strech an alpha bitmap to a new size and keep ratio
*
* Prototype: fun [Chn ObjAlphaBitmap I I I I] ObjAlphaBitmap
*
* \param Chn : channel
* \param ObjAlphaBitmap : source alpha bitmap
* \param I : destination width
* \param I : destination height
* \param I : keep ratio (1 to enable, 0 otherwise)
* \param I : background color
*
* \return ObjAlphaBitmap : the alpha bitmap in new size
**/
fun G2DstrechAlphaBitmap(chan, bmp, width, height, keepratio, bcolor)=
let _GETalphaBitmapSize bmp -> [bw bh] in
if (bw == width) && (bh == height) then
bmp
else
let _GETalphaBitmaps bmp -> [colorLayer alphaLayer] in
let if bh >= bw then ftoi ((itof height) /. ((itof bh) /. (itof bw))) else width -> fw in
let if bh >= bw then height else ftoi ((itof width) /. ((itof bw) /. (itof bh))) -> fh in
let if keepratio then fw else width -> fw in
let if keepratio then fh else height -> fh in
let _FILLbitmap _CRbitmap chan width height bcolor -> newColorLayer in
let _FILLbitmap8 _CRbitmap8 chan width height 0 -> newAlphaLayer in
(
_SCPbitmap newColorLayer ((width / 2) - (fw / 2)) ((height / 2) - (fh / 2)) ((width / 2) + (fw / 2)) ((height / 2) + (fh / 2)) colorLayer 0 0 bw bh nil;
_SCPbitmap8 newAlphaLayer ((width / 2) - (fw / 2)) ((height / 2) - (fh / 2)) ((width / 2) + (fw / 2)) ((height / 2) + (fh / 2)) alphaLayer 0 0 bw bh nil;
let _CRalphaBitmap chan newColorLayer newAlphaLayer nil nil -> newbmp in
(
_DSalphaBitmap bmp;
_DSbitmap newColorLayer;
_DSbitmap8 newAlphaLayer;
newbmp;
);
);;
fun G2DgetAlphaBitmapRatioH(abmp, width, height)=
let _GETalphaBitmapSize abmp -> [resW resH] in
if (resW == width) && (resH == height) then
(itof resH) /. (itof resW)
else
let if resH >= resW then ftoi ((itof height) /. ((itof resH) /. (itof resW))) else width -> fw in
let if resH >= resW then height else ftoi ((itof width) /. ((itof resW) /. (itof resH))) -> fh in
(itof fh) /. (itof fw);;
fun G2DgetBitmapRatioH(abmp, width, height)=
let _GETbitmapSize abmp -> [resW resH] in
if (resW == width) && (resH == height) then
(itof resH) /. (itof resW)
else
let if resH >= resW then ftoi ((itof height) /. ((itof resH) /. (itof resW))) else width -> fw in
let if resH >= resW then height else ftoi ((itof width) /. ((itof resW) /. (itof resH))) -> fh in
(itof fh) /. (itof fw);;
/*! @ingroup g2dbmpTools
* \brief Strech an alpha bitmap to a new size and keep ratio
*
* Prototype: fun [Chn ObjAlphaBitmap I I I I] ObjAlphaBitmap
*
* \param Chn : channel
* \param ObjAlphaBitmap : source alpha bitmap
* \param I : destination width
* \param I : destination height
* \param I : keep ratio (1 to enable, 0 otherwise)
* \param I : background color
* \param I : strech mode, 0 strech, 1 split, 2 fit, 3 inside
*
* \return ObjAlphaBitmap : the alpha bitmap in new size
**/
fun G2DstrechAlphaBitmapExt(chan, abmp, width, height, keepratio, bcolor, mode)=
let _GETalphaBitmapSize abmp -> [resW resH] in
if (resW == width) && (resH == height) then
abmp
else
let _GETalphaBitmaps abmp -> [colorLayer alphaLayer] in
let if (mode == 3) then [(min width height) (min width height)] else [width height] -> [mw mh] in
let if resH >= resW then ftoi ((itof mh) /. ((itof resH) /. (itof resW))) else mw -> fw in
let if resH >= resW then mh else ftoi ((itof mw) /. ((itof resW) /. (itof resH))) -> fh in
let if keepratio then fw else width -> fw in
let if keepratio then fh else height -> fh in
let _FILLbitmap _CRbitmap chan width height bcolor -> newColorLayer in
let _FILLbitmap8 _CRbitmap8 chan width height 0 -> newAlphaLayer in
let _CRalphaBitmap chan newColorLayer newAlphaLayer nil nil -> dabmp in
(
if (mode == 1) then
let [((min resW fw) / 2) ((min resH fh) / 2)] -> [cnw cnh] in
(
_BTCPalphaBitmapRect dabmp [0 0 cnw cnh] abmp [0 0 cnw cnh];
_BTCPalphaBitmapRect dabmp [(width - cnw) 0 cnw cnh] abmp [(resW - cnw) 0 cnw cnh];
_BTCPalphaBitmapRect dabmp [(width - cnw) (height - cnh) cnw cnh] abmp [(resW - cnw) (resH - cnh) cnw cnh];
_BTCPalphaBitmapRect dabmp [0 (height - cnh) cnw cnh] abmp [0 (resH - cnh) cnw cnh];
_BTCPalphaBitmapRect dabmp [(cnw - 1) 0 (width - (cnw * 2) + 1) height] dabmp [(cnw - 1) 0 1 height];
_BTCPalphaBitmapRect dabmp [0 (cnh - 1) width (height - (cnh * 2)) + 1] dabmp [0 (cnh - 1) width 1];
0;
)
else
(
_BTCPalphaBitmapRect dabmp [((width - fw) / 2) ((height - fh) / 2) fw fh] abmp [0 0 resW resH];
0;
);
_DSalphaBitmap abmp;
_DSbitmap newColorLayer;
_DSbitmap8 newAlphaLayer;
dabmp;
);;
/*! @ingroup g2dbmpTools
* \brief Strech an alpha by it's center to create a new background image
*
* Prototype: fun [Chn ObjAlphaBitmap I I] ObjAlphaBitmap
*
* \param Chn : channel
* \param ObjAlphaBitmap : source alpha bitmap
* \param I : destination width
* \param I : destination height
*
* \return ObjAlphaBitmap : a new alpha bitmap in new size
**/
fun G2DstrechAlphaBitmapToBackground(chan, abmp, width, height) =
let _GETalphaBitmapSize abmp -> [resW resH] in
let if (width < resW) then resW else width -> width in
let if (height < resH) then resH else height -> height in
// creation of the two destination bitmap
let _CRbitmap chan width height -> tempBmp in
let _CRbitmap8 chan width height -> tempBmp8 in
let _CRalphaBitmap chan tempBmp tempBmp8 nil nil -> dabmp in
let [(resW / 2) (resH / 2)] -> [cnw cnh] in
let [0 0] -> [rx ry] in
(
_DSbitmap tempBmp;
_DSbitmap8 tempBmp8;
_BTCPalphaBitmapRect dabmp [0 0 cnw cnh] abmp [rx ry cnw cnh];
_BTCPalphaBitmapRect dabmp [(width - cnw) 0 cnw cnh] abmp [(rx + (resW - cnw)) ry cnw cnh];
_BTCPalphaBitmapRect dabmp [(width - cnw) (height - cnh) cnw cnh] abmp [(rx + (resW - cnw)) (ry + (resH - cnh)) cnw cnh];
_BTCPalphaBitmapRect dabmp [0 (height - cnh) cnw cnh] abmp [rx (ry + (resH - cnh)) cnw cnh];
_BTCPalphaBitmapRect dabmp [(cnw - 1) 0 (width - (cnw * 2) + 1) height] dabmp [(cnw - 1) 0 1 height];
_BTCPalphaBitmapRect dabmp [0 (cnh - 1) width (height - (cnh * 2)) + 1] dabmp [0 (cnh - 1) width 1];
dabmp;
);;
/*! @ingroup g2dbmpTools
* \brief Strech an alpha by it's center to the destination background image
*
* Prototype: fun [ObjAlphaBitmap ObjAlphaBitmap] ObjAlphaBitmap
*
* \param ObjAlphaBitmap : source alpha bitmap
* \param ObjAlphaBitmap : dest alpha bitmap
*
* \return ObjAlphaBitmap : the destination alpha bitmap
**/
fun G2DstrechAlphaBitmapToBackgroundBitmap(abmp, dabmp) =
let _GETalphaBitmapSize abmp -> [resW resH] in
let _GETalphaBitmaps dabmp -> [dbmp dbmp8] in
let _GETalphaBitmapSize dabmp -> [width height] in
let if (width < resW) then resW else width -> width in
let if (height < resH) then resH else height -> height in
let [(resW / 2) (resH / 2)] -> [cnw cnh] in
let [0 0] -> [rx ry] in
(
_BTCPalphaBitmapRect dabmp [0 0 cnw cnh] abmp [rx ry cnw cnh];
_BTCPalphaBitmapRect dabmp [(width - cnw) 0 cnw cnh] abmp [(rx + (resW - cnw)) ry cnw cnh];
_BTCPalphaBitmapRect dabmp [(width - cnw) (height - cnh) cnw cnh] abmp [(rx + (resW - cnw)) (ry + (resH - cnh)) cnw cnh];
_BTCPalphaBitmapRect dabmp [0 (height - cnh) cnw cnh] abmp [rx (ry + (resH - cnh)) cnw cnh];
_BTCPalphaBitmapRect dabmp [(cnw - 1) 0 (width - (cnw * 2) + 1) height] dabmp [(cnw - 1) 0 1 height];
_BTCPalphaBitmapRect dabmp [0 (cnh - 1) width (height - (cnh * 2)) + 1] dabmp [0 (cnh - 1) width 1];
dabmp;
);;
/*! @ingroup g2dbmpTools
* \brief Strech an alpha to the destination background image with flags
*
* Prototype: fun [ObjAlphaBitmap [I I I I] ObjAlphaBitmap I] ObjAlphaBitmap
*
* \param ObjAlphaBitmap : source alpha bitmap
* \param [I I I I] : source rect
* \param ObjAlphaBitmap : dest alpha bitmap
* \param I : 0 strech all, 1 strech borders / split, 2 fill
*
* \return ObjAlphaBitmap : the destination alpha bitmap
**/
fun G2DstrechAlphaBitmapRectToBackgroundBitmap(abmp, rect, dabmp, mode) =
let rect -> [rx ry resW resH] in
let _GETalphaBitmapSize dabmp -> [width height] in
if ((width == resW) && (height == resH)) then
(
_BTCPalphaBitmapRect dabmp [0 0 width height] abmp [rx ry width height];
0;
)
else if (mode == 2) then
(
if (((resW - rx) <= 0) || ((resH - ry) <= 0)) then nil else
let (resW - rx) -> rw in
let (resH - ry) -> rh in
let width / (resW - rx) -> nbw in
let if (nbw == 0) then 1 else nbw -> nbw in
let height / (resH - ry) -> nbh in
let if (nbh == 0) then 1 else nbh -> nbh in
let 0 -> col in
while (col <= nbw) do
(
let 0 -> line in
while (line <= nbh) do
(
_BTCPalphaBitmapRect dabmp [(rw * col) (rh * line) rw rh] abmp [rx ry resW resH];
set line = line + 1;
);
set col = col + 1;
);
0;
)
else if (mode == 1) then
let [((min resW width) / 2) ((min resH height) / 2)] -> [cnw cnh] in
(
_BTCPalphaBitmapRect dabmp [0 0 cnw cnh] abmp [rx ry cnw cnh];
_BTCPalphaBitmapRect dabmp [(width - cnw) 0 cnw cnh] abmp [(rx + (resW - cnw)) ry cnw cnh];
_BTCPalphaBitmapRect dabmp [(width - cnw) (height - cnh) cnw cnh] abmp [(rx + (resW - cnw)) (ry + (resH - cnh)) cnw cnh];
_BTCPalphaBitmapRect dabmp [0 (height - cnh) cnw cnh] abmp [rx (ry + (resH - cnh)) cnw cnh];
_BTCPalphaBitmapRect dabmp [(cnw - 1) 0 (width - (cnw * 2) + 1) height] dabmp [(cnw - 1) 0 1 height];
_BTCPalphaBitmapRect dabmp [0 (cnh - 1) width (height - (cnh * 2)) + 1] dabmp [0 (cnh - 1) width 1];
0;
)
else
(
_BTCPalphaBitmapRect dabmp [0 0 width height] abmp [rx ry resW resH];
0;
);
dabmp;;
/*! @ingroup g2dbmpTools
* \brief Strech an alpha to the destination background image with flags and blending
*
* Prototype: fun [ObjAlphaBitmap [I I I I] ObjAlphaBitmap I F] ObjAlphaBitmap
*
* \param ObjAlphaBitmap : source alpha bitmap
* \param [I I I I] : source rect
* \param ObjAlphaBitmap : dest alpha bitmap
* \param I : 0 strech all, 1 strech borders / split, 2 fill
* \param F : blending coef
*
* \return ObjAlphaBitmap : the destination alpha bitmap
**/
fun G2DstrechAlphaBitmapRectToBlendBitmap(abmp, rect, dabmp, mode, blending) =
let rect -> [rx ry resW resH] in
let _GETalphaBitmapSize dabmp -> [width height] in
if ((width == resW) && (height == resH)) then
(
_BTBLENDalphaBitmaps dabmp [0 0 width height] abmp [rx ry width height] blending;
0;
)
else if (mode == 2) then
(
if (((resW - rx) <= 0) || ((resH - ry) <= 0)) then nil else
let (resW - rx) -> rw in
let (resH - ry) -> rh in
let width / (resW - rx) -> nbw in
let if (nbw == 0) then 1 else nbw -> nbw in
let height / (resH - ry) -> nbh in
let if (nbh == 0) then 1 else nbh -> nbh in
let 0 -> col in
while (col <= nbw) do
(
let 0 -> line in
while (line <= nbh) do
(
_BTBLENDalphaBitmaps dabmp [(rw * col) (rh * line) rw rh] abmp [rx ry resW resH] blending;
set line = line + 1;
);
set col = col + 1;
);
0;
)
else if (mode == 1) then
let [((min resW width) / 2) ((min resH height) / 2)] -> [cnw cnh] in
(
_BTBLENDalphaBitmaps dabmp [0 0 cnw cnh] abmp [rx ry cnw cnh] blending;
_BTBLENDalphaBitmaps dabmp [(width - cnw) 0 cnw cnh] abmp [(rx + (resW - cnw)) ry cnw cnh] blending;
_BTBLENDalphaBitmaps dabmp [(width - cnw) (height - cnh) cnw cnh] abmp [(rx + (resW - cnw)) (ry + (resH - cnh)) cnw cnh] blending;
_BTBLENDalphaBitmaps dabmp [0 (height - cnh) cnw cnh] abmp [rx (ry + (resH - cnh)) cnw cnh] blending;
_BTBLENDalphaBitmaps dabmp [cnw 0 (width - (cnw * 2)) cnh] abmp [(rx + (cnw - 1)) ry 1 cnh] blending;
_BTBLENDalphaBitmaps dabmp [cnw (height - cnh) (width - (cnw * 2)) cnh] abmp [(rx + (cnw - 1)) (ry + (resH - cnh)) 1 cnh] blending;
_BTBLENDalphaBitmaps dabmp [0 cnh cnw (height - (cnh * 2))] abmp [rx (ry + (cnh - 1)) cnw 1] blending;
_BTBLENDalphaBitmaps dabmp [(width - cnw) cnh cnw (height - (cnh * 2))] abmp [(rx + (resW - cnw)) (ry + (cnh - 1)) cnw 1] blending;
_BTBLENDalphaBitmaps dabmp [cnw cnh (width - (cnw * 2)) (height - (cnh * 2))] abmp [(rx + (cnw - 1)) (ry + (cnh - 1)) 1 1] blending;
0;
)
else
(
_BTBLENDalphaBitmaps dabmp [0 0 width height] abmp [rx ry resW resH] blending;
0;
);
dabmp;;
/*! @ingroup g2dbmpTools
* \brief Copy an alpha bitmap rectangle to a new alpha bitmap
*
* Prototype: fun [Chn ObjAlphaBitmap I I I I] ObjAlphaBitmap
*
* \param Chn : channel
* \param ObjAlphaBitmap : source alpha bitmap
* \param I : rectangle pos x
* \param I : rectangle pos y
* \param I : rectangle width
* \param I : rectangle height
*
* \return ObjAlphaBitmap : the new alpha bitmap
**/
fun G2DcopyAlphaBitmap(chan, bmp, px, py, pw, ph)=
let _GETalphaBitmaps bmp -> [colorLayer alphaLayer] in
let _CPbitmap24 (_CRbitmap chan pw ph) 0 0 colorLayer px py pw ph nil -> newColorLayer in
let _CPbitmap8 (_CRbitmap8 chan pw ph) 0 0 alphaLayer px py pw ph nil -> newAlphaLayer in
let _CRalphaBitmap chan newColorLayer newAlphaLayer nil nil -> newbmp in
(
_DSbitmap newColorLayer;
_DSbitmap8 newAlphaLayer;
newbmp;
);;
var iFILTER_SHARPEN = 0;;
var iFILTER_UNSHAR_MASK = 1;;
var iFILTER_EMBOSS = 2;;
var iFILTER_BOX_BLUR = 3;;
var iFILTER_GAUSSIAN_BLUR = 4;;
var iFILTER_EDGE0 = 5;;
var iFILTER_EDGE1 = 6;;
var iFILTER_EDGE2 = 7;;
/*! @ingroup g2dbmpTools
* \brief Apply a filter on a bitmap bitmap
*
* Prototype: fun [ObjBitmap I] ObjBitmap
*
* \param Chn : channel
* \param ObjBitmap : source bitmap
* \param I : filter type, selected bellow
* \param : iFILTER_SHARPEN, iFILTER_UNSHAR_MASK, iFILTER_EMBOSS, iFILTER_BOX_BLUR, iFILTER_GAUSSIAN_BLUR, iFILTER_EDGE0, iFILTER_EDGE1, iFILTER_EDGE2
*
* \return ObjAlphaBitmap : the same bitmap
**/
fun G2DfilterBitmap(bmp, filter)=
let
(
//sharpen
if (filter == iFILTER_SHARPEN) then
let mktab 3 nil -> kernel in
(
set kernel.0 = mktab 3 1.0;
set kernel.0.0 = 0.0;
set kernel.0.1 = -.1.0;
set kernel.0.2 = 0.0;
set kernel.1 = mktab 3 1.0;
set kernel.1.0 = -.1.0;
set kernel.1.1 = 5.0;
set kernel.1.2 = -.1.0;
set kernel.2 = mktab 3 1.0;
set kernel.2.0 = 0.0;
set kernel.2.1 = -.1.0;
set kernel.2.2 = 0.0;
kernel;
)
//Unsharp masking
else if (filter == iFILTER_UNSHAR_MASK) then
let mktab 5 nil -> kernel in
(
set kernel.0 = mktab 5 1.0;
set kernel.0.0 = 1.0 /. (-.256.0);
set kernel.0.1 = 4.0 /. (-.256.0);
set kernel.0.2 = 6.0 /. (-.256.0);
set kernel.0.3 = 4.0 /. (-.256.0);
set kernel.0.4 = 1.0 /. (-.256.0);
set kernel.1 = mktab 5 1.0;
set kernel.1.0 = 4.0 /. (-.256.0);
set kernel.1.1 = 16.0 /. (-.256.0);
set kernel.1.2 = 24.0 /. (-.256.0);
set kernel.1.3 = 16.0 /. (-.256.0);
set kernel.1.4 = 4.0 /. (-.256.0);
set kernel.2 = mktab 5 1.0;
set kernel.2.0 = 6.0 /. (-.256.0);
set kernel.2.1 = 24.0 /. (-.256.0);
set kernel.2.2 = -.476.0 /. (-.256.0);
set kernel.2.3 = 24.0 /. (-.256.0);
set kernel.2.4 = 6.0 /. (-.256.0);
set kernel.3 = mktab 5 1.0;
set kernel.3.0 = 4.0 /. (-.256.0);
set kernel.3.1 = 16.0 /. (-.256.0);
set kernel.3.2 = 24.0 /. (-.256.0);
set kernel.3.3 = 16.0 /. (-.256.0);
set kernel.3.4 = 4.0 /. (-.256.0);
set kernel.4 = mktab 5 1.0;
set kernel.4.0 = 1.0 /. (-.256.0);
set kernel.4.1 = 4.0 /. (-.256.0);
set kernel.4.2 = 6.0 /. (-.256.0);
set kernel.4.3 = 4.0 /. (-.256.0);
set kernel.4.4 = 1.0 /. (-.256.0);
kernel;
)
//emboss
else if (filter == iFILTER_EMBOSS) then
let mktab 3 nil -> kernel in
(
set kernel.0 = mktab 3 1.0;
set kernel.0.0 = -.2.0;
set kernel.0.1 = -.1.0;
set kernel.0.2 = 0.0;
set kernel.1 = mktab 3 1.0;
set kernel.1.0 = -.1.0;
set kernel.1.1 = 1.0;
set kernel.1.2 = 1.0;
set kernel.2 = mktab 3 1.0;
set kernel.2.0 = 0.0;
set kernel.2.1 = 1.0;
set kernel.2.2 = 2.0;
kernel;
)
//box blur
else if (filter == iFILTER_BOX_BLUR) then
let mktab 3 nil -> kernel in
(
set kernel.0 = mktab 3 1.0;
set kernel.0.0 = 0.1111;
set kernel.0.1 = 0.1111;
set kernel.0.2 = 0.1111;
set kernel.1 = mktab 3 1.0;
set kernel.1.0 = 0.1111;
set kernel.1.1 = 0.1111;
set kernel.1.2 = 0.1111;
set kernel.2 = mktab 3 1.0;
set kernel.2.0 = 0.1111;
set kernel.2.1 = 0.1111;
set kernel.2.2 = 0.1111;
kernel;
)
else if (filter == iFILTER_GAUSSIAN_BLUR) then
let mktab 3 nil -> kernel in
(
set kernel.0 = mktab 3 1.0;
set kernel.0.0 = 0.0625;
set kernel.0.1 = 0.125;
set kernel.0.2 = 0.0625;
set kernel.1 = mktab 3 1.0;
set kernel.1.0 = 0.125;
set kernel.1.1 = 0.25;
set kernel.1.2 = 0.125;
set kernel.2 = mktab 3 1.0;
set kernel.2.0 = 0.0625;
set kernel.2.1 = 0.125;
set kernel.2.2 = 0.0625;
kernel;
)
else if (filter == iFILTER_EDGE0) then
let mktab 3 nil -> kernel in
(
set kernel.0 = mktab 3 1.0;
set kernel.0.0 = 1.0;
set kernel.0.1 = 0.0;
set kernel.0.2 = -.1.0;
set kernel.1 = mktab 3 1.0;
set kernel.1.0 = 0.0;
set kernel.1.1 = 0.0;
set kernel.1.2 = 0.0;
set kernel.2 = mktab 3 1.0;
set kernel.2.0 = -.1.0;
set kernel.2.1 = 0.0;
set kernel.2.2 = 1.0;
kernel;
)
else if (filter == iFILTER_EDGE1) then
let mktab 3 nil -> kernel in
(
set kernel.0 = mktab 3 1.0;
set kernel.0.0 = 0.0;
set kernel.0.1 = 1.0;
set kernel.0.2 = 0.0;
set kernel.1 = mktab 3 1.0;
set kernel.1.0 = 1.0;
set kernel.1.1 = -.4.0;
set kernel.1.2 = 1.0;
set kernel.2 = mktab 3 1.0;
set kernel.2.0 = 0.0;
set kernel.2.1 = 1.0;
set kernel.2.2 = 0.0;
kernel;
)
else if (filter == iFILTER_EDGE1) then
let mktab 3 nil -> kernel in
(
set kernel.0 = mktab 3 1.0;
set kernel.0.0 = 0.0;
set kernel.0.1 = 1.0;
set kernel.0.2 = 0.0;
set kernel.1 = mktab 3 1.0;
set kernel.1.0 = 1.0;
set kernel.1.1 = -.4.0;
set kernel.1.2 = 1.0;
set kernel.2 = mktab 3 1.0;
set kernel.2.0 = 0.0;
set kernel.2.1 = 1.0;
set kernel.2.2 = 0.0;
kernel;
)
else if (filter == iFILTER_EDGE2) then
let mktab 3 nil -> kernel in
(
set kernel.0 = mktab 3 1.0;
set kernel.0.0 = -.1.0;
set kernel.0.1 = -.1.0;
set kernel.0.2 = -.1.0;
set kernel.1 = mktab 3 1.0;
set kernel.1.0 = -.1.0;
set kernel.1.1 = 8.0;
set kernel.1.2 = -.1.0;
set kernel.2 = mktab 3 1.0;
set kernel.2.0 = -.1.0;
set kernel.2.1 = -.1.0;
set kernel.2.2 = -.1.0;
kernel;
)
else nil;
)
-> kernel in
_BTFILTERbitmap bmp kernel;;
/*! @ingroup g2dbmpTools
* \brief Create an AlphaBitmap with border, backcolor and opacity
*
* Prototype: fun [Chn I I I I I I] AlphaBitmap
*
* \param Chn : channel
* \param I : width
* \param I : height
* \param I : size
* \param I : border color
* \param I : background color
* \param I : opacity 0 to 100
*
* \return AlphaBitmap : AlphaBitmap for using as layer
**/
fun G2DcreateLayer (chan, w, h, border, bcolor, color, opacity)=
let (255 * opacity) / 100 -> opcoef in
let if !border then
_FILLbitmap _CRbitmap chan w h color
else
(_BTDRAWrect
(_FILLbitmap (_CRbitmap chan w h) color)
[0 0 w h] bcolor border 0 color)
-> nodebmp in
let if !border then
_FILLbitmap8 (_CRbitmap8 chan w h) opcoef
else
(_BTDRAWrect8
(_FILLbitmap8 (_CRbitmap8 chan w h) 0)
[0 0 w h] 0xffffff border 1 (make_rgb opcoef opcoef opcoef))
-> nodebmpalpha in
let _CRalphaBitmap chan nodebmp nodebmpalpha nil nil -> alphabmp in
(
_DSbitmap nodebmp;
_DSbitmap8 nodebmpalpha;
alphabmp;
);;
/*! @ingroup g2dbmpTools
* \brief Modify an AlphaBitmap with border, backcolor and opacity
*
* Prototype: fun [Chn AlphaBitmap I I I I I I] AlphaBitmap
*
* \param Chn : channel
* \param AlphaBitmap : alpha bitmap to modify
* \param I : width
* \param I : height
* \param I : size
* \param I : border color
* \param I : background color
* \param I : opacity 0 to 100
*
* \return AlphaBitmap : AlphaBitmap for using as layer
**/
fun G2DsetLayer (chan, alphabmp, w, h, border, bcolor, color, opacity)=
// construction de la palette 8bit de niveau de gris
let _GETalphaBitmaps alphabmp -> [buffer buffer8] in
(
let (255 * opacity) / 100 -> opcoef in
let if !border then
_FILLbitmap buffer color
else
(_BTDRAWrect
(_FILLbitmap buffer color)
[0 0 w h] bcolor border 0 color)
-> nodebmp in
let if !border then
_FILLbitmap8 buffer8 opcoef
else
(_BTDRAWrect8
(_FILLbitmap8 buffer8 0)
[0 0 w h] 0xffffff border 1 opcoef)
-> nodebmpalpha in
alphabmp;
);;
/* ***************************** */
/* Resize check with text */
/* ***************************** */
fun G2DbBmp_HResize (resBmp, orgBmp, resBmp8, orgBmp8, nbCol, numCol, trans, borders) =
let borders -> [wl wr ht hb] in
let _GETbitmapSize resBmp -> [resW resH] in
let resW/nbCol -> widthRes in
let numCol*widthRes -> resPos in
let _GETbitmapSize orgBmp -> [orgW orgH] in
let orgW/nbCol -> widthOrg in
let numCol*widthOrg -> orgPos in
(
_SCPbitmap resBmp resPos 0 resPos+wl-1 resH orgBmp orgPos 0 orgPos+wl-1 resH trans;
_SCPbitmap resBmp resPos+wl 0 resPos+widthRes-wr-1 resH orgBmp orgPos+wl 0 orgPos+widthOrg-wr-1 resH trans;
_SCPbitmap resBmp resPos+widthRes-wr 0 resPos+widthRes-1 resH orgBmp orgPos+widthOrg-wr 0 orgPos+widthOrg-1 resH trans;
_SCPbitmap8 resBmp8 resPos 0 resPos+wl-1 resH orgBmp8 orgPos 0 orgPos+wl-1 resH trans;
_SCPbitmap8 resBmp8 resPos+wl 0 resPos+widthRes-wr-1 resH orgBmp8 orgPos+wl 0 orgPos+widthOrg-wr-1 resH trans;
_SCPbitmap8 resBmp8 resPos+widthRes-wr 0 resPos+widthRes-1 resH orgBmp8 orgPos+widthOrg-wr 0 orgPos+widthOrg-1 resH trans;
if (numCol+1)==nbCol then
0
else
G2DbBmp_HResize resBmp orgBmp resBmp8 orgBmp8 nbCol numCol+1 trans borders
);;
fun G2DbBmp_VResize (resBmp, orgBmp, resBmp8, orgBmp8, nbLine, numLine, trans, borders) =
let borders -> [wl wr ht hb] in
let _GETbitmapSize resBmp -> [resW resH] in
let resH/nbLine -> heightRes in
let numLine*heightRes -> resPos in
let _GETbitmapSize orgBmp -> [orgW orgH] in
let orgH/nbLine -> heightOrg in
let numLine*heightOrg -> orgPos in
(
_SCPbitmap resBmp 0 resPos resW resPos+ht-1 orgBmp 0 orgPos resW orgPos+ht-1 trans;
_SCPbitmap resBmp 0 resPos+ht resW resPos+heightRes-hb-1 orgBmp 0 orgPos+ht resW orgPos+heightOrg-hb-1 trans;
_SCPbitmap resBmp 0 resPos+heightRes-hb resW resPos+heightRes-1 orgBmp 0 orgPos+heightOrg-hb resW orgPos+heightOrg-1 trans;
_SCPbitmap8 resBmp8 0 resPos resW resPos+ht-1 orgBmp8 0 orgPos resW orgPos+ht-1 trans;
_SCPbitmap8 resBmp8 0 resPos+ht resW resPos+heightRes-hb-1 orgBmp8 0 orgPos+ht resW orgPos+heightOrg-hb-1 trans;
_SCPbitmap8 resBmp8 0 resPos+heightRes-hb resW resPos+heightRes-1 orgBmp8 0 orgPos+heightOrg-hb resW orgPos+heightOrg-1 trans;
if (numLine+1)==nbLine then
0
else
G2DbBmp_VResize resBmp orgBmp resBmp8 orgBmp8 nbLine numLine+1 trans borders
);;
fun G2DbBmp_DrawText(bmp, text, tabl, size, pos, colors, numLine, numCol)=
let text -> [txt font] in
let tabl -> [nbLine nbCol] in
let pos -> [xpos ypos] in
let size -> [width height] in
(
let hd hd colors -> coul in
if coul!=-1 then
_DRAWtext bmp font xpos+(width*numCol) ypos+(height*numLine) TD_TOP|TD_LEFT coul txt
else
nil;
if (numLine+1)==nbLine then
if (numCol+1)==nbCol then
0
else
G2DbBmp_DrawText bmp text tabl size pos (tl colors) 0 numCol+1
else
G2DbBmp_DrawText bmp text tabl size pos ((tl hd colors)::(tl colors)) numLine+1 numCol
);;
// construct the alphaBitmap for the CompChecks of the items' Menu
fun G2DbBmp_stretchButtonText (chan, text, size, colors, borders, tabl, img, right) =
let text -> [txt font] in
let size -> [width height] in
let colors -> [trans write] in
let borders -> [wl wr ht hb] in
let tabl -> [nbLine nbCol] in
let _GETalphaBitmaps img -> [Bmp Bmp8] in
let _GETbitmapSize Bmp -> [bmpW bmpH] in
// creation of the two destination bitmap
let _CRbitmap chan (width+right)*nbCol bmpH -> tempBmp in
let _CRbitmap8 chan (width+right)*nbCol bmpH -> tempBmp8 in
(
G2DbBmp_HResize tempBmp Bmp tempBmp8 Bmp8 nbCol 0 nil borders;
let _CRbitmap chan (width+right)*nbCol nbLine*height -> temp2Bmp in
let _CRbitmap8 chan (width+right)*nbCol nbLine*height -> temp2Bmp8 in
(
G2DbBmp_VResize temp2Bmp tempBmp temp2Bmp8 tempBmp8 nbLine 0 nil borders;
// calculation of the position of the text
let G2DgetStringSize font txt -> [wtxt htxt] in
let if width-(wl+wr)>wtxt then ((width-(wl+wr)-wtxt)/2)+wl else wl -> xpos in
let if height>htxt then height-htxt-hb else ht -> ypos in
(
// draw of the text in the different state of the bitmap
G2DbBmp_DrawText temp2Bmp text tabl [(width + right) height] [xpos ypos] write 0 0;
//_SAVEjpeg temp2Bmp _getmodifypack (strcatn "testBBMP"::txt::".jpg"::nil) 80;
// creation of the final alphabitmap
let _CRalphaBitmap chan temp2Bmp temp2Bmp8 nil trans -> newalpha in
(
_DSbitmap tempBmp;
_DSbitmap8 tempBmp8;
_DSbitmap temp2Bmp;
_DSbitmap8 temp2Bmp8;
newalpha;
);
)
)
);;
fun G2DcbResizeNode(cbmp, p, w, h, oldval)=
if w < 1 || h < 1 then nil else
let p -> [oldalpha color opcoef] in
(
_DSalphaBitmap oldalpha;
let oldval -> [ox oy ow oh] in
let _FILLbitmap _CRbitmap _channel w h color -> nodebmp in
let _FILLbitmap8 _CRbitmap8 _channel w h (make_rgb opcoef opcoef opcoef) -> nodebmpalpha in
let _CRalphaBitmap _channel nodebmp nodebmpalpha nil nil -> alphamainnode in
(
_DSbitmap nodebmp;
_DSbitmap8 nodebmpalpha;
[alphamainnode [ox oy w h]]
);
);;
/*! \brief Create a CompBitmap as layer with border, backcolor and opacity
*
* Prototype: fun [Chn ObjNode [I I] I I I I I I I] ObjNode
*
* \param Chn : channel
* \param ObjNode : father node
* \param [I I] : [x y] position
* \param I : width
* \param I : height
* \param I : CompBitmap flags
* \param I : background color
* \param I : opacity 0 to 100
* \param I : border size
* \param I : border color
*
* \return ObjNode : ObjNode of the layer
**/
fun G2DcreateNode(container, node, pos, width, height, flags, color, opacity, inline, linecolor)=
let (255 * opacity) / 100 -> opcoef in
let if inline != 0 && inline != nil then
(_BTDRAWrect
(_FILLbitmap (_CRbitmap _channel width height) color)
[0 0 width height] linecolor inline 0 color)
else
_FILLbitmap _CRbitmap _channel width height color
-> nodebmp in
let if inline != 0 && inline != nil then
(_BTDRAWrect8
(_FILLbitmap8 (_CRbitmap8 _channel width height) (make_rgb opcoef opcoef opcoef))
[0 0 width height] 0xffffff inline 0 (make_rgb opcoef opcoef opcoef))
else
_FILLbitmap8 _CRbitmap8 _channel width height (make_rgb opcoef opcoef opcoef)
-> nodebmpalpha in
let _CRalphaBitmap _channel nodebmp nodebmpalpha nil nil -> alphamainnode in
let _CBcompBitmapResizeResource _CRcompBitmap _channel container node pos flags|OBJ_LH_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_CLICK|OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_DBLCLICK|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_MOVE alphamainnode 0 0 width height @G2DcbResizeNode [alphamainnode color opcoef] -> nodeback in
(
_DSbitmap nodebmp;
_DSbitmap8 nodebmpalpha;
_CONVERTcompBitmapToObjNode nodeback;
);;
/*! \brief Create a new theme structure with default values
*
* Prototype: fun [Chn] EdTheme
*
* \param Chn : channel
*
* \return EdTheme : theme structure
**/
fun makeEdThemeResources(chan)=
let mkEdTheme [chan nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> themestr in
(
set themestr.EDT_fontLabel = G2DcrFont themestr.EDT_channel 9 0 FF_PIXEL|FF_WEIGHT "Arial";
set themestr.EDT_iLabelColor = iG2DDEFAULTLABELFONTCOLOR;
set themestr.EDT_iMainBackgroundColor = iG2DDEFAULTBACKGROUNDCOLOR;
set themestr.EDT_iToolBarColor = iG2DDEFAULTBACKGROUNDCOLOR;
set themestr.EDT_iTabBarColor = iG2DDEFAULTBACKGROUNDCOLOR;
let _LDbitmap themestr.EDT_channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DHCOLORPICKERCURSOR) -> bmp in
let _GETbitmapSize bmp -> [bw bh] in
let _CRcursor themestr.EDT_channel bmp (bw / 2) (bh / 2) 0x000000 0xffffff -> cursor in
set themestr.EDT_cursorColorPicker = cursor;
set themestr.EDT_sColorMap = (strcat sG2DDEFAULTRESOURCESPATH sG2DCOLORMAP);
set themestr.EDT_abmpColorMapCross = _LDalphaBitmap themestr.EDT_channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DCOLORMAPCROSS);
set themestr.EDT_abmpColorMapPickerBtn = _LDalphaBitmap themestr.EDT_channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DDEFAULTBTNCOLORPICKER);
set themestr.EDT_abmpTabCheck = _LDalphaBitmap themestr.EDT_channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DDEFAULTCHKTAB);
set themestr.EDT_abmpTabClose = _LDalphaBitmap themestr.EDT_channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DDEFAULTCLOSETAB);
set themestr.EDT_abmpTabLeft = _LDalphaBitmap themestr.EDT_channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DDEFAULTBTNTABLEFT);
set themestr.EDT_abmpTabRight = _LDalphaBitmap themestr.EDT_channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DDEFAULTBTNTABRIGHT);
set themestr.EDT_iTabFontColor = iG2DDEFAULTFONTCOLOR;
set themestr.EDT_fontTab = G2DcrFont themestr.EDT_channel 9 0 FF_PIXEL "Arial";
let _LDbitmap themestr.EDT_channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DUPDOWNVALUECURSOR) -> bmp in
let _GETbitmapSize bmp -> [bw bh] in
let _CRcursor themestr.EDT_channel bmp (bw / 2) (bh / 2) 0x000000 0xffffff -> cursor in
set themestr.EDT_cursorUpDownValue = cursor;
let _LDbitmap themestr.EDT_channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DHSIZECURSOR) -> bmp in
let _GETbitmapSize bmp -> [bw bh] in
let _CRcursor themestr.EDT_channel bmp (bw / 2) (bh / 2) 0x000000 0xffffff -> cursor in
set themestr.EDT_cursorHSize = cursor;
let _LDbitmap themestr.EDT_channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DWSIZECURSOR) -> bmp in
let _GETbitmapSize bmp -> [bw bh] in
let _CRcursor themestr.EDT_channel bmp (bw / 2) (bh / 2) 0x000000 0xffffff -> cursor in
set themestr.EDT_cursorWSize = cursor;
set themestr.EDT_abmpValUp = _LDalphaBitmap themestr.EDT_channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DDEFAULTBTNVALUP);
set themestr.EDT_abmpValDown = _LDalphaBitmap themestr.EDT_channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DDEFAULTBTNVALDOWN);
set themestr.EDT_abmpFrameFold = _LDalphaBitmap themestr.EDT_channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DDEFAULTCHKFRAMEFOLD);
set themestr.EDT_iFrameFontColor = iG2DDEFAULTFRAMEFONTCOLOR;
set themestr.EDT_sFrameFontName = "Arial";
set themestr.EDT_iFrameFontSize = 9;
set themestr.EDT_iFrameBarColor = iG2DDEFAULTBACKGROUNDCOLOR;
set themestr.EDT_iFrameBarHeight = 18;
set themestr.EDT_fontToolTip = G2DcrFont themestr.EDT_channel 8 0 FF_PIXEL "Arial";
set themestr.EDT_fontModuleEditor = G2DcrFont themestr.EDT_channel 9 0 FF_PIXEL "Arial";
set themestr.EDT_iModuleEditorBg = iG2DDEFAULTMODULEEDITORBGCOLOR;
set themestr.EDT_iModuleEditorDot = iG2DDEFAULTMODULEEDITORDOTCOLOR;
set themestr.EDT_iModuleEditorBoxOff = iG2DDEFAULTMODULEEDITORBOXOFFCOLOR;
set themestr.EDT_iModuleEditorBoxOn = iG2DDEFAULTMODULEEDITORBOXONCOLOR;
set themestr.EDT_iModuleEditorBoxDisableOff = iG2DDEFAULTMODULEEDITORBOXDISABLEOFFCOLOR;
set themestr.EDT_iModuleEditorBoxDisableOn = iG2DDEFAULTMODULEEDITORBOXDISABLEONCOLOR;
set themestr.EDT_iModuleEditorBoxBorderOff = iG2DDEFAULTMODULEEDITORBOXBORDEROFFCOLOR;
set themestr.EDT_iModuleEditorBoxBorderOn = iG2DDEFAULTMODULEEDITORBOXBORDERONCOLOR;
set themestr.EDT_iModuleEditorBoxTextOff = iG2DDEFAULTMODULEEDITORBOXTEXTOFFCOLOR;
set themestr.EDT_iModuleEditorBoxTextOn = iG2DDEFAULTMODULEEDITORBOXTEXTONCOLOR;
set themestr.EDT_iModuleEditorLinkOff = iG2DDEFAULTMODULEEDITORLINKOFFCOLOR;
set themestr.EDT_iModuleEditorLinkOn = iG2DDEFAULTMODULEEDITORLINKONCOLOR;
set themestr.EDT_iModuleEditorRLinkSize = iG2DDEFAULTMODULEEDITORROUNDLINKSIZE;
set themestr.EDT_iModuleEditorBorderWidth = iG2DDEFAULTMODULEEDITORBORDERWIDTH;
set themestr.EDT_fontTimeLineEditor = G2DcrFont themestr.EDT_channel 9 0 FF_PIXEL "Arial";
set themestr.EDT_iTimeLineEditorBg = iG2DDEFAULTTIMELINEEDITORBGCOLOR;
set themestr.EDT_iTimeLineEditorTrackOff = iG2DDEFAULTTIMELINEEDITORTRACKOFFCOLOR;
set themestr.EDT_iTimeLineEditorTrackOn = iG2DDEFAULTTIMELINEEDITORTRACKONCOLOR;
set themestr.EDT_iTimeLineEditorKeyOff = iG2DDEFAULTTIMELINEEDITORKEYOFFCOLOR;
set themestr.EDT_iTimeLineEditorKeyOn = iG2DDEFAULTTIMELINEEDITORKEYONCOLOR;
set themestr.EDT_iTimeLineEditorBorderWidth = iG2DDEFAULTTIMELINEEDITORBORDERWIDTH;
set themestr.EDT_iTimeLineEditorKeyInterOff = iG2DDEFAULTTIMELINEEDITORKEYINTEROFFCOLOR;
set themestr.EDT_iTimeLineEditorKeyInterOn = iG2DDEFAULTTIMELINEEDITORKEYINTERONCOLOR;
set themestr.EDT_iTimeLineEditorKeyBorderOff = iG2DDEFAULTTIMELINEEDITORKEYBORDEROFFCOLOR;
set themestr.EDT_iTimeLineEditorKeyBorderOn = iG2DDEFAULTTIMELINEEDITORKEYBORDERONCOLOR;
_SETdefaultFont G2DcrFont themestr.EDT_channel 15 0 0 "Microsoft San Serif";
themestr;
);;
/*! \brief Set the color map control theme resources
*
* Prototype: fun [EdTheme S S S S] I
*
* \param EdTheme : theme structure
* \param S : colormap png path in scol partition
* \param S : cross selection png path in scol partition
* \param S : button color picker png path in scol partition
* \param S : cursor color picker path in scol partition
*
* \return I : 0
**/
fun setEdColorMapResources(themestr, cmap, mapcross, btnpicker, curpicker)=
if cmap == nil then nil else
(
set themestr.EDT_sColorMap = cmap;
);
if mapcross == nil then nil else
(
_DSalphaBitmap themestr.EDT_abmpColorMapCross;
set themestr.EDT_abmpColorMapCross = _LDalphaBitmap themestr.EDT_channel _checkpack mapcross;
);
if btnpicker == nil then nil else
(
_DSalphaBitmap themestr.EDT_abmpColorMapPickerBtn;
set themestr.EDT_abmpColorMapPickerBtn = _LDalphaBitmap themestr.EDT_channel _checkpack btnpicker;
);
if curpicker == nil then nil else
(
_DScursor themestr.EDT_cursorColorPicker;
let _LDbitmap themestr.EDT_channel _checkpack curpicker -> bmp in
let _GETbitmapSize bmp -> [bw bh] in
let _CRcursor themestr.EDT_channel bmp (bw / 2) (bh / 2) 0x000000 0xffffff -> cursor in
set themestr.EDT_cursorColorPicker = cursor;
);
0;;
/*! \brief Set the toolbar control theme resources
*
* Prototype: fun [EdTheme I] I
*
* \param EdTheme : theme structure
* \param I : background color
*
* \return I : 0
**/
fun setEdToolBarResources(themestr, backcolor)=
if backcolor == nil then nil else
(
set themestr.EDT_iToolBarColor = backcolor;
);
0;;
/*! \brief Set the tabs control theme resources
*
* Prototype: fun [EdTheme I S S S S S I I] I
*
* \param EdTheme : theme structure
* \param I : background color
* \param S : Tab check png path in scol partition
* \param S : Tab close button png path in scol partition
* \param S : Tab left button png path in scol partition
* \param S : Tab right button png path in scol partition
* \param S : font face name
* \param I : font size
* \param I : font color
*
* \return I : 0
**/
fun setEdTabResources(themestr, backcolor, tabcheck, tabclose, tableft, tabright, fontname, fontsize, fontcolor)=
if backcolor == nil then nil else
(
set themestr.EDT_iTabBarColor = backcolor;
);
if tabcheck == nil then nil else
(
_DSalphaBitmap themestr.EDT_abmpTabCheck;
set themestr.EDT_abmpTabCheck = _LDalphaBitmap themestr.EDT_channel _checkpack tabcheck;
);
if tabclose == nil then nil else
(
_DSalphaBitmap themestr.EDT_abmpTabClose;
set themestr.EDT_abmpTabClose = _LDalphaBitmap themestr.EDT_channel _checkpack tabclose;
);
if tableft == nil then nil else
(
_DSalphaBitmap themestr.EDT_abmpTabLeft;
set themestr.EDT_abmpTabLeft = _LDalphaBitmap themestr.EDT_channel _checkpack tableft;
);
if tabright == nil then nil else
(
_DSalphaBitmap themestr.EDT_abmpTabRight;
set themestr.EDT_abmpTabRight = _LDalphaBitmap themestr.EDT_channel _checkpack tabright;
);
if (fontname == nil) || (fontsize == nil) then nil else
(
_DSfont themestr.EDT_fontTab;
set themestr.EDT_fontTab = G2DcrFont themestr.EDT_channel fontsize 0 FF_PIXEL fontname;
);
if fontcolor == nil then nil else
(
set themestr.EDT_iTabFontColor = fontcolor;
);
0;;
/*! \brief Set the float control theme resources
*
* Prototype: fun [EdTheme S S S] I
*
* \param EdTheme : theme structure
* \param S : up button png path in scol partition
* \param S : down button png path in scol partition
* \param S : arrows cursor bmp path in scol partition
*
* \return I : 0
**/
fun setEdFloatResources(themestr, upbtn, downbtn, cursize)=
if upbtn == nil then nil else
(
_DSalphaBitmap themestr.EDT_abmpValUp;
set themestr.EDT_abmpValUp = _LDalphaBitmap themestr.EDT_channel _checkpack upbtn;
);
if downbtn == nil then nil else
(
_DSalphaBitmap themestr.EDT_abmpValDown;
set themestr.EDT_abmpValDown = _LDalphaBitmap themestr.EDT_channel _checkpack downbtn;
);
if cursize == nil then nil else
(
_DScursor themestr.EDT_cursorUpDownValue;
let _LDbitmap themestr.EDT_channel _checkpack cursize -> bmp in
let _GETbitmapSize bmp -> [bw bh] in
let _CRcursor themestr.EDT_channel bmp (bw / 2) (bh / 2) 0x000000 0xffffff -> cursor in
set themestr.EDT_cursorUpDownValue = cursor;
);
0;;
/*! \brief Set the frame control theme resources
*
* Prototype: fun [EdTheme I S S I I I] I
*
* \param EdTheme : theme structure
* \param I : background color
* \param S : fold (minimize / restore) button png path in scol partition
* \param S : font face name
* \param I : font size
* \param I : font color
* \param I : title bar height
*
* \return I : 0
**/
fun setEdFrameResources(themestr, backcolor, foldbtn, fontname, fontsize, fontcolor, barheight)=
if backcolor == nil then nil else
(
set themestr.EDT_iFrameBarColor = backcolor;
);
if foldbtn == nil then nil else
(
_DSalphaBitmap themestr.EDT_abmpFrameFold;
set themestr.EDT_abmpFrameFold = _LDalphaBitmap themestr.EDT_channel _checkpack foldbtn;
);
if (fontname == nil) then nil else
(
set themestr.EDT_sFrameFontName = fontname;
);
if (fontsize == nil) then nil else
(
set themestr.EDT_iFrameFontSize = fontsize;
);
if fontcolor == nil then nil else
(
set themestr.EDT_iFrameFontColor = fontcolor;
);
if barheight == nil then nil else
(
set themestr.EDT_iFrameBarHeight = barheight;
);
0;;
/*! \brief Add an indexed resource to the theme
*
* Prototype: fun [EdTheme S S] I
*
* \param EdTheme : theme structure
* \param S : resource name index
* \param S : png path in scol partition
*
* \return I : 0
**/
fun addEdThemeResource(themestr, resname, path)=
if (resname == nil) || (path == nil) then nil else
let _LDalphaBitmap themestr.EDT_channel _checkpack path -> abmp in
set themestr.EDT_lAlphaResources = [resname abmp]::themestr.EDT_lAlphaResources;
0;;
/*! \brief Del an indexed resource in the theme
*
* Prototype: fun [EdTheme S] I
*
* \param EdTheme : theme structure
* \param S : resource name index
*
* \return I : 0
**/
fun delEdThemeResource(themestr, resname)=
let switchstr themestr.EDT_lAlphaResources resname -> abmp in
_DSalphaBitmap abmp;
set themestr.EDT_lAlphaResources = G2DremoveEdSidFromList themestr.EDT_lAlphaResources resname;
0;;
/*! \brief Get an indexed resource from the theme
*
* Prototype: fun [EdTheme S] AlphaBitmap
*
* \param EdTheme : theme structure
* \param S : resource name index
*
* \return AlphaBitmap : resource AlphaBitmap
**/
fun getEdThemeResource(themestr, resname)= switchstr themestr.EDT_lAlphaResources resname;;
/*! \brief Destroy a theme structure and his resources
*
* Prototype: fun [EdTheme] I
*
* \param EdTheme : theme structure
*
* \return I : 0
**/
fun delEdTheme(themestr)=
let sizelist themestr.EDT_lAlphaResources -> size in
let 0 -> i in
while i < size do
(
let nth_list themestr.EDT_lAlphaResources i -> [_ abmp] in
_DSalphaBitmap abmp;
set i = i + 1;
);
set themestr.EDT_lAlphaResources = nil;
_DSfont themestr.EDT_fontLabel;
set themestr.EDT_fontLabel = nil;
_DScursor themestr.EDT_cursorColorPicker;
set themestr.EDT_cursorColorPicker = nil;
_DSalphaBitmap themestr.EDT_abmpColorMapCross;
set themestr.EDT_abmpColorMapCross = nil;
_DSalphaBitmap themestr.EDT_abmpColorMapPickerBtn;
set themestr.EDT_abmpColorMapPickerBtn = nil;
_DScursor themestr.EDT_cursorUpDownValue;
set themestr.EDT_cursorUpDownValue = nil;
_DScursor themestr.EDT_cursorHSize;
set themestr.EDT_cursorHSize = nil;
_DScursor themestr.EDT_cursorWSize;
set themestr.EDT_cursorWSize = nil;
_DSfont themestr.EDT_fontTab;
set themestr.EDT_fontTab = nil;
_DSalphaBitmap themestr.EDT_abmpTabCheck;
set themestr.EDT_abmpTabCheck = nil;
_DSalphaBitmap themestr.EDT_abmpTabClose;
set themestr.EDT_abmpTabClose = nil;
_DSalphaBitmap themestr.EDT_abmpTabLeft;
set themestr.EDT_abmpTabLeft = nil;
_DSalphaBitmap themestr.EDT_abmpTabRight;
set themestr.EDT_abmpTabRight = nil;
_DSalphaBitmap themestr.EDT_abmpValUp;
set themestr.EDT_abmpValUp = nil;
_DSalphaBitmap themestr.EDT_abmpValDown;
set themestr.EDT_abmpValDown = nil;
_DSalphaBitmap themestr.EDT_abmpFrameFold;
set themestr.EDT_abmpFrameFold = nil;
_DSfont themestr.EDT_fontModuleEditor;
set themestr.EDT_fontModuleEditor = nil;
_DSfont themestr.EDT_fontToolTip;
set themestr.EDT_fontToolTip = nil;
_DSfont themestr.EDT_fontTimeLineEditor;
set themestr.EDT_fontTimeLineEditor = nil;
0;;
/* ********************************************************************************************* /
Tabs
/ ********************************************************************************************* */
/*! \brief Re-position all tabs on tab bar
*
* Private
*
* Prototype: fun [EdTabBar] I
*
* \param EdTabBar : tab bar structure
*
* \return I : 0
**/
fun resetEdTabPosition(tabbarstr)=
set tabbarstr.ETABBAR_iCurrentLpos = 0;
let sizelist tabbarstr.ETABBAR_lTab -> size in
let 0 -> i in
while i < size do
(
let nth_list tabbarstr.ETABBAR_lTab i -> item in
let _CONVERTcompCheckToObjNode item.ETAB_chk -> node in
let _GETobjNodePositionSizeInFatherRef node -> [_ _ nw nh] in
(
_CHANGEobjNodeCoordinates node [tabbarstr.ETABBAR_iCurrentLpos 0] 0;
set tabbarstr.ETABBAR_iCurrentLpos = tabbarstr.ETABBAR_iCurrentLpos + nw;
);
set i = i + 1;
);
0;;
/*! \brief Get the width of the tab bar from a tab position
*
* Private
*
* Prototype: fun [EdTabBar I] I
*
* \param EdTabBar : tab bar structure
* \param I : tab position
*
* \return I : width size
**/
fun getEdTabsLength(tabbarstr, pos)=
let sizelist tabbarstr.ETABBAR_lTab -> size in
let 0 -> width in
let if !pos then 0 else pos -> i in
(
while i < size do
(
let nth_list tabbarstr.ETABBAR_lTab i -> elem in
let _GETobjNodePositionSizeInFatherRef (_CONVERTcompCheckToObjNode elem.ETAB_chk) -> [_ _ w h] in
set width = width + w;
set i = i + 1;
);
width;
);;
/*! \brief Get last visible tab position
*
* Private
*
* Prototype: fun [EdTabBar] I
*
* \param EdTabBar : tab bar structure
*
* \return I : last visible position
**/
fun getEdLastVisibleTabs(tabbarstr)=
let sizelist tabbarstr.ETABBAR_lTab -> size in
let _GETcontainerPositionSize tabbarstr.ETABBAR_contScroll -> [_ _ cw _] in
let tabbarstr.ETABBAR_size -> [tw _] in
let (tw -cw) -> width in
let 0 -> ww in
let tabbarstr.ETABBAR_iScrollPos -> i in
(
while (i < size) && (ww < width) do
(
let nth_list tabbarstr.ETABBAR_lTab i -> elem in
let _GETobjNodePositionSizeInFatherRef (_CONVERTcompCheckToObjNode elem.ETAB_chk) -> [_ _ w h] in
set ww = ww + w;
set i = i + 1;
);
i - 1;
);;
/*! \brief Get the best pos for the scrolled tab bar
*
* Private
*
* Prototype: fun [EdTabBar I I] I
*
* \param EdTabBar : tab bar structure
* \param I : real width of the tab
* \param I : tab position
*
* \return I : best position
**/
fun getEdBestTabsByLength(tabbarstr, w, pos)=
if !pos then 0 else
let getEdTabsLength tabbarstr pos -> width in
let sizelist tabbarstr.ETABBAR_lTab -> size in
(
while pos >= 0 && (width < w) do
(
set width = getEdTabsLength tabbarstr pos - 1;
set pos = pos - 1;
);
pos;
);;
/*! \brief Show or hide the scrolling arrows if needed
*
* Private
*
* Prototype: fun [EdTabBar] I
*
* \param EdTabBar : tab bar structure
*
* \return I : 0
**/
fun activateEdTabBarScroll(tabbarstr)=
let getEdTabsLength tabbarstr 0 -> width in
let tabbarstr.ETABBAR_size -> [w _] in
if width < w then
// hide buttons
(
_SHOWcontainer tabbarstr.ETABBAR_contScroll CONTAINER_HIDDEN;
let _GETobjNodePositionSizeInFatherRef tabbarstr.ETABBAR_node -> [nx ny _ _] in
_CHANGEobjNodeCoordinates tabbarstr.ETABBAR_node [0 ny] 1;
0;
)
else
// show scroll buttons
(
_SHOWcontainer tabbarstr.ETABBAR_contScroll CONTAINER_UNHIDDEN;
0;
);
0;;
/*! \brief Not used
*
* private
*
* Prototype: fun [CompCheck u0 I I I I] I
*
* \return I : 0
**/
fun cbEdTabClick(cmpchk, param, x, y, btn, mask) =
0;;
/*! \brief Unclick call back on a tab
*
* Private
*
* Prototype: fun [CompCheck [EdTabBar EdTab] I I I I] I
*
* \return I : 0
**/
fun cbEdTabUnClick(cmpchk, param, x, y, btn, mask) =
let param -> [tabbarstr tabstr] in
(
if (_GETcompCheckState cmpchk) == CHK_UNCHECKED then
(
_SETcompCheckState cmpchk CHK_CHECKED;
0;
)
else
(
focusEdTab tabbarstr tabstr;
0;
);
_PAINTcontainer tabbarstr.ETABBAR_cont;
);
0;;
/*! \brief Not used
*
* Private
*
* Prototype: fun [CompCheck u0 I I] I
*
* \return I : 0
**/
fun cbEdTabResize(cmpchk, p, w, h)=
0;;
/*! \brief Callback for the close button
*
* Private
*
* Prototype: fun [CompRollOver u0 I I I I] I
*
* \return I : 0
**/
fun cbEdCloseTabClick(cmproll, param, x, y, btn, mask)=
let param -> [tabbarstr tabstr] in
(
exec tabstr.ETAB_cbClosed with [tabstr];
dsEdTab tabbarstr tabstr;
);
0;;
/*! \brief Callback for the close button
*
* Private
*
* Prototype: fun [EdTab fun [EdTab] I] I
*
* \return I : 0
**/
fun setEdTabCbClose(tabstr, cbfun)=
set tabstr.ETAB_cbClosed = cbfun;
0;;
/*! \brief Update the tab check
*
* Private
*
* Prototype: fun [EdTabBar EdTab] I
*
* \return I : 0
**/
fun changeEdTabCheck(tabbarstr, tabstr)=
let _GETobjNodePositionSizeInFatherRef (_CONVERTcompCheckToObjNode tabstr.ETAB_chk) -> [px py _ _] in
(
_DScompCheck tabstr.ETAB_chk;
set tabstr.ETAB_chk = nil;
_DSalphaBitmap tabstr.ETAB_abmpTab;
set tabstr.ETAB_abmpTab = nil;
_DScompRollOver tabstr.ETAB_closeBtn;
set tabstr.ETAB_closeBtn = nil;
let _GETalphaBitmapSize tabbarstr.ETABBAR_theme.EDT_abmpTabCheck -> [taw tah] in
let _GETalphaBitmapSize tabbarstr.ETABBAR_theme.EDT_abmpTabClose -> [tcw tch] in
let [tcw (tch / 5)] -> [tcw tch] in
let [(taw / 2) (tah / 5)] -> [tw th] in
let (G2DgetStrWidth tabbarstr.ETABBAR_theme.EDT_fontTab tabstr.ETAB_sName) + (tabbarstr.ETABBAR_iMargin * 2) -> tabw in
let tabbarstr.ETABBAR_theme.EDT_iTabFontColor -> c1 in
let G2DbBmp_stretchButtonText
tabstr.ETAB_channel
[tabstr.ETAB_sName tabbarstr.ETABBAR_theme.EDT_fontTab]
[tabw th]
[
nil
(c1::c1::c1::c1::0xdddddd::nil)::(c1::c1::c1::c1::0xdddddd::nil)::nil
]
[10 10 12 2]
[5 2]
tabbarstr.ETABBAR_theme.EDT_abmpTabCheck
if !tabstr.ETAB_bState then 0 else tcw + 5
-> img in
let _GETalphaBitmapSize img -> [nw nh] in
(
set tabstr.ETAB_abmpTab = img;
set tabstr.ETAB_chk = _CRcompCheck tabstr.ETAB_channel tabbarstr.ETABBAR_cont tabbarstr.ETABBAR_node [px py] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_MOVE img;
if !tabstr.ETAB_bState then nil else
(
set tabstr.ETAB_closeBtn = _CRcompRollOver tabstr.ETAB_channel tabbarstr.ETABBAR_cont (_CONVERTcompCheckToObjNode tabstr.ETAB_chk) [((nw / 2) - (tcw + 5)) (((nh / 5) - tch) / 2)] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK nil tabbarstr.ETABBAR_theme.EDT_abmpTabClose;
_CBcompRollOverUnClick tabstr.ETAB_closeBtn @cbEdCloseTabClick [tabbarstr tabstr];
);
_CBcompCheckClick tabstr.ETAB_chk @cbEdTabClick [tabbarstr tabstr];
_CBcompCheckUnClick tabstr.ETAB_chk @cbEdTabUnClick [tabbarstr tabstr];
_CBcompCheckResize tabstr.ETAB_chk @cbEdTabResize [tabbarstr tabstr];
);
);
0;;
/*! @ingroup g2dtabTools
* \brief Rename a tab
*
* Prototype: fun [EdTabBar EdTab S] I
*
* \param EdTabBar : tab bar structure
* \param EdTab : tab structure
* \param S : new name
*
* \return I : 0
**/
fun renameEdTab(tabbarstr, tabstr, name)=
if (tabstr == nil) || (name == nil) then nil else
(
set tabstr.ETAB_sName = name;
changeEdTabCheck tabbarstr tabstr;
if tabbarstr.ETABBAR_currentTab != tabstr then nil else
_SETcompCheckState tabstr.ETAB_chk CHK_CHECKED;
resetEdTabPosition tabbarstr;
activateEdTabBarScroll tabbarstr;
);
0;;
/*! \brief Focus the specified tab
*
* Private
*
* Prototype: fun [EdTabBar EdTab] I
*
* \param EdTabBar : tab bar structure
* \param EdTab : tab structure
*
* \return I : 0
**/
fun focusEdTab(tabbarstr, tabstr)=
let sizelist tabbarstr.ETABBAR_lTab -> size in
let 0 -> i in
while i < size do
(
let nth_list tabbarstr.ETABBAR_lTab i -> item in
if item == tabstr then
(
set item.ETAB_bState = 1;
if item.ETAB_modeFlag & ETAB_CLOSEBTN then
changeEdTabCheck tabbarstr item
else nil;
let tabbarstr.ETABBAR_size -> [w _] in
let _GETcontainerPositionSize tabbarstr.ETABBAR_contScroll -> [_ _ cw _] in
let getEdLastVisibleTabs tabbarstr -> lastvisibletab in
let getEdBestTabsByLength tabbarstr (w -cw) i -> pos in
if (i >= tabbarstr.ETABBAR_iScrollPos) && (i < lastvisibletab) then nil else
(
set tabbarstr.ETABBAR_iScrollPos = if i == (size - 1) then pos + 1 else pos;
let nth_list tabbarstr.ETABBAR_lTab tabbarstr.ETABBAR_iScrollPos -> sctabstr in
let _GETobjNodePositionSizeInFatherRef (_CONVERTcompCheckToObjNode sctabstr.ETAB_chk) -> [cx _ _ _] in
let _GETobjNodePositionSizeInFatherRef tabbarstr.ETABBAR_node -> [nx ny _ _] in
_CHANGEobjNodeCoordinates tabbarstr.ETABBAR_node [-cx ny] 1;
);
_SETcompCheckState item.ETAB_chk CHK_CHECKED;
exec item.ETAB_cbFocused with [item];
setEdWindowVisible item.ETAB_win 1;
_SETfocus item.ETAB_win.EDW_win;
set tabbarstr.ETABBAR_currentTab = item;
0;
)
else
(
if !item.ETAB_bState then nil else
set tabbarstr.ETABBAR_lastTab = item;
set item.ETAB_bState = 0;
if item.ETAB_modeFlag & ETAB_CLOSEBTN then
changeEdTabCheck tabbarstr item
else nil;
_SETcompCheckState item.ETAB_chk CHK_UNCHECKED;
setEdWindowVisible item.ETAB_win 0;
0;
);
set i = i + 1;
);
resetEdTabPosition tabbarstr;
activateEdTabBarScroll tabbarstr;
0;;
/*! @ingroup g2dtabTools
* \brief Destroy a tab
*
* Prototype: fun [EdTabBar EdTab] I
*
* \param EdTabBar : tab bar structure
* \param EdTab : tab structure
*
* \return I : 0
**/
fun dsEdTab(tabbarstr, tabstr)=
set tabbarstr.ETABBAR_lTab = G2DremoveFromList tabbarstr.ETABBAR_lTab tabstr;
dsEdWindow tabstr.ETAB_win;
set tabstr.ETAB_win = nil;
_DScompCheck tabstr.ETAB_chk;
set tabstr.ETAB_chk = nil;
_DScompRollOver tabstr.ETAB_closeBtn;
set tabstr.ETAB_closeBtn = nil;
_DSalphaBitmap tabstr.ETAB_abmpTab;
set tabstr.ETAB_abmpTab = nil;
resetEdTabPosition tabbarstr;
activateEdTabBarScroll tabbarstr;
// select lasttab or last inserted
if tabbarstr.ETABBAR_currentTab != tabstr then
nil
else if tabbarstr.ETABBAR_lastTab.ETAB_chk == nil then
let sizelist tabbarstr.ETABBAR_lTab -> size in
focusEdTab tabbarstr (nth_list tabbarstr.ETABBAR_lTab (size -1))
else
focusEdTab tabbarstr tabbarstr.ETABBAR_lastTab;
_PAINTcontainer tabbarstr.ETABBAR_cont;
0;;
/*! @ingroup g2dtabTools
* \brief Create a new tab in tab bar
*
* Prototype: fun [EdTabBar S I I] EdTab
*
* \param EdTabBar : tab bar structure
* \param S : tab label
* \param I : tab mode ETAB_CLOSEBTN for a tab with close button
* \param I : tab state 1 for selecting the tab after creation
*
* \return EdTab : new tab structure
**/
fun crEdTab(tabbarstr, name, mode, state)=
let if mode == nil then 0 else mode -> mode in
let mkEdTab [tabbarstr.ETABBAR_channel tabbarstr nil name nil nil nil nil nil nil nil nil nil] -> tabstr in
let _GETalphaBitmapSize tabbarstr.ETABBAR_theme.EDT_abmpTabCheck -> [taw tah] in
let [(taw / 2) (tah / 5)] -> [tw th] in
let (G2DgetStrWidth tabbarstr.ETABBAR_theme.EDT_fontTab name) + (tabbarstr.ETABBAR_iMargin * 2) -> tabw in
let tabbarstr.ETABBAR_theme.EDT_iTabFontColor -> c1 in
let G2DbBmp_stretchButtonText
tabstr.ETAB_channel
[tabstr.ETAB_sName tabbarstr.ETABBAR_theme.EDT_fontTab]
[tabw th]
[
nil
(c1::c1::c1::c1::0xdddddd::nil)::(c1::c1::c1::c1::0xdddddd::nil)::nil
]
[10 10 12 2]
[5 2]
tabbarstr.ETABBAR_theme.EDT_abmpTabCheck
0
-> img in
let _GETalphaBitmapSize img -> [nw nh] in
(
set tabstr.ETAB_abmpTab = img;
set tabstr.ETAB_bState = (if tabbarstr.ETABBAR_lTab == nil then 1 else state);
set tabstr.ETAB_modeFlag = mode;
let _GETwindowPositionSize tabbarstr.ETABBAR_targetWin.EDW_win -> [_ _ ww wh] in
let getEdWindowToolBarSize tabbarstr.ETABBAR_targetWin -> [tww twh] in
let [(ww - tww) (wh - twh)] -> [ww wh] in
// hack if width or heigth is negative on creation
let [(if ww <= 0 then 100 else ww) (if wh <= 0 then 100 else wh)] -> [ww wh] in
set tabstr.ETAB_win = crEdWindow tabstr.ETAB_channel tabbarstr.ETABBAR_targetWin tww twh ww wh WN_CHILDINSIDE|WN_NOBORDER|WN_HIDDEN EDWIN_RESIZE_MW|EDWIN_RESIZE_MH EDWIN_TAB "";
set tabbarstr.ETABBAR_lTab = G2Dlcat tabbarstr.ETABBAR_lTab tabstr::nil;
set tabstr.ETAB_chk = _CRcompCheck tabstr.ETAB_channel tabbarstr.ETABBAR_cont tabbarstr.ETABBAR_node [tabbarstr.ETABBAR_iCurrentLpos 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_MOVE img;
set tabbarstr.ETABBAR_iCurrentLpos = tabbarstr.ETABBAR_iCurrentLpos + (nw / 2);
_CBcompCheckClick tabstr.ETAB_chk @cbEdTabClick [tabbarstr tabstr];
_CBcompCheckUnClick tabstr.ETAB_chk @cbEdTabUnClick [tabbarstr tabstr];
_CBcompCheckResize tabstr.ETAB_chk @cbEdTabResize [tabbarstr tabstr];
if !tabstr.ETAB_bState then
(
activateEdTabBarScroll tabbarstr;
0;
)
else
(
focusEdTab tabbarstr tabstr;
0;
);
_PAINTcontainer tabbarstr.ETABBAR_cont;
tabstr;
);;
/*! @ingroup g2dtabTools
* \brief Get the windows structure of a tab
*
* Prototype: fun [EdTab] EdWindow
*
* \param EdTab : tab structure
*
* \return EdWindow : windows structure
**/
fun getEdTabWindow(tabstr)= tabstr.ETAB_win;;
/*! @ingroup g2dtabTools
* \brief Set the focused callback on a tab
*
* Prototype: fun [EdTab fun [EdTab] I] EdWindow
*
* \param EdTab : tab structure
* \param fun [EdTab] I : callback fun
*
* return fun [EdTab] I : same callback function
**/
fun setEdTabCbFocused(tabstr, cbfun)= set tabstr.ETAB_cbFocused = cbfun;;
/*! @ingroup g2dtabTools
* \brief Resize a tab bar
*
* Prototype: fun [EdTabBar I I] I
*
* \param EdTabBar : tab bar structure
* \param I : new width
* \param I : new height
*
* \return I : 0
**/
fun resizeEdTabBar(tabbarstr, w, h)=
let tabbarstr.ETABBAR_pos -> [x y] in
_SIZEcontainer tabbarstr.ETABBAR_cont x y (w - tabbarstr.ETABBAR_rightPos) h;
set tabbarstr.ETABBAR_size = [(w - tabbarstr.ETABBAR_rightPos) h];
let _GETcontainerPositionSize tabbarstr.ETABBAR_contScroll -> [cx cy cw ch] in
_SIZEcontainer tabbarstr.ETABBAR_contScroll (w - tabbarstr.ETABBAR_rightPos - cw) cy cw ch;
activateEdTabBarScroll tabbarstr;
focusEdTab tabbarstr tabbarstr.ETABBAR_currentTab;
_PAINTcontainer tabbarstr.ETABBAR_cont;
0;;
/*! @ingroup g2dtabTools
* \brief Destroy a tab bar
*
* Prototype: fun [EdTabBar] I
*
* \param EdTabBar : tab bar structure
*
* \return I : 0
**/
fun dsEdTabBar(tabbarstr)=
let sizelist tabbarstr.ETABBAR_lTab -> size in
let 0 -> i in
while i < size do
(
let nth_list tabbarstr.ETABBAR_lTab i -> tabstr in
dsEdTab tabbarstr tabstr;
set i = i + 1;
);
set tabbarstr.ETABBAR_lTab = nil;
_DScompRollOver tabbarstr.ETABBAR_btnScrollL;
set tabbarstr.ETABBAR_btnScrollL = nil;
_DScompRollOver tabbarstr.ETABBAR_btnScrollR;
set tabbarstr.ETABBAR_btnScrollR = nil;
_DScontainer tabbarstr.ETABBAR_contScroll;
set tabbarstr.ETABBAR_contScroll = nil;
_DScontainer tabbarstr.ETABBAR_cont;
set tabbarstr.ETABBAR_cont = nil;
0;;
/*! \brief Callback on scroll left click
*
* Private
*
* Prototype: fun [CompRollOver EdTabBar I I I I] I
*
* \return I : 0
**/
fun cbEdTabBarScrollLeft(cmpbtn, tabbarstr, x, y, btn, mask)=
set tabbarstr.ETABBAR_iScrollPos = if (tabbarstr.ETABBAR_iScrollPos - 1) <=0 then 0 else tabbarstr.ETABBAR_iScrollPos - 1;
let nth_list tabbarstr.ETABBAR_lTab tabbarstr.ETABBAR_iScrollPos -> tabstr in
let _GETobjNodePositionSizeInFatherRef (_CONVERTcompCheckToObjNode tabstr.ETAB_chk) -> [cx _ w h] in
let _GETobjNodePositionSizeInFatherRef tabbarstr.ETABBAR_node -> [nx ny _ _] in
_CHANGEobjNodeCoordinates tabbarstr.ETABBAR_node [-cx ny] 1;
0;;
/*! \brief Callback on scroll right click
*
* Private
*
* Prototype: fun [CompRollOver EdTabBar I I I I] I
*
* \return I : 0
**/
fun cbEdTabBarScrollRight(cmpbtn, tabbarstr, x, y, btn, mask)=
let getEdTabsLength tabbarstr tabbarstr.ETABBAR_iScrollPos -> width in
let tabbarstr.ETABBAR_size -> [w _] in
let _GETcontainerPositionSize tabbarstr.ETABBAR_contScroll -> [_ _ cw _] in
if width <= (w - cw) then nil else
(
set tabbarstr.ETABBAR_iScrollPos = if tabbarstr.ETABBAR_iScrollPos >= ((sizelist tabbarstr.ETABBAR_lTab) - 1) then ((sizelist tabbarstr.ETABBAR_lTab) - 1) else tabbarstr.ETABBAR_iScrollPos + 1;
let nth_list tabbarstr.ETABBAR_lTab tabbarstr.ETABBAR_iScrollPos -> tabstr in
let _GETobjNodePositionSizeInFatherRef (_CONVERTcompCheckToObjNode tabstr.ETAB_chk) -> [cx _ w h] in
let _GETobjNodePositionSizeInFatherRef tabbarstr.ETABBAR_node -> [nx ny _ _] in
_CHANGEobjNodeCoordinates tabbarstr.ETABBAR_node [-cx ny] 1;
);
0;;
/*! \brief Create the tab bar scroll interface
*
* Private
*
* Prototype: fun [EdTabBar] I
*
* \return I : 0
**/
fun makeEdTabBarScroll(tabbarstr)=
let _GETalphaBitmapSize tabbarstr.ETABBAR_theme.EDT_abmpTabLeft -> [blw blh] in
let _GETalphaBitmapSize tabbarstr.ETABBAR_theme.EDT_abmpTabRight -> [brw brh] in
let blh / 5 -> blh in
let brh / 5 -> brh in
let tabbarstr.ETABBAR_size -> [w h] in
(
set tabbarstr.ETABBAR_contScroll = _CRcontainerFromObjCont tabbarstr.ETABBAR_channel tabbarstr.ETABBAR_cont (w - (blw + brw)) 0 (blw + brw) blh CO_HIDE|CO_CHILDINSIDE|CO_NOBORDER|CO_NOCAPTION tabbarstr.ETABBAR_theme.EDT_iTabBarColor "";
set tabbarstr.ETABBAR_btnScrollL = _CRcompRollOver tabbarstr.ETABBAR_channel tabbarstr.ETABBAR_contScroll nil [0 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE OBJ_CONTAINER_MOVE|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_DBLCLICK tabbarstr.ETABBAR_theme.EDT_abmpTabLeft;
set tabbarstr.ETABBAR_btnScrollR = _CRcompRollOver tabbarstr.ETABBAR_channel tabbarstr.ETABBAR_contScroll nil [blw 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE OBJ_CONTAINER_MOVE|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_DBLCLICK tabbarstr.ETABBAR_theme.EDT_abmpTabRight;
_CBcompRollOverUnClick tabbarstr.ETABBAR_btnScrollL @cbEdTabBarScrollLeft tabbarstr;
_CBcompRollOverUnClick tabbarstr.ETABBAR_btnScrollR @cbEdTabBarScrollRight tabbarstr;
_PAINTcontainer tabbarstr.ETABBAR_contScroll;
_TOPcontainer tabbarstr.ETABBAR_contScroll;
);
0;;
/*! @ingroup g2dtabTools
* \brief Create the tab bar on tool bar
*
* Prototype: fun [EdToolBar EdWindow I I I I I EdTheme] EdTabBar
*
* \param EdToolBar : tool bar structure
* \param EdWindow : target window structure
* \param I : x position
* \param I : y position
* \param I : width
* \param I : height
* \param I : text margin on tabs
* \param EdTheme : theme structure
*
* \return EdTabBar : the new tab bar
**/
fun crEdTabBarFromToolBar(tbstr, targetstr, x, y, w, h, margin, themestr)=
let if themestr == nil then (if EdDefaultTheme == nil then (set EdDefaultTheme = makeEdThemeResources tbstr.ETB_channel) else EdDefaultTheme) else themestr -> themestr in
let tbstr.ETB_size -> [tbw tbh] in
let mkEdTabBar [tbstr.ETB_channel nil nil targetstr tbh [(tbstr.ETB_iCurrentLpos + x) y] [w h] (tbw - (tbstr.ETB_iCurrentLpos + x + w)) margin 0 nil themestr nil nil nil nil nil 0] -> tabbarstr in
(
set tbstr.ETB_tabBar = tabbarstr;
set tabbarstr.ETABBAR_cont = _CRcontainerFromObjCont tabbarstr.ETABBAR_channel tbstr.ETB_cont (tbstr.ETB_iCurrentLpos + x) y w h CO_CHILDINSIDE|CO_NOBORDER|CO_NOCAPTION themestr.EDT_iTabBarColor "";
set tabbarstr.ETABBAR_node = G2DcreateNode tabbarstr.ETABBAR_cont nil [0 0] w h nil 0xffffff 0 nil nil;
set tbstr.ETB_iCurrentLpos = tbstr.ETB_iCurrentLpos + x + w;
makeEdTabBarScroll tabbarstr;
_PAINTcontainer tabbarstr.ETABBAR_cont;
tabbarstr;
);;
/* ********************************************************************************************* /
ToolBar
/ ********************************************************************************************* */
/*! \brief Hide a toolbar tooltip
*
* Private
*
* Prototype: fun [ObjNode EdToolBar S] I
*
* \param ObjNode : node of tooltip
* \param EdToolBar : tool bar structure
* \param S : tooltip text
*
* \return I : 0
**/
fun cbEdToolBarToolTipHide(node, t, bubble)=
let switch t.ETB_lTooltip node -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set t.ETB_lTooltip = G2DremoveEdIdxFromList t.ETB_lTooltip node;
);
0;;
/*! \brief Show a toolbar tooltip
*
* Private
*
* Prototype: fun [ObjNode EdToolBar S I I] I
*
* \param ObjNode : node of tooltip
* \param EdToolBar : tool bar structure
* \param S : tooltip text
* \param I : X position
* \param I : Y position
*
* \return I : 0
**/
fun cbEdToolBarToolTipShow(node, t, bubble, dx, dy)=
let switch t.ETB_lTooltip node -> [tpcont tptext] in
if tpcont == nil then nil else
(
_DScompText tptext;
_DScontainer tpcont;
set t.ETB_lTooltip = G2DremoveEdIdxFromList t.ETB_lTooltip node;
);
let G2DgetStringSize t.ETB_fontTooltip bubble -> [w h] in
let _GETWorkingAreaSize -> [sw sh] in
let sh - 40 -> sh in
let _GETscreenPos -> [sx sy] in
let [16 16] -> [xdecal ydecal] in
let if (sx + w + 4 + xdecal) > sw then (sw - (w + 4) - xdecal) else sx + xdecal -> x in
let if (sy + h + 4 + ydecal) > sh then (sh - (h + 4) - ydecal) else sy + ydecal -> y in
let (_CRcontainerFromObjWin t.ETB_channel t.ETB_win x y w+4 h+4 CO_NOCAPTION 0xffffff nil) -> tpcont in
let _CRcompText t.ETB_channel tpcont nil [2 2] CT_LABEL|CT_CENTER|OBJ_VISIBLE nil w h bubble t.ETB_fontTooltip [0 nil nil nil] nil nil nil -> tptext in
(
set t.ETB_lTooltip = [node [tpcont tptext]]::t.ETB_lTooltip;
_PAINTcontainer tpcont;
);
0;;
/*! \brief Callback on toolbar text resize
*
* Private not used
*
* Prototype: fun [CompText [EdToolBar u0] I I] I
*
* \return I : 0
**/
fun cbEdToolBarTextResize(ctext, param, w, h)=
0;;
/*! @ingroup g2dToolbar
* \brief Set a toolbar text value
*
* Prototype: fun [EdToolBar CompText S I] I
*
* \param EdToolBar : tool bar structure
* \param CompText : toolbar element contain text
* \param S : text value to set
* \param I : text color
*
* \return I : 0
**/
fun setEdToolBarText(t, cmptxt, val, txtcolor)=
let switch t.ETB_lText cmptxt -> font in
let G2DgetStringSize font val -> [w h] in
(
_SETcompText cmptxt val font [txtcolor 0 0 0] 1;
_SIZEobjNode _CONVERTcompTextToObjNode cmptxt w h 0;
let _GETcontainerPositionSize t.ETB_cont -> [_ _ cw ch] in
(
set t.ETB_iCurrentLpos = 0;
set t.ETB_iCurrentRpos = cw;
set t.ETB_iCurrentTpos = 0;
set t.ETB_iCurrentBpos = ch;
);
let sizelist t.ETB_lControl -> size in
let 0 -> i in
while i < size do
(
let nth_list t.ETB_lControl i -> [node align] in
let _GETobjNodePositionSizeInContainerRef node -> [_ _ nw nh] in
let
if align == ETB_ALIGN_RIGHT then
[(set t.ETB_iCurrentRpos = t.ETB_iCurrentRpos - t.ETB_iHmargin - nw) t.ETB_iVmargin]
else if align == ETB_ALIGN_TOP then
[t.ETB_iHmargin ((set t.ETB_iCurrentTpos = t.ETB_iCurrentTpos + t.ETB_iVmargin + nh) - nh)]
else if align == ETB_ALIGN_BOTTOM then
[t.ETB_iHmargin (set t.ETB_iCurrentBpos = t.ETB_iCurrentBpos - t.ETB_iVmargin - nh)]
else
[((set t.ETB_iCurrentLpos = t.ETB_iCurrentLpos + t.ETB_iHmargin + nw) - nw) t.ETB_iVmargin]
-> npos in
_CHANGEobjNodeCoordinates node npos 0;
set i = i + 1;
);
_PAINTcontainer t.ETB_cont;
);
0;;
/*! @ingroup g2dToolbar
* \brief Create a toolbar text element
*
* Prototype: fun [EdToolBar S S I I I I I] CompText
*
* \param EdToolBar : tool bar structure
* \param S : text value to set
* \param S : font name for the text
* \param I : font size
* \param I : font flags (FF_WEIGHT, FF_ITALIC, FF_UNDERLINE, FF_STRIKED, FF_PIXEL)
* \param I : text color
* \param I : CompText creation flags
* \param I : toolbar align flag (ETB_ALIGN_LEFT, ETB_ALIGN_RIGHT, ETB_ALIGN_BOTTOM, ETB_ALIGN_TOP)
*
* \return CompText : the new text element
**/
fun crEdToolBarText(t, txt, fontname, fontsize, fontflag, txtcolor, flags, align) =
let G2DcrFont t.ETB_channel fontsize 0 (if fontflag == nil then 0 else fontflag) fontname -> font in
let if flags == nil then OBJ_ENABLE|OBJ_VISIBLE|CT_LEFT|CT_LABEL else flags|OBJ_ENABLE|OBJ_VISIBLE -> flags in
let G2DgetStringSize font txt -> [w h] in
let
if align == ETB_ALIGN_RIGHT then
[(set t.ETB_iCurrentRpos = t.ETB_iCurrentRpos - t.ETB_iHmargin - w) t.ETB_iVmargin]
else if align == ETB_ALIGN_TOP then
[t.ETB_iHmargin ((set t.ETB_iCurrentTpos = t.ETB_iCurrentTpos + t.ETB_iVmargin + h) - h)]
else if align == ETB_ALIGN_BOTTOM then
[t.ETB_iHmargin (set t.ETB_iCurrentBpos = t.ETB_iCurrentBpos - t.ETB_iVmargin - h)]
else
[((set t.ETB_iCurrentLpos = t.ETB_iCurrentLpos + t.ETB_iHmargin + w) - w) t.ETB_iVmargin]
-> [x y] in
let _CRcompText t.ETB_channel t.ETB_cont nil [x y] flags OBJ_CONTAINER_MOVE|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_DBLCLICK w h txt font [txtcolor 0 0 0] nil nil nil -> text in
(
_CBcompTextResize text @cbEdToolBarTextResize [t nil] nil nil nil nil;
set t.ETB_lText = [text font]::t.ETB_lText;
set t.ETB_lControl = G2Dlcat t.ETB_lControl [(_CONVERTcompTextToObjNode text) align]::nil;
text;
);;
/*! \brief Callback on toolbar check click
*
* Private
*
* Prototype: fun [CompCheck [EdToolBar fun [EdToolBar CompCheck I I I] I] I I I I] I
*
* \return I : 0
**/
fun cbEdToolBarCheckClick(check, param, x, y, btn, mask)=
let param -> [t cbclick] in
let _GETcompCheckState check -> state in
exec cbclick with [t check btn mask state];
0;;
/*! \brief Callback on toolbar check cursor in
*
* Private not used
*
* Prototype: fun [CompCheck [EdToolBar u0] I I I] I
*
* \return I : 0
**/
fun cbEdToolBarCheckIn(croll, param, x, y, mask)=
0;;
/*! \brief Callback on toolbar check cursor out
*
* Private not used
*
* Prototype: fun [CompCheck [EdToolBar u0] I I I] I
*
* \return I : 0
**/
fun cbEdToolBarCheckOut(croll, param, x, y, mask)=
0;;
/*! \brief Callback on toolbar check resize
*
* Private not used
*
* Prototype: fun [CompCheck [EdToolBar u0] I I] I
*
* \return I : 0
**/
fun cbEdToolBarCheckResize(croll, param, w, h)=
0;;
/*! @ingroup g2dToolbar
* \brief Change the toolbar check element state
*
* Prototype: fun [EdToolBar CompCheck I] I
*
* \param EdToolBar : tool bar structure
* \param CompCheck : check element
* \param I : new state, 0 for unchecked, 1 for checked
*
* \return I : 0
**/
fun setEdToolBarCheckState(t, chk, state)=
_SETcompCheckState chk state;
_PAINTcontainer t.ETB_cont;
0;;
/*! @ingroup g2dToolbar
* \brief Enable or disable the toolbar check element
*
* Prototype: fun [EdToolBar CompCheck I] I
*
* \param EdToolBar : tool bar structure
* \param CompCheck : check element
* \param I : new state, 0 for disabled, 1 for enabled
*
* \return I : 0
**/
fun setEdToolBarCheckEnable(t, chk, state)=
let if state then OBJ_ENABLE else OBJ_DISABLE -> state in
_CHANGEobjNodeFlags (_CONVERTcompCheckToObjNode chk) OBJ_VISIBLE|ROL_MASK|ROL_DISABLE|state 1;
_PAINTcontainer t.ETB_cont;
0;;
/*! @ingroup g2dToolbar
* \brief Set the toolbar check element click callback
*
* Prototype: fun [EdToolBar CompCheck fun [EdToolBar CompCheck I I I] I ] I
*
* \param EdToolBar : tool bar structure
* \param CompCheck : check element
* \param fun [EdToolBar CompCheck I I I] I : callback on click
*
* \return I : 0
**/
fun setEdToolBarCheckCbClick(t, check, cbclick)=
_CBcompCheckUnClick check @cbEdToolBarCheckClick [t cbclick];
0;;
/*! @ingroup g2dToolbar
* \brief Set the toolbar check element tooltip content
*
* Prototype: fun [EdToolBar CompCheck S ] I
*
* \param EdToolBar : tool bar structure
* \param CompCheck : check element
* \param S : tooltip text
*
* \return I : 0
**/
fun setEdToolBarCheckToolTip(t, check, bubble)=
let _CONVERTcompCheckToObjNode check -> node in
let switch t.ETB_lTooltip node -> tooltip in
(
if (tooltip == nil) then nil else
let tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set t.ETB_lTooltip = G2DremoveEdIdxFromList t.ETB_lTooltip node;
);
_DStoolTip node;
if (!strcmp (strtrim bubble) "") then nil else
_CRtoolTip node 150 bubble @cbEdToolBarToolTipShow t @cbEdToolBarToolTipHide t;
);
0;;
/*! @ingroup g2dToolbar
* \brief Create a toolbar check element
*
* Prototype: fun [EdToolBar AlphaBitmap I S fun [EdToolBar CompCheck I I I] I] CompCheck
*
* \param EdToolBar : tool bar structure
* \param AlphaBitmap : alpha bitmap to use as graphic check
* \param I : toolbar align flag (ETB_ALIGN_LEFT, ETB_ALIGN_RIGHT, ETB_ALIGN_BOTTOM, ETB_ALIGN_TOP)
* \param S : tooltip text
* \param fun [EdToolBar CompCheck I I I] I : callback on click
*
* \return I : 0
**/
fun crEdToolBarCheck(t, abmp, align, bubble, cbclick) =
let _GETalphaBitmapSize abmp -> [bw bh] in
let [(bw / 2) (bh / 5)] -> [w h] in
let
if align == ETB_ALIGN_RIGHT then
[(set t.ETB_iCurrentRpos = t.ETB_iCurrentRpos - t.ETB_iHmargin - w) t.ETB_iVmargin]
else if align == ETB_ALIGN_TOP then
[t.ETB_iHmargin ((set t.ETB_iCurrentTpos = t.ETB_iCurrentTpos + t.ETB_iVmargin + h) - h)]
else if align == ETB_ALIGN_BOTTOM then
[t.ETB_iHmargin (set t.ETB_iCurrentBpos = t.ETB_iCurrentBpos - t.ETB_iVmargin - h)]
else
[((set t.ETB_iCurrentLpos = t.ETB_iCurrentLpos + t.ETB_iHmargin + w) - w) t.ETB_iVmargin]
-> [x y] in
let _CRcompCheck t.ETB_channel t.ETB_cont nil [x y] OBJ_ENABLE|ROL_MASK|ROL_DISABLE OBJ_CONTAINER_MOVE|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_DBLCLICK abmp -> check in
(
if (!strcmp (strtrim bubble) "") then nil else
_CRtoolTip _CONVERTcompCheckToObjNode check 150 bubble @cbEdToolBarToolTipShow t @cbEdToolBarToolTipHide t;
_CBcompCheckUnClick check @cbEdToolBarCheckClick [t cbclick];
_CBcompCheckCursorMoveIn check @cbEdToolBarCheckIn [t nil];
_CBcompCheckCursorMoveOut check @cbEdToolBarCheckOut [t nil];
_CBcompCheckResize check @cbEdToolBarCheckResize [t nil];
set t.ETB_lCheck = check::t.ETB_lCheck;
set t.ETB_lControl = G2Dlcat t.ETB_lControl [(_CONVERTcompCheckToObjNode check) align]::nil;
check;
);;
/*! @ingroup g2dToolbar
* \brief Enable or disable the toolbar button element
*
* Prototype: fun [EdToolBar CompRollOver I] I
*
* \param EdToolBar : tool bar structure
* \param CompRollOver : button element
* \param I : new state, 0 for disabled, 1 for enabled
*
* \return I : 0
**/
fun setEdToolBarButtonEnable(t, btn, state)=
let if state then OBJ_ENABLE else OBJ_DISABLE -> state in
_CHANGEobjNodeFlags (_CONVERTcompRollOverToObjNode btn) OBJ_VISIBLE|ROL_MASK|ROL_DISABLE|state 1;
_PAINTcontainer t.ETB_cont;
0;;
/*! \brief Callback on toolbar button click
*
* Private
*
* Prototype: fun [CompRollOver [EdToolBar fun [EdToolBar CompRollOver I I] I] I I I I] I
*
* \return I : 0
**/
fun cbEdToolBarButtonClick(croll, param, x, y, btn, mask) =
let param -> [t cbclick] in
exec cbclick with [t croll btn mask];
0;;
/*! @ingroup g2dToolbar
* \brief Set the toolbar button element click callback
*
* Prototype: fun [EdToolBar CompRollOver fun [EdToolBar CompRollOver I I] I ] I
*
* \param EdToolBar : tool bar structure
* \param CompRollOver : button element
* \param fun [EdToolBar CompRollOver I I] I : callback on click
*
* \return I : 0
**/
fun setEdToolBarButtonCbClick(t, button, cbclick)=
_CBcompRollOverUnClick button @cbEdToolBarButtonClick [t cbclick];
0;;
/*! \brief Callback on toolbar button cursor in
*
* Private not used
*
* Prototype: fun [CompRollOver [EdToolBar u0] I I I] I
*
* \return I : 0
**/
fun cbEdToolBarButtonIn(croll, param, x, y, mask)=
0;;
/*! \brief Callback on toolbar button cursor out
*
* Private not used
*
* Prototype: fun [CompRollOver [EdToolBar u0] I I I] I
*
* \return I : 0
**/
fun cbEdToolBarButtonOut(croll, param, x, y, mask)=
0;;
/*! \brief Callback on toolbar button resize
*
* Private not used
*
* Prototype: fun [CompRollOver [EdToolBar u0] I I] I
*
* \return I : 0
**/
fun cbEdToolBarButtonResize(croll, param, w, h)=
0;;
/*! @ingroup g2dToolbar
* \brief Set the toolbar button element tooltip content
*
* Prototype: fun [EdToolBar CompRollOver S ] I
*
* \param EdToolBar : tool bar structure
* \param CompRollOver : button element
* \param S : tooltip text
*
* \return I : 0
**/
fun setEdToolBarButtonToolTip(t, check, bubble)=
let _CONVERTcompRollOverToObjNode check -> node in
let switch t.ETB_lTooltip node -> tooltip in
(
if (tooltip == nil) then nil else
let tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set t.ETB_lTooltip = G2DremoveEdIdxFromList t.ETB_lTooltip node;
);
_DStoolTip node;
if (!strcmp (strtrim bubble) "") then nil else
_CRtoolTip node 150 bubble @cbEdToolBarToolTipShow t @cbEdToolBarToolTipHide t;
);
0;;
/*! @ingroup g2dToolbar
* \brief Create a toolbar button element
*
* Prototype: fun [EdToolBar AlphaBitmap I S fun [EdToolBar CompRollOver I I] I] CompRollOver
*
* \param EdToolBar : tool bar structure
* \param AlphaBitmap : alpha bitmap to use as graphic button
* \param I : toolbar align flag (ETB_ALIGN_LEFT, ETB_ALIGN_RIGHT, ETB_ALIGN_BOTTOM, ETB_ALIGN_TOP)
* \param S : tooltip text
* \param fun [EdToolBar CompRollOver I I] I : callback on click
*
* \return CompRollOver : new button
**/
fun crEdToolBarButton(t, abmp, align, bubble, cbclick) =
let _GETalphaBitmapSize abmp -> [bw bh] in
let [bw (bh / 5)] -> [w h] in
let
if align == ETB_ALIGN_RIGHT then
[(set t.ETB_iCurrentRpos = t.ETB_iCurrentRpos - t.ETB_iHmargin - w) t.ETB_iVmargin]
else if align == ETB_ALIGN_TOP then
[t.ETB_iHmargin ((set t.ETB_iCurrentTpos = t.ETB_iCurrentTpos + t.ETB_iVmargin + h) - h)]
else if align == ETB_ALIGN_BOTTOM then
[t.ETB_iHmargin (set t.ETB_iCurrentBpos = t.ETB_iCurrentBpos - t.ETB_iVmargin - h)]
else
[((set t.ETB_iCurrentLpos = t.ETB_iCurrentLpos + t.ETB_iHmargin + w) - w) t.ETB_iVmargin]
-> [x y] in
let _CRcompRollOver t.ETB_channel t.ETB_cont nil [x y] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE OBJ_CONTAINER_MOVE|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_DBLCLICK abmp -> button in
(
if (!strcmp (strtrim bubble) "") then nil else
_CRtoolTip _CONVERTcompRollOverToObjNode button 150 bubble @cbEdToolBarToolTipShow t @cbEdToolBarToolTipHide t;
_CBcompRollOverUnClick button @cbEdToolBarButtonClick [t cbclick];
_CBcompRollOverCursorMoveIn button @cbEdToolBarButtonIn [t nil];
_CBcompRollOverCursorMoveOut button @cbEdToolBarButtonOut [t nil];
_CBcompRollOverResize button @cbEdToolBarButtonResize [t nil];
set t.ETB_lButton = button::t.ETB_lButton;
set t.ETB_lControl = G2Dlcat t.ETB_lControl [(_CONVERTcompRollOverToObjNode button) align]::nil;
button;
);;
/*! \brief Callback on toolbar bitmap click
*
* Private
*
* Prototype: fun [CompBitmap [EdToolBar fun [EdToolBar CompBitmap I I] I] I I I I] I
*
* \return I : 0
**/
fun cbEdToolBarBmpClick(bmp, p, x, y, btn, mask)=
let p -> [t cbclick] in
exec cbclick with [t btn mask 0];
0;;
/*! \brief Callback on toolbar bitmap double click
*
* Private
*
* Prototype: fun [CompBitmap [EdToolBar fun [EdToolBar I I I] I] I I I I] I
*
* \return I : 0
**/
fun cbEdToolBarBmpDbClick(bmp, p, x, y, btn, mask)=
let p -> [t cbclick] in
exec cbclick with [t btn mask 1];
0;;
/*! @ingroup g2dToolbar
* \brief Set the toolbar bitmap element tooltip content
*
* Prototype: fun [EdToolBar CompBitmap S ] I
*
* \param EdToolBar : tool bar structure
* \param CompBitmap : bitmap element
* \param S : tooltip text
*
* \return I : 0
**/
fun setEdToolBarBitmapToolTip(t, check, bubble)=
let _CONVERTcompBitmapToObjNode check -> node in
let switch t.ETB_lTooltip node -> tooltip in
(
if (tooltip == nil) then nil else
let tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set t.ETB_lTooltip = G2DremoveEdIdxFromList t.ETB_lTooltip node;
);
_DStoolTip node;
if (!strcmp (strtrim bubble) "") then nil else
_CRtoolTip node 150 bubble @cbEdToolBarToolTipShow t @cbEdToolBarToolTipHide t;
);
0;;
/*! @ingroup g2dToolbar
* \brief Create a toolbar bitmap element
*
* Prototype: fun [EdToolBar AlphaBitmap I S fun [EdToolBar I I I] I] CompRollOver
*
* \param EdToolBar : tool bar structure
* \param AlphaBitmap : alpha bitmap to use as graphic bitmap
* \param I : toolbar align flag (ETB_ALIGN_LEFT, ETB_ALIGN_RIGHT, ETB_ALIGN_BOTTOM, ETB_ALIGN_TOP)
* \param S : tooltip text
* \param fun [EdToolBar I I I] I : callback on click
*
* \return I : 0
**/
fun crEdToolBarBitmap (t, abmp, align, bubble, cbclick) =
let _GETalphaBitmapSize abmp -> [w h] in
let
if align == ETB_ALIGN_RIGHT then
[(set t.ETB_iCurrentRpos = t.ETB_iCurrentRpos - t.ETB_iHmargin - w) t.ETB_iVmargin]
else if align == ETB_ALIGN_TOP then
[t.ETB_iHmargin ((set t.ETB_iCurrentTpos = t.ETB_iCurrentTpos + t.ETB_iVmargin + h) - h)]
else if align == ETB_ALIGN_BOTTOM then
[t.ETB_iHmargin (set t.ETB_iCurrentBpos = t.ETB_iCurrentBpos - t.ETB_iVmargin - h)]
else
[((set t.ETB_iCurrentLpos = t.ETB_iCurrentLpos + t.ETB_iHmargin + w) - w) t.ETB_iVmargin]
-> [x y] in
let _CRcompBitmap t.ETB_channel t.ETB_cont nil [x y] OBJ_ENABLE OBJ_CONTAINER_MOVE|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_DBLCLICK abmp 0 0 w h -> bmp in
(
if (!strcmp (strtrim bubble) "") then nil else
_CRtoolTip _CONVERTcompBitmapToObjNode bmp 150 bubble @cbEdToolBarToolTipShow t @cbEdToolBarToolTipHide t;
_CBcompBitmapClick bmp @cbEdToolBarBmpClick [t cbclick];
_CBcompBitmapDblClick bmp @cbEdToolBarBmpDbClick [t cbclick];
set t.ETB_lBmp = bmp::t.ETB_lBmp;
set t.ETB_lControl = G2Dlcat t.ETB_lControl [(_CONVERTcompBitmapToObjNode bmp) align]::nil;
bmp;
);;
/*! \brief Destroy a toolbar from a window
*
* Private
*
* Prototype: fun [EdWindow EdToolBar] I
*
* \param EdWindow : window structure
* \param EdToolBar : tool bar structure
*
* \return I : 0
**/
fun dsEdToolBar (win, tbstr) =
_DSwindow tbstr.ETB_win;
_DScontainer tbstr.ETB_cont;
set tbstr.ETB_win = nil;
set tbstr.ETB_cont = nil;
let sizelist tbstr.ETB_lButton -> size in
let 0 -> i in
while i < size do
(
let nth_list tbstr.ETB_lButton i -> btn in
_DScompRollOver btn;
set i = i + 1;
);
let sizelist tbstr.ETB_lBmp -> size in
let 0 -> i in
while i < size do
(
let nth_list tbstr.ETB_lBmp i -> bmp in
_DScompBitmap bmp;
set i = i + 1;
);
let sizelist tbstr.ETB_lCheck -> size in
let 0 -> i in
while i < size do
(
let nth_list tbstr.ETB_lCheck i -> chk in
_DScompCheck chk;
set i = i + 1;
);
let sizelist tbstr.ETB_lText -> size in
let 0 -> i in
while i < size do
(
let nth_list tbstr.ETB_lText i -> [txt font] in
(
_DScompText txt;
_DSfont font;
);
set i = i + 1;
);
let sizelist tbstr.ETB_lTooltip -> size in
let 0 -> i in
while i < size do
(
let nth_list tbstr.ETB_lTooltip i -> [_ [cont text]] in
(
_DScompText text;
_DScontainer cont;
);
set i = i + 1;
);
dsEdTabBar tbstr.ETB_tabBar;
set tbstr.ETB_tabBar = nil;
set tbstr.ETB_lControl = nil;
_DSfont tbstr.ETB_fontTooltip;
set tbstr.ETB_fontTooltip = nil;
0;;
/*! \brief Destroy a toolbar list
*
* Private
*
* Prototype: fun [[EdToolBar r1]] I
*
* \param [EdToolBar r1] : tool bar structure list
*
* \return I : 0
**/
fun dsEdToolBarList(l)=
let sizelist l -> size in
let 0 -> i in
while i < size do
(
let nth_list l i -> elt in
dsEdToolBar nil elt;
set i = i + 1;
);
0;;
/*! @ingroup g2dToolbar
* \brief Resize a toolbar
*
* Prototype: fun [EdToolBar I I I I] I
*
* \param EdToolBar : tool bar structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
*
* \return I : 0
**/
fun sizeEdToolBar(t, x, y, w, h)=
_SIZEwindow t.ETB_win w h x y;
_SIZEcontainer t.ETB_cont 0 0 w h;
set t.ETB_iCurrentLpos = 0;
set t.ETB_iCurrentRpos = w;
set t.ETB_iCurrentTpos = 0;
set t.ETB_iCurrentBpos = h;
set t.ETB_size = [w h];
let sizelist t.ETB_lControl -> size in
let 0 -> i in
while i < size do
(
let nth_list t.ETB_lControl i -> [node align] in
let _GETobjNodePositionSizeInContainerRef node -> [_ _ nw nh] in
let
if align == ETB_ALIGN_RIGHT then
[(set t.ETB_iCurrentRpos = t.ETB_iCurrentRpos - t.ETB_iHmargin - nw) t.ETB_iVmargin]
else if align == ETB_ALIGN_TOP then
[t.ETB_iHmargin ((set t.ETB_iCurrentTpos = t.ETB_iCurrentTpos + t.ETB_iVmargin + nh) - nh)]
else if align == ETB_ALIGN_BOTTOM then
[t.ETB_iHmargin (set t.ETB_iCurrentBpos = t.ETB_iCurrentBpos - t.ETB_iVmargin - nh)]
else
[((set t.ETB_iCurrentLpos = t.ETB_iCurrentLpos + t.ETB_iHmargin + nw) - nw) t.ETB_iVmargin]
-> npos in
_CHANGEobjNodeCoordinates node npos 0;
set i = i + 1;
);
resizeEdTabBar t.ETB_tabBar w h;
_PAINTcontainer t.ETB_cont;
_TOPwindow t.ETB_win;
_TOPcontainer t.ETB_cont;
0;;
/*! @ingroup g2dToolbar
* \brief Paint a toolbar
*
* Prototype: fun [EdToolBar] I
*
* \param EdToolBar : tool bar structure
*
* \return I : 0
**/
fun paintEdToolBar(t)=
//_TOPwindow t.ETB_win;
_TOPcontainer t.ETB_cont;
_PAINTcontainer t.ETB_cont;
0;;
/*! \brief Callback on toolbar double click
*
* Private
*
* Prototype: fun [ObjContainer [EdToolBar fun [EdToolBar I I I I] I] I I I I] I
*
* \return I : 0
**/
fun cbEdToolBarDbClick(cont, p, x, y, btn, mask)=
let p -> [t cbfun] in
exec cbfun with [t x y btn mask];
0;;
/*! @ingroup g2dToolbar
* \brief Set the toolbar double click Callback
*
* Prototype: fun [EdToolBar fun [EdToolBar I I I I] I]] I
*
* \param EdToolBar : tool bar structure
* \param fun [EdToolBar I I I I] I : double click callback
*
* \return I : 0
**/
fun setEdToolBarDbClick(t, cbfun)=
_CBcontainerDblClick t.ETB_cont @cbEdToolBarDbClick [t cbfun];
0;;
/*! \brief Callback on toolbar click
*
* Private
*
* Prototype: fun [ObjContainer [EdToolBar fun [EdToolBar I I I I] I] I I I I] I
*
* \return I : 0
**/
fun cbEdToolBarClick(cont, p, x, y, btn, mask)=
let p -> [t cbfun] in
exec cbfun with [t x y btn mask];
0;;
/*! @ingroup g2dToolbar
* \brief Set the toolbar click Callback
*
* Prototype: fun [EdToolBar fun [EdToolBar I I I I] I]] I
*
* \param EdToolBar : tool bar structure
* \param fun [EdToolBar I I I I] I : click callback
*
* \return I : 0
**/
fun setEdToolBarClick(t, cbfun)=
_CBcontainerClick t.ETB_cont @cbEdToolBarClick [t cbfun];
0;;
/*! @ingroup g2dToolbar
* \brief Set the toolbar visibility
*
* Prototype: fun [EdToolBar I] I
*
* \param EdToolBar : tool bar structure
* \param I : 0 for hide, 1 for show
*
* \return I : 0
**/
fun setEdToolBarVisible(t, mode)=
let if !mode then WINDOW_HIDDEN else WINDOW_UNHIDDEN -> flag in
(
_SHOWwindow t.ETB_win flag;
set t.ETB_bVisible = mode;
);
0;;
/*! \brief Create a toolbar on a window
*
* Private
*
* Prototype: fun [Chn EdWindow I I I I I I I I] EdToolBar
*
* \param Chn : channel
* \param EdWindow : window where to put the toolbar
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : horizontal margin between elements
* \param I : vertical margin between elements
* \param I : toolbar background color
* \param I : mode flag (ETB_HORIZONTAL, ETB_VERTICAL, ETB_BOTTOM)
*
* \return EdToolBar : the new toolbar
**/
fun crEdToolBar(chan, father, x, y, w, h, hmargin, vmargin, bgcolor, mode)=
let if father == nil then WN_MENU else WN_CHILDINSIDE|WN_NOCAPTION|WN_NOBORDER -> flag in
let _CRwindow chan father x y w h flag "" -> win in
let _CRcontainerFromObjWin chan win 0 0 w h CO_CHILDINSIDE|CO_NOBORDER bgcolor "toolbar" -> cont in
let mkEdToolBar[chan win cont [x y] [w h] mode bgcolor hmargin vmargin nil nil nil nil nil nil nil nil nil nil nil nil 1] -> t in
(
set t.ETB_iCurrentLpos = 0;
set t.ETB_iCurrentRpos = w;
set t.ETB_iCurrentTpos = 0;
set t.ETB_iCurrentBpos = h;
set t.ETB_fontTooltip = G2DcrFont chan 8 0 FF_PIXEL "Arial";
_CBwinDestroy win @dsEdToolBar t;
_TOPwindow t.ETB_win;
_TOPcontainer t.ETB_cont;
_PAINTcontainer t.ETB_cont;
t;
);;
/* ********************************************************************************************* /
Window
/ ********************************************************************************************* */
/*! @ingroup g2dWindow
* \brief Get a window visible state
*
* Prototype: fun [EdWindow] I
*
* \param EdWindow : window structure
*
* \return I : 0 for hidden, 1 for visible
**/
fun getEdWindowVisibleState(winstr)= winstr.EDW_bVisible;;
/*! @ingroup g2dWindow
* \brief Enable or disable 3D view on a window or on its child windows
*
* Prototype: fun [EdWindow I] I
*
* \param EdWindow : window structure
* \param I : new state, 0 for disable, 1 for enable
*
* \return I : 0
**/
fun setEdWindowCtrl3dEnable(winstr, state)=
let sizelist winstr.EDW_lControl -> size in
let 0 -> i in
while i < size do
(
let nth_list winstr.EDW_lControl i -> ctrlstr in
if ctrlstr.EDC_view3d == nil then nil else
V3DEnableRender ctrlstr.EDC_view3d state;
set i = i + 1;
);
let sizelist winstr.EDW_lSons -> size in
let 0 -> i in
while i < size do
(
let nth_list winstr.EDW_lSons i -> sonstr in
setEdWindowCtrl3dEnable sonstr state;
set i = i + 1;
);
0;;
/*! @ingroup g2dWindow
* \brief Show or hide a window
*
* Prototype: fun [EdWindow I] EdWindow
*
* \param EdWindow : window structure
* \param I : new state, 0 for hide, 1 for show
*
* \return EdWindow : same window
**/
fun setEdWindowVisible(winstr, state)=
let if !state then 0 else 1 -> state in
(
set winstr.EDW_bVisible = state;
_SHOWwindow winstr.EDW_win if !state then WINDOW_HIDDEN else WINDOW_UNHIDDEN;
setEdWindowCtrl3dEnable winstr state;
);
winstr;;
/*! @ingroup g2dWindow
* \brief Give the keyboard focus on a window
*
* Prototype: fun [EdWindow] EdWindow
*
* \param EdWindow : window structure to focus
*
* \return EdWindow : same window
**/
fun setEdWindowFocus(winstr)=
_SETfocus winstr.EDW_win;
winstr;;
/*! @ingroup g2dWindow
* \brief Bring a window to the top on the screen
*
* Prototype: fun [EdWindow] EdWindow
*
* \param EdWindow : window structure to put in top
*
* \return EdWindow : same window
**/
fun setEdWindowTop(winstr)=
_TOPwindow winstr.EDW_win;
winstr;;
/*! @ingroup g2dWindow
* \brief Bring a window to the top most on the screen
*
* Prototype: fun [EdWindow] EdWindow
*
* \param EdWindow : window structure to put in top
*
* \return EdWindow : same window
**/
fun setEdWindowTopMost(winstr)=
_TOPMOSTwindow winstr.EDW_win 3 1;
_TOPMOSTwindow winstr.EDW_win 1 1;
winstr;;
/*! @ingroup g2dWindow
* \brief Rename the title of a window
*
* Prototype: fun [EdWindow S] I
*
* \param EdWindow : window structure
* \param S : the new title
*
* \return I : 0
**/
fun setEdWindowName(winstr, name)=
_SETwindowName winstr.EDW_win name;
0;;
/*! @ingroup g2dWindow
* \brief Set the minimum window size
*
* Prototype: fun [EdWindow I I] I
*
* \param EdWindow : window structure
* \param I : minimum width
* \param I : minimum height
*
* \return I : 0
**/
fun setEdWindowMinimumSize(winstr, w, h)=
//manage border size
let _GETwindowExPositionSize winstr.EDW_win -> [_ _ ew eh] in
let _GETwindowPositionSize winstr.EDW_win -> [_ _ nw nh] in
let [((w + (ew - nw)) - 1) ((h + (eh - nh)) - 1)] -> [w h] in
_SETwindowMinSize winstr.EDW_win w h;
0;;
/*! @ingroup g2dWindow
* \brief Set the maximum window size
*
* Prototype: fun [EdWindow I I] I
*
* \param EdWindow : window structure
* \param I : maximum width
* \param I : maximum height
*
* \return I : 0
**/
fun setEdWindowMaximumSize(winstr, w, h)=
//manage border size
let _GETwindowExPositionSize winstr.EDW_win -> [_ _ ew eh] in
let _GETwindowPositionSize winstr.EDW_win -> [_ _ nw nh] in
let [((w + (ew - nw)) - 1) ((h + (eh - nh)) - 1)] -> [w h] in
_SETwindowMaxSize winstr.EDW_win w h;
0;;
/*! @ingroup g2dWindow
* \brief Get the size used by toolbars on a window
*
* Prototype: fun [EdWindow] I
*
* \param EdWindow : window structure
*
* \return I : the size used by toolbars
**/
fun getEdWindowToolBarSize(winstr)=
let sizelist winstr.EDW_lToolbar -> size in
let 0 -> xdecal in
let 0 -> ydecal in
let 0 -> i in
(
while i < size do
(
let nth_list winstr.EDW_lToolbar i -> tb in
if !tb.ETB_bVisible then nil else
(
let tb.ETB_size -> [tw th] in
if tb.ETB_modeflag & ETB_VERTICAL then
set xdecal = xdecal + tw
else if tb.ETB_modeflag & ETB_HORIZONTAL then
set ydecal = ydecal + th
else nil;
);
set i = i + 1;
);
[xdecal ydecal]
);;
/*! @ingroup g2dWindow
* \brief Resize all toolbars on a window
*
* Prototype: fun [EdWindow I I] I
*
* \param EdWindow : window structure
* \param I : new toolbar width
* \param I : new toolbar height
*
* \return I : 0
**/
fun resizeEdWindowToolBar(winstr, winw, winh, w, h)=
let sizelist winstr.EDW_lToolbar -> size in
let 0 -> i in
while i < size do
(
let nth_list winstr.EDW_lToolbar i -> elem in
let elem.ETB_pos -> [tx ty] in
let elem.ETB_size -> [tw th] in
if elem.ETB_modeflag == nil then nil else
let if elem.ETB_modeflag & ETB_VERTICAL then [tw (h - ty)] else [(w - tx) th] -> [tbw tbh] in
let if elem.ETB_modeflag & ETB_VERTICAL then winw - tbw else tx -> tx in
let if elem.ETB_modeflag & ETB_BOTTOM then winh - tbh else ty -> ty in
sizeEdToolBar elem tx ty tbw tbh;
set i = i + 1;
);
0;;
/*! @ingroup g2dWindow
* \brief Destroy a toolbar from a window
*
* Prototype: fun [EdWindow EdToolBar] I
*
* \param EdWindow : window structure
* \param EdToolBar : toolbar to destroy
*
* \return I : 0
**/
fun dsEdWindowToolBar(winstr, tbstr)=
set winstr.EDW_lToolbar = G2DremoveFromList winstr.EDW_lToolbar tbstr;
dsEdToolBar nil tbstr;
0;;
/*! @ingroup g2dWindow
* \brief Create a toolbar on a window
*
* Private
*
* Prototype: fun [Chn EdWindow I I I I I I I I] EdToolBar
*
* \param EdWindow : window where to put the toolbar
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : horizontal margin between elements
* \param I : vertical margin between elements
* \param I : toolbar background color
* \param I : mode flag (ETB_HORIZONTAL, ETB_VERTICAL)
*
* \return EdToolBar : the new toolbar
**/
fun crEdWindowToolBar(winstr, x, y, w, h, hmargin, vmargin, bgcolor, mode)=
let crEdToolBar winstr.EDW_channel winstr.EDW_win x y w h hmargin vmargin bgcolor mode -> tbstr in
(
set winstr.EDW_lToolbar = tbstr::winstr.EDW_lToolbar;
tbstr;
);;
/*! \brief Calculate the needed Y position of a window from the other group windows
*
* Private
*
* Prototype: fun [EdWindow] I
*
* \param EdWindow : window structure
*
* \return I : new y pos
**/
fun calcEdWindowGroupSonPos(winstr)=
let sizelist winstr.EDW_lSons -> size in
let nil -> newy in
let 0 -> i in
(
while i < size do
(
let nth_list winstr.EDW_lSons i -> sonstr in
if (sonstr.EDW_modeFlag & EDWIN_DIALOG) || (sonstr.EDW_modeFlag & EDWIN_POPUP) then nil else
let _GETwindowExPositionSize sonstr.EDW_win -> [x y w h] in
set newy = (if newy == nil then y else newy) + h;
set i = i + 1;
);
newy;
);;
/*! \brief Move group windows from the other group windows
*
* Private
*
* Prototype: fun [EdWindow] I
*
* \param EdWindow : window structure
*
* \return I : 0
**/
fun updateEdGroupWindowSons(winstr)=
if !(winstr.EDW_modeFlag & EDWIN_GROUP) then nil else
let sizelist winstr.EDW_lSons -> size in
let nil -> newy in
let 0 -> i in
(
while i < size do
(
let nth_list winstr.EDW_lSons i -> sonstr in
if (sonstr.EDW_modeFlag & EDWIN_DIALOG) || (sonstr.EDW_modeFlag & EDWIN_POPUP) then nil else
let _GETwindowExPositionSize sonstr.EDW_win -> [x y w h] in
(
set newy = if newy == nil then y else newy;
_SIZEwindowEx sonstr.EDW_win w h x newy;
set newy = newy + h;
);
set i = i + 1;
);
);
0;;
/*! \brief Calculate a frame window Y position in a group windows
*
* Private
*
* Prototype: fun [EdWindow] I
*
* \param EdWindow : window structure
*
* \return I : Y position
**/
fun getEdFrameYpos(winstr)=
if !(winstr.EDW_father.EDW_modeFlag & EDWIN_GROUP) then nil else
let sizelist winstr.EDW_father.EDW_lSons -> size in
let nil -> newy in
let 0 -> i in
let nil -> sonstr in
(
while i < size && sonstr != winstr do
(
set sonstr = nth_list winstr.EDW_father.EDW_lSons i;
if sonstr == winstr then nil else
if (sonstr.EDW_modeFlag & EDWIN_DIALOG) || (sonstr.EDW_modeFlag & EDWIN_POPUP) then nil else
let _GETwindowExPositionSize sonstr.EDW_win -> [x y w h] in
(
set newy = if newy == nil then y else newy;
set newy = newy + h;
);
set i = i + 1;
);
newy;
);;
/*! \brief Calculate coordinates of a window according to the mother window
*
* Private
*
* Prototype: fun [EdWindow] [I I I I I I]
*
* \param EdWindow : window structure
*
* \return [I I I I I I] : window coords
**/
fun calcEdCoord(winstr)=
let if winstr.EDW_father == nil then
let _GETWorkingAreaSize -> [ww hh] in
[ww hh-40]
else
let _GETwindowPositionSize winstr.EDW_father.EDW_win -> [_ _ ww hh] in
[ww hh]
-> [fw fh] in
let _GETwindowPositionSize winstr.EDW_win -> [x y w h] in
set winstr.EDW_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
0;;
/*! \brief Calculate a position with respect to the resize flags
*
* Private
*
* Prototype: fun [I I I I I] [I I]
*
* \return [I I] : size
**/
fun calcEdWindowDim(typ,x1,w,x2,l)=
let max 1 (if typ&1 then x1 else 0)+(if typ&2 then w else 0)+(if typ&4 then x2 else 0) -> sum in
let (x1 * ((l-x1-x2-w)+sum)) / sum -> xx in
let (w * ((l-x1-x2-w)+sum)) / sum -> ww in
[(if typ&1 then xx else x1) (if typ&2 then ww else w)];;
/*! \brief Calculate a window position and size according to its resize flags
*
* Private
*
* Prototype: fun [EdWindow] [I I I I]
*
* \param EdWindow : window structure
*
* \return [I I I I] : x y window pos and w h size
**/
fun calcEdWindowSizePos(winstr)=
let winstr.EDW_initCoords -> [x1 y1 x2 y2 w h] in
if !winstr.EDW_resizeFlag then
[x1 y1 w h]
else
let if winstr.EDW_father==nil then
let _GETWorkingAreaSize -> [tw th] in
[tw th-40]
else let _GETwindowSizePosition winstr.EDW_father.EDW_win -> [tw th _ _] in
if tw == 0 || th == 0 then let winstr.EDW_father.EDW_initCoords -> [_ _ _ _ sw sh] in [sw sh] else [tw th]
-> [fw fh] in
(
let calcEdWindowDim winstr.EDW_resizeFlag x1 w x2 fw -> [xx ww] in
let calcEdWindowDim winstr.EDW_resizeFlag>>3 y1 h y2 fh -> [yy hh] in
[xx yy ww hh]
);;
/*! \brief Calculate a control position and size according to its resize flags
*
* Private
*
* Prototype: fun [EdControl] [I I I I]
*
* \param EdControl : control structure
*
* \return [I I I I] : x y control pos and w h size
**/
fun calcEdCtrlSizePos(ctrlstr)=
let ctrlstr.EDC_coords -> [x1 y1 x2 y2 w h] in
if !ctrlstr.EDC_resizeFlag then
[x1 y1 w h]
else
let ctrlstr.EDC_father.EDW_initCoords -> [_ _ _ _ ow oh] in
let if w < 0 then (ow - (abs w)) else w -> w in
let if h < 0 then (oh - (abs h)) else h -> h in
let _GETwindowSizePosition ctrlstr.EDC_father.EDW_win -> [fw fh _ _] in
(
let calcEdWindowDim ctrlstr.EDC_resizeFlag x1 w x2 fw -> [xx ww] in
let calcEdWindowDim ctrlstr.EDC_resizeFlag>>3 y1 h y2 fh -> [yy hh] in
[xx yy ww hh]
);;
/*! \brief Get a virtual window size
*
* Private
*
* Prototype: fun [EdWindow] [I I]
*
* \param EdWindow : window structure
*
* \return [I I] : w h window size
**/
fun getEdVirtualWindowSize(winstr)=
let _GETwindowPositionSize winstr.EDW_virtualWin -> [_ _ w h] in
[w h];;
/*! \brief Get a virtual window position
*
* Private
*
* Prototype: fun [EdWindow] [I I]
*
* \param EdWindow : window structure
*
* \return [I I] : x y window position
**/
fun getEdVirtualWindowPos(winstr)=
let _GETwindowPositionSize winstr.EDW_virtualWin -> [x y _ _] in
[x y];;
/*! \brief Get a window size
*
* Private
*
* Prototype: fun [EdWindow] [I I]
*
* \param EdWindow : window structure
*
* \return [I I] : w h window size
**/
fun getEdWindowSize(winstr)=
let _GETwindowPositionSize winstr.EDW_win -> [x y w h] in
[w h];;
/*! \brief Get a window position
*
* Private
*
* Prototype: fun [EdWindow] [I I]
*
* \param EdWindow : window structure
*
* \return [I I] : x y window position
**/
fun getEdWindowPos(winstr)=
let _GETwindowPositionSize winstr.EDW_win -> [x y w h] in
[x y];;
/*! \brief Get a window position and size
*
* Private
*
* Prototype: fun [EdWindow] [I I I I]
*
* \param EdWindow : window structure
*
* \return [I I I I] : x y window position and w h size
**/
fun getEdWindowPosSize(winstr)=
let _GETwindowPositionSize winstr.EDW_win -> [x y w h] in
[x y w h];;
/*! \brief Get a window position in screen
*
* Private
*
* Prototype: fun [EdWindow] [I I]
*
* \param EdWindow : window structure
*
* \return [I I] : x y window position
**/
fun getEdWindowScreenPos(winstr)=
let [0 0] -> [px py] in
(
while (winstr != nil) do
(
let _GETwindowPositionSize winstr.EDW_win -> [x y w h] in
(
set px = px + x;
set py = py + y;
);
set winstr = winstr.EDW_father;
);
[px py];
);;
/*! \brief Get a window position and size with borders
*
* Private
*
* Prototype: fun [EdWindow] [I I I I]
*
* \param EdWindow : window structure
*
* \return [I I I I] : x y window position and w h size
**/
fun getEdWindowExPosSize(winstr)=
let _GETwindowExPositionSize winstr.EDW_win -> [x y w h] in
[x y w h];;
/*! \brief Get a window resize flags
*
* Private
*
* Prototype: fun [EdWindow] I
*
* \param EdWindow : window structure
*
* \return I : resize flags
**/
fun getEdWindowResizeFlags(winstr)= winstr.EDW_resizeFlag;;
/*! \brief Resize a window according to its type, state and resize flags
*
* Private
*
* Prototype: fun [EdWindow] I
*
* \param EdWindow : window structure
*
* \return I : 0
**/
fun resizeEdWindow(winstr)=
if (winstr.EDW_resizeFlag == nil) || (winstr.EDW_resizeFlag == EDWIN_RESIZE_NONE) || (winstr.EDW_modeFlag & EDWIN_DIALOG) && !(winstr.EDW_modeFlag & EDWIN_FRAME) then nil else
if winstr.EDW_modeFlag & EDWIN_TAB then
(
let getEdWindowToolBarSize winstr.EDW_father -> [xdecal ydecal] in
let getEdWindowSize winstr.EDW_father -> [w h] in
_SIZEwindow winstr.EDW_win (w - xdecal) (h - ydecal) xdecal ydecal;
0;
)
else if winstr.EDW_bMinimize != 1 then
(
let calcEdWindowSizePos winstr -> [x y w h] in
let if (winstr.EDW_modeFlag & EDWIN_FRAME) then getEdFrameYpos winstr else y -> y in
_SIZEwindow winstr.EDW_win w h x y;
0;
)
else if (winstr.EDW_bMinimize) && (winstr.EDW_modeFlag & EDWIN_FRAME) then
(
let hd winstr.EDW_lToolbar -> tbstr in
let tbstr.ETB_size -> [tw th] in
let calcEdWindowSizePos winstr -> [x y w h] in
let getEdFrameYpos winstr -> y in
(
_SIZEwindow winstr.EDW_win w th x y;
0;
);
)
else
(
let _GETwindowSizePosition winstr.EDW_father.EDW_win -> [w h _ _] in
let winstr.EDW_tMdecal -> [hdecal vdecal] in
let getEdWindowToolBarSize winstr.EDW_father -> [xdecal ydecal] in
(
_SIZEwindow winstr.EDW_win (w - xdecal) (h - ydecal) xdecal+hdecal ydecal+vdecal;
_TOPwindow winstr.EDW_win;
//_SETfocus winstr.EDW_win;
);
0;
);
0;;
/*! @ingroup g2dWindow
* \brief Move and resize a window
*
* Prototype: fun [EdWindow I I I I] I
*
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
* \param i : width
* \param I : height
*
* \return I : 0
**/
fun setEdWindowPosSize(winstr, x, y, w, h)=
_SIZEwindow winstr.EDW_win w h x y;
calcEdCoord winstr;
set winstr.EDW_initCoords = winstr.EDW_coords;
0;;
/*! @ingroup g2dWindow
* \brief Resize a window
*
* Prototype: fun [EdWindow I I] I
*
* \param EdWindow : window structure
* \param i : width
* \param I : height
*
* \return I : 0
**/
fun setEdWindowSize(winstr, w, h)=
let _GETwindowPositionSize winstr.EDW_win -> [x y _ _] in
_SIZEwindow winstr.EDW_win w h x y;
calcEdCoord winstr;
set winstr.EDW_initCoords = winstr.EDW_coords;
0;;
/*! @ingroup g2dWindow
* \brief Move a window
*
* Prototype: fun [EdWindow I I] I
*
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
*
* \return I : 0
**/
fun setEdWindowPos(winstr, x, y)=
let _GETwindowPositionSize winstr.EDW_win -> [_ _ w h] in
_SIZEwindow winstr.EDW_win w h x y;
calcEdCoord winstr;
set winstr.EDW_initCoords = winstr.EDW_coords;
0;;
/*! @ingroup g2dWindow
* \brief Move and resize a window with global coordinates (window + border + title)
*
* Prototype: fun [EdWindow I I I I] I
*
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
* \param i : width
* \param I : height
*
* \return I : 0
**/
fun setEdWindowPosSizeEx(winstr, x, y, w, h)=
_SIZEwindowEx winstr.EDW_win w h x y;
calcEdCoord winstr;
set winstr.EDW_initCoords = winstr.EDW_coords;
0;;
/*! @ingroup g2dWindow
* \brief Resize a window with global coordinates (window + border + title)
*
* Prototype: fun [EdWindow I I] I
*
* \param EdWindow : window structure
* \param i : width
* \param I : height
*
* \return I : 0
**/
fun setEdWindowSizeEx(winstr, w, h)=
let _GETwindowPositionSize winstr.EDW_win -> [x y _ _] in
_SIZEwindowEx winstr.EDW_win w h x y;
calcEdCoord winstr;
set winstr.EDW_initCoords = winstr.EDW_coords;
0;;
/*! @ingroup g2dWindow
* \brief Move a window with global coordinates (window + border + title)
*
* Prototype: fun [EdWindow I I] I
*
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
*
* \return I : 0
**/
fun setEdWindowPosEx(winstr, x, y)=
let _GETwindowPositionSize winstr.EDW_win -> [_ _ w h] in
_SIZEwindowEx winstr.EDW_win w h x y;
calcEdCoord winstr;
set winstr.EDW_initCoords = winstr.EDW_coords;
0;;
/*! @ingroup g2dWindow
* \brief Move and resize a virtual window
*
* Prototype: fun [EdWindow I I I I] I
*
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
* \param i : width
* \param I : height
*
* \return I : 0
**/
fun setEdVirtualWindowPosSize(winstr, x, y, w, h)=
_SIZEwindow winstr.EDW_virtualWin w h x y;
0;;
/*! @ingroup g2dWindow
* \brief Resize a virtual window
*
* Prototype: fun [EdWindow I I] I
*
* \param EdWindow : window structure
* \param i : width
* \param I : height
*
* \return I : 0
**/
fun setEdVirtualWindowSize(winstr, w, h)=
let _GETwindowPositionSize winstr.EDW_virtualWin -> [x y _ _] in
_SIZEwindow winstr.EDW_virtualWin w h x y;
0;;
/*! @ingroup g2dWindow
* \brief Move a virtual window
*
* Prototype: fun [EdWindow I I] I
*
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
*
* \return I : 0
**/
fun setEdVirtualWindowPos(winstr, x, y)=
let _GETwindowPositionSize winstr.EDW_virtualWin -> [_ _ w h] in
_SIZEwindow winstr.EDW_virtualWin w h x y;
0;;
/*! @ingroup g2dWindow
* \brief set a window parent
*
* Prototype: fun [EdWindow EdWindow] I
*
* \param EdWindow : window structure
* \param EdWindow : new parent window structure
*
* \return I : 0
**/
fun setEdWindowParent(winstr, fatherstr)=
_SETwindowParent winstr.EDW_win fatherstr.EDW_win;
set winstr.EDW_prevFather = winstr.EDW_father;
set winstr.EDW_father.EDW_lSons = G2DremoveFromList winstr.EDW_father.EDW_lSons winstr;
set winstr.EDW_father = fatherstr;
set fatherstr.EDW_lSons = winstr::fatherstr.EDW_lSons;
calcEdCoord winstr;
set winstr.EDW_initCoords = winstr.EDW_coords;
0;;
/*! @ingroup g2dWindow
* \brief Change a window resize flags
*
* Prototype: fun [EdWindow I] I
*
* \param EdWindow : window structure
* \param I : new resize flags
*
* \return I : 0
**/
fun setEdWindowResizeFlags(winstr, flags)=
set winstr.EDW_resizeFlag = flags;
calcEdCoord winstr;
set winstr.EDW_initCoords = winstr.EDW_coords;
0;;
/*! \brief Callback on virtual window resize
*
* Private
*
* Prototype: fun [ObjWin EdWindow I I] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : width
* \param I : height
*
* \return I : 0
**/
fun cbEdVirtualWindowSize(win, winstr, wv, hv)=
exec winstr.EDW_cbVirtualSize with [winstr wv hv];
0;;
/*! \brief Callback on virtual window move
*
* Private
*
* Prototype: fun [ObjWin EdWindow I I] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
*
* \return I : 0
**/
fun cbEdVirtualWindowMove(win, winstr, x, y)=
exec winstr.EDW_cbVirtualMove with [winstr x y];
0;;
/*! \brief Callback on window move
*
* Private
*
* Prototype: fun [ObjWin EdWindow I I] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
*
* \return I : 0
**/
fun cbEdWindowMove(win, winstr, x, y)=
// update Ed coordinates
calcEdCoord winstr;
// update the minimum size of the father virtual window on son modification
resizeEdWindowVirtualSize winstr.EDW_father;
exec winstr.EDW_cbMove with [winstr x y];
0;;
/*! \brief Update all controls size according to the mother window
*
* Private
*
* Prototype: fun [ObjWin EdWindow I I] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
*
* \return I : 0
**/
fun updateEdCtrlSize(winstr)=
let sizelist winstr.EDW_lControl -> size in
let 0 -> i in
while i < size do
(
let nth_list winstr.EDW_lControl i -> ctrlstr in
let ctrlstr.EDC_coords -> [_ _ _ _ cw ch] in
let calcEdCtrlSizePos ctrlstr -> [x y w h] in
// + 1 because of the border size
(
if ctrlstr.EDC_label != nil then
// the init size is the minimum size
let if h <= ch then ch else h -> h in
(
_POSITIONtext ctrlstr.EDC_label x y w h;
0;
)
else if ctrlstr.EDC_colorLabel != nil then
// the init size is the minimum size
let if h <= ch then ch else h -> h in
(
let ctrlstr.EDC_colorLabel -> [cont cmptext] in
_SIZEcontainer cont x y w h;
0;
)
else if ctrlstr.EDC_editText != nil then
(
_POSITIONtext ctrlstr.EDC_editText x y w+1 h+1;
0;
)
else if ctrlstr.EDC_editLine != nil then
// the init size is the minimum size
let if h <= ch then ch else h -> h in
(
_POSITIONtext ctrlstr.EDC_editLine x y w+1 h+1;
0;
)
else if ctrlstr.EDC_text != nil then
(
_POSITIONtext ctrlstr.EDC_text x y w+1 h+1;
0;
)
else if ctrlstr.EDC_button != nil then
// the init size is the minimum size
let if h <= ch then ch else h -> h in
let ctrlstr.EDC_button -> [btn _] in
(
_POSITIONbutton btn x y w h;
0;
)
else if ctrlstr.EDC_check != nil then
// the init size is the minimum size
let if h <= ch then ch else h -> h in
(
_POSITIONcheck ctrlstr.EDC_check x y w h;
0;
)
else if ctrlstr.EDC_list != nil then
(
let ctrlstr.EDC_list -> [list _] in
_POSITIONlist list x y w+1 h+1;
0;
)
else if ctrlstr.EDC_select != nil then
// the init size is the minimum size
let if h <= ch then ch else h -> h in
(
_POSITIONcombo ctrlstr.EDC_select x y w h;
0;
)
else if ctrlstr.EDC_tree != nil then
(
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
_POSITIONtree tree x y w+1 h+1;
0;
)
else if ctrlstr.EDC_bitmap != nil then
// the init size is the minimum size
let if w <= 2 then 2 else w -> w in
let if h <= 2 then 2 else h -> h in
(
let ctrlstr.EDC_bitmap -> [cont alphabmp ocbmp _ _ _ _ _ _] in
_SIZEcontainer cont x y w h;
0;
)
else if ctrlstr.EDC_bitmapList != nil then
// the init size is the minimum size
let if w <= 2 then 2 else w -> w in
let if h <= 2 then 2 else h -> h in
(
let ctrlstr.EDC_bitmapList -> [cont _ _ _ _ _ _] in
_SIZEcontainer cont x y w h;
0;
)
else if ctrlstr.EDC_editFloat != nil then
// the init size is the minimum size
let if h <= ch then ch else h -> h in
(
let ctrlstr.EDC_editFloat -> [txt cont _ _ _ _ _ _ _ _ _ _ _ _ _ _] in
let _GETcontainerExPositionSize cont -> [_ _ bw bh] in
(
_POSITIONtext txt x y ((w - bw) + 1) (h + 1);
_MOVEcontainer cont (x + (w - bw)) y;
);
0;
)
else if ctrlstr.EDC_editDate != nil then
// the init size is the minimum size
let if h <= ch then ch else h -> h in
(
0;
)
else if ctrlstr.EDC_view3d != nil then
// the init size is the minimum size
let if w <= 1 then 1 else w -> w in
let if h <= 1 then 1 else h -> h in
(
V3DresizeView ctrlstr.EDC_view3d x y w h;
0;
)
else if ctrlstr.EDC_colorButton != nil then
// the init size is the minimum size
let if h <= ch then ch else h -> h in
(
let ctrlstr.EDC_colorButton -> [btn obmp winstr color mode cbfun] in
let if (mode != 1) then color else G2Dbgra2bgr (G2Drgba2bgra color) -> bgrcolor in
let _FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgrcolor -> bmp in
(
_DSbitmap obmp;
_POSITIONbutton btn x y w h;
_SETbuttonBitmap btn bmp;
mutate ctrlstr.EDC_colorButton <- [_ bmp _ color _ _];
_PAINTbutton btn;
);
0;
)
else if ctrlstr.EDC_slider != nil then
// the init size is the minimum size
let if h <= ch then ch else h -> h in
let if w <= cw then cw else w -> w in
(
_SIZEcontainer ctrlstr.EDC_slider.EDSLIDER_cont x y w h;
0;
)
else if ctrlstr.EDC_timeLineEditor != nil then
// the init size is the minimum size
let if h <= ch then ch else h -> h in
let if w <= cw then cw else w -> w in
(
setEdWindowPosSizeEx ctrlstr.EDC_timeLineEditor.EDTLE_win x y w h-28;
set ctrlstr.EDC_timeLineEditor.EDTLE_statusBar.ETB_pos = [ctrlstr.EDC_timeLineEditor.EDTLE_iLeftStatus h];
sizeEdToolBar ctrlstr.EDC_timeLineEditor.EDTLE_statusBar ctrlstr.EDC_timeLineEditor.EDTLE_iLeftStatus h-28 w-ctrlstr.EDC_timeLineEditor.EDTLE_iLeftStatus 28;
0;
)
else nil;
);
set i = i + 1;
);
0;;
/*! \brief Resize a virtual window according to the sons windows size
*
* Private
*
* Prototype: fun [EdWindow] I
*
* \param EdWindow : window structure
*
* \return I : 0
**/
fun resizeEdWindowVirtualSize(winstr)=
if winstr.EDW_virtualWin == nil then nil else
(
let _GETwindowPositionSize winstr.EDW_virtualWin -> [ox oy _ _] in
let _GETwindowPositionSize winstr.EDW_win -> [_ _ minw minh] in
let minw -> neww in
let minh -> newh in
(
let sizelist winstr.EDW_lSons -> size in
let 0 -> i in
(
while i < size do
(
let nth_list winstr.EDW_lSons i -> sonstr in
if sonstr.EDW_modeFlag & EDWIN_DIALOG then nil else
let _GETwindowExPositionSize sonstr.EDW_win -> [x y w h] in
let x + w -> nw in
let y + h -> nh in
let if nw > neww then nw else neww -> nnw in
let if nh > newh then nh else newh -> nnh in
(
set neww = nnw;
set newh = nnh;
);
set i = i + 1;
);
_SIZEwindow winstr.EDW_virtualWin neww newh ox oy;
);
);
// update controls size
updateEdCtrlSize winstr;
);
0;;
/*! \brief Callback on window resize
*
* Private
*
* Prototype: fun [ObjWin EdWindow I I] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : width
* \param I : height
*
* \return I : 0
**/
fun cbEdWindowSize(win, winstr, w, h)=
let sizelist winstr.EDW_lSons -> size in
let 0 -> i in
while i < size do
(
let nth_list winstr.EDW_lSons i -> son in
resizeEdWindow son;
set i = i + 1;
);
// update Ed coordinates
calcEdCoord winstr;
// update the position of the sons of a father group
updateEdGroupWindowSons winstr.EDW_father;
// update the minimum size of the virtual window
resizeEdWindowVirtualSize winstr;
// update the minimum size of the father virtual window on son modification
resizeEdWindowVirtualSize winstr.EDW_father;
// update controls size
updateEdCtrlSize winstr;
// update toolbar size
let getEdWindowToolBarSize winstr.EDW_father -> [xdecal ydecal] in
resizeEdWindowToolBar winstr w h (w - xdecal) (h - ydecal);
exec winstr.EDW_cbSize with [winstr w h];
0;;
/*! @ingroup g2dWindow
* \brief Maximize or minimize a window
*
* Prototype: fun [EdWindow I I] I
*
* \param EdWindow : window structure
* \param I : X decal
* \param I : Y decal
*
* \return I : 0
**/
fun maximizeOrMinimizeEdWindow(winstr, hdecal, vdecal)=
if winstr.EDW_bMinimize != 1 then
(
set winstr.EDW_bMinimize = 1;
set winstr.EDW_tMdecal = [hdecal vdecal];
let _GETwindowSizePosition winstr.EDW_father.EDW_win -> [w h _ _] in
let getEdWindowToolBarSize winstr.EDW_father -> [xdecal ydecal] in
(
// Hide all brothers
let sizelist winstr.EDW_father.EDW_lSons -> size in
let 0 -> i in
while i < size do
(
let nth_list winstr.EDW_father.EDW_lSons i -> brostr in
if (brostr == winstr) || (brostr.EDW_modeFlag & EDWIN_DIALOG|EDWIN_POPUP) then nil else
setEdWindowVisible brostr 0;
set i = i + 1;
);
_SIZEwindow winstr.EDW_win (w - xdecal) (h - ydecal) xdecal+hdecal ydecal+vdecal;
_TOPwindow winstr.EDW_win;
_SETfocus winstr.EDW_win;
);
)
else
(
set winstr.EDW_bMinimize = 0;
set winstr.EDW_tMdecal = nil;
// Show all brothers
let sizelist winstr.EDW_father.EDW_lSons -> size in
let 0 -> i in
while i < size do
(
let nth_list winstr.EDW_father.EDW_lSons i -> brostr in
if brostr == winstr then nil else
setEdWindowVisible brostr 1;
set i = i + 1;
);
resizeEdWindow winstr;
_TOPwindow winstr.EDW_win;
_SETfocus winstr.EDW_win;
);
0;;
/*! \brief Callback on window key down
*
* Private
*
* Prototype: fun [ObjWin EdWindow I I] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : key
* \param I : ascii code
*
* \return I : 0
**/
fun cbEdWindowKeyDown(win, winstr, key, scode)=
exec winstr.EDW_cbKeyDown with [winstr key scode];
// if dialog and escape key then close window
if (winstr.EDW_modeFlag & EDWIN_DIALOG) && key == 1 then
dsEdWindow winstr
else if (winstr.EDW_father.EDW_modeFlag & EDWIN_DIALOG) && key == 1 then
dsEdWindow winstr.EDW_father
else nil;
0;;
/*! \brief Callback on window drop file
*
* Private
*
* Prototype: fun [ObjWin EdWindow I I [P r1]] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
* \param [P r1] : files list
*
* \return I : 0
**/
fun cbEdWindowDropFile(win, winstr, x, y, lp)=
exec winstr.EDW_cbDrop with [winstr x y lp];
0;;
/*! \brief Callback on window key up
*
* Private
*
* Prototype: fun [ObjWin EdWindow I] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : key
*
* \return I : 0
**/
fun cbEdWindowKeyUp(win, winstr, key)=
exec winstr.EDW_cbKeyUp with [winstr key];
0;;
/*! @ingroup g2dWindow
* \brief Set a window key down callback
*
* Prototype: fun [EdWindow fun [EdWindow I I] I] I
*
* \param EdWindow : window structure
* \param fun [EdWindow I I] I : callback
* - EdWindow : window structure
* - I : key
* - I : ascii code
*
* \return I : 0
**/
fun setEdwindowCbKeyDown(winstr, cbfun)=
set winstr.EDW_cbKeyDown = cbfun;
0;;
/*! @ingroup g2dWindow
* \brief Set a window key up callback
*
* Prototype: fun [EdWindow fun [EdWindow I] I] I
*
* \param EdWindow : window structure
* \param fun [EdWindow I] I : callback
* - EdWindow : window structure
* - I : key
*
* \return I : 0
**/
fun setEdwindowCbKeyUp(winstr, cbfun)=
set winstr.EDW_cbKeyUp= cbfun;
0;;
/*! @ingroup g2dWindow
* \brief Set a window size callback
*
* Prototype: fun [EdWindow fun [EdWindow I I] I] I
*
* \param EdWindow : window structure
* \param fun [EdWindow I I] I : callback
* - EdWindow : window structure
* - I : width
* - I : height
*
* \return I : 0
**/
fun setEdwindowCbSize(winstr, cbfun)=
set winstr.EDW_cbSize = cbfun;
0;;
/*! @ingroup g2dWindow
* \brief Set a window move callback
*
* Prototype: fun [EdWindow fun [EdWindow I I] I] I
*
* \param EdWindow : window structure
* \param fun [EdWindow I I] I : callback
* - EdWindow : window structure
* - I : X position
* - I : Y position
*
* \return I : 0
**/
fun setEdwindowCbMove(winstr, cbfun)=
set winstr.EDW_cbMove = cbfun;
0;;
/*! @ingroup g2dWindow
* \brief Set a virtual window move callback
*
* Prototype: fun [EdWindow fun [EdWindow I I] I] I
*
* \param EdWindow : window structure
* \param fun [EdWindow I I] I : callback
* - EdWindow : window structure
* - I : X position
* - I : Y position
*
* \return I : 0
**/
fun setEdwindowCbVirtualMove(winstr, cbfun)=
set winstr.EDW_cbVirtualMove = cbfun;
0;;
/*! @ingroup g2dWindow
* \brief Set a virtual window size callback
*
* Prototype: fun [EdWindow fun [EdWindow I I] I] I
*
* \param EdWindow : window structure
* \param fun [EdWindow I I] I : callback
* - EdWindow : window structure
* - I : width
* - I : height
*
* \return I : 0
**/
fun setEdwindowCbVirtualSize(winstr, cbfun)=
set winstr.EDW_cbVirtualSize = cbfun;
0;;
/*! @ingroup g2dWindow
* \brief Set a window destroy callback
*
* Prototype: fun [EdWindow fun [EdWindow] I] I
*
* \param EdWindow : window structure
* \param fun [EdWindow] I : callback
* - EdWindow : window structure
*
* \return I : 0
**/
fun setEdwindowCbDestroy(winstr, cbfun)=
set winstr.EDW_cbDestroy = cbfun;
0;;
/*! @ingroup g2dWindow
* \brief Set a window close callback
*
* Prototype: fun [EdWindow fun [EdWindow] I] I
*
* \param EdWindow : window structure
* \param fun [EdWindow] I : callback
* - EdWindow : window structure
*
* \return I : 0
**/
fun setEdwindowCbClose(winstr, cbfun)=
set winstr.EDW_cbClose = cbfun;
0;;
/*! @ingroup g2dWindow
* \brief Set a window focus callback
*
* Prototype: fun [EdWindow fun [EdWindow] I] I
*
* \param EdWindow : window structure
* \param fun [EdWindow] I : callback
* - EdWindow : window structure
*
* \return I : 0
**/
fun setEdwindowCbFocus(winstr, cbfun)=
set winstr.EDW_cbFocus = cbfun;
0;;
/*! @ingroup g2dWindow
* \brief Set a window drop files callback
*
* Prototype: fun [EdWindow fun [EdWindow I I [P r1]] I] I
*
* \param EdWindow : window structure
* \param fun [EdWindow I I [P r1]] I : callback
* - EdWindow : window structure
* - I : X position
* - I : Y position
* - [P r1] : files list
*
* \return I : 0
**/
fun setEdwindowCbDrop(winstr, cbfun)=
set winstr.EDW_cbDrop = cbfun;
0;;
/*! @ingroup g2dWindow
* \brief Destroy a window
*
* Prototype: fun [EdWindow] I
*
* \param EdWindow : window structure
*
* \return I : 0
**/
fun dsEdWindow(winstr)=
exec winstr.EDW_cbDestroy with [winstr];
dsEdToolBarList winstr.EDW_lToolbar;
set winstr.EDW_lToolbar = nil;
let sizelist winstr.EDW_lSons -> size in
let 0 -> i in
while i < size do
(
let nth_list winstr.EDW_lSons i -> son in
dsEdWindow son;
set i = i + 1;
);
// remove window from father
set winstr.EDW_father.EDW_lSons = G2DremoveFromList winstr.EDW_father.EDW_lSons winstr;
if winstr.EDW_virtualWin == nil then nil else
_DSwindow winstr.EDW_virtualWin;
dsEdWindowCtrlList winstr.EDW_lControl;
if !(winstr.EDW_modeFlag & EDWIN_MODAL) then nil else
_ENwindow winstr.EDW_father.EDW_win 1;
_DSwindow winstr.EDW_win;
0;;
/*! @ingroup g2dWindow
* \brief Destroy a window but not the children
*
* Prototype: fun [EdWindow] I
*
* \param EdWindow : window structure
*
* \return I : 0
**/
fun dsEdWindow2(winstr)=
exec winstr.EDW_cbDestroy with [winstr];
dsEdToolBarList winstr.EDW_lToolbar;
set winstr.EDW_lToolbar = nil;
// remove window from father
set winstr.EDW_father.EDW_lSons = G2DremoveFromList winstr.EDW_father.EDW_lSons winstr;
if winstr.EDW_virtualWin == nil then nil else
_DSwindow winstr.EDW_virtualWin;
dsEdWindowCtrlList winstr.EDW_lControl;
if !(winstr.EDW_modeFlag & EDWIN_MODAL) then nil else
_ENwindow winstr.EDW_father.EDW_win 1;
_DSwindow winstr.EDW_win;
0;;
/*! \brief Callback on window close
*
* Private
*
* Prototype: fun [ObjWin EdWindow] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
*
* \return I : 0
**/
fun cbEdWindowClose(win, winstr)=
if winstr.EDW_cbClose != nil then
exec winstr.EDW_cbClose with [winstr]
else
dsEdWindow winstr;
0;;
/*! \brief Callback on window focus
*
* Private
*
* Prototype: fun [ObjWin EdWindow] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
*
* \return I : 0
**/
fun cbEdWindowFocus(win, winstr)=
if winstr.EDW_cbFocus == nil then nil else
exec winstr.EDW_cbFocus with [winstr];
0;;
/*! \brief Callback on window destroy
*
* Private
*
* Prototype: fun [ObjWin EdWindow] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
*
* \return I : 0
**/
fun cbEdWindowDestroy(win, winstr)=
dsEdWindow winstr;
0;;
/*! \brief Callback on virtual window mouse wheel
*
* Private
*
* Prototype: fun [ObjWin EdWindow I I I I] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
* \param I : wheel delta
* \param I : mouse button, 1 left, 2 right, 16 middle
*
* \return I : 0
**/
fun cbEdVirtualWindowWheel(win, winstr, x, y, delta, btn)=
let delta * 10 -> delta in
if winstr.EDW_virtualWin == nil then nil else
(
let _GETwindowPositionSize winstr.EDW_win -> [_ _ ww wh] in
let _GETwindowPositionSize winstr.EDW_virtualWin -> [vx vy vw vh] in
let if (vy + delta) <= (-(vh - wh)) then (-(vh - wh)) else if (vy + delta) >= 0 then 0 else (vy + delta) -> my in
_MVwindow winstr.EDW_virtualWin vx my;
);
0;;
/*! \brief Callback on virtual window mouse move
*
* Private
*
* Prototype: fun [ObjWin EdWindow I I I I] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
* \param I : mouse button, 1 left, 2 right, 16 middle
*
* \return I : 0
**/
fun cbEdVirtualWindowCursorMove(win, winstr, dx, dy, btn)=
let _GETcursorPos winstr.EDW_win -> [x y] in
let _GETwindowPositionSize winstr.EDW_win -> [_ _ ww wh] in
let _GETwindowPositionSize winstr.EDW_virtualWin -> [vx vy vw vh] in
if btn & 16 then
if x == nil || y == nil || vx == nil || vy == nil || vw == nil || vh == nil then nil else
if winstr.EDW_tLastCursorPos == nil then
(
set winstr.EDW_tLastCursorPos = [(x - vx) (y - vy)];
0;
)
else
let winstr.EDW_tLastCursorPos -> [cx cy] in
let if (x - cx) <= (-(vw - ww)) then (-(vw - ww)) else if (x - cx) >= 0 then 0 else (x - cx) -> mx in
let if (y - cy) <= (-(vh - wh)) then (-(vh - wh)) else if (y - cy) >= 0 then 0 else (y - cy) -> my in
(
_MVwindow winstr.EDW_virtualWin mx my;
0;
)
else nil;
0;;
/*! \brief Callback on win paint
*
* Private
*
* Prototype: fun [ObjWin EdWindow] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
*
* \return I : 0
**/
fun cbEdWindowPaint(win, winstr)=
if (winstr.EDW_iBackColor == nil) then nil else
(
let _GETwindowPositionSize win -> [_ _ w h] in
_PAINTrectangle win 0 0 w h DRAW_INVISIBLE 0 winstr.EDW_iBackColor DRAW_SOLID winstr.EDW_iBackColor;
let _GETwindowExPositionSize winstr.EDW_virtualWin -> [_ _ w h] in
_PAINTrectangle winstr.EDW_virtualWin 0 0 w h DRAW_INVISIBLE 0 winstr.EDW_iBackColor DRAW_SOLID winstr.EDW_iBackColor;
);
0;;
/*! \brief Callback on virtual window mouse click
*
* Private
*
* Prototype: fun [ObjWin EdWindow I I I I] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
* \param I : mouse button, 1 left, 2 right, 16 middle
*
* \return I : 0
**/
fun cbEdVirtualWindowClick(win, winstr, dx, dy, btn)=
_SETfocus win;
0;;
/*! \brief Callback on virtual window mouse unclick
*
* Private
*
* Prototype: fun [ObjWin EdWindow I I I I] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
* \param I : mouse button, 1 left, 2 right, 16 middle
*
* \return I : 0
**/
fun cbEdVirtualWindowUnClick(win, winstr, x, y, btn)=
set winstr.EDW_tLastCursorPos = nil;
0;;
/*! \brief Callback on mouse cursor move
*
* Private
*
* Prototype: fun [ObjWin EdWindow I I I] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
* \param I : mouse button
*
* \return I : 0
**/
fun cbEdWindowCursorMove(win, winstr, x, y, btn)=
cbEdVirtualWindowCursorMove win winstr.EDW_father x y btn;
exec winstr.EDW_cbCursorMove with [winstr x y btn];
0;;
/*! \brief Callback on mouse click
*
* Private
*
* Prototype: fun [ObjWin EdWindow I I I] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
* \param I : mouse button
*
* \return I : 0
**/
fun cbEdWindowClick(win, winstr, x, y, btn)=
cbEdVirtualWindowClick win winstr.EDW_father x y btn;
exec winstr.EDW_cbMouseClick with [winstr x y btn];
set winstr.EDW_tLastClickPos = [x y];
0;;
/*! \brief Callback on mouse unclick
*
* Private
*
* Prototype: fun [ObjWin EdWindow I I I] I
*
* \param ObjWin : window object
* \param EdWindow : window structure
* \param I : X position
* \param I : Y position
* \param I : mouse button
*
* \return I : 0
**/
fun cbEdWindowUnClick(win, winstr, x, y, btn)=
cbEdVirtualWindowUnClick win winstr.EDW_father x y btn;
exec winstr.EDW_cbMouseUnClick with [winstr x y btn];
0;;
/*! @ingroup g2dWindow
* \brief Set a window cursor move callback
*
* Prototype: fun [EdWindow fun [EdWindow I I I] I] I
*
* \param EdWindow : window structure
* \param fun [EdWindow I I I] I : callback
* - EdWindow : window structure
* - I : X position
* - I : Y position
* - I : mouse button
*
* \return I : 0
**/
fun setEdwindowCbCursorMove(winstr, cbfun)=
set winstr.EDW_cbCursorMove = cbfun;
0;;
/*! @ingroup g2dWindow
* \brief Set a window mouse click callback
*
* Prototype: fun [EdWindow fun [EdWindow I I I] I] I
*
* \param EdWindow : window structure
* \param fun [EdWindow I I I] I : callback
* - EdWindow : window structure
* - I : X position
* - I : Y position
* - I : mouse button
*
* \return I : 0
**/
fun setEdwindowCbClick(winstr, cbfun)=
set winstr.EDW_cbMouseClick = cbfun;
0;;
/*! @ingroup g2dWindow
* \brief Set a window mouse unclick callback
*
* Prototype: fun [EdWindow fun [EdWindow I I I] I] I
*
* \param EdWindow : window structure
* \param fun [EdWindow I I I] I : callback
* - EdWindow : window structure
* - I : X position
* - I : Y position
* - I : mouse button
*
* \return I : 0
**/
fun setEdwindowCbUnClick(winstr, cbfun)=
set winstr.EDW_cbMouseClick = cbfun;
0;;
/*! @ingroup g2dWindow
* \brief Set a window title bar icon
*
* Prototype: fun [EdWindow S] EdWindow
*
* \param EdWindow : window structure
* \param S : icon file path in scol partition
*
* \return EdWindow : same window structure
**/
fun setEdWindowIcon(winstr, file)=
let _checkpack file -> picon in
_SETwindowIcon winstr.EDW_win picon;
winstr;;
/*! @ingroup g2dWindow
* \brief Set a window background color
*
* Prototype: fun [EdWindow I] EdWindow
*
* \param EdWindow : window structure
* \param I : the new background color
*
* \return EdWindow : same window structure
**/
fun setEdWindowBackgroundColor(winstr, color)=
let _GETwindowExPositionSize winstr.EDW_win -> [_ _ w h] in
_PAINTrectangle winstr.EDW_win 0 0 w h DRAW_INVISIBLE 0 color DRAW_SOLID color;
let _GETwindowExPositionSize winstr.EDW_virtualWin -> [_ _ w h] in
_PAINTrectangle winstr.EDW_virtualWin 0 0 w h DRAW_INVISIBLE 0 color DRAW_SOLID color;
set winstr.EDW_iBackColor = color;
winstr;;
/*! @ingroup g2dWindow
* \brief Create a new window
*
* Prototype: fun [Chn EdWindow I I I I I I I S] EdWindow
*
* \param Chn : channel
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : window flags
* \param I : resize flags
* \param I : window type flags
* \param S : window title
*
* \return EdWindow : new window structure
**/
fun crEdWindow(chan, fatherstr, x, y, w, h, flags, resize, mode, title)=
let if flags == nil then WN_NORMAL|WN_DRAGDROP|WN_NOSCOL else flags|WN_DRAGDROP|WN_NOSCOL -> flags in
let if mode == nil then
flags
else if mode & EDWIN_DIALOG then
flags|WN_DIALOG|WN_NOSCOL
else if mode & EDWIN_POPUP then
flags|WN_CHILDMENU|WN_CHILDINSIDE|WN_NOSCOL|WN_TOPMOST
else if mode & EDWIN_FRAME then
WN_CHILDINSIDE|WN_NOBORDER
else flags
-> modeflag in
let if fatherstr.EDW_virtualWin == nil then fatherstr.EDW_win else fatherstr.EDW_virtualWin -> fatherwin in
let mkEdWindow [chan nil nil fatherstr.EDW_win nil nil nil 0 nil resize 0 nil nil nil nil nil 0 1 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> winstr in
let if (fatherstr.EDW_modeFlag & EDWIN_GROUP) && !(mode & EDWIN_POPUP) && !(mode & EDWIN_DIALOG) then (let calcEdWindowGroupSonPos fatherstr -> ny in if ny == nil then y else ny) else y -> y in
(
if !(mode & EDWIN_MODAL) then nil else
_ENwindow fatherstr.EDW_win 0;
set winstr.EDW_channel = chan;
set winstr.EDW_father = fatherstr;
set winstr.EDW_modeFlag = if mode == nil then 0 else mode;
set winstr.EDW_win = _CRwindow winstr.EDW_channel fatherwin x y w h modeflag title;
set fatherstr.EDW_lSons = G2Dlcat fatherstr.EDW_lSons winstr::nil;
// update the minimum size of the father virtual window on son add
resizeEdWindowVirtualSize fatherstr;
calcEdCoord winstr;
set winstr.EDW_initCoords = winstr.EDW_coords;
_CBwinSize winstr.EDW_win @cbEdWindowSize winstr;
_CBwinMove winstr.EDW_win @cbEdWindowMove winstr;
_CBwinDestroy winstr.EDW_win @cbEdWindowDestroy winstr;
_CBwinClose winstr.EDW_win @cbEdWindowClose winstr;
_CBwinFocus winstr.EDW_win @cbEdWindowFocus winstr;
_CBwinClick winstr.EDW_win @cbEdWindowClick winstr;
_CBwinUnclick winstr.EDW_win @cbEdWindowUnClick winstr;
_CBcursorMove winstr.EDW_win @cbEdWindowCursorMove winstr;
_CBwinWheel winstr.EDW_virtualWin @cbEdVirtualWindowWheel fatherstr;
_CBwinKeydown winstr.EDW_win @cbEdWindowKeyDown winstr;
_CBwinKeyup winstr.EDW_win @cbEdWindowKeyUp winstr;
_CBwinPaint winstr.EDW_win @cbEdWindowPaint winstr;
_CBwinDropFile winstr.EDW_win @cbEdWindowDropFile winstr;
//_SETfocus winstr.EDW_win;
winstr;
);;
/*! @ingroup g2dWindow
* \brief Create a new scroll window
*
* Prototype: fun [Chn EdWindow I I I I I I I S] EdWindow
*
* \param Chn : channel
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : window flags
* \param I : resize flags
* \param I : window type flags
* \param S : window title
*
* \return EdWindow : new scroll window structure
**/
fun crEdScrollWindow(chan, fatherstr, x, y, w, h, flags, resize, mode, title)=
let if flags == nil then WN_NORMAL|WN_VSCROLL|WN_HSCROLL|WN_DRAGDROP|WN_NOSCOL else flags|WN_DRAGDROP|WN_NOSCOL -> flags in
let if fatherstr.EDW_virtualWin == nil then fatherstr.EDW_win else fatherstr.EDW_virtualWin -> fatherwin in
let mkEdWindow [chan nil nil fatherstr.EDW_win nil nil nil 0 nil resize 0 nil nil nil nil nil 0 1 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> winstr in
let if fatherstr.EDW_modeFlag & EDWIN_GROUP then (let calcEdWindowGroupSonPos fatherstr -> ny in if ny == nil then y else ny) else y -> y in
let _CRscrollWindow winstr.EDW_channel fatherwin x y w h w h flags title -> [win vwin] in
(
set winstr.EDW_channel = chan;
set winstr.EDW_father = fatherstr;
set winstr.EDW_modeFlag = if mode == nil then 0 else mode;
set winstr.EDW_win = win;
set winstr.EDW_virtualWin = vwin;
set fatherstr.EDW_lSons = winstr::fatherstr.EDW_lSons;
// update the minimum size of the father virtual window on son add
resizeEdWindowVirtualSize fatherstr;
calcEdCoord winstr;
set winstr.EDW_initCoords = winstr.EDW_coords;
_CBwinSize winstr.EDW_win @cbEdWindowSize winstr;
_CBwinMove winstr.EDW_win @cbEdWindowMove winstr;
_CBwinDestroy winstr.EDW_win @cbEdWindowDestroy winstr;
_CBwinClose winstr.EDW_win @cbEdWindowClose winstr;
_CBwinFocus winstr.EDW_win @cbEdWindowFocus winstr;
_CBwinKeydown winstr.EDW_win @cbEdWindowKeyDown winstr;
_CBwinKeyup winstr.EDW_win @cbEdWindowKeyUp winstr;
_CBwinPaint winstr.EDW_win @cbEdWindowPaint winstr;
// pass the scroll bug force the update
_CBwinSize winstr.EDW_virtualWin @cbEdVirtualWindowSize winstr;
_CBwinMove winstr.EDW_virtualWin @cbEdVirtualWindowMove winstr;
_CBwinClick winstr.EDW_virtualWin @cbEdVirtualWindowClick winstr;
_CBwinUnclick winstr.EDW_virtualWin @cbEdVirtualWindowUnClick winstr;
_CBcursorMove winstr.EDW_virtualWin @cbEdVirtualWindowCursorMove winstr;
_CBwinWheel winstr.EDW_virtualWin @cbEdVirtualWindowWheel winstr;
_CBwinPaint winstr.EDW_virtualWin @cbEdWindowPaint winstr;
_CBwinKeydown winstr.EDW_virtualWin @cbEdWindowKeyDown winstr;
_CBwinKeyup winstr.EDW_virtualWin @cbEdWindowKeyUp winstr;
//_SETfocus winstr.EDW_virtualWin;
winstr;
);;
/*! @ingroup g2dWindow
* \brief Create a new group window
*
* Prototype: fun [Chn EdWindow I I I I I I S] EdWindow
*
* \param Chn : channel
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : window flags
* \param I : resize flags
* \param S : window title
*
* \return EdWindow : new group window structure
**/
fun crEdGroupWindow(chan, fatherstr, x, y, w, h, flags, resize, title)=
crEdScrollWindow chan fatherstr x y w h flags resize EDWIN_GROUP title;;
/*! @ingroup g2dWindow
* \brief Create a new dialog window
*
* Prototype: fun [Chn EdWindow I I I I I I S] EdWindow
*
* \param Chn : channel
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : window flags
* \param I : resize flags
* \param S : window title
*
* \return EdWindow : new dialog window structure
**/
fun crEdDialogWindow(chan, fatherstr, x, y, w, h, flags, resize, title)=
crEdWindow chan fatherstr x y w h flags resize EDWIN_DIALOG title;;
/*! @ingroup g2dWindow
* \brief Create a new modal dialog window
*
* Prototype: fun [Chn EdWindow I I I I I I S] EdWindow
*
* \param Chn : channel
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : window flags
* \param I : resize flags
* \param S : window title
*
* \return EdWindow : new modal dialog window structure
**/
fun crEdModalDialogWindow(chan, fatherstr, x, y, w, h, flags, resize, title)=
crEdWindow chan fatherstr x y w h flags resize EDWIN_DIALOG|EDWIN_MODAL title;;
/*! @ingroup g2dWindow
* \brief Create a new popup window
*
* Prototype: fun [Chn EdWindow I I I I I I S] EdWindow
*
* \param Chn : channel
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : window flags
* \param I : resize flags
* \param S : window title
*
* \return EdWindow : new popup window structure
**/
fun crEdPopupWindow(chan, fatherstr, x, y, w, h, flags, resize, title)=
crEdWindow chan fatherstr x y w h flags resize EDWIN_POPUP title;;
/*! \brief Callback on a frame window minimize/maximize click
*
* Private
*
* Prototype: fun [EdTabBar CompCheck I I I EdWindow] I
*
* \param EdTabBar : toolbar
* \param CompCheck : minimize/maximize control check
* \param I : mouse button
* \param I : keyboard mask
* \param I : minimize/maximize control check state
* \param EdWindow : window structure
*
* \return I : 0
**/
fun cbEdFrameMinMax(tbstr, check, btn, mask, state, winstr)=
let _GETwindowPositionSize winstr.EDW_win -> [cx cy cw ch] in
let if winstr.EDW_father.EDW_virtualWin == nil then winstr.EDW_father.EDW_win else winstr.EDW_father.EDW_virtualWin -> fatherw in
let _GETwindowPositionSize fatherw -> [px py pw ph] in
if winstr.EDW_bMinimize != 1 then
(
set winstr.EDW_bMinimize = 1;
let hd winstr.EDW_lToolbar -> tbstr in
let tbstr.ETB_size -> [tw th] in
(
_SIZEwindow winstr.EDW_win cw th cx cy;
_SIZEwindow fatherw pw ((ph-ch) + th) px py;
);
_TOPwindow winstr.EDW_win;
_SETfocus winstr.EDW_win;
)
else
(
set winstr.EDW_bMinimize = 0;
resizeEdWindow winstr;
let hd winstr.EDW_lToolbar -> tbstr in
let tbstr.ETB_size -> [tw th] in
let _GETwindowPositionSize winstr.EDW_win -> [cx cy cw ch] in
_SIZEwindow fatherw pw ph+ch-th px py;
_TOPwindow winstr.EDW_win;
_SETfocus winstr.EDW_win;
);
0;;
/*! \brief minimize or restore a frame window
*
* Prototype: fun [EdWindow state] I
*
* \param EdWindow : frame window
* \param I : state
*
* \return I : 0
**/
fun setEdFrameState(winstr, state)=
let _GETwindowPositionSize winstr.EDW_win -> [cx cy cw ch] in
let if winstr.EDW_father.EDW_virtualWin == nil then winstr.EDW_father.EDW_win else winstr.EDW_father.EDW_virtualWin -> fatherw in
let _GETwindowPositionSize fatherw -> [px py pw ph] in
if winstr.EDW_bMinimize == state then nil else
(
set winstr.EDW_bMinimize = state;
if (state == 1) then
(
let hd winstr.EDW_lToolbar -> tbstr in
let tbstr.ETB_size -> [tw th] in
(
_SIZEwindow winstr.EDW_win cw th cx cy;
_SIZEwindow fatherw pw ((ph-ch) + th) px py;
);
_TOPwindow winstr.EDW_win;
_SETfocus winstr.EDW_win;
)
else
(
set winstr.EDW_bMinimize = 0;
resizeEdWindow winstr;
let hd winstr.EDW_lToolbar -> tbstr in
let tbstr.ETB_size -> [tw th] in
let _GETwindowPositionSize winstr.EDW_win -> [cx cy cw ch] in
_SIZEwindow fatherw pw ph+ch-th px py;
_TOPwindow winstr.EDW_win;
_SETfocus winstr.EDW_win;
);
);
winstr;;
/*! \brief Callback on a frame window toolbar double click
*
* Private
*
* Prototype: fun [ObjContainer [EdWindow CompCheck] I I I ] I
*
* \param ObjContainer : toolbar background container
* \param [EdWindow CompCheck] : window structure and minimize/maximize control check
* \param I : X click position
* \param I : Y click position
* \param I : mouse button
* \param I : keyboard mask
*
* \return I : 0
**/
fun cbEdDbClickFrameWindowTitle(cont, param, x, y, btn, mask)=
let param -> [winstr minmaxchk] in
if btn != 1 then nil else
(
let _GETwindowPositionSize winstr.EDW_win -> [cx cy cw ch] in
let if winstr.EDW_father.EDW_virtualWin == nil then winstr.EDW_father.EDW_win else winstr.EDW_father.EDW_virtualWin -> fatherw in
let _GETwindowPositionSize fatherw -> [px py pw ph] in
if winstr.EDW_bMinimize != 1 then
(
set winstr.EDW_bMinimize = 1;
_SETcompCheckState minmaxchk CHK_CHECKED;
let hd winstr.EDW_lToolbar -> tbstr in
let tbstr.ETB_size -> [tw th] in
(
_SIZEwindow winstr.EDW_win cw th cx cy;
_SIZEwindow fatherw pw ((ph-ch) + th) px py;
);
_TOPwindow winstr.EDW_win;
_SETfocus winstr.EDW_win;
)
else
(
set winstr.EDW_bMinimize = 0;
_SETcompCheckState minmaxchk CHK_UNCHECKED;
resizeEdWindow winstr;
let hd winstr.EDW_lToolbar -> tbstr in
let tbstr.ETB_size -> [tw th] in
let _GETwindowPositionSize winstr.EDW_win -> [cx cy cw ch] in
_SIZEwindow fatherw pw ph+ch-th px py;
_TOPwindow winstr.EDW_win;
_SETfocus winstr.EDW_win;
);
_PAINTcontainer cont;
);
0;;
/*! @ingroup g2dWindow
* \brief Create a frame window
*
* Prototype: fun [Chn EdWindow I I I I I EdTheme S S] EdWindow
*
* \param Chn : channel
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : resize flags
* \param EdTheme : theme structure to use
* \param S : window title
* \param S : minimize/maximize tooltip text
*
* \return EdWindow : new frame window structure
**/
fun crEdFrameWindow(chan, fatherstr, x, y, w, h, resize, themestr, title, minimizebuble)=
let if themestr == nil then (if EdDefaultTheme == nil then (set EdDefaultTheme = makeEdThemeResources chan) else EdDefaultTheme) else themestr -> themestr in
let crEdWindow chan fatherstr x y w h nil resize EDWIN_FRAME title -> winstr in
let crEdWindowToolBar winstr 0 0 w themestr.EDT_iFrameBarHeight 5 0 themestr.EDT_iFrameBarColor ETB_HORIZONTAL -> tbstr in
let crEdToolBarText tbstr title themestr.EDT_sFrameFontName themestr.EDT_iFrameFontSize FF_PIXEL|FF_WEIGHT themestr.EDT_iFrameFontColor nil ETB_ALIGN_LEFT -> txttitle in
(
if (minimizebuble == nil) then nil else
let crEdToolBarCheck tbstr themestr.EDT_abmpFrameFold ETB_ALIGN_RIGHT minimizebuble mkfun6 @cbEdFrameMinMax winstr -> minmaxchk in
_CBcontainerDblClick tbstr.ETB_cont @cbEdDbClickFrameWindowTitle [winstr minmaxchk];
paintEdToolBar tbstr;
winstr;
);;
fun crEdFrameWindowEx(chan, fatherstr, x, y, w, h, resize, themestr, title, minimizebuble, minimize)=
let if themestr == nil then (if EdDefaultTheme == nil then (set EdDefaultTheme = makeEdThemeResources chan) else EdDefaultTheme) else themestr -> themestr in
let crEdWindow chan fatherstr x y w h WN_HIDDEN resize EDWIN_FRAME title -> winstr in
let crEdWindowToolBar winstr 0 0 w themestr.EDT_iFrameBarHeight 5 0 themestr.EDT_iFrameBarColor ETB_HORIZONTAL -> tbstr in
let crEdToolBarText tbstr title themestr.EDT_sFrameFontName themestr.EDT_iFrameFontSize FF_PIXEL|FF_WEIGHT themestr.EDT_iFrameFontColor nil ETB_ALIGN_LEFT -> txttitle in
(
if (minimizebuble == nil) then nil else
let crEdToolBarCheck tbstr themestr.EDT_abmpFrameFold ETB_ALIGN_RIGHT minimizebuble mkfun6 @cbEdFrameMinMax winstr -> minmaxchk in
(
setEdToolBarCheckState tbstr minmaxchk minimize;
_CBcontainerDblClick tbstr.ETB_cont @cbEdDbClickFrameWindowTitle [winstr minmaxchk];
);
if (!minimize) then nil else
let _GETwindowPositionSize winstr.EDW_win -> [cx cy cw ch] in
(
set winstr.EDW_bMinimize = minimize;
let hd winstr.EDW_lToolbar -> tbstr in
let tbstr.ETB_size -> [tw th] in
_SIZEwindow winstr.EDW_win cw th cx cy;
);
paintEdToolBar tbstr;
setEdWindowVisible winstr 1;
winstr;
);;
/*! @ingroup g2dWindow
* \brief Create a new main window
*
* Automaticaly included in the activeX window if available
*
* Prototype: fun [Chn EdWindow I I I I I S] EdWindow
*
* \param Chn : channel
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : window flags
* \param S : window title
*
* \return EdWindow : new popup window structure
**/
fun crEdMainWindow(chan, fatherwin, x, y, w, h, flags, title)=
let if flags == nil then WN_NORMAL|WN_DRAGDROP|WN_NOSCOL else flags|WN_DRAGDROP|WN_NOSCOL -> flags in
let mkEdWindow [chan nil nil fatherwin nil nil nil 0 nil 0 0 nil nil nil nil nil 0 1 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> winstr in
(
set winstr.EDW_channel = chan;
if winAX ==nil then
(
set winstr.EDW_win = _CRwindow winstr.EDW_channel fatherwin x y w h flags title;
)
else
let _GETwindowPositionSize winAX -> [_ _ w h] in
(
set winstr.EDW_bIsAx = 1;
set winstr.EDW_win = _CRwindow winstr.EDW_channel winAX 0 0 w h WN_CHILD|WN_NOBORDER|WN_DRAGDROP "WebDetect";
set winstr.EDW_resizeFlag = EDWIN_RESIZE_MW|EDWIN_RESIZE_MH;
set winstr.EDW_fatherWin = winAX;
set winstr.EDW_father = mkEdWindow [chan nil nil nil winstr::nil winAX nil 0 nil 0 0 nil nil nil nil nil 0 1 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil];
_CBwinSize winAX @cbEdWindowSize winstr.EDW_father;
_CBwinDestroy winAX @cbEdWindowDestroy winstr.EDW_father;
);
calcEdCoord winstr;
set winstr.EDW_initCoords = winstr.EDW_coords;
_CBwinSize winstr.EDW_win @cbEdWindowSize winstr;
_CBwinDestroy winstr.EDW_win @cbEdWindowDestroy winstr;
_CBwinClose winstr.EDW_win @cbEdWindowClose winstr;
_CBwinFocus winstr.EDW_win @cbEdWindowFocus winstr;
_CBwinKeydown winstr.EDW_win @cbEdWindowKeyDown winstr;
_CBwinKeyup winstr.EDW_win @cbEdWindowKeyUp winstr;
_CBwinPaint winstr.EDW_win @cbEdWindowPaint winstr;
_CBwinDropFile winstr.EDW_win @cbEdWindowDropFile winstr;
_CBwinClick winstr.EDW_win @cbEdWindowClick winstr;
_CBwinUnclick winstr.EDW_win @cbEdWindowUnClick winstr;
_CBcursorMove winstr.EDW_win @cbEdWindowCursorMove winstr;
winstr;
);;
/*! @ingroup g2dWindow
* \brief Return if a window is embeded in an activeX
*
* Prototype: fun [EdWindow] I
*
* \param Chn : channel
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : window flags
* \param S : window title
*
* \return I : 0 if not embeded, 1 if embeded
**/
fun getEdWindowIsAX(winstr)= winstr.EDW_bIsAx;;
/* ********************************************************************************************* /
Controls
/ ********************************************************************************************* */
fun getEdCtrlLabel(ctrlstr)= ctrlstr.EDC_label;;
fun getEdCtrlColorLabel(ctrlstr)= ctrlstr.EDC_colorLabel;;
fun getEdCtrlText(ctrlstr)= ctrlstr.EDC_text;;
fun getEdCtrlEditText(ctrlstr)= ctrlstr.EDC_editText;;
fun getEdCtrlTextLine(ctrlstr)= ctrlstr.EDC_editLine;;
fun getEdCtrlButton(ctrlstr)= let ctrlstr.EDC_button -> [btn _] in btn;;
fun getEdCtrlCheck(ctrlstr)= ctrlstr.EDC_check;;
fun getEdCtrlRadio(ctrlstr)= ctrlstr.EDC_check;;
fun getEdCtrlList(ctrlstr)= let ctrlstr.EDC_list -> [list _] in list;;
fun getEdCtrlTree(ctrlstr)= let ctrlstr.EDC_tree -> [tree _ _ _ _] in tree;;
fun getEdCtrlSelect(ctrlstr)= ctrlstr.EDC_select;;
fun getEdCtrlFloat(ctrlstr)= let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown cval minval maxval incre nb0 _ _ _ _ _ _ _] in txt;;
fun getEdCtrlView3d(ctrlstr)= ctrlstr.EDC_view3d;;
fun getEdCtrlSlider(ctrlstr)= ctrlstr.EDC_slider;;
fun getEdCtrlTimeLineEditor(ctrlstr)= ctrlstr.EDC_timeLineEditor;;
fun getEdCtrlTooltip(ctrlstr)= ctrlstr.EDC_toolTip;;
/* ********************************************************************************************* /
Control Tooltip
/ ********************************************************************************************* */
/*! @ingroup g2dTooltip
* \brief Set a tooltip control text value
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : Tooltip control structure
* \param S : text value
*
* \return I : 0
**/
fun setEdCtrlTooltipValue(ctrlstr, value)=
if ((value == nil) || (!strcmp "" value)) then
(
let ctrlstr.EDC_toolTip -> [tpcont tptext mode] in
_SHOWcontainer tpcont CONTAINER_HIDDEN;
0;
)
else
(
let ctrlstr.EDC_toolTip -> [tpcont tptext mode] in
let _GETcontainerPositionSize tpcont -> [tpx tpy tpw tph] in
let if (mode) then G2DgetStringSize ctrlstr.EDC_theme.EDT_fontToolTip value else [tpw tph] -> [w h] in
let _GETWorkingAreaSize -> [sw sh] in
let sh - 40 -> sh in
let if (mode) then _GETscreenPos else [tpx tpy] -> [sx sy] in
let [16 16] -> [xdecal ydecal] in
let if (sx + w + 4 + xdecal) > sw then (sw - (w + 4) - xdecal) else sx + xdecal -> x in
let if (sy + h + 4 + ydecal) > sh then (sh - (h + 4) - ydecal) else sy + ydecal -> y in
(
addLogMessage strcatn "Tooltip: "::(itoa x)::" "::(itoa y)::" - "::(itoa w)::" "::(itoa h)::nil;
_SIZEcontainer tpcont x y w h;
_SETcompText tptext value ctrlstr.EDC_theme.EDT_fontToolTip [0 nil nil nil] CT_NOCHANGE;
_PAINTobjNode _CONVERTcompTextToObjNode tptext;
_PAINTcontainer tpcont;
_SHOWcontainer tpcont CONTAINER_UNHIDDEN;
);
0;
);
0;;
/*! @ingroup g2dTooltip
* \brief Set a tooltip control visibility
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : Tooltip control structure
*
* \return I : 0
**/
fun setEdCtrlTooltipVisible(ctrlstr, state)=
if (ctrlstr.EDC_toolTip == nil) then nil else
let ctrlstr.EDC_toolTip -> [tpcont tptext mode] in
_SHOWcontainer tpcont (if state then CONTAINER_UNHIDDEN else CONTAINER_HIDDEN);
0;;
/*! @ingroup g2dTooltip
* \brief Create a tooltip control at mouse position
*
* Prototype: fun [EdWindow S EdTheme] EdControl
*
* \param EdWindow : mother window structure
* \param S : text value
* \param EdTheme : theme structure or nil for default
*
* \return EdControl : new Tooltip control
**/
fun crEdCtrlTooltip(winstr, value, themestr)=
let if themestr == nil then (if EdDefaultTheme == nil then (set EdDefaultTheme = makeEdThemeResources winstr.EDW_channel) else EdDefaultTheme) else themestr -> themestr in
let mkEdControl [winstr.EDW_channel winstr nil themestr nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
(
let G2DgetStringSize ctrlstr.EDC_theme.EDT_fontToolTip value -> [w h] in
let _GETWorkingAreaSize -> [sw sh] in
let sh - 40 -> sh in
let _GETscreenPos -> [sx sy] in
let [16 16] -> [xdecal ydecal] in
let if (sx + w + 4 + xdecal) > sw then (sw - (w + 4) - xdecal) else sx + xdecal -> x in
let if (sy + h + 4 + ydecal) > sh then (sh - (h + 4) - ydecal) else sy + ydecal -> y in
let (_CRcontainerFromObjWin ctrlstr.EDC_channel father x y w+4 h+4 CO_NOCAPTION 0xffffff nil) -> tpcont in
let _CRcompText ctrlstr.EDC_channel tpcont nil [2 2] CT_LABEL|CT_LEFT|OBJ_VISIBLE nil w h value ctrlstr.EDC_theme.EDT_fontToolTip [0 nil nil nil] nil nil nil -> tptext in
(
set ctrlstr.EDC_toolTip = [tpcont tptext 1];
_PAINTcontainer tpcont;
if ((value == nil) && (!strcmp "" value)) then
_SHOWcontainer tpcont CONTAINER_HIDDEN
else
_SHOWcontainer tpcont CONTAINER_UNHIDDEN;
);
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
ctrlstr;
);;
/*! @ingroup g2dTooltip
* \brief Create a tooltip control
*
* Prototype: fun [EdWindow I I I I S EdTheme] EdControl
*
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param S : text value
* \param EdTheme : theme structure or nil for default
*
* \return EdControl : new Tooltip control
**/
fun crEdCtrlTooltipFixed(winstr, x, y, w, h, value, themestr)=
let if themestr == nil then (if EdDefaultTheme == nil then (set EdDefaultTheme = makeEdThemeResources winstr.EDW_channel) else EdDefaultTheme) else themestr -> themestr in
let mkEdControl [winstr.EDW_channel winstr nil themestr nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
(
let _GETWorkingAreaSize -> [sw sh] in
let sh - 40 -> sh in
let [x y ] -> [sx sy] in
let [16 16] -> [xdecal ydecal] in
let if (sx + w + 4 + xdecal) > sw then (sw - (w + 4) - xdecal) else sx + xdecal -> x in
let if (sy + h + 4 + ydecal) > sh then (sh - (h + 4) - ydecal) else sy + ydecal -> y in
let (_CRcontainerFromObjWin ctrlstr.EDC_channel father x y w+4 h+4 CO_NOCAPTION 0xffffff nil) -> tpcont in
let _CRcompText ctrlstr.EDC_channel tpcont nil [2 2] CT_LABEL|CT_LEFT|OBJ_VISIBLE nil w h value ctrlstr.EDC_theme.EDT_fontToolTip [0 nil nil nil] nil nil nil -> tptext in
(
set ctrlstr.EDC_toolTip = [tpcont tptext 0];
_PAINTcontainer tpcont;
if ((value != nil) && (strcmp "" value)) then nil else
_SHOWcontainer tpcont CONTAINER_HIDDEN;
);
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
ctrlstr;
);;
/*! @ingroup g2dTooltip
* \brief Destroy a tooltip control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : Tooltip control structure
*
* \return I : 0
**/
fun dsEdCtrlTooltip(ctrlstr)=
if ctrlstr.EDC_toolTip == nil then nil else
let ctrlstr.EDC_toolTip -> [tpcont tptext mode] in
(
_DScompText tptext;
_DScontainer tpcont;
set ctrlstr.EDC_toolTip = nil;
);
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control text label
/ ********************************************************************************************* */
/*! @ingroup g2dLabel
* \brief Get a label control value
*
* Prototype: fun [EdControl] S
*
* \param EdControl : label control structure
*
* \return S : the label control text value
**/
fun getEdCtrlLabelValue(ctrlstr)= _GETtext ctrlstr.EDC_label;;
/*! @ingroup g2dLabel
* \brief Set a label control text value
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : label control structure
* \param S : text value
*
* \return I : 0
**/
fun setEdCtrlLabelValue(ctrlstr, val)=
_SETtext ctrlstr.EDC_label val;
0;;
/*! @ingroup g2dLabel
* \brief Enable or disable a label control
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : label control structure
* \param I : state, 0 to disable, 1 to enable
*
* \return I : 0
**/
fun setEdCtrlLabelEnable(ctrlstr, state)=
_ENtext ctrlstr.EDC_label state;
0;;
/*! @ingroup g2dLabel
* \brief Create a label control
*
* Prototype: fun [EdWindow I I I I S I] EdControl
*
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param S : text value
* \param I : resize flags
*
* \return EdControl : new label control
**/
fun crEdCtrlLabel(winstr, x, y, w, h, value, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRtext ctrlstr.EDC_channel father x y w h ET_AHSCROLL|ET_ALIGN_LEFT value -> txt in
(
set ctrlstr.EDC_label = txt;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2dLabel
* \brief Create a label control
*
* Prototype: fun [EdWindow I I I I S I I] EdControl
*
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param S : text value
* \param I : text flags
* \param I : resize flags
*
* \return EdControl : new label control
**/
fun crEdCtrlLabelEx(winstr, x, y, w, h, value, flags, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRtext ctrlstr.EDC_channel father x y w h flags value -> txt in
(
set ctrlstr.EDC_label = txt;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2dLabel
* \brief Destroy a label control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : label control structure
*
* \return I : 0
**/
fun dsEdCtrlLabel(ctrlstr)=
_DStext ctrlstr.EDC_label;
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control text color label
/ ********************************************************************************************* */
/*! @ingroup g2dLabel
* \brief Get a color label control value
*
* Prototype: fun [EdControl] S
*
* \param EdControl : label control structure
*
* \return S : the label control text value
**/
fun getEdCtrlColorLabelValue(ctrlstr)=
let ctrlstr.EDC_colorLabel -> [cont cmptext] in
_GETcompText cmptext;;
/*! @ingroup g2dLabel
* \brief Set a color label control text value
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : label control structure
* \param S : text value
*
* \return I : 0
**/
fun setEdCtrlColorLabelValue(ctrlstr, val)=
let ctrlstr.EDC_colorLabel -> [cont cmptext] in
(
_SETcompText cmptext val ctrlstr.EDC_theme.EDT_fontLabel [ctrlstr.EDC_theme.EDT_iLabelColor 0 0 0] CT_NOCHANGE;
_PAINTobjNode _CONVERTcompTextToObjNode cmptext;
);
0;;
/*! @ingroup g2dLabel
* \brief Enable or disable a color label control
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : label control structure
* \param I : state, 0 to disable, 1 to enable
*
* \return I : 0
**/
fun setEdCtrlColorLabelEnable(ctrlstr, state)=
let ctrlstr.EDC_colorLabel -> [cont cmptext] in
(
_CHANGEobjNodeFlags _CONVERTcompTextToObjNode cmptext (if state then OBJ_ENABLE else OBJ_DISABLE) 1;
_PAINTobjNode _CONVERTcompTextToObjNode cmptext;
);
0;;
/*! @ingroup g2dLabel
* \brief Create a color label control
*
* Prototype: fun [EdWindow I I I I S I I EdTheme] EdControl
*
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param S : text value
* \param I : resize flags
* \param I : background color
* \param EdTheme : theme structure to use
*
* \return EdControl : new label control
**/
fun crEdCtrlColorLabel(winstr, x, y, w, h, value, resize, bgcolor, themestr)=
let if themestr == nil then (if EdDefaultTheme == nil then (set EdDefaultTheme = makeEdThemeResources winstr.EDW_channel) else EdDefaultTheme) else themestr -> themestr in
let mkEdControl [winstr.EDW_channel winstr resize themestr nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRcontainerFromObjWin ctrlstr.EDC_channel father x y w h CO_CHILDINSIDE|CO_NOBORDER bgcolor "" -> cont in
let _CRcompText ctrlstr.EDC_channel cont nil [0 0] CT_LABEL|CT_LEFT|OBJ_VISIBLE|OBJ_MH_FLEX|OBJ_MW_FLEX nil w h value ctrlstr.EDC_theme.EDT_fontLabel [ctrlstr.EDC_theme.EDT_iLabelColor nil nil nil] nil nil nil -> cmptext in
(
set ctrlstr.EDC_colorLabel = [cont cmptext];
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
_PAINTcontainer cont;
ctrlstr;
);;
fun crEdCtrlColorLabelExt(winstr, x, y, w, h, margin, value, align, resize, bgcolor, themestr)=
let if align == nil then CT_LEFT else align -> align in
let margin -> [mx my] in
let if themestr == nil then (if EdDefaultTheme == nil then (set EdDefaultTheme = makeEdThemeResources winstr.EDW_channel) else EdDefaultTheme) else themestr -> themestr in
let mkEdControl [winstr.EDW_channel winstr resize themestr nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRcontainerFromObjWin ctrlstr.EDC_channel father x y w h CO_CHILDINSIDE|CO_NOBORDER|CO_HIDE bgcolor "" -> cont in
let _CRcompText ctrlstr.EDC_channel cont nil [mx my] align|CT_LABEL|OBJ_VISIBLE|OBJ_MH_FLEX|OBJ_MW_FLEX nil (w - (mx * 2)) (h - (my * 2)) value ctrlstr.EDC_theme.EDT_fontLabel [ctrlstr.EDC_theme.EDT_iLabelColor nil nil nil] nil nil nil -> cmptext in
(
set ctrlstr.EDC_colorLabel = [cont cmptext];
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
_PAINTcontainer cont;
ctrlstr;
);;
/*! @ingroup g2dLabel
* \brief Destroy a color label control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : label control structure
*
* \return I : 0
**/
fun dsEdCtrlColorLabel(ctrlstr)=
let ctrlstr.EDC_colorLabel -> [cont cmptext] in
(
_DScompText cmptext;
_DScontainer cont;
);
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control Text
/ ********************************************************************************************* */
/*! @ingroup g2dText
* \brief Get a text control value
*
* Prototype: fun [EdControl] S
*
* \param EdControl : text control structure
*
* \return S : the text control value
**/
fun getEdCtrlTextValue(ctrlstr)= _GETtext ctrlstr.EDC_text;;
/*! @ingroup g2dText
* \brief Get the number of lines in a text control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : text control structure
*
* \return I : the number of lines in the text control
**/
fun getEdCtrlTextLineCount(ctrlstr)= _GETlineCount ctrlstr.EDC_text;;
/*! @ingroup g2dText
* \brief Scroll a text control to the specified column and line position
*
* Prototype: fun [EdControl I I] I
*
* \param EdControl : text control structure
* \param I : the column position
* \param I : the line position
*
* \return I : 0
**/
fun scrollEdCtrlText(ctrlstr, col, line)=
_SCROLLtext ctrlstr.EDC_text col line;
0;;
/*! @ingroup g2dText
* \brief Remove the line in a text control
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : text control structure
* \param I : the line position to remove
*
* \return I : 0
**/
fun removeEdCtrlTextLine(ctrlstr, line)=
_DELline ctrlstr.EDC_text line;
0;;
/*! @ingroup g2dText
* \brief Set a text control value
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : text control structure
* \param S : text value
*
* \return I : 0
**/
fun setEdCtrlTextValue(ctrlstr, val)=
_SETtext ctrlstr.EDC_text val;
0;;
/*! @ingroup g2dText
* \brief Add a line to a text control
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : text control structure
* \param S : text line to add
*
* \return I : 0
**/
fun addEdCtrlTextValue(ctrlstr, val)=
_ADDtext ctrlstr.EDC_text strcat val "\n";
0;;
/*! @ingroup g2dText
* \brief Enable or disable a text control
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : text control structure
* \param I : state, 0 to disable, 1 to enable
*
* \return I : 0
**/
fun setEdCtrlTextEnable(ctrlstr, state)=
_ENtext ctrlstr.EDC_text state;
0;;
/*! \brief Callback on text control value change
*
* Private
*
* Prototype: fun [ObjText [EdControl fun [EdControl S] I]] I
*
* \param ObjText : text object
* \param [EdControl fun [EdControl S] I] : text control structure and user callback
*
* \return I : 0
**/
fun cbEdCtrlTextChange(txt, p)=
let p -> [ctrlstr cbfun] in
let _GETtext ctrlstr.EDC_text -> val in
exec cbfun with [ctrlstr val];
0;;
/*! @ingroup g2dText
* \brief Set the callback on text control change
*
* Prototype: fun [EdControl fun [EdControl S] I] I
*
* \param EdControl : text control structure
* \param fun [EdControl S] I : callback
* - EdControl : text control structure
* - S : new text value
*
* \return I : 0
**/
fun setEdCtrlTextCbChange(ctrlstr, cbfun)=
_CBtext ctrlstr.EDC_text @cbEdCtrlTextChange [ctrlstr cbfun];
0;;
/*! @ingroup g2dText
* \brief Create a text control
*
* Prototype: fun [EdWindow I I I I S I I] EdControl
*
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param S : text value
* \param I : ObjText flags, nil for default
* \param I : resize flags
*
* \return EdControl : new text control
**/
fun crEdCtrlText(winstr, x, y, w, h, value, flags, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRtext ctrlstr.EDC_channel father x y w h (if flags == nil then ET_BORDER|ET_AHSCROLL|ET_AVSCROLL|ET_VSCROLL|ET_TABFOCUS else flags) value -> txt in
(
set ctrlstr.EDC_text = txt;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2dText
* \brief Destroy a text control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : text control structure
*
* \return I : 0
**/
fun dsEdCtrlText(ctrlstr)=
_DStext ctrlstr.EDC_text;
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control Edit Text
/ ********************************************************************************************* */
/*! @ingroup g2dEditText
* \brief Get a edit text control value
*
* Prototype: fun [EdControl] S
*
* \param EdControl : edit text control structure
*
* \return S : the edit text control value
**/
fun getEdCtrlEditTextValue(ctrlstr)= _GETtext ctrlstr.EDC_editText;;
/*! @ingroup g2dEditText
* \brief Set a edit text control value
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : edit text control structure
* \param S : text value
*
* \return I : 0
**/
fun setEdCtrlEditTextValue(ctrlstr, val)=
_SETtext ctrlstr.EDC_editText val;
0;;
/*! @ingroup g2dEditText
* \brief Enable or disable a edit text control
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : edit text control structure
* \param I : state, 0 to disable, 1 to enable
*
* \return I : 0
**/
fun setEdCtrlEditTextEnable(ctrlstr, state)=
_ENtext ctrlstr.EDC_editText state;
0;;
/*! \brief Callback on edit text control value change
*
* Private
*
* Prototype: fun [ObjText [EdControl fun [EdControl S] I]] I
*
* \param ObjText : text object
* \param [EdControl fun [EdControl S] I] : edit text control structure and user callback
*
* \return I : 0
**/
fun cbEdCtrlEditTextChange(txt, p)=
let p -> [ctrlstr cbfun] in
let _GETtext ctrlstr.EDC_editText -> val in
exec cbfun with [ctrlstr val];
0;;
/*! @ingroup g2dEditText
* \brief Set the callback on edit text control change
*
* Prototype: fun [EdControl fun [EdControl S] I] I
*
* \param EdControl : edit text control structure
* \param fun [EdControl S] I : callback
* - EdControl : edit text control structure
* - S : new text value
*
* \return I : 0
**/
fun setEdCtrlEditTextCbChange(ctrlstr, cbfun)=
_CBtext ctrlstr.EDC_editText @cbEdCtrlEditTextChange [ctrlstr cbfun];
0;;
/*! @ingroup g2dEditText
* \brief Create a edit text control
*
* Prototype: fun [EdWindow I I I I S I I] EdControl
*
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param S : text value
* \param I : ObjText flags, nil for default
* \param I : resize flags
*
* \return EdControl : new edit text control
**/
fun crEdCtrlEditText(winstr, x, y, w, h, value, flags, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CReditText ctrlstr.EDC_channel father x y w h (if flags == nil then ET_BORDER|ET_AHSCROLL|ET_AVSCROLL|ET_HSCROLL|ET_VSCROLL|ET_TABFOCUS else flags) value -> txt in
(
set ctrlstr.EDC_editText = txt;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2dEditText
* \brief Destroy a edit text control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : edit text control structure
*
* \return I : 0
**/
fun dsEdCtrlEditText(ctrlstr)=
_DStext ctrlstr.EDC_editText;
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control Text edit line
/ ********************************************************************************************* */
/*! @ingroup g2dLineText
* \brief Get a text line control value
*
* Prototype: fun [EdControl] S
*
* \param EdControl : text line control structure
*
* \return S : the text line control value
**/
fun getEdCtrlTextLineValue(ctrlstr)= _GETtext ctrlstr.EDC_editLine;;
/*! @ingroup g2dLineText
* \brief Set a text line control value
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : text line control structure
* \param S : text value
*
* \return I : 0
**/
fun setEdCtrlTextLineValue(ctrlstr, val)=
_SETtext ctrlstr.EDC_editLine val;
0;;
/*! @ingroup g2dLineText
* \brief Enable or disable a text line control
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : text line control structure
* \param I : state, 0 to disable, 1 to enable
*
* \return I : 0
**/
fun setEdCtrlTextLineEnable(ctrlstr, state)=
_ENtext ctrlstr.EDC_editLine state;
0;;
/*! \brief Callback on text line control value change
*
* Private
*
* Prototype: fun [ObjText [EdControl fun [EdControl S] I]] I
*
* \param ObjText : text object
* \param [EdControl fun [EdControl S] I] : text line control structure and user callback
*
* \return I : 0
**/
fun cbEdCtrlTextLineChange(txt, p)=
let p -> [ctrlstr cbfun] in
let _GETtext ctrlstr.EDC_editLine -> val in
exec cbfun with [ctrlstr val];
0;;
/*! @ingroup g2dLineText
* \brief Set the callback on text line control change
*
* Prototype: fun [EdControl fun [EdControl S] I] I
*
* \param EdControl : text line control structure
* \param fun [EdControl S] I : callback
* - EdControl : text line control structure
* - S : new text value
*
* \return I : 0
**/
fun setEdCtrlTextLineCbChange(ctrlstr, cbfun)=
_CBtext ctrlstr.EDC_editLine @cbEdCtrlTextLineChange [ctrlstr cbfun];
0;;
/*! \brief Callback on text line control validate
*
* Private
*
* Prototype: fun [ObjText [EdControl fun [EdControl S] I]] I
*
* \param ObjText : text object
* \param [EdControl fun [EdControl S] I] : text line control structure and user callback
*
* \return I : 0
**/
fun cbEdCtrlTextLineValidate(txt, p, val)=
let p -> [ctrlstr cbfun] in
exec cbfun with [ctrlstr val];
0;;
/*! @ingroup g2dLineText
* \brief Set the callback on text line control validate
*
* Prototype: fun [EdControl fun [EdControl S] I] I
*
* \param EdControl : text line control structure
* \param fun [EdControl S] I : callback
* - EdControl : text line control structure
* - S : new text value
*
* \return I : 0
**/
fun setEdCtrlTextLineCbValidate(ctrlstr, cbfun)=
_CBlineOk ctrlstr.EDC_editLine @cbEdCtrlTextLineValidate [ctrlstr cbfun];
0;;
/*! @ingroup g2dLineText
* \brief Create a text line control
*
* Prototype: fun [EdWindow I I I I S I I] EdControl
*
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param S : text value
* \param I : ObjText flags, nil for default
* \param I : resize flags
*
* \return EdControl : new text line control
**/
fun crEdCtrlTextLine(winstr, x, y, w, h, value, flags, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CReditLine ctrlstr.EDC_channel father x y w h (if flags == nil then ET_BORDER|ET_AHSCROLL|ET_TABFOCUS else flags) value -> txt in
(
set ctrlstr.EDC_editLine = txt;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2dLineText
* \brief Set keyboard focus on a text line control
*
* Prototype: fun [EdControl] ObjText
*
* \param EdControl : text line control structure
*
* \return ObjText : text object
**/
fun setEdctrlTextLineFocus(ctrlstr)= _SETtextFocus ctrlstr.EDC_editLine;;
/*! @ingroup g2dLineText
* \brief Destroy a text line control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : text line control structure
*
* \return I : 0
**/
fun dsEdCtrlTextLine(ctrlstr)=
_DStext ctrlstr.EDC_editLine;
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control Button
/ ********************************************************************************************* */
/*! @ingroup g2dButton
* \brief Enable or disable a button control
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : button control structure
* \param I : state, 0 to disable, 1 to enable
*
* \return I : 0
**/
fun setEdCtrlButtonEnable(ctrlstr, state)=
let ctrlstr.EDC_button -> [btn _] in
_ENbutton btn state;
0;;
/*! @ingroup g2dButton
* \brief Trigger a button callback
*
* Prototype: fun [EdControl] I
*
* \param EdControl : button control structure
*
* \return I : 0
**/
fun triggerEdCtrlButton(ctrlstr)=
let ctrlstr.EDC_button -> [btn cbfun] in
exec cbfun with [ctrlstr];
0;;
/*! \brief Callback on button control click
*
* Private
*
* Prototype: fun [ObjButton [EdControl fun [EdControl] I]] I
*
* \param ObjButton : button object
* \param [EdControl fun [EdControl] I] : button control structure and callback
*
* \return I : 0
**/
fun cbEdCtrlButton(btn, p)=
let p -> [ctrlstr cbfun] in
exec cbfun with [ctrlstr];
0;;
/*! @ingroup g2dButton
* \brief Set the callback on button control click
*
* Prototype: fun [EdControl fun [EdControl] I] I
*
* \param EdControl : button control structure
* \param fun [EdControl] I : callback
* - EdControl : button control structure
*
* \return I : 0
**/
fun setEdCtrlButtonCb(ctrlstr, cbfun)=
let ctrlstr.EDC_button -> [btn _] in
(
mutate ctrlstr.EDC_button <- [_ cbfun];
_CBbutton btn @cbEdCtrlButton [ctrlstr cbfun];
);
0;;
/*! @ingroup g2dButton
* \brief Set the bitmap of a button control
*
* Prototype: fun [EdControl ObjBitmap] I
*
* \param EdControl : button control structure
* \param ObjBitmap : bitmap to use on the button
*
* \return I : 0
**/
fun setEdCtrlButtonBitmap(ctrlstr, bitmap)=
let ctrlstr.EDC_button -> [btn _] in
_SETbuttonBitmap btn bitmap;
0;;
/*! @ingroup g2dButton
* \brief Create a button bitmap control
*
* Prototype: fun [EdWindow I I I I ObjBitmap I] EdControl
*
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param ObjBitmap : bitmap
* \param I : resize flags
*
* \return EdControl : new button control
**/
fun crEdCtrlButtonBitmap(winstr, x, y, w, h, bitmap, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRbuttonBitmap ctrlstr.EDC_channel father bitmap x y w h PB_TABFOCUS -> button in
(
set ctrlstr.EDC_button = [button nil];
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2dButton
* \brief Set the text value of a button control
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : button control structure
* \param S : text value
*
* \return I : 0
**/
fun setEdCtrlButtonValue(ctrlstr, value)=
let ctrlstr.EDC_button -> [btn _] in
_SETbuttonName btn value;
0;;
/*! @ingroup g2dButton
* \brief Create a button control
*
* Prototype: fun [EdWindow I I I I S I] EdControl
*
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param S : text value
* \param I : resize flags
*
* \return EdControl : new button control
**/
fun crEdCtrlButton(winstr, x, y, w, h, value, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRbutton ctrlstr.EDC_channel father x y w h PB_TABFOCUS value -> button in
(
set ctrlstr.EDC_button = [button nil];
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2dButton
* \brief Destroy a button control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : button control structure
*
* \return I : 0
**/
fun dsEdCtrlButton(ctrlstr)=
let ctrlstr.EDC_button -> [btn _] in
_DSbutton btn;
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control Check / Radio
/ ********************************************************************************************* */
/*! @ingroup g2dCheck
* \brief Get a check box control state
*
* Prototype: fun [EdControl] I
*
* \param EdControl : check box control structure
*
* \return I : state, 0 if unchecked, 1 if checked
**/
fun getEdCtrlCheckState(ctrlstr)= _GETcheck ctrlstr.EDC_check;;
/*! @ingroup g2dCheck
* \brief Set a check box control state
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : check box control structure
* \param I : state, 0 to uncheck, 1 to check
*
* \return I : 0
**/
fun setEdCtrlCheckState(ctrlstr, state)=
_SETcheck ctrlstr.EDC_check state;
0;;
/*! @ingroup g2dCheck
* \brief Enable or disable a check box control
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : check box control structure
* \param I : state, 0 to disable, 1 to enable
*
* \return I : 0
**/
fun setEdCtrlCheckEnable(ctrlstr, state)=
_ENcheck ctrlstr.EDC_check state;
0;;
/*! \brief Callback on check box control state change
*
* Private
*
* Prototype: fun [ObjCheck [EdControl fun [EdControl I] I]] I
*
* \param ObjCheck : check object
* \param [EdControl fun [EdControl I] I] : check box control structure and callback
*
* \return I : 0
**/
fun cbEdCtrlCheckState(chk, p, state)=
let p -> [ctrlstr cbfun] in
exec cbfun with [ctrlstr state];
0;;
/*! @ingroup g2dCheck
* \brief Set the callback on check box control state change
*
* Prototype: fun [EdControl fun [EdControl I] I] I
*
* \param EdControl : check box control structure
* \param fun [EdControl I] I : callback
* - EdControl : check box control structure
* - I : new state, 0 for unchecked, 1 for checked
*
* \return I : 0
**/
fun setEdCtrlCheckCbState(ctrlstr, cbfun)=
_CBcheck ctrlstr.EDC_check @cbEdCtrlCheckState [ctrlstr cbfun];
0;;
/*! @ingroup g2dCheck
* \brief Get a radio box control state
*
* Prototype: fun [EdControl] I
*
* \param EdControl : radio box control structure
*
* \return I : state, 0 if unchecked, 1 if checked
**/
fun getEdCtrlRadioState(ctrlstr)= _GETcheck ctrlstr.EDC_check;;
/*! @ingroup g2dCheck
* \brief Set a radio box control state
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : radio box control structure
* \param I : state, 0 to uncheck, 1 to check
*
* \return I : 0
**/
fun setEdCtrlRadioState(ctrlstr, state)=
_SETcheck ctrlstr.EDC_check state;
0;;
/*! @ingroup g2dCheck
* \brief Enable or disable a radio box control
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : radio box control structure
* \param I : state, 0 to disable, 1 to enable
*
* \return I : 0
**/
fun setEdCtrlRadioEnable(ctrlstr, state)=
_ENcheck ctrlstr.EDC_check state;
0;;
/*! @ingroup g2dCheck
* \brief Set the callback on radio box control state change
*
* Prototype: fun [EdControl fun [EdControl I] I] I
*
* \param EdControl : radio box control structure
* \param fun [EdControl I] I : callback
* - EdControl : radio box control structure
* - I : new state, 0 for unchecked, 1 for checked
*
* \return I : 0
**/
fun setEdCtrlRadioCbState(ctrlstr, cbfun)=
_CBcheck ctrlstr.EDC_check @cbEdCtrlCheckState [ctrlstr cbfun];
0;;
/*! @ingroup g2dCheck
* \brief Create a check box control
*
* Prototype: fun [EdWindow I I I I S I] EdControl
*
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param S : text value
* \param I : resize flags
*
* \return EdControl : new check box control
**/
fun crEdCtrlCheck(winstr, x, y, w, h, value, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRcheck ctrlstr.EDC_channel father x y w h CH_TABFOCUS value -> check in
(
set ctrlstr.EDC_check = check;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2dCheck
* \brief Destroy a check box control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : check box control structure
*
* \return I : 0
**/
fun dsEdCtrlCheck(ctrlstr)=
_DScheck ctrlstr.EDC_check;
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/*! @ingroup g2dCheck
* \brief Create a radio box control
*
* Prototype: fun [EdWindow I I I I S I] EdControl
*
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param S : text value
* \param I : resize flags
*
* \return EdControl : new radio box control
**/
fun crEdCtrlRadio(winstr, x, y, w, h, value, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRcheck ctrlstr.EDC_channel father x y w h CH_RADIO|CH_TABFOCUS value -> check in
(
set ctrlstr.EDC_check = check;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2dCheck
* \brief Destroy a radio box control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : radio box control structure
*
* \return I : 0
**/
fun dsEdCtrlRadio(ctrlstr)=
_DScheck ctrlstr.EDC_check;
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control List
/ ********************************************************************************************* */
/*! @ingroup g2dList
* \brief Get the number of elements of a list control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : list control structure
*
* \return I : the number of elements
**/
fun getEdCtrlListNbElems(ctrlstr)=
let ctrlstr.EDC_list -> [list lp] in
_GETlistCount list;;
/*! @ingroup g2dList
* \brief Get an element of a list control by name
*
* Prototype: fun [EdControl S] [I [S [[S r1] I]]]
*
* \param EdControl : list control structure
* \param S : name of the element
*
* \return [I [S [[S r1] I]]] : the tuple of the list element
**/
fun getEdCtrlListElemByName(ctrlstr, name)=
let ctrlstr.EDC_list -> [_ l] in
let sizelist l -> size in
let 0 -> i in
let nil -> ret in
(
while i < size && ret == nil do
(
let nth_list l i -> elt in
let elt -> [pos [val p]] in
if (!strcmp val name) then
set ret = elt
else nil;
set i = i + 1;
);
ret;
);;
/*! @ingroup g2dList
* \brief Get an element of a list control by position
*
* Prototype: fun [EdControl S] [I [S [[S r1] I]]]
*
* \param EdControl : list control structure
* \param I : position of the element
*
* \return [I [S [[S r1] I]]] : the tuple of the list element
**/
fun getEdCtrlListElemByPos(ctrlstr, pos)=
let ctrlstr.EDC_list -> [_ l] in
let sizelist l -> size in
let 0 -> i in
let nil -> ret in
(
while i < size && ret == nil do
(
let nth_list l i -> elt in
let elt -> [epos [val p]] in
if (i == pos) then
set ret = elt
else nil;
set i = i + 1;
);
ret;
);;
/*! @ingroup g2dList
* \brief Fill a list control with a list of elements
*
* Prototype: fun [EdControl [S r1]] I
*
* \param EdControl : list control structure
* \param [S r1] : list of elements
*
* \return I : 0
**/
fun fillEdCtrlList(ctrlstr, lparam)=
if ctrlstr == nil then nil else
let ctrlstr.EDC_list -> [list _] in
let nil -> lp in
(
_RSTlist list;
let sizelist lparam -> size in
let 0 -> i in
while i < size do
(
let nth_list lparam i -> elt in
(
_ADDlist list i elt;
set lp = G2Dlcat lp [i [elt [nil nil]]]::nil;
);
set i = i + 1;
);
mutate ctrlstr.EDC_list <- [_ lp];
_SELlist list 0;
);
0;;
/*! @ingroup g2dList
* \brief Fill a list control with a list of elements with params
*
* Prototype: fun [EdControl [[S [[S r1] I]] r1]] I
*
* \param EdControl : list control structure
* \param [S r1] : list of elements
*
* \return I : 0
**/
fun fillEdCtrlListEx(ctrlstr, lparam)=
if ctrlstr == nil then nil else
let ctrlstr.EDC_list -> [list _] in
let nil -> lp in
(
_RSTlist list;
let sizelist lparam -> size in
let 0 -> i in
while i < size do
(
let nth_list lparam i -> [elt [elp etype]] in
(
_ADDlist list i elt;
set lp = G2Dlcat lp [i [elt [elp etype]]]::nil;
);
set i = i + 1;
);
mutate ctrlstr.EDC_list <- [_ lp];
_SELlist list 0;
);
0;;
/*! @ingroup g2dList
* \brief Add an element to a list control
*
* Prototype: fun [EdControl S [S r1] I] I
*
* \param EdControl : list control structure
* \param S : the element to add
* \param [S r1] : list of parameters associated to the element
* \param I : a user flag to set a type on the element
*
* \return I : 0
**/
fun addEdCtrlList(ctrlstr, name, lval, type)=
if ctrlstr == nil then nil else
let ctrlstr.EDC_list -> [list lp] in
let _GETlistCount list -> pos in
(
_ADDlist list pos name;
mutate ctrlstr.EDC_list <- [_ G2Dlcat lp [pos [name [lval type]]]::nil];
);
0;;
/*! @ingroup g2dList
* \brief Get the elements of a list control
*
* Prototype: fun [EdControl] [S r1]
*
* \param EdControl : list control structure
*
* \return [S r1] : list of elements
**/
fun getEdCtrlListElems(ctrlstr)=
let ctrlstr.EDC_list -> [list lp] in
let sizelist lp -> size in
let 0 -> i in
let nil -> elems in
(
while i < size do
(
let nth_list lp i -> [_ [elt _]] in
set elems = G2Dlcat elems elt::nil;
set i = i + 1;
);
elems;
);;
/*! @ingroup g2dList
* \brief Get the elements of a list control with params
*
* Prototype: fun [EdControl] [[S [[S r1] I]] r1]
*
* \param EdControl : list control structure
*
* \return [S r1] : list of elements
**/
fun getEdCtrlListElemsEx(ctrlstr)=
let ctrlstr.EDC_list -> [list lp] in
let sizelist lp -> size in
let 0 -> i in
let nil -> elems in
(
while i < size do
(
let nth_list lp i -> [_ elt] in
set elems = G2Dlcat elems elt::nil;
set i = i + 1;
);
elems;
);;
/*! @ingroup g2dList
* \brief Get parameters and type from an element name of a list control
*
* Prototype: fun [EdControl S] [[S r1] I]
*
* \param EdControl : list control structure
* \param S : element name
*
* \return [[S r1] I] : tuple with parameters list and the element type
**/
fun getEdCtrlListElem(ctrlstr, elt)=
let ctrlstr.EDC_list -> [list lp] in
let getEdCtrlListElemByName ctrlstr elt -> [i [n p]] in
p;;
/*! @ingroup g2dList
* \brief Refresh a list control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : list control structure
*
* \return I : 0
**/
fun refreshEdCtrlList(ctrlstr)=
if ctrlstr == nil then nil else
let ctrlstr.EDC_list -> [list lp] in
let nil -> ln in
(
_RSTlist list;
let sizelist lp -> size in
let 0 -> i in
while i < size do
(
let nth_list lp i -> [_ [elt p]] in
(
_ADDlist list i elt;
set ln = G2Dlcat ln [i [elt p]]::nil;
);
set i = i + 1;
);
mutate ctrlstr.EDC_list <- [_ ln];
);
0;;
/*! @ingroup g2dList
* \brief Rename a list control element
*
* Prototype: fun [EdControl S S] I
*
* \param EdControl : list control structure
* \param S : the name of the element
* \param S : the new name of the element
*
* \return I : 0
**/
fun renameEdCtrlListElement(ctrlstr, oldname, newname)=
if ctrlstr == nil then nil else
let ctrlstr.EDC_list -> [list lp] in
let nil -> ln in
(
_RSTlist list;
let sizelist lp -> size in
let 0 -> i in
while i < size do
(
let nth_list lp i -> [_ [elt p]] in
let if !strcmp oldname elt then newname else elt -> elt in
(
_ADDlist list i elt;
set ln = G2Dlcat ln [i [elt p]]::nil;
);
set i = i + 1;
);
mutate ctrlstr.EDC_list <- [_ ln];
);
0;;
/*! @ingroup g2dList
* \brief Rename a list control element
*
* Prototype: fun [EdControl I S] I
*
* \param EdControl : list control structure
* \param I : the position of the element
* \param S : the new name of the element
*
* \return I : 0
**/
fun renameEdCtrlListElementByPos(ctrlstr, pos, newname)=
if ctrlstr == nil then nil else
let ctrlstr.EDC_list -> [list lp] in
let nil -> ln in
(
_RSTlist list;
let sizelist lp -> size in
let 0 -> i in
while i < size do
(
let nth_list lp i -> [_ [elt p]] in
let if (i == pos) then newname else elt -> elt in
(
_ADDlist list i elt;
set ln = G2Dlcat ln [i [elt p]]::nil;
);
set i = i + 1;
);
mutate ctrlstr.EDC_list <- [_ ln];
);
0;;
/*! @ingroup g2dList
* \brief Change a list control element params
*
* Prototype: fun [EdControl S [S r1]] I
*
* \param EdControl : list control structure
* \param S : the name of the element
* \param [S r1] : the new params
*
* \return I : 0
**/
fun setEdCtrlListElementParam(ctrlstr, elt, np)=
if ctrlstr == nil then nil else
let getEdCtrlListElemByName ctrlstr elt -> [i [n p]] in
let p -> [_ et] in
mutate p <- [np et];
0;;
/*! @ingroup g2dList
* \brief Change a list control element params by it's position
*
* Prototype: fun [EdControl I [S r1]] I
*
* \param EdControl : list control structure
* \param I : the element position
* \param [S r1] : the new params
*
* \return I : 0
**/
fun setEdCtrlListElementParamByPos(ctrlstr, pos, np)=
if ctrlstr == nil then nil else
let getEdCtrlListElemByPos ctrlstr pos -> [i [n p]] in
let p -> [_ et] in
mutate p <- [np et];
0;;
/*! @ingroup g2dList
* \brief Change a list control element type
*
* Prototype: fun [EdControl S I] I
*
* \param EdControl : list control structure
* \param S : the name of the element
* \param I : the new element type
*
* \return I : 0
**/
fun setEdCtrlListElementType(ctrlstr, elt, nt)=
if ctrlstr == nil then nil else
let getEdCtrlListElemByName ctrlstr elt -> [i [n p]] in
let p -> [np _] in
mutate p <- [np nt];
0;;
/*! @ingroup g2dList
* \brief Change a list control element type by it's position
*
* Prototype: fun [EdControl I I] I
*
* \param EdControl : list control structure
* \param I : the element position
* \param I : the new element type
*
* \return I : 0
**/
fun setEdCtrlListElementTypeByPos(ctrlstr, pos, nt)=
if ctrlstr == nil then nil else
let getEdCtrlListElemByPos ctrlstr pos -> [i [n p]] in
let p -> [np _] in
mutate p <- [np nt];
0;;
/*! @ingroup g2dList
* \brief Move a list control element up in the list
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : list control structure
* \param S : the name of the element to move
*
* \return I : 0
**/
fun moveEdCtrlListElementUp(ctrlstr, name)=
if ctrlstr == nil then nil else
let ctrlstr.EDC_list -> [list lp] in
let nil -> ln in
(
_RSTlist list;
let sizelist lp -> size in
let 0 -> i in
while i < size do
(
let nth_list lp i -> [_ [elt1 p1]] in
let nth_list lp i+1 -> [_ [elt2 p2]] in
if (!strcmp name elt2) then
(
_ADDlist list i elt2;
set ln = G2Dlcat ln [i [elt2 p2]]::nil;
set i = i + 1;
_ADDlist list i elt1;
set ln = G2Dlcat ln [i [elt1 p1]]::nil;
)
else
(
_ADDlist list i elt1;
set ln = G2Dlcat ln [i [elt1 p1]]::nil;
);
set i = i + 1;
);
mutate ctrlstr.EDC_list <- [_ ln];
);
0;;
/*! @ingroup g2dList
* \brief Move a list control element down in the list
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : list control structure
* \param S : the name of the element to move
*
* \return I : 0
**/
fun moveEdCtrlListElementDown(ctrlstr, name)=
if ctrlstr == nil then nil else
let ctrlstr.EDC_list -> [list lp] in
let nil -> ln in
(
_RSTlist list;
let sizelist lp -> size in
let 0 -> i in
while i < size do
(
let nth_list lp i -> [_ [elt1 p1]] in
let nth_list lp i+1 -> [_ [elt2 p2]] in
if ((!strcmp name elt1) && (elt2 != nil)) then
(
_ADDlist list i elt2;
set ln = G2Dlcat ln [i [elt2 p2]]::nil;
set i = i + 1;
_ADDlist list i elt1;
set ln = G2Dlcat ln [i [elt1 p1]]::nil;
)
else
(
_ADDlist list i elt1;
set ln = G2Dlcat ln [i [elt1 p1]]::nil;
);
set i = i + 1;
);
mutate ctrlstr.EDC_list <- [_ ln];
);
0;;
/*! @ingroup g2dList
* \brief Move a list control element up in the list
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : list control structure
* \param I : the position of the element to move
*
* \return I : 0
**/
fun moveEdCtrlListElementUpByPos(ctrlstr, pos)=
if ctrlstr == nil then nil else
let ctrlstr.EDC_list -> [list lp] in
let nil -> ln in
(
_RSTlist list;
let sizelist lp -> size in
let 0 -> i in
while i < size do
(
let nth_list lp i -> [_ [elt1 p1]] in
let nth_list lp i+1 -> [_ [elt2 p2]] in
if ((i + 1) == pos) then
(
_ADDlist list i elt2;
set ln = G2Dlcat ln [i [elt2 p2]]::nil;
set i = i + 1;
_ADDlist list i elt1;
set ln = G2Dlcat ln [i [elt1 p1]]::nil;
)
else
(
_ADDlist list i elt1;
set ln = G2Dlcat ln [i [elt1 p1]]::nil;
);
set i = i + 1;
);
mutate ctrlstr.EDC_list <- [_ ln];
);
0;;
/*! @ingroup g2dList
* \brief Move a list control element down in the list
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : list control structure
* \param I : the position of the element to move
*
* \return I : 0
**/
fun moveEdCtrlListElementDownByPos(ctrlstr, pos)=
if ctrlstr == nil then nil else
let ctrlstr.EDC_list -> [list lp] in
let nil -> ln in
(
_RSTlist list;
let sizelist lp -> size in
let 0 -> i in
while i < size do
(
let nth_list lp i -> [_ [elt1 p1]] in
let nth_list lp i+1 -> [_ [elt2 p2]] in
if ((i == pos) && (elt2 != nil)) then
(
_ADDlist list i elt2;
set ln = G2Dlcat ln [i [elt2 p2]]::nil;
set i = i + 1;
_ADDlist list i elt1;
set ln = G2Dlcat ln [i [elt1 p1]]::nil;
)
else
(
_ADDlist list i elt1;
set ln = G2Dlcat ln [i [elt1 p1]]::nil;
);
set i = i + 1;
);
mutate ctrlstr.EDC_list <- [_ ln];
);
0;;
/*! @ingroup g2dList
* \brief Remove an element from a list control
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : list control structure
* \param S : element name
*
* \return I : 0
**/
fun delEdCtrlList(ctrlstr, elt)=
let ctrlstr.EDC_list -> [list lp] in
let getEdCtrlListElemByName ctrlstr elt -> [i [n p]] in
(
_DELlist list i;
mutate ctrlstr.EDC_list <- [_ (G2DremoveEdIdxFromList lp i)];
refreshEdCtrlList ctrlstr;
let (_GETlistCount list) - 1 -> maxpos in
let if (i > maxpos) then maxpos else i -> npos in
_SELlist list npos;
);
0;;
/*! @ingroup g2dList
* \brief Reset a list control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : list control structure
*
* \return I : 0
**/
fun resetEdCtrlList(ctrlstr)=
let ctrlstr.EDC_list -> [list lp] in
(
_RSTlist list;
mutate ctrlstr.EDC_list <- [_ nil];
);
0;;
/*! @ingroup g2dList
* \brief Select an element from a list control
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : list control structure
* \param S : element name
*
* \return I : 0
**/
fun selectEdCtrlList(ctrlstr, name)=
let ctrlstr.EDC_list -> [list lp] in
_SSELlist list name;
0;;
/*! @ingroup g2dList
* \brief Select an element from a list control using it's position
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : list control structure
* \param I : element position
*
* \return I : 0
**/
fun selectEdCtrlListByPos(ctrlstr, pos)=
let ctrlstr.EDC_list -> [list lp] in
let if (pos < 0) then 0 else if (pos >= (_GETlistCount list)) then (_GETlistCount list) - 1 else pos -> pos in
_SELlist list pos;
0;;
/*! @ingroup g2dList
* \brief Select an element from a list control using it's parameters
*
* Prototype: fun [EdControl [S r1]] I
*
* \param EdControl : list control structure
* \param [S r1] : element parameters
*
* \return I : 0
**/
fun selectEdCtrlListByParams(ctrlstr, params)=
let ctrlstr.EDC_list -> [list l] in
let sizelist l -> size in
let 0 -> i in
let nil -> ret in
while i < size && ret == nil do
(
let nth_list l i -> elt in
let elt -> [pos [val p]] in
let p -> [lp type] in
if (!strcmpi strcatn lp strcatn params) then
(
set ret = pos;
_SELlist list pos;
)
else nil;
set i = i + 1;
);
0;;
/*! @ingroup g2dList
* \brief Get the current selected element from a list control
*
* Prototype: fun [EdControl] [S [S r1] I]
*
* \param EdControl : list control structure
*
* \return [S [S r1] I] : the selected element tuple, name, parameters and type
**/
fun getSelectedEdCtrlList(ctrlstr)=
let ctrlstr.EDC_list -> [list lp] in
let _GETlist list -> [pos name] in
let switch lp pos -> [n [lval type]] in
[name lval type];;
/*! @ingroup g2dList
* \brief Get the current selected element from a list control
*
* Prototype: fun [EdControl] [I S [S r1] I]
*
* \param EdControl : list control structure
*
* \return [I S [S r1] I] : the selected element tuple, pos, name, parameters and type
**/
fun getSelectedEdCtrlList2(ctrlstr)=
let ctrlstr.EDC_list -> [list lp] in
let _GETlist list -> [pos name] in
let switch lp pos -> [n [lval type]] in
[pos name lval type];;
/*! @ingroup g2dList
* \brief Get the current selected element from a list control
*
* Prototype: fun [EdControl] [I S [S r1] I]
*
* \param EdControl : list control structure
*
* \return [I S [S r1] I] : the selected element tuple, pos, name, parameters and type
**/
fun getSelectedEdCtrlListExt(ctrlstr)=
let ctrlstr.EDC_list -> [list lp] in
let _GETlist list -> [pos name] in
let switch lp pos -> [n [lval type]] in
[pos name lval type];;
/*! @ingroup g2dList
* \brief Get the current selected elements from a list control
*
* Prototype: fun [EdControl] [[S [S r1] I] r1]
*
* \param EdControl : list control structure
*
* \return [[S [S r1] I] r1] : the selected elements list, name, parameters and type
**/
fun getMultiSelectedEdCtrlList(ctrlstr)=
let ctrlstr.EDC_list -> [list lp] in
let _GETlistMSel list -> elems in
let nil -> retlist in
(
while (elems != nil) do
(
let hd elems -> [pos name] in
let switch lp pos -> [n [lval type]] in
set retlist = [name lval type]::retlist;
set elems = tl elems;
);
retlist;
);;
/*! @ingroup g2dList
* \brief Enable or disable a list control
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : list control structure
* \param I : state, 0 to disable, 1 to enable
*
* \return I : 0
**/
fun setEdCtrlListEnable(ctrlstr, state)=
let ctrlstr.EDC_list -> [list lp] in
_ENlist list state;
0;;
/*! \brief Callback on list control double click
*
* Private
*
* Prototype: fun [ObjList [EdControl fun [EdControl I S [S r1] I] I] I S] I
*
* \param ObjList : list object
* \param [EdControl fun [EdControl I S [S r1] I] I] : list control structure and callback
* \param I : position
* \param S : name
*
* \return I : 0
**/
fun cbEdCtrlListDbClick(lst, p, pos, elem)=
let p -> [ctrlstr cbfun] in
let ctrlstr.EDC_list -> [list lp] in
let switch lp pos -> [n [lval type]] in
exec cbfun with [ctrlstr pos elem lval type];
0;;
/*! @ingroup g2dList
* \brief Set the callback on list control double click
*
* Prototype: fun [EdControl fun [EdControl I S [S r1] I] I] I
*
* \param EdControl : list box control structure
* \param fun [EdControl I S [S r1] I] I : callback
* - EdControl : list control structure
* - I : element position
* - S : element name
* - [S r1] : element parameters
* - I : element type
*
* \return I : 0
**/
fun setEdCtrlListCbDbClick(ctrlstr, cbfun)=
let ctrlstr.EDC_list -> [list lp] in
_CBlistDclick list @cbEdCtrlListDbClick [ctrlstr cbfun];
0;;
/*! \brief Callback on list control click
*
* Private
*
* Prototype: fun [ObjList [EdControl fun [EdControl I S [S r1] I] I] I S] I
*
* \param ObjList : list object
* \param [EdControl fun [EdControl I S [S r1] I] I] : list control structure and callback
* \param I : position
* \param S : name
*
* \return I : 0
**/
fun cbEdCtrlListClick(lst, p, pos, elem)=
let p -> [ctrlstr cbfun] in
let ctrlstr.EDC_list -> [list lp] in
let switch lp pos -> [n [lval type]] in
exec cbfun with [ctrlstr pos elem lval type];
0;;
/*! @ingroup g2dList
* \brief Set the callback on list control click
*
* Prototype: fun [EdControl fun [EdControl I S [S r1] I] I] I
*
* \param EdControl : list box control structure
* \param fun [EdControl I S [S r1] I] I : callback
* - EdControl : list control structure
* - I : element position
* - S : element name
* - [S r1] : element parameters
* - I : element type
*
* \return I : 0
**/
fun setEdCtrlListCbClick(ctrlstr, cbfun)=
let ctrlstr.EDC_list -> [list lp] in
_CBlistClick list @cbEdCtrlListClick [ctrlstr cbfun];
0;;
/*! \brief Callback on list control key down
*
* Private
*
* Prototype: fun [ObjList [EdControl fun [EdControl I S [S r1] I I I] I] I S] I
*
* \param ObjList : list object
* \param [EdControl fun [EdControl I S [S r1] I I I] I] : list control structure and callback
* \param I : key code
* \param I : ascii code
*
* \return I : 0
**/
fun cbEdCtrlListKeyDown(listobj, p, key, code) =
let p -> [ctrlstr cbfun] in
let ctrlstr.EDC_list -> [list lp] in
let _GETlist list -> [pos name] in
let switch lp pos -> [n [lval type]] in
(
exec cbfun with [ctrlstr pos name lval type key code];
);
0;;
/*! @ingroup g2dList
* \brief Set the callback on list control key down
*
* Prototype: fun [EdControl fun [EdControl I S [S r1] I I I] I] I
*
* \param EdControl : list box control structure
* \param fun [EdControl I S [S r1] I I I] I : callback
* - EdControl : list control structure
* - I : element position
* - S : element name
* - [S r1] : element parameters
* - I : element type
* - I : key code
* - I : ascii code
*
* \return I : 0
**/
fun setEdCtrlListCbKeyDown(ctrlstr, cbfun)=
let ctrlstr.EDC_list -> [list lp] in
_CBlistKeyDown list @cbEdCtrlListKeyDown [ctrlstr cbfun];
0;;
/*! \brief Callback on list control key up
*
* Private
*
* Prototype: fun [ObjList [EdControl fun [EdControl I S [S r1] I I] I] I S] I
*
* \param ObjList : list object
* \param [EdControl fun [EdControl I S [S r1] I I] I] : list control structure and callback
* \param I : key code
*
* \return I : 0
**/
fun cbEdCtrlListKeyUp(listobj, p, key) =
let p -> [ctrlstr cbfun] in
let ctrlstr.EDC_list -> [list lp] in
let _GETlist list -> [pos name] in
let switch lp pos -> [n [lval type]] in
(
exec cbfun with [ctrlstr pos name lval type key];
);
0;;
/*! @ingroup g2dList
* \brief Set the callback on list control key up
*
* Prototype: fun [EdControl fun [EdControl I S [S r1] I I] I] I
*
* \param EdControl : list box control structure
* \param fun [EdControl I S [S r1] I I] I : callback
* - EdControl : list control structure
* - I : element position
* - S : element name
* - [S r1] : element parameters
* - I : element type
* - I : key code
*
* \return I : 0
**/
fun setEdCtrlListCbKeyUp(ctrlstr, cbfun)=
let ctrlstr.EDC_list -> [list lp] in
_CBlistKeyUp list @cbEdCtrlListKeyUp [ctrlstr cbfun];
0;;
/*! @ingroup g2dList
* \brief Create a list control
*
* Prototype: fun [EdWindow I I I I I I] EdControl
*
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : ObjList flags
* \param I : resize flags
*
* \return EdControl : new list control
**/
fun crEdCtrlList(winstr, x, y, w, h, flags, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRlist ctrlstr.EDC_channel father x y w h (if flags == nil then LB_BORDER|LB_VSCROLL|ET_TABFOCUS else flags) -> list in
(
set ctrlstr.EDC_list = [list nil];
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2dList
* \brief Destroy a list control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : list control structure
*
* \return I : 0
**/
fun dsEdCtrlList(ctrlstr)=
let ctrlstr.EDC_list -> [list lp] in
_DSlist list;
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control Select combo box
/ ********************************************************************************************* */
/*! @ingroup g2dSelect
* \brief Fill a select box control
*
* Prototype: fun [EdControl [S r1]] I
*
* \param EdControl : select control structure
* \param [S r1] : list of elements
*
* \return I : 0
**/
fun fillEdCtrlSelect(ctrlstr, lparam)=
_RSTcombo ctrlstr.EDC_select;
let sizelist lparam -> size in
let 0 -> i in
while i < size do
(
let nth_list lparam i -> elt in
(
_ADDcombo ctrlstr.EDC_select i elt;
);
set i = i + 1;
);
_SELcombo ctrlstr.EDC_select 0;
0;;
/*! @ingroup g2dSelect
* \brief Add an element to a select box control
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : select control structure
* \param S : element to add
*
* \return I : 0
**/
fun addEdCtrlSelect(ctrlstr, param)=
_ADDcombo ctrlstr.EDC_select (_GETcomboCount ctrlstr.EDC_select) param;
0;;
/*! @ingroup g2dSelect
* \brief Reset/Clear a select box control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : select control structure
*
* \return I : 0
**/
fun resetEdCtrlSelect(ctrlstr)=
_RSTcombo ctrlstr.EDC_select;
0;;
/*! @ingroup g2dSelect
* \brief Select an element in a select box control
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : select control structure
* \param S : element to select
*
* \return I : 0
**/
fun selectEdCtrlSelect(ctrlstr, name)=
_SSELcombo ctrlstr.EDC_select name;
0;;
/*! @ingroup g2dSelect
* \brief Select an element in a select box control by position
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : select control structure
* \param I : element position to select
*
* \return I : 0
**/
fun selectEdCtrlSelectByPos(ctrlstr, pos)=
_SELcombo ctrlstr.EDC_select pos;
0;;
/*! @ingroup g2dSelect
* \brief Get the selected element of a select box control
*
* Prototype: fun [EdControl] S
*
* \param EdControl : select control structure
*
* \return S : selected element
**/
fun getSelectedEdCtrlSelect(ctrlstr)=
let _GETcombo ctrlstr.EDC_select -> [pos name] in
name;;
/*! @ingroup g2dSelect
* \brief Get the selected element position of a select box control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : select control structure
*
* \return I : selected element position
**/
fun getSelectedEdCtrlSelectPos(ctrlstr)=
let _GETcombo ctrlstr.EDC_select -> [pos name] in
pos;;
/*! @ingroup g2dSelect
* \brief Enable or disable a select box control
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : select control structure
* \param I : state, 0 to disable, 1 to enable
*
* \return I : 0
**/
fun setEdCtrlSelectEnable(ctrlstr, state)=
_ENcombo ctrlstr.EDC_select state;
0;;
/*! \brief Callback on select box control selected
*
* Private
*
* Prototype: fun [ObjBox [EdControl fun [EdControl I S] I] I S] I
*
* \param ObjBox : select object
* \param [EdControl fun [EdControl I S] I] : select control structure and callback
* \param I : element position
* \param S : element name
*
* \return I : 0
**/
fun cbEdCtrlSelect(sel, p, pos, elem)=
let p -> [ctrlstr cbfun] in
exec cbfun with [ctrlstr pos elem];
0;;
/*! @ingroup g2dSelect
* \brief Set the callback on select box control selected
*
* Prototype: fun [EdControl fun [EdControl I S] I] I
*
* \param EdControl : radio box control structure
* \param fun [EdControl I S] I : callback
* - EdControl : select control structure
* - I : element position
* - S : element name
*
* \return I : 0
**/
fun setEdCtrlSelectCb(ctrlstr, cbfun)=
_CBcombo ctrlstr.EDC_select @cbEdCtrlSelect [ctrlstr cbfun];
0;;
/*! @ingroup g2dSelect
* \brief Create a select box control
*
* Prototype: fun [EdWindow I I I I I] EdControl
*
* \param EdWindow : mother window structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : resize flags
*
* \return EdControl : new select box control
**/
fun crEdCtrlSelect(winstr, x, y, w, h, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRcombo ctrlstr.EDC_channel father x y w h CB_NOEDIT|CB_TABFOCUS nil -> select in
(
set ctrlstr.EDC_select = select;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2dSelect
* \brief Destroy a select box control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : select control structure
*
* \return I : 0
**/
fun dsEdCtrlSelect(ctrlstr)=
_DScombo ctrlstr.EDC_select;
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control Tree
/ ********************************************************************************************* */
/*! @ingroup g2dTree
* \brief Get the previous selected item
*
* Prototype: fun [EdControl] EdTreeItem
*
* \param EdControl : tree control structure
*
* \return EdTreeItem : nil
**/
fun getEdCtrlTreePreviousSelectedItem(ctrlstr)= let ctrlstr.EDC_tree -> [_ _ _ item _] in item;;
/*! @ingroup g2dTree
* \brief Get the current selected item
*
* Prototype: fun [EdControl] EdTreeItem
*
* \param EdControl : tree control structure
*
* \return EdTreeItem : nil
**/
fun getEdCtrlTreeSelectedItem(ctrlstr)= let ctrlstr.EDC_tree -> [_ _ item _ _] in item;;
/*! @ingroup g2dTree
* \brief Get the father of a tree item
*
* Prototype: fun [EdControl EdTreeItem] EdTreeItem
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item
*
* \return EdTreeItem : nil
**/
fun getEdCtrlTreeFatherItem(ctrlstr, item)= item.EDTITEM_father;;
/*! @ingroup g2dTree
* \brief Get the sons list of a tree item
*
* Prototype: fun [EdControl EdTreeItem] [EdTreeItem r1]
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item
*
* \return [EdTreeItem r1] : nil
**/
fun getEdCtrlTreeSonsItem(ctrlstr, item)= item.EDTITEM_lSons;;
/*! @ingroup g2dTree
* \brief Get the root tree item
*
* Prototype: fun [EdControl] EdTreeItem
*
* \param EdControl : tree control structure
*
* \return EdTreeItem : nil
**/
fun getEdCtrlTreeRootItem(ctrlstr)=
let ctrlstr.EDC_tree -> [tree [litems lsitems bmplist _] _ _ _] in
let nth_list litems ((sizelist litems) -1) -> [_ itemstr] in
itemstr;;
/*! @ingroup g2dTree
* \brief Return 1 if the first item is a son of the second item
*
* Prototype: fun [EdControl EdTreeItem EdTreeItem] I
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item to search
* \param EdTreeItem : father tree item
*
* \return 1 : 0
**/
fun isEdCtrlTreeItemSon(ctrlstr, item, father)=
let 0 -> ret in
(
let sizelist father.EDTITEM_lSons -> size in
let 0 -> i in
while i < size && ret != 1 do
(
let nth_list father.EDTITEM_lSons i -> elt in
(
if elt != item then
set ret = isEdCtrlTreeItemSon ctrlstr item elt
else
set ret = 1;
);
set i = i + 1;
);
ret;
);;
/*! \brief Callback on a tree item selection
*
* Private
*
* Prototype: fun [ObjTree [EdControl fun [EdControl EdTreeItem EdTreeItem S I] u1] ObjTreeItem] I
*
* \return 0
**/
fun cbEdCtrlTreeSelect(tree, p, item) =
let p -> [ctrlstr cbfun] in
let ctrlstr.EDC_tree -> [tree [litems lsitems bmplist _] pitem _ _] in
let switch litems item -> itemstr in
(
_SELtreeItem tree item;
mutate ctrlstr.EDC_tree <- [_ _ itemstr pitem _];
exec cbfun with [ctrlstr itemstr.EDTITEM_father itemstr itemstr.EDTITEM_sValue itemstr.EDTITEM_iType];
);
0;;
/*! \brief Callback on a tree item drag
*
* Private
*
* Prototype: fun [ObjTree [EdControl fun [EdControl [EdTreeItem EdTreeItem S I] [EdTreeItem EdTreeItem S I]] u1] ObjTreeItem ObjTreeItem] I
*
* \return 0
**/
fun cbEdCtrlTreeDrag(tree, p, item1, item2)=
let p -> [ctrlstr cbfun] in
let ctrlstr.EDC_tree -> [tree [litems lsitems bmplist _] _ _ _] in
let switch litems item1 -> item1str in
let switch litems item2 -> item2str in
let if item2str == nil then getEdCtrlTreeRootItem ctrlstr else item2str -> item2str in
exec cbfun with [ctrlstr [item1str.EDTITEM_father item1str item1str.EDTITEM_sValue item1str.EDTITEM_iType] [item2str.EDTITEM_father item2str item2str.EDTITEM_sValue item2str.EDTITEM_iType]];
0;;
/*! @ingroup g2dTree
* \brief Define the tree item drag callback
*
* Prototype: fun [EdControl fun [EdControl [EdTreeItem EdTreeItem S I] [EdTreeItem EdTreeItem S I]] u0] I
*
* \param EdControl : tree control structure
* \param fun [EdControl [EdTreeItem EdTreeItem S I] [EdTreeItem EdTreeItem S I]] u0 : callback function
* \param - EdControl : tree control structure
* \param - [EdTreeItem EdTreeItem S I] : first item father, item, item value, item type
* \param - [EdTreeItem EdTreeItem S I] : second item father, item, item value, item type
*
* \return 0
**/
fun setEdCtrlTreeCbDrag(ctrlstr, cbfun)=
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
_CBtreeDrag tree @cbEdCtrlTreeDrag [ctrlstr cbfun];
0;;
/*! \brief Callback on a tree item double click
*
* Private
*
* Prototype: fun [ObjTree [EdControl fun [EdControl EdTreeItem EdTreeItem S I u1 u2] u3] ObjTreeItem u1 u2] I
*
* \return 0
**/
fun cbEdCtrlTreeDbClick(tree, p, item, x, y) =
let p -> [ctrlstr cbfun] in
let ctrlstr.EDC_tree -> [tree [litems lsitems bmplist _] pitem _ _] in
let switch litems item -> itemstr in
(
_SELtreeItem tree item;
exec cbfun with [ctrlstr itemstr.EDTITEM_father itemstr itemstr.EDTITEM_sValue itemstr.EDTITEM_iType x y];
);
0;;
/*! @ingroup g2dTree
* \brief Define the tree item double click callback
*
* Prototype: fun [EdControl fun [EdControl EdTreeItem EdTreeItem S I I I] u0] I
*
* \param EdControl : tree control structure
* \param fun [EdControl EdTreeItem EdTreeItem S I I I] u0: callback function
* \param - EdControl : tree control structure
* \param - EdTreeItem : item father
* \param - EdTreeItem : clicked item
* \param - S : item value
* \param - I : item type
* \param - I : click X coordinate
* \param - I : click Y coordinate
*
* \return 0
**/
fun setEdCtrlTreeCbDbClick(ctrlstr, cbfun)=
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
_CBtreeDClick tree @cbEdCtrlTreeDbClick [ctrlstr cbfun];
0;;
/*! @ingroup g2dTree
* \brief Define the tree item select callback
*
* Prototype: fun [EdControl fun [EdControl EdTreeItem EdTreeItem S I] u0] I
*
* \param EdControl : tree control structure
* \param fun [EdControl EdTreeItem EdTreeItem S I] u0: callback function
* \param - EdControl : tree control structure
* \param - EdTreeItem : item father
* \param - EdTreeItem : selected item
* \param - S : item value
* \param - I : item type
*
* \return 0
**/
fun setEdCtrlTreeCbSelect(ctrlstr, cbfun)=
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
(
_CBtreeSelect tree @cbEdCtrlTreeSelect [ctrlstr cbfun];
mutate ctrlstr.EDC_tree <- [_ _ _ _ cbfun];
);
0;;
/*! \brief Callback on a tree item right click
*
* Private
*
* Prototype: fun [ObjTree [EdControl fun [EdControl EdTreeItem EdTreeItem S I u1 u2] u3] ObjTreeItem u1 u2 u4] I
*
* \return 0
**/
fun cbEdCtrlTreeRclick(tree, p, item, x, y, btn)=
if (btn != 2) then nil else
let p -> [ctrlstr cbfun] in
let ctrlstr.EDC_tree -> [tree [litems lsitems bmplist _] pitem _ cbselfun] in
let switch litems item -> itemstr in
(
_CBtreeSelect tree @cbEdCtrlTreeSelect [ctrlstr nil];
_SELtreeItem tree item;
_CBtreeSelect tree @cbEdCtrlTreeSelect [ctrlstr cbselfun];
exec cbfun with [ctrlstr itemstr.EDTITEM_father itemstr itemstr.EDTITEM_sValue itemstr.EDTITEM_iType x y];
);
0;;
/*! \brief Callback on a tree item right click
*
* Private
*
* Prototype: fun [ObjTree [EdControl fun [EdControl EdTreeItem EdTreeItem S I [u1 u2] u4] u3] ObjTreeItem u1 u2 u4] I
*
* \return 0
**/
fun cbEdCtrlTreeClick(tree, p, item, x, y, btn)=
let p -> [ctrlstr cbfun] in
let ctrlstr.EDC_tree -> [tree [litems lsitems bmplist _] pitem _ cbselfun] in
let switch litems item -> itemstr in
(
//let cbSelect manage selection on btn 1
if (btn == 1) then nil else
(
_CBtreeSelect tree @cbEdCtrlTreeSelect [ctrlstr nil];
_SELtreeItem tree item;
_CBtreeSelect tree @cbEdCtrlTreeSelect [ctrlstr cbselfun];
);
exec cbfun with [ctrlstr itemstr.EDTITEM_father itemstr itemstr.EDTITEM_sValue itemstr.EDTITEM_iType [x y] btn];
);
0;;
/*! \brief Callback on a tree item expand
*
* Private
*
* Prototype: fun [ObjTree [EdControl fun [EdControl EdTreeItem EdTreeItem S I u1 u2] u3] ObjTreeItem u1 u2 u4] I
*
* \return 0
**/
fun cbEdCtrlTreeExpand(tree, p, item, state)=
let p -> [ctrlstr cbfun] in
let ctrlstr.EDC_tree -> [tree [litems lsitems bmplist _] pitem _ cbselfun] in
let switch litems item -> itemstr in
(
set itemstr.EDTITEM_iState = state;
exec cbfun with [ctrlstr itemstr.EDTITEM_father itemstr itemstr.EDTITEM_sValue itemstr.EDTITEM_iType state];
);
0;;
/*! @ingroup g2dTree
* \brief Define the tree item expand callback
*
* Prototype: fun [EdControl fun [EdControl EdTreeItem EdTreeItem S I I I] u0] I
*
* \param EdControl : tree control structure
* \param fun [EdControl EdTreeItem EdTreeItem S I I I I] u0: callback function
* \param - EdControl : tree control structure
* \param - EdTreeItem : item father
* \param - EdTreeItem : clicked item
* \param - S : item value
* \param - I : item type
* \param - I : state
*
* \return 0
**/
fun setEdCtrlTreeCbExpand(ctrlstr, cbfun)=
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
_CBtreeExpand tree @cbEdCtrlTreeExpand [ctrlstr cbfun];
0;;
/*! @ingroup g2dTree
* \brief Define the tree item right click callback
*
* Prototype: fun [EdControl fun [EdControl EdTreeItem EdTreeItem S I I I] u0] I
*
* \param EdControl : tree control structure
* \param fun [EdControl EdTreeItem EdTreeItem S I I I] u0: callback function
* \param - EdControl : tree control structure
* \param - EdTreeItem : item father
* \param - EdTreeItem : clicked item
* \param - S : item value
* \param - I : item type
* \param - I : click X coordinate
* \param - I : click Y coordinate
*
* \return 0
**/
fun setEdCtrlTreeCbRclick(ctrlstr, cbfun)=
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
_CBtreeRClick tree @cbEdCtrlTreeRclick [ctrlstr cbfun];
0;;
/*! @ingroup g2dTree
* \brief Define the tree item click callback
*
* Prototype: fun [EdControl fun [EdControl EdTreeItem EdTreeItem S I [I I] I] u0] I
*
* \param EdControl : tree control structure
* \param fun [EdControl EdTreeItem EdTreeItem S I I I] u0: callback function
* \param - EdControl : tree control structure
* \param - EdTreeItem : item father
* \param - EdTreeItem : clicked item
* \param - S : item value
* \param - I : item type
* \param - [I I] : click X coordinate
* \param - I : btn
*
* \return 0
**/
fun setEdCtrlTreeCbClick(ctrlstr, cbfun)=
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
_CBtreeRClick tree @cbEdCtrlTreeClick [ctrlstr cbfun];
0;;
/*! \brief Callback on a tree item key down event
*
* Private
*
* Prototype: fun [ObjTree [EdControl fun [EdControl EdTreeItem EdTreeItem S I u1 u2] u3] u1 u2] I
*
* \return 0
**/
fun cbEdCtrlTreeKeyDown(tree, p, key, code) =
let p -> [ctrlstr cbfun] in
let ctrlstr.EDC_tree -> [tree [litems lsitems bmplist _] itemstr previtem cbselfun] in
(
exec cbfun with [ctrlstr itemstr.EDTITEM_father itemstr itemstr.EDTITEM_sValue itemstr.EDTITEM_iType key code];
);
0;;
/*! @ingroup g2dTree
* \brief Define the tree item key down callback
*
* Prototype: fun [EdControl fun [EdControl EdTreeItem EdTreeItem S I I I] u0] I
*
* \param EdControl : tree control structure
* \param fun [EdControl EdTreeItem EdTreeItem S I I I] u0
* \param - EdControl : tree control structure
* \param - EdTreeItem : item father
* \param - EdTreeItem : clicked item
* \param - S : item value
* \param - I : item type
* \param - I : key
* \param - I : key code
*
* \return 0
**/
fun setEdCtrlTreeCbKeyDown(ctrlstr, cbfun)=
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
_CBtreeKeyDown tree @cbEdCtrlTreeKeyDown [ctrlstr cbfun];
0;;
/*! \brief Callback on a tree item key up event
*
* Private
*
* Prototype: fun [ObjTree [EdControl fun [EdControl EdTreeItem EdTreeItem S I u1] u2] u1] I
*
* \return 0
**/
fun cbEdCtrlTreeKeyUp(tree, p, key) =
let p -> [ctrlstr cbfun] in
let ctrlstr.EDC_tree -> [tree [litems lsitems bmplist _] itemstr _ cbselfun] in
(
exec cbfun with [ctrlstr itemstr.EDTITEM_father itemstr itemstr.EDTITEM_sValue itemstr.EDTITEM_iType key];
);
0;;
/*! @ingroup g2dTree
* \brief Define the tree item key down callback
*
* Prototype: fun [EdControl fun [EdControl EdTreeItem EdTreeItem S I I] u0] I
*
* \param EdControl : tree control structure
* \param fun [EdControl EdTreeItem EdTreeItem S I I] u0
* \param - EdControl : tree control structure
* \param - EdTreeItem : item father
* \param - EdTreeItem : clicked item
* \param - S : item value
* \param - I : item type
* \param - I : key
*
* \return 0
**/
fun setEdCtrlTreeCbKeyUp(ctrlstr, cbfun)=
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
_CBtreeKeyUp tree @cbEdCtrlTreeKeyUp [ctrlstr cbfun];
0;;
/*! @ingroup g2dTree
* \brief Expand a tree
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : tree control structure
* \param I : 1 to expand, 0 to retract
*
* \return 0
**/
fun setEdCtrlTreeExpandAll(ctrlstr, mode)=
let ctrlstr.EDC_tree -> [tree [litems lsitems bmplist _] _ _ _] in
let sizelist litems -> size in
let 0 -> i in
while i < size do
(
let nth_list litems i -> [item itemstr] in
(
_SETtreeItemState tree item mode;
set itemstr.EDTITEM_iState = mode;
);
set i = i + 1;
);
0;;
/*! @ingroup g2dTree
* \brief Expand a tree item
*
* Prototype: fun [EdControl EdTreeItem I I] I
*
* \param EdControl : tree control structure
* \param EdTreeItem : item
* \param I : 1 to expand, 0 to retract
* \param I : 1 to apply on children, 0 otherwise
*
* \return 0
**/
fun setEdCtrlTreeExpandItem(ctrlstr, itemstr, mode, children)=
let ctrlstr.EDC_tree -> [tree [litems lsitems bmplist _] _ _ _] in
(
_SETtreeItemState tree itemstr.EDTITEM_item mode;
set itemstr.EDTITEM_iState = mode;
if (!children) then nil else
let sizelist itemstr.EDTITEM_lSons -> size in
let 0 -> i in
while i < size do
(
let nth_list itemstr.EDTITEM_lSons i -> childstr in
setEdCtrlTreeExpandItem ctrlstr childstr mode children;
set i = i + 1;
);
);
0;;
/******************************************
Tree items functions
*******************************************/
/*! @ingroup g2dTree
* \brief Add an item to a tree
*
* Prototype: fun [EdControl EdTreeItem S S I S] EdTreeItem
*
* \param EdControl : tree control structure
* \param EdTreeItem : father item, nil for root
* \param S : item label
* \param S : item value
* \param I : item type
* \param S : item bitmap path
*
* \return 0
**/
fun addEdCtrlTreeItem(ctrlstr, father, name, val, type, bitmappath)=
let ctrlstr.EDC_tree -> [tree treeparams _ _ _] in
let treeparams -> [litems lsitems bmplist lbmp] in
let _ADDtreeChild tree father.EDTITEM_item TREE_INSERT_LAST name -> item in
let switchstri lbmp bitmappath -> bmpidx in
let if (bitmappath == nil) || (bmpidx != nil) then nil else G2DloadBmp ctrlstr.EDC_channel bitmappath -> bitmap in
let if bmpidx != nil then bmpidx else if bitmap == nil then nil else let (_ADDbitmapList bmplist bitmap) -> bid in (mutate treeparams <- [_ _ _ [bitmappath bid]::lbmp]; bid;) -> bmpidx in
let mkEdTreeItem [item name val type 0 father bmpidx nil] -> itemstr in
(
if father == nil then nil else
set father.EDTITEM_lSons = itemstr::father.EDTITEM_lSons;
if (bmpidx == nil) then nil else
_SETtreeItemBitmap tree item bmpidx bmpidx;
mutate treeparams <- [([item itemstr]::litems) ([val itemstr]::lsitems) _ _];
itemstr;
);;
/*! @ingroup g2dTree
* \brief Remove all sons of a tree item
*
* Prototype: fun [EdControl EdTreeItem] I
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item
*
* \return 0
**/
fun removeEdCtrlTreeSons(ctrlstr, item)=
if item == nil then nil else
(
while item.EDTITEM_lSons != nil do
(
let hd item.EDTITEM_lSons -> sonstr in
removeEdCtrlTreeSons ctrlstr sonstr;
set item.EDTITEM_lSons = tl item.EDTITEM_lSons;
);
let ctrlstr.EDC_tree -> [tree treeparams _ _ _] in
let treeparams -> [litems lsitems _ _] in
mutate treeparams <- [(G2DremoveEdIdxFromList litems item.EDTITEM_item) (G2DremoveEdSidFromListi lsitems item.EDTITEM_sValue) _ _];
);
0;;
/*! @ingroup g2dTree
* \brief Remove a tree item and all it's sons
*
* Prototype: fun [EdControl EdTreeItem] I
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item to remove
*
* \return 0
**/
fun delEdCtrlTreeItem(ctrlstr, item)=
if item == nil then nil else
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
(
removeEdCtrlTreeSons ctrlstr item;
set item.EDTITEM_father.EDTITEM_lSons = G2DremoveFromList item.EDTITEM_father.EDTITEM_lSons item;
_DStreeItem tree item.EDTITEM_item;
);
0;;
/*! @ingroup g2dTree
* \brief Refresh the sons of a tree item
*
* Prototype: fun [EdControl EdTreeItem I] I
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item
* \param I : 1 to sort the items, 0 otherwise
*
* \return 0
**/
fun refreshEdCtrlTreeSons(ctrlstr, item, sort)=
if item == nil then nil else
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
let item.EDTITEM_item -> olditem in
let _ADDtreeChild tree item.EDTITEM_father.EDTITEM_item sort item.EDTITEM_sLabel -> nitem in
(
if (item.EDTITEM_bmpIdx == nil) then nil else
_SETtreeItemBitmap tree nitem item.EDTITEM_bmpIdx item.EDTITEM_bmpIdx;
set item.EDTITEM_item = nitem;
let ctrlstr.EDC_tree -> [_ treeparams _ _ _] in
let treeparams -> [litems lsitems _ _] in
mutate treeparams <- [[item.EDTITEM_item item]::(G2DremoveEdIdxFromList litems olditem) _ _ _];
let item.EDTITEM_lSons -> l in
while l != nil do
(
let hd l -> sonstr in
refreshEdCtrlTreeSons ctrlstr sonstr TREE_INSERT_FIRST;
set l = tl l;
);
_SETtreeItemState tree item.EDTITEM_item item.EDTITEM_iState;
);
0;;
/*! @ingroup g2dTree
* \brief Change an item type
*
* Prototype: fun [EdControl EdTreeItem I] I
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item
* \param I : the new item type
*
* \return 0
**/
fun setEdCtrlTreeType(ctrlstr, item, type)=
if item == nil then nil else
set item.EDTITEM_iType = type;
0;;
/*! @ingroup g2dTree
* \brief Change an item value
*
* Prototype: fun [EdControl EdTreeItem S] I
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item
* \param S : the new item value
*
* \return 0
**/
fun setEdCtrlTreeValue(ctrlstr, item, value)=
if item == nil then nil else
set item.EDTITEM_sValue = value;
0;;
/*! @ingroup g2dTree
* \brief Change an item label
*
* Prototype: fun [EdControl EdTreeItem S] I
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item
* \param S : the new item label
*
* \return 0
**/
fun setEdCtrlTreeLabel(ctrlstr, item, val)=
if item == nil then nil else
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
(
set item.EDTITEM_sLabel = val;
_SETtreeItemLabel tree item.EDTITEM_item item.EDTITEM_sLabel;
);
0;;
/*! @ingroup g2dTree
* \brief Move a tree item to a new father
*
* Prototype: fun [EdControl EdTreeItem EdTreeItem] I
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item to move
* \param EdTreeItem : new father
*
* \return 0
**/
fun moveEdCtrlTreeItem(ctrlstr, item, father)=
let item.EDTITEM_item -> olditem in
let item.EDTITEM_father -> oldfather in
let ctrlstr.EDC_tree -> [tree treeparams _ _ _] in
let treeparams -> [litems lsitems _ _] in
(
set item.EDTITEM_father = father;
set item.EDTITEM_father.EDTITEM_lSons = item::item.EDTITEM_father.EDTITEM_lSons;
set oldfather.EDTITEM_lSons = G2DremoveFromList oldfather.EDTITEM_lSons item;
refreshEdCtrlTreeSons ctrlstr item TREE_INSERT_LAST;
_DStreeItem tree olditem;
);
0;;
/*! @ingroup g2dTree
* \brief Move a tree item to a new position from a node
*
* Prototype: fun [EdControl EdTreeItem EdTreeItem] I
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item to move
* \param EdTreeItem : node position
*
* \return 0
**/
fun changeEdCtrlTreeItemPos(ctrlstr, item, itempos)=
let item.EDTITEM_item -> olditem in
let item.EDTITEM_father -> oldfather in
let ctrlstr.EDC_tree -> [tree treeparams _ _ _] in
let treeparams -> [litems lsitems _ _] in
(
set oldfather.EDTITEM_lSons = G2DremoveFromList oldfather.EDTITEM_lSons item;
set item.EDTITEM_father = itempos.EDTITEM_father;
let pos_in_list itempos.EDTITEM_father.EDTITEM_lSons itempos 0 -> npos in
set item.EDTITEM_father.EDTITEM_lSons = add_nth_in_list item.EDTITEM_father.EDTITEM_lSons npos item;
_DStreeItem tree item.EDTITEM_father.EDTITEM_item;
let getEdCtrlTreeRootItem ctrlstr -> rootitem in
(
_DStreeItem tree rootitem.EDTITEM_item;
refreshEdCtrlTreeSons ctrlstr rootitem TREE_INSERT_LAST;
);
_SELtreeItem tree item.EDTITEM_item;
);
0;;
/*! @ingroup g2dTree
* \brief Set a tree item bitmap
*
* Prototype: fun [EdControl EdTreeItem S] EdTreeItem
*
* \param EdControl : tree control structure
* \param EdTreeItem : item
* \param S : item bitmap path
*
* \return 0
**/
fun setEdCtrlTreeItemBitmap(ctrlstr, itemstr, bitmappath)=
let ctrlstr.EDC_tree -> [tree treeparams _ _ _] in
let treeparams -> [litems lsitems bmplist lbmp] in
let switchstri lbmp bitmappath -> bmpidx in
let if (bitmappath == nil) || (bmpidx != nil) then nil else G2DloadBmp ctrlstr.EDC_channel bitmappath -> bitmap in
let if bmpidx != nil then bmpidx else if bitmap == nil then nil else let (_ADDbitmapList bmplist bitmap) -> bid in (mutate treeparams <- [_ _ _ [bitmappath bid]::lbmp]; bid;) -> bmpidx in
(
set itemstr.EDTITEM_bmpIdx = bmpidx;
if (bmpidx == nil) then nil else
_SETtreeItemBitmap tree itemstr.EDTITEM_item bmpidx bmpidx;
);
0;;
/*! @ingroup g2dTree
* \brief Resize a tree control
*
* Prototype: fun [EdControl I I I I] ObjTree
*
* \param EdControl : tree control structure
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
*
* \return ObjTree
**/
fun sizeEdCtrlTree(ctrlstr, x, y, w, h)=
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
(
_SIZEtree tree w h x y;
);;
/*! @ingroup g2dTree
* \brief Get a tree item by it's value
*
* Prototype: fun [EdControl S] EdTreeItem
*
* \param EdControl : tree control structure
* \param S : the item value
*
* \return EdTreeItem : nil
**/
fun getEdCtrlTreeItemByValue(ctrlstr, val)=
let ctrlstr.EDC_tree -> [tree [litems lsitems bmplist _] _ _ _] in
switchstri lsitems val;;
/*! @ingroup g2dTree
* \brief Get a tree item label
*
* Prototype: fun [EdControl EdTreeItem] S
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item
*
* \return S : item label
**/
fun getEdCtrlTreeLabelByItem(ctrlstr, item)= item.EDTITEM_sLabel;;
/*! @ingroup g2dTree
* \brief Get a tree item value and type
*
* Prototype: fun [EdControl EdTreeItem] [S I]
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item
*
* \return [S I] : item value, item type
**/
fun getEdCtrlTreeValueByItem(ctrlstr, item)= [item.EDTITEM_sValue item.EDTITEM_iType];;
/*! @ingroup g2dTree
* \brief Get a tree item father, value and type
*
* Prototype: fun [EdControl EdTreeItem] [EdTreeItem S I]
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item
*
* \return [EdTreeItem S I] : item father, item value, item type
**/
fun getEdCtrlTreeFullValuesByItem(ctrlstr, item)= [item.EDTITEM_father item.EDTITEM_sValue item.EDTITEM_iType];;
/*! @ingroup g2dTree
* \brief Get a tree item father, value and type, by an item value
*
* Prototype: fun [EdControl S] [EdTreeItem S I]
*
* \param EdControl : tree control structure
* \param S : value to search
*
* \return [EdTreeItem S I] : item father, item value, item type, or nil if not found
**/
fun getEdCtrlTreeFullValuesByValue(ctrlstr, val)=
let getEdCtrlTreeItemByValue ctrlstr val -> item in
[item.EDTITEM_father item.EDTITEM_sValue item.EDTITEM_iType];;
/*! @ingroup g2dTree
* \brief Get the brothers of a tree item
*
* Prototype: fun [EdControl EdTreeItem] [EdTreeItem r1]
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item
*
* \return [EdTreeItem r1] : list of item brothers
**/
fun getEdCtrlTreeBrothers(ctrlstr, item)= G2DremoveFromList item.EDTITEM_lSons item;;
/*! @ingroup g2dTree
* \brief Select a tree item by it's value
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : tree control structure
* \param S : item value
*
* \return 0
**/
fun selEdCtrlTreeItemByValue(ctrlstr, val)=
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
let getEdCtrlTreeItemByValue ctrlstr val -> item in
_SELtreeItem tree item.EDTITEM_item;
0;;
/*! @ingroup g2dTree
* \brief Select a tree item
*
* Prototype: fun [EdControl EdTreeItem] I
*
* \param EdControl : tree control structure
* \param EdTreeItem : tree item
*
* \return 0
**/
fun selEdCtrlTreeItem(ctrlstr, item)=
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
_SELtreeItem tree item.EDTITEM_item;
0;;
/*! @ingroup g2dTree
* \brief Enable or disable a tree control
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : tree control structure
* \param I : state, 0 to disable, 1 to enable
*
* \return 0
**/
fun setEdCtrlTreeEnable(ctrlstr, state)=
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
_ENtree tree state;
0;;
fun getEdCtrlTreeItems(ctrlstr)=
let ctrlstr.EDC_tree -> [_ treeparams _ _ _] in
let treeparams -> [_ lsitems _ _] in
lsitems;;
fun cpEdCtrlTreeItems(ctrlstr1, item1, ctrlstr2, father2)=
let ctrlstr1.EDC_tree -> [_ treeparams1 _ _ _] in
let ctrlstr2.EDC_tree -> [tree treeparams2 _ _ _] in
let treeparams1 -> [_ _ _ lbmp1] in
let treeparams2 -> [litems lsitems _ lbmp2] in
let _ADDtreeChild tree father2.EDTITEM_item TREE_INSERT_LAST item1.EDTITEM_sLabel -> nitem in
let switchInv lbmp1 item1.EDTITEM_bmpIdx -> bmppath in
let switchstri lbmp2 bmppath -> bmpidx in
let mkEdTreeItem [nitem item1.EDTITEM_sLabel item1.EDTITEM_sValue item1.EDTITEM_iType item1.EDTITEM_iState father2 bmpidx nil] -> itemstr in
(
if father2 == nil then nil else
set father2.EDTITEM_lSons = itemstr::father2.EDTITEM_lSons;
if (bmpidx == nil) then nil else
_SETtreeItemBitmap tree nitem bmpidx bmpidx;
mutate treeparams2 <- [([nitem itemstr]::litems) ([item1.EDTITEM_sValue itemstr]::lsitems) _ _];
let revertlist item1.EDTITEM_lSons -> l in
while l != nil do
(
let hd l -> sonstr in
cpEdCtrlTreeItems ctrlstr1 sonstr ctrlstr2 itemstr;
set l = tl l;
);
_SETtreeItemState tree nitem itemstr.EDTITEM_iState;
);
0;;
fun cpEdCtrlTreeContent(ctrlstr1, ctrlstr2)=
let ctrlstr1.EDC_tree -> [_ treeparams1 _ _ _] in
let ctrlstr2.EDC_tree -> [_ treeparams2 _ _ _] in
let treeparams1 -> [_ lsitems _ lbmp1] in
(
// Copy bitmaps
let sizelist lbmp1 -> size in
let 0 -> i in
while i < size do
(
let nth_list lbmp1 i -> [bmppath bmpidx] in
let treeparams2 -> [_ _ bmplist2 lbmp2] in
let switchstri lbmp2 bmppath -> bmpidx in
let if (bmppath == nil) || (bmpidx != nil) then nil else G2DloadBmp ctrlstr2.EDC_channel bmppath -> bitmap in
if (bmpidx != nil) || (bitmap == nil) then nil else
let (_ADDbitmapList bmplist2 bitmap) -> bid in
mutate treeparams2 <- [_ _ _ [bmppath bid]::lbmp2];
set i = i + 1;
);
cpEdCtrlTreeItems ctrlstr1 (getEdCtrlTreeRootItem ctrlstr1) ctrlstr2 nil;
);
0;;
fun getEdCtrlTreeValidParent(ctrlstr, item)=
while ((item.EDTITEM_father != nil) && (item.EDTITEM_father.EDTITEM_item == nil)) do
set item = item.EDTITEM_father;
if (item.EDTITEM_father.EDTITEM_item == nil) then
getEdCtrlTreeRootItem ctrlstr
else
item.EDTITEM_father;;
fun applyEdCtrlTreeFilter(ctrlstr, item, filter)=
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
let getEdCtrlTreeRootItem ctrlstr -> rootitem in
let getEdCtrlTreeValidParent ctrlstr item -> parent in
let if ((rootitem == item) || ((filter != nil) && (strcmp filter "") && ((strfindi filter item.EDTITEM_sLabel 0) == nil))) then nil else _ADDtreeChild tree parent.EDTITEM_item TREE_INSERT_FIRST item.EDTITEM_sLabel -> nitem in
(
if (nitem == nil) then nil else
(
if (item.EDTITEM_bmpIdx == nil) then nil else
_SETtreeItemBitmap tree nitem item.EDTITEM_bmpIdx item.EDTITEM_bmpIdx;
set item.EDTITEM_item = nitem;
let ctrlstr.EDC_tree -> [_ treeparams _ _ _] in
let treeparams -> [litems _ _ _] in
mutate treeparams <- [[nitem item]::litems _ _ _];
);
let item.EDTITEM_lSons -> l in
while l != nil do
(
let hd l -> sonstr in
applyEdCtrlTreeFilter ctrlstr sonstr filter;
set l = tl l;
);
if (nitem == nil) then nil else
_SETtreeItemState tree nitem item.EDTITEM_iState;
);
0;;
/*! @ingroup g2dTree
* \brief Filter tree items
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : tree control structure
* \param S : keyword or nil
*
* \return 0
**/
fun setEdCtrlTreeFilter(ctrlstr, filter)=
let getEdCtrlTreeRootItem ctrlstr -> rootitem in
let ctrlstr.EDC_tree -> [tree treeparams _ _ _] in
let treeparams -> [litems lsitems bmplist lbmp] in
(
_DStreeItem tree rootitem.EDTITEM_item;
set rootitem.EDTITEM_item = nil;
let sizelist litems -> size in
let 0 -> i in
while i < size do
(
let nth_list litems i -> [item itemstr] in
(
_DStreeItem tree itemstr.EDTITEM_item;
set itemstr.EDTITEM_item = nil;
);
set i = i + 1;
);
// add root
let _ADDtreeChild tree nil TREE_INSERT_FIRST rootitem.EDTITEM_sLabel -> nitem in
(
if (rootitem.EDTITEM_bmpIdx == nil) then nil else
_SETtreeItemBitmap tree nitem rootitem.EDTITEM_bmpIdx rootitem.EDTITEM_bmpIdx;
set rootitem.EDTITEM_item = nitem;
set rootitem.EDTITEM_iState = 1;
);
mutate treeparams <- [[rootitem.EDTITEM_item rootitem]::nil _ _ _];
applyEdCtrlTreeFilter ctrlstr rootitem filter;
_SETtreeItemState tree rootitem.EDTITEM_item rootitem.EDTITEM_iState;
);
0;;
/*! @ingroup g2dTree
* \brief Reset a tree control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : tree control structure
*
* \return 0
**/
fun resetEdCtrlTree(ctrlstr)=
let ctrlstr.EDC_tree -> [tree treeparams _ _ _] in
let treeparams -> [litems lsitems bmplist lbmp] in
let getEdCtrlTreeRootItem ctrlstr -> rootitem in
(
_DStreeItem tree rootitem.EDTITEM_item;
set rootitem.EDTITEM_item = nil;
let sizelist litems -> size in
let 0 -> i in
while i < size do
(
let nth_list litems i -> [item itemstr] in
_DStreeItem tree itemstr.EDTITEM_item;
set i = i + 1;
);
let sizelist lbmp -> size in
let 0 -> i in
while i < size do
(
let nth_list lbmp i -> [_ bmpidx] in
_DELbitmapFromList bmplist bmpidx;
set i = i + 1;
);
mutate treeparams <- [nil nil _ nil];
mutate ctrlstr.EDC_tree <- [_ _ nil nil _];
);
0;;
/*! @ingroup g2dTree
* \brief Create a tree control
*
* Prototype: fun [EdWindow I I I I I] EdControl
*
* \param EdWindow : parent control window
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : resize flags
*
* \return EdControl
**/
fun crEdCtrlTree(winstr, x, y, w, h, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRtree ctrlstr.EDC_channel father x y w h TV_BORDER|TV_VSCROLL|TV_HSCROLL|TV_BUTTON -> tree in
let _CRbitmapList ctrlstr.EDC_channel 16 16 -> bmplist in
(
set ctrlstr.EDC_tree = [tree [nil nil bmplist nil] nil nil nil];
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
_SETtreeBitmaps tree bmplist;
_CBtreeDClick tree @cbEdCtrlTreeDbClick [ctrlstr nil];
_CBtreeSelect tree @cbEdCtrlTreeSelect [ctrlstr nil];
_CBtreeRClick tree @cbEdCtrlTreeRclick [ctrlstr nil];
_CBtreeExpand tree @cbEdCtrlTreeExpand [ctrlstr nil];
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2dTree
* \brief Destroy a tree control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : tree control structure
*
* \return 0
**/
fun dsEdCtrlTree(ctrlstr)=
resetEdCtrlTree ctrlstr;
let ctrlstr.EDC_tree -> [tree [litems lsitems bmplist _] _ _ _] in
(
_DStree tree;
_DSbitmapList bmplist;
);
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control Advanced bitmap list
/ ********************************************************************************************* */
/*! \brief Callback on a bitmap list control cursor move
*
* Private
*
* Prototype: fun [CompBitmap EdControl I I I] I
*
* \return 0
**/
fun cbEdCtrlBitmapListCursorMove(cmpbmp, ctrlstr, x, y, mask)=
0;;
/*! \brief Callback on a bitmap list control resize
*
* Private
*
* Prototype: fun [CompBitmap EdControl I I] I
*
* \return 0
**/
fun cbEdCtrlBitmapListResize(cmpbmp, ctrlstr, w, h)=
0;;
fun selectEdCtrlBitmapList(ctrlstr, pos)=
let ctrlstr.EDC_bitmapList -> [cont marge w h lval _ _] in
let G2DcrFont ctrlstr.EDC_channel 10 0 FF_PIXEL "Arial" -> font in
(
let sizelist lval -> size in
let 0 -> i in
while i < size do
(
let nth_list lval i -> [epos [bglayer _ _ name _]] in
(
if epos == pos then
G2DsetLayer ctrlstr.EDC_channel bglayer w h 1 0xf3718a 0xff98ab 80
else
G2DsetLayer ctrlstr.EDC_channel bglayer w h 0 0xffffff 0xffffff 100;
let _GETalphaBitmaps bglayer -> [tbmp _] in
_DRAWtext tbmp font (w / 2) h-marge TD_CENTER|TD_BOTTOM 0x000000 name;
);
set i = i + 1;
);
_DSfont font;
_PAINTcontainer cont;
);
0;;
fun getEdCtrlBitmapListValbyPos(ctrlstr, pos)=
let ctrlstr.EDC_bitmapList -> [_ _ _ _ lval _ _] in
let switch lval pos -> [_ _ _ _ val] in
val;;
fun cbEdCtrlBitmapListClick(cmpbmp, param, x, y, btn, mask)=
let param -> [ctrlstr pos] in
let ctrlstr.EDC_bitmapList -> [_ _ _ _ lval cbfun _] in
let switch lval pos -> [_ _ _ _ val] in
(
exec cbfun with [ctrlstr val btn mask];
selectEdCtrlBitmapList ctrlstr pos;
);
0;;
fun cbEdCtrlBitmapListDbClick(cmpbmp, param, x, y, btn, mask)=
let param -> [ctrlstr pos] in
let ctrlstr.EDC_bitmapList -> [_ _ _ _ lval _ cbfun] in
let switch lval pos -> [_ _ _ _ val] in
(
exec cbfun with [ctrlstr val btn mask];
selectEdCtrlBitmapList ctrlstr pos;
);
0;;
fun refreshEdCtrlBitmapListBitmap(ctrlstr)=
let ctrlstr.EDC_bitmapList -> [cont marge w h lval _ _] in
(
let _GETcontainerPositionSize cont -> [_ _ cw ch] in
let cw / w -> nbw in
let sizelist lval -> size in
let 0 -> i in
while i < size do
(
let (mod i nbw) * w -> lx in
let (i / nbw) * h -> ly in
let nth_list lval i -> [epos [_ cbmpback _ _ _]] in
(
_CHANGEobjNodeCoordinates (_CONVERTcompBitmapToObjNode cbmpback) [lx ly] 0;
);
set i = i + 1;
);
_PAINTcontainer cont;
);
0;;
fun setEdCtrlBitmapListBitmap(ctrlstr, pos, bmppath)=
let ctrlstr.EDC_bitmapList -> [cont marge w h lval _ _] in
let switch lval pos -> [bglayer cbmpback ocbmp name val] in
(
_DScompBitmap ocbmp;
let G2DstrechBitmap ctrlstr.EDC_channel G2DloadBmp ctrlstr.EDC_channel bmppath w-(marge*2) h-(marge*2)-20 0xffffff -> bmp in
let _CRalphaBitmap ctrlstr.EDC_channel bmp nil nil nil -> abmp in
let _CRcompBitmap ctrlstr.EDC_channel cont (_CONVERTcompBitmapToObjNode cbmpback) [marge marge] OBJ_ENABLE|OBJ_VISIBLE nil abmp 0 0 w h -> cbmp in
(
_DSbitmap bmp;
_CBcompBitmapClick cbmp @cbEdCtrlBitmapListClick [ctrlstr pos];
_CBcompBitmapDblClick cbmp @cbEdCtrlBitmapListDbClick [ctrlstr pos];
_CBcompBitmapCursorMove cbmp @cbEdCtrlBitmapListCursorMove [ctrlstr pos];
_CBcompBitmapResize cbmp @cbEdCtrlBitmapListResize [ctrlstr pos];
mutate ctrlstr.EDC_bitmapList <- [_ _ _ _ (G2Dlcat (G2DremoveEdIdxFromList lval pos) [pos [bglayer cbmpback cbmp name val]]::nil) _ _];
0;
);
_PAINTcontainer cont;
);
0;;
fun setEdCtrlBitmapListCbClick(ctrlstr, cbfun)=
mutate ctrlstr.EDC_bitmapList <- [_ _ _ _ _ cbfun _];
0;;
fun setEdCtrlBitmapListCbDbClick(ctrlstr, cbfun)=
mutate ctrlstr.EDC_bitmapList <- [_ _ _ _ _ _ cbfun];
0;;
fun addEdCtrlBitmapList(ctrlstr, name, bmppath, val)=
let ctrlstr.EDC_bitmapList -> [cont marge w h lval _ _] in
let sizelist lval -> pos in
(
let _GETcontainerPositionSize cont -> [_ _ cw ch] in
let cw / w -> nbw in
let (mod pos nbw) * w -> lx in
let (pos / nbw) * h -> ly in
let G2DcreateLayer ctrlstr.EDC_channel w h 0 0xffffff 0xffffff 100 -> bglayer in
let G2DstrechBitmap ctrlstr.EDC_channel G2DloadBmp ctrlstr.EDC_channel bmppath w-(marge*2) h-(marge*2)-20 0xffffff -> bmp in
let _CRalphaBitmap ctrlstr.EDC_channel bmp nil nil nil -> abmp in
let _CRcompBitmap ctrlstr.EDC_channel cont nil [lx ly] OBJ_ENABLE|OBJ_VISIBLE nil bglayer 0 0 w h -> cbmpback in
let _CRcompBitmap ctrlstr.EDC_channel cont (_CONVERTcompBitmapToObjNode cbmpback) [marge marge] OBJ_ENABLE|OBJ_VISIBLE nil abmp 0 0 w h -> cbmp in
let _GETalphaBitmaps bglayer -> [tbmp _] in
let G2DcrFont ctrlstr.EDC_channel 10 0 FF_PIXEL "Arial" -> font in
(
_DRAWtext tbmp font (w / 2) h-marge TD_CENTER|TD_BOTTOM 0x000000 name;
_DSfont font;
_DSbitmap bmp;
_CBcompBitmapClick cbmpback @cbEdCtrlBitmapListClick [ctrlstr pos];
_CBcompBitmapDblClick cbmpback @cbEdCtrlBitmapListDbClick [ctrlstr pos];
_CBcompBitmapCursorMove cbmpback @cbEdCtrlBitmapListCursorMove [ctrlstr pos];
_CBcompBitmapResize cbmpback @cbEdCtrlBitmapListResize [ctrlstr pos];
_CBcompBitmapClick cbmp @cbEdCtrlBitmapListClick [ctrlstr pos];
_CBcompBitmapDblClick cbmp @cbEdCtrlBitmapListDbClick [ctrlstr pos];
_CBcompBitmapCursorMove cbmp @cbEdCtrlBitmapListCursorMove [ctrlstr pos];
_CBcompBitmapResize cbmp @cbEdCtrlBitmapListResize [ctrlstr pos];
mutate ctrlstr.EDC_bitmapList <- [_ _ _ _ (G2Dlcat lval [pos [bglayer cbmpback cbmp name val]]::nil) _ _];
);
_PAINTcontainer cont;
pos;
);;
fun resetEdCtrlBitmapList(ctrlstr)=
let ctrlstr.EDC_bitmapList -> [cont marge w h lval _ _] in
(
let sizelist lval -> size in
let 0 -> i in
while i < size do
(
let nth_list lval i -> [_ [bglayer cbmpback cbmp _ _]] in
(
_DScompBitmap cbmpback;
_DScompBitmap cbmp;
_DSalphaBitmap bglayer;
);
set i = i + 1;
);
mutate ctrlstr.EDC_bitmapList <- [cont _ _ _ nil _ _];
_PAINTcontainer cont;
);
0;;
fun setEdCtrlBitmapListElemSize(ctrlstr, w, h, marge)=
mutate ctrlstr.EDC_bitmapList <- [_ marge w h _ _ _];
0;;
fun cbEdCtrlBitmapListSize(cont, ctrlstr, state, w, h)=
refreshEdCtrlBitmapListBitmap ctrlstr;
0;;
fun crEdCtrlBitmapList(winstr, x, y, w, h, bw, bh, marge, resize) =
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRcontainerFromObjWin ctrlstr.EDC_channel father x y w h CO_CHILDINSIDE 0xffffff "" -> cont in
(
set ctrlstr.EDC_bitmapList = [cont marge bw bh nil nil nil];
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
_CBcontainerSize cont @cbEdCtrlBitmapListSize ctrlstr;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
_PAINTcontainer cont;
ctrlstr;
);;
fun dsEdCtrlBitmapList(ctrlstr)=
resetEdCtrlBitmapList ctrlstr;
let ctrlstr.EDC_bitmapList -> [cont _ _ _ _ _ _] in
_DScontainer cont;
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control Bitmap
/ ********************************************************************************************* */
/*! \brief Callback on a bitmap control resource resize
*
* Private
*
* Prototype: fun [CompBitmap EdControl I I [I I I I]] I
*
* \return 0
**/
fun cbEdCtrlBitmapResizeResource(cmpbmp, ctrlstr, w, h, oldval)=
let oldval -> [ox oy ow oh] in
let ctrlstr.EDC_bitmap -> [_ obmp _ bmpbase bmppath bgcolor split _ _] in
(
if (split != 0) then
(
let if bmppath == nil then
_CRalphaBitmap ctrlstr.EDC_channel (_FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgcolor) nil nil nil
else
G2DstrechAlphaBitmapExt ctrlstr.EDC_channel (G2DloadAlphaBmp ctrlstr.EDC_channel bmppath) w h (split >= 2) bgcolor split
-> abmp in
(
_DSalphaBitmap obmp;
mutate ctrlstr.EDC_bitmap <- [_ abmp _ _ _ _ _ _ _];
[abmp [ox oy w h]];
);
)
else
(
let if bmppath == nil && bmpbase == nil then
(_FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgcolor)
else if bmpbase != nil then
G2DstrechBitmap ctrlstr.EDC_channel bmpbase w h bgcolor
else
G2DstrechBitmap ctrlstr.EDC_channel G2DloadBmp ctrlstr.EDC_channel bmppath w h bgcolor
-> bmp in
let _CRalphaBitmap ctrlstr.EDC_channel bmp nil nil nil -> abmp in
(
_DSbitmap bmp;
_DSalphaBitmap obmp;
mutate ctrlstr.EDC_bitmap <- [_ abmp _ _ _ _ _ _ _];
[abmp [ox oy w h]];
);
);
);;
/*! \brief Callback on a bitmap control resource resize
*
* Private
*
* Prototype: fun [CompBitmap EdControl I I [I I I I] I] I
*
* \return 0
**/
fun cbEdCtrlBitmapResizeResourceExt(cmpbmp, ctrlstr, w, h, oldval)=
let oldval -> [ox oy ow oh] in
let ctrlstr.EDC_bitmap -> [_ obmp _ bmpbase bmppath bgcolor split _ _] in
let if bmppath == nil then
_CRalphaBitmap ctrlstr.EDC_channel (_FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgcolor) nil nil nil
else
G2DstrechAlphaBitmapExt ctrlstr.EDC_channel (G2DloadAlphaBmp ctrlstr.EDC_channel bmppath) w h (split >= 2) bgcolor split
-> abmp in
(
_DSalphaBitmap obmp;
mutate ctrlstr.EDC_bitmap <- [_ abmp _ _ _ _ _ _ _];
[abmp [ox oy w h]]
);;
/*! \brief Callback on a bitmap control resize
*
* Private
*
* Prototype: fun [CompBitmap EdControl I I] I
*
* \return 0
**/
fun cbEdCtrlBitmapResize(cmpbmp, ctrlstr, w, h)=
0;;
/*! \brief Callback on a bitmap control cursor click
*
* Private
*
* Prototype: fun [CompBitmap EdControl I I I I] I
*
* \return 0
**/
fun cbEdCtrlBitmapClick(cmpbmp, ctrlstr, x, y, btn, mask)=
let ctrlstr.EDC_bitmap -> [cont alphabmp ocbmp _ _ _ _ cbfun _] in
(
exec cbfun with [ctrlstr x y btn mask];
);
0;;
/*! @ingroup g2dBitmap
* \brief Define the bitmap control cursor click callback
*
* Prototype: fun [EdControl fun [EdControl I I I I] u0] I
*
* \param EdControl : bitmap control structure
* \param fun [EdControl I I I I] u0 : validation callback
* \param - EdControl : the same bitmap control structure
* \param - I : X coordinate in the bitmap
* \param - I : Y coordinate in the bitmap
* \param - I : Mouse button clicked. Can be any of LBUTTON, MBUTTON or RBUTTON
* \param - I : Mask. Can be a combination of any of MK_LBUTTON, MK_MBUTTON, MK_RBUTTON, MK_CONTROL and MK_SHIFT
*
* \return 0
**/
fun setEdCtrlBitmapCbClick(ctrlstr, cbfun)=
mutate ctrlstr.EDC_bitmap <- [_ _ _ _ _ _ _ cbfun _];
0;;
/*! \brief Callback on a bitmap control cursor move
*
* Private
*
* Prototype: fun [CompBitmap EdControl I I I I] I
*
* \return 0
**/
fun cbEdCtrlBitmapCursorMove(cmpbmp, ctrlstr, x, y, mask)=
let ctrlstr.EDC_bitmap -> [cont alphabmp ocbmp _ _ _ _ _ cbfun] in
(
exec cbfun with [ctrlstr x y mask];
);
0;;
/*! @ingroup g2dBitmap
* \brief Define the bitmap control cursor move callback
*
* Prototype: fun [EdControl fun [EdControl I I I] u0] I
*
* \param EdControl : bitmap control structure
* \param fun [EdControl I I I] u0 : validation callback
* \param - EdControl : the same bitmap control structure
* \param - I : X coordinate in the bitmap
* \param - I : Y coordinate in the bitmap
* \param - I : Mask. Can be a combination of any of MK_LBUTTON, MK_MBUTTON, MK_RBUTTON, MK_CONTROL and MK_SHIFT
*
* \return 0
**/
fun setEdCtrlBitmapCbCursorMove(ctrlstr, cbfun)=
mutate ctrlstr.EDC_bitmap <- [_ _ _ _ _ _ _ _ cbfun];
0;;
/*! @ingroup g2dBitmap
* \brief Set a bitmap control bitmap path
*
* Prototype: fun [EdControl S] I
*
* \param EdControl : bitmap control structure
* \param S : the new bitmap path
*
* \return 0
**/
fun setEdCtrlBitmap(ctrlstr, bmppath)=
let ctrlstr.EDC_bitmap -> [cont alphabmp ocbmp _ _ bgcolor split _ _] in
let _GETcontainerPositionSize cont -> [_ _ w h] in
(
_DScompBitmap ocbmp;
_DSalphaBitmap alphabmp;
let if bmppath == nil then
_CRalphaBitmap ctrlstr.EDC_channel (_FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgcolor) nil nil nil
else
G2DstrechAlphaBitmapExt ctrlstr.EDC_channel (G2DloadAlphaBmp ctrlstr.EDC_channel bmppath) w h (split >= 2) bgcolor split
-> abmp in
let _CRcompBitmap ctrlstr.EDC_channel cont nil [0 0] OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_CLICK|OBJ_CONTAINER_MOVE abmp 0 0 w h -> cbmp in
(
_CBcompBitmapCursorMove cbmp @cbEdCtrlBitmapCursorMove ctrlstr;
_CBcompBitmapClick cbmp @cbEdCtrlBitmapClick ctrlstr;
_CBcompBitmapResize cbmp @cbEdCtrlBitmapResize ctrlstr;
_CBcompBitmapResizeResource cbmp @cbEdCtrlBitmapResizeResource ctrlstr;
mutate ctrlstr.EDC_bitmap <- [_ abmp cbmp nil bmppath _ _ _ _];
0;
);
_PAINTcontainer cont;
);
0;;
/*! @ingroup g2dBitmap
* \brief Set a bitmap control bitmap
*
* Prototype: fun [EdControl ObjBitmap] I
*
* \param EdControl : bitmap control structure
* \param ObjBitmap : bitmap to use
*
* \return 0
**/
fun setEdCtrlBitmap2(ctrlstr, bmpbase)=
let ctrlstr.EDC_bitmap -> [cont alphabmp ocbmp _ _ _ split _ _] in
let _GETcontainerPositionSize cont -> [_ _ w h] in
(
_DScompBitmap ocbmp;
_DSalphaBitmap alphabmp;
let G2DstrechBitmap ctrlstr.EDC_channel bmpbase w h 0xffffff -> sbmp in
let _CRalphaBitmap ctrlstr.EDC_channel sbmp nil nil nil -> abmp in
let _CRcompBitmap ctrlstr.EDC_channel cont nil [0 0] OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_CLICK|OBJ_CONTAINER_MOVE abmp 0 0 w h -> cbmp in
(
if (sbmp == bmpbase) then nil else
_DSbitmap sbmp;
_CBcompBitmapCursorMove cbmp @cbEdCtrlBitmapCursorMove ctrlstr;
_CBcompBitmapClick cbmp @cbEdCtrlBitmapClick ctrlstr;
_CBcompBitmapResize cbmp @cbEdCtrlBitmapResize ctrlstr;
_CBcompBitmapResizeResource cbmp @cbEdCtrlBitmapResizeResource ctrlstr;
mutate ctrlstr.EDC_bitmap <- [_ abmp cbmp bmpbase nil _ _ _ _];
0;
);
_PAINTcontainer cont;
);
0;;
/*! @ingroup g2dBitmap
* \brief Set a bitmap8 on control bitmap
*
* Prototype: fun [EdControl ObjBitmap8] I
*
* \param EdControl : bitmap control structure
* \param ObjBitmap8 : bitmap to use
*
* \return 0
**/
fun setEdCtrlBitmap8(ctrlstr, bmp8)=
let ctrlstr.EDC_bitmap -> [cont alphabmp ocbmp _ _ _ split _ _] in
let _GETcontainerPositionSize cont -> [_ _ w h] in
(
_DScompBitmap ocbmp;
_DSalphaBitmap alphabmp;
let _GETbitmap8Size bmp8 -> [bw bh] in
let _SETbitmapBGR (_CRbitmap _channel bw bh) [bmp8 bmp8 bmp8] -> bmpbase in
let G2DstrechBitmap ctrlstr.EDC_channel bmpbase w h 0xffffff -> sbmp in
let _CRalphaBitmap ctrlstr.EDC_channel sbmp nil nil nil -> abmp in
let _CRcompBitmap ctrlstr.EDC_channel cont nil [0 0] OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_CLICK|OBJ_CONTAINER_MOVE abmp 0 0 w h -> cbmp in
(
_DSbitmap bmpbase;
_DSbitmap sbmp;
_CBcompBitmapCursorMove cbmp @cbEdCtrlBitmapCursorMove ctrlstr;
_CBcompBitmapClick cbmp @cbEdCtrlBitmapClick ctrlstr;
_CBcompBitmapResize cbmp @cbEdCtrlBitmapResize ctrlstr;
_CBcompBitmapResizeResource cbmp @cbEdCtrlBitmapResizeResource ctrlstr;
mutate ctrlstr.EDC_bitmap <- [_ abmp cbmp nil nil _ _ _ _];
0;
);
_PAINTcontainer cont;
);
0;;
/*! @ingroup g2dBitmap
* \brief Get a bitmap control buffer
*
* Prototype: fun [EdControl] ObjBitmap
*
* \param EdControl : bitmap control structure
*
* \return ObjBitmap : the bitmap buffer
**/
fun getEdCtrlBitmapBuffer(ctrlstr)=
let ctrlstr.EDC_bitmap -> [cont alphabmp ocbmp _ _ _ _ _ _] in
let _GETalphaBitmaps alphabmp -> [buffer _ ] in
buffer;;
/*! @ingroup g2dBitmap
* \brief Set a bitmap control background color
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : bitmap control structure
* \param I : the RGB background color
*
* \return 0
**/
fun setEdCtrlBitmapColor(ctrlstr, bgcolor)=
let ctrlstr.EDC_bitmap -> [cont alphabmp ocbmp _ _ _ _ _ _] in
let _GETcontainerPositionSize cont -> [_ _ w h] in
(
_DScompBitmap ocbmp;
_DSalphaBitmap alphabmp;
let _FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgcolor -> bmp in
let _CRalphaBitmap ctrlstr.EDC_channel bmp nil nil nil -> abmp in
let _CRcompBitmap ctrlstr.EDC_channel cont nil [0 0] OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_CLICK|OBJ_CONTAINER_MOVE abmp 0 0 w h -> cbmp in
(
_DSbitmap bmp;
_CBcompBitmapCursorMove cbmp @cbEdCtrlBitmapCursorMove ctrlstr;
_CBcompBitmapClick cbmp @cbEdCtrlBitmapClick ctrlstr;
_CBcompBitmapResize cbmp @cbEdCtrlBitmapResize ctrlstr;
_CBcompBitmapResizeResource cbmp @cbEdCtrlBitmapResizeResource ctrlstr;
mutate ctrlstr.EDC_bitmap <- [_ abmp cbmp _ _ bgcolor _ _ _];
0;
);
_PAINTcontainer cont;
);
0;;
/*! @ingroup g2dBitmap
* \brief Paint a bitmap control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : bitmap control structure
*
* \return 0
**/
fun paintEdCtrlBitmap(ctrlstr)=
let ctrlstr.EDC_bitmap -> [cont _ _ _ _ _ _ _ _] in
_PAINTcontainer cont;
0;;
/*! @ingroup g2dBitmap
* \brief Create a bitmap control
*
* Prototype: fun [EdWindow I I I I S I I] EdControl
*
* \param EdWindow : parent control window
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param S : the bitmap path, use nil for plain color
* \param I : RGB background color
* \param I : resize flags
*
* \return EdControl
**/
fun crEdCtrlBitmap(winstr, x, y, w, h, bmppath, bgcolor, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRcontainerFromObjWin ctrlstr.EDC_channel father x y w h CO_CHILDINSIDE|CO_NOBORDER bgcolor "" -> cont in
let if bmppath == nil then _CRalphaBitmap ctrlstr.EDC_channel (_FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgcolor) nil nil nil else G2DstrechAlphaBitmap ctrlstr.EDC_channel G2DloadAlphaBmp ctrlstr.EDC_channel bmppath w h 1 bgcolor -> abmp in
let _CRcompBitmap ctrlstr.EDC_channel cont nil [0 0] OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_CLICK|OBJ_CONTAINER_MOVE abmp 0 0 w h -> cbmp in
(
_CBcompBitmapCursorMove cbmp @cbEdCtrlBitmapCursorMove ctrlstr;
_CBcompBitmapClick cbmp @cbEdCtrlBitmapClick ctrlstr;
_CBcompBitmapResize cbmp @cbEdCtrlBitmapResize ctrlstr;
_CBcompBitmapResizeResource cbmp @cbEdCtrlBitmapResizeResource ctrlstr;
set ctrlstr.EDC_bitmap = [cont abmp cbmp nil bmppath bgcolor 0 nil nil];
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
_PAINTcontainer cont;
ctrlstr;
);;
/*! @ingroup g2dBitmap
* \brief Create a bitmap control
*
* Prototype: fun [EdWindow I I I I S I I I] EdControl
*
* \param EdWindow : parent control window
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param S : the bitmap path, use nil for plain color
* \param I : RGB background color
* \param I : resize flags
* \param I : strech mode, 0 streched, 1 splited, 2 fit
*
* \return EdControl
**/
fun crEdCtrlBitmapExt(winstr, x, y, w, h, bmppath, bgcolor, resize, split)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRcontainerFromObjWin ctrlstr.EDC_channel father x y w h CO_CHILDINSIDE|CO_NOBORDER bgcolor "" -> cont in
let if bmppath == nil then
_CRalphaBitmap ctrlstr.EDC_channel (_FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgcolor) nil nil nil
else
G2DstrechAlphaBitmapExt ctrlstr.EDC_channel (G2DloadAlphaBmp ctrlstr.EDC_channel bmppath) w h (split >= 2) bgcolor split
-> abmp in
let _CRcompBitmap ctrlstr.EDC_channel cont nil [0 0] OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_CLICK|OBJ_CONTAINER_MOVE abmp 0 0 w h -> cbmp in
(
_CBcompBitmapCursorMove cbmp @cbEdCtrlBitmapCursorMove ctrlstr;
_CBcompBitmapClick cbmp @cbEdCtrlBitmapClick ctrlstr;
_CBcompBitmapResize cbmp @cbEdCtrlBitmapResize ctrlstr;
_CBcompBitmapResizeResource cbmp @cbEdCtrlBitmapResizeResourceExt ctrlstr;
set ctrlstr.EDC_bitmap = [cont abmp cbmp nil bmppath bgcolor split nil nil];
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
_PAINTcontainer cont;
ctrlstr;
);;
/*! @ingroup g2dBitmap
* \brief Create a bitmap control
*
* Prototype: fun [EdWindow I I I I ObjBitmap I I] EdControl
*
* \param EdWindow : parent control window
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param ObjBitmap : bitmap to use
* \param I : RGB background color
* \param I : resize flags
*
* \return EdControl
**/
fun crEdCtrlBitmap2(winstr, x, y, w, h, bmpbase, bgcolor, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRcontainerFromObjWin ctrlstr.EDC_channel father x y w h CO_CHILDINSIDE|CO_NOBORDER bgcolor "" -> cont in
let G2DstrechBitmap ctrlstr.EDC_channel bmpbase w h 0xffffff -> bmp in
let _CRalphaBitmap ctrlstr.EDC_channel bmp nil nil nil -> abmp in
let _CRcompBitmap ctrlstr.EDC_channel cont nil [0 0] OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_CLICK|OBJ_CONTAINER_MOVE abmp 0 0 w h -> cbmp in
(
if (bmp == bmpbase) then nil else
_DSbitmap bmp;
_CBcompBitmapCursorMove cbmp @cbEdCtrlBitmapCursorMove ctrlstr;
_CBcompBitmapClick cbmp @cbEdCtrlBitmapClick ctrlstr;
_CBcompBitmapResize cbmp @cbEdCtrlBitmapResize ctrlstr;
_CBcompBitmapResizeResource cbmp @cbEdCtrlBitmapResizeResource ctrlstr;
set ctrlstr.EDC_bitmap = [cont abmp cbmp bmpbase nil bgcolor 0 nil nil];
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
_PAINTcontainer cont;
ctrlstr;
);;
/*! @ingroup g2dBitmap
* \brief Create a bitmap control
*
* Prototype: fun [EdWindow I I I I ObjBitmap I I] EdControl
*
* \param EdWindow : parent control window
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param ObjBitmap : bitmap to use
* \param I : RGB background color
* \param I : resize flags
*
* \return EdControl
**/
fun crEdCtrlBitmap8(winstr, x, y, w, h, bmp8, bgcolor, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRcontainerFromObjWin ctrlstr.EDC_channel father x y w h CO_CHILDINSIDE|CO_NOBORDER bgcolor "" -> cont in
let _GETbitmap8Size bmp8 -> [bw bh] in
let _SETbitmapBGR (_CRbitmap _channel bw bh) [bmp8 bmp8 bmp8] -> bmpbase in
let G2DstrechBitmap ctrlstr.EDC_channel bmpbase w h 0xffffff -> bmp in
let _CRalphaBitmap ctrlstr.EDC_channel bmp nil nil nil -> abmp in
let _CRcompBitmap ctrlstr.EDC_channel cont nil [0 0] OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_CLICK|OBJ_CONTAINER_MOVE abmp 0 0 w h -> cbmp in
(
_DSbitmap bmpbase;
_DSbitmap bmp;
_CBcompBitmapCursorMove cbmp @cbEdCtrlBitmapCursorMove ctrlstr;
_CBcompBitmapClick cbmp @cbEdCtrlBitmapClick ctrlstr;
_CBcompBitmapResize cbmp @cbEdCtrlBitmapResize ctrlstr;
_CBcompBitmapResizeResource cbmp @cbEdCtrlBitmapResizeResource ctrlstr;
set ctrlstr.EDC_bitmap = [cont abmp cbmp nil nil bgcolor 0 nil nil];
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
_PAINTcontainer cont;
ctrlstr;
);;
/*! @ingroup g2dBitmap
* \brief Create a bitmap control
*
* Prototype: fun [EdWindow I I I I S I I] EdControl
*
* \param EdWindow : parent control window
* \param ObjContainer : container to create the bitmap in
* \param I : X position in the container
* \param I : Y position int the container
* \param I : width
* \param I : height
* \param S : the bitmap path, use nil for plain color
* \param I : RGB background color
* \param I : resize flags
*
* \return EdControl
**/
/*fun crEdCtrlBitmapOnContainer(winstr, cont, x, y, w, h, bmppath, bgcolor, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let if bmppath == nil then _CRalphaBitmap ctrlstr.EDC_channel (_FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgcolor) nil nil nil else G2DstrechAlphaBitmap ctrlstr.EDC_channel G2DloadAlphaBmp ctrlstr.EDC_channel bmppath w h 1 bgcolor -> abmp in
let _CRcompBitmap ctrlstr.EDC_channel cont nil [x y] OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_CLICK|OBJ_CONTAINER_MOVE abmp 0 0 w h -> cbmp in
(
_CBcompBitmapCursorMove cbmp @cbEdCtrlBitmapCursorMove ctrlstr;
_CBcompBitmapClick cbmp @cbEdCtrlBitmapClick ctrlstr;
_CBcompBitmapResize cbmp @cbEdCtrlBitmapResize ctrlstr;
_CBcompBitmapResizeResource cbmp @cbEdCtrlBitmapResizeResource ctrlstr;
set ctrlstr.EDC_bitmap = [cont abmp cbmp nil bmppath bgcolor 0 nil nil];
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
//let _GETwindowPositionSize father -> [_ _ fw fh] in
//set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
set ctrlstr.EDC_coords = [x y (x + w) (y + h) w h];
_PAINTcontainer cont;
ctrlstr;
);;*/
/*! \brief Callback on a bitmap control resource resize to paint a grid
*
* Private
*
* Prototype: fun [CompBitmap [EdControl I] I I [I I I I]] I
*
* \return 0
**/
fun cbEdCtrlBitmapResizeGridResource(cmpbmp, p, w, h, oldval)=
let p -> [ctrlstr dotcolor] in
let ftoi ((itof ctrlstr.EDC_iParam) *. ctrlstr.EDC_fParam) -> dotspace in
let oldval -> [ox oy ow oh] in
let ctrlstr.EDC_bitmap -> [_ obmp _ _ _ bgcolor _ _ _] in
let (_FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgcolor) -> bmp in
let
// draw dots
let 0 -> ih in
while ih <= h do
(
let 0 -> iw in
while iw <= w do
(
_PUTpixel24 bmp iw ih dotcolor;
//_DRAWrectangle gtabstr.PLTAB_buffer iw ih 2 2 DRAW_SOLID 0 0x000000 DRAW_SOLID 0xffffff;
set iw = iw + dotspace;
);
set ih = ih + dotspace;
)
-> _ in
let _CRalphaBitmap ctrlstr.EDC_channel bmp nil nil nil -> abmp in
(
_DSbitmap bmp;
_DSalphaBitmap obmp;
mutate ctrlstr.EDC_bitmap <- [_ abmp _ _ _ _ _ _ _];
[abmp [ox oy w h]]
);;
/*! \brief Refresh the bitmap grid
*
* Private
*
* Prototype: fun [EdControl I] I
*
* \return 0
**/
fun updateEdCtrlGrid(ctrlstr, dotcolor)=
let ftoi ((itof ctrlstr.EDC_iParam) *. ctrlstr.EDC_fParam) -> dotspace in
let ctrlstr.EDC_bitmap -> [_ abmp _ _ _ bgcolor _ _ _] in
let _GETalphaBitmapSize abmp -> [w h] in
let _GETalphaBitmaps abmp -> [bmp _] in
(
_FILLbitmap bmp bgcolor;
// draw dots
let 0 -> ih in
while ih <= h do
(
let 0 -> iw in
while iw <= w do
(
_PUTpixel24 bmp iw ih dotcolor;
//_DRAWrectangle gtabstr.PLTAB_buffer iw ih 2 2 DRAW_SOLID 0 0x000000 DRAW_SOLID 0xffffff;
set iw = iw + dotspace;
);
set ih = ih + dotspace;
);
);
0;;
/*! @ingroup g2dBitmap
* \brief Create a bitmap control to display a grid
*
* Prototype: fun [EdWindow I I I I I I I I] EdControl
*
* \param EdWindow : parent control window
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : RGB background color
* \param I : RGB grid dot color
* \param I : dot space in pixel
* \param I : resize flags
*
* \return EdControl
**/
fun crEdCtrlGrid(winstr, x, y, w, h, bgcolor, dotcolor, dotspace, resize)=
let if !dotspace then 10 else dotspace -> dotspace in
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 1.0 dotspace] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRcontainerFromObjWin ctrlstr.EDC_channel father x y w h CO_CHILDINSIDE|CO_NOBORDER 0xffffff "" -> cont in
let _FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgcolor -> bmp in
let
// draw dots
let 0 -> ih in
while ih <= h do
(
let 0 -> iw in
while iw <= w do
(
_PUTpixel24 bmp iw ih dotcolor;
//_DRAWrectangle gtabstr.PLTAB_buffer iw ih 2 2 DRAW_SOLID 0 0x000000 DRAW_SOLID 0xffffff;
set iw = iw + dotspace;
);
set ih = ih + dotspace;
)
-> _ in
let _CRalphaBitmap ctrlstr.EDC_channel bmp nil nil nil -> abmp in
let _CRcompBitmap ctrlstr.EDC_channel cont nil [0 0] OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_CLICK|OBJ_CONTAINER_DBLCLICK|OBJ_CONTAINER_MOVE|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_KEYUP abmp 0 0 w h -> cbmp in
(
_DSbitmap bmp;
_CBcompBitmapCursorMove cbmp @cbEdCtrlBitmapCursorMove ctrlstr;
_CBcompBitmapResize cbmp @cbEdCtrlBitmapResize ctrlstr;
_CBcompBitmapResizeResource cbmp @cbEdCtrlBitmapResizeGridResource [ctrlstr dotcolor];
set ctrlstr.EDC_bitmap = [cont abmp cbmp nil nil bgcolor 0 nil nil];
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
_PAINTcontainer cont;
ctrlstr;
);;
/*! @ingroup g2dBitmap
* \brief Destroy a bitmap control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : bitmap control structure
*
* \return 0
**/
fun dsEdCtrlBitmap(ctrlstr)=
let ctrlstr.EDC_bitmap -> [cont abmp cbmp bmpbase bmppath _ _ _ _] in
(
_DScompBitmap cbmp;
_DSalphaBitmap abmp;
_DScontainer cont;
_DSbitmap bmpbase;
);
set ctrlstr.EDC_bitmap = nil;
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control Edit float / Int
/ ********************************************************************************************* */
/*! \brief Callback on a float control value change timer timeout
*
* Private
*
* Prototype: fun [Timer EdControl F fun [EdControl F] u0] I
*
* \return 0
**/
proto setEdCtrlFloatValueWithoutCallback = fun [EdControl F] I;;
fun cbEdCtrlFloatChangeTimer(trm, ctrlstr, fval)=
_deltimer trm;
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown cval minval maxval incre nb0 _ _ _ _ cbfun cbfun2 _] in
(
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ nil];
if (cval == fval) then nil else
exec cbfun2 with [ctrlstr cval fval];
if (fval >=. minval) && (fval <=. maxval) && (fval != nil) then nil else
(
setEdCtrlFloatValueWithoutCallback ctrlstr fval;
exec cbfun with [ctrlstr fval];
);
);
0;;
/*! \brief Callback on a float control value change
*
* Private
*
* Prototype: fun [ObjText EdControl] I
*
* \return 0
**/
fun cbEdCtrlFloatChange(txt, ctrlstr)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown cval minval maxval incre nb0 _ _ _ cbfun _ _ trm] in
let _GETtext txt -> val in
let isNumber val -> isnum in
let !(strlen (strtrim val)) || (val == nil) -> isempty in
let if (!isnum && !isempty) then cval else if ((atof val) <. minval) then minval else if ((atof val) >. maxval) then maxval else (atof val) -> fval in
(
_deltimer trm;
set trm = nil;
if (isnum || isempty) then nil else
setEdCtrlFloatValueWithoutCallback ctrlstr fval;
exec cbfun with [ctrlstr fval];
set trm = _rfltimer _starttimer ctrlstr.EDC_channel 600 mkfun3 @cbEdCtrlFloatChangeTimer fval ctrlstr;
/*
if ((atof val) >=. minval) && ((atof val) <=. maxval) && ((atof val) != nil) then
(
exec cbfun with [ctrlstr fval];
0;
)
else
(
set trm = _rfltimer _starttimer ctrlstr.EDC_channel 800 mkfun3 @cbEdCtrlFloatChangeTimer fval ctrlstr;
0;
);*/
if (isnum || isempty) then
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ trm]
else
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ fval _ _ _ _ _ _ _ _ _ _ trm];
);
0;;
/*! @ingroup g2dFloat
* \brief Get a float control value
*
* Prototype: fun [EdControl] I
*
* \param EdControl : float control structure
*
* \return F : the float value
**/
fun getEdCtrlFloatValue(ctrlstr)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown cval minval maxval incre nb0 _ _ _ _ _ _ _] in
atof _GETtext txt;;
/*! @ingroup g2dFloat
* \brief Set a float control value
*
* Prototype: fun [EdControl F] I
*
* \param EdControl : float control structure
* \param F : the new float value
*
* \return 0
**/
fun setEdCtrlFloatValue(ctrlstr, val)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown cval minval maxval incre nb0 _ _ _ _ _ _ _] in
let if val == nil then 0.0 else val -> val in
(
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ val _ _ _ _ _ _ _ _ _ _ _];
_SETtext txt G2DgetFtoA val nb0;
);
0;;
/*! @ingroup g2dFloat
* \brief Set a float control number of decimals
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : float control structure
* \param I : the new number of decimals
*
* \return 0
**/
fun setEdCtrlFloatNbDecimals(ctrlstr, nb0)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown cval minval maxval incre _ _ _ _ _ _ _ _] in
let if nb0 == nil then 0 else nb0 -> nb0 in
(
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ _ _ _ nb0 _ _ _ _ _ _ _];
_SETtext txt G2DgetFtoA (atof _GETtext txt) nb0;
);
0;;
/*! @ingroup g2dFloat
* \brief Set a float control minimum value
*
* Prototype: fun [EdControl F] I
*
* \param EdControl : float control structure
* \param F : the new minimum value
*
* \return 0
**/
fun setEdCtrlFloatMinValue(ctrlstr, val)= mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ val _ _ _ _ _ _ _ _ _ _];;
/*! @ingroup g2dFloat
* \brief Set a float control maximum value
*
* Prototype: fun [EdControl F] I
*
* \param EdControl : float control structure
* \param F : the new maximum value
*
* \return 0
**/
fun setEdCtrlFloatMaxValue(ctrlstr, val)= mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ _ val _ _ _ _ _ _ _ _ _];;
/*! @ingroup g2dFloat
* \brief Set a float control value, but do not send the change callback
*
* Prototype: fun [EdControl F] I
*
* \param EdControl : float control structure
* \param F : the new float value
*
* \return 0
**/
fun setEdCtrlFloatValueWithoutCallback(ctrlstr, val)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown cval minval maxval incre nb0 _ _ _ cbfun _ _ _] in
let if val == nil then 0.0 else val -> val in
(
_CBtext txt nil nil;
_SETtext txt G2DgetFtoA val nb0;
_CBtext txt @cbEdCtrlFloatChange ctrlstr;
);
0;;
/*! @ingroup g2dFloat
* \brief Set a float control state
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : float control structure
* \param I : 1 to enable, 0 the disable
*
* \return 0
**/
fun setEdCtrlFloatEnable(ctrlstr, state)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown _ _ _ _ _ _ _ _ _ _ _ _] in
let if state then OBJ_ENABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK else OBJ_DISABLE|OBJ_VISIBLE|ROL_DISABLE|ROL_MASK -> flags in
(
_ENtext txt state;
_CHANGEobjNodeFlags _CONVERTcompRollOverToObjNode cmprup flags 0;
_CHANGEobjNodeFlags _CONVERTcompRollOverToObjNode cmprdown flags 0;
_PAINTcontainer cont;
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ _ _ _ _ _ _ state _ _ _ _];
);
0;;
/*! @ingroup g2dFloat
* \brief Define the float control change value callback function
*
* Prototype: fun [EdControl fun [EdControl F] u0] I
*
* \param EdControl : float control structure
* \param fun [EdControl F] u0 : validate callback
* \param - EdControl : the same float control structure
* \param - F : the float value
*
* \return 0
**/
fun setEdCtrlFloatCbChange(ctrlstr, cbfun)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown _ _ _ _ nb0 _ _ _ _ _ _ _] in
_CBtext txt @cbEdCtrlFloatChange ctrlstr;
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ _ _ _ _ _ _ _ cbfun _ _ _];
0;;
/*! \brief Callback on a float control validation
*
* Private
*
* Prototype: fun [ObjText EdControl S] I
*
* \return 0
**/
fun cbEdCtrlFloatValidate(txt, ctrlstr, val)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown cval minval maxval _ nb0 _ _ _ _ cbfun cbfun2 trm] in
let !(strlen (strtrim val)) || (val == nil) -> isempty in
let if ((!isNumber val) && !isempty) then
cval
else if ((atof val) <. minval) && minval != nil then
minval
else if ((atof val) >. maxval) && maxval != nil then
maxval
else
(atof val)
-> fval in
(
_deltimer trm;
if (cval == fval) then nil else
exec cbfun2 with [ctrlstr cval fval];
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ fval _ _ _ _ _ _ _ _ _ _ nil];
_SETtext txt G2DgetFtoA fval nb0;
exec cbfun with [ctrlstr fval];
);
0;;
/*! @ingroup g2dFloat
* \brief Define the float control validation callback function
*
* Prototype: fun [EdControl fun [EdControl F] u0] I
*
* \param EdControl : float control structure
* \param fun [EdControl F] u0 : validation callback
* \param - EdControl : the same float control structure
* \param - F : the float value
*
* \return 0
**/
fun setEdCtrlFloatCbValidate(ctrlstr, cbfun)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown _ _ _ _ nb0 _ _ _ _ _ _ _] in
_CBlineOk txt @cbEdCtrlFloatValidate ctrlstr;
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ _ _ _ _ _ _ _ _ cbfun _ _];
0;;
/*! @ingroup g2dFloat
* \brief Define the float control value changed callback when the validation occur and the value has really changed
*
* Prototype: fun [EdControl fun [EdControl F F] u0] I
*
* \param EdControl : float control structure
* \param fun [EdControl F] u0 : validation callback
* \param - EdControl : the same float control structure
* \param - F : the previous float value
* \param - F : the new float value
*
* \return 0
**/
fun setEdCtrlFloatCbChangedValue(ctrlstr, cbfun)=
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ _ _ _ _ _ _ _ _ _ cbfun _];
0;;
/*! \brief Callback on a float control click on up arrow
*
* Private
*
* Prototype: fun [CompRollOver EdControl I I I I] I
*
* \return 0
**/
fun cbEdCtrlFloatUpClick(cmproll, ctrlstr, x, y, btn, mask)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown _ minval maxval incre nb0 _ _ _ _ cbfun _ trm] in
let (atof _GETtext txt) +. incre -> fval in
let if (fval <. minval) && minval != nil then
minval
else if (fval >. maxval) && maxval != nil then
maxval
else
fval
-> fval in
(
_deltimer trm;
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ nil];
_SETtext txt G2DgetFtoA fval nb0;
cbEdCtrlFloatChange txt ctrlstr;
);
0;;
/*! \brief Callback on a float control mouse click on down arrow
*
* Private
*
* Prototype: fun [CompRollOver EdControl I I I I] I
*
* \return 0
**/
fun cbEdCtrlFloatDownClick(cmproll, ctrlstr, x, y, btn, mask)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown _ minval maxval incre nb0 _ _ _ _ cbfun _ trm] in
let (atof _GETtext txt) -. incre -> fval in
let if (fval <. minval) && minval != nil then
minval
else if (fval >. maxval) && maxval != nil then
maxval
else
fval
-> fval in
(
_deltimer trm;
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ nil];
_SETtext txt G2DgetFtoA fval nb0;
cbEdCtrlFloatChange txt ctrlstr;
);
0;;
/*! \brief Callback on a float control mouse unclick
*
* Private
*
* Prototype: fun [ObjContainer EdControl I I I I] I
*
* \return 0
**/
fun cbEdCtrlFloatUnClick(cont, ctrlstr, x, y, btn, mask)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown _ _ _ incre nb0 _ _ _ _ cbfun _ trm] in
let atof _GETtext txt -> fval in
(
_deltimer trm;
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ nil];
cbEdCtrlFloatValidate txt ctrlstr G2DgetFtoA fval nb0;
);
0;;
/*! \brief Callback on a float control mouse leave
*
* Private
*
* Prototype: fun [ObjContainer EdControl] I
*
* \return 0
**/
fun cbEdCtrlFloatLeave(cont, ctrlstr)=
_SETcontainerCursor cont nil;
0;;
/*! \brief Callback on a float control mouse wheel
*
* Private
*
* Prototype: fun [ObjContainer EdControl I I I I] I
*
* \return 0
**/
fun cbEdCtrlFloatWheel(cont, ctrlstr, x, y, delta, mask)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown _ minval maxval incre nb0 _ _ _ _ cbfun _ trm] in
let (atof _GETtext txt) +. (incre *. (itof delta)) -> fval in
let if (fval <. minval) && minval != nil then
minval
else if (fval >. maxval) && maxval != nil then
maxval
else
fval
-> fval in
(
_deltimer trm;
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ nil];
_SETtext txt G2DgetFtoA fval nb0;
cbEdCtrlFloatChange txt ctrlstr;
);
0;;
/*! \brief Callback on a float control drag
*
* Private
*
* Prototype: fun [ObjContainer EdControl I I I] I
*
* \return 0
**/
fun cbEdCtrlFloatDrag(cont, ctrlstr, x, y, mask)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown cval minval maxval incre nb0 cy cursor state cbfun _ _ trm] in
if !state then nil else
let _GETscreenPos -> [sx sy] in
let _GETscreenSize -> [_ sh] in
let sh - 40 -> sh in
(
_deltimer trm;
let itof (cy - sy) -> coef in
if (mask & MK_LBUTTON) then
(
// TODO move cursor on top or bottom of the screen if sy == 0 || sy == sh
if (sy <= 1) && (coef >. 0.0) then
(
_SETscreenPos sx sh;
set sy = sh;
)
else if (sy >= (sh - 1)) && (coef <. 0.0) then
(
_SETscreenPos sx 1;
set sy = 1;
)
else nil;
_SETcontainerCursor cont cursor;
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ _ _ _ _ sy _ _ _ _ _ nil];
let ((atof _GETtext txt) +. (incre *. coef)) -> fval in
let if (fval == nil) || (fval <. minval) then minval else if (fval >. maxval) then maxval else fval -> fval in
(
setEdCtrlFloatValueWithoutCallback ctrlstr fval;
exec cbfun with [ctrlstr fval];
);
0;
)
else
(
_SETcontainerCursor cont nil;
mutate ctrlstr.EDC_editFloat <- [_ _ _ _ _ _ _ _ _ sy _ _ _ _ _ nil];
0;
);
);
0;;
/*! @ingroup g2dFloat
* \brief Create a float control
*
* Prototype: fun [EdWindow I I I I F F F F I EdTheme I] EdControl
*
* \param EdWindow : parent control window
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param F : default value
* \param F : minium allowed value
* \param F : maximum allowed value
* \param F : increment value
* \param I : number of decimal
* \param EdTheme : theme structure to use
* \param I : resize flags
*
* \return EdControl
**/
fun crEdCtrlFloat(winstr, x, y, w, h, value, minval, maxval, incre, nb0, themestr, resize)=
let if value == nil then 0.0 else value -> value in
let if themestr == nil then (if EdDefaultTheme == nil then (set EdDefaultTheme = makeEdThemeResources winstr.EDW_channel) else EdDefaultTheme) else themestr -> themestr in
let mkEdControl [winstr.EDW_channel winstr resize themestr nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _GETalphaBitmapSize themestr.EDT_abmpValUp -> [auw auh] in
let _GETalphaBitmapSize themestr.EDT_abmpValDown -> [adw adh] in
let _CReditLine ctrlstr.EDC_channel father x y (w - auw) h if (nb0 == 0 || nb0 == nil) then ET_BORDER|ET_AHSCROLL|ET_TABFOCUS else ET_BORDER|ET_AHSCROLL|ET_TABFOCUS (G2DgetFtoA value nb0) -> txt in
let _CRcontainerFromObjWin ctrlstr.EDC_channel father (x + (w - auw)) y auw ((auh / 5) + (adh / 5)) CO_CHILDINSIDE|CO_NOBORDER 0xffffff "" -> cont in
let _CRcompRollOver ctrlstr.EDC_channel cont nil [0 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE OBJ_CONTAINER_MOVE|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_DBLCLICK themestr.EDT_abmpValUp -> cmprup in
let _CRcompRollOver ctrlstr.EDC_channel cont nil [0 (auh / 5)] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE OBJ_CONTAINER_MOVE|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_DBLCLICK themestr.EDT_abmpValDown -> cmprdown in
(
set ctrlstr.EDC_editFloat = [txt cont cmprup cmprdown value minval maxval incre nb0 nil themestr.EDT_cursorUpDownValue 1 nil nil nil nil];
_CBcompRollOverUnClick cmprup @cbEdCtrlFloatUpClick ctrlstr;
_CBcompRollOverUnClick cmprdown @cbEdCtrlFloatDownClick ctrlstr;
_CBcontainerCursorMove cont @cbEdCtrlFloatDrag ctrlstr;
_CBcontainerCursorLeave cont @cbEdCtrlFloatLeave ctrlstr;
_CBcontainerUnClick cont @cbEdCtrlFloatUnClick ctrlstr;
_CBcontainerMouseWheel cont @cbEdCtrlFloatWheel ctrlstr;
_CBtext txt @cbEdCtrlFloatChange ctrlstr;
_CBlineOk txt @cbEdCtrlFloatValidate ctrlstr;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
_PAINTcontainer cont;
ctrlstr;
);;
/*! @ingroup g2dFloat
* \brief Destroy a float control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : float control structure
*
* \return 0
**/
fun dsEdCtrlFloat(ctrlstr)=
let ctrlstr.EDC_editFloat -> [txt cont cmprup cmprdown _ _ _ _ _ _ cursor _ _ _ _ trm] in
(
_deltimer trm;
_DStext txt;
_DScompRollOver cmprup;
_DScompRollOver cmprdown;
_DScontainer cont;
);
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control Edit date
/ ********************************************************************************************* */
/*! \brief Callback on a date control change
*
* Private
*
* Prototype: fun [EdControl S EdControl] I
*
* \return 0
**/
fun cbEdCtrlDateChange(datectrl, value, ctrlstr)=
let ctrlstr.EDC_editDate -> [ctrlday ctrlmonth ctrlyear _ _ cbfun] in
let ftoi getEdCtrlFloatValue ctrlday -> day in
let ftoi getEdCtrlFloatValue ctrlmonth -> month in
let ftoi getEdCtrlFloatValue ctrlyear -> year in
let getMonthDays month year -> maxday in
(
if day <= maxday then nil else
(
setEdCtrlFloatValueWithoutCallback ctrlday (itof maxday);
set day = maxday;
);
setEdCtrlFloatMaxValue ctrlday (itof maxday);
exec cbfun with [ctrlstr day month year];
);
0;;
/*! @ingroup g2dDate
* \brief Get a date control value
*
* Prototype: fun [EdControl] [I I I]
*
* \param EdControl : date control structure
*
* \return [I I I] : the day, month, year value
**/
fun getEdCtrlDateValue(ctrlstr)=
let ctrlstr.EDC_editDate -> [ctrlday ctrlmonth ctrlyear _ _ cbfun] in
let ftoi getEdCtrlFloatValue ctrlday -> day in
let ftoi getEdCtrlFloatValue ctrlmonth -> month in
let ftoi getEdCtrlFloatValue ctrlyear -> year in
(
[day month year];
);;
/*! @ingroup g2dDate
* \brief Set a date control value
*
* Prototype: fun [EdControl I I I] I
*
* \param EdControl : date control structure
* \param I : new day value
* \param I : new month value
* \param I : new year value
*
* \return 0
**/
fun setEdCtrlDateValue(ctrlstr, day, month, year)=
let ctrlstr.EDC_editDate -> [ctrlday ctrlmonth ctrlyear _ _ cbfun] in
let if month <= 0 then 1 else if month > 12 then 12 else month -> month in
let getMonthDays month year -> maxday in
let if day <= 0 then 1 else if day > maxday then maxday else day -> day in
(
setEdCtrlFloatValue ctrlday itof day;
setEdCtrlFloatValue ctrlmonth itof month;
setEdCtrlFloatValue ctrlyear itof year;
);
0;;
/*! @ingroup g2dDate
* \brief Set a date control state
*
* Prototype: fun [EdControl I] I
*
* \param EdControl : date control structure
* \param I : 1 to enable, 0 the disable
*
* \return 0
**/
fun setEdCtrlDateEnable(ctrlstr, state)=
let ctrlstr.EDC_editDate -> [ctrlday ctrlmonth ctrlyear _ _ cbfun] in
(
setEdCtrlFloatEnable ctrlday state;
setEdCtrlFloatEnable ctrlmonth state;
setEdCtrlFloatEnable ctrlyear state;
);
0;;
/*! @ingroup g2dDate
* \brief Define a date control change callback function
*
* Prototype: fun [EdControl fun [EdControl I I I] u0] I
*
* \param EdControl : date control structure
* \param fun [EdControl I I I] u0 : change callback
* \param - EdControl : the same date control structure
* \param - I : the day value
* \param - I : the month value
* \param - I : the year value
*
* \return 0
**/
fun setEdCtrlDateCbChange(ctrlstr, cbfun)=
let ctrlstr.EDC_editDate -> [ctrlday ctrlmonth ctrlyear _ _ _] in
mutate ctrlstr.EDC_editDate <- [_ _ _ _ _ cbfun];
0;;
/*! @ingroup g2dDate
* \brief Create a date control
*
* Prototype: fun [EdWindow I I I I I I I EdTheme I] EdControl
*
* \param EdWindow : parent control window
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : day
* \param I : month
* \param I : year
* \param EdTheme : theme structure to use
* \param I : resize flags
*
* \return EdControl
**/
fun crEdCtrlDate(winstr, x, y, w, h, day, month, year, themestr, resize)=
//let if value == nil then 0.0 else value -> value in
let if themestr == nil then (if EdDefaultTheme == nil then (set EdDefaultTheme = makeEdThemeResources winstr.EDW_channel) else EdDefaultTheme) else themestr -> themestr in
let mkEdControl [winstr.EDW_channel winstr resize themestr nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let crEdCtrlFloat winstr x y 60 20 (itof year) 0.0 10000.0 1.0 0 themestr nil -> ctrlyear in
let crEdCtrlLabel winstr (x + 64) (y + 2) 8 20 "/" nil -> ctrlb1 in
let crEdCtrlFloat winstr (x + 73) y 30 20 (itof month) 1.0 12.0 1.0 0 themestr nil -> ctrlmonth in
let crEdCtrlLabel winstr (x + 74 + 34) (y + 2) 8 20 "/" nil -> ctrlb2 in
let crEdCtrlFloat winstr (x + 74 + 43) y 30 20 (itof day) 1.0 31.0 1.0 0 themestr nil -> ctrlday in
(
set ctrlstr.EDC_editDate = [ctrlday ctrlmonth ctrlyear ctrlb1 ctrlb2 nil];
setEdCtrlFloatCbChange ctrlday mkfun3 @cbEdCtrlDateChange ctrlstr;
setEdCtrlFloatCbChange ctrlmonth mkfun3 @cbEdCtrlDateChange ctrlstr;
setEdCtrlFloatCbChange ctrlyear mkfun3 @cbEdCtrlDateChange ctrlstr;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2dDate
* \brief Destroy a date control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : date control structure
*
* \return 0
**/
fun dsEdCtrlDate(ctrlstr)=
let ctrlstr.EDC_editDate -> [ctrlday ctrlmonth ctrlyear ctrlb1 ctrlb2 _] in
(
dsEdCtrlFloat ctrlday;
dsEdCtrlFloat ctrlmonth;
dsEdCtrlFloat ctrlyear;
dsEdCtrlLabel ctrlb1;
dsEdCtrlLabel ctrlb2;
);
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Control 3D
/ ********************************************************************************************* */
/*! @ingroup g2d3D
* \brief Create a 3D control with a default scene
*
* Prototype: fun [EdWindow I I I I I] EdControl
*
* \param EdWindow : parent control window
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : resize flags
*
* \return EdControl
**/
fun crEdCtrl3D(winstr, x, y, w, h, resize)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let V3DcrView ctrlstr.EDC_channel father x y w h nil nil 1 -> v3dstr in
(
set ctrlstr.EDC_view3d = v3dstr;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2d3D
* \brief Create a 3D control
*
* Prototype: fun [EdWindow I I I I I I] EdControl
*
* \param EdWindow : parent control window
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : resize flags
* \param I : create a default scene
*
* \return EdControl
**/
fun crEdCtrl3DAdv(winstr, x, y, w, h, resize, defscene)=
let mkEdControl [winstr.EDW_channel winstr resize nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let V3DcrView ctrlstr.EDC_channel father x y w h nil nil defscene -> v3dstr in
(
set ctrlstr.EDC_view3d = v3dstr;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2d3D
* \brief Destroy a 3D control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : 3D control structure
*
* \return 0
**/
fun dsEdCtrl3D(ctrlstr)=
V3DdsView ctrlstr.EDC_view3d;
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/*! @ingroup g2d3D
* \brief Define a 3D control destroy callback function
*
* Prototype: fun [EdControl fun [V3Dview] I] I
*
* \param EdControl : 3D control structure
* \param fun [V3Dview] I : the destroy callback
*
* \return 0
**/
fun setEdCtrl3DdestroyCb(ctrlstr, cb)=
V3DsetViewDestroyCb ctrlstr.EDC_view3d cb;
0;;
/* ********************************************************************************************* /
Color map
/ ********************************************************************************************* */
proto cbEdColorMapExaValueChange = fun [EdControl S [I I [I I I] EdControl EdControl EdControl EdControl EdControl EdControl EdControl EdControl CompBitmap ObjCursor]] I;;
typeof tmrEdColorMapMousePicker = Timer;;
/*! \brief Fill the color map ruler
*
* Private
*
* Prototype: fun [EdControl I] I
*
* \return 0
**/
fun fillEdColorMapRuller(ctrlstr, color)=
let G2Drgb2hsv color -> [hc sc vc] in
let ctrlstr.EDC_bitmap -> [cont abmp cbmp _ bmppath _ _ _ _] in
let _GETalphaBitmaps abmp -> [bmp _] in
let _GETbitmapSize bmp -> [xmax ymax] in
let 0.01 -> delta in
let itof ymax -> float_max in
(
let 1.0 -> iv in
while iv >. 0.0 do
(
let G2Dhsv2rgb hc sc iv -> c in
_BTDRAWrect bmp [0 ftoi iv*.float_max xmax-10 3] c 2 0 nil;
set iv = iv -. delta;
);
_BTDRAWrect bmp [xmax-10 0 xmax ymax+1] 0xffffff 0 1 0xffffff;
let (ftoi vc*.float_max) -> av in
let mktab 3 [xmax-10 av] -> t in
(
set t.(0) = [xmax av-5];
set t.(2) = [xmax av+5];
_DRAWpoly16 bmp 3 t DRAW_SOLID 1 0 DRAW_SOLID 0;
);
_PAINTobjNode _CONVERTcompBitmapToObjNode cbmp;
_PAINTcontainer cont;
);
0;;
/*! \brief Callback on a color map control value change
*
* Private
*
* Prototype: fun [EdControl S [...]] I
*
* \return 0
**/
fun cbEdColorMapValueChange(ctrlstr, val, p)=
let p -> [ccolor mode hsvcolor bmpworkstr bmpsamplestr bmprulerstr htxtstr rtxtstr gtxtstr btxtstr atxtstr ccross _] in
let bmpworkstr.EDC_bitmap -> [cont _ _ _ _ _ _ _ _] in
let ftoi getEdCtrlFloatValue rtxtstr -> fr in
let ftoi getEdCtrlFloatValue gtxtstr -> fg in
let ftoi getEdCtrlFloatValue btxtstr -> fb in
let ftoi getEdCtrlFloatValue atxtstr -> fa in
let if (mode == -1) then fr+(fr<<8)+(fr<<16) else fr+(fg<<8)+(fb<<16) -> color in
let _GETcontainerPositionSize cont -> [_ _ w h] in
let G2Drgb2hsv color -> [hc sc vc] in
let [(ftoi hc) (ftoi (sc *. 100.0)) (ftoi (vc *. 100.0))] -> [hcolor scolor vcolor] in
let [hcolor*w/360 scolor*2] -> [crossx crossy] in
(
setEdCtrlEditTextCbChange htxtstr nil;
fillEdColorMapRuller bmprulerstr color;
setEdCtrlBitmapColor bmpsamplestr color;
setEdCtrlEditTextValue htxtstr G2DformatHexaColorI color;
if (mode == -1) then nil else
_CHANGEobjNodeCoordinates _CONVERTcompBitmapToObjNode ccross [crossx-12 crossy-12] 1;
setEdCtrlEditTextCbChange htxtstr mkfun3 @cbEdColorMapExaValueChange p;
mutate p <- [(if (mode != 1) then color else (G2Drgb2rgba color fa)) _ [hcolor scolor vcolor] _ _ _ _ _ _ _ _ _ _];
);
0;;
/*! \brief Callback on a color map control hexa value change
*
* Private
*
* Prototype: fun [EdControl S [...]] I
*
* \return 0
**/
fun cbEdColorMapExaValueChange(ctrlstr, val, p)=
let p -> [ccolor mode hsvcolor bmpworkstr bmpsamplestr bmprulerstr htxtstr rtxtstr gtxtstr btxtstr atxtstr ccross _] in
let G2Drgb2bgr (htoi G2DformatHexaColor val) -> color in
let G2Drgb2hsv color -> [hc sc vc] in
let [(ftoi hc) (ftoi (sc *. 100.0)) (ftoi (vc *. 100.0))] -> [hcolor scolor vcolor] in
let bmpworkstr.EDC_bitmap -> [cont _ _ _ _ _ _ _ _] in
let _GETcontainerPositionSize cont -> [_ _ w h] in
let [hcolor*w/360 scolor*2] -> [crossx crossy] in
let ftoi getEdCtrlFloatValue atxtstr -> fa in
(
setEdCtrlFloatCbChange rtxtstr nil;
setEdCtrlFloatCbChange gtxtstr nil;
setEdCtrlFloatCbChange btxtstr nil;
_CHANGEobjNodeCoordinates _CONVERTcompBitmapToObjNode ccross [crossx-12 crossy-12] 1;
setEdCtrlFloatValue rtxtstr itof color&255;
setEdCtrlFloatValue gtxtstr itof (color>>8)&255;
setEdCtrlFloatValue btxtstr itof (color>>16)&255;
fillEdColorMapRuller bmprulerstr color;
setEdCtrlBitmapColor bmpsamplestr color;
setEdCtrlFloatCbChange rtxtstr mkfun3 @cbEdColorMapValueChange p;
setEdCtrlFloatCbChange gtxtstr mkfun3 @cbEdColorMapValueChange p;
setEdCtrlFloatCbChange btxtstr mkfun3 @cbEdColorMapValueChange p;
mutate p <- [(if (mode != 1) then color else (G2Drgb2rgba color fa)) _ [hcolor scolor vcolor] _ _ _ _ _ _ _ _ _ _];
);
0;;
/*! \brief Callback on a color map control cross move
*
* Private
*
* Prototype: fun [ObjContainer [...] I I I] I
*
* \return 0
**/
fun cbEdColorMapCrossCursorMove(cont, p, x, y, mask) =
if !(mask & MK_LBUTTON) then nil else
let p -> [ccolor mode hsvcolor bmpworkstr bmpsamplestr bmprulerstr htxtstr rtxtstr gtxtstr btxtstr atxtstr ccross _] in
let hsvcolor -> [_ _ vcolor] in
let _GETcontainerPositionSize cont -> [_ _ w h] in
let if x<=0 then 0 else if x>=w then w else x -> x in
let if y<=0 then 0 else if y>=h then h else y -> y in
let ftoi getEdCtrlFloatValue atxtstr -> fa in
let G2Dhsv2rgb (itof x)/.(itof w)*. 360.0 (itof y)/. 200.0 (itof vcolor)/. 100.0 -> color in
(
setEdCtrlFloatCbChange rtxtstr nil;
setEdCtrlFloatCbChange gtxtstr nil;
setEdCtrlFloatCbChange btxtstr nil;
setEdCtrlEditTextCbChange htxtstr nil;
_CHANGEobjNodeCoordinates _CONVERTcompBitmapToObjNode ccross [x-12 y-12] 1;
setEdCtrlFloatValue rtxtstr itof color&255;
setEdCtrlFloatValue gtxtstr itof (color>>8)&255;
setEdCtrlFloatValue btxtstr itof (color>>16)&255;
setEdCtrlEditTextValue htxtstr G2DformatHexaColorI color;
fillEdColorMapRuller bmprulerstr color;
setEdCtrlBitmapColor bmpsamplestr color;
setEdCtrlFloatCbChange rtxtstr mkfun3 @cbEdColorMapValueChange p;
setEdCtrlFloatCbChange gtxtstr mkfun3 @cbEdColorMapValueChange p;
setEdCtrlFloatCbChange btxtstr mkfun3 @cbEdColorMapValueChange p;
setEdCtrlEditTextCbChange htxtstr mkfun3 @cbEdColorMapExaValueChange p;
mutate p <- [(if (mode != 1) then color else (G2Drgb2rgba color fa)) _ [(x*360/w) y/2 vcolor] _ _ _ _ _ _ _ _ _ _];
);
0;;
/*! \brief Callback on a color map control cross click
*
* Private
*
* Prototype: fun [ObjContainer [...] I I I I] I
*
* \return 0
**/
fun cbEdColorMapCrossCursorClick(cont, p, x, y, btn, mask) =
if btn != 1 then nil else
cbEdColorMapCrossCursorMove cont p x y MK_LBUTTON;
0;;
/*! \brief Callback on a color map control ruler move
*
* Private
*
* Prototype: fun [ObjContainer [...] I I I] I
*
* \return 0
**/
fun cbEdColorMapRulerCursorMove(cont, p, x, y, mask) =
if !(mask & MK_LBUTTON) then nil else
let p -> [ccolor mode hsvcolor bmpworkstr bmpsamplestr bmprulerstr htxtstr rtxtstr gtxtstr btxtstr atxtstr ccross _] in
let bmprulerstr.EDC_bitmap -> [_ abmp _ _ _ _ _ _ _] in
let hsvcolor -> [hcolor scolor _] in
let _GETalphaBitmaps abmp -> [bmp _] in
let _GETbitmapSize bmp -> [_ ymax] in
let if y <= 0 then 0 else if y >= ymax then ymax else y -> y in
let G2Dhsv2rgb itof hcolor (itof scolor)/. 100.0 (itof y)/.(itof ymax) -> color in
let bmpworkstr.EDC_bitmap -> [contw _ _ _ _ _ _ _ _] in
let _GETcontainerPositionSize contw -> [_ _ w h] in
let ftoi getEdCtrlFloatValue atxtstr -> fa in
let [hcolor*w/360 scolor*2] -> [crossx crossy] in
(
setEdCtrlFloatCbChange rtxtstr nil;
setEdCtrlFloatCbChange gtxtstr nil;
setEdCtrlFloatCbChange btxtstr nil;
setEdCtrlEditTextCbChange htxtstr nil;
_CHANGEobjNodeCoordinates _CONVERTcompBitmapToObjNode ccross [crossx-12 crossy-12] 1;
setEdCtrlFloatValue rtxtstr itof color&255;
setEdCtrlFloatValue gtxtstr itof (color>>8)&255;
setEdCtrlFloatValue btxtstr itof (color>>16)&255;
setEdCtrlEditTextValue htxtstr G2DformatHexaColorI color;
fillEdColorMapRuller bmprulerstr color;
setEdCtrlBitmapColor bmpsamplestr color;
setEdCtrlFloatCbChange rtxtstr mkfun3 @cbEdColorMapValueChange p;
setEdCtrlFloatCbChange gtxtstr mkfun3 @cbEdColorMapValueChange p;
setEdCtrlFloatCbChange btxtstr mkfun3 @cbEdColorMapValueChange p;
setEdCtrlEditTextCbChange htxtstr mkfun3 @cbEdColorMapExaValueChange p;
mutate p <- [(if (mode != 1) then color else (G2Drgb2rgba color fa)) _ [hcolor scolor y*100/ymax] _ _ _ _ _ _ _ _ _ _];
);
0;;
/*! \brief Callback on a color map control ruler click
*
* Private
*
* Prototype: fun [ObjContainer [...] I I I I] I
*
* \return 0
**/
fun cbEdColorMapRulerCursorClick(cont, p, x, y, btn, mask) =
if btn != 1 then nil else
cbEdColorMapRulerCursorMove cont p x y MK_LBUTTON;
0;;
/*! \brief Callback on a color map control ok click
*
* Private
*
* Prototype: fun [EdControl [[...] EdWindow fun [I] u0]] I
*
* \return 0
**/
fun cbEdColorMapOk(ctrlstr, param)=
let param -> [p winstr cbfun] in
let p -> [ccolor mode hsvcolor bmpworkstr bmpsamplestr bmprulerstr htxtstr rtxtstr gtxtstr btxtstr atxtstr ccross pickcursor] in
(
exec cbfun with [ccolor];
dsEdWindow winstr;
);
0;;
/*! \brief Callback on a color map control cancel click
*
* Private
*
* Prototype: fun [EdControl [[...] EdWindow fun [I] u0]] I
*
* \return 0
**/
fun cbEdColorMapCancel(ctrlstr, param)=
let param -> [p winstr cbfun] in
(
exec cbfun with [nil];
dsEdWindow winstr;
);
0;;
/*! \brief Callback on a color map control screen color picker timer timeout
*
* Private
*
* Prototype: fun [Timer [ObjWin ObjContainer [...]]] I
*
* \return 0
**/
fun cbEdColorMapScreenPickerTimer(tmr, param)=
let param -> [win cont p] in
let p -> [ccolor mode hsvcolor bmpworkstr bmpsamplestr bmprulerstr htxtstr rtxtstr gtxtstr btxtstr atxtstr ccross pickcursor] in
let _GETscreenPos -> [wx wy] in
(
_MVwindow win wx-1 wy-1;
_SETcontainerCursor cont pickcursor;
);
0;;
/*! \brief Callback on a color map control screen color picker click
*
* Private
*
* Prototype: fun [ObjContainer [...] I I I I] I
*
* \return 0
**/
fun cbEdColorMapScreenPickerClick(cont, param, x, y, btn, m)=
let param -> [ch win p] in
let p -> [ccolor mode hsvcolor bmpworkstr bmpsamplestr bmprulerstr htxtstr rtxtstr gtxtstr btxtstr atxtstr ccross pickcursor] in
(
_DSwindow win;
_DScontainer cont;
_deltimer tmrEdColorMapMousePicker;
if btn != 1 then nil else
let _GETscreenPos -> [wx wy] in
let _CAPTUREscreen (_CRbitmap ch 1 1) wx wy 1 1 0 -> bmp in
let _GETpixel24 bmp 0 0 -> color in
let if (mode == -1) then
let G2Dgetbgr color -> [bc gc rc] in
(make_rgb rc rc rc)
else color -> color in
let bmpworkstr.EDC_bitmap -> [contw _ _ _ _ _ _ _ _] in
let _GETcontainerPositionSize contw -> [_ _ w h] in
let G2Drgb2hsv color -> [hc sc vc] in
let [(ftoi hc) (ftoi (sc *. 100.0)) (ftoi (vc *. 100.0))] -> [hcolor scolor vcolor] in
let ftoi getEdCtrlFloatValue atxtstr -> fa in
let [hcolor*w/360 scolor*2] -> [crossx crossy] in
(
setEdCtrlFloatCbChange rtxtstr nil;
setEdCtrlFloatCbChange gtxtstr nil;
setEdCtrlFloatCbChange btxtstr nil;
setEdCtrlEditTextCbChange htxtstr nil;
_CHANGEobjNodeCoordinates _CONVERTcompBitmapToObjNode ccross [crossx-12 crossy-12] 1;
setEdCtrlFloatValue rtxtstr itof color&255;
setEdCtrlFloatValue gtxtstr itof (color>>8)&255;
setEdCtrlFloatValue btxtstr itof (color>>16)&255;
setEdCtrlEditTextValue htxtstr G2DformatHexaColorI color;
fillEdColorMapRuller bmprulerstr color;
setEdCtrlBitmapColor bmpsamplestr color;
setEdCtrlFloatCbChange rtxtstr mkfun3 @cbEdColorMapValueChange p;
setEdCtrlFloatCbChange gtxtstr mkfun3 @cbEdColorMapValueChange p;
setEdCtrlFloatCbChange btxtstr mkfun3 @cbEdColorMapValueChange p;
setEdCtrlEditTextCbChange htxtstr mkfun3 @cbEdColorMapExaValueChange p;
// INVERT RGB ?
mutate p <- [(if (mode != 1) then color else (G2Drgb2rgba color fa)) _ [hcolor scolor vcolor] _ _ _ _ _ _ _ _ _ _];
_DSbitmap bmp;
);
);;
/*! \brief Callback on a color map control screen color picker
*
* Private
*
* Prototype: fun [EdToolBar CompRollOver I I [...]] I
*
* \return 0
**/
fun cbEdColorMapScreenPicker(tbstr, cmproll, btn, mask, p)=
let p -> [ccolor mode hsvcolor bmpworkstr bmpsamplestr bmprulerstr htxtstr rtxtstr gtxtstr btxtstr atxtstr ccross pickcursor] in
let _GETscreenPos -> [wx wy] in
let _TOPwindow _CRwindow tbstr.ETB_channel nil wx-1 wy-1 2 2 WN_NOBORDER|WN_NOCAPTION|WN_TRANSPARENCY "" -> capwin in
let _TOPcontainer _CRcontainerFromObjWin tbstr.ETB_channel capwin 0 0 2 2 CO_NOBORDER|CO_NOCAPTION|CO_CHILDINSIDE nil "" -> newcont in
(
_CBcontainerClick newcont @cbEdColorMapScreenPickerClick [tbstr.ETB_channel capwin p];
_SETcontainerTransparency newcont nil 1 WN_TRANS_ALPHA;
_SETcontainerCursor newcont pickcursor;
set tmrEdColorMapMousePicker = _rfltimer (_starttimer tbstr.ETB_channel 50) @cbEdColorMapScreenPickerTimer [capwin newcont p];
);
0;;
/*! \brief Callback on a color map control destroy
*
* Private
*
* Prototype: fun [EdWindow [...]] I
*
* \return 0
**/
fun cbEdColorMapDestroy(winstr, p)=
let p -> [ccolor mode hsvcolor bmpworkstr bmpsamplestr bmprulerstr htxtstr rtxtstr gtxtstr btxtstr atxtstr ccross pickcursor] in
(
_DScompBitmap ccross;
);
0;;
/*! @ingroup g2dColormap
* \brief Create a Color map control
*
* Prototype: fun [Chn EdWindow I I S EdTheme fun [I] u0] EdControl
*
* \param Chn : Scol channel
* \param EdWindow : parent control window
* \param I : default color
* \param I : 1 for RGBA colors, 0 for RGB
* \param S : window title
* \param EdTheme : theme structure to use
* \param fun [I] u0 : color selection callback
*
* \return EdControl
**/
fun crEdColorMap(chan, fatherstr, color, mode, name, themestr, cbfun)=
let if color == nil then 0 else color -> color in
let if themestr == nil then (if EdDefaultTheme == nil then (set EdDefaultTheme = makeEdThemeResources chan) else EdDefaultTheme) else themestr -> themestr in
let themestr.EDT_abmpColorMapPickerBtn -> abmpcpick in
let if (mode != 1) then color else G2Dbgra2bgr color -> bgrcolor in
let G2Dgetbgr bgrcolor -> [bc gc rc] in
let if (mode == -1) then [rc rc rc] else [bc gc rc] -> [bc gc rc] in
let if (mode == -1) then (make_rgb rc rc rc) else bgrcolor -> bgrcolor in
let if (mode == 1) then G2DgetAlphaFromColor color else nil -> alpha in
let [345 330] -> [w h] in
let _GETscreenSize -> [ww wh] in
let wh - 40 -> wh in
let crEdDialogWindow chan fatherstr ((ww / 2) - (w / 2)) ((wh / 2) - (h / 2)) w h WN_MENU nil name -> winstr in
let if (mode == -1) then nil else crEdCtrlBitmap winstr 10 10 263 200 themestr.EDT_sColorMap nil nil -> bmpworkstr in
let crEdCtrlBitmap winstr 10 220 40 40 nil bgrcolor nil -> bmpsamplestr in
let if (mode == -1) then crEdCtrlBitmap winstr 10 10 (w-20) 200 nil bgrcolor nil else crEdCtrlBitmap winstr 288 10 20 200 nil bgrcolor nil -> bmprulerstr in
let crEdCtrlLabel winstr 60 232 15 20 "#" nil -> hlabel in
let crEdCtrlEditText winstr 75 230 60 20 G2DformatHexaColorI bgrcolor ET_BORDER|ET_TABFOCUS nil -> htxtstr in
let if (mode != 1) then nil else crEdCtrlLabel winstr 145 232 40 20 "Alpha :" nil -> alabel in
let if (mode != 1) then nil else crEdCtrlFloat winstr 190 230 60 20 (itof alpha) 0.0 127.0 1.0 0 themestr nil -> atxtstr in
let crEdCtrlLabel winstr 10 272 25 20 if (mode != 1) then "L" else "R :" nil -> rlabel in
let crEdCtrlFloat winstr 35 270 60 20 (itof rc) 0.0 255.0 1.0 0 themestr nil -> rtxtstr in
let if (mode == -1) then nil else crEdCtrlLabel winstr 105 272 25 20 "G :" nil -> glabel in
let if (mode == -1) then nil else crEdCtrlFloat winstr 130 270 60 20 (itof gc) 0.0 255.0 1.0 0 themestr nil -> gtxtstr in
let if (mode == -1) then nil else crEdCtrlLabel winstr 200 272 25 20 "B :" nil -> blabel in
let if (mode == -1) then nil else crEdCtrlFloat winstr 225 270 60 20 (itof bc) 0.0 255.0 1.0 0 themestr nil -> btxtstr in
let crEdCtrlButton winstr 10 (h - 30) 60 20 (locDef "OS3D_0282" "Ok") nil -> okbtnstr in
let crEdCtrlButton winstr 100 (h - 30) 60 20 (locDef "OS3D_0513" "Cancel") nil -> cancelbtnstr in
let crEdWindowToolBar winstr (w - 34) 268 24 24 0 0 themestr.EDT_iToolBarColor nil -> tbstr in
let bmpworkstr.EDC_bitmap -> [contwork _ cmbpwork _ _ _ _ _ _] in
let bmprulerstr.EDC_bitmap -> [contruler _ _ _ _ _ _ _ _] in
let G2Drgb2hsv bgrcolor -> [hc sc vc] in
let [(ftoi hc) (ftoi (sc *. 100.0)) (ftoi (vc *. 100.0))] -> [hcolor scolor vcolor] in
let [hcolor*263/360 scolor*2] -> [crossx crossy] in
let if (mode == -1) then nil else _CRcompBitmap winstr.EDW_channel contwork (_CONVERTcompBitmapToObjNode cmbpwork)
[9 9] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_CLICK|OBJ_CONTAINER_MOVE
themestr.EDT_abmpColorMapCross 0 0 25 25 -> ccross in
let [color mode [hcolor scolor vcolor] bmpworkstr bmpsamplestr bmprulerstr htxtstr rtxtstr gtxtstr btxtstr atxtstr ccross themestr.EDT_cursorColorPicker] -> pcolormap in
let crEdToolBarButton tbstr abmpcpick ETB_ALIGN_LEFT (locDef "OS3D_0549" "Color picker") mkfun5 @cbEdColorMapScreenPicker pcolormap -> pickbtnstr in
(
fillEdColorMapRuller bmprulerstr bgrcolor;
setEdCtrlFloatCbChange rtxtstr mkfun3 @cbEdColorMapValueChange pcolormap;
if (mode == -1) then nil else
(
_CHANGEobjNodeCoordinates _CONVERTcompBitmapToObjNode ccross [crossx-12 crossy-12] 1;
_SETcontainerCursor contwork themestr.EDT_cursorColorPicker;
setEdCtrlFloatCbChange gtxtstr mkfun3 @cbEdColorMapValueChange pcolormap;
setEdCtrlFloatCbChange btxtstr mkfun3 @cbEdColorMapValueChange pcolormap;
setEdCtrlFloatCbChange atxtstr mkfun3 @cbEdColorMapValueChange pcolormap;
_CBcontainerClick contwork @cbEdColorMapCrossCursorClick pcolormap;
_CBcontainerCursorMove contwork @cbEdColorMapCrossCursorMove pcolormap;
);
setEdCtrlEditTextCbChange htxtstr mkfun3 @cbEdColorMapExaValueChange pcolormap;
_CBcontainerClick contruler @cbEdColorMapRulerCursorClick pcolormap;
_CBcontainerCursorMove contruler @cbEdColorMapRulerCursorMove pcolormap;
setEdCtrlButtonCb okbtnstr mkfun2 @cbEdColorMapOk [pcolormap winstr cbfun];
setEdCtrlButtonCb cancelbtnstr mkfun2 @cbEdColorMapCancel [pcolormap winstr cbfun];
if (mode == -1) then nil else
_PAINTcontainer contwork;
paintEdToolBar tbstr;
_TOPwindow winstr.EDW_win;
_SETfocus winstr.EDW_win;
setEdwindowCbDestroy winstr mkfun2 @cbEdColorMapDestroy pcolormap;
winstr;
);;
/* ********************************************************************************************* /
Control Color Button
/ ********************************************************************************************* */
/*! \brief Fill a color button control with a color
*
* Private
*
* Prototype: fun [EdControl I] I
*
* \return 0
**/
fun updateEdCtrlColorButton(ctrlstr, color)=
if color == nil then nil else
let ctrlstr.EDC_colorButton -> [btn obmp winstr _ mode cbfun] in
let _GETbuttonSizePosition btn -> [w h _ _] in
let if (mode != 1) then color else G2Dbgra2bgr color -> bgrcolor in
let _FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgrcolor -> bmp in
(
_DSbitmap obmp;
_SETbuttonBitmap btn bmp;
mutate ctrlstr.EDC_colorButton <- [_ bmp _ color _ _];
_PAINTbutton btn;
);
0;;
/*! \brief Callback on a color button control, color selection
*
* Private
*
* Prototype: fun [I EdControl] I
*
* \return 0
**/
fun cbEdCtrlColorButtonSelect(color, ctrlstr)=
let ctrlstr.EDC_colorButton -> [btn obmp winstr ocolor mode cbfun] in
let if color == nil then ocolor else color -> color in
(
updateEdCtrlColorButton ctrlstr color;
mutate ctrlstr.EDC_colorButton <- [_ _ nil color _ _];
exec cbfun with [ctrlstr color];
);
0;;
/*! @ingroup g2dColorBtn
* \brief Get a Color button control color
*
* Prototype: fun [EdControl] I
*
* \param EdControl : Color button control structure
*
* \return I : the button color
**/
fun getEdCtrlColorButtonColor(ctrlstr)=
let ctrlstr.EDC_colorButton -> [btn obmp winstr color mode cbfun] in
color;;
/*! @ingroup g2dColorBtn
* \brief Set a Color button control color
*
* Prototype: fun [EdControl I] EdControl
*
* \param EdControl : Color button control structure
* \param I : new Color
*
* \return EdControl : the button
**/
fun setEdCtrlColorButtonColor(ctrlstr, color)=
let ctrlstr.EDC_colorButton -> [btn obmp winstr ocolor mode cbfun] in
let if color == nil then ocolor else color -> color in
(
updateEdCtrlColorButton ctrlstr color;
dsEdWindow winstr;
mutate ctrlstr.EDC_colorButton <- [_ _ nil color _ _];
ctrlstr;
);;
/*! @ingroup g2dColorBtn
* \brief Set a Color button control state
*
* Prototype: fun [EdControl I] EdControl
*
* \param EdControl : Color button control structure
* \param I : new state
*
* \return EdControl : the button
**/
fun setEdCtrlColorButtonEnable(ctrlstr, state)=
let ctrlstr.EDC_colorButton -> [btn obmp winstr ocolor mode cbfun] in
(
_ENbutton btn state;
ctrlstr;
);;
/*! \brief Callback on a color button control destroy
*
* Private
*
* Prototype: fun [EdWindow EdControl] I
*
* \return 0
**/
fun cbEdCtrlColorButtonMapDestroy(winstr, ctrlstr)=
mutate ctrlstr.EDC_colorButton <- [_ _ nil _ _ _];
0;;
/*! \brief Callback on a color button control click
*
* Private
*
* Prototype: fun [ObjButton EdControl] I
*
* \return 0
**/
fun cbEdCtrlColorButton(btn, ctrlstr)=
let ctrlstr.EDC_colorButton -> [btn obmp winstr color mode cbfun] in
if winstr != nil then
(
_SETfocus winstr.EDW_win;
0;
)
else
(
let crEdColorMap ctrlstr.EDC_channel ctrlstr.EDC_father color mode (locDef "OS3D_0550" "Color selector") ctrlstr.EDC_theme mkfun2 @cbEdCtrlColorButtonSelect ctrlstr -> winstr in
(
setEdwindowCbDestroy winstr mkfun2 @cbEdCtrlColorButtonMapDestroy ctrlstr;
mutate ctrlstr.EDC_colorButton <- [_ _ winstr _ _ _];
);
0;
);
0;;
/*! @ingroup g2dColorBtn
* \brief Define a Color button control, color selection callback
*
* Prototype: fun [EdControl fun [EdControl I] u0] I
*
* \param EdControl : Color button control structure
* \param fun [EdControl I] u0 : selection callback
* \param - EdControl : the same Color button control structure
* \param - I : the selected color
*
* \return 0
**/
fun setEdCtrlColorButtonCb(ctrlstr, cbfun)=
mutate ctrlstr.EDC_colorButton <- [_ _ _ _ _ cbfun];
0;;
/*! @ingroup g2dColorBtn
* \brief Create a Color button control
*
* Prototype: fun [Chn EdWindow I I S EdTheme fun [I] u0] EdControl
*
* \param EdWindow : parent control window
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param I : default color
* \param I : 1 for RGBA colors, 0 for RGB
* \param I : resize flags
* \param EdTheme : theme structure to use
*
* \return EdControl
**/
fun crEdCtrlColorButton(winstr, x, y, w, h, color, mode, resize, themestr)=
let if color == nil then 0 else color -> color in
let if themestr == nil then (if EdDefaultTheme == nil then (set EdDefaultTheme = makeEdThemeResources winstr.EDW_channel) else EdDefaultTheme) else themestr -> themestr in
let mkEdControl [winstr.EDW_channel winstr resize themestr nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let if (mode != 1) then color else G2Drgba2rgb color -> bgrcolor in
let _FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgrcolor -> bmp in
let _CRbuttonBitmap ctrlstr.EDC_channel father bmp x y w h PB_TABFOCUS -> button in
(
set ctrlstr.EDC_colorButton = [button bmp nil color mode nil];
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
_CBbutton button @cbEdCtrlColorButton ctrlstr;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
ctrlstr;
);;
/*! @ingroup g2dColorBtn
* \brief Destroy a Color button control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : Color button control structure
*
* \return 0
**/
fun dsEdCtrlColorButton(ctrlstr)=
let ctrlstr.EDC_colorButton -> [button bitmap winstr _ _ _] in
(
dsEdWindow winstr;
_DSbitmap bitmap;
_DSbutton button;
);
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Slider
/ ********************************************************************************************* */
/*! \brief Get the key position of a Time line control
*
* Private
*
* Prototype: fun [EdTLKey] I
*
* \return I : the position
**/
fun getEdCtrlTimeLineKeyPos(keystr)=
let keystr.EDTLK_track -> trackstr in
let nil -> pos in
(
let sizelist trackstr.EDTLT_lKey -> size in
let 0 -> i in
while i < size && pos == nil do
(
if ((nth_list trackstr.EDTLT_lKey i) != keystr) then nil else
set pos = i;
set i = i + 1;
);
pos;
);;
/*! \brief Update a Slider control
*
* Private
*
* Prototype: fun [EdControl] I
*
* \return 0
**/
fun updateEdCtrlSliderCursor(ctrlstr)=
let ctrlstr.EDC_slider -> sliderstr in
let _GETcontainerPositionSize sliderstr.EDSLIDER_cont -> [_ _ cw ch] in
let absf (sliderstr.EDSLIDER_fMaxValue -. sliderstr.EDSLIDER_fMinValue) -> length in
let if length == 0.0 then 0 else ftoi ((itof cw) /. length *. (sliderstr.EDSLIDER_fValue -. sliderstr.EDSLIDER_fMinValue)) -> x in
(
_CHANGEobjNodeCoordinates sliderstr.EDSLIDER_nodeCursor [x-8 1] 1;
);
0;;
/*! @ingroup g2dSlider
* \brief Set a Slider control value
*
* Prototype: fun [EdControl F] I
*
* \param EdControl : Slider control structure
* \param F : the new value
*
* \return 0
**/
fun setEdCtrlSliderValue(ctrlstr, value)=
let ctrlstr.EDC_slider -> sliderstr in
let if value <. sliderstr.EDSLIDER_fMinValue then
sliderstr.EDSLIDER_fMinValue
else if value >. sliderstr.EDSLIDER_fMaxValue then
sliderstr.EDSLIDER_fMaxValue else value
-> value in
set sliderstr.EDSLIDER_fValue = value;
updateEdCtrlSliderCursor ctrlstr;
0;;
/*! @ingroup g2dSlider
* \brief Get a Slider control value
*
* Prototype: fun [EdControl] F
*
* \param EdControl : Slider control structure
*
* \return F : the slider value
**/
fun getEdCtrlSliderValue(ctrlstr)=
let ctrlstr.EDC_slider -> sliderstr in
sliderstr.EDSLIDER_fValue;;
/*! \brief Callback of a Slider control click
*
* Private
*
* Prototype: fun [ObjContainer EdControl I I I I] I
*
* \return 0
**/
fun cbCtrlSliderContClick(cont, ctrlstr, x, y, btn, mask)=
let ctrlstr.EDC_slider -> sliderstr in
let _GETcontainerPositionSize sliderstr.EDSLIDER_cont -> [_ _ cw ch] in
let absf (sliderstr.EDSLIDER_fMaxValue -. sliderstr.EDSLIDER_fMinValue) -> length in
let if length == 0.0 then 0.0 else sliderstr.EDSLIDER_fMinValue +. (itof x) /. ((itof cw) /. length) -> value in
(
setEdCtrlSliderValue ctrlstr value;
exec sliderstr.EDSLIDER_cbValue with [ctrlstr sliderstr.EDSLIDER_fValue];
);
0;;
/*! \brief Refresh a Slider control background
*
* Private
*
* Prototype: fun [EdControl] I
*
* \return 0
**/
fun refreshEdCtrlSliderBackground(ctrlstr)=
let ctrlstr.EDC_slider -> sliderstr in
let _GETalphaBitmaps sliderstr.EDSLIDER_abmpBack -> [buffer _] in
let _GETcontainerPositionSize sliderstr.EDSLIDER_cont -> [_ _ w h] in
if (buffer == nil) then nil else
(
if (EdDefaultTheme == nil) then (set EdDefaultTheme = makeEdThemeResources ctrlstr.EDC_channel) else nil;
let _FILLbitmap buffer EdDefaultTheme.EDT_iMainBackgroundColor -> bmp in
let 0 -> i in
let absf (sliderstr.EDSLIDER_fMaxValue -. sliderstr.EDSLIDER_fMinValue) -> length in
let
if length == 0.0 then
1.0
else if length <=. 1.0 then
length *. 10.0
else
length
-> length in
let (itof w) /. length -> fstep in
let if fstep <. 2.0 then 2 else ftoi fstep -> step in
(
while i < w do
(
_BTDRAWline bmp [i ((h /3) * 2)] [i h] 0xffffff 1;
set i = i + step;
);
);
_PAINTobjNode _CONVERTcompBitmapToObjNode sliderstr.EDSLIDER_cbmpBack;
);
0;;
/*! \brief Update a Slider control background bitmap
*
* Private
*
* Prototype: fun [EdControl I I] I
*
* \return 0
**/
fun updateEdCtrlSliderBackgroundBmp(ctrlstr, w, h)=
let ctrlstr.EDC_slider -> sliderstr in
(
if sliderstr.EDSLIDER_abmpBack == nil then nil else
_DSalphaBitmap sliderstr.EDSLIDER_abmpBack;
if (EdDefaultTheme == nil) then (set EdDefaultTheme = makeEdThemeResources ctrlstr.EDC_channel) else nil;
let _FILLbitmap _CRbitmap ctrlstr.EDC_channel w h EdDefaultTheme.EDT_iMainBackgroundColor -> bmp in
let 0 -> i in
let absf (sliderstr.EDSLIDER_fMaxValue -. sliderstr.EDSLIDER_fMinValue) -> length in
let
if length == 0.0 then
1.0
else if length <=. 1.0 then
length *. 10.0
else
length
-> length in
let (itof w) /. length -> fstep in
let if fstep <. 2.0 then 2 else ftoi fstep -> step in
(
while i < w do
(
_BTDRAWline bmp [i ((h /3) * 2)] [i h] 0xffffff 1;
set i = i + step;
);
let _CRalphaBitmap ctrlstr.EDC_channel bmp nil nil nil -> abmp in
(
_DSbitmap bmp;
set sliderstr.EDSLIDER_abmpBack = abmp;
);
);
);;
/*! @ingroup g2dSlider
* \brief Set a Slider control maximum value
*
* Prototype: fun [EdControl F] I
*
* \param EdControl : Slider control structure
* \param F : the new maximum value
*
* \return 0
**/
fun setEdCtrlSliderMaxValue(ctrlstr, value)=
let ctrlstr.EDC_slider -> sliderstr in
(
set sliderstr.EDSLIDER_fMaxValue = value;
refreshEdCtrlSliderBackground ctrlstr;
updateEdCtrlSliderCursor ctrlstr;
);
0;;
/*! @ingroup g2dSlider
* \brief Set a Slider control minimum value
*
* Prototype: fun [EdControl F] I
*
* \param EdControl : Slider control structure
* \param F : the new minimum value
*
* \return 0
**/
fun setEdCtrlSliderMinValue(ctrlstr, value)=
let ctrlstr.EDC_slider -> sliderstr in
(
set sliderstr.EDSLIDER_fMinValue = value;
refreshEdCtrlSliderBackground ctrlstr;
updateEdCtrlSliderCursor ctrlstr;
);
0;;
/*! \brief Callback of a Slider control background resize
*
* Private
*
* Prototype: fun [CompBitmap EdControl I I [I I I I]] I
*
* \return 0
**/
fun cbEdCtrlSliderBackgroundResize(cmpbmp, ctrlstr, w, h, coords)=
let ctrlstr.EDC_slider -> sliderstr in
let coords -> [x y _ _ ] in
(
updateEdCtrlSliderCursor ctrlstr;
[(updateEdCtrlSliderBackgroundBmp ctrlstr w h) [x y w h]];
);;
/*! \brief Callback of a Slider control tooltip hide
*
* Private
*
* Prototype: fun [ObjNode EdControl S] I
*
* \return 0
**/
fun cbEdCtrlSliderToolTipHide(node, ctrlstr, bubble)=
let ctrlstr.EDC_slider -> sliderstr in
let sliderstr.EDSLIDER_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set sliderstr.EDSLIDER_tooltip = nil;
);
0;;
/*! \brief Callback of a Slider control tooltip show
*
* Private
*
* Prototype: fun [ObjNode EdControl S I I] I
*
* \return 0
**/
fun cbEdCtrlSliderToolTipShow(node, ctrlstr, bubble, dx, dy)=
let ctrlstr.EDC_slider -> sliderstr in
let (ftoa sliderstr.EDSLIDER_fValue) -> bubble in
(
if sliderstr.EDSLIDER_tooltip == nil then nil else
let sliderstr.EDSLIDER_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set sliderstr.EDSLIDER_tooltip = nil;
);
let G2DgetStringSize ctrlstr.EDC_theme.EDT_fontToolTip bubble -> [w h] in
let _GETWorkingAreaSize -> [sw sh] in
let sh - 40 -> sh in
let _GETscreenPos -> [sx sy] in
let [16 16] -> [xdecal ydecal] in
let if (sx + w + 4 + xdecal) > sw then (sw - (w + 4) - xdecal) else sx + xdecal -> x in
let if (sy + h + 4 + ydecal) > sh then (sh - (h + 4) - ydecal) else sy + ydecal -> y in
let (_CRcontainerFromObjWin ctrlstr.EDC_channel ctrlstr.EDC_father.EDW_win x y w+4 h+4 CO_NOCAPTION 0xffffff nil) -> tpcont in
let _CRcompText ctrlstr.EDC_channel tpcont nil [2 2] CT_LABEL|CT_LEFT|OBJ_VISIBLE nil w h bubble ctrlstr.EDC_theme.EDT_fontToolTip [0 nil nil nil] nil nil nil -> tptext in
(
set sliderstr.EDSLIDER_tooltip = [tpcont tptext];
_PAINTcontainer tpcont;
);
);
0;;
/*! \brief Callback of a Slider control cursor move
*
* Private
*
* Prototype: fun [ObjContainer EdControl I I I] I
*
* \return 0
**/
fun cbCtrlSliderCursorMove(cont, ctrlstr, x, y, btn)=
let ctrlstr.EDC_slider -> sliderstr in
let _GETcontainerPositionSize sliderstr.EDSLIDER_cont -> [_ _ cw ch] in
let absf (sliderstr.EDSLIDER_fMaxValue -. sliderstr.EDSLIDER_fMinValue) -> length in
let if length == 0.0 then 0.0 else sliderstr.EDSLIDER_fMinValue +. (itof x) /. ((itof cw) /. length) -> value in
(
setEdCtrlSliderValue ctrlstr value;
let sliderstr.EDSLIDER_tooltip -> [tpcont tptext] in
let _GETcontainerPositionSize tpcont -> [_ _ w h] in
let _GETscreenSize -> [sw sh] in
let sh - 40 -> sh in
let _GETscreenPos -> [sx sy] in
let [16 16] -> [xdecal ydecal] in
let if (sx + w + 4 + xdecal) > sw then (sw - (w + 4) - xdecal) else sx + xdecal -> x in
let if (sy + h + 4 + ydecal) > sh then (sh - (h + 4) - ydecal) else sy + ydecal -> y in
(
_SIZEcontainer tpcont x y w h;
_SETcompText tptext (ftoa sliderstr.EDSLIDER_fValue) ctrlstr.EDC_theme.EDT_fontToolTip [0 nil nil nil] CT_NOCHANGE;
_PAINTobjNode _CONVERTcompTextToObjNode tptext;
);
exec sliderstr.EDSLIDER_cbValue with [ctrlstr sliderstr.EDSLIDER_fValue];
);
0;;
/*! \brief Callback of a Slider control cursor unclick
*
* Private
*
* Prototype: fun [ObjContainer EdControl I I I I] I
*
* \return 0
**/
fun cbCtrlSliderUnlick(cont, ctrlstr, x, y, btn, mask)=
let ctrlstr.EDC_slider -> sliderstr in
(
_CBcontainerCursorMove sliderstr.EDSLIDER_cont nil nil;
_CBcontainerUnClick sliderstr.EDSLIDER_cont nil nil;
cbEdCtrlSliderToolTipHide sliderstr.EDSLIDER_nodeCursor ctrlstr nil;
);
0;;
/*! \brief Callback of a Slider control cursor click
*
* Private
*
* Prototype: fun [CompBitmap EdControl I I I I] I
*
* \return 0
**/
fun cbEdCtrlSliderCursorClick(cmpbmp, ctrlstr, x, y, btn, mask)=
let ctrlstr.EDC_slider -> sliderstr in
(
_CBcontainerCursorMove sliderstr.EDSLIDER_cont @cbCtrlSliderCursorMove ctrlstr;
_CBcontainerUnClick sliderstr.EDSLIDER_cont @cbCtrlSliderUnlick ctrlstr;
cbEdCtrlSliderToolTipShow sliderstr.EDSLIDER_nodeCursor ctrlstr nil x y;
);
0;;
/*! @ingroup g2dSlider
* \brief Define a Slider control value change callback function
*
* Prototype: fun [EdControl fun [EdControl F] u0] EdControl
*
* \param EdControl : Slider control structure
* \param fun [EdControl F] u0 : the callback function
* \param - EdControl : the same Slider control structure
* \param - F : the new value
*
* \return same EdControl
**/
fun setEdCtrlSliderCbValue(ctrlstr, cbfun)=
set ctrlstr.EDC_slider.EDSLIDER_cbValue = cbfun;
ctrlstr;;
/*! @ingroup g2dSlider
* \brief Create a Slider control
*
* Prototype: fun [Chn EdWindow I I S EdTheme fun [I] u0] EdControl
*
* \param EdWindow : parent control window
* \param I : X position
* \param I : Y position
* \param I : width
* \param I : height
* \param F : default value
* \param F : minimum value
* \param F : maximum value
* \param I : not used
* \param I : resize flags
* \param EdTheme : theme structure to use
*
* \return EdControl
**/
fun crEdCtrlSlider(winstr, x, y, w, h, val, minval, maxval, mode, resize, themestr)=
let if themestr == nil then (if EdDefaultTheme == nil then (set EdDefaultTheme = makeEdThemeResources winstr.EDW_channel) else EdDefaultTheme) else themestr -> themestr in
let mkEdControl [winstr.EDW_channel winstr resize themestr nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let _CRcontainerFromObjWin ctrlstr.EDC_channel father x y w h CO_CHILDINSIDE|CO_NOBORDER themestr.EDT_iMainBackgroundColor "" -> cont in
let mkEdSlider [nil nil nil nil nil nil nil nil nil nil nil] -> sliderstr in
(
set ctrlstr.EDC_slider = sliderstr;
set sliderstr.EDSLIDER_cont = cont;
set sliderstr.EDSLIDER_fMinValue = minval;
set sliderstr.EDSLIDER_fMaxValue = maxval;
let updateEdCtrlSliderBackgroundBmp ctrlstr w h -> babmp in
let _CRcompBitmap ctrlstr.EDC_channel cont nil [0 0] OBJ_ENABLE|OBJ_VISIBLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_CLICK|OBJ_CONTAINER_DBLCLICK|OBJ_CONTAINER_MOVE|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_KEYUP babmp 0 0 w h -> bcbmp in
(
set sliderstr.EDSLIDER_cbmpBack = bcbmp;
set sliderstr.EDSLIDER_abmpBack = babmp;
);
let h/3 * 2 -> cursorh in
let _FILLbitmap _CRbitmap ctrlstr.EDC_channel 16 cursorh 0 -> bmp in
let _DRAWpoly24 bmp 3 (listtotab [0 0]::[8 cursorh]::[16 0]::nil) DRAW_INVISIBLE 0 0 DRAW_SOLID 0xffffff -> bmp in
let _CRalphaBitmap ctrlstr.EDC_channel bmp nil 0 0 -> abmp in
let _CRcompBitmap ctrlstr.EDC_channel cont nil [0 1] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_DBLCLICK|OBJ_CONTAINER_MOVE|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_KEYUP abmp 0 0 16 cursorh -> cbmp in
(
_DSbitmap bmp;
set sliderstr.EDSLIDER_cbmpCursor = cbmp;
set sliderstr.EDSLIDER_abmpCursor = abmp;
set sliderstr.EDSLIDER_nodeCursor = _CONVERTcompBitmapToObjNode cbmp;
);
_CBcompBitmapResizeResource sliderstr.EDSLIDER_cbmpBack @cbEdCtrlSliderBackgroundResize ctrlstr;
_CBcompBitmapClick sliderstr.EDSLIDER_cbmpCursor @cbEdCtrlSliderCursorClick ctrlstr;
_CRtoolTip sliderstr.EDSLIDER_nodeCursor 150 (ftoa sliderstr.EDSLIDER_fValue) @cbEdCtrlSliderToolTipShow ctrlstr @cbEdCtrlSliderToolTipHide ctrlstr;
_CBcontainerUnClick sliderstr.EDSLIDER_cont @cbCtrlSliderContClick ctrlstr;
_CBcontainerClick sliderstr.EDSLIDER_cont @cbCtrlSliderContClick ctrlstr;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
setEdCtrlSliderValue ctrlstr val;
_PAINTcontainer sliderstr.EDSLIDER_cont;
ctrlstr;
);;
/*! @ingroup g2dSlider
* \brief Destroy a Slider control
*
* Prototype: fun [EdControl] I
*
* \param EdControl : Slider control structure
*
* \return 0
**/
fun dsEdCtrlSlider(ctrlstr)=
let ctrlstr.EDC_slider -> sliderstr in
(
if sliderstr.EDSLIDER_tooltip == nil then nil else
let sliderstr.EDSLIDER_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set sliderstr.EDSLIDER_tooltip = nil;
);
_DStoolTip sliderstr.EDSLIDER_nodeCursor;
_DScompBitmap sliderstr.EDSLIDER_cbmpCursor;
_DSalphaBitmap sliderstr.EDSLIDER_abmpCursor;
_DScompBitmap sliderstr.EDSLIDER_cbmpBack;
_DSalphaBitmap sliderstr.EDSLIDER_abmpBack;
_DScontainer sliderstr.EDSLIDER_cont;
set sliderstr.EDSLIDER_cont = nil;
);
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Time line editor
/ ********************************************************************************************* */
fun cbEdCtrlTimeLineKeyClick(cmpbmp, p, x, y, btn, mask)=
let p -> [ctrlstr keystr] in
(
selectEdCtrlTimeLineTrack ctrlstr keystr.EDTLK_track;
selectEdCtrlTimeLineKey ctrlstr keystr;
);
0;;
fun cbEdCtrlTimeLineTrackClick(cont, p, x, y, btn, mask)=
let p -> [ctrlstr trackstr] in
let ctrlstr.EDC_timeLineEditor -> timelinestr in
(
selectEdCtrlTimeLineTrack ctrlstr trackstr;
selectEdCtrlTimeLineKey ctrlstr nil;
);
0;;
fun getEdCtrlTimeLineSelectedTrack(ctrlstr)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
timelinestr.EDTLE_selectedTrack;;
fun getEdCtrlTimeLineTrackByPos(ctrlstr, trackidx)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
nth_list timelinestr.EDTLE_lTrack trackidx;;
fun getEdCtrlTimeLineTrackPos(trackstr)=
let trackstr.EDTLT_timeLineEditor -> timelinestr in
let nil -> pos in
(
let sizelist timelinestr.EDTLE_lTrack -> size in
let 0 -> i in
while i < size && pos == nil do
(
if ((nth_list timelinestr.EDTLE_lTrack i) != trackstr) then nil else
set pos = i;
set i = i + 1;
);
pos;
);;
fun getEdCtrlTimeLineSelectedKey(ctrlstr)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
timelinestr.EDTLE_selectedKey;;
fun getEdCtrlTimeLineKeyByPos(trackstr, keyidx)=
nth_list trackstr.EDTLT_lKey keyidx;;
fun getEdCtrlTimeLineKeyTrack(keystr)= keystr.EDTLK_track;;
fun getEdCtrlTimeLineTrackKeys(trackstr)=
trackstr.EDTLT_lKey;;
fun updateCtrlTimeLineKey(ctrlstr, keystr)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
let getEdCtrlTimeLineKeyPos keystr -> keypos in
let getEdCtrlTimeLineKeyByPos keystr.EDTLK_track (keypos - 1) -> prevkeystr in
(
/*
let mboxstr.EDB_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set mboxstr.EDB_tooltip = nil;
);
_DStoolTip mboxstr.EDB_node;
*/
if (keystr.EDTLK_cbmpKey == nil) then nil else
(
_DScompBitmap keystr.EDTLK_cbmpKey;
_DSalphaBitmap keystr.EDTLK_abmpKey;
_DSbitmap keystr.EDTLK_bmpOn;
_DSbitmap keystr.EDTLK_bmpOff;
);
//let G2DgetStringSize ctrlstr.EDC_theme.EDT_fontTimeLineEditor keystr.EDTLK_sName -> [w _] in
let if (prevkeystr == nil) then 0 else
let _GETobjNodePositionSizeInFatherRef prevkeystr.EDTLK_node -> [cx _ cw _] in
cx + cw
-> startpos in
let ftoi ((itof timelinestr.EDTLE_iPixelPerUnit) *. keystr.EDTLK_fKeyPos) -> pos in
let ftoi ((itof timelinestr.EDTLE_iPixelPerUnit) *. keystr.EDTLK_fKeyLength) -> w in
let if keystr == timelinestr.EDTLE_selectedKey then 1 else 0 -> selected in
let _BTDRAWrect (_FILLbitmap _CRbitmap ctrlstr.EDC_channel w timelinestr.EDTLE_iTrackHeight ctrlstr.EDC_theme.EDT_iTimeLineEditorKeyOff) [0 0 w timelinestr.EDTLE_iTrackHeight] ctrlstr.EDC_theme.EDT_iTimeLineEditorKeyBorderOff ctrlstr.EDC_theme.EDT_iTimeLineEditorBorderWidth 0 nil -> bmpoff in
let _BTDRAWrect (_FILLbitmap _CRbitmap ctrlstr.EDC_channel w timelinestr.EDTLE_iTrackHeight ctrlstr.EDC_theme.EDT_iTimeLineEditorKeyOn) [0 0 w timelinestr.EDTLE_iTrackHeight] ctrlstr.EDC_theme.EDT_iTimeLineEditorKeyBorderOn ctrlstr.EDC_theme.EDT_iTimeLineEditorBorderWidth 0 nil -> bmpon in
(
if (pos >= startpos) then nil else
let startpos - pos -> transw in
(
_BTDRAWrect bmpoff [0 0 transw timelinestr.EDTLE_iTrackHeight] ctrlstr.EDC_theme.EDT_iTimeLineEditorKeyBorderOff ctrlstr.EDC_theme.EDT_iTimeLineEditorBorderWidth 1 ctrlstr.EDC_theme.EDT_iTimeLineEditorKeyInterOff;
_BTDRAWrect bmpon [0 0 transw timelinestr.EDTLE_iTrackHeight] ctrlstr.EDC_theme.EDT_iTimeLineEditorKeyBorderOn ctrlstr.EDC_theme.EDT_iTimeLineEditorBorderWidth 1 ctrlstr.EDC_theme.EDT_iTimeLineEditorKeyInterOn;
_BTDRAWline bmpoff [0 0] [transw timelinestr.EDTLE_iTrackHeight] ctrlstr.EDC_theme.EDT_iTimeLineEditorKeyBorderOff ctrlstr.EDC_theme.EDT_iTimeLineEditorBorderWidth;
_BTDRAWline bmpoff [0 timelinestr.EDTLE_iTrackHeight] [transw 0] ctrlstr.EDC_theme.EDT_iTimeLineEditorKeyBorderOff ctrlstr.EDC_theme.EDT_iTimeLineEditorBorderWidth;
_BTDRAWline bmpon [0 0] [transw timelinestr.EDTLE_iTrackHeight] ctrlstr.EDC_theme.EDT_iTimeLineEditorKeyBorderOn ctrlstr.EDC_theme.EDT_iTimeLineEditorBorderWidth;
_BTDRAWline bmpon [0 timelinestr.EDTLE_iTrackHeight] [transw 0] ctrlstr.EDC_theme.EDT_iTimeLineEditorKeyBorderOn ctrlstr.EDC_theme.EDT_iTimeLineEditorBorderWidth;
);
_DRAWtext bmpoff ctrlstr.EDC_theme.EDT_fontTimeLineEditor (w / 2) 10 TD_CENTER ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOff keystr.EDTLK_sName;
_DRAWtext bmpon ctrlstr.EDC_theme.EDT_fontTimeLineEditor (w / 2) 10 TD_CENTER ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOn keystr.EDTLK_sName;
set keystr.EDTLK_bmpOff = bmpoff;
set keystr.EDTLK_bmpOn = bmpon;
set keystr.EDTLK_abmpKey = _CRalphaBitmap ctrlstr.EDC_channel (if selected then bmpon else bmpoff) nil nil nil;
set keystr.EDTLK_cbmpKey = _CRcompBitmap ctrlstr.EDC_channel keystr.EDTLK_track.EDTLT_cont nil [pos 0] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_MOVE keystr.EDTLK_abmpKey 0 0 w timelinestr.EDTLE_iTrackHeight;
set keystr.EDTLK_node = _CONVERTcompBitmapToObjNode keystr.EDTLK_cbmpKey;
//setEdCtrlModuleEditorBoxTooltip ctrlstr mboxstr mboxstr.EDB_sToolTip;
_CBcompBitmapClick keystr.EDTLK_cbmpKey @cbEdCtrlTimeLineKeyClick [ctrlstr keystr];
/*
_CBcompBitmapUnClick mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxUnClick [ctrlstr mboxstr];
_CBcompBitmapDblClick mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxDbClick [ctrlstr mboxstr];
_CBcompBitmapCursorMoveIn mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxMoveIn [ctrlstr mboxstr];
_CBcompBitmapCursorMoveOut mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxMoveOut [ctrlstr mboxstr];
*/
_PAINTobjNode keystr.EDTLK_node;
);
);
0;;
fun updateEdCtrlTimeLineTracks(ctrlstr, mode)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
let sizelist timelinestr.EDTLE_lTrack -> nbtrack in
(
let getEdWindowSize timelinestr.EDTLE_winDmi -> [w h] in
let 0 -> i in
while i < nbtrack do
(
let nth_list timelinestr.EDTLE_lTrack i -> trackstr in
(
if !mode then nil else
let sizelist trackstr.EDTLT_lKey -> ksize in
let 0 -> k in
while k < ksize do
(
let nth_list trackstr.EDTLT_lKey k -> keystr in
updateCtrlTimeLineKey ctrlstr keystr;
set k = k + 1;
);
_SIZEcontainer trackstr.EDTLT_cont 0 ((i * (timelinestr.EDTLE_iTrackHeight + 2)) + 20) w-2 timelinestr.EDTLE_iTrackHeight + 2;
_PAINTcontainer trackstr.EDTLT_cont;
);
set i = i + 1;
);
let getEdWindowSize timelinestr.EDTLE_winDmi -> [w _] in
setEdWindowSize timelinestr.EDTLE_winDmi w (timelinestr.EDTLE_iTrackHeight + 2) * nbtrack + 22;
);
0;;
fun selectEdCtrlTimeLineKey(ctrlstr, keystr)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
(
if ((keystr == timelinestr.EDTLE_selectedKey) || (timelinestr.EDTLE_selectedKey == nil)) then nil else
(
let _GETalphaBitmaps timelinestr.EDTLE_selectedKey.EDTLK_abmpKey -> [buffer _] in
let _GETbitmap timelinestr.EDTLE_selectedKey.EDTLK_bmpOff -> sbmp in
_SETbitmap buffer sbmp;
_PAINTobjNode timelinestr.EDTLE_selectedKey.EDTLK_node;
);
if ((keystr == timelinestr.EDTLE_selectedKey) || (keystr == nil)) then nil else
(
let _GETalphaBitmaps keystr.EDTLK_abmpKey -> [buffer _] in
let _GETbitmap keystr.EDTLK_bmpOn -> sbmp in
(
_SETbitmap buffer sbmp;
_PAINTobjNode keystr.EDTLK_node;
);
);
set timelinestr.EDTLE_selectedKey = keystr;
exec timelinestr.EDTLE_cbSelectKey with [ctrlstr keystr];
);
keystr;;
fun setEdCtrlTimeLineCbSelectKey(ctrlstr, cbfun)=
set ctrlstr.EDC_timeLineEditor.EDTLE_cbSelectKey = cbfun;
0;;
fun selectEdCtrlTimeLineTrack(ctrlstr, trackstr)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
if (trackstr == timelinestr.EDTLE_selectedTrack) then nil else
(
_SETcontainerBackgroundColor timelinestr.EDTLE_selectedTrack.EDTLT_cont ctrlstr.EDC_theme.EDT_iTimeLineEditorTrackOff 1;
_SETcontainerBackgroundColor trackstr.EDTLT_cont ctrlstr.EDC_theme.EDT_iTimeLineEditorTrackOn 1;
set timelinestr.EDTLE_selectedTrack = trackstr;
exec timelinestr.EDTLE_cbSelectTrack with [ctrlstr trackstr];
);
trackstr;;
fun setEdCtrlTimeLineCbSelectTrack(ctrlstr, cbfun)=
set ctrlstr.EDC_timeLineEditor.EDTLE_cbSelectTrack = cbfun;
0;;
fun setEdCtrlTimeLinekeyParams(ctrlstr, keystr, pos, length)=
set keystr.EDTLK_fKeyPos = pos;
set keystr.EDTLK_fKeyLength = length;
updateCtrlTimeLineKey ctrlstr keystr;
_PAINTcontainer keystr.EDTLK_track.EDTLT_cont;
0;;
fun setEdCtrlTimeLinekeyParamsEx(ctrlstr, keystr, pos, length, paint)=
set keystr.EDTLK_fKeyPos = pos;
set keystr.EDTLK_fKeyLength = length;
updateCtrlTimeLineKey ctrlstr keystr;
if (!paint) then nil else
_PAINTcontainer keystr.EDTLK_track.EDTLT_cont;
0;;
fun setEdCtrlTimeLinekeyPos(ctrlstr, keystr, pos, paint)=
set keystr.EDTLK_fKeyPos = pos;
updateCtrlTimeLineKey ctrlstr keystr;
if (!paint) then nil else
_PAINTcontainer keystr.EDTLK_track.EDTLT_cont;
0;;
fun setEdCtrlTimeLinekeyLength(ctrlstr, keystr, length, paint)=
set keystr.EDTLK_fKeyLength = length;
updateCtrlTimeLineKey ctrlstr keystr;
if (!paint) then nil else
_PAINTcontainer keystr.EDTLK_track.EDTLT_cont;
0;;
fun addEdCtrlTimeLineKey(ctrlstr, trackidx, name, pos, length, paint)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
let getEdCtrlTimeLineTrackByPos ctrlstr trackidx -> trackstr in
if trackstr == nil then nil else
let mkEdTLKey [name trackstr nil nil nil nil nil pos length] -> keystr in
(
set trackstr.EDTLT_lKey = G2Dlcat trackstr.EDTLT_lKey keystr::nil;
if (!paint) then nil else
updateEdCtrlTimeLineTracks ctrlstr 1;
keystr;
);;
fun addEdCtrlTimeLineKeyFromIndex(ctrlstr, trackidx, index, name, pos, length, paint)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
let getEdCtrlTimeLineTrackByPos ctrlstr trackidx -> trackstr in
if trackstr == nil then nil else
let mkEdTLKey [name trackstr nil nil nil nil nil pos length] -> keystr in
(
if (index == nil) then
(
set trackstr.EDTLT_lKey = G2Dlcat trackstr.EDTLT_lKey keystr::nil;
)
else
(
let G2DsplitList trackstr.EDTLT_lKey index + 1 -> [pl nl] in
set trackstr.EDTLT_lKey = G2Dlcat pl keystr::nl;
);
if (!paint) then nil else
updateEdCtrlTimeLineTracks ctrlstr 1;
keystr;
);;
fun addEdCtrlTimeLineKeyAfterKey(ctrlstr, trackidx, prevkeystr, name, pos, length, paint)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
let getEdCtrlTimeLineTrackByPos ctrlstr trackidx -> trackstr in
if trackstr == nil then nil else
let mkEdTLKey [name trackstr nil nil nil nil nil pos length] -> keystr in
(
if (prevkeystr == nil) then
(
set trackstr.EDTLT_lKey = if (trackstr.EDTLT_lKey == nil) then keystr::nil else G2Dlcat trackstr.EDTLT_lKey keystr::nil;
)
else
(
let getEdCtrlTimeLineKeyPos prevkeystr -> keypos in
if (keypos == ((sizelist trackstr.EDTLT_lKey) - 1)) then
set trackstr.EDTLT_lKey = G2Dlcat trackstr.EDTLT_lKey keystr::nil
else
let G2DsplitList trackstr.EDTLT_lKey keypos + 1 -> [pl nl] in
set trackstr.EDTLT_lKey = G2Dlcat pl keystr::nl;
);
if (!paint) then nil else
updateEdCtrlTimeLineTracks ctrlstr 1;
keystr;
);;
fun dsCtrlTimeLineKey(ctrlstr, keystr)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
if (keystr.EDTLK_cbmpKey == nil) then nil else
(
if (keystr != timelinestr.EDTLE_selectedKey) then nil else
set timelinestr.EDTLE_selectedKey = nil;
_DScompBitmap keystr.EDTLK_cbmpKey;
_DSalphaBitmap keystr.EDTLK_abmpKey;
_DSbitmap keystr.EDTLK_bmpOn;
_DSbitmap keystr.EDTLK_bmpOff;
);
0;;
fun removeEdCtrlTimeLineKey(ctrlstr, keystr, paint)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
let keystr.EDTLK_track -> trackstr in
(
set trackstr.EDTLT_lKey = G2DremoveFromList trackstr.EDTLT_lKey keystr;
dsCtrlTimeLineKey ctrlstr keystr;
if (keystr != timelinestr.EDTLE_selectedKey) then nil else
selectEdCtrlTimeLineKey ctrlstr nil;
if (!paint) then nil else
updateEdCtrlTimeLineTracks ctrlstr 1;
);
0;;
fun moveEdCtrlTimeLineKey(trackstr, pos, to)=
set trackstr.EDTLT_lKey = moveListElement trackstr.EDTLT_lKey pos to;
0;;
fun dsEdCtrlTimeLineTrack(ctrlstr, trackstr)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
(
if (trackstr != timelinestr.EDTLE_selectedTrack) then nil else
set timelinestr.EDTLE_selectedTrack = nil;
let sizelist trackstr.EDTLT_lKey -> ksize in
let 0 -> k in
while k < ksize do
(
let nth_list trackstr.EDTLT_lKey k -> keystr in
dsCtrlTimeLineKey ctrlstr keystr;
set k = k + 1;
);
_DScontainer trackstr.EDTLT_cont;
set trackstr.EDTLT_cont = nil;
);
0;;
fun addEdCtrlTimeLineTrack(ctrlstr, paint)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
let (timelinestr.EDTLE_iTrackHeight + 2) * (sizelist timelinestr.EDTLE_lTrack) + 20 -> y in
let getEdWindowSize timelinestr.EDTLE_winDmi -> [w _] in
let _CRcontainerFromObjWin ctrlstr.EDC_channel timelinestr.EDTLE_winDmi.EDW_win 0 y w-2 timelinestr.EDTLE_iTrackHeight CO_CHILDINSIDE ctrlstr.EDC_theme.EDT_iTimeLineEditorTrackOff "" -> cont in
let mkEdTLTrack [timelinestr cont nil] -> trackstr in
(
set timelinestr.EDTLE_lTrack = G2Dlcat timelinestr.EDTLE_lTrack trackstr::nil;
_CBcontainerClick cont @cbEdCtrlTimeLineTrackClick [ctrlstr trackstr];
if (!paint) then nil else
updateEdCtrlTimeLineTracks ctrlstr 0;
trackstr;
);;
fun removeEdCtrlTimeLineTrack(ctrlstr, trackstr, paint)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
(
set timelinestr.EDTLE_lTrack = G2DremoveFromList timelinestr.EDTLE_lTrack trackstr;
dsEdCtrlTimeLineTrack ctrlstr trackstr;
if (trackstr != timelinestr.EDTLE_selectedTrack) then nil else
selectEdCtrlTimeLineKey ctrlstr nil;
if (!paint) then nil else
updateEdCtrlTimeLineTracks ctrlstr 0;
);
0;;
fun setEdCtrlTimeLineValue(ctrlstr, value)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
(
//scroll the window to keep pointer position
let if (value <. 0.0) then 0.0 else value -> value in
let ftoi ((itof timelinestr.EDTLE_iPixelPerUnit) *. value) -> xpos in
let _GETwindowPositionSize timelinestr.EDTLE_win.EDW_win -> [_ _ ww wh] in
let _GETwindowPositionSize timelinestr.EDTLE_win.EDW_virtualWin -> [vx vy vw vh] in
let if (xpos - (abs vx)) > ww then ww - (xpos - (abs vx)) + vx else if ((abs vx) - xpos) > 0 then vx + ((abs vx) - xpos) else 0 -> mv in
let if (xpos - (abs vx)) > ww || ((abs vx) - xpos) > 0 then 1 else 0 -> needmv in
if needmv == 0 then nil else
_MVwindow timelinestr.EDTLE_win.EDW_virtualWin mv 0;
setEdCtrlSliderValue timelinestr.EDTLE_slider value;
set timelinestr.EDTLE_fValue = value;
_SETcompText timelinestr.EDTLE_statusText strcat "Pos: " (ftoa timelinestr.EDTLE_fValue) ctrlstr.EDC_theme.EDT_fontToolTip [0 nil nil nil] CT_NOCHANGE;
_PAINTobjNode _CONVERTcompTextToObjNode timelinestr.EDTLE_statusText;
);
0;;
fun cbEdCtrlTimeLineValue(sliderstr, value, ctrlstr)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
(
//scroll the window to keep pointer position
let ftoi ((itof timelinestr.EDTLE_iPixelPerUnit) *. value) -> xpos in
let _GETwindowPositionSize timelinestr.EDTLE_win.EDW_win -> [_ _ ww wh] in
let _GETwindowPositionSize timelinestr.EDTLE_win.EDW_virtualWin -> [vx vy vw vh] in
let if (xpos - (abs vx)) > ww then ww - (xpos - (abs vx)) + vx else if ((abs vx) - xpos) > 0 then vx + ((abs vx) - xpos) else 0 -> mv in
let if (xpos - (abs vx)) > ww || ((abs vx) - xpos) > 0 then 1 else 0 -> needmv in
if needmv == 0 then nil else
_MVwindow timelinestr.EDTLE_win.EDW_virtualWin mv 0;
set timelinestr.EDTLE_fValue = value;
_SETcompText timelinestr.EDTLE_statusText strcat "Pos: " (ftoa timelinestr.EDTLE_fValue) ctrlstr.EDC_theme.EDT_fontToolTip [0 nil nil nil] CT_NOCHANGE;
_PAINTobjNode _CONVERTcompTextToObjNode timelinestr.EDTLE_statusText;
exec timelinestr.EDTLE_cbValue with [ctrlstr timelinestr.EDTLE_fValue]
);
0;;
fun setEdCtrlTimeLineCbValue(ctrlstr, cbfun)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
set timelinestr.EDTLE_cbValue = cbfun;
0;;
fun setEdCtrlTimeLinePixelPerUnit(ctrlstr, value, paint)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
let if (value == nil) || (value <= 0) then 1 else value -> value in
let (ftoi ((itof value) *. timelinestr.EDTLE_fLength)) + 2 -> width in
(
set timelinestr.EDTLE_iPixelPerUnit = value;
let sizelist timelinestr.EDTLE_lTrack -> nbtrack in
setEdWindowSize timelinestr.EDTLE_winDmi width (timelinestr.EDTLE_iTrackHeight + 2) * nbtrack + 22;
if (!paint) then nil else
updateEdCtrlTimeLineTracks ctrlstr 1;
setEdCtrlSize timelinestr.EDTLE_slider width 20;
);
0;;
fun setEdCtrlTimeLineLength(ctrlstr, value)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
if (value == nil) || (value <=. 0.0) then nil else
// limit the length for 10000 * (unit pixel)100 override the maximum container pixel width
let if (value >=. 10000.0) then 9999.9 else value -> value in
(
set timelinestr.EDTLE_fLength = value;
setEdCtrlSliderMaxValue timelinestr.EDTLE_slider value;
setEdCtrlTimeLinePixelPerUnit ctrlstr timelinestr.EDTLE_iPixelPerUnit 1;
);
0;;
fun getEdCtrlTimeLinePixelPerUnit(ctrlstr)= ctrlstr.EDC_timeLineEditor.EDTLE_iPixelPerUnit;;
fun cbEdCtrlTimeLineBgPaint(win, ctrlstr)=
let _GETwindowPositionSize win -> [_ _ w h] in
_PAINTrectangle win 0 0 w h DRAW_INVISIBLE 0 ctrlstr.EDC_theme.EDT_iTimeLineEditorBg DRAW_SOLID ctrlstr.EDC_theme.EDT_iTimeLineEditorBg;
0;;
fun crEdCtrlTimeLineEditorEx(winstr, x, y, w, h, trackheight, pixelsperunit, length, leftstatus, resize, themestr, mtrack)=
let if themestr == nil then (if EdDefaultTheme == nil then (set EdDefaultTheme = makeEdThemeResources winstr.EDW_channel) else EdDefaultTheme) else themestr -> themestr in
let if (pixelsperunit == nil) || (pixelsperunit <= 0) then 1 else pixelsperunit -> pixelsperunit in
let if length == 0.0 then itof (w / pixelsperunit) else length -> length in
let mkEdControl [winstr.EDW_channel winstr resize themestr nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let if mtrack then WN_VSCROLL|WN_HSCROLL else WN_HSCROLL -> scroll in
let crEdScrollWindow ctrlstr.EDC_channel winstr x y w h-28 WN_CHILDINSIDE|WN_NOBORDER|scroll EDWIN_RESIZE_MW|EDWIN_RESIZE_MH nil "" -> swinstr in
let (ftoi ((itof pixelsperunit) *. length)) + 2 -> width in
let crEdWindow ctrlstr.EDC_channel swinstr 0 0 width 20 WN_NOBORDER|WN_CHILDINSIDE nil nil "" -> dwinstr in
let crEdCtrlSlider dwinstr 0 0 width 20 0.0 0.0 length nil EDWIN_RESIZE_MW nil -> ctrlslider in
let crEdWindowToolBar winstr leftstatus h w-leftstatus 28 5 1 themestr.EDT_iMainBackgroundColor ETB_HORIZONTAL -> tbstr in
let crEdToolBarText tbstr "Pos: 0.000000 " "Arial" 9 FF_PIXEL|FF_WEIGHT 0xffffff nil ETB_ALIGN_RIGHT -> textstr in
let mkEdTimeLineEditor [nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> timelinestr in
(
set ctrlstr.EDC_timeLineEditor = timelinestr;
set timelinestr.EDTLE_win = swinstr;
set timelinestr.EDTLE_winDmi = dwinstr;
set timelinestr.EDTLE_slider = ctrlslider;
set timelinestr.EDTLE_iLeftStatus = leftstatus;
set timelinestr.EDTLE_statusBar = tbstr;
set timelinestr.EDTLE_statusText = textstr;
set timelinestr.EDTLE_iTrackHeight = trackheight;
set timelinestr.EDTLE_iPixelPerUnit = pixelsperunit;
set timelinestr.EDTLE_fZoomCoef = 1.0;
set timelinestr.EDTLE_fLength = length;
set timelinestr.EDTLE_fValue = 0.0;
cbEdCtrlTimeLineBgPaint timelinestr.EDTLE_win.EDW_virtualWin ctrlstr;
_CBwinPaint timelinestr.EDTLE_win.EDW_virtualWin @cbEdCtrlTimeLineBgPaint ctrlstr;
setEdCtrlSliderCbValue timelinestr.EDTLE_slider mkfun3 @cbEdCtrlTimeLineValue ctrlstr;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
setEdWindowPosSizeEx swinstr x y w h-28;
setEdToolBarVisible tbstr 1;
paintEdToolBar tbstr;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [x y (fw-(x + w)) (fh-(y+h)) w h];
setEdCtrlTimeLinePixelPerUnit ctrlstr pixelsperunit 1;
ctrlstr;
);;
fun crEdCtrlTimeLineEditor(winstr, x, y, w, h, trackheight, pixelsperunit, length, leftstatus, resize, themestr)=
crEdCtrlTimeLineEditorEx winstr x y w h trackheight pixelsperunit length leftstatus resize themestr 1;;
fun dsEdCtrlTimeLineEditor(ctrlstr)=
let ctrlstr.EDC_timeLineEditor -> timelinestr in
(
/*if timelinestr.EDTLE_tooltip == nil then nil else
let timelinestr.EDTLE_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set timelinestr.EDTLE_tooltip = nil;
);
_DStoolTip timelinestr.EDTLE_nodeCursor;
*/
let sizelist timelinestr.EDTLE_lTrack -> size in
let 0 -> i in
while i < size do
(
let nth_list timelinestr.EDTLE_lTrack i -> trackstr in
dsEdCtrlTimeLineTrack ctrlstr trackstr;
set i = i + 1;
);
dsEdCtrlSlider timelinestr.EDTLE_slider;
dsEdWindow timelinestr.EDTLE_winDmi;
dsEdWindow timelinestr.EDTLE_win;
set timelinestr.EDTLE_win = nil;
);
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
TCB
/ ********************************************************************************************* */
// 2t3 - 3t2 + 1
fun edH1(coef)=
(2.0 *. (pow coef 3.0)) -. (3.0 *. (pow coef 2.0)) +. 1.0;;
// -2t3 + 3t2
fun edH2(coef)=
(-. 2.0 *. (pow coef 3.0)) +. (3.0 *. (pow coef 2.0));;
// t3 - 2t2 +t
fun edH3(coef)=
(pow coef 3.0) -. (2.0 *. (pow coef 2.0)) +. coef;;
// t3 - t2
fun edH4(coef)=
(pow coef 3.0) -. (pow coef 2.0);;
fun edGetInterpolateCurve(vec1, vec2, ang1, ang2, coef)=
let vec1 -> [x1 y1] in
let vec2 -> [x2 y2] in
let ang1 -> [ax1 ay1] in
let ang2 -> [ax2 ay2] in
let ftoi (((edH1 coef) *. x1) +. ((edH2 coef) *. x2) +. ((edH3 coef) *. ax1) +. ((edH4 coef) *. ax2)) -> x in
let ftoi (((edH1 coef) *. y1) +. ((edH2 coef) *. y2) +. ((edH3 coef) *. ay1) +. ((edH4 coef) *. ay2)) -> y in
[x y];;
fun edGetBezierCurveCenter(lp)=
let sizelist lp -> size in
nth_list lp (size / 2);;
fun edGetBezierCurve(vec1, vec2, curve, it)=
let vec1 -> [ix0 iy0] in
let [(itof ix0) (itof iy0)] -> [x0 y0] in
let [0.0 0.0] -> [x1 y1] in
let [0.0 0.0] -> [x2 y2] in
let vec2 -> [ix3 iy3] in
let [(itof ix3) (itof iy3)] -> [x3 y3] in
let (x3 -. x0) -> dx in
let (y3 -. y0) -> dy in
let curve *. 0.10 *. (absf(x0 -. x3)) -> dist in
(
if ((absf dx) >. (absf dy)) then
(
set y1 = y0;
set x1 = x0 +. (if (dx >. 0.0) then dist else -.dist);
)
else
(
set x1 = x0;
set y1 = y0 +. (if (dy >. 0.0) then dist else -.dist);
);
if ((absf dx) >. (absf dy)) then
(
set y2 = y3;
set x2 = x3 +. (if (dx >. 0.0) then -.dist else dist);
)
else
(
set x2 = x3;
set y2 = y3 +. (if (dy >. 0.0) then -.dist else dist);
);
let itof it -> resol in
let x0 -> rx0 in
let y0 -> ry0 in
let 3.0 *. (x1 -. x0) /. resol -> rx1 in
let 3.0 *. (y1 -. y0) /. resol -> ry1 in
let resol *. resol -> resol in
let 3.0 *. (x0 -. 2.0 *. x1 +. x2) /. resol -> rx2 in
let 3.0 *. (y0 -. 2.0 *. y1 +. y2) /. resol -> ry2 in
let resol *. (itof it) -> resol in
let (x3 -. x0 +. 3.0 *. (x1 -. x2)) /. resol -> rx3 in
let (y3 -. y0 +. 3.0 *. (y1 -. y2)) /. resol -> ry3 in
let rx0 -> x0 in
let ry0 -> y0 in
let rx1 +. rx2 +. rx3 -> x1 in
let ry1 +. ry2 +. ry3 -> y1 in
let 2.0 *. rx2 +. 6.0 *. rx3 -> x2 in
let 2.0 *. ry2 +. 6.0 *. ry3 -> y2 in
let 6.0 *. rx3 -> x3 in
let 6.0 *. ry3 -> y3 in
let 0 -> i in
let nil -> nl in
(
while (i <= it) do
(
set nl = [(ftoi x0) (ftoi y0)]::nl;
set x0 = x0 +. x1;
set x1 = x1 +. x2;
set x2 = x2 +. x3;
set y0 = y0 +. y1;
set y1 = y1 +. y2;
set y2 = y2 +. y3;
set i = i + 1;
);
nl;
);
);;
/* ********************************************************************************************* /
Modules editor
/ ********************************************************************************************* */
fun getEdCtrlModuleEditorLinkCenterPrivate(x1, y1, x2, y2)=
edGetBezierCurveCenter (edGetBezierCurve [x1 y1] [x2 y2] 5.0 16);;
fun findEdCtrlModuleEditorRoundLink(ctrlstr, srcmboxstr, dstmboxstr)=
let sizelist ctrlstr.EDC_modulesEditor.EDM_lRoundLinks -> size in
let nil -> ndata in
let 0 -> i in
(
while i < size && ndata == nil do
(
let nth_list ctrlstr.EDC_modulesEditor.EDM_lRoundLinks i -> rlinkstr in
if ((rlinkstr.EDRL_srcModuleBox == srcmboxstr) && (rlinkstr.EDRL_dstModuleBox == dstmboxstr)) ||
((rlinkstr.EDRL_dstModuleBox == srcmboxstr) && (rlinkstr.EDRL_srcModuleBox == dstmboxstr))
then
set ndata = rlinkstr
else nil;
set i = i + 1;
);
ndata;
);;
fun calcEdCtrlModuleEditorRoundLinkPos( x1, y1, w1, h1, x2, y2, w2, h2 )=
if (abs (x1 - x2)) > (abs (y1 - y2 ))
then
if x1 < x2
then [
x1+w1 y1+h1/2
x2-1 y2+h2/2
]
else [
x1-1 y1+h1/2
x2+w2 y2+h2/2
]
else if y1 < y2
then [
x1+w1/2 y1+h1
x2+w2/2 y2-1
]
else [
x1+w1/2 y1-1
x2+w2/2 y2+h2
]
;;
fun updateEdCtrlModuleEditorRoundLinkPos(ctrlstr)=
let ctrlstr.EDC_modulesEditor -> mestr in
let ctrlstr.EDC_theme.EDT_iModuleEditorRLinkSize -> dcircle in
let ftoi ((itof dcircle) *. mestr.EDM_fScale) -> dcircle in
let sizelist ctrlstr.EDC_modulesEditor.EDM_lRoundLinks -> size in
let 0 -> i in
while i < size do
(
let nth_list ctrlstr.EDC_modulesEditor.EDM_lRoundLinks i -> rlinkstr in
let _GETobjNodePositionSizeInFatherRef rlinkstr.EDRL_srcModuleBox.EDB_node -> [x1 y1 w1 h1] in
let _GETobjNodePositionSizeInFatherRef rlinkstr.EDRL_dstModuleBox.EDB_node -> [x2 y2 w2 h2] in
let if rlinkstr.EDRL_srcModuleBox == rlinkstr.EDRL_dstModuleBox then
[x1 y1 x2 y2]
else
calcEdCtrlModuleEditorRoundLinkPos x1 y1 w1 h1 x2 y2 w2 h2
-> [px1 py1 px2 py2] in
let if (ctrlstr.EDC_modulesEditor.EDM_bLinksCurved) then
getEdCtrlModuleEditorLinkCenterPrivate px1 py1 px2 py2
else
[(px2 + px1) / 2 (py2 + py1) / 2]
-> [ncx ncy] in
let [(ncx - (dcircle / 2)) (ncy - (dcircle / 2))] -> [mx my] in
_TOPobjNode _CHANGEobjNodeCoordinates rlinkstr.EDRL_node [mx my] 0;
set i = i + 1;
);
0;;
fun drawEdCtrlModuleEditorLinkPrivate(buffer, x1, y1, x2, y2, width, color)=
_BTDRAWline buffer [x1 y1] [x2 y2] color width;
0;;
fun drawEdCtrlModuleEditorLinkCurvedPrivate(buffer, x1, y1, x2, y2, width, color)=
let sqrt (sqr itof(x2 - x1)) +. (sqr itof(y2 - y1)) -> dist in
let 16 -> resol in
if (dist == 0.0) then nil else
(
let edGetBezierCurve [x1 y1] [x2 y2] 5.0 resol -> lp in
let 0 -> i in
let sizelist lp -> size in
let [0 0] -> ppos in
while (i < size) do
(
let nth_list lp i -> [nx ny] in
(
if i == 0 then nil else
let ppos -> [px py] in
_BTDRAWline buffer [px py] [nx ny] color width;
set ppos = [nx ny];
set i = i + 1;
);
);
);
0;;
fun calcEdCtrlModuleEditorLink(x1, y1, w1, h1, x2, y2, w2, h2)=
if (abs (x1 - x2)) > (abs (y1 - y2 ))
then
if x1 < x2
then [
x1+w1 y1+h1/2
x2-1 y2+h2/2
]
else [
x1-1 y1+h1/2
x2+w2 y2+h2/2
]
else if y1 < y2
then [
x1+w1/2 y1+h1
x2+w2/2 y2-1
]
else [
x1+w1/2 y1-1
x2+w2/2 y2+h2
]
;;
fun isLinkSelectedInRoundLink(l, linkstr)=
if (l == nil) then 0 else
let l -> [elt next] in
if (G2DisInList elt.EDRL_lLinks linkstr) then
1
else
isLinkSelectedInRoundLink next linkstr;;
fun drawEdCtrlModuleEditorLink(ctrlstr, linkstr)=
let _GETobjNodePositionSizeInContainerRef linkstr.EDL_srcModuleBox.EDB_node -> [x1 y1 w1 h1] in
let _GETobjNodePositionSizeInContainerRef linkstr.EDL_dstModuleBox.EDB_node -> [x2 y2 w2 h2] in
let if linkstr.EDL_srcModuleBox == linkstr.EDL_dstModuleBox then
[x1 y1 x2 y2]
else
calcEdCtrlModuleEditorLink x1 y1 w1 h1 x2 y2 w2 h2
-> [px1 py1 px2 py2] in
let ctrlstr.EDC_modulesEditor.EDM_abmpLinks -> alphaBmp in
let _GETalphaBitmaps alphaBmp -> [buffer _] in
let if (isLinkSelectedInRoundLink ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink linkstr) || (G2DisInList ctrlstr.EDC_modulesEditor.EDM_selectedBox linkstr.EDL_srcModuleBox) || (G2DisInList ctrlstr.EDC_modulesEditor.EDM_selectedBox linkstr.EDL_dstModuleBox) then ctrlstr.EDC_theme.EDT_iModuleEditorLinkOn else ctrlstr.EDC_theme.EDT_iModuleEditorLinkOff -> color in
if (ctrlstr.EDC_modulesEditor.EDM_bLinksCurved) then
drawEdCtrlModuleEditorLinkCurvedPrivate buffer px1 py1 px2 py2 ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth color
else
drawEdCtrlModuleEditorLinkPrivate buffer px1 py1 px2 py2 ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth color;
0;;
fun refreshEdCtrlModuleEditorLinksPrivate(ctrlstr, l, buffer)=
if l == nil then nil else
let l -> [linkstr next] in
(
let ctrlstr.EDC_modulesEditor -> mestr in
let _GETobjNodePositionSizeInContainerRef linkstr.EDL_srcModuleBox.EDB_node -> [x1 y1 w1 h1] in
let _GETobjNodePositionSizeInContainerRef linkstr.EDL_dstModuleBox.EDB_node -> [x2 y2 w2 h2] in
let if linkstr.EDL_srcModuleBox == linkstr.EDL_dstModuleBox then
[x1 y1 x2 y2]
else
calcEdCtrlModuleEditorLink x1 y1 w1 h1 x2 y2 w2 h2
-> [px1 py1 px2 py2] in
(
if (!mestr.EDM_bLinksFilter) then
(
let if (isLinkSelectedInRoundLink ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink linkstr) ||
(G2DisInList ctrlstr.EDC_modulesEditor.EDM_selectedBox linkstr.EDL_srcModuleBox) ||
(G2DisInList ctrlstr.EDC_modulesEditor.EDM_selectedBox linkstr.EDL_dstModuleBox) then
ctrlstr.EDC_theme.EDT_iModuleEditorLinkOn
else
ctrlstr.EDC_theme.EDT_iModuleEditorLinkOff
-> color in
if (ctrlstr.EDC_modulesEditor.EDM_bLinksCurved) then
drawEdCtrlModuleEditorLinkCurvedPrivate buffer px1 py1 px2 py2 ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth color
else
drawEdCtrlModuleEditorLinkPrivate buffer px1 py1 px2 py2 ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth color;
let linkstr.EDL_rLink -> rlinkstr in
_CHANGEobjNodeFlags rlinkstr.EDRL_node OBJ_ENABLE|OBJ_VISIBLE 0;
0;
)
else
(
if (isLinkSelectedInRoundLink ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink linkstr) ||
(G2DisInList ctrlstr.EDC_modulesEditor.EDM_selectedBox linkstr.EDL_srcModuleBox) ||
(G2DisInList ctrlstr.EDC_modulesEditor.EDM_selectedBox linkstr.EDL_dstModuleBox)
then
(
if (ctrlstr.EDC_modulesEditor.EDM_bLinksCurved) then
drawEdCtrlModuleEditorLinkCurvedPrivate buffer px1 py1 px2 py2 ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth ctrlstr.EDC_theme.EDT_iModuleEditorLinkOn
else
drawEdCtrlModuleEditorLinkPrivate buffer px1 py1 px2 py2 ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth ctrlstr.EDC_theme.EDT_iModuleEditorLinkOn;
let linkstr.EDL_rLink -> rlinkstr in
_CHANGEobjNodeFlags rlinkstr.EDRL_node OBJ_ENABLE|OBJ_VISIBLE 0;
0;
)
else
(
let linkstr.EDL_rLink -> rlinkstr in
_CHANGEobjNodeFlags rlinkstr.EDRL_node OBJ_DISABLE|OBJ_HIDE 0;
0;
);
0;
);
);
refreshEdCtrlModuleEditorLinksPrivate ctrlstr next buffer;
);
0;;
fun refreshEdCtrlModuleEditorLinks(ctrlstr)=
let ctrlstr.EDC_modulesEditor -> mestr in
let ctrlstr.EDC_modulesEditor.EDM_abmpLinks -> alphaBmp in
let _GETalphaBitmaps alphaBmp -> [buffer _] in
let _GETalphaBitmapTransparency alphaBmp -> transparency in
(
// clear links
_FILLbitmap buffer transparency;
refreshEdCtrlModuleEditorLinksPrivate ctrlstr mestr.EDM_lLinks buffer;
);
updateEdCtrlModuleEditorRoundLinkPos ctrlstr;
0;;
fun calcEdModuleEditorBoxSquare(ctrlstr)=
let ctrlstr.EDC_modulesEditor -> mestr in
let _GETobjNodePositionSizeInContainerRef mestr.EDM_node -> [x y _ _] in
let 0 -> w in
let 0 -> h in
(
/*
// first calc the minimum X Y
let sizelist mestr.EDM_lBox -> size in
let 0 -> i in
while i < size do
(
let nth_list mestr.EDM_lBox i -> [_ mboxstr] in
let _GETobjNodePositionSizeInContainerRef mboxstr.EDB_node -> [modx mody _ _] in
(
if x == nil || modx < x then
set x = modx
else nil;
if y == nil || mody < y then
set y = mody
else nil;
);
set i = i + 1;
);
*/
// calc then maximum W H
let sizelist mestr.EDM_lBox -> size in
let 0 -> i in
while i < size do
(
let nth_list mestr.EDM_lBox i -> [_ mboxstr] in
let _GETobjNodePositionSizeInContainerRef mboxstr.EDB_node -> [modx mody modw modh] in
(
if modw == nil ||(modx + modw) > (x + w) then
set w = (modx - x) + modw
else nil;
if modh == nil || (mody + modh) > (y + h) then
set h = (mody - y) + modh
else nil;
);
set i = i + 1;
);
[x y w h]
);;
fun calcEdModuleEditorSelectedBoxSquare(ctrlstr)=
let ctrlstr.EDC_modulesEditor -> mestr in
let nil -> x in
let nil -> y in
let 0 -> w in
let 0 -> h in
(
// first calc the minimum X Y
let sizelist mestr.EDM_selectedBox -> size in
let 0 -> i in
while i < size do
(
let nth_list mestr.EDM_selectedBox i -> mboxstr in
let _GETobjNodePositionSizeInFatherRef mboxstr.EDB_node -> [modx mody _ _] in
(
if x == nil || modx < x then
set x = modx
else nil;
if y == nil || mody < y then
set y = mody
else nil;
);
set i = i + 1;
);
// calc then maximum W H
let sizelist mestr.EDM_selectedBox -> size in
let 0 -> i in
while i < size do
(
let nth_list mestr.EDM_selectedBox i -> mboxstr in
let _GETobjNodePositionSizeInFatherRef mboxstr.EDB_node -> [modx mody modw modh] in
(
if modw == nil || (modx + modw) > (x + w) then
set w = (modx - x) + modw
else nil;
if modh == nil || (mody + modh) > (y + h) then
set h = (mody - y) + modh
else nil;
);
set i = i + 1;
);
[x y w h]
);;
fun paintEdCtrlModuleEditorNoResize(ctrlstr)=
let ctrlstr.EDC_modulesEditor.EDM_winScroll -> winstr in
let _GETwindowPositionSize winstr.EDW_win -> [_ _ ww wh] in
let _GETwindowPositionSize winstr.EDW_virtualWin -> [vx vy vw vh] in
if ww <= 0 || wh <= 0 then nil else
(
_CHANGEobjNodeCoordinates ctrlstr.EDC_modulesEditor.EDM_node [vx vy] 0;
setEdCtrlPositionSize ctrlstr.EDC_modulesEditor.EDM_bmpBack (abs vx) (abs vy) ww wh;
//_PAINTcontainer ctrlstr.EDC_modulesEditor.EDM_cont;
refreshEdCtrlModuleEditorLinks ctrlstr;
_PAINTcontainerArea ctrlstr.EDC_modulesEditor.EDM_cont 0 0 ww wh;
);
0;;
fun paintEdCtrlModuleEditor(ctrlstr)=
let ctrlstr.EDC_modulesEditor.EDM_winScroll -> winstr in
let _GETwindowPositionSize winstr.EDW_win -> [_ _ ww wh] in
if ww <= 0 || wh <= 0 then nil else
(
let calcEdModuleEditorBoxSquare ctrlstr -> [mx my mw mh] in
let [(max ww (mw + (ctrlstr.EDC_modulesEditor.EDM_iSnap * 2))) (max wh (mh + (ctrlstr.EDC_modulesEditor.EDM_iSnap * 2)))] -> [mw mh] in
setEdWindowSize ctrlstr.EDC_modulesEditor.EDM_winDmi (mw - 1) (mh - 1);
let _GETwindowPositionSize winstr.EDW_virtualWin -> [vx vy vw vh] in
(
_CHANGEobjNodeCoordinates ctrlstr.EDC_modulesEditor.EDM_node [vx vy] 0;
setEdCtrlPositionSize ctrlstr.EDC_modulesEditor.EDM_bmpBack (abs vx) (abs vy) ww wh;
//_PAINTcontainer ctrlstr.EDC_modulesEditor.EDM_cont;
refreshEdCtrlModuleEditorLinks ctrlstr;
_PAINTcontainerArea ctrlstr.EDC_modulesEditor.EDM_cont 0 0 ww wh;
);
);
0;;
fun paintEdCtrlModuleEditorResizeMax(ctrlstr)=
let ctrlstr.EDC_modulesEditor.EDM_winScroll -> winstr in
let _GETwindowPositionSize winstr.EDW_win -> [_ _ ww wh] in
let _GETwindowPositionSize winstr.EDW_virtualWin -> [vx vy vw vh] in
if ww <= 0 || wh <= 0 then nil else
(
let calcEdModuleEditorBoxSquare ctrlstr -> [mx my mw mh] in
let [(max ww (mw + (ctrlstr.EDC_modulesEditor.EDM_iSnap * 2))) (max wh (mh + (ctrlstr.EDC_modulesEditor.EDM_iSnap * 2)))] -> [mw mh] in
if (vw > (mw - 1) && vh > (mh - 1)) then nil else
(
setEdWindowSize ctrlstr.EDC_modulesEditor.EDM_winDmi (mw - 1) (mh - 1);
);
let _GETwindowPositionSize winstr.EDW_virtualWin -> [vx vy vw vh] in
(
_CHANGEobjNodeCoordinates ctrlstr.EDC_modulesEditor.EDM_node [vx vy] 0;
setEdCtrlPositionSize ctrlstr.EDC_modulesEditor.EDM_bmpBack (abs vx) (abs vy) ww wh;
//_PAINTcontainer ctrlstr.EDC_modulesEditor.EDM_cont;
refreshEdCtrlModuleEditorLinks ctrlstr;
_PAINTcontainerArea ctrlstr.EDC_modulesEditor.EDM_cont 0 0 ww wh;
);
);
0;;
fun paintEdCtrlModuleEditorNoUpdate(ctrlstr)=
let ctrlstr.EDC_modulesEditor.EDM_winScroll -> winstr in
let _GETwindowPositionSize winstr.EDW_win -> [_ _ ww wh] in
if ww <= 0 || wh <= 0 then nil else
(
_PAINTcontainerArea ctrlstr.EDC_modulesEditor.EDM_cont 0 0 ww wh;
);
0;;
fun dsEdCtrlModuleEditorRoundLink(ctrlstr, rlinkstr)=
if rlinkstr.EDRL_tooltip == nil then nil else
let rlinkstr.EDRL_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set rlinkstr.EDRL_tooltip = nil;
);
_DStoolTip rlinkstr.EDRL_node;
_DScompBitmap rlinkstr.EDRL_compBmp;
_DSalphaBitmap rlinkstr.EDRL_alphaBmp;
_DSbitmap rlinkstr.EDRL_bmpOn;
_DSbitmap rlinkstr.EDRL_bmpOff;
exec ctrlstr.EDC_modulesEditor.EDM_cbRoundLinkDestroy with [ctrlstr rlinkstr];
set ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink = G2DremoveFromList ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink rlinkstr;
set ctrlstr.EDC_modulesEditor.EDM_lRoundLinks = G2DremoveFromList ctrlstr.EDC_modulesEditor.EDM_lRoundLinks rlinkstr;
0;;
fun chkCtrlModuleEditorBox(ctrlstr, mboxstr, add, paint)=
let ctrlstr.EDC_modulesEditor -> mestr in
(
if add then nil else
(
let ctrlstr.EDC_modulesEditor.EDM_selectedBox -> lselected in
let sizelist lselected -> size in
let 0 -> i in
while i < size do
(
let nth_list lselected i -> boxstr in
(
let _GETalphaBitmaps boxstr.EDB_alphaBmp -> [buffer _] in
if (mestr.EDM_fScale == 1.0) then
(
let _GETbitmap boxstr.EDB_bmpOff -> sbmp in
_SETbitmap buffer sbmp;
0;
)
else
(
let _GETbitmapSize buffer -> [w h] in
let _BTGETbitmapBuffer buffer -> nbuff in
let boxstr.EDB_bmpOff -> bmp in
_BTSCALEbitmap buffer bmp 1;
0;
);
set ctrlstr.EDC_modulesEditor.EDM_selectedBox = G2DremoveFromList ctrlstr.EDC_modulesEditor.EDM_selectedBox boxstr;
set boxstr.EDB_bState = 0;
//_PAINTobjNode boxstr.EDB_node;
);
set i = i + 1;
);
);
if(mboxstr == nil) then nil else
(
let _GETalphaBitmaps mboxstr.EDB_alphaBmp -> [buffer _] in
if (mestr.EDM_fScale == 1.0) then
(
let _GETbitmap (if !mboxstr.EDB_bState then mboxstr.EDB_bmpOn else mboxstr.EDB_bmpOff) -> sbmp in
_SETbitmap buffer sbmp;
0;
)
else
(
let _GETbitmapSize buffer -> [w h] in
let _BTGETbitmapBuffer buffer -> nbuff in
let if !mboxstr.EDB_bState then mboxstr.EDB_bmpOn else mboxstr.EDB_bmpOff -> bmp in
_BTSCALEbitmap buffer bmp 1;
0;
);
set mboxstr.EDB_bState = !mboxstr.EDB_bState;
if !mboxstr.EDB_bState then
set ctrlstr.EDC_modulesEditor.EDM_selectedBox = G2DremoveFromList ctrlstr.EDC_modulesEditor.EDM_selectedBox mboxstr
else
set ctrlstr.EDC_modulesEditor.EDM_selectedBox = if add then mboxstr::ctrlstr.EDC_modulesEditor.EDM_selectedBox else mboxstr::nil;
//_PAINTobjNode boxstr.EDB_node;
);
if mboxstr != nil then nil else
set ctrlstr.EDC_modulesEditor.EDM_selectedBox = nil;
if !paint then nil else
paintEdCtrlModuleEditor ctrlstr;
//_PAINTobjNode ctrlstr.EDC_modulesEditor.EDM_node;
exec mestr.EDM_cbBoxSelect with [ctrlstr mboxstr];
);
0;;
fun chkCtrlModuleEditorRoundLink(ctrlstr, rlinktr, add, paint)=
let ctrlstr.EDC_modulesEditor -> mestr in
(
if (add) then
(
let !rlinktr.EDRL_bState -> state in
let _GETalphaBitmaps rlinktr.EDRL_alphaBmp -> [buffer _] in
(
if (mestr.EDM_fScale == 1.0) then
(
let _GETbitmap (if state then rlinktr.EDRL_bmpOn else rlinktr.EDRL_bmpOff) -> sbmp in
_SETbitmap buffer sbmp;
0;
)
else
(
let _GETbitmapSize buffer -> [w h] in
let if state then rlinktr.EDRL_bmpOn else rlinktr.EDRL_bmpOff -> bmp in
_BTSCALEbitmap buffer bmp 1;
0;
);
set rlinktr.EDRL_bState = state;
);
)
else
(
let sizelist mestr.EDM_lRoundLinks -> size in
let 0 -> i in
while i < size do
(
let nth_list mestr.EDM_lRoundLinks i -> crlinkstr in
let if crlinkstr == rlinktr then 1 else 0 -> state in
(
let _GETalphaBitmaps crlinkstr.EDRL_alphaBmp -> [buffer _] in
if (mestr.EDM_fScale == 1.0) then
(
let _GETbitmap (if state then crlinkstr.EDRL_bmpOn else crlinkstr.EDRL_bmpOff) -> sbmp in
_SETbitmap buffer sbmp;
0;
)
else
(
let _GETbitmapSize buffer -> [w h] in
let if state then crlinkstr.EDRL_bmpOn else crlinkstr.EDRL_bmpOff -> bmp in
_BTSCALEbitmap buffer bmp 1;
0;
);
set crlinkstr.EDRL_bState = state;
);
set i = i + 1;
);
);
if (rlinktr == nil) then
set ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink = nil
else if !rlinktr.EDRL_bState then
set ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink = G2DremoveFromList ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink rlinktr
else
set ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink = if add then rlinktr::ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink else rlinktr::nil;
if (!paint) then nil else
paintEdCtrlModuleEditor ctrlstr;
//_PAINTobjNode ctrlstr.EDC_modulesEditor.EDM_node;
//exec mestr.EDM_cbBoxSelect with [ctrlstr mboxstr];
);
0;;
fun cbEdCtrlModuleEditorRoundLinkClick(cmpbmp, p, x, y, btn, mask)=
let p -> [ctrlstr rlinktr] in
(
if btn != 1 then nil else
(
set ctrlstr.EDC_modulesEditor.EDM_bLinkClicked = 1;
let (_keybdstate == 2) -> add in
if ctrlstr.EDC_modulesEditor.EDM_iLinkMode then nil else
(
if (add || (ctrlstr.EDC_modulesEditor.EDM_selectedBox == nil)) then
set ctrlstr.EDC_modulesEditor.EDM_lastSelectedBox = nil
else
set ctrlstr.EDC_modulesEditor.EDM_lastSelectedBox = ctrlstr.EDC_modulesEditor.EDM_selectedBox;
chkCtrlModuleEditorRoundLink ctrlstr rlinktr add (if add then 1 else 0);
if (add) then nil else
chkCtrlModuleEditorBox ctrlstr nil 0 1;
);
_TOPobjNode _PAINTobjNode rlinktr.EDRL_node;
0;
);
exec ctrlstr.EDC_modulesEditor.EDM_cbRoundLinkClick with [ctrlstr rlinktr btn mask];
);
0;;
fun setEdCtrlModuleEditorRoundLinkCbClick(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbRoundLinkClick = cbfun;
0;;
fun cbEdCtrlModuleEditorRoundLinkUnClick(cmpbmp, p, x, y, btn, mask)=
let p -> [ctrlstr rlinktr] in
exec ctrlstr.EDC_modulesEditor.EDM_cbRoundLinkUnClick with [ctrlstr rlinktr btn mask];
0;;
fun setEdCtrlModuleEditorRoundLinkCbUnClick(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbRoundLinkUnClick = cbfun;
0;;
fun cbEdCtrlModuleEditorRoundLinkDbClick(cmpbmp, p, x, y, btn, mask)=
let p -> [ctrlstr rlinktr] in
exec ctrlstr.EDC_modulesEditor.EDM_cbRoundLinkDbClick with [ctrlstr rlinktr btn mask];
0;;
fun setEdCtrlModuleEditorRoundLinkCbDbClick(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbRoundLinkDbClick = cbfun;
0;;
fun setEdCtrlModuleEditorRoundLinkCbDestroy(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbRoundLinkDestroy = cbfun;
0;;
fun setEdCtrlModuleEditorRoundLinkCbUpdate(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbRoundLinkUpdate = cbfun;
0;;
fun setEdCtrlModuleEditorRoundLinkFlag(rlinkstr, flag)= set rlinkstr.EDRL_iFlag = flag;;
fun getEdCtrlModuleEditorRoundLinkFlag(rlinkstr)= rlinkstr.EDRL_iFlag;;
fun cbEdModuleEditorRoundLinkToolTipHide(node, p, bubble)=
//let p -> [ctrlstr rlinkstr] in
//let rlinkstr.EDRL_tooltip -> [tpcont tptext] in
//(
// _DScompText tptext;
// _DScontainer tpcont;
// set rlinkstr.EDRL_tooltip = nil;
//);
0;;
fun cbEdModuleEditorRoundLinkToolTipShow(node, p, bubble, dx, dy)=
let p -> [ctrlstr rlinkstr] in
(
if rlinkstr.EDRL_tooltip == nil then nil else
let rlinkstr.EDRL_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set rlinkstr.EDRL_tooltip = nil;
);
let G2DgetStringSize ctrlstr.EDC_theme.EDT_fontToolTip bubble -> [w h] in
let _GETWorkingAreaSize -> [sw sh] in
let sh - 40 -> sh in
let _GETscreenPos -> [sx sy] in
let [16 16] -> [xdecal ydecal] in
let if (sx + w + 4 + xdecal) > sw then (sw - (w + 4) - xdecal) else sx + xdecal -> x in
let if (sy + h + 4 + ydecal) > sh then (sh - (h + 4) - ydecal) else sy + ydecal -> y in
let (_CRcontainerFromObjWin ctrlstr.EDC_modulesEditor.EDM_channel ctrlstr.EDC_modulesEditor.EDM_winScroll.EDW_virtualWin x y w+4 h+4 CO_NOCAPTION 0xffffff nil) -> tpcont in
let _CRcompText ctrlstr.EDC_modulesEditor.EDM_channel tpcont nil [2 2] CT_LABEL|CT_LEFT|OBJ_VISIBLE nil w h bubble ctrlstr.EDC_theme.EDT_fontToolTip [0 nil nil nil] nil nil nil -> tptext in
(
set rlinkstr.EDRL_tooltip = [tpcont tptext];
_PAINTcontainer tpcont;
);
);
0;;
fun setEdCtrlModuleEditorRoundLinkTooltip(ctrlstr, rlinkstr, bubble)=
if rlinkstr.EDRL_tooltip == nil then nil else
let rlinkstr.EDRL_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set rlinkstr.EDRL_tooltip = nil;
);
_DStoolTip rlinkstr.EDRL_node;
_CRtoolTip rlinkstr.EDRL_node 150 bubble @cbEdModuleEditorRoundLinkToolTipShow [ctrlstr rlinkstr] @cbEdModuleEditorRoundLinkToolTipHide [ctrlstr rlinkstr];
0;;
fun cbEdCtrlModuleEditorRoundLinkMouseOut(cmpbmp, p, x, y, mask)=
let p -> [ctrlstr rlinkstr] in
if (rlinkstr.EDRL_tooltip == nil) then nil else
let rlinkstr.EDRL_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set rlinkstr.EDRL_tooltip = nil;
);
0;;
fun cbEdCtrlModuleEditorRoundLinkResize(cbmp, p, w, h, oldval)=
let oldval -> [ox oy ow oh] in
let p -> [ctrlstr rlinkstr] in
let if rlinkstr.EDRL_bState then rlinkstr.EDRL_bmpOn else rlinkstr.EDRL_bmpOff -> bmp in
let _FILLbitmap _CRbitmap _channel w h 0 -> nbmp in
let _BTSCALEbitmap nbmp bmp 1 -> nbmp in
let _CRalphaBitmap ctrlstr.EDC_channel nbmp nil nil 0 -> abmp in
(
_DSbitmap nbmp;
_DSalphaBitmap rlinkstr.EDRL_alphaBmp;
set rlinkstr.EDRL_alphaBmp = abmp;
[abmp [ox oy w h]];
);;
fun crEdCtrlModuleEditorRoundLink(ctrlstr, linkstr)=
let ctrlstr.EDC_modulesEditor -> mestr in
let ctrlstr.EDC_theme.EDT_iModuleEditorRLinkSize -> dcircle in
let ftoi ((itof dcircle) *. mestr.EDM_fScale) -> scircle in
let linkstr.EDL_srcModuleBox -> srcmboxstr in
let linkstr.EDL_dstModuleBox -> dstmboxstr in
let findEdCtrlModuleEditorRoundLink ctrlstr srcmboxstr dstmboxstr -> rlinkexiststr in
let _GETobjNodePositionSizeInContainerRef srcmboxstr.EDB_node -> [x1 y1 w1 h1] in
let _GETobjNodePositionSizeInContainerRef dstmboxstr.EDB_node -> [x2 y2 w2 h2] in
let if srcmboxstr == dstmboxstr then
[x1 y1 x2 y2]
else
calcEdCtrlModuleEditorRoundLinkPos x1 y1 w1 h1 x2 y2 w2 h2
-> [px1 py1 px2 py2] in
let if (ctrlstr.EDC_modulesEditor.EDM_bLinksCurved) then
getEdCtrlModuleEditorLinkCenterPrivate px1 py1 px2 py2
else
[(px2 + px1) / 2 (py2 + py1) / 2]
-> [ncx ncy] in
let [(ncx - (scircle / 2)) (ncy - (scircle / 2))] -> [mx my] in
let if rlinkexiststr != nil then rlinkexiststr else
(
let mkEdModuleRoundLink [srcmboxstr dstmboxstr nil nil nil nil nil nil nil nil 0] -> rlinknewstr in
(
set ctrlstr.EDC_modulesEditor.EDM_lRoundLinks = G2Dlcat ctrlstr.EDC_modulesEditor.EDM_lRoundLinks rlinknewstr::nil;
set rlinknewstr.EDRL_bmpOff = _FILLbitmap _CRbitmap ctrlstr.EDC_channel dcircle dcircle 0;
set rlinknewstr.EDRL_alphaBmp = _CRalphaBitmap ctrlstr.EDC_channel rlinknewstr.EDRL_bmpOff nil nil 0;
set rlinknewstr.EDRL_compBmp = _CRcompBitmap ctrlstr.EDC_channel ctrlstr.EDC_modulesEditor.EDM_cont ctrlstr.EDC_modulesEditor.EDM_node [mx my] OBJ_DISABLE|OBJ_HIDE OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_MOVE rlinknewstr.EDRL_alphaBmp 0 0 dcircle dcircle;
set rlinknewstr.EDRL_node = _CONVERTcompBitmapToObjNode rlinknewstr.EDRL_compBmp;
_CBcompBitmapClick rlinknewstr.EDRL_compBmp @cbEdCtrlModuleEditorRoundLinkClick [ctrlstr rlinknewstr];
_CBcompBitmapUnClick rlinknewstr.EDRL_compBmp @cbEdCtrlModuleEditorRoundLinkUnClick [ctrlstr rlinknewstr];
_CBcompBitmapDblClick rlinknewstr.EDRL_compBmp @cbEdCtrlModuleEditorRoundLinkDbClick [ctrlstr rlinknewstr];
_CBcompBitmapResizeResource rlinknewstr.EDRL_compBmp @cbEdCtrlModuleEditorRoundLinkResize [ctrlstr rlinknewstr];
_CBcompBitmapCursorMoveOut rlinknewstr.EDRL_compBmp @cbEdCtrlModuleEditorRoundLinkMouseOut [ctrlstr rlinknewstr];
rlinknewstr;
);
)
-> rlinkstr in
(
set rlinkstr.EDRL_lLinks = G2Dlcat rlinkstr.EDRL_lLinks linkstr::nil;
if rlinkstr.EDRL_bmpOn == nil then nil else
_DSbitmap rlinkstr.EDRL_bmpOn;
if rlinkstr.EDRL_bmpOff == nil then nil else
_DSbitmap rlinkstr.EDRL_bmpOff;
let sizelist rlinkstr.EDRL_lLinks -> nb in
let _DRAWcircle (_FILLbitmap _CRbitmap ctrlstr.EDC_channel dcircle dcircle 0) (dcircle / 2) (dcircle / 2) (dcircle / 2) DRAW_SOLID ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth ctrlstr.EDC_theme.EDT_iModuleEditorLinkOff DRAW_SOLID ctrlstr.EDC_theme.EDT_iModuleEditorBoxOff -> offbmp in
let _DRAWcircle (_FILLbitmap _CRbitmap ctrlstr.EDC_channel dcircle dcircle 0) (dcircle / 2) (dcircle / 2) (dcircle / 2) DRAW_SOLID ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth ctrlstr.EDC_theme.EDT_iModuleEditorLinkOn DRAW_SOLID ctrlstr.EDC_theme.EDT_iModuleEditorBoxOn -> onbmp in
let G2DgetStringSize ctrlstr.EDC_theme.EDT_fontModuleEditor itoa nb -> [sw sh] in
let _DRAWtext offbmp ctrlstr.EDC_theme.EDT_fontModuleEditor (dcircle / 2) ((dcircle / 2) - (sh / 2)) TD_CENTER ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOff itoa nb -> offbmp in
let _DRAWtext onbmp ctrlstr.EDC_theme.EDT_fontModuleEditor (dcircle / 2) ((dcircle / 2) - (sh / 2)) TD_CENTER ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOn itoa nb -> onbmp in
(
set rlinkstr.EDRL_bmpOff = offbmp;
set rlinkstr.EDRL_bmpOn = onbmp;
let _GETalphaBitmaps rlinkstr.EDRL_alphaBmp -> [buffer _] in
if (mestr.EDM_fScale == 1.0) then
(
let _GETbitmap (if rlinkstr.EDRL_bState then rlinkstr.EDRL_bmpOn else rlinkstr.EDRL_bmpOff) -> sbmp in
_SETbitmap buffer sbmp;
0;
)
else
(
let _GETbitmapSize buffer -> [w h] in
let if rlinkstr.EDRL_bState then rlinkstr.EDRL_bmpOn else rlinkstr.EDRL_bmpOff -> bmp in
_BTSCALEbitmap buffer bmp 1;
0;
);
_CHANGEobjNodeCoordinates rlinkstr.EDRL_node [mx my] 0;
_CHANGEobjNodeFlags rlinkstr.EDRL_node OBJ_ENABLE|OBJ_VISIBLE 0;
if (mestr.EDM_fScale == 1.0) then nil else
(
let ftoi ((itof dcircle) *. mestr.EDM_fScale) -> w in
_SIZEobjNode rlinkstr.EDRL_node w w 0;
);
exec ctrlstr.EDC_modulesEditor.EDM_cbRoundLinkUpdate with [ctrlstr rlinkstr];
rlinkstr;
);
);;
fun removeEdCtrlModuleEditorLinkFromRoundLink(ctrlstr, linkstr, refresh)=
let ctrlstr.EDC_modulesEditor -> mestr in
let linkstr.EDL_rLink -> rlinkstr in
let ctrlstr.EDC_theme.EDT_iModuleEditorRLinkSize -> dcircle in
(
set rlinkstr.EDRL_lLinks = remove_from_list rlinkstr.EDRL_lLinks linkstr;
let sizelist rlinkstr.EDRL_lLinks -> nb in
if nb <= 0 then
(
dsEdCtrlModuleEditorRoundLink ctrlstr rlinkstr;
if !refresh then nil else
paintEdCtrlModuleEditor ctrlstr;
0;
)
else
(
if rlinkstr.EDRL_bmpOn == nil then nil else
_DSbitmap rlinkstr.EDRL_bmpOn;
if rlinkstr.EDRL_bmpOff == nil then nil else
_DSbitmap rlinkstr.EDRL_bmpOff;
let _DRAWcircle (_FILLbitmap _CRbitmap ctrlstr.EDC_channel dcircle dcircle 0) (dcircle / 2) (dcircle / 2) (dcircle / 2) DRAW_SOLID ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth ctrlstr.EDC_theme.EDT_iModuleEditorLinkOff DRAW_SOLID ctrlstr.EDC_theme.EDT_iModuleEditorBoxOff -> offbmp in
let _DRAWcircle (_FILLbitmap _CRbitmap ctrlstr.EDC_channel dcircle dcircle 0) (dcircle / 2) (dcircle / 2) (dcircle / 2) DRAW_SOLID ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth ctrlstr.EDC_theme.EDT_iModuleEditorLinkOn DRAW_SOLID ctrlstr.EDC_theme.EDT_iModuleEditorBoxOn -> onbmp in
let G2DgetStringSize ctrlstr.EDC_theme.EDT_fontModuleEditor itoa nb -> [sw sh] in
let _DRAWtext offbmp ctrlstr.EDC_theme.EDT_fontModuleEditor (dcircle / 2) ((dcircle / 2) - (sh / 2)) TD_CENTER ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOff itoa nb -> offbmp in
let _DRAWtext onbmp ctrlstr.EDC_theme.EDT_fontModuleEditor (dcircle / 2) ((dcircle / 2) - (sh / 2)) TD_CENTER ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOn itoa nb -> onbmp in
(
set rlinkstr.EDRL_bmpOff = offbmp;
set rlinkstr.EDRL_bmpOn = onbmp;
let _GETalphaBitmaps rlinkstr.EDRL_alphaBmp -> [buffer _] in
if (mestr.EDM_fScale == 1.0) then
(
let _GETbitmap (if rlinkstr.EDRL_bState then rlinkstr.EDRL_bmpOn else rlinkstr.EDRL_bmpOff) -> sbmp in
_SETbitmap buffer sbmp;
0;
)
else
(
let _GETbitmapSize buffer -> [w h] in
let if rlinkstr.EDRL_bState then rlinkstr.EDRL_bmpOn else rlinkstr.EDRL_bmpOff -> bmp in
_BTSCALEbitmap buffer bmp 1;
0;
);
exec ctrlstr.EDC_modulesEditor.EDM_cbRoundLinkUpdate with [ctrlstr rlinkstr];
_TOPobjNode rlinkstr.EDRL_node;
);
0;
);
);
0;;
fun dsEdCtrlModuleEditorLink(ctrlstr, linkstr, refresh)=
set ctrlstr.EDC_modulesEditor.EDM_lLinks = G2DremoveFromList ctrlstr.EDC_modulesEditor.EDM_lLinks linkstr;
removeEdCtrlModuleEditorLinkFromRoundLink ctrlstr linkstr refresh;
0;;
fun crEdCtrlModuleEditorLink(ctrlstr, srcmboxstr, dstmboxstr, lp, param)=
let mkEdModuleLink [srcmboxstr dstmboxstr lp param nil 0] -> linkstr in
(
set ctrlstr.EDC_modulesEditor.EDM_lLinks = G2Dlcat ctrlstr.EDC_modulesEditor.EDM_lLinks linkstr::nil;
//drawEdCtrlModuleEditorLink ctrlstr linkstr;
set linkstr.EDL_rLink = crEdCtrlModuleEditorRoundLink ctrlstr linkstr;
linkstr;
);;
fun getEdCoordsOverlap(rect1, rect2)=
let rect1 -> [x1 y1 w1 h1] in
let rect2 -> [x2 y2 w2 h2] in
let x1 + w1 -> ir1 in
let x2 + w2 -> ir2 in
let y1 + h1 -> ib1 in
let y2 + h2 -> ib2 in
(
if (x1 >= ir2 || x2 >= ir1) || (y1 >= ib2 || y2 >= ib1) then
0
else
1;
);;
fun getEdCtrlModuleEditorBoxOptimizedPos(mestr, mboxstr, x, y)=
let [(mboxstr.EDB_iWidth / mestr.EDM_iSnap) (mboxstr.EDB_iHeight / mestr.EDM_iSnap)] -> [mcw mch] in
let sizelist mestr.EDM_lBox -> size in
let nil -> nx in
let nil -> ny in
let 0 -> i in
(
while (i < size) && (nx == nil && ny == nil) do
(
let nth_list mestr.EDM_lBox i -> [_ boxstr] in
if (boxstr == mboxstr) then nil else
(
let boxstr.EDB_pos -> [cx cy] in
let [(boxstr.EDB_iWidth / mestr.EDM_iSnap) (boxstr.EDB_iHeight / mestr.EDM_iSnap)] -> [cw ch] in
if (getEdCoordsOverlap [x y mcw mch] [cx cy cw ch]) then
(
let if (x - cx) > (y - cy) then [(cx + cw) y] else [x (cy + ch)] -> [xx yy] in
if (xx == x) && (yy == y) then nil else
let getEdCtrlModuleEditorBoxOptimizedPos mestr mboxstr xx yy -> [xx yy] in
(
set nx = xx;
set ny = yy;
)
)
else nil;
);
set i = i + 1;
);
[(if nx == nil then x else nx) (if ny == nil then y else ny)];
);;
fun setEdCtrlModuleEditorZoomLevel(ctrlstr, level)=
let if level <= 30 then 30 else if level >= 100 then 100 else level -> level in
let ctrlstr.EDC_modulesEditor -> mestr in
(
set mestr.EDM_fScale = (itof level) /. 100.0;
set mestr.EDM_bmpBack.EDC_fParam = mestr.EDM_fScale;
let sizelist mestr.EDM_lBox -> size in
let 0 -> i in
while (i < size) do
(
let nth_list mestr.EDM_lBox i -> [_ mboxstr] in
let ftoi ((itof mboxstr.EDB_iWidth) *. mestr.EDM_fScale) -> w in
let ftoi ((itof mboxstr.EDB_iHeight) *. mestr.EDM_fScale) -> h in
let mboxstr.EDB_pos -> [mx my] in
let ftoi ((itof mestr.EDM_iSnap) *. mestr.EDM_fScale) -> snap in
let [(mx * snap) (my * snap)] -> [px py] in
let [(px - (mod px snap)) (py - (mod py snap))] -> [nx ny] in
(
_CHANGEobjNodeCoordinates mboxstr.EDB_node [nx ny] 0;
_SIZEobjNode mboxstr.EDB_node w h 0;
);
set i = i + 1;
);
let sizelist mestr.EDM_lRoundLinks -> size in
let 0 -> i in
while (i < size) do
(
let nth_list mestr.EDM_lRoundLinks i -> rlinkstr in
let ftoi ((itof ctrlstr.EDC_theme.EDT_iModuleEditorRLinkSize) *. mestr.EDM_fScale) -> w in
(
_SIZEobjNode rlinkstr.EDRL_node w w 0;
);
set i = i + 1;
);
let mestr.EDM_winScroll -> winstr in
let mestr.EDM_winDmi -> windmistr in
let mestr.EDM_sizeSurface -> [w h] in
let ftoi ((itof w) *. mestr.EDM_fScale) -> w in
let ftoi ((itof h) *. mestr.EDM_fScale) -> h in
(
//setEdVirtualWindowSize winstr w h;
//setEdWindowSize windmistr w h;
updateEdCtrlGrid mestr.EDM_bmpBack ctrlstr.EDC_theme.EDT_iModuleEditorDot;
);
paintEdCtrlModuleEditor ctrlstr;
);
0;;
fun getEdCtrlModuleEditorZoomLevel(ctrlstr)= ftoi (ctrlstr.EDC_modulesEditor.EDM_fScale *. 100.0);;
fun cbEdCtrlModuleEditorWheel(cont, ctrlstr, x, y, delta, btn)=
let ctrlstr.EDC_modulesEditor.EDM_winScroll -> winstr in
let ctrlstr.EDC_modulesEditor.EDM_winDmi -> windmistr in
if winstr.EDW_virtualWin == nil then nil else
let delta * 10 -> delta in
//if (btn & MK_CONTROL) then
let getEdVirtualWindowSize winstr -> [w h] in
(
let ctrlstr.EDC_modulesEditor -> mestr in
let (ftoi (mestr.EDM_fScale *. 100.0)) + delta -> level in
setEdCtrlModuleEditorZoomLevel ctrlstr level;
0;
);
/*
else
(
let _GETwindowPositionSize winstr.EDW_win -> [_ _ ww wh] in
let _GETwindowPositionSize winstr.EDW_virtualWin -> [vx vy vw vh] in
let if (vy + delta) <= (-(vh - wh)) then (-(vh - wh)) else if (vy + delta) >= 0 then 0 else (vy + delta) -> my in
_MVwindow winstr.EDW_virtualWin vx my;
0;
);
*/
0;;
fun setEdCtrlModuleEditorMouseLink(cont, ctrlstr, rec)=
let ctrlstr.EDC_modulesEditor -> mestr in
let mestr.EDM_moveCoords -> [posx posy] in
let _GETcontainerMap cont -> buffer in
let mestr.EDM_mnuBox -> selboxstr in
let _GETobjNodePositionSizeInContainerRef selboxstr.EDB_node -> [x y w h] in
let [(x + (w / 2)) (y + (h / 2))] -> [px py] in
if (ctrlstr.EDC_modulesEditor.EDM_bLinksCurved) then
drawEdCtrlModuleEditorLinkCurvedPrivate buffer px py posx posy 1 0xffff00
else
drawEdCtrlModuleEditorLinkPrivate buffer px py posx posy 1 0xffff00;
0;;
fun setEdCtrlModuleEditorMouseSelection(cont, ctrlstr, rec)=
let ctrlstr.EDC_modulesEditor -> mestr in
let mestr.EDM_winScroll -> winstr in
let _GETwindowPositionSize winstr.EDW_virtualWin -> [vx vy vw vh] in
let mestr.EDM_tLastCursorPos -> [lgx lgy] in
let mestr.EDM_tLastClickPos -> [mgx mgy] in
let mestr.EDM_tLastLocalClickPos -> [mcx mcy] in
let [((mcx - vx) - mgx) ((mcy - vy) - mgy)] -> [xdiff ydiff] in
let [(mcx - xdiff) (mcy - ydiff)] -> [mcx mcy] in
let [(lgx - mgx) (lgy - mgy)] -> [selectw selecth] in
let _GETcontainerMap cont -> bbuffer in
_BTDRAWrect bbuffer [mcx mcy selectw selecth] 0xffffff 1 0 0;
0;;
fun cbCtrlModuleEditorCursorMove(cont, ctrlstr, x, y, btn)=
let ctrlstr.EDC_modulesEditor -> mestr in
let mestr.EDM_winScroll -> winstr in
let _GETwindowPositionSize winstr.EDW_win -> [_ _ ww wh] in
let _GETwindowPositionSize winstr.EDW_virtualWin -> [vx vy vw vh] in
(
set ctrlstr.EDC_modulesEditor.EDM_moveCoords = [x y];
if vx == nil || vy == nil || vw == nil || vh == nil then nil else
if (btn & 16) || ((btn == 1) && (ctrlstr.EDC_modulesEditor.EDM_iLinkMode)) then
(
if mestr.EDM_tLastCursorPos == nil then
(
set mestr.EDM_tLastCursorPos = [(x - vx) (y - vy)];
set mestr.EDM_tLastLocalCursorPos = [x y];
0;
)
else
(
let mestr.EDM_tLastCursorPos -> [cx cy] in
let if (x - cx) <= (-(vw - ww)) then (-(vw - ww)) else if (x - cx) >= 0 then 0 else (x - cx) -> mx in
let if (y - cy) <= (-(vh - wh)) then (-(vh - wh)) else if (y - cy) >= 0 then 0 else (y - cy) -> my in
_MVwindow winstr.EDW_virtualWin mx my;
0;
);
)
else if (btn == 1) || (btn == 1|MK_CONTROL) then
(
set mestr.EDM_tLastCursorPos = [(x - vx) (y - vy)];
set mestr.EDM_tLastLocalCursorPos = [x y];
let if (x + 10 > ww) then vx - (x - ww) - 10 else if (x < 10) then vx - x + 10 else vx -> mvx in
let if (y + 10 > wh) then vy - (y - wh) - 10 else if (y < 10) then vy - y + 10 else vy -> mvy in
let if mvx <= (-(vw - ww)) then (-(vw - ww)) else if mvx >= 0 then 0 else mvx -> mx in
let if mvy <= (-(vh - wh)) then (-(vh - wh)) else if mvy >= 0 then 0 else mvy -> my in
_MVwindow winstr.EDW_virtualWin mx my;
0;
)
else nil;
if !ctrlstr.EDC_modulesEditor.EDM_iLinkMode && !btn then nil else
paintEdCtrlModuleEditorNoUpdate ctrlstr;
);
0;;
fun cbCtrlModuleEditorBoxCursorMove(cont, p, x, y, btn)=
let p -> [ctrlstr smboxstr [oldx oldy]] in
let ctrlstr.EDC_modulesEditor -> mestr in
let _GETwindowPositionSize mestr.EDM_winScroll.EDW_virtualWin -> [cx cy vw vh] in
let getEdWindowSize mestr.EDM_winScroll -> [ww wh] in
let calcEdModuleEditorSelectedBoxSquare ctrlstr -> [sqx sqy sqw sqh] in
// try to block the mouse in the window
let [(if x < 0 then 0 else if x > ww then ww else x) (if y < 0 then 0 else if y > wh then wh else y)] -> [x y] in
let sqx + (x - oldx) -> cnx in
let sqy + (y - oldy) -> cny in
let if cnx < 0 then 0 else cnx -> cnx in
let if cny < 0 then 0 else cny -> cny in
let [(cnx - sqx) (cny - sqy)] -> [mvx mvy] in
let ftoi ((itof mestr.EDM_iSnap) *. mestr.EDM_fScale) -> snap in
(
//_SETcursorPos mestr.EDM_winScroll.EDW_virtualWin x y;
exec mestr.EDM_cbSelectedBoxMoving with [ctrlstr x y btn];
let sizelist mestr.EDM_selectedBox -> size in
let 0 -> i in
while i < size do
(
let nth_list mestr.EDM_selectedBox i -> mboxstr in
let _GETobjNodePositionSizeInFatherRef mboxstr.EDB_node -> [modx mody modw modh] in
let modx + mvx -> nx in
let mody + mvy -> ny in
(
_CHANGEobjNodeCoordinates mboxstr.EDB_node [nx ny] 0;
set mboxstr.EDB_pos = [(nx / snap) (ny / snap)];
set mboxstr.EDB_bHasMoved = 1;
set i = i + 1;
);
);
if ((cnx + cx + sqw) > ww) || ((cnx + cx) < 0) || ((cny + cy + sqh) > wh) || ((cny + cy) < 0) then
(
let if ((cnx + cx + sqw) > ww) || ((cnx + cx) < 0) then cx - (cnx - sqx) else cx -> wmvx in
let if ((cny + cy + sqh) > wh) || ((cny + cy) < 0) then cy - (cny - sqy) else cy -> wmvy in
let if wmvx <= (-(vw - ww)) then (-(vw - ww)) else if wmvx >= 0 then 0 else wmvx -> wmvx in
let if wmvy <= (-(vh - wh)) then (-(vh - wh)) else if wmvy >= 0 then 0 else wmvy -> wmvy in
(
_MVwindow mestr.EDM_winScroll.EDW_virtualWin wmvx wmvy;
);
)
else nil;
mutate p <- [_ _ [x y]];
paintEdCtrlModuleEditorResizeMax ctrlstr;
0;
);
0;;
fun getEdModuleEditorRlinksInArea(ctrlstr, x1, y1, x2, y2)=
if x1 == nil || x2 == nil || y1 == nil || y2 == nil then nil else
let ctrlstr.EDC_modulesEditor -> mestr in
let if x1 > x2 then [x2 x1] else [x1 x2] -> [x1 x2] in
let if y1 > y2 then [y2 y1] else [y1 y2] -> [y1 y2] in
let nil -> lslinks in
(
let sizelist mestr.EDM_lRoundLinks -> size in
let 0 -> i in
while i < size do
(
let nth_list mestr.EDM_lRoundLinks i -> rlinkstr in
let _GETobjNodePositionSizeInFatherRef rlinkstr.EDRL_node -> [mbx mby mbw mbh] in
if ((mbx > x1) && (mby > y1)) && ((mbx+mbw < x2) && (mby+mbh < y2)) then
set lslinks = rlinkstr::lslinks
else nil;
set i = i + 1;
);
lslinks;
);;
fun getEdModuleEditorBoxesInArea(ctrlstr, x1, y1, x2, y2)=
if x1 == nil || x2 == nil || y1 == nil || y2 == nil then nil else
let ctrlstr.EDC_modulesEditor -> mestr in
let if x1 > x2 then [x2 x1] else [x1 x2] -> [x1 x2] in
let if y1 > y2 then [y2 y1] else [y1 y2] -> [y1 y2] in
let nil -> lsbox in
(
let sizelist mestr.EDM_lBox -> size in
let 0 -> i in
while i < size do
(
let nth_list mestr.EDM_lBox i -> [_ mboxstr] in
let _GETobjNodePositionSizeInFatherRef mboxstr.EDB_node -> [mbx mby mbw mbh] in
if ((mbx > x1) && (mby > y1)) && ((mbx+mbw < x2) && (mby+mbh < y2)) then
set lsbox = mboxstr::lsbox
else nil;
set i = i + 1;
);
lsbox;
);;
fun cbCtrlModuleEditorUnClick(cont, ctrlstr, x, y, btn, mask)=
let ctrlstr.EDC_modulesEditor -> mestr in
(
set mestr.EDM_tLastCursorPos = nil;
set mestr.EDM_tLastLocalCursorPos = nil;
_CBcontainerCursorMove mestr.EDM_cont @cbCtrlModuleEditorCursorMove ctrlstr;
if ctrlstr.EDC_modulesEditor.EDM_iLinkMode then nil else
_CBcontainerPostRender ctrlstr.EDC_modulesEditor.EDM_cont nil nil;
// rectangle selection
if (btn != 1) || ctrlstr.EDC_modulesEditor.EDM_iLinkMode || ctrlstr.EDC_modulesEditor.EDM_bBoxClicked || ctrlstr.EDC_modulesEditor.EDM_bLinkClicked then nil else //|| (ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink != nil)
(
let ctrlstr.EDC_modulesEditor.EDM_winScroll -> winstr in
let mestr.EDM_tLastClickPos -> [mcx mcy] in
let _GETcursorPos winstr.EDW_win -> [wx wy] in
let _GETwindowPositionSize winstr.EDW_virtualWin -> [vx vy _ _] in
(
let getEdModuleEditorBoxesInArea ctrlstr mcx mcy (wx - vx) (wy - vy) -> lbox in
(
while lbox != nil do
(
chkCtrlModuleEditorBox ctrlstr (hd lbox) 1 0;
set lbox = tl lbox;
);
);
let getEdModuleEditorRlinksInArea ctrlstr mcx mcy (wx - vx) (wy - vy) -> lrlink in
(
while lrlink != nil do
(
chkCtrlModuleEditorRoundLink ctrlstr (hd lrlink) 1 0;
set lrlink = tl lrlink;
);
);
);
);
let mestr.EDM_selectedBox -> lmboxstr in
(
let ftoi ((itof mestr.EDM_iSnap) *. mestr.EDM_fScale) -> snap in
let sizelist lmboxstr -> size in
let 0 -> i in
while i < size do
(
let nth_list lmboxstr i -> mboxstr in
if !mboxstr.EDB_bHasMoved then nil else
let _GETobjNodePositionSizeInFatherRef mboxstr.EDB_node -> [cx cy _ _] in
(
let [(cx - (mod cx snap)) (cy - (mod cy snap))] -> [cx cy] in
let [(cx / snap) (cy / snap)] -> [mx my] in
let getEdCtrlModuleEditorBoxOptimizedPos mestr mboxstr mx my -> [mx my] in
let [(mx * snap) (my * snap)] -> [px py] in
let [(px - (mod px snap)) (py - (mod py snap))] -> [nx ny] in
(
_CHANGEobjNodeCoordinates mboxstr.EDB_node [nx ny] 0;
set mboxstr.EDB_pos = [mx my];
exec mestr.EDM_cbBoxMove with [ctrlstr mboxstr mx my];
);
exec mestr.EDM_cbBoxUnClick with [ctrlstr mboxstr btn mask];
set mboxstr.EDB_bHasMoved = 0;
);
set i = i + 1;
);
);
);
paintEdCtrlModuleEditor ctrlstr;
exec ctrlstr.EDC_modulesEditor.EDM_cbUnClick with [ctrlstr x y btn mask];
set ctrlstr.EDC_modulesEditor.EDM_bBoxClicked = 0;
set ctrlstr.EDC_modulesEditor.EDM_bLinkClicked = 0;
0;;
fun cbCtrlModuleEditorClick(cont, ctrlstr, x, y, btn, mask)=
let ctrlstr.EDC_modulesEditor -> mestr in
let mestr.EDM_winScroll -> winstr in
let _GETcursorPos winstr.EDW_win -> [x y] in
let _GETwindowPositionSize winstr.EDW_virtualWin -> [vx vy vw vh] in
(
set mestr.EDM_tLastClickPos = [(x - vx) (y - vy)];
set mestr.EDM_tLastLocalClickPos = [x y];
if (btn != 1) || ctrlstr.EDC_modulesEditor.EDM_iLinkMode then nil else
(
if (mask &MK_CONTROL) then nil else
(
chkCtrlModuleEditorBox ctrlstr nil 0 0;
chkCtrlModuleEditorRoundLink ctrlstr nil 0 1;
);
_CBcontainerPostRender mestr.EDM_cont @setEdCtrlModuleEditorMouseSelection ctrlstr;
);
let ftoi ((itof (x - vx)) /. mestr.EDM_fScale) -> nx in
let ftoi ((itof (y - vy)) /. mestr.EDM_fScale) -> ny in
exec ctrlstr.EDC_modulesEditor.EDM_cbClick with [ctrlstr nx ny btn mask];
);
0;;
fun cbCtrlModuleEditorDbClick(cont, ctrlstr, x, y, btn, mask)=
let ctrlstr.EDC_modulesEditor -> mestr in
let mestr.EDM_winScroll -> winstr in
let _GETcursorPos winstr.EDW_win -> [x y] in
let _GETwindowPositionSize winstr.EDW_virtualWin -> [vx vy vw vh] in
let ftoi ((itof (x - vx)) /. mestr.EDM_fScale) -> nx in
let ftoi ((itof (y - vy)) /. mestr.EDM_fScale) -> ny in
exec ctrlstr.EDC_modulesEditor.EDM_cbDbClick with [ctrlstr nx ny btn mask];
0;;
fun cbCtrlModuleEditorKeyDown(cont, ctrlstr, key, code)=
exec ctrlstr.EDC_modulesEditor.EDM_cbKeyDown with [ctrlstr key code];
0;;
fun cbCtrlModuleEditorKeyUp(cont, ctrlstr, key)=
exec ctrlstr.EDC_modulesEditor.EDM_cbKeyUp with [ctrlstr key];
0;;
fun selectCtrlModuleEditorBox(ctrlstr, mboxstr, add)=
if (add) then nil else
chkCtrlModuleEditorRoundLink ctrlstr nil 0 0;
chkCtrlModuleEditorBox ctrlstr mboxstr add 1;
0;;
fun cbEdCtrlModuleEditorBoxMenu(elt, p)=
let p -> [ctrlstr mnu mboxstr lp] in
(
set ctrlstr.EDC_modulesEditor.EDM_mnuBox = mboxstr;
exec ctrlstr.EDC_modulesEditor.EDM_cbBoxMenu with [ctrlstr mboxstr lp ctrlstr.EDC_modulesEditor.EDM_iLinkInfos];
set ctrlstr.EDC_modulesEditor.EDM_iLinkInfos = lp;
_DSmenu mnu;
);
0;;
fun cbSortBoxMenu(m1, m2)=
(strcmp strcatn m1 strcatn m2) <= 0;;
fun sortBoxMenu(mboxstr)=
let sizelist mboxstr.EDB_lMenus -> size in
let 0 -> i in
while i < size do
(
let nth_list mboxstr.EDB_lMenus i -> fmenu in
let fmenu -> [_ lmenu] in
mutate fmenu <- [_ (sortlist lmenu @cbSortBoxMenu)];
set i = i + 1;
);;
fun crEdCtrlModuleEditorBoxMenu(ctrlstr, mboxstr)=
//sortBoxMenu mboxstr;
let ctrlstr.EDC_modulesEditor -> mestr in
let _CRpopupMenu mestr.EDM_channel -> mnu in
let switch mboxstr.EDB_lMenus mestr.EDM_iLinkMode -> l in // [Sgrp [S r1] r1]
let sizelist l -> size in
let 0 -> i in
let nil -> lpp in
let nil -> lgrpp in
(
while i < size do
(
let nth_list l i -> [grp lp] in
let if mestr.EDM_iBoxMode then switchstr lpp (hd lp) else mnu -> mpop in
let if mpop == nil then (let _APPpopup mestr.EDM_channel mnu (hd lp) -> mnpop in (set lpp = [(hd lp) mnpop]::lpp; mnpop)) else mpop -> mpop in
let if (grp == nil) then mpop else switchstr lgrpp grp -> mgrppop in
let if (grp != nil) && (mgrppop == nil) then (let _APPpopup mestr.EDM_channel mpop grp -> mnpop in (set lgrpp = [grp mnpop]::lgrpp; mnpop)) else mgrppop -> mpop in
let if mestr.EDM_iBoxMode then (hd tl lp) else (hd lp) -> ename in
_CBmenu _APPitem mestr.EDM_channel mpop ME_ENABLED ename @cbEdCtrlModuleEditorBoxMenu [ctrlstr mnu mboxstr lp];
set i = i + 1;
);
mnu;
);;
fun setEdCtrlModuleEditorBoxMenu(ctrlstr, mboxstr, mode, l)=
set mboxstr.EDB_lMenus = G2DremoveEdIdxFromList mboxstr.EDB_lMenus mode;
set mboxstr.EDB_lMenus = G2Dlcat mboxstr.EDB_lMenus [mode l]::nil;
0;;
fun resetEdCtrlModuleEditorBoxMenu(ctrlstr, mboxstr)=
set mboxstr.EDB_lMenus = nil;
0;;
fun cbEdModuleEditorBoxToolTipHide(node, p, bubble)=
let p -> [ctrlstr mboxstr] in
let mboxstr.EDB_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set mboxstr.EDB_tooltip = nil;
);
0;;
fun cbEdModuleEditorBoxToolTipShow(node, p, bubble, dx, dy)=
let p -> [ctrlstr mboxstr] in
(
if mboxstr.EDB_tooltip == nil then nil else
let mboxstr.EDB_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set mboxstr.EDB_tooltip = nil;
);
let G2DgetStringSize ctrlstr.EDC_theme.EDT_fontToolTip bubble -> [w h] in
let _GETWorkingAreaSize -> [sw sh] in
let sh - 40 -> sh in
let _GETscreenPos -> [sx sy] in
let [16 16] -> [xdecal ydecal] in
let if (sx + w + 4 + xdecal) > sw then (sw - (w + 4) - xdecal) else sx + xdecal -> x in
let if (sy + h + 4 + ydecal) > sh then (sh - (h + 4) - ydecal) else sy + ydecal -> y in
let (_CRcontainerFromObjWin ctrlstr.EDC_modulesEditor.EDM_channel ctrlstr.EDC_modulesEditor.EDM_winScroll.EDW_virtualWin x y w+4 h+4 CO_NOCAPTION 0xffffff nil) -> tpcont in
let _CRcompText ctrlstr.EDC_modulesEditor.EDM_channel tpcont nil [2 2] CT_LABEL|CT_LEFT|OBJ_VISIBLE nil w h bubble ctrlstr.EDC_theme.EDT_fontToolTip [0 nil nil nil] nil nil nil -> tptext in
(
set mboxstr.EDB_tooltip = [tpcont tptext];
_PAINTcontainer tpcont;
);
);
0;;
fun setEdCtrlModuleEditorBoxTooltip(ctrlstr, mboxstr, bubble)=
if mboxstr.EDB_tooltip == nil then nil else
let mboxstr.EDB_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set mboxstr.EDB_tooltip = nil;
);
_DStoolTip mboxstr.EDB_node;
set mboxstr.EDB_sToolTip = bubble;
if mboxstr.EDB_sToolTip == nil then nil else
_CRtoolTip mboxstr.EDB_node 150 bubble @cbEdModuleEditorBoxToolTipShow [ctrlstr mboxstr] @cbEdModuleEditorBoxToolTipHide [ctrlstr mboxstr];
0;;
fun setEdCtrlModuleEditorBoxFlags(mboxstr, flags)= set mboxstr.EDB_iFlags = flags;;
fun getEdCtrlModuleEditorBoxFlags(mboxstr)= mboxstr.EDB_iFlags;;
fun delEdCtrlModuleEditorBoxMenu(ctrlstr, mboxstr, mode, name, name2)=
let ctrlstr.EDC_modulesEditor -> mestr in
let G2DgetElemFromListByIndex mboxstr.EDB_lMenus mode -> fmenu in
let fmenu -> [_ lmenu] in
let lmenu -> lcmnu in
let hd lmenu -> [_ tt] in
let if name2 == nil then (remove_all_first_string_from_second_elem_list lmenu name) else (remove_first_and_second_string_from_second_elem_list lmenu name name2) -> nl in
mutate fmenu <- [_ nl];
0;;
fun delEdCtrlModuleEditorBoxMenuStartWith(ctrlstr, mboxstr, mode, name)=
let ctrlstr.EDC_modulesEditor -> mestr in
let G2DgetElemFromListByIndex mboxstr.EDB_lMenus mode -> fmenu in
let fmenu -> [_ lmenu] in
mutate fmenu <- [_ (remove_first_string_from_second_element_list_start_with lmenu name)];
0;;
fun addEdCtrlModuleEditorBoxMenu(ctrlstr, mboxstr, mode, grp, lp)=
let ctrlstr.EDC_modulesEditor -> mestr in
let switch mboxstr.EDB_lMenus mode -> lmenu in
if lmenu == nil then
(
setEdCtrlModuleEditorBoxMenu ctrlstr mboxstr mode [grp lp]::nil;
0;
)
else // if (isFirstStringInList lmenu (hd lp)) then nil else
let G2DgetElemFromListByIndex mboxstr.EDB_lMenus mode -> fmenu in
let fmenu -> [_ lmenu] in
(
mutate fmenu <- [_ [grp lp]::lmenu];
0;
);
0;;
fun sortEdCtrlModuleEditorBoxMenu(ctrlstr, mboxstr)=
if (!ctrlstr.EDC_modulesEditor.EDM_bSortMenus) then nil else
sortBoxMenu mboxstr;
0;;
fun cbEdCtrlModuleEditorBoxClick(cmpbmp, p, x, y, btn, mask)=
let p -> [ctrlstr mboxstr] in
let ctrlstr.EDC_modulesEditor -> mestr in
if btn == 16 then nil else
(
set mestr.EDM_bBoxClicked = 1;
_TOPobjNode _PAINTobjNode mboxstr.EDB_node;
set mboxstr.EDB_bHasMoved = 0;
set mboxstr.EDB_iKeybState = _keybdstate;
// move
if btn == 1 && !mestr.EDM_iLinkMode then
(
if ((mboxstr.EDB_bState) && (mboxstr.EDB_iKeybState != 2) && ((sizelist ctrlstr.EDC_modulesEditor.EDM_selectedBox) > 1)) then nil else
(
if (mboxstr.EDB_iKeybState == 2) then nil else
chkCtrlModuleEditorRoundLink ctrlstr nil 0 0;
chkCtrlModuleEditorBox ctrlstr mboxstr (if mboxstr.EDB_iKeybState == 2 then 1 else 0) 1;
);
if mboxstr.EDB_bState then
_CBcontainerCursorMove mestr.EDM_cont @cbCtrlModuleEditorBoxCursorMove [ctrlstr mboxstr [x y]]
else
_CBcontainerCursorMove mestr.EDM_cont nil nil;
0;
)
else if btn == 2 then
(
// menu
let _GETscreenPos -> [sx sy] in
let crEdCtrlModuleEditorBoxMenu ctrlstr mboxstr -> mnu in
_DRAWmenu nil mnu sx sy PM_SCREEN|PM_LEFT_ALIGN|PM_TOP_ALIGN;
0;
)
else
(
_CBcontainerCursorMove mestr.EDM_cont nil nil;
0;
);
exec mestr.EDM_cbBoxClick with [ctrlstr mboxstr btn mask];
);
0;;
fun cbEdCtrlModuleEditorBoxDbClick(cmpbmp, p, x, y, btn, mask)=
let p -> [ctrlstr mboxstr] in
if (G2DisInList ctrlstr.EDC_modulesEditor.EDM_selectedBox mboxstr) then
(
set ctrlstr.EDC_modulesEditor.EDM_bBoxClicked = 1;
exec ctrlstr.EDC_modulesEditor.EDM_cbBoxDbClick with [ctrlstr mboxstr btn mask];
)
else nil;
0;;
fun cbEdCtrlModuleEditorBoxUnClick(cmpbmp, p, x, y, btn, mask)=
let p -> [ctrlstr mboxstr] in
let ctrlstr.EDC_modulesEditor -> mestr in
(
if btn == 1 && !mestr.EDM_iLinkMode && !mboxstr.EDB_bHasMoved && ((sizelist ctrlstr.EDC_modulesEditor.EDM_selectedBox) > 1) && (mboxstr.EDB_iKeybState != 2) then
(
chkCtrlModuleEditorRoundLink ctrlstr nil 0 0;
chkCtrlModuleEditorBox ctrlstr mboxstr 0 1;
0;
)
else nil;
set mboxstr.EDB_iKeybState = 0;
_CBcontainerCursorMove mestr.EDM_cont nil nil;
if (!mboxstr.EDB_bHasMoved) then nil else
paintEdCtrlModuleEditor ctrlstr;
);
0;;
fun cbEdCtrlModuleEditorBoxMoveIn(cmpbmp, p, x, y, mask)=
let p -> [ctrlstr mboxstr] in
let ctrlstr.EDC_modulesEditor -> mestr in
if (G2DisInList ctrlstr.EDC_modulesEditor.EDM_selectedBox mboxstr) || (!mestr.EDM_bLinksFilter) then nil else
(
let ctrlstr.EDC_modulesEditor.EDM_abmpLinks -> alphaBmp in
let _GETalphaBitmaps alphaBmp -> [buffer _] in
let _GETalphaBitmapTransparency alphaBmp -> transparency in
(
let sizelist mestr.EDM_lLinks -> size in
let 0 -> i in
while i < size do
(
let nth_list mestr.EDM_lLinks i -> linkstr in
if (isLinkSelectedInRoundLink ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink linkstr) ||
(G2DisInList ctrlstr.EDC_modulesEditor.EDM_selectedBox linkstr.EDL_srcModuleBox) ||
(G2DisInList ctrlstr.EDC_modulesEditor.EDM_selectedBox linkstr.EDL_dstModuleBox) ||
((mboxstr != linkstr.EDL_srcModuleBox) && (mboxstr != linkstr.EDL_dstModuleBox))
then nil else
(
let _GETobjNodePositionSizeInContainerRef linkstr.EDL_srcModuleBox.EDB_node -> [x1 y1 w1 h1] in
let _GETobjNodePositionSizeInContainerRef linkstr.EDL_dstModuleBox.EDB_node -> [x2 y2 w2 h2] in
let if linkstr.EDL_srcModuleBox == linkstr.EDL_dstModuleBox then
[x1 y1 x2 y2]
else
calcEdCtrlModuleEditorLink x1 y1 w1 h1 x2 y2 w2 h2
-> [px1 py1 px2 py2] in
(
if (ctrlstr.EDC_modulesEditor.EDM_bLinksCurved) then
drawEdCtrlModuleEditorLinkCurvedPrivate buffer px1 py1 px2 py2 ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth ctrlstr.EDC_theme.EDT_iModuleEditorLinkOff
else
drawEdCtrlModuleEditorLinkPrivate buffer px1 py1 px2 py2 ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth ctrlstr.EDC_theme.EDT_iModuleEditorLinkOff;
let linkstr.EDL_rLink -> rlinkstr in
_CHANGEobjNodeFlags rlinkstr.EDRL_node OBJ_DISABLE|OBJ_VISIBLE 0;
);
);
set i = i + 1;
);
);
updateEdCtrlModuleEditorRoundLinkPos ctrlstr;
paintEdCtrlModuleEditorNoUpdate ctrlstr;
);
0;;
fun cbEdCtrlModuleEditorBoxMoveOut(cmpbmp, p, x, y, mask)=
let p -> [ctrlstr mboxstr] in
let ctrlstr.EDC_modulesEditor -> mestr in
if (!mestr.EDM_bLinksFilter) then nil else
(
paintEdCtrlModuleEditor ctrlstr;
);
0;;
fun setEdCtrlModuleEditorBoxPos(ctrlstr, mboxstr, mx, my)=
let ctrlstr.EDC_modulesEditor -> mestr in
let getEdCtrlModuleEditorBoxOptimizedPos mestr mboxstr mx my -> [mx my] in
let ftoi ((itof mestr.EDM_iSnap) *. mestr.EDM_fScale) -> snap in
let mx * snap -> cx in
let my * snap -> cy in
let [(cx - (mod cx snap)) (cy - (mod cy snap))] -> [nx ny] in
(
_CHANGEobjNodeCoordinates mboxstr.EDB_node [nx ny] 0;
set mboxstr.EDB_pos = [mx my];
paintEdCtrlModuleEditor ctrlstr;
);
0;;
fun selectEdCtrlModuleEditorBoxes(ctrlstr)=
let ctrlstr.EDC_modulesEditor -> mestr in
(
let sizelist mestr.EDM_lBox -> size in
let 0 -> i in
while i < size do
(
let nth_list mestr.EDM_lBox i -> [_ mboxstr] in
if mboxstr.EDB_bState then nil else
chkCtrlModuleEditorBox ctrlstr mboxstr 1 0;
set i = i + 1;
);
let sizelist mestr.EDM_lRoundLinks -> size in
let 0 -> i in
while i < size do
(
let nth_list mestr.EDM_lRoundLinks i -> rlinkstr in
if rlinkstr.EDRL_bState then nil else
chkCtrlModuleEditorRoundLink ctrlstr rlinkstr 1 0;
set i = i + 1;
);
);
paintEdCtrlModuleEditor ctrlstr;
0;;
fun cbEdCtrlModuleEditorBoxResize(cbmp, p, w, h, oldval)=
let oldval -> [ox oy ow oh] in
let p -> [ctrlstr mboxstr] in
let if mboxstr.EDB_bState then mboxstr.EDB_bmpOn else mboxstr.EDB_bmpOff -> bmp in
let _GETbitmapSize bmp -> [bw bh] in
let _CRbitmap _channel w h -> nbuff in
let _BTSCALEbitmap nbuff bmp 1 -> nbuff in
let _CRalphaBitmap ctrlstr.EDC_channel nbuff nil nil nil -> abmp in
(
_DSbitmap nbuff;
_DSalphaBitmap mboxstr.EDB_alphaBmp;
set mboxstr.EDB_alphaBmp = abmp;
[abmp [ox oy w h]];
);;
fun updateCtrlModuleEditorBox(ctrlstr, mboxstr)=
let ctrlstr.EDC_modulesEditor -> mestr in
(
let mboxstr.EDB_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
set mboxstr.EDB_tooltip = nil;
);
_DStoolTip mboxstr.EDB_node;
_DScompBitmap mboxstr.EDB_compBmp;
_DSalphaBitmap mboxstr.EDB_alphaBmp;
_DSbitmap mboxstr.EDB_bmpOn;
_DSbitmap mboxstr.EDB_bmpOff;
let if ((mboxstr.EDB_sDesc == nil) || (!strcmp mboxstr.EDB_sDesc "")) then mboxstr.EDB_sLabel else strcatn mboxstr.EDB_sLabel::"\n"::mboxstr.EDB_sDesc::nil -> label in
let G2DgetStringSize ctrlstr.EDC_theme.EDT_fontModuleEditor label -> [sw sh] in
let [(sw + 10) (sh + 10)] -> [w h] in
let if w < mestr.EDM_iSnap then mestr.EDM_iSnap else if w > mestr.EDM_iSnap then (mestr.EDM_iSnap * ((w / mestr.EDM_iSnap) + 1)) else w -> w in
let if h < mestr.EDM_iSnap then mestr.EDM_iSnap else if h > mestr.EDM_iSnap then (mestr.EDM_iSnap * ((h / mestr.EDM_iSnap) + 1)) else h -> h in
let _BTDRAWrect (_FILLbitmap _CRbitmap ctrlstr.EDC_channel w h (if mboxstr.EDB_bEnable then mboxstr.EDB_iColorOff else ctrlstr.EDC_theme.EDT_iModuleEditorBoxDisableOff)) [0 0 w h] ctrlstr.EDC_theme.EDT_iModuleEditorBoxBorderOff ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth 0 nil -> bmpoff in
let _BTDRAWrect (_FILLbitmap _CRbitmap ctrlstr.EDC_channel w h (if mboxstr.EDB_bEnable then mboxstr.EDB_iColorOn else ctrlstr.EDC_theme.EDT_iModuleEditorBoxDisableOn)) [0 0 w h] ctrlstr.EDC_theme.EDT_iModuleEditorBoxBorderOn ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth 0 nil -> bmpon in
let mboxstr.EDB_pos -> [mx my] in
let ftoi ((itof mestr.EDM_iSnap) *. mestr.EDM_fScale) -> snap in
let [(mx * snap) (my * snap)] -> [px py] in
let [(px - (mod px snap)) (py - (mod py snap))] -> [nx ny] in
(
let if (G2DcolorIsClear mboxstr.EDB_iColorOff) then !ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOff else ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOff -> ocol in
_DRAWrectangleText bmpoff ctrlstr.EDC_theme.EDT_fontModuleEditor 5 ((h - sh) / 2) w - 10 h - 10 ocol TD_CENTER label;
let if (G2DcolorIsClear mboxstr.EDB_iColorOn) then !ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOn else ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOn -> ocol in
_DRAWrectangleText bmpon ctrlstr.EDC_theme.EDT_fontModuleEditor 5 ((h - sh) / 2) w - 10 h - 10 ocol TD_CENTER label;
set mboxstr.EDB_iWidth = w;
set mboxstr.EDB_iHeight = h;
set mboxstr.EDB_bmpOff = bmpoff;
set mboxstr.EDB_bmpOn = bmpon;
set mboxstr.EDB_alphaBmp = _CRalphaBitmap ctrlstr.EDC_channel (if mboxstr.EDB_bState then bmpon else bmpoff) nil nil nil;
set mboxstr.EDB_compBmp = _CRcompBitmap ctrlstr.EDC_channel mestr.EDM_cont mestr.EDM_node [nx ny] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_MOVE mboxstr.EDB_alphaBmp 0 0 w h;
set mboxstr.EDB_node = _CONVERTcompBitmapToObjNode mboxstr.EDB_compBmp;
if mboxstr.EDB_sToolTip == nil then nil else
_CRtoolTip mboxstr.EDB_node 150 mboxstr.EDB_sToolTip @cbEdModuleEditorBoxToolTipShow [ctrlstr mboxstr] @cbEdModuleEditorBoxToolTipHide [ctrlstr mboxstr];
_CBcompBitmapClick mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxClick [ctrlstr mboxstr];
_CBcompBitmapUnClick mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxUnClick [ctrlstr mboxstr];
_CBcompBitmapDblClick mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxDbClick [ctrlstr mboxstr];
_CBcompBitmapCursorMoveIn mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxMoveIn [ctrlstr mboxstr];
_CBcompBitmapCursorMoveOut mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxMoveOut [ctrlstr mboxstr];
_CBcompBitmapResizeResource mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxResize [ctrlstr mboxstr];
if (mestr.EDM_fScale == 1.0) then nil else
(
let ftoi ((itof mboxstr.EDB_iWidth) *. mestr.EDM_fScale) -> w in
let ftoi ((itof mboxstr.EDB_iHeight) *. mestr.EDM_fScale) -> h in
(
_SIZEobjNode mboxstr.EDB_node w h 0;
);
);
);
);
0;;
fun setEdCtrlModuleEditorBoxEnable(ctrlstr, mboxstr, state)=
set mboxstr.EDB_bEnable = state;
updateCtrlModuleEditorBox ctrlstr mboxstr;
0;;
fun setEdCtrlModuleEditorBoxLabel(ctrlstr, mboxstr, label)=
set mboxstr.EDB_sLabel = label;
updateCtrlModuleEditorBox ctrlstr mboxstr;
paintEdCtrlModuleEditor ctrlstr;
0;;
fun setEdCtrlModuleEditorBoxColors(ctrlstr, mboxstr, oncolor, offcolor)=
if ((oncolor == nil) && (offcolor == nil)) then nil else
(
let if oncolor == nil then
G2DaddColor offcolor 0x202020
else
oncolor
-> oncolor in
set mboxstr.EDB_iColorOn = oncolor;
let if offcolor == nil then
G2DsubColor oncolor 0x202020
else
offcolor
-> offcolor in
set mboxstr.EDB_iColorOff = offcolor;
updateCtrlModuleEditorBox ctrlstr mboxstr;
);
0;;
fun setEdCtrlModuleEditorBoxDesc(ctrlstr, mboxstr, desc)=
set mboxstr.EDB_sDesc = desc;
updateCtrlModuleEditorBox ctrlstr mboxstr;
0;;
fun crEdCtrlModuleEditorBox(ctrlstr, name, label, desc, lp, mx, my, icon, mode)=
let ctrlstr.EDC_modulesEditor -> mestr in
let if (mx == nil || mx < 0) then 0 else mx -> mx in
let if (my == nil || my < 0) then 0 else my -> my in
let mkEdModuleBox [mestr nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ctrlstr.EDC_theme.EDT_iModuleEditorBoxOn ctrlstr.EDC_theme.EDT_iModuleEditorBoxOff 0 1] -> mboxstr in
let if ((desc == nil) || (!strcmp desc "")) then label else strcatn label::"\n"::desc::nil -> nlabel in
let G2DgetStringSize ctrlstr.EDC_theme.EDT_fontModuleEditor nlabel -> [sw sh] in
let [(sw + 10) (sh + 10)] -> [w h] in
let if w < mestr.EDM_iSnap then mestr.EDM_iSnap else if w > mestr.EDM_iSnap then (mestr.EDM_iSnap * ((w / mestr.EDM_iSnap) + 1)) else w -> w in
let if h < mestr.EDM_iSnap then mestr.EDM_iSnap else if h > mestr.EDM_iSnap then (mestr.EDM_iSnap * ((h / mestr.EDM_iSnap) + 1)) else h -> h in
let _BTDRAWrect (_FILLbitmap _CRbitmap ctrlstr.EDC_channel w h mboxstr.EDB_iColorOff) [0 0 w h] ctrlstr.EDC_theme.EDT_iModuleEditorBoxBorderOff ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth 0 nil -> bmpoff in
let _BTDRAWrect (_FILLbitmap _CRbitmap ctrlstr.EDC_channel w h mboxstr.EDB_iColorOn) [0 0 w h] ctrlstr.EDC_theme.EDT_iModuleEditorBoxBorderOn ctrlstr.EDC_theme.EDT_iModuleEditorBorderWidth 0 nil -> bmpon in
let ftoi ((itof mestr.EDM_iSnap) *. mestr.EDM_fScale) -> snap in
(
let if (G2DcolorIsClear mboxstr.EDB_iColorOff) then !ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOff else ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOff -> ocol in
_DRAWrectangleText bmpoff ctrlstr.EDC_theme.EDT_fontModuleEditor 5 ((h - sh) / 2) w - 10 h - 10 ocol TD_CENTER nlabel;
let if (G2DcolorIsClear mboxstr.EDB_iColorOn) then !ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOn else ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOn -> ocol in
_DRAWrectangleText bmpon ctrlstr.EDC_theme.EDT_fontModuleEditor 5 ((h - sh) / 2) w - 10 h - 10 ocol TD_CENTER nlabel;
set mboxstr.EDB_bmpOff = bmpoff;
set mboxstr.EDB_bmpOn = bmpon;
set mboxstr.EDB_sName = name;
set mboxstr.EDB_sLabel = label;
set mboxstr.EDB_sDesc = desc;
set mboxstr.EDB_lParams = lp;
set mboxstr.EDB_iWidth = w;
set mboxstr.EDB_iHeight = h;
set mboxstr.EDB_alphaBmp = _CRalphaBitmap ctrlstr.EDC_channel bmpoff nil nil nil;
let if (mode) then [mx my] else getEdCtrlModuleEditorBoxOptimizedPos mestr mboxstr mx my -> [mx my] in
let [(mx * snap) (my * snap)] -> [cx cy] in
let [(cx - (mod cx snap)) (cy - (mod cy snap))] -> [cx cy] in
(
set mboxstr.EDB_pos = [mx my];
set mboxstr.EDB_compBmp = _CRcompBitmap ctrlstr.EDC_channel mestr.EDM_cont mestr.EDM_node [cx cy] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_MOUSEWHEEL|OBJ_CONTAINER_MOVE mboxstr.EDB_alphaBmp 0 0 w h;
set mboxstr.EDB_node = _CONVERTcompBitmapToObjNode mboxstr.EDB_compBmp;
exec mestr.EDM_cbBoxMove with [ctrlstr mboxstr mx my];
);
_CBcompBitmapClick mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxClick [ctrlstr mboxstr];
_CBcompBitmapUnClick mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxUnClick [ctrlstr mboxstr];
_CBcompBitmapDblClick mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxDbClick [ctrlstr mboxstr];
_CBcompBitmapCursorMoveIn mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxMoveIn [ctrlstr mboxstr];
_CBcompBitmapCursorMoveOut mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxMoveOut [ctrlstr mboxstr];
_CBcompBitmapResizeResource mboxstr.EDB_compBmp @cbEdCtrlModuleEditorBoxResize [ctrlstr mboxstr];
if (mestr.EDM_fScale == 1.0) then nil else
(
let ftoi ((itof mboxstr.EDB_iWidth) *. mestr.EDM_fScale) -> w in
let ftoi ((itof mboxstr.EDB_iHeight) *. mestr.EDM_fScale) -> h in
(
_SIZEobjNode mboxstr.EDB_node w h 0;
);
);
// too slow
//_PAINTcontainer mestr.EDM_cont;
set mestr.EDM_lBox = [name mboxstr]::mestr.EDM_lBox;
mboxstr;
);;
fun getEdCtrlModuleEditorBoxByName(ctrlstr, name)= switchstr ctrlstr.EDC_modulesEditor.EDM_lBox name;;
fun getEdCtrlModuleEditorRoundLinksByBox(ctrlstr, boxstr)=
let nil -> lrlinks in
(
let sizelist ctrlstr.EDC_modulesEditor.EDM_lRoundLinks -> size in
let 0 -> i in
while (i < size) do
(
let nth_list ctrlstr.EDC_modulesEditor.EDM_lRoundLinks i -> rlinkstr in
if ((rlinkstr.EDRL_srcModuleBox != boxstr) && (rlinkstr.EDRL_dstModuleBox != boxstr)) then nil else
set lrlinks = rlinkstr::lrlinks;
set i = i + 1;
);
lrlinks;
);;
fun getEdCtrlModuleEditorSelectedBox(ctrlstr)= ctrlstr.EDC_modulesEditor.EDM_selectedBox;;
fun getEdCtrlModuleEditorSelectedRoundLink(ctrlstr)= ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink;;
fun dsEdCtrlModuleEditorBox(ctrlstr, mboxstr)=
let ctrlstr.EDC_modulesEditor.EDM_lRoundLinks -> l in
let sizelist l -> size in
let 0 -> i in
while i < size do
(
let nth_list l i -> rlinkstr in
if (rlinkstr.EDRL_srcModuleBox != mboxstr) && (rlinkstr.EDRL_dstModuleBox != mboxstr) then nil else
dsEdCtrlModuleEditorRoundLink ctrlstr rlinkstr;
set i = i + 1;
);
let ctrlstr.EDC_modulesEditor.EDM_lLinks -> l in
let sizelist l -> size in
let 0 -> i in
while i < size do
(
let nth_list l i -> linkstr in
if (linkstr.EDL_srcModuleBox != mboxstr) && (linkstr.EDL_dstModuleBox != mboxstr) then nil else
dsEdCtrlModuleEditorLink ctrlstr linkstr 0;
set i = i + 1;
);
set ctrlstr.EDC_modulesEditor.EDM_selectedBox = G2DremoveFromList ctrlstr.EDC_modulesEditor.EDM_selectedBox mboxstr;
let mboxstr.EDB_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
_DStoolTip mboxstr.EDB_node;
set mboxstr.EDB_tooltip = nil;
);
_DScompBitmap mboxstr.EDB_compBmp;
_DSalphaBitmap mboxstr.EDB_alphaBmp;
_DSbitmap mboxstr.EDB_bmpOn;
_DSbitmap mboxstr.EDB_bmpOff;
set ctrlstr.EDC_modulesEditor.EDM_lBox = G2DremoveEdSidFromList ctrlstr.EDC_modulesEditor.EDM_lBox mboxstr.EDB_sName;
//paintEdCtrlModuleEditor ctrlstr;
//_PAINTcontainer ctrlstr.EDC_modulesEditor.EDM_cont;
0;;
fun setEdCtrlModuleEditorLinkMode(ctrlstr, mode)=
set ctrlstr.EDC_modulesEditor.EDM_iLinkMode = mode;
if mode then
(
_CBcontainerPostRender ctrlstr.EDC_modulesEditor.EDM_cont @setEdCtrlModuleEditorMouseLink ctrlstr;
0;
)
else
(
_CBcontainerPostRender ctrlstr.EDC_modulesEditor.EDM_cont nil nil;
paintEdCtrlModuleEditor ctrlstr;
0;
);
0;;
fun getEdCtrlModuleEditorLinkMode(ctrlstr)= ctrlstr.EDC_modulesEditor.EDM_iLinkMode;;
fun setEdCtrlModuleEditorLinkFilter(ctrlstr, state)=
set ctrlstr.EDC_modulesEditor.EDM_bLinksFilter = state;
paintEdCtrlModuleEditor ctrlstr;
0;;
fun getEdCtrlModuleEditorLinkFilter(ctrlstr)= ctrlstr.EDC_modulesEditor.EDM_bLinksFilter;;
fun setEdCtrlModuleEditorSortMenus(ctrlstr, state)=
set ctrlstr.EDC_modulesEditor.EDM_bSortMenus = state;
paintEdCtrlModuleEditor ctrlstr;
0;;
fun getEdCtrlModuleEditorSortMenus(ctrlstr)= ctrlstr.EDC_modulesEditor.EDM_bSortMenus;;
fun setEdCtrlModuleEditorLinkStyle(ctrlstr, state)=
set ctrlstr.EDC_modulesEditor.EDM_bLinksCurved = state;
paintEdCtrlModuleEditor ctrlstr;
0;;
fun getEdCtrlModuleEditorLinkStyle(ctrlstr)= ctrlstr.EDC_modulesEditor.EDM_bLinksCurved;;
fun setEdCtrlModuleEditorInfo(ctrlstr, value)=
setEdCtrlColorLabelValue ctrlstr.EDC_modulesEditor.EDM_info value;
0;;
fun setEdCtrlModuleEditorInfoVisible(ctrlstr, state)=
setEdCtrlVisible ctrlstr.EDC_modulesEditor.EDM_info state;
0;;
fun resetEdCtrlModuleEditor(ctrlstr)=
set ctrlstr.EDC_modulesEditor.EDM_selectedBox = nil;
set ctrlstr.EDC_modulesEditor.EDM_lastSelectedBox = nil;
let ctrlstr.EDC_modulesEditor -> mestr in
(
let sizelist mestr.EDM_lBox -> size in
let 0 -> i in
while i < size do
(
let nth_list mestr.EDM_lBox i -> [_ mboxstr] in
let mboxstr.EDB_tooltip -> [tpcont tptext] in
(
_DScompText tptext;
_DScontainer tpcont;
_DStoolTip mboxstr.EDB_node;
set mboxstr.EDB_tooltip = nil;
_DScompBitmap mboxstr.EDB_compBmp;
_DSalphaBitmap mboxstr.EDB_alphaBmp;
_DSbitmap mboxstr.EDB_bmpOn;
_DSbitmap mboxstr.EDB_bmpOff;
);
set i = i + 1;
);
set mestr.EDM_lBox = nil;
let mestr.EDM_lRoundLinks -> l in
let sizelist l -> size in
let 0 -> i in
while i < size do
(
let nth_list l i -> rlinkstr in
dsEdCtrlModuleEditorRoundLink ctrlstr rlinkstr;
set i = i + 1;
);
set mestr.EDM_lLinks = nil;
//reset position
let _GETwindowPositionSize mestr.EDM_winScroll.EDW_win -> [_ _ ww wh] in
setEdWindowSize mestr.EDM_winDmi ww - 1 wh - 1;
//reset scale
set mestr.EDM_fScale = 1.0;
set mestr.EDM_bmpBack.EDC_fParam = 1.0;
setEdCtrlVisible mestr.EDM_info 0;
paintEdCtrlModuleEditor ctrlstr;
);
0;;
fun setEdCtrlModuleEditorCbBoxMenu(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbBoxMenu = cbfun;
0;;
fun setEdCtrlModuleEditorCbBoxSelect(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbBoxSelect = cbfun;
0;;
fun setEdCtrlModuleEditorCbBoxClick(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbBoxClick = cbfun;
0;;
fun setEdCtrlModuleEditorCbBoxUnClick(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbBoxUnClick = cbfun;
0;;
fun setEdCtrlModuleEditorCbBoxDbClick(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbBoxDbClick = cbfun;
0;;
fun setEdCtrlModuleEditorCbBoxMove(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbBoxMove = cbfun;
0;;
fun setEdCtrlModuleEditorCbSeletedBoxMoving(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbSelectedBoxMoving = cbfun;
0;;
fun setEdCtrlModuleEditorCbClick(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbClick = cbfun;
0;;
fun setEdCtrlModuleEditorCbUnClick(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbUnClick = cbfun;
0;;
fun setEdCtrlModuleEditorCbDbClick(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbDbClick = cbfun;
0;;
fun setEdCtrlModuleEditorCbKeyDown(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbKeyDown = cbfun;
0;;
fun setEdCtrlModuleEditorCbKeyUp(ctrlstr, cbfun)=
set ctrlstr.EDC_modulesEditor.EDM_cbKeyUp = cbfun;
0;;
fun cbEdCtrlModuleEditorSize(winstr, w, h, ctrlstr)=
paintEdCtrlModuleEditor ctrlstr;
0;;
fun cbEdCtrlModuleEditorScroll(winstr, x, y, ctrlstr)=
paintEdCtrlModuleEditorNoResize ctrlstr;
0;;
fun cbEdCtrlModuleEditorLinkResizeResources(cmpbmp, ctrlstr, w, h, oldval)=
let ctrlstr.EDC_modulesEditor -> mestr in
let oldval -> [ox oy ow oh] in
let _CRbitmap ctrlstr.EDC_channel w h -> bmp in
let _CRalphaBitmap ctrlstr.EDC_channel bmp nil 0x000000 0x000000 -> abmp in
(
_DSbitmap bmp;
_DSalphaBitmap mestr.EDM_abmpLinks;
set mestr.EDM_abmpLinks = abmp;
[abmp [ox oy w h]]
);;
fun crEdCtrlModuleEditor(winstr, surfw, surfh, snap, mode, linksfilter, themestr)=
let if themestr == nil then (if EdDefaultTheme == nil then (set EdDefaultTheme = makeEdThemeResources winstr.EDW_channel) else EdDefaultTheme) else themestr -> themestr in
let getEdWindowSize winstr -> [w h] in
let mkEdControl [winstr.EDW_channel winstr nil themestr nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> ctrlstr in
let if ctrlstr.EDC_father.EDW_virtualWin == nil then ctrlstr.EDC_father.EDW_win else ctrlstr.EDC_father.EDW_virtualWin -> father in
let crEdScrollWindow ctrlstr.EDC_channel winstr 0 0 w h WN_CHILDINSIDE|WN_VSCROLL|WN_HSCROLL EDWIN_RESIZE_MW|EDWIN_RESIZE_MH nil "" -> scrollwinstr in
let crEdWindow ctrlstr.EDC_channel scrollwinstr 0 0 w h WN_NOBORDER|WN_CHILDINSIDE nil nil "" -> windmistr in
let crEdCtrlGrid windmistr 0 0 w h themestr.EDT_iModuleEditorBg themestr.EDT_iModuleEditorDot snap /*EDWIN_RESIZE_MW|EDWIN_RESIZE_MH*/ nil -> ctrlbmp in
let ctrlbmp.EDC_bitmap -> [cont _ bgcomp _ _ _ _ _ _] in
let _CRbitmap ctrlstr.EDC_channel w h -> bmpLinks in
let _CRalphaBitmap ctrlstr.EDC_channel bmpLinks nil 0x000000 0x000000 -> abmplinks in
let _CRcompBitmap ctrlstr.EDC_channel cont (_CONVERTcompBitmapToObjNode bgcomp) [0 0] OBJ_VISIBLE|OBJ_ENABLE|OBJ_MW_FLEX|OBJ_MH_FLEX OBJ_CONTAINER_CLICK|OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_MOVE|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_DBLCLICK abmplinks 0 0 w h -> cmplinks in
let _CRbitmap ctrlstr.EDC_channel 1 1 -> bmpLayer in
let _CRalphaBitmap ctrlstr.EDC_channel bmpLayer nil 0x000000 0x000000 -> abmplayer in
let _CRcompBitmap ctrlstr.EDC_channel cont nil [0 0] OBJ_VISIBLE|OBJ_ENABLE OBJ_CONTAINER_CLICK|OBJ_CONTAINER_UNCLICK|OBJ_CONTAINER_MOVE|OBJ_CONTAINER_KEYDOWN|OBJ_CONTAINER_KEYUP|OBJ_CONTAINER_DBLCLICK abmplayer 0 0 1 1 -> cmplayer in
let mkEdModuleEditor [ctrlstr.EDC_channel nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil] -> mestr in
(
_DSbitmap bmpLinks;
_DSbitmap bmpLayer;
setEdwindowCbSize scrollwinstr mkfun4 @cbEdCtrlModuleEditorSize ctrlstr;
setEdwindowCbVirtualMove scrollwinstr mkfun4 @cbEdCtrlModuleEditorScroll ctrlstr;
set mestr.EDM_info = crEdCtrlColorLabelExt scrollwinstr (w - 200) 0 200 100 [5 5] "" CT_CENTER|CT_WORDWRAP EDWIN_RESIZE_RH|EDWIN_RESIZE_LW themestr.EDT_iMainBackgroundColor themestr;
setEdCtrlVisible mestr.EDM_info 0;
set mestr.EDM_fScale = 1.0;
set mestr.EDM_winScroll = scrollwinstr;
set mestr.EDM_winDmi = windmistr;
set mestr.EDM_bmpBack = ctrlbmp;
set mestr.EDM_abmpLayer = abmplayer;
set mestr.EDM_cbmpLayer = cmplayer;
set mestr.EDM_abmpLinks = abmplinks;
set mestr.EDM_cbmpLinks = _CBcompBitmapResizeResource cmplinks @cbEdCtrlModuleEditorLinkResizeResources ctrlstr;
set mestr.EDM_sizeSurface = [surfw surfh];
set mestr.EDM_bSortMenus = 1;
set mestr.EDM_iLinkMode = 0;
set mestr.EDM_bLinksFilter = linksfilter;
set mestr.EDM_bBoxClicked = 0;
set mestr.EDM_bLinkClicked = 0;
set mestr.EDM_iBoxMode = mode;
set mestr.EDM_bLinksCurved = 0;
set mestr.EDM_node = _CONVERTcompBitmapToObjNode cmplayer;
set mestr.EDM_cont = cont;
set mestr.EDM_iSnap = snap;
_CBcontainerMouseWheel mestr.EDM_cont @cbEdCtrlModuleEditorWheel ctrlstr;
_CBcontainerCursorMove mestr.EDM_cont @cbCtrlModuleEditorCursorMove ctrlstr;
_CBcontainerClick mestr.EDM_cont @cbCtrlModuleEditorClick ctrlstr;
_CBcontainerDblClick mestr.EDM_cont @cbCtrlModuleEditorDbClick ctrlstr;
_CBcontainerUnClick mestr.EDM_cont @cbCtrlModuleEditorUnClick ctrlstr;
_CBcontainerKeyDown mestr.EDM_cont @cbCtrlModuleEditorKeyDown ctrlstr;
_CBcontainerKeyUp mestr.EDM_cont @cbCtrlModuleEditorKeyUp ctrlstr;
set ctrlstr.EDC_modulesEditor = mestr;
set winstr.EDW_lControl = ctrlstr::winstr.EDW_lControl;
let _GETwindowPositionSize father -> [_ _ fw fh] in
set ctrlstr.EDC_coords = [0 0 (fw-w) (fh-h) w h];
ctrlstr;
);;
fun dsEdCtrlModuleEditor(ctrlstr)=
resetEdCtrlModuleEditor ctrlstr;
let ctrlstr.EDC_modulesEditor -> mestr in
(
dsEdWindow mestr.EDM_winScroll;
dsEdWindow mestr.EDM_winDmi;
_DScompBitmap mestr.EDM_cbmpLinks;
_DSalphaBitmap mestr.EDM_abmpLinks;
_DScompBitmap mestr.EDM_cbmpLayer;
_DSalphaBitmap mestr.EDM_abmpLayer;
dsEdCtrlBitmap mestr.EDM_bmpBack;
);
set ctrlstr.EDC_father.EDW_lControl = G2DremoveFromList ctrlstr.EDC_father.EDW_lControl ctrlstr;
0;;
/* ********************************************************************************************* /
Controls common
/ ********************************************************************************************* */
fun dsEdWindowCtrlList(lctrl)=
let sizelist lctrl -> size in
let 0 -> i in
while i < size do
(
let nth_list lctrl i -> ctrl in
(
if ctrl.EDC_label == nil then nil else
dsEdCtrlLabel ctrl;
if ctrl.EDC_colorLabel == nil then nil else
dsEdCtrlColorLabel ctrl;
if ctrl.EDC_text == nil then nil else
dsEdCtrlText ctrl;
if ctrl.EDC_editText == nil then nil else
dsEdCtrlEditText ctrl;
if ctrl.EDC_editLine == nil then nil else
dsEdCtrlTextLine ctrl;
if ctrl.EDC_editFloat == nil then nil else
dsEdCtrlFloat ctrl;
if ctrl.EDC_editDate == nil then nil else
dsEdCtrlDate ctrl;
if ctrl.EDC_button == nil then nil else
dsEdCtrlButton ctrl;
if ctrl.EDC_colorButton == nil then nil else
dsEdCtrlColorButton ctrl;
if ctrl.EDC_check == nil then nil else
dsEdCtrlCheck ctrl;
if ctrl.EDC_list == nil then nil else
dsEdCtrlList ctrl;
if ctrl.EDC_tree == nil then nil else
dsEdCtrlTree ctrl;
if ctrl.EDC_bitmap == nil then nil else
dsEdCtrlBitmap ctrl;
if ctrl.EDC_select == nil then nil else
dsEdCtrlSelect ctrl;
if ctrl.EDC_bitmapList == nil then nil else
dsEdCtrlBitmapList ctrl;
if ctrl.EDC_view3d == nil then nil else
dsEdCtrl3D ctrl;
if ctrl.EDC_modulesEditor == nil then nil else
dsEdCtrlModuleEditor ctrl;
if ctrl.EDC_slider == nil then nil else
dsEdCtrlSlider ctrl;
if ctrl.EDC_timeLineEditor == nil then nil else
dsEdCtrlTimeLineEditor ctrl;
if ctrl.EDC_toolTip == nil then nil else
dsEdCtrlTooltip ctrl;
);
set i = i + 1;
);
0;;
fun setEdCtrlEnable(ctrlstr, state)=
if ctrlstr.EDC_label != nil then
(
setEdCtrlLabelEnable ctrlstr state;
0;
)
else if ctrlstr.EDC_colorLabel != nil then
(
setEdCtrlColorLabelEnable ctrlstr state;
0;
)
else if ctrlstr.EDC_editText != nil then
(
setEdCtrlEditTextEnable ctrlstr state;
0;
)
else if ctrlstr.EDC_editLine != nil then
(
setEdCtrlTextLineEnable ctrlstr state;
0;
)
else if ctrlstr.EDC_text != nil then
(
setEdCtrlTextEnable ctrlstr state;
0;
)
else if ctrlstr.EDC_button != nil then
(
setEdCtrlButtonEnable ctrlstr state;
0;
)
else if ctrlstr.EDC_check != nil then
(
setEdCtrlCheckEnable ctrlstr state;
0;
)
else if ctrlstr.EDC_list != nil then
(
setEdCtrlListEnable ctrlstr state;
0;
)
else if ctrlstr.EDC_select != nil then
(
setEdCtrlSelectEnable ctrlstr state;
0;
)
else if ctrlstr.EDC_tree != nil then
(
setEdCtrlTreeEnable ctrlstr state;
0;
)
else if ctrlstr.EDC_bitmap != nil then
nil
else if ctrlstr.EDC_bitmapList != nil then
nil
else if ctrlstr.EDC_editFloat != nil then
(
setEdCtrlFloatEnable ctrlstr state;
0;
)
else if ctrlstr.EDC_view3d != nil then
nil
else if ctrlstr.EDC_colorButton != nil then
(
setEdCtrlColorButtonEnable ctrlstr state;
0;
)
else if ctrlstr.EDC_slider != nil then
nil
else if ctrlstr.EDC_timeLineEditor != nil then
nil
else nil;
0;;
fun setEdCtrlVisible(ctrlstr, state)=
if ctrlstr.EDC_label != nil then
(
_SHOWtext ctrlstr.EDC_label (if state then WINDOW_UNHIDDEN else WINDOW_HIDDEN);
0;
)
else if ctrlstr.EDC_colorLabel != nil then
let ctrlstr.EDC_colorLabel -> [cont _] in
(
_SHOWcontainer cont (if state then CONTAINER_UNHIDDEN else CONTAINER_HIDDEN);
0;
)
else if ctrlstr.EDC_editText != nil then
(
_SHOWtext ctrlstr.EDC_editText (if state then WINDOW_UNHIDDEN else WINDOW_HIDDEN);
0;
)
else if ctrlstr.EDC_editLine != nil then
(
_SHOWtext ctrlstr.EDC_editLine (if state then WINDOW_UNHIDDEN else WINDOW_HIDDEN);
0;
)
else if ctrlstr.EDC_text != nil then
(
_SHOWtext ctrlstr.EDC_text (if state then WINDOW_UNHIDDEN else WINDOW_HIDDEN);
0;
)
else if ctrlstr.EDC_button != nil then
let ctrlstr.EDC_button -> [btn _] in
(
_SHOWbutton btn (if state then WINDOW_UNHIDDEN else WINDOW_HIDDEN);
0;
)
else if ctrlstr.EDC_check != nil then
(
_SHOWcheck ctrlstr.EDC_check (if state then WINDOW_UNHIDDEN else WINDOW_HIDDEN);
0;
)
else if ctrlstr.EDC_list != nil then
let ctrlstr.EDC_list -> [list _] in
(
_SHOWlist list (if state then WINDOW_UNHIDDEN else WINDOW_HIDDEN);
0;
)
else if ctrlstr.EDC_select != nil then
(
_SHOWcombo ctrlstr.EDC_select (if state then WINDOW_UNHIDDEN else WINDOW_HIDDEN);
0;
)
else if ctrlstr.EDC_tree != nil then
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
(
// Commented in order not to break the next release, in case macOS do not want to compile. Uncomment at will after the next release.
//_SHOWtree tree (if state then WINDOW_UNHIDDEN else WINDOW_HIDDEN);
0;
)
else if ctrlstr.EDC_bitmap != nil then
let ctrlstr.EDC_bitmap -> [cont _ _ _ _ _ _ _ _] in
(
_SHOWcontainer cont (if state then CONTAINER_UNHIDDEN else CONTAINER_HIDDEN);
0;
)
else if ctrlstr.EDC_bitmapList != nil then
let ctrlstr.EDC_bitmapList -> [cont _ _ _ _ _ _] in
(
_SHOWcontainer cont (if state then CONTAINER_UNHIDDEN else CONTAINER_HIDDEN);
0;
)
else if ctrlstr.EDC_editFloat != nil then
let ctrlstr.EDC_editFloat -> [txt cont _ _ _ _ _ _ _ _ _ _ _ _ _ _] in
(
_SHOWtext txt (if state then WINDOW_UNHIDDEN else WINDOW_HIDDEN);
_SHOWcontainer cont (if state then CONTAINER_UNHIDDEN else CONTAINER_HIDDEN);
0;
)
else if ctrlstr.EDC_view3d != nil then
(
V3DenableView ctrlstr.EDC_view3d state;
0;
)
else if ctrlstr.EDC_colorButton != nil then
let ctrlstr.EDC_colorButton -> [btn _ _ _ _ _] in
(
_SHOWbutton btn (if state then WINDOW_UNHIDDEN else WINDOW_HIDDEN);
0;
)
else if ctrlstr.EDC_slider != nil then
(
_SHOWcontainer ctrlstr.EDC_slider.EDSLIDER_cont (if state then CONTAINER_UNHIDDEN else CONTAINER_HIDDEN);
0;
)
else if ctrlstr.EDC_timeLineEditor != nil then
(
setEdWindowVisible ctrlstr.EDC_timeLineEditor.EDTLE_win state;
0;
)
else if ctrlstr.EDC_toolTip != nil then
(
setEdCtrlTooltipVisible ctrlstr state;
0;
)
else nil;
0;;
fun setEdCtrlPositionSize(ctrlstr, x, y, w, h)=
let getEdWindowSize ctrlstr.EDC_father -> [fw fh] in
// + 1 because of the border size
(
if ctrlstr.EDC_label != nil then
(
_POSITIONtext ctrlstr.EDC_label x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_colorLabel != nil then
let ctrlstr.EDC_colorLabel -> [cont cmptext] in
(
_SIZEcontainer cont x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_editText != nil then
(
_POSITIONtext ctrlstr.EDC_editText x y w+1 h+1;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_editLine != nil then
(
_POSITIONtext ctrlstr.EDC_editLine x y w+1 h+1;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_text != nil then
(
_POSITIONtext ctrlstr.EDC_text x y w+1 h+1;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_button != nil then
(
let ctrlstr.EDC_button -> [btn _] in
_POSITIONbutton btn x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_check != nil then
(
_POSITIONcheck ctrlstr.EDC_check x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_list != nil then
let ctrlstr.EDC_list -> [list lp] in
(
_POSITIONlist list x y w+1 h+1;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_select != nil then
(
_POSITIONcombo ctrlstr.EDC_select x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_tree != nil then
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
(
_POSITIONtree tree x y w+1 h+1;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_bitmap != nil then
let ctrlstr.EDC_bitmap -> [cont alphabmp ocbmp _ _ _ _ _ _] in
(
_SIZEcontainer cont x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_bitmapList != nil then
let ctrlstr.EDC_bitmapList -> [cont _ _ _ _ _ _] in
(
_SIZEcontainer cont x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_editFloat != nil then
let ctrlstr.EDC_editFloat -> [txt cont _ _ _ _ _ _ _ _ _ _ _ _ _ _] in
let _GETcontainerExPositionSize cont -> [_ _ bw bh] in
(
_POSITIONtext txt x y ((w - bw) + 1) (h + 1);
_MOVEcontainer cont (x + (w - bw)) y;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_view3d != nil then
(
V3DresizeView ctrlstr.EDC_view3d x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_colorButton != nil then
let ctrlstr.EDC_colorButton -> [btn obmp winstr color mode cbfun] in
(
let if (mode != 1) then color else G2Dbgra2bgr (G2Drgba2bgra color) -> bgrcolor in
let _FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgrcolor -> bmp in
(
_DSbitmap obmp;
_POSITIONbutton btn x y w h;
_SETbuttonBitmap btn bmp;
mutate ctrlstr.EDC_colorButton <- [_ bmp _ color _ _];
_PAINTbutton btn;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
);
0;
)
else if ctrlstr.EDC_slider != nil then
(
_SIZEcontainer ctrlstr.EDC_slider.EDSLIDER_cont x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_timeLineEditor != nil then
(
setEdWindowPosSizeEx ctrlstr.EDC_timeLineEditor.EDTLE_win x y w h-28;
set ctrlstr.EDC_timeLineEditor.EDTLE_statusBar.ETB_pos = [ctrlstr.EDC_timeLineEditor.EDTLE_iLeftStatus h-28];
sizeEdToolBar ctrlstr.EDC_timeLineEditor.EDTLE_statusBar ctrlstr.EDC_timeLineEditor.EDTLE_iLeftStatus h-28 w-ctrlstr.EDC_timeLineEditor.EDTLE_iLeftStatus 28;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else nil;
);
0;;
fun setEdCtrlSize(ctrlstr, w, h)=
let getEdWindowSize ctrlstr.EDC_father -> [fw fh] in
// + 1 because of the border size
(
if ctrlstr.EDC_label != nil then
let _GETtextPositionSize ctrlstr.EDC_label -> [x y _ _] in
(
_POSITIONtext ctrlstr.EDC_label x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_colorLabel != nil then
let ctrlstr.EDC_colorLabel -> [cont cmptext] in
let _GETcontainerPositionSize cont -> [x y _ _] in
(
_SIZEcontainer cont x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_editText != nil then
let _GETtextPositionSize ctrlstr.EDC_editText -> [x y _ _] in
(
_POSITIONtext ctrlstr.EDC_editText x y w+1 h+1;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_editLine != nil then
let _GETtextPositionSize ctrlstr.EDC_editLine -> [x y _ _] in
(
_POSITIONtext ctrlstr.EDC_editLine x y w+1 h+1;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_text != nil then
let _GETtextPositionSize ctrlstr.EDC_text -> [x y _ _] in
(
_POSITIONtext ctrlstr.EDC_text x y w+1 h+1;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_button != nil then
let ctrlstr.EDC_button -> [btn _] in
let _GETbuttonPositionSize btn -> [x y _ _] in
(
_POSITIONbutton btn x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_check != nil then
let _GETcheckPositionSize ctrlstr.EDC_check -> [x y _ _] in
(
_POSITIONcheck ctrlstr.EDC_check x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_list != nil then
let ctrlstr.EDC_list -> [list lp] in
let _GETlistPositionSize list -> [x y _ _] in
(
_POSITIONlist list x y w+1 h+1;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_select != nil then
let _GETcomboPositionSize ctrlstr.EDC_select -> [x y _ _] in
(
_POSITIONcombo ctrlstr.EDC_select x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_tree != nil then
let ctrlstr.EDC_tree -> [tree _ _ _ _] in
let _GETtreePositionSize tree -> [x y _ _] in
(
_POSITIONtree tree x y w+1 h+1;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_bitmap != nil then
let ctrlstr.EDC_bitmap -> [cont alphabmp ocbmp _ _ _ _ _ _] in
let _GETcontainerPositionSize cont -> [x y _ _] in
(
_SIZEcontainer cont x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_bitmapList != nil then
let ctrlstr.EDC_bitmapList -> [cont _ _ _ _ _ _] in
let _GETcontainerPositionSize cont -> [x y _ _] in
(
_SIZEcontainer cont x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_editFloat != nil then
let ctrlstr.EDC_editFloat -> [txt cont _ _ _ _ _ _ _ _ _ _ _ _ _ _] in
let _GETcontainerExPositionSize cont -> [_ _ bw bh] in
let _GETtextPositionSize txt -> [x y _ _] in
(
_POSITIONtext txt x y ((w - bw) + 1) (h + 1);
_MOVEcontainer cont (x + (w - bw)) y;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_view3d != nil then
let V3DgetViewPos ctrlstr.EDC_view3d -> [x y] in
(
V3DresizeView ctrlstr.EDC_view3d x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_colorButton != nil then
let ctrlstr.EDC_colorButton -> [btn obmp winstr color mode cbfun] in
let _GETbuttonPositionSize btn -> [x y _ _] in
(
let if (mode != 1) then color else G2Dbgra2bgr (G2Drgba2bgra color) -> bgrcolor in
let _FILLbitmap _CRbitmap ctrlstr.EDC_channel w h bgrcolor -> bmp in
(
_DSbitmap obmp;
_POSITIONbutton btn x y w h;
_SETbuttonBitmap btn bmp;
mutate ctrlstr.EDC_colorButton <- [_ bmp _ color _ _];
_PAINTbutton btn;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
);
0;
)
else if ctrlstr.EDC_slider != nil then
let _GETcontainerPositionSize ctrlstr.EDC_slider.EDSLIDER_cont -> [x y _ _] in
(
_SIZEcontainer ctrlstr.EDC_slider.EDSLIDER_cont x y w h;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else if ctrlstr.EDC_timeLineEditor != nil then
let getEdWindowPosSize ctrlstr.EDC_timeLineEditor.EDTLE_win -> [x y _ _] in
(
setEdWindowPosSizeEx ctrlstr.EDC_timeLineEditor.EDTLE_win x y w h-28;
set ctrlstr.EDC_timeLineEditor.EDTLE_statusBar.ETB_pos = [ctrlstr.EDC_timeLineEditor.EDTLE_iLeftStatus h-28];
sizeEdToolBar ctrlstr.EDC_timeLineEditor.EDTLE_statusBar ctrlstr.EDC_timeLineEditor.EDTLE_iLeftStatus h-28 w-ctrlstr.EDC_timeLineEditor.EDTLE_iLeftStatus 28;
mutate ctrlstr.EDC_coords <- [x y (fw-(x + w)) (fh-(y+h)) w h];
0;
)
else nil;
);
0;;
/* ********************************************************************************************* /
File dialog
/ ********************************************************************************************* */
//TODO Doxygen Doc
fun cbEdOpenFileDialog(ctrlstr, fdialogstr)=
let nil -> lpfiles in
(
if (!fdialogstr.EDFD_bSave) then
(
if (fdialogstr.EDFD_iFlags & EDFILE_DIALOG_MULTI) then
(
let getMultiSelectedEdCtrlList fdialogstr.EDFD_fileList -> lsel in
while (lsel != nil) do
(
let hd lsel -> [_ lp _] in
let _checkpack hd lp -> pfile in
if (pfile == nil) then nil else
set lpfiles = pfile::lpfiles;
set lsel = tl lsel;
);
0;
)
else
(
let getSelectedEdCtrlList fdialogstr.EDFD_fileList -> [_ lp _] in
let _checkpack hd lp -> pfile in
set lpfiles = pfile::lpfiles;
0;
);
dsEdWindow fdialogstr.EDFD_dialog;
set fdialogstr.EDFD_dialog = nil;
if (fdialogstr.EDFD_iFlags & EDFILE_DIALOG_MULTI) then
(
exec fdialogstr.EDFD_cbMulti with [(revertlist lpfiles)];
0;
)
else
(
exec fdialogstr.EDFD_cbFile with [(hd lpfiles)];
0;
);
)
else
(
let getEdCtrlTreeSelectedItem fdialogstr.EDFD_dirTree -> delem in
let getEdCtrlTextLineValue fdialogstr.EDFD_fileName -> fname in
if (!strcmp strtrim fname "") then nil else
let delem.EDTITEM_sValue -> path in
let if ((path == nil) || (!strcmp path "") || (!strcmp path "/")) then fname else strcatn path::"/"::fname::nil -> fpath in
(
dsEdWindow fdialogstr.EDFD_dialog;
set fdialogstr.EDFD_dialog = nil;
exec fdialogstr.EDFD_cbSave with [(_getmodifypack fpath)];
);
0;
);
);
0;;
fun cbEdCancelFileDialog(ctrlstr, fdialogstr)=
dsEdWindow fdialogstr.EDFD_dialog;
set fdialogstr.EDFD_dialog = nil;
if (!fdialogstr.EDFD_bSave) then
(
if (fdialogstr.EDFD_iFlags & EDFILE_DIALOG_MULTI) then
(
exec fdialogstr.EDFD_cbMulti with [nil];
0;
)
else
(
exec fdialogstr.EDFD_cbFile with [nil];
0;
);
)
else
(
exec fdialogstr.EDFD_cbSave with [nil];
0;
);
0;;
fun setEdOpenFileDialogCb(fdialogstr, cbfun)=
set fdialogstr.EDFD_cbFile = cbfun;
0;;
fun setEdOpenFileDialogCbMulti(fdialogstr, cbfun)=
set fdialogstr.EDFD_cbMulti = cbfun;
0;;
fun setEdSaveFileDialogCb(fdialogstr, cbfun)=
set fdialogstr.EDFD_cbSave = cbfun;
0;;
fun setEdOpenFileDialogInfoCb(fdialogstr, cbfun)=
set fdialogstr.EDFD_cbInfo = cbfun;
0;;
fun setEdOpenFileDialogFilterCb(fdialogstr, cbfun)=
set fdialogstr.EDFD_cbFilter = cbfun;
0;;
fun cbEdFileDialogListSelect(ctrlstr, pos, name, lp, type, fdialogstr)=
if (type != 0) then nil else
(
setEdCtrlButtonEnable fdialogstr.EDFD_openBtn 1;
setEdCtrlTextLineValue fdialogstr.EDFD_fileName name;
if ((fdialogstr.EDFD_iFlags & EDFILE_DIALOG_FILTER_BITMAP) && (fdialogstr.EDFD_iFlags & EDFILE_DIALOG_SHOW_INFOS)) then
(
setEdCtrlBitmap fdialogstr.EDFD_fileInfo hd lp;
0;
)
else if (fdialogstr.EDFD_iFlags & EDFILE_DIALOG_SHOW_INFOS) then
(
let _checkpack hd lp -> pfile in
let exec fdialogstr.EDFD_cbInfo with [pfile] -> info in
setEdCtrlLabelValue fdialogstr.EDFD_fileInfo info;
0;
)
else nil;
);
0;;
fun fillEdFileDialogTreeElems(fdialogstr, path, ldir, pelem, limits, level)=
if (ldir == nil) then nil else
(
let hd ldir -> dpath in
let if (fdialogstr.EDFD_iFlags & EDFILE_DIALOG_SYSTEM_FILES) then 0 else (isStringInListi lEDFILE_DIALOG_SYSTEM_PATHS dpath) -> ignore in
if ignore then nil else
let if (!strcmp (substr dpath 0 1) "/") then substr dpath 1 (strlen dpath) - 1 else dpath -> dpath in
let getlastPathDir dpath -> dir in
let addEdCtrlTreeItem fdialogstr.EDFD_dirTree pelem dir dpath 1 strcat sG2DDEFAULTRESOURCESPATH "folder.png" -> elem in
if ((limits >= 0) && (level >= limits)) then nil else
(
let _listofsubdir2 dpath -> nl in
fillEdFileDialogTreeElems fdialogstr dpath nl elem limits level + 1;
);
fillEdFileDialogTreeElems fdialogstr path (tl ldir) pelem limits level;
);
0;;
fun cbEdFileDialogSelectFolder(ctrlstr, father, item, value, type, fdialogstr)=
resetEdCtrlList fdialogstr.EDFD_fileList;
let getEdCtrlTreeRootItem fdialogstr.EDFD_dirTree -> root in
let getFilesFromDir value fdialogstr.EDFD_lFileExt -> lfiles in
(
if (fdialogstr.EDFD_iFlags & EDFILE_DIALOG_LIST_FOLDERS) then
(
if (root == item) then nil else
addEdCtrlList fdialogstr.EDFD_fileList "[..]" father.EDTITEM_sValue::nil 2;
let _listofsubdir item.EDTITEM_sValue -> ldir in
while (ldir != nil) do
(
let hd ldir -> dpath in
let if (fdialogstr.EDFD_iFlags & EDFILE_DIALOG_SYSTEM_FILES) then 0 else (isStringInListi lEDFILE_DIALOG_SYSTEM_PATHS dpath) -> ignore in
if ignore then nil else
let if (!strcmp (substr dpath 0 1) "/") then substr dpath 1 (strlen dpath) - 1 else dpath -> dpath in
let strcatn "["::(getlastPathDir dpath)::"]"::nil -> dir in
addEdCtrlList fdialogstr.EDFD_fileList dir dpath::nil 1;
set ldir = tl ldir;
);
)
else nil;
while (lfiles != nil) do
(
let hd lfiles -> path in
let getPathFile path "" -> [_ fname] in
let if (!strcmp (substr path 0 1) "/") then substr path 1 (strlen path) - 1 else path -> path in
if (fdialogstr.EDFD_cbFilter == nil) then
(
addEdCtrlList fdialogstr.EDFD_fileList fname path::nil 0;
)
else
(
let _checkpack path -> pfile in
let exec fdialogstr.EDFD_cbFilter with [pfile] -> ret in
if (!ret) then nil else
addEdCtrlList fdialogstr.EDFD_fileList fname path::nil 0;
);
set lfiles = tl lfiles;
);
);
if (fdialogstr.EDFD_bSave) then nil else
(
setEdCtrlButtonEnable fdialogstr.EDFD_openBtn 0;
setEdCtrlTextLineValue fdialogstr.EDFD_fileName "";
);
0;;
fun cbEdFileDialogExpandFolder(ctrlstr, father, item, value, type, state, fdialogstr)=
if (type != 1) || (!state) then nil else
(
let getEdCtrlTreeSonsItem ctrlstr item -> nl in
while (nl != nil) do
(
let hd nl -> sitem in
let _listofsubdir sitem.EDTITEM_sValue -> ldir in
fillEdFileDialogTreeElems fdialogstr sitem.EDTITEM_sValue ldir sitem 0 0;
set nl = tl nl;
);
setEdCtrlTreeType ctrlstr item 2;
);
0;;
fun fillEdFileDialogTree(fdialogstr, base, path)=
let if (fdialogstr.EDFD_iFlags & EDFILE_DIALOG_SYSTEM_FILES) then "/" else base -> base in
let _listofsubdir base -> ldir in
let getlastPathDir base -> basedir in
let getPathFile path "" -> [_ fname] in
let if (!strcmp basedir "") then "/" else basedir -> basedir in
let addEdCtrlTreeItem fdialogstr.EDFD_dirTree nil basedir base 2 strcat sG2DDEFAULTRESOURCESPATH "folder.png" -> elem in
(
fillEdFileDialogTreeElems fdialogstr path ldir elem 1 0;
setEdCtrlTreeExpandItem fdialogstr.EDFD_dirTree elem 1 0;
let strToListSep path "/" -> ldd in
let sizelist ldd -> size in
let 1 -> i in
while (i < size) do
(
let strcatnSepLimits ldd "/" i -> dir in
(
selEdCtrlTreeItemByValue fdialogstr.EDFD_dirTree dir;
let getEdCtrlTreeSelectedItem fdialogstr.EDFD_dirTree -> selem in
cbEdFileDialogExpandFolder fdialogstr.EDFD_dirTree selem.EDTITEM_father selem selem.EDTITEM_sValue selem.EDTITEM_iType 1 fdialogstr;
);
set i = i + 1;
);
selEdCtrlTreeItemByValue fdialogstr.EDFD_dirTree path;
let getEdCtrlTreeSelectedItem fdialogstr.EDFD_dirTree -> selem in
let if (selem == nil) then elem else selem -> elem in
(
let elem -> pelem in
let nil -> rlist in
(
while (pelem != nil) do
(
set rlist = pelem::rlist;
set pelem = pelem.EDTITEM_father;
);
while (rlist != nil) do
(
let hd rlist -> pelem in
cbEdFileDialogExpandFolder fdialogstr.EDFD_dirTree pelem.EDTITEM_father pelem pelem.EDTITEM_sValue pelem.EDTITEM_iType 1 fdialogstr;
set rlist = tl rlist;
);
);
setEdCtrlTreeExpandItem fdialogstr.EDFD_dirTree elem 1 0;
selEdCtrlTreeItem fdialogstr.EDFD_dirTree elem;
cbEdFileDialogSelectFolder fdialogstr.EDFD_dirTree elem.EDTITEM_father elem elem.EDTITEM_sValue elem.EDTITEM_iType fdialogstr;
if (fname == nil) then nil else
(
selectEdCtrlList fdialogstr.EDFD_fileList fname;
let getSelectedEdCtrlListExt fdialogstr.EDFD_fileList -> [pos name lp type] in
cbEdFileDialogListSelect fdialogstr.EDFD_fileList pos name lp type fdialogstr;
);
);
);
0;;
fun cbEdFileDialogFileType(ctrlstr, pos, value, fdialogstr)=
let nth_list fdialogstr.EDFD_lFiletypes pos -> [_ exts] in
set fdialogstr.EDFD_lFileExt = exts;
let getEdCtrlTreeSelectedItem fdialogstr.EDFD_dirTree -> elem in
cbEdFileDialogSelectFolder fdialogstr.EDFD_dirTree elem.EDTITEM_father elem elem.EDTITEM_sValue elem.EDTITEM_iType fdialogstr;
0;;
fun cbEdFileDialogListValidate(ctrlstr, pos, name, lp, type, fdialogstr)=
if (type == 0) then
(
cbEdOpenFileDialog nil fdialogstr;
0;
)
else
let hd lp -> path in
let getEdCtrlTreeItemByValue fdialogstr.EDFD_dirTree path -> elem in
(
setEdCtrlTreeExpandItem fdialogstr.EDFD_dirTree elem 1 0;
selEdCtrlTreeItem fdialogstr.EDFD_dirTree elem;
cbEdFileDialogSelectFolder fdialogstr.EDFD_dirTree elem.EDTITEM_father elem elem.EDTITEM_sValue elem.EDTITEM_iType fdialogstr;
0;
);
0;;
fun cbEdFileDialogListKey(ctrlstr, pos, name, lp, type, key, asc, fdialogstr)=
if (key == 28) then
(
if (type == 0) then
(
cbEdOpenFileDialog nil fdialogstr;
0;
)
else
let hd lp -> path in
let getEdCtrlTreeItemByValue fdialogstr.EDFD_dirTree path -> elem in
(
setEdCtrlTreeExpandItem fdialogstr.EDFD_dirTree elem 1 0;
selEdCtrlTreeItem fdialogstr.EDFD_dirTree elem;
cbEdFileDialogSelectFolder fdialogstr.EDFD_dirTree elem.EDTITEM_father elem elem.EDTITEM_sValue elem.EDTITEM_iType fdialogstr;
0;
);
)
else if key != 1 then nil else
(
dsEdWindow fdialogstr.EDFD_dialog;
set fdialogstr.EDFD_dialog = nil;
if (!fdialogstr.EDFD_bSave) then
(
if (fdialogstr.EDFD_iFlags & EDFILE_DIALOG_MULTI) then
(
exec fdialogstr.EDFD_cbMulti with [nil];
0;
)
else
(
exec fdialogstr.EDFD_cbFile with [nil];
0;
);
)
else
(
exec fdialogstr.EDFD_cbSave with [nil];
0;
);
);
0;;
fun cbEdFileDialogValidate(ctrlstr, value, fdialogstr)=
cbEdOpenFileDialog nil fdialogstr;
0;;
fun cbEdFileDialogDestroy(winstr, fdialogstr)=
if (fdialogstr.EDFD_dialog == nil) then nil else
(
if (!fdialogstr.EDFD_bSave) then
(
if (fdialogstr.EDFD_iFlags & EDFILE_DIALOG_MULTI) then
(
exec fdialogstr.EDFD_cbMulti with [nil];
0;
)
else
(
exec fdialogstr.EDFD_cbFile with [nil];
0;
);
)
else
(
exec fdialogstr.EDFD_cbSave with [nil];
0;
);
);
0;;
fun cbEdFileDialogShowSystem(tbstr, check, btn, mask, state, fdialogstr)=
set fdialogstr.EDFD_iFlags = if (state) then fdialogstr.EDFD_iFlags|EDFILE_DIALOG_SYSTEM_FILES else fdialogstr.EDFD_iFlags & (~EDFILE_DIALOG_SYSTEM_FILES);
resetEdCtrlTree fdialogstr.EDFD_dirTree;
fillEdFileDialogTree fdialogstr fdialogstr.EDFD_sBasePath fdialogstr.EDFD_sPath;
0;;
fun cbEdFileDialogShowFolderList(tbstr, check, btn, mask, state, fdialogstr)=
set fdialogstr.EDFD_iFlags = if (state) then fdialogstr.EDFD_iFlags|EDFILE_DIALOG_LIST_FOLDERS else fdialogstr.EDFD_iFlags & (~EDFILE_DIALOG_LIST_FOLDERS);
let getEdCtrlTreeSelectedItem fdialogstr.EDFD_dirTree -> elem in
cbEdFileDialogSelectFolder fdialogstr.EDFD_dirTree elem.EDTITEM_father elem elem.EDTITEM_sValue elem.EDTITEM_iType fdialogstr;
0;;
fun cbEdFileDialogNewFolderCancel(ctrlstr, winstr)=
dsEdWindow winstr;
0;;
fun cbEdFileDialogNewFolderBtn(ctrlstr, p)=
let p -> [winstr ctrlfolder fdialogstr] in
let strtrim (getEdCtrlTextLineValue ctrlfolder) -> nfolder in
if (!strcmp nfolder "") then nil else
(
let getEdCtrlTreeSelectedItem fdialogstr.EDFD_dirTree -> elem in
let if (!strcmp "/" elem.EDTITEM_sValue) then nfolder else strcatn elem.EDTITEM_sValue::"/"::nfolder::nil -> fpath in
let if ((nth_char fpath 0) == 47) then substr fpath 1 (strlen fpath) - 1 else fpath -> fpath in // remove '/'
(
createFolder fpath;
resetEdCtrlTree fdialogstr.EDFD_dirTree;
fillEdFileDialogTree fdialogstr fdialogstr.EDFD_sBasePath fpath;
);
dsEdWindow winstr;
);
0;;
fun cbEdFileDialogNewFolder(tbstr, tbtn, btn, mask, fdialogstr)=
let getEdWindowPosSize fdialogstr.EDFD_dialog -> [x y w h] in
let [350 100] -> [nw nh] in
let crEdModalDialogWindow fdialogstr.EDFD_dialog.EDW_channel fdialogstr.EDFD_dialog x + ((w - nw) / 2) y + ((h - nh) / 2) nw nh WN_NOSCOL|WN_DIALOG nil (locDef "newFolder" "Create a new folder") -> winstr in
let crEdCtrlLabelEx winstr 10 10 100 20 (locDef "fileName" "File name") ET_ALIGN_LEFT nil -> label in
let crEdCtrlTextLine winstr 120 10 (nw - 130) 20 "" nil nil -> ctrlfolder in
let crEdCtrlButton winstr 10 (nh - 30) 90 20 (locDef "ok" "Ok") nil -> okbtn in
let crEdCtrlButton winstr (nw - 100) (nh - 30) 90 20 (locDef "cancel" "Cancel") nil -> cancelbtn in
(
setEdCtrlButtonCb okbtn mkfun2 @cbEdFileDialogNewFolderBtn [winstr ctrlfolder fdialogstr];
setEdCtrlButtonCb cancelbtn mkfun2 @cbEdFileDialogNewFolderCancel winstr;
);
0;;
fun cbEdFileDialogTreeDelFolder(dlg, p, state)=
let p -> [fdialogstr folder] in
if (!state) then nil else
(
let getEdCtrlTreeSelectedItem fdialogstr.EDFD_dirTree -> elem in
let elem.EDTITEM_father.EDTITEM_sValue -> pfolder in
(
cleanDirectory folder;
resetEdCtrlTree fdialogstr.EDFD_dirTree;
fillEdFileDialogTree fdialogstr fdialogstr.EDFD_sBasePath pfolder;
);
);
0;;
fun cbEdFileDialogTreeKey(ctrlstr, father, item, val, type, key, ascode, fdialogstr)=
if key == 339 then // suppr
(
let getEdCtrlTreeRootItem fdialogstr.EDFD_dirTree -> root in
let getEdCtrlTreeSelectedItem fdialogstr.EDFD_dirTree -> elem in
if (root == elem) then nil else
(
_DLGrflmessage _DLGMessageBox fdialogstr.EDFD_channel fdialogstr.EDFD_dialog.EDW_win (locDef "delFolder" "Delete folder") (locDef "delFolderQ" "Are you sure you want to delete the selected folder?") 1 @cbEdFileDialogTreeDelFolder [fdialogstr elem.EDTITEM_sValue];
);
0;
)
else if key != 1 then nil else
(
dsEdWindow fdialogstr.EDFD_dialog;
set fdialogstr.EDFD_dialog = nil;
if (!fdialogstr.EDFD_bSave) then
(
if (fdialogstr.EDFD_iFlags & EDFILE_DIALOG_MULTI) then
(
exec fdialogstr.EDFD_cbMulti with [nil];
0;
)
else
(
exec fdialogstr.EDFD_cbFile with [nil];
0;
);
)
else
(
exec fdialogstr.EDFD_cbSave with [nil];
0;
);
);
0;;
fun cbEdFileDialogKeyDown(winstr, key, asc, fdialogstr)=
if key != 1 then nil else
(
dsEdWindow fdialogstr.EDFD_dialog;
set fdialogstr.EDFD_dialog = nil;
if (!fdialogstr.EDFD_bSave) then
(
if (fdialogstr.EDFD_iFlags & EDFILE_DIALOG_MULTI) then
(
exec fdialogstr.EDFD_cbMulti with [nil];
0;
)
else
(
exec fdialogstr.EDFD_cbFile with [nil];
0;
);
)
else
(
exec fdialogstr.EDFD_cbSave with [nil];
0;
);
);
0;;
fun crEdFileDialogExt(chan, fatherwin, x, y, ww, hh, title, filetypes, basepath, path, fname, flags, save)=
let if (flags == nil) then 0 else flags -> flags in
let if (path == nil) then "" else path -> path in
let if (!strcmp (substr path (strlen path) - 1 1) "/") then substr path 0 (strlen path) - 1 else path -> path in
let hd filetypes -> [_ lext] in
let 720 -> w in
let 300 -> h in
let if (flags & EDFILE_DIALOG_SHOW_TOOLBAR) then 38 else 10 -> tpos in
let if (ww < w) then w else ww -> ww in
let if (hh < h) then h else hh -> hh in
let if (flags & EDFILE_DIALOG_SHOW_INFOS) then (w - 40) / 3 else (w - 30) / 3 -> wcol in
let if (flags & EDFILE_DIALOG_SHOW_INFOS) then wcol else (wcol * 2) -> listw in
let crEdModalDialogWindow chan fatherwin x y w h WN_NOSCOL|WN_MENU|WN_DIALOG|WN_SIZEBOX nil title -> winstr in
let if (flags & EDFILE_DIALOG_SHOW_TOOLBAR) then crEdWindowToolBar winstr 0 0 w 28 5 1 EdDefaultTheme.EDT_iToolBarColor ETB_HORIZONTAL else nil -> tbstr in
let crEdCtrlTree winstr 10 tpos wcol (h - 70 - tpos) EDWIN_RESIZE_RW|EDWIN_RESIZE_MH -> ctrltree in
let if (flags & EDFILE_DIALOG_MULTI) then LB_BORDER|LB_HSCROLL|LB_VSCROLL|LB_TABFOCUS|LB_MULTIPLE else LB_BORDER|LB_HSCROLL|LB_VSCROLL|LB_TABFOCUS -> lflags in
let crEdCtrlList winstr (wcol + 20) tpos listw (h - 70 - tpos) lflags EDWIN_RESIZE_MW|EDWIN_RESIZE_MH -> ctrllist in
let crEdCtrlLabelEx winstr 10 (h - 65) wcol 20 (locDef "fileName" "File name") ET_ALIGN_RIGHT EDWIN_RESIZE_LH|EDWIN_RESIZE_RW -> label in
let crEdCtrlTextLine winstr (wcol + 20) (h - 65) (w - (wcol + 30) - wcol - 12) 20 fname nil EDWIN_RESIZE_LH|EDWIN_RESIZE_MW -> ctrlname in
let if ((flags & EDFILE_DIALOG_FILTER_BITMAP) && (flags & EDFILE_DIALOG_SHOW_INFOS)) then
crEdCtrlBitmapExt winstr ((wcol + 30) + listw) tpos wcol (h - 70 - tpos) nil 0xffffff EDWIN_RESIZE_LW|EDWIN_RESIZE_MH 3
else if (flags & EDFILE_DIALOG_SHOW_INFOS) then
crEdCtrlLabelEx winstr ((wcol + 30) + listw) tpos wcol (h - 70 - tpos) "" ET_ALIGN_LEFT|ET_BORDER|ET_VSCROLL EDWIN_RESIZE_LW|EDWIN_RESIZE_MH
else nil
-> ctrlinfo in
let crEdCtrlSelect winstr (w - wcol - 12) (h - 65) wcol + 2 120 EDWIN_RESIZE_LH|EDWIN_RESIZE_LW -> ctrlftype in
let crEdCtrlButton winstr (w - wcol - 10) (h - 30) ((wcol / 2) - 5) 20 (if (save == 1) then (locDef "save" "Save") else if (save == 2) then (locDef "saveAs" "Save as") else (locDef "open" "Open")) EDWIN_RESIZE_LH|EDWIN_RESIZE_LW -> openbtn in
let crEdCtrlButton winstr ((w - wcol - 10) + (wcol / 2) + 5) (h - 30) ((wcol / 2) - 5) 20 (locDef "cancel" "Cancel") EDWIN_RESIZE_LH|EDWIN_RESIZE_LW -> cancelbtn in
let mkEdFileDialog [chan winstr tbstr ctrltree ctrllist ctrlname ctrlftype ctrlinfo openbtn filetypes lext basepath path nil nil nil nil nil flags save] -> fdialogstr in
(
if (tbstr == nil) then nil else
(
let _LDalphaBitmap _channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DDEFAULTCHKSFOLDER) -> asfolder in
setEdToolBarCheckState tbstr (crEdToolBarCheck tbstr asfolder ETB_ALIGN_LEFT (locDef "showSystemFolder" "Show / Hide system folders") mkfun6 @cbEdFileDialogShowSystem fdialogstr) if (flags & EDFILE_DIALOG_SYSTEM_FILES) then 1 else 0;
let _LDalphaBitmap _channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DDEFAULTCHKLFOLDER) -> alfolder in
setEdToolBarCheckState tbstr (crEdToolBarCheck tbstr alfolder ETB_ALIGN_LEFT (locDef "showFoldersInList" "Show / Hide folders in files list") mkfun6 @cbEdFileDialogShowFolderList fdialogstr) if (flags & EDFILE_DIALOG_LIST_FOLDERS) then 1 else 0;
if (!save) then nil else
let _LDalphaBitmap _channel _checkpack (strcat sG2DDEFAULTRESOURCESPATH sG2DDEFAULTBTNNFOLDER) -> anfolder in
crEdToolBarButton tbstr anfolder ETB_ALIGN_LEFT (locDef "newFolder" "Create a new folder") mkfun5 @cbEdFileDialogNewFolder fdialogstr;
);
setEdWindowMinimumSize winstr w h;
setEdWindowSize winstr ww hh;
setEdCtrlButtonEnable openbtn if save then 1 else 0;
fillEdFileDialogTree fdialogstr basepath path;
while (filetypes != nil) do
(
let hd filetypes -> [label lext] in
addEdCtrlSelect ctrlftype label;
set filetypes = tl filetypes;
);
selectEdCtrlSelectByPos ctrlftype 0;
setEdCtrlSelectCb ctrlftype mkfun4 @cbEdFileDialogFileType fdialogstr;
setEdCtrlTreeCbExpand ctrltree mkfun7 @cbEdFileDialogExpandFolder fdialogstr;
setEdCtrlTreeCbSelect ctrltree mkfun6 @cbEdFileDialogSelectFolder fdialogstr;
setEdCtrlListCbClick ctrllist mkfun6 @cbEdFileDialogListSelect fdialogstr;
setEdCtrlListCbDbClick ctrllist mkfun6 @cbEdFileDialogListValidate fdialogstr;
setEdCtrlTextLineCbValidate ctrlname mkfun3 @cbEdFileDialogValidate fdialogstr;
setEdCtrlListCbKeyDown ctrllist mkfun8 @cbEdFileDialogListKey fdialogstr;
if (!save) then nil else
setEdCtrlTreeCbKeyDown ctrltree mkfun8 @cbEdFileDialogTreeKey fdialogstr;
setEdCtrlButtonCb openbtn mkfun2 @cbEdOpenFileDialog fdialogstr;
setEdCtrlButtonCb cancelbtn mkfun2 @cbEdCancelFileDialog fdialogstr;
setEdwindowCbKeyDown winstr mkfun4 @cbEdFileDialogKeyDown fdialogstr;
setEdwindowCbDestroy winstr mkfun2 @cbEdFileDialogDestroy fdialogstr;
fdialogstr;
);;
fun crEdOpenFileDialogMulti(chan, fatherwin, x, y, w, h, title, filetypes, flags, basepath, path)=
let if (flags == nil) then EDFILE_DIALOG_MULTI else flags|EDFILE_DIALOG_MULTI -> flags in
let if (basepath == nil) || (!strcmp basepath "/") then "" else basepath -> basepath in
let crEdFileDialogExt chan fatherwin x y w h title filetypes basepath path "" flags 0 -> fdialogstr in
fdialogstr;;
fun crEdOpenFileDialog(chan, fatherwin, x, y, w, h, title, filetypes, flags, basepath, path)=
let if (basepath == nil) || (!strcmp basepath "/") then "" else basepath -> basepath in
let crEdFileDialogExt chan fatherwin x y w h title filetypes basepath path "" flags 0 -> fdialogstr in
fdialogstr;;
fun crEdOpenFileBitmapDialog(chan, fatherwin, x, y, w, h, title, filetypes, flags, basepath, path)=
let if (basepath == nil) || (!strcmp basepath "/") then "" else basepath -> basepath in
let crEdFileDialogExt chan fatherwin x y w h title filetypes basepath path "" EDFILE_DIALOG_FILTER_BITMAP|EDFILE_DIALOG_SHOW_INFOS|flags 0 -> fdialogstr in
fdialogstr;;
fun crEdSaveFileDialog(chan, fatherwin, x, y, w, h, title, filetypes, flags, basepath, path, fname)=
let if (basepath == nil) || (!strcmp basepath "/") then "" else basepath -> basepath in
let crEdFileDialogExt chan fatherwin x y w h title filetypes basepath path fname flags 1 -> fdialogstr in
fdialogstr;;
fun crEdSaveAsFileDialog(chan, fatherwin, x, y, w, h, title, filetypes, flags, basepath, path, fname)=
let if (basepath == nil) || (!strcmp basepath "/") then "" else basepath -> basepath in
let crEdFileDialogExt chan fatherwin x y w h title filetypes basepath path fname flags 2 -> fdialogstr in
fdialogstr;;