/* ----------------------------------------------------------------------------- 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 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 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_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_bSortMenus : I, EDM_fScale : F, EDM_iSnap : I, EDM_iBoxMode : I, EDM_bBoxClicked : 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, 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_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_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 ] mkEdWindow;; /*! @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] I;; proto selectEdCtrlTimeLineKey = fun [EdControl EdTLKey] 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 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 cr1 + cr2 g1 + g2 b1 + b2;; /*! @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 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 cr1 * cr2 g1 * g2 b1 * b2;; /*! \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(float, nb)= let if float == nil then 0.0 else float -> float in let ftoa float -> sf in let if nb == 0 || nb == nil then 0 else 1 + nb -> nb0 in substr sf 0 ((strfind "." sf 0) + nb0);; /*! \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 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; ); );; /*! @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 * * \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 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 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 [0 0 width height] 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; );; /*! @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 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 then (G2Drgb2bgr 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 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 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 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] -> 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; _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 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] -> 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; _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 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] -> 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 [_channel 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]; _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; _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;; /* ********************************************************************************************* / 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] -> 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] -> 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; 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; 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] -> 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; );; /*! @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] -> 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] -> 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] -> 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] -> 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] -> 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] -> 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] -> 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 -> [p [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 -> [p [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 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 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 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] [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] -> 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] -> 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)= 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 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 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;; /*! \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;; /*! @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 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] -> 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] -> 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 _ _] in 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, split)= let oldval -> [ox oy ow oh] in let ctrlstr.EDC_bitmap -> [_ obmp _ bmpbase bmppath bgcolor _ _] 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 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 _ _ _ _ _] in let _GETcontainerPositionSize cont -> [_ _ w h] in ( _DScompBitmap ocbmp; _DSalphaBitmap alphabmp; let G2DloadBmp ctrlstr.EDC_channel bmppath -> bmp in let G2DstrechBitmap ctrlstr.EDC_channel bmp 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 nil abmp 0 0 w h -> cbmp in ( _DSbitmap bmp; _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 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 _ _ _ _ _] 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 nil 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 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 nil 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 abmp cbmp _ bmppath bgcolor _ _] 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] -> 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 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 * * \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] -> 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 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 mkfun6 @cbEdCtrlBitmapResizeResourceExt split ctrlstr; set ctrlstr.EDC_bitmap = [cont abmp cbmp nil bmppath bgcolor 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] -> 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 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] -> 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 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 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 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 cval 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 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] -> 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; _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] -> 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] -> 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] -> 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 -> [_ 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 10 3] c 2 0 nil; set iv = iv -. delta; ); _BTDRAWrect bmp [10 0 20 ymax+1] 0xffffff 0 1 0xffffff; let (ftoi vc*.float_max) -> av in let mktab 3 [10 av] -> t in ( set t.(0) = [20 av-5]; set t.(2) = [20 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 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; _CHANGEobjNodeCoordinates _CONVERTcompBitmapToObjNode ccross [crossx-12 crossy-12] 1; setEdCtrlEditTextCbChange htxtstr mkfun3 @cbEdColorMapExaValueChange p; mutate p <- [(if !mode 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 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 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 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 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 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 then color else G2Dbgra2bgr color -> bgrcolor in let G2Dgetbgr bgrcolor -> [bc gc rc] in let if mode 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 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 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 then nil else crEdCtrlLabel winstr 145 232 40 20 "Alpha :" nil -> alabel in let if !mode 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 "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 crEdCtrlLabel winstr 105 272 25 20 "G :" nil -> glabel in let crEdCtrlFloat winstr 130 270 60 20 (itof gc) 0.0 255.0 1.0 0 themestr nil -> gtxtstr in let crEdCtrlLabel winstr 200 272 25 20 "B :" nil -> blabel in let 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 (loc "OS3D_0282") nil -> okbtnstr in let crEdCtrlButton winstr 100 (h - 30) 60 20 (loc "OS3D_0513") 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 _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 (loc "OS3D_0549") mkfun5 @cbEdColorMapScreenPicker pcolormap -> pickbtnstr in ( _CHANGEobjNodeCoordinates _CONVERTcompBitmapToObjNode ccross [crossx-12 crossy-12] 1; fillEdColorMapRuller bmprulerstr bgrcolor; _SETcontainerCursor contwork themestr.EDT_cursorColorPicker; setEdCtrlFloatCbChange rtxtstr mkfun3 @cbEdColorMapValueChange pcolormap; setEdCtrlFloatCbChange gtxtstr mkfun3 @cbEdColorMapValueChange pcolormap; setEdCtrlFloatCbChange btxtstr mkfun3 @cbEdColorMapValueChange pcolormap; setEdCtrlFloatCbChange atxtstr mkfun3 @cbEdColorMapValueChange pcolormap; setEdCtrlEditTextCbChange htxtstr mkfun3 @cbEdColorMapExaValueChange pcolormap; _CBcontainerClick contwork @cbEdColorMapCrossCursorClick pcolormap; _CBcontainerCursorMove contwork @cbEdColorMapCrossCursorMove pcolormap; _CBcontainerClick contruler @cbEdColorMapRulerCursorClick pcolormap; _CBcontainerCursorMove contruler @cbEdColorMapRulerCursorMove pcolormap; setEdCtrlButtonCb okbtnstr mkfun2 @cbEdColorMapOk [pcolormap winstr cbfun]; setEdCtrlButtonCb cancelbtnstr mkfun2 @cbEdColorMapCancel [pcolormap winstr cbfun]; paintEdToolBar tbstr; _PAINTcontainer contwork; _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 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 (loc "OS3D_0550") 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] -> 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 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;; /*! \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] I * * \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 0 **/ fun setEdCtrlSliderCbValue(ctrlstr, cbfun)= set ctrlstr.EDC_slider.EDSLIDER_cbValue = cbfun; 0;; /*! @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] -> 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 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) then nil else ( if (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 == 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]; ); 0;; 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]; ); 0;; 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 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 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 crEdCtrlTimeLineEditor(winstr, x, y, w, h, trackheight, pixelsperunit, length, leftstatus, resize, themestr)= 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] -> 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 x y w h-28 WN_CHILDINSIDE|WN_VSCROLL|WN_HSCROLL|WN_NOBORDER 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 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 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 (G2DisInList ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink.EDRL_lLinks 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 (G2DisInList ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink.EDRL_lLinks 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 (G2DisInList ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink.EDRL_lLinks 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]; if rlinkstr != ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink then nil else set ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink = nil; 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)= let ctrlstr.EDC_modulesEditor -> mestr in ( 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; ); set ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink = rlinktr; 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 ( if ctrlstr.EDC_modulesEditor.EDM_iLinkMode then nil else ( if (ctrlstr.EDC_modulesEditor.EDM_selectedBox == nil) then nil else set ctrlstr.EDC_modulesEditor.EDM_lastSelectedBox = ctrlstr.EDC_modulesEditor.EDM_selectedBox; chkCtrlModuleEditorRoundLink ctrlstr rlinktr; 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 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]; 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 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 (((x >= cx) && (x < (cx + cw))) )/*|| (((x + mcw) > cx) && ((x + mcw) < (cx + cw))))*/ && (((y >= cy) && (y < (cy + ch))) )/*|| (((y + mch) > cy) && ((y + mch) < (cy + ch))))*/ then let if (x - cx) > (y - cy) then [(cx + cw) y] else [x (cy + ch)] -> [xx yy] in 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 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_selectedRoundLink != nil) then nil else ( 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 let sizelist lbox -> size in ( while lbox != nil do ( chkCtrlModuleEditorBox ctrlstr (hd lbox) 1 0; set lbox = tl lbox; ); ); ); 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; 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 1; chkCtrlModuleEditorRoundLink ctrlstr nil; _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)= chkCtrlModuleEditorRoundLink ctrlstr nil; 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 ( chkCtrlModuleEditorRoundLink ctrlstr nil; 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; 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 (G2DisInList ctrlstr.EDC_modulesEditor.EDM_selectedRoundLink.EDRL_lLinks 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; ); 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 G2DgetStringSize ctrlstr.EDC_theme.EDT_fontModuleEditor mboxstr.EDB_sLabel -> [w h] in let [(w + 10) (h + 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 ( _DRAWtext bmpoff ctrlstr.EDC_theme.EDT_fontModuleEditor (w / 2) 10 TD_CENTER ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOff mboxstr.EDB_sLabel; _DRAWtext bmpon ctrlstr.EDC_theme.EDT_fontModuleEditor (w / 2) 10 TD_CENTER ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOn mboxstr.EDB_sLabel; 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; setEdCtrlModuleEditorBoxTooltip ctrlstr mboxstr mboxstr.EDB_sToolTip; _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 then nil else set mboxstr.EDB_iColorOn = oncolor; if offcolor == nil then nil else set mboxstr.EDB_iColorOff = offcolor; updateCtrlModuleEditorBox ctrlstr mboxstr; 0;; fun crEdCtrlModuleEditorBox(ctrlstr, name, label, 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 ctrlstr.EDC_theme.EDT_iModuleEditorBoxOn ctrlstr.EDC_theme.EDT_iModuleEditorBoxOff 0 1] -> mboxstr in let G2DgetStringSize ctrlstr.EDC_theme.EDT_fontModuleEditor label -> [w h] in let [(w + 10) (h + 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 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 ( _DRAWtext bmpoff ctrlstr.EDC_theme.EDT_fontModuleEditor (w / 2) 10 TD_CENTER ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOff label; _DRAWtext bmpon ctrlstr.EDC_theme.EDT_fontModuleEditor (w / 2) 10 TD_CENTER ctrlstr.EDC_theme.EDT_iModuleEditorBoxTextOn label; set mboxstr.EDB_bmpOff = bmpoff; set mboxstr.EDB_bmpOn = bmpon; set mboxstr.EDB_sName = name; set mboxstr.EDB_sLabel = label; set mboxstr.EDB_lParams = lp; set mboxstr.EDB_pos = [mx my]; set mboxstr.EDB_iWidth = w; set mboxstr.EDB_iHeight = h; set mboxstr.EDB_alphaBmp = _CRalphaBitmap ctrlstr.EDC_channel bmpoff nil nil nil; 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 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 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; 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] -> 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] -> mestr in ( _DSbitmap bmpLinks; _DSbitmap bmpLayer; setEdwindowCbSize scrollwinstr mkfun4 @cbEdCtrlModuleEditorSize ctrlstr; setEdwindowCbVirtualMove scrollwinstr mkfun4 @cbEdCtrlModuleEditorScroll ctrlstr; 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_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; ); 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 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 then (G2Drgb2bgr 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 then (G2Drgb2bgr 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;;