HGamer3D-GUI 0.3.1 → 0.4.0
raw patch · 12 files changed
+1801/−506 lines, 12 filesdep +splitdep ~HGamer3D-CEGUI-Bindingdep ~HGamer3D-Datadep ~HGamer3D-WinEvent
Dependencies added: split
Dependency ranges changed: HGamer3D-CEGUI-Binding, HGamer3D-Data, HGamer3D-WinEvent
Files
- HGamer3D-GUI.cabal +3/−3
- HGamer3D/GUI.hs +0/−503
- HGamer3D/GUI/BaseAPI.hs +229/−0
- HGamer3D/GUI/Internal/Base.hs +450/−0
- HGamer3D/GUI/Internal/Form.hs +360/−0
- HGamer3D/GUI/Internal/Properties.hs +201/−0
- HGamer3D/GUI/Internal/Widgets.hs +345/−0
- HGamer3D/GUI/Schema/Form.hs +44/−0
- HGamer3D/GUI/Schema/GUIDim.hs +38/−0
- HGamer3D/GUI/Schema/Layout.hs +38/−0
- HGamer3D/GUI/Schema/Widget.hs +58/−0
- HGamer3D/Internal/GUI.hs +35/−0
HGamer3D-GUI.cabal view
@@ -1,5 +1,5 @@ Name: HGamer3D-GUI -Version: 0.3.1 +Version: 0.4.0 Synopsis: GUI Functionality for HGamer3D Description: HGamer3D is a game engine for developing 3D games in the programming @@ -18,9 +18,9 @@ Extra-source-files: Setup.hs Library - Build-Depends: base >= 3 && < 5, HGamer3D-Data >= 0.3.0 && < 0.4.0, HGamer3D-CEGUI-Binding >= 0.3.0 && < 0.4.0, HGamer3D-WinEvent >= 0.3.0 && < 0.4.0 + Build-Depends: base >= 3 && < 5, split, HGamer3D-Data >= 0.4.0 && < 0.5.0, HGamer3D-CEGUI-Binding >= 0.4.0 && < 0.5.0, HGamer3D-WinEvent >= 0.4.0 && < 0.5.0 - Exposed-modules: HGamer3D.GUI + Exposed-modules: HGamer3D.GUI.Internal.Base, HGamer3D.GUI.Internal.Widgets, HGamer3D.GUI.Internal.Properties, HGamer3D.GUI.Internal.Form, HGamer3D.GUI.BaseAPI, HGamer3D.Internal.GUI, HGamer3D.GUI.Schema.GUIDim, HGamer3D.GUI.Schema.Widget, HGamer3D.GUI.Schema.Layout, HGamer3D.GUI.Schema.Form Other-modules: c-sources:
− HGamer3D/GUI.hs
@@ -1,503 +0,0 @@--- This source file is part of HGamer3D--- (A project to enable 3D game development in Haskell)--- For the latest info, see http://www.hgamer3d.org------ (c) 2011-2013 Peter Althainz------ Licensed under the Apache License, Version 2.0 (the "License");--- you may not use this file except in compliance with the License.--- You may obtain a copy of the License at------ http://www.apache.org/licenses/LICENSE-2.0------ Unless required by applicable law or agreed to in writing, software--- distributed under the License is distributed on an "AS IS" BASIS,--- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.--- See the License for the specific language governing permissions and--- limitations under the License.---- BasicGUI.hs---- |GUI functionality of the Base API.--module HGamer3D.GUI--(- - -- * Data Definitions, Types- - GUISystem (..),- GUIElement (..),- GUIEvent (..),- EventFunction,- - -- * Initialization, Event Input and Configuration- initGUI,- injectWinEventToGUI,-- loadGuiLayoutFromFile,- loadGuiScheme,- loadGuiFont,- setGuiDefaultFont,- setGuiDefaultMouseCursor,- setGuiDefaultTooltip,- - -- * Find and display GUI Elements- getChildGuiEl,- findChildGuiElRecursive,- addGuiElToDisplay,- removeGuiElFromDisplay,- - -- * Set specific GUI Element properties- getGuiElProperty,- setGuiElProperty,- enableGuiEl,- disableGuiEl,- activateGuiEl,- deactivateGuiEl,- showGuiEl,- hideGuiEl,- - -- * Listbox, Compobox specific functions- listboxAddText,- listboxGetSelectedText,- listboxRemoveAllText,- listboxInitialize,- listboxStatus,- comboboxAddText,- comboboxRemoveAllText,- - -- * Event Handling- registerGUIEvent,- pollGUIEvents- -)--where--import HGamer3D.Bindings.CEGUI.ClassOgreRenderer as CEGUIOgreRenderer-import HGamer3D.Bindings.CEGUI.ClassSystem as CEGUISystem-import HGamer3D.Bindings.CEGUI.ClassSystemHG3D as CEGUISystemHG3D-import HGamer3D.Bindings.CEGUI.ClassWindowManagerHG3D as CEGUIWindowManagerHG3D-import HGamer3D.Bindings.CEGUI.ClassWindowManager as CEGUIWindowManager-import HGamer3D.Bindings.CEGUI.ClassResourceProvider as CEGUIResourceProvider-import HGamer3D.Bindings.CEGUI.ClassDefaultResourceProvider as CEGUIDefaultResourceProvider-import HGamer3D.Bindings.CEGUI.ClassImageset as CEGUIImageset-import HGamer3D.Bindings.CEGUI.ClassFont as CEGUIFont-import HGamer3D.Bindings.CEGUI.ClassScheme as CEGUIScheme-import HGamer3D.Bindings.CEGUI.ClassWidgetLookManager as CEGUIWidgetLookManager-import HGamer3D.Bindings.CEGUI.ClassScriptModule as CEGUIScriptModule-import HGamer3D.Bindings.CEGUI.ClassLogger as CEGUILogger-import HGamer3D.Bindings.CEGUI.EnumLoggingLevel-import HGamer3D.Bindings.CEGUI.EnumMouseButton as CEGUIButton-import HGamer3D.Bindings.CEGUI.ClassFontManager as CEGUIFontManager-import HGamer3D.Bindings.CEGUI.ClassSchemeManager as CEGUISchemeManager-import HGamer3D.Bindings.CEGUI.ClassDefaultLogger as CEGUIDefaultLogger-import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController-import HGamer3D.Bindings.CEGUI.ClassWindowManagerHG3D as HG3DWindowManager---import HGamer3D.Bindings.Ogre.ClassHG3DMessagePump as MessagePump---import GHC.Ptr--import HGamer3D.Data-import HGamer3D.Util-import HGamer3D.WinEvent--import HGamer3D.Bindings.CEGUI.ClassPtr-import HGamer3D.Bindings.CEGUI.Utils--import HGamer3D.Bindings.CEGUI.ClassWindow as Window-import HGamer3D.Bindings.CEGUI.ClassWindowManager as WindowManager-import HGamer3D.Bindings.CEGUI.ClassWindowManagerHG3D as WindowManagerHG3D-import HGamer3D.Bindings.CEGUI.ClassWindow as Window-import HGamer3D.Bindings.CEGUI.ClassSystem as System-import HGamer3D.Bindings.CEGUI.ClassSystemHG3D as SystemHG3D-import HGamer3D.Bindings.CEGUI.ClassPropertySet as PropertySet-import HGamer3D.Bindings.CEGUI.ClassHG3DEventStaticFunctions as EvtSF -import HGamer3D.Bindings.CEGUI.ClassHG3DListboxStaticFunctions as ListboxSF-import HGamer3D.Bindings.CEGUI.ClassHG3DWindowStaticFunctions as WindowSF-import HGamer3D.Bindings.CEGUI.ClassListbox as Listbox-import HGamer3D.Bindings.CEGUI.ClassListboxItem as ListboxItem-import HGamer3D.Bindings.CEGUI.ClassCombobox as Combobox-import HGamer3D.Bindings.CEGUI.EnumKeyScan--import HGamer3D.Bindings.CEGUI.ClassHG3DEventStaticFunctions as EvtSF --import HGamer3D.Bindings.CEGUI.EnumMouseButton as CEGUIButton---data GUISystem = GUISystem {- guiRoot::HG3DClass,- guiRenderer::HG3DClass,- guiWindowManager::HG3DClass,- guiWindowManagerHG3D::HG3DClass,- guiFontManager::HG3DClass,- guiSchemeManager::HG3DClass,- guiEventController::HG3DClass,- guiUniqueName::UniqueName-} --type EventFunction = IO ()---- | The GUI Element, a window, a button, any widget or widget element, organized in a hierarchy-data GUIElement = GUIElement HG3DClass -- ^ only one constructor, currently GUI elements are not specified in more detail---- | load a complete layout file into the application-loadGuiLayoutFromFile :: GUISystem - -> String -- ^ filename, without the path (this is defined by resource locations)- -> String -- ^ prefix to append to the identifiers in the layout, this allows, to load the same dailog/gui element multiple times with different names, if needed- -> IO GUIElement -- ^ the resulting tree of GUI elements as top GUI element-loadGuiLayoutFromFile guis layoutFile prefix = do- let hg3dWinMgr = guiWindowManagerHG3D guis- window <- WindowManagerHG3D.loadWindowLayoutHG3D hg3dWinMgr layoutFile prefix- return (GUIElement window)---- | add a GUI element to the display-addGuiElToDisplay :: GUISystem -> GUIElement -- ^ GUI element- -> IO ()-addGuiElToDisplay guis (GUIElement window) = do- let guir = guiRoot guis- guiSheet <- System.getGUISheet guir- Window.addChildWindow2 guiSheet window---- | remove a GUI element from the display-removeGuiElFromDisplay :: GUISystem -> GUIElement -- ^ GUI element- -> IO ()-removeGuiElFromDisplay guis (GUIElement window) = do- let guir = guiRoot guis- guiSheet <- System.getGUISheet guir- Window.removeChildWindow2 guiSheet window---- | enable GUI element, allow interaction with it and render it accordingly-enableGuiEl :: GUIElement -- ^ GUI element to enable- -> IO ()-enableGuiEl (GUIElement window) = do- Window.enable window---- | disable GUI element, disallow interaction with it and render it accordingly-disableGuiEl :: GUIElement -- ^ GUI element to disable- -> IO ()-disableGuiEl (GUIElement window) = do- Window.disable window---- | activate GUI element, process events send to it-activateGuiEl :: GUIElement -- ^ GUI element to activate- -> IO ()-activateGuiEl (GUIElement window) = do- Window.activate window---- | deactivate GUI element, do not process events send to it-deactivateGuiEl :: GUIElement -- ^ GUI element to deactivate- -> IO ()-deactivateGuiEl (GUIElement window) = do- Window.deactivate window---- | show GUI element-showGuiEl :: GUIElement -- ^ GUI element to show- -> IO ()-showGuiEl (GUIElement window) = do- Window.show window---- | hide GUI element-hideGuiEl :: GUIElement -- ^ GUI element to hide- -> IO ()-hideGuiEl (GUIElement window) = do- Window.hide window---- | get child gui element, throws an exception, if element not found in children, only searches the direct children of element.-getChildGuiEl :: GUIElement -- ^ GUI element, which childrens are searched for child element- -> String -- ^ name of searched child element- -> IO GUIElement -- ^ found element (throws exception, in case no child found)-getChildGuiEl (GUIElement window) name = do- window <- Window.getChild window name- return (GUIElement window)---- | find child element recursively, searches all sub-trees-findChildGuiElRecursive :: GUIElement -- ^ GUI element, which childrens are searched, including children of children and so on.- -> String -- ^ name of child element to be found- -> IO (Maybe GUIElement) -- ^ in case of found element: Just el, Nothing otherwhise-findChildGuiElRecursive (GUIElement window) name = do- window <- Window.getChildRecursive window name- if (ocPtr window) == nullPtr then do- return Nothing- else do- return (Just (GUIElement window))---- | get a named property as string from element-getGuiElProperty :: GUIElement -- ^ GUI element- -> String -- ^ property name to get- -> IO String -- ^ property value-getGuiElProperty (GUIElement window) name = do- prop <- PropertySet.getProperty window name- return prop---- | set a named property -setGuiElProperty :: GUIElement -- ^ GUI element- -> String -- ^ property name to set- -> String -- ^ property value as string- -> IO ()-setGuiElProperty (GUIElement window) name value = do- PropertySet.setProperty window name value---- | load a complete GUI scheme, see CEGUI manual for details-loadGuiScheme :: GUISystem -> String -- ^ scheme name- -> IO ()-loadGuiScheme guis schemeName = do- SystemHG3D.schemeManagerCreate (guiSchemeManager guis) schemeName---- | load a GUI font-loadGuiFont :: GUISystem -> String -- ^ font name- -> IO () -loadGuiFont guis fontName = do- SystemHG3D.fontManagerCreate (guiFontManager guis) fontName- --- | set default GUI font-setGuiDefaultFont :: GUISystem -> String -- ^ font name- -> IO () -setGuiDefaultFont guis fontName = do- let guir = guiRoot guis- System.setDefaultFont guir fontName- --- | set default mouse cursor-setGuiDefaultMouseCursor :: GUISystem - -> String -- ^ scheme name, where cursor is contained in- -> String -- ^ cursor name- -> IO () -setGuiDefaultMouseCursor guis schemeName cursorName = do- let guir = guiRoot guis- System.setDefaultMouseCursor3 guir schemeName cursorName---- | set default tool tip-setGuiDefaultTooltip :: GUISystem -> String -- ^ default tool tip name- -> IO () -setGuiDefaultTooltip guis ttName = do- let guir = guiRoot guis- System.setDefaultTooltip2 guir ttName---- | add one line of text as a selectable entry to a combobox-comboboxAddText :: GUIElement -- ^ GUI element, needs to be a combobox- -> String -- ^ the entry string to add- -> IO ()-comboboxAddText (GUIElement window) itemname = do- realcombo <- WindowSF.castWindowToCombobox window- ListboxSF.comboboxAddItem realcombo itemname- --- | removes all lines of entries from a combobox-comboboxRemoveAllText :: GUIElement -- ^ the GUI elements, needs to be a combobox- -> IO ()-comboboxRemoveAllText (GUIElement window) = do- realcombo <- WindowSF.castWindowToCombobox window- Combobox.resetList realcombo- --- | add one line of text as a selectable entry to a listbox-listboxAddText :: GUIElement -- ^ GUI element, needs to be a listbox- -> String -- ^ the entry string to add- -> IO ()-listboxAddText (GUIElement window) itemname = do- reallistbox <- WindowSF.castWindowToListbox window- ListboxSF.listboxAddItem reallistbox itemname- -_getTextListOfItem reallistbox item list = do- let (HG3DClass ptra ptrb) = item- if ptra /= nullPtr then do- txt <- ListboxItem.getText item- let list' = list ++ [txt]- item' <- Listbox.getNextSelected reallistbox item- list'' <- _getTextListOfItem reallistbox item' list'- return list''- else do- return list- -listboxInitialize :: GUIElement -- ^ GUI element, needs to be a listbox- -> [(String, Bool)] -- ^ list of entry, selected pairs- -> IO ()-listboxInitialize (GUIElement window) pairs = do- reallistbox <- WindowSF.castWindowToListbox window- Listbox.resetList reallistbox- mapM ( \((entry, selected), ind) -> do- ListboxSF.listboxAddItem reallistbox entry- item <- Listbox.getListboxItemFromIndex reallistbox ind- ListboxItem.setSelected item selected- return ()- ) (zip pairs [0..])- return ()- -listboxStatus :: GUIElement -- ^ GUI element, needs to be a listbox- -> IO [(String, Bool)] -- ^ list of entry, selected pairs-listboxStatus (GUIElement window) = do- reallistbox <- WindowSF.castWindowToListbox window- count <- Listbox.getItemCount reallistbox- outlist <- mapM ( \ind -> do- item <- Listbox.getListboxItemFromIndex reallistbox ind- sel <- ListboxItem.isSelected item- txt <- ListboxItem.getText item- return (txt, sel)- ) [0..(count-1)]- return outlist- ---- | return the selected items as an array of strings-listboxGetSelectedText :: GUIElement -- ^ the GUI element, needs to be a listbox- -> IO [String] -- ^ the selected items as an array of strings-listboxGetSelectedText (GUIElement window) = do- reallistbox <- WindowSF.castWindowToListbox window- item <- Listbox.getFirstSelectedItem reallistbox- list <- _getTextListOfItem reallistbox item ([]::[String])- return list- --- | removes all lines of entries from a listbox-listboxRemoveAllText :: GUIElement -- ^ the GUI element, needs to be a listbox- -> IO ()-listboxRemoveAllText (GUIElement window) = do- reallistbox <- WindowSF.castWindowToListbox window- Listbox.resetList reallistbox- ------ | initialize the GUI system, used internally-initGUI :: Bool -- ^ logging flag- -> Bool -- ^ show graphics cursor flag- -> IO (GUISystem) -- ^ GUI system object-initGUI fShowGraphicsCursor fLog = do--- -- CEGUI system- ---------------- - -- first logger, loglevel- - if not fLog then do- ceguilog <- CEGUISystemHG3D.createNoLogger - return ()- else do- ceguilog <- CEGUIDefaultLogger.new- CEGUILogger.setLogFilename ceguilog "hgamer3d-gui.log" False- CEGUILogger.setLoggingLevel ceguilog LoggingLevelInformative- return ()-- -- bootstrap complete cegui system- - guirenderer <- CEGUIOgreRenderer.bootstrapSystem- - guiroot <- CEGUISystem.getSingletonPtr- guiwindowmgr <- CEGUIWindowManagerHG3D.getSingleton- guifontmgr <- CEGUISystemHG3D.getFontManagerSingleton- guischememgr <- CEGUISystemHG3D.getSchemeManagerSingleton- - CEGUIScheme.setDefaultResourceGroup "Schemes"- CEGUIImageset.setDefaultResourceGroup "Imagesets"- CEGUIFont.setDefaultResourceGroup "Fonts"- CEGUIWidgetLookManager.setDefaultResourceGroup "LookNFeel"- CEGUIWindowManager.setDefaultResourceGroup "Layouts"--- CEGUIScriptModule.setDefaultResourceGroup "lua_scripts"-- CEGUISystemHG3D.schemeManagerCreate guischememgr "VanillaSkin.scheme"- CEGUISystemHG3D.schemeManagerCreate guischememgr "WindowsLook.scheme"- CEGUISystemHG3D.schemeManagerCreate guischememgr "WindowsLookWidgets.scheme"- CEGUISystemHG3D.schemeManagerCreate guischememgr "TaharezLook.scheme"- CEGUISystemHG3D.schemeManagerCreate guischememgr "TaharezLookWidgets.scheme"- - CEGUISystemHG3D.fontManagerCreate guifontmgr "DejaVuSans-10.font"- - CEGUISystem.setDefaultFont guiroot "DejaVuSans-10"- if fShowGraphicsCursor then do- CEGUISystem.setDefaultMouseCursor3 guiroot "Vanilla-Images" "MouseArrow"- showCursor False- return ()- else do- showCursor True- return ()- CEGUISystem.setDefaultTooltip2 guiroot "WindowsLook/Tooltip"- - -- set standard empty gui sheet- myRoot <- CEGUIWindowManager.createWindow guiwindowmgr "DefaultWindow" "root"- CEGUISystem.setGUISheet guiroot myRoot- - eventController <- HG3DEventController.new- guiwmgrhg3d <- HG3DWindowManager.new- uniqueName <- createUniqueName "GUI"- - return (GUISystem guiroot guirenderer guiwindowmgr guiwmgrhg3d guifontmgr guischememgr eventController uniqueName)--keyscanToScancode :: EnumSDLScancode -> Maybe Int-keyscanToScancode keyscan = if out == KeyMediaSelect then Nothing else (Just (fromIntegral (fromEnum out))) where- out = case keyscan of- SDL_SCANCODE_RETURN -> KeyReturn- SDL_SCANCODE_ESCAPE -> KeyEscape- SDL_SCANCODE_BACKSPACE -> KeyBackspace- SDL_SCANCODE_TAB -> KeyTab- SDL_SCANCODE_INSERT -> KeyInsert- SDL_SCANCODE_HOME -> KeyHome- SDL_SCANCODE_PAGEUP -> KeyPageUp- SDL_SCANCODE_DELETE -> KeyDelete- SDL_SCANCODE_END -> KeyEnd - SDL_SCANCODE_PAGEDOWN -> KeyPageDown- SDL_SCANCODE_RIGHT -> KeyArrowRight- SDL_SCANCODE_LEFT -> KeyArrowLeft- SDL_SCANCODE_DOWN -> KeyArrowDown- SDL_SCANCODE_UP ->KeyArrowUp- _ -> KeyMediaSelect -- misused as Nothing indicator- - -_injectKeyUp guiroot keycode = do - case keyscanToScancode keycode of- Nothing -> return False- Just scancode -> System.injectKeyUp guiroot scancode--_injectKeyDown guiroot keycode = do - case keyscanToScancode keycode of- Nothing -> return False- Just scancode -> System.injectKeyDown guiroot scancode---- keypressInject---- | injects key presses into the CEGUI engine, used internally-injectWinEventToGUI :: GUISystem -> SDLEvent -> IO ()-injectWinEventToGUI guis evt = do- - let guiroot = guiRoot guis- case evt of- EvtText ts window text -> System.injectChar guiroot (fromEnum (text !! 0))- EvtKeyUp ts window keyscan keycode keymode -> _injectKeyUp guiroot keyscan- EvtKeyDown ts window keyscan keycode keymode -> _injectKeyDown guiroot keyscan- EvtMouseButtonUp ts window mid button x y -> do- case button of- SDLButtonLeft -> System.injectMouseButtonUp guiroot CEGUIButton.MouseLeftButton- SDLButtonRight -> System.injectMouseButtonUp guiroot CEGUIButton.MouseRightButton- SDLButtonMiddle -> System.injectMouseButtonUp guiroot CEGUIButton.MouseMiddleButton- _ -> return True- EvtMouseButtonDown ts window mid button x y -> do- case button of- SDLButtonLeft -> System.injectMouseButtonDown guiroot CEGUIButton.MouseLeftButton- SDLButtonRight -> System.injectMouseButtonDown guiroot CEGUIButton.MouseRightButton- SDLButtonMiddle -> System.injectMouseButtonDown guiroot CEGUIButton.MouseMiddleButton- _ -> return True- EvtMouseMotion ts window mid x y rx ry -> CEGUISystem.injectMousePosition guiroot (fromIntegral x) (fromIntegral y)- _ -> return True- - return () - --- | register a GUI Event, for later retrieval-registerGUIEvent :: GUISystem - -> GUIElement -- ^ GUI Element from which event is registered- -> String -- ^ event name, for which registration is done- -> String -- ^ identifier, with which event is identified later on- -> IO ()-registerGUIEvent guis (GUIElement el) eventToRegister registrationTag = do- EvtSF.subscribeScriptedEvent el eventToRegister registrationTag- -data GUIEvent = GUIEvent String String GUIElement--pollGUIEvents :: GUISystem -> IO [GUIEvent]-pollGUIEvents guis = do- let eventController = guiEventController guis- processEvents <- HG3DEventController.eventsAvailable eventController- if processEvents then do- (name, sender, window) <- HG3DEventController.popEvent eventController- let evt = GUIEvent name sender (GUIElement window)- moreEvents <- pollGUIEvents guis- return $ (evt : moreEvents)- else do- return []
+ HGamer3D/GUI/BaseAPI.hs view
@@ -0,0 +1,229 @@+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2013 Peter Althainz+-- +-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- GUI.hs++-- |GUI functionality of HGamer3D, public API. ++module HGamer3D.GUI.BaseAPI++(+ -- * General GUI Functionality+ + -- ** Data Definitions, Types+ + GUISystem,++ -- ** Initializing+ + initGUI,+ freeGUI,+ pollGUIEvent,++ -- ** Configuration+ + loadGuiScheme,+ loadGuiFont,+ setGuiDefaultFont,+ setGuiDefaultMouseCursor,+ setGuiDefaultTooltip,++ -- * General Handling of GUI Elements++ -- ** Data Definition, Types+ + GUIElement,+ GUIDim (..),+ GUIVec2 (..),++ -- ** Work on the GUI Element Tree++ addChildGuiEl,+ getChildGuiEl,+ removeChildGuiEl,+ findChildGuiElRecursive,++ -- ** Add Elements to Display and Remove from Display+ + addGuiElToDisplay,+ removeGuiElFromDisplay,+ + -- ** Work with GUI Element Properties+ + getGuiElProperty,+ setGuiElProperty,+ enableGuiEl,+ disableGuiEl,+ activateGuiEl,+ deactivateGuiEl,+ deleteGuiEl,+ showGuiEl,+ hideGuiEl,+ typeOfGuiEl,++ -- ** Work with File Layouts++ loadGuiLayoutFromFile,++ -- * Event Handling+ + injectWinEventToGUI,+ injectGUITimeDelta,+ notifyDisplaySizeChanged,+ GUIEvent (..),+ registerGUIEvent,++-- * Widget Properties++ -- ** Property Types++ GUIElementProperty, + GUIHasValueProperty,++-- ** Property Functions+ (=:),+ setP,+ getP,++-- ** GUI Widget General Properties++ pText,+ pDisabled,+ pVisible,+ pAlpha,+ pTooltip,+ pAlwaysOnTop,+ pMargin,++ pX,+ pY,+ pWidth,+ pHeight,++ pSelected,+ pValue,++ pTextSelection,+ pTextChoice,+ ++-- * Widget Specific Types, Functions and Properties++ -- ** Button Widget+ GUIButton,+ GUIButtonProperty,+ button,+ toButton,+ findButton,++ -- ** RadioButton Widget+ GUIRadioButton,+ GUIRadioButtonProperty,+ radioButton,+ toRadioButton,+ findRadioButton,++ -- ** CheckBox Widget+ GUICheckBox,+ GUICheckBoxProperty,+ checkBox,+ toCheckBox,+ findCheckBox,++ -- ** EditText Widget+ GUIEditText, + GUIEditTextProperty,+ editText,+ toEditText,+ findEditText,++ -- ** MultilineText Widget+ GUIMultilineText, + multilineText,+ toMultilineText,+ findMultilineText,++ -- ** Listbox/Combobox Widget + GUIListBox,+ GUIComboBox,+ GUIHasSelectionProperty, + comboBox,+ listBox,+ toComboBox,+ toListBox,+ findComboBox,+ findListBox,++ listboxAddText,+ listboxGetSelectedText,+ listboxRemoveAllText,+ listboxInitialize,+ listboxStatus,++ comboboxAddText,+ comboboxRemoveAllText,+ comboboxStatus,++ -- ** Slider/Spinner Widget+ GUISlider,+ GUISpinner,+ GUISliderProperty,+ GUISpinnerProperty,+ slider,+ spinner,+ toSlider,+ toSpinner, + findSlider,+ findSpinner,++ -- ** Layout Container Widgets+ GUIHLayout,+ GUIVLayout,+ GUIGridLayout,++ hLayout,+ vLayout,+ gridLayout,++ toHLayout,+ toVLayout,+ toGridLayout,++ -- ** Window Widget+ GUIWindow,+ window,+ toWindow,+ ++ -- ** CRUD for Form based GUIs+ GUIEngineData,+ createForm,+ updateForm,+ removeForm,++ getFormValues,+ setFormValues+)++where++import HGamer3D.GUI.Internal.Base+import HGamer3D.GUI.Internal.Widgets+import HGamer3D.GUI.Internal.Properties+import HGamer3D.GUI.Internal.Form+import HGamer3D.GUI.Schema.GUIDim
+ HGamer3D/GUI/Internal/Base.hs view
@@ -0,0 +1,450 @@+{-# OPTIONS_HADDOCK hide #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2013 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- GUI/Internal/Base.hs++-- |Base functionality of the GUI. Implementation module with internal data structures exposed. Public API in HGamer3D.GUI.++module HGamer3D.GUI.Internal.Base+where++import HGamer3D.Bindings.CEGUI.ClassOgreRenderer as CEGUIOgreRenderer+import HGamer3D.Bindings.CEGUI.ClassSystem as CEGUISystem+import HGamer3D.Bindings.CEGUI.ClassSystemHG3D as CEGUISystemHG3D+import HGamer3D.Bindings.CEGUI.ClassWindowManagerHG3D as CEGUIWindowManagerHG3D+import HGamer3D.Bindings.CEGUI.ClassWindowManager as CEGUIWindowManager+import HGamer3D.Bindings.CEGUI.ClassResourceProvider as CEGUIResourceProvider+import HGamer3D.Bindings.CEGUI.ClassDefaultResourceProvider as CEGUIDefaultResourceProvider+import HGamer3D.Bindings.CEGUI.ClassImageset as CEGUIImageset+import HGamer3D.Bindings.CEGUI.ClassFont as CEGUIFont+import HGamer3D.Bindings.CEGUI.ClassEventSet as EventSet+import HGamer3D.Bindings.CEGUI.ClassScheme as CEGUIScheme+import HGamer3D.Bindings.CEGUI.ClassWidgetLookManager as CEGUIWidgetLookManager+import HGamer3D.Bindings.CEGUI.ClassScriptModule as CEGUIScriptModule+import HGamer3D.Bindings.CEGUI.ClassLogger as CEGUILogger+import HGamer3D.Bindings.CEGUI.EnumLoggingLevel+import HGamer3D.Bindings.CEGUI.EnumMouseButton as CEGUIButton+import HGamer3D.Bindings.CEGUI.ClassFontManager as CEGUIFontManager+import HGamer3D.Bindings.CEGUI.ClassSchemeManager as CEGUISchemeManager+import HGamer3D.Bindings.CEGUI.ClassDefaultLogger as CEGUIDefaultLogger+import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController+import HGamer3D.Bindings.CEGUI.ClassWindowManagerHG3D as HG3DWindowManager+--import HGamer3D.Bindings.Ogre.ClassHG3DMessagePump as MessagePump+++import GHC.Ptr++import HGamer3D.Data+import HGamer3D.Util+import HGamer3D.WinEvent.BaseAPI++import HGamer3D.Bindings.CEGUI.ClassPtr+import HGamer3D.Bindings.CEGUI.Utils++import HGamer3D.Bindings.CEGUI.ClassWindow as Window+import HGamer3D.Bindings.CEGUI.ClassWindowManager as WindowManager+import HGamer3D.Bindings.CEGUI.ClassWindowManagerHG3D as WindowManagerHG3D+import HGamer3D.Bindings.CEGUI.ClassWindow as Window+import HGamer3D.Bindings.CEGUI.ClassSystem as System+import HGamer3D.Bindings.CEGUI.ClassSystemHG3D as SystemHG3D+import HGamer3D.Bindings.CEGUI.ClassPropertySet as PropertySet+import HGamer3D.Bindings.CEGUI.ClassHG3DEventStaticFunctions as EvtSF +import HGamer3D.Bindings.CEGUI.ClassHG3DListboxStaticFunctions as ListboxSF+import HGamer3D.Bindings.CEGUI.ClassHG3DWindowStaticFunctions as WindowSF+import HGamer3D.Bindings.CEGUI.ClassListbox as Listbox+import HGamer3D.Bindings.CEGUI.ClassListboxItem as ListboxItem+import HGamer3D.Bindings.CEGUI.ClassCombobox as Combobox+import HGamer3D.Bindings.CEGUI.EnumKeyScan++import HGamer3D.Bindings.CEGUI.ClassHG3DEventStaticFunctions as EvtSF ++import HGamer3D.Bindings.CEGUI.EnumMouseButton as CEGUIButton++import HGamer3D.Data.HG3DClass++import HGamer3D.WinEvent.Internal.Base (showCursor)++-- | the basic data item, carrying status information on implementation details for GUI system+data GUISystem = GUISystem {+ guiRoot::HG3DClass,+ guiRenderer::HG3DClass,+ guiWindowManager::HG3DClass,+ guiWindowManagerHG3D::HG3DClass,+ guiFontManager::HG3DClass,+ guiSchemeManager::HG3DClass,+ guiEventController::HG3DClass,+ guiUniqueName::UniqueName+} ++-- type constructors for phantom types++data GEButton = GEButton+data GERadioButton = GERadioButton+data GECheckBox = GECheckBox+data GEEditText = GEEditText+data GEMultilineText = GEMultilineText++data GEListBox = GEListBox+data GEComboBox = GEComboBox++data GESlider = GESlider+data GESpinner = GESpinner++data GEWindow = GEWindow+data GEHLayout = GEHLayout+data GEVLayout = GEVLayout+data GEGridLayout = GEGridLayout++-- | The GUI Element, a window, a button, any widget or widget element, organized in a hierarchy+data GUIElement a = GUIElement HG3DClass a -- ^ only one constructor, phantom type a, to allow GUIElement sub-typing+++++-- | load a complete layout file into the application+loadGuiLayoutFromFile :: GUISystem + -> String -- ^ filename, without the path (this is defined by resource locations)+ -> String -- ^ prefix to append to the identifiers in the layout, this allows, to load the same dailog/gui element multiple times with different names, if needed+ -> IO (GUIElement a) -- ^ the resulting tree of GUI elements as top GUI element+loadGuiLayoutFromFile guis layoutFile prefix = do+ let hg3dWinMgr = guiWindowManagerHG3D guis+ window <- WindowManagerHG3D.loadWindowLayoutHG3D hg3dWinMgr layoutFile prefix+ return (GUIElement window undefined)++-- | add a GUI element to the display+addGuiElToDisplay :: GUISystem + -> GUIElement a -- ^ GUI element+ -> IO ()+addGuiElToDisplay guis (GUIElement window _) = do+ let guir = guiRoot guis+ guiSheet <- System.getGUISheet guir+ Window.addChildWindow2 guiSheet window++-- | remove a GUI element from the display+removeGuiElFromDisplay :: GUISystem + -> GUIElement a -- ^ GUI element+ -> IO ()+removeGuiElFromDisplay guis (GUIElement window _) = do+ let guir = guiRoot guis+ guiSheet <- System.getGUISheet guir+ Window.removeChildWindow2 guiSheet window++-- | enable GUI element, allow interaction with it and render it accordingly+enableGuiEl :: GUIElement a -- ^ GUI element to enable+ -> IO ()+enableGuiEl (GUIElement window _) = do+ Window.enable window++-- | disable GUI element, disallow interaction with it and render it accordingly+disableGuiEl :: GUIElement a -- ^ GUI element to disable+ -> IO ()+disableGuiEl (GUIElement window _) = do+ Window.disable window++-- | activate GUI element, process events send to it+activateGuiEl :: GUIElement a -- ^ GUI element to activate+ -> IO ()+activateGuiEl (GUIElement window _) = do+ Window.activate window++-- | deactivate GUI element, do not process events send to it+deactivateGuiEl :: GUIElement a -- ^ GUI element to deactivate+ -> IO ()+deactivateGuiEl (GUIElement window _) = do+ Window.deactivate window++-- | delete a GUI element, do not process events send to it+deleteGuiEl :: GUISystem -> GUIElement a -- ^ GUI element to deactivate+ -> IO ()+deleteGuiEl guis (GUIElement window _) = do+ let wmgr = guiWindowManager guis+ EventSet.removeAllEvents window+ CEGUIWindowManager.destroyWindow wmgr window++-- | show GUI element+showGuiEl :: GUIElement a -- ^ GUI element to show+ -> IO ()+showGuiEl (GUIElement window _) = do+ Window.show window++-- | hide GUI element+hideGuiEl :: GUIElement a -- ^ GUI element to hide+ -> IO ()+hideGuiEl (GUIElement window _) = do+ Window.hide window++-- | add a GUI element as a child to another GUI element+addChildGuiEl :: GUIElement a -- ^ parent GUI element+ -> GUIElement b -- ^ child GUI element+ -> IO ()+addChildGuiEl (GUIElement parentW _) (GUIElement childW _) = do+ Window.addChildWindow2 parentW childW++-- | remove a GUI element as a child from the parent GUI element+removeChildGuiEl :: GUIElement a -- ^ parent GUI element+ -> GUIElement b -- ^ child GUI element+ -> IO ()+removeChildGuiEl (GUIElement parentW _) (GUIElement childW _) = do+ Window.removeChildWindow2 parentW childW++-- | get child gui element, throws an exception, if element not found in children, only searches the direct children of element.+getChildGuiEl :: GUIElement a -- ^ GUI element, which childrens are searched for child element+ -> String -- ^ name of searched child element+ -> IO (GUIElement a) -- ^ found element (throws exception, in case no child found)+getChildGuiEl (GUIElement window _) name = do+ window <- Window.getChild window name+ return (GUIElement window undefined)++-- | find child element recursively, searches all sub-trees+findChildGuiElRecursive :: GUIElement a -- ^ GUI element, which childrens are searched, including children of children and so on.+ -> String -- ^ name of child element to be found+ -> IO (Maybe (GUIElement b)) -- ^ in case of found element: Just el, Nothing otherwhise+findChildGuiElRecursive (GUIElement window _) name = do+ window <- Window.getChildRecursive window name+ if (ocPtr window) == nullPtr then do+ return Nothing+ else do+ return (Just (GUIElement window undefined))++-- | get a named property as string from element+getGuiElProperty :: GUIElement a -- ^ GUI element+ -> String -- ^ property name to get+ -> IO String -- ^ property value+getGuiElProperty (GUIElement window _) name = do+ prop <- PropertySet.getProperty window name+ return prop++-- | set a named property +setGuiElProperty :: GUIElement a -- ^ GUI element+ -> String -- ^ property name to set+ -> String -- ^ property value as string+ -> IO ()+setGuiElProperty (GUIElement window _) name value = do+ PropertySet.setProperty window name value++-- | load a complete GUI scheme, see CEGUI manual for details+loadGuiScheme :: GUISystem -> String -- ^ scheme name+ -> IO ()+loadGuiScheme guis schemeName = do+ SystemHG3D.schemeManagerCreate (guiSchemeManager guis) schemeName++-- | load a GUI font+loadGuiFont :: GUISystem -> String -- ^ font name+ -> IO () +loadGuiFont guis fontName = do+ SystemHG3D.fontManagerCreate (guiFontManager guis) fontName+ +-- | set default GUI font+setGuiDefaultFont :: GUISystem -> String -- ^ font name+ -> IO () +setGuiDefaultFont guis fontName = do+ let guir = guiRoot guis+ System.setDefaultFont guir fontName+ +-- | set default mouse cursor+setGuiDefaultMouseCursor :: GUISystem + -> String -- ^ scheme name, where cursor is contained in+ -> String -- ^ cursor name+ -> IO () +setGuiDefaultMouseCursor guis schemeName cursorName = do+ let guir = guiRoot guis+ System.setDefaultMouseCursor3 guir schemeName cursorName++-- | set default tool tip+setGuiDefaultTooltip :: GUISystem -> String -- ^ default tool tip name+ -> IO () +setGuiDefaultTooltip guis ttName = do+ let guir = guiRoot guis+ System.setDefaultTooltip2 guir ttName+++++-- | initialize the GUI system, used internally+initGUI :: Bool -- ^ logging flag+ -> Bool -- ^ show graphics cursor flag+ -> IO (GUISystem) -- ^ GUI system object+initGUI fShowGraphicsCursor fLog = do+++ -- CEGUI system+ ---------------+ + -- first logger, loglevel+ + if not fLog then do+ ceguilog <- CEGUISystemHG3D.createNoLogger + return ()+ else do+ ceguilog <- CEGUIDefaultLogger.new+ CEGUILogger.setLogFilename ceguilog "hgamer3d-gui.log" False+ CEGUILogger.setLoggingLevel ceguilog LoggingLevelInformative+ return ()++ -- bootstrap complete cegui system+ + guirenderer <- CEGUIOgreRenderer.bootstrapSystem+ + guiroot <- CEGUISystem.getSingletonPtr+ guiwindowmgr <- CEGUIWindowManagerHG3D.getSingleton+ guifontmgr <- CEGUISystemHG3D.getFontManagerSingleton+ guischememgr <- CEGUISystemHG3D.getSchemeManagerSingleton+ + CEGUIScheme.setDefaultResourceGroup "Schemes"+ CEGUIImageset.setDefaultResourceGroup "Imagesets"+ CEGUIFont.setDefaultResourceGroup "Fonts"+ CEGUIWidgetLookManager.setDefaultResourceGroup "LookNFeel"+ CEGUIWindowManager.setDefaultResourceGroup "Layouts"+-- CEGUIScriptModule.setDefaultResourceGroup "lua_scripts"++ CEGUISystemHG3D.schemeManagerCreate guischememgr "VanillaSkin.scheme"+ CEGUISystemHG3D.schemeManagerCreate guischememgr "WindowsLook.scheme"+ CEGUISystemHG3D.schemeManagerCreate guischememgr "WindowsLookWidgets.scheme"+ CEGUISystemHG3D.schemeManagerCreate guischememgr "TaharezLook.scheme"+ CEGUISystemHG3D.schemeManagerCreate guischememgr "TaharezLookWidgets.scheme"+ + CEGUISystemHG3D.fontManagerCreate guifontmgr "DejaVuSans-10.font"+ + CEGUISystem.setDefaultFont guiroot "DejaVuSans-10"+ if fShowGraphicsCursor then do+ CEGUISystem.setDefaultMouseCursor3 guiroot "Vanilla-Images" "MouseArrow"+ showCursor False+ return ()+ else do+ showCursor True+ return ()+ CEGUISystem.setDefaultTooltip2 guiroot "WindowsLook/Tooltip"+ + -- set standard empty gui sheet+ myRoot <- CEGUIWindowManager.createWindow guiwindowmgr "DefaultWindow" "root"+ CEGUISystem.setGUISheet guiroot myRoot+ + eventController <- HG3DEventController.new+ guiwmgrhg3d <- HG3DWindowManager.new+ uniqueName <- createUniqueName "GUI"+ + return (GUISystem guiroot guirenderer guiwindowmgr guiwmgrhg3d guifontmgr guischememgr eventController uniqueName)++freeGUI :: GUISystem -> IO ()+freeGUI gs = return ()++keyscanToScancode :: EnumSDLScancode -> Maybe Int+keyscanToScancode keyscan = if out == KeyMediaSelect then Nothing else (Just (fromIntegral (fromEnum out))) where+ out = case keyscan of+ SDL_SCANCODE_RETURN -> KeyReturn+ SDL_SCANCODE_ESCAPE -> KeyEscape+ SDL_SCANCODE_BACKSPACE -> KeyBackspace+ SDL_SCANCODE_TAB -> KeyTab+ SDL_SCANCODE_INSERT -> KeyInsert+ SDL_SCANCODE_HOME -> KeyHome+ SDL_SCANCODE_PAGEUP -> KeyPageUp+ SDL_SCANCODE_DELETE -> KeyDelete+ SDL_SCANCODE_END -> KeyEnd + SDL_SCANCODE_PAGEDOWN -> KeyPageDown+ SDL_SCANCODE_RIGHT -> KeyArrowRight+ SDL_SCANCODE_LEFT -> KeyArrowLeft+ SDL_SCANCODE_DOWN -> KeyArrowDown+ SDL_SCANCODE_UP ->KeyArrowUp+ _ -> KeyMediaSelect -- misused as Nothing indicator+ + +_injectKeyUp guiroot keycode = do + case keyscanToScancode keycode of+ Nothing -> return False+ Just scancode -> System.injectKeyUp guiroot scancode++_injectKeyDown guiroot keycode = do + case keyscanToScancode keycode of+ Nothing -> return False+ Just scancode -> System.injectKeyDown guiroot scancode++-- keypressInject++-- | injects key presses into the CEGUI engine, used internally+injectWinEventToGUI :: GUISystem -> SDLEvent -> IO ()+injectWinEventToGUI guis evt = do+ + let guiroot = guiRoot guis+ case evt of+ EvtText ts window text -> System.injectChar guiroot (fromEnum (text !! 0))+ EvtKeyUp ts window keyscan keycode keymode -> _injectKeyUp guiroot keyscan+ EvtKeyDown ts window keyscan keycode keymode -> _injectKeyDown guiroot keyscan+ EvtMouseButtonUp ts window mid button x y -> do+ case button of+ SDLButtonLeft -> System.injectMouseButtonUp guiroot CEGUIButton.MouseLeftButton+ SDLButtonRight -> System.injectMouseButtonUp guiroot CEGUIButton.MouseRightButton+ SDLButtonMiddle -> System.injectMouseButtonUp guiroot CEGUIButton.MouseMiddleButton+ _ -> return True+ EvtMouseButtonDown ts window mid button x y -> do+ case button of+ SDLButtonLeft -> System.injectMouseButtonDown guiroot CEGUIButton.MouseLeftButton+ SDLButtonRight -> System.injectMouseButtonDown guiroot CEGUIButton.MouseRightButton+ SDLButtonMiddle -> System.injectMouseButtonDown guiroot CEGUIButton.MouseMiddleButton+ _ -> return True+ EvtMouseMotion ts window mid x y rx ry -> CEGUISystem.injectMousePosition guiroot (fromIntegral x) (fromIntegral y)+ _ -> return True+ + return () + +-- | register a GUI Event, for later retrieval+registerGUIEvent :: GUISystem + -> GUIElement a -- ^ GUI Element from which event is registered+ -> String -- ^ event name, for which registration is done+ -> String -- ^ identifier, with which event is identified later on+ -> IO ()+registerGUIEvent guis (GUIElement el _) eventToRegister registrationTag = do+ EvtSF.subscribeScriptedEvent el eventToRegister registrationTag+ +data GUIEvent = GUIEvent String String (GUIElement ())++instance Show GUIEvent where+ show (GUIEvent str1 str2 _) = "GUI Event - " ++ str1 ++ " " ++ str2++pollGUIEvent :: GUISystem -> IO (Maybe GUIEvent)+pollGUIEvent guis = do+ let eventController = guiEventController guis+ processEvents <- HG3DEventController.eventsAvailable eventController+ if processEvents+ then do+ (name, sender, window) <- HG3DEventController.popEvent eventController+ let evt = GUIEvent name sender (GUIElement window ())+ return $ Just evt+ else return Nothing++injectGUITimeDelta :: GUISystem -> GameTime -> IO ()+injectGUITimeDelta guis gtime = do+ CEGUISystem.injectTimePulse (guiRoot guis) ((fromIntegral . msec) gtime)+ return ()++notifyDisplaySizeChanged :: GUISystem -> Float -> Float -> IO ()+notifyDisplaySizeChanged guis width height = do+ WindowSF.setNewWindowSize (guiRoot guis) width height+ return ()++type GUIElementProperty a b = (GUIElement a -> IO b, GUIElement a -> b -> IO ())++(=:) :: (GUIElementProperty a b) -> b -> (GUIElement a -> IO ())+(=:) prop val = (\val' guiel -> (snd prop) guiel val') val ++setP :: GUIElement a -> [GUIElement a -> IO ()] -> IO [()]+setP guiel ps = sequence $ fmap (\f -> f guiel) ps++getP :: GUIElement a -> GUIElementProperty a b -> IO b+getP guiel p = (fst p) guiel+
+ HGamer3D/GUI/Internal/Form.hs view
@@ -0,0 +1,360 @@+{-# OPTIONS_HADDOCK hide #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2013 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- GUI/Internal/Form.hs++-- |Form functionality of the GUI. Implementation module with internal data structures exposed. Public API in HGamer3D.GUI.++module HGamer3D.GUI.Internal.Form+where++import HGamer3D.GUI.Internal.Base+import HGamer3D.GUI.Internal.Widgets+import HGamer3D.GUI.Internal.Properties++import HGamer3D.GUI.Schema.Widget+import HGamer3D.GUI.Schema.Layout+import HGamer3D.GUI.Schema.Form+import HGamer3D.GUI.Schema.GUIDim++import Data.Maybe+import Control.Monad++ +{- ----------------------------------------------------------------+ Functions for ECS API+ ---------------------------------------------------------------- -}++data GUIEngineDataWidget = GEDButton GUIButton String+ | GEDRadioButton GUIRadioButton String+ | GEDCheckBox GUICheckBox String+ | GEDComboBox GUIComboBox String+ | GEDListBox GUIListBox String+ | GEDSpinner GUISpinner String+ | GEDSlider GUISlider String+ | GEDEditText GUIEditText String+ | GEDMultilineText GUIMultilineText String+ +data GUIEngineDataLayout = GEDHLayout GUIHLayout+ | GEDVLayout GUIVLayout+ | GEDGridLayout GUIGridLayout+ | GEDWindow GUIWindow++data GUIEngineData = GUIEngineData GUIEngineDataElement Form++data GUIEngineDataElement = GEDSingleElement GUIEngineDataWidget+ | GEDCombinedElement GUIEngineDataLayout [GUIEngineDataElement]++-- there is a big distinction in the typesystem between a type which is not known to the function but it is assumed it has a specific type on calling (typevariable a) and the return value of being any possible type which is requested by outer world type (typevariable b). So _undef is polymorphic in its out value, this only can be accomplished by undef!+_toUndef :: GUIElement a -> GUIElement b+_toUndef (GUIElement window _) = (GUIElement window undefined)++_getWidget :: GUIEngineDataElement -> GUIElement a+_getWidget (GEDSingleElement (GEDButton w _)) = _toUndef w+_getWidget (GEDSingleElement (GEDRadioButton w _)) = _toUndef w+_getWidget (GEDSingleElement (GEDCheckBox w _)) = _toUndef w+_getWidget (GEDSingleElement (GEDComboBox w _)) = _toUndef w+_getWidget (GEDSingleElement (GEDListBox w _)) = _toUndef w+_getWidget (GEDSingleElement (GEDSpinner w _)) = _toUndef w+_getWidget (GEDSingleElement (GEDSlider w _)) = _toUndef w+_getWidget (GEDSingleElement (GEDEditText w _)) = _toUndef w+_getWidget (GEDSingleElement (GEDMultilineText w _)) = _toUndef w++_getWidget (GEDCombinedElement (GEDHLayout l) _) = _toUndef l+_getWidget (GEDCombinedElement (GEDVLayout l) _) = _toUndef l+_getWidget (GEDCombinedElement (GEDGridLayout l) _) = _toUndef l+_getWidget (GEDCombinedElement (GEDWindow l) _) = _toUndef l++_createLayout :: GUISystem -> Layout -> String -> IO GUIEngineDataLayout+_createLayout guis layout typename = do+ case layout of+ VerticalLayout props -> vLayout guis (_createProps props) >>= return . GEDVLayout+ HorizontalLayout props -> hLayout guis (_createProps props) >>= return . GEDHLayout+ GridLayout x y props -> gridLayout guis (_createProps props) >>= return . GEDGridLayout+ Window name props -> window guis typename (_createProps props) >>= return . GEDWindow++-- the following routine assume same typename for new layout, it only modify props+_updateLayoutProps :: GUIEngineDataLayout -> Layout -> IO ()+_updateLayoutProps edata layout = do+ -- check assumptions+ case (edata, layout) of+ (GEDHLayout hLayout, HorizontalLayout props) -> setP hLayout (_createProps props)+ (GEDVLayout vLayout, VerticalLayout props) -> setP vLayout (_createProps props)+ (GEDGridLayout gLayout, GridLayout x y props) -> setP gLayout (_createProps props)+ (GEDWindow window, Window n props) -> setP window (_createProps props)+ _ -> error "HGamer3D.GUI.Internal.Form._updateLayoutProps: update parameters not matching!"+ return ()+ +_createProps' :: (WidgetProperty -> GUIElement a -> IO ()) -> [WidgetProperty] -> [GUIElement a -> IO ()]+_createProps' addOn props = + let oneProp prop = case prop of+ XPos gd -> pX =: gd+ YPos gd -> pY =: gd+ Width gd -> pWidth =: gd+ Height gd -> pHeight =: gd+ Visible v -> pVisible =: v+ Alpha f -> pAlpha =: f+ Text t -> pText =: t+ Margin m -> pMargin =: m+ Tooltip t -> pTooltip =: t+ _ -> addOn prop+ in map oneProp props++_createProps = _createProps' (\w -> (const (return ())))++_createPropsCB :: [WidgetProperty] -> [GUIComboBox -> IO ()]+_createPropsCB props =+ let addOn prop = case prop of+ TextChoice tc -> pTextChoice =: tc+ _ -> const (return ())+ in _createProps' addOn props++_createPropsLB :: [WidgetProperty] -> [GUIListBox -> IO ()]+_createPropsLB props =+ let addOn prop = case prop of+ TextSelection ts -> pTextSelection =: ts+ _ -> const (return ())+ in _createProps' addOn props++_createPropsHV :: [WidgetProperty] -> [GUIHasValue a -> IO ()]+_createPropsHV props =+ let addOn prop = case prop of+ Value v -> pValue =: v+ _ -> const (return ())+ in _createProps' addOn props++_createPropsHS :: [WidgetProperty] -> [GUIHasSelection a -> IO ()]+_createPropsHS props =+ let addOn prop = case prop of+ Selected s -> pSelected =: s+ _ -> const (return ())+ in _createProps' addOn props++_createWidget :: GUISystem -> Widget -> String -> IO GUIEngineDataElement+_createWidget guis widget typename = do+ case widget of+ Button name props -> do+ w <- button guis typename (_createProps props)+ registerGUIEvent guis w "Clicked" name+ return (GEDSingleElement (GEDButton w name))+ RadioButton name props -> do+ w <- radioButton guis typename (_createPropsHS props)+ registerGUIEvent guis w "SelectStateChanged" name+ return (GEDSingleElement (GEDRadioButton w name))+ CheckBox name props -> do+ w <- checkBox guis typename (_createPropsHS props)+ registerGUIEvent guis w "CheckStateChanged" name+ return (GEDSingleElement (GEDCheckBox w name))+ ComboBox name props -> do+ w <- comboBox guis typename (_createPropsCB props)+ registerGUIEvent guis w "ListSelectionAccepted" name+ return (GEDSingleElement (GEDComboBox w name))+ ListBox name props -> do+ w <- listBox guis typename (_createPropsLB props)+ registerGUIEvent guis w "ItemSelectionChanged" name+ return (GEDSingleElement (GEDListBox w name))+ Spinner name props -> do+ w <- spinner guis typename (_createPropsHV props)+ registerGUIEvent guis w "ValueChanged" name+ return (GEDSingleElement (GEDSpinner w name))+ Slider name props -> do+ w <- slider guis typename (_createPropsHV props)+ registerGUIEvent guis w "ValueChanged" name+ return (GEDSingleElement (GEDSlider w name))+ EditText name props -> do+ w <- editText guis typename (_createProps props)+ registerGUIEvent guis w "TextAccepted" name+ registerGUIEvent guis w "TextChanged" name+ return (GEDSingleElement (GEDEditText w name))+ MultilineText name props -> do+ w <- multilineText guis typename (_createProps props)+ registerGUIEvent guis w "TextAccepted" name+ registerGUIEvent guis w "TextChanged" name+ return (GEDSingleElement (GEDMultilineText w name))++_updateWidgetProps :: GUIEngineDataElement -> Widget -> IO ()+_updateWidgetProps edata widget = do+ case (edata, widget) of+ (GEDSingleElement (GEDButton w _), Button name props) -> setP w (_createProps props)+ (GEDSingleElement (GEDRadioButton w _), RadioButton name props) -> setP w (_createPropsHS props)+ (GEDSingleElement (GEDCheckBox w _), CheckBox name props) -> setP w (_createPropsHS props)+ (GEDSingleElement (GEDComboBox w _), ComboBox name props) -> setP w (_createPropsCB props)+ (GEDSingleElement (GEDListBox w _), ListBox name props) -> setP w (_createPropsLB props)+ (GEDSingleElement (GEDSpinner w _), Spinner name props) -> setP w (_createPropsHV props)+ (GEDSingleElement (GEDSlider w _), Slider name props) -> setP w (_createPropsHV props)+ (GEDSingleElement (GEDEditText w _), EditText name props) -> setP w (_createProps props)+ (GEDSingleElement (GEDMultilineText w _), MultilineText name props) -> setP w (_createProps props)+ _ -> error "HGamer3D.GUI.Internal.Form._updateWidgetProps: update parameters not matching!"+ return ()++createForm :: GUISystem -> Form -> IO GUIEngineData+createForm guis form = do+ let (Form typename formcontent) = form+ + let createFormContent formcontent = do+ case formcontent of+ WidgetFC widget -> _createWidget guis widget typename+ LayoutFC layout formList -> do+ layoutW <- _createLayout guis layout typename+ widgetsW <- mapM createFormContent formList+ let cl = GEDCombinedElement layoutW widgetsW+ mapM (\f -> addChildGuiEl (_getWidget cl) (_getWidget f)) widgetsW+ return $ cl+ + formW <- createFormContent formcontent+ addGuiElToDisplay guis (_getWidget formW)+ return $ GUIEngineData formW form++getFormValues :: GUIEngineData -> IO [(String, FormValue)]+getFormValues (GUIEngineData elem form) = do++ let addTo oldList n con = return . (flip (:)) oldList . (,) n . con+ + let getItem oldList eitem = case eitem of+ GEDSingleElement widget -> case widget of+ GEDButton w n -> return ( (n, FVE) : oldList)+ GEDRadioButton w n -> getP w pSelected >>= addTo oldList n FVB+ GEDCheckBox w n -> getP w pSelected >>= addTo oldList n FVB+ GEDComboBox w n -> getP w pText >>= addTo oldList n FVS+ GEDListBox w n -> getP w pTextSelection >>= addTo oldList n FVTS+ GEDSpinner w n -> getP w pValue >>= addTo oldList n FVF+ GEDSlider w n -> getP w pValue >>= addTo oldList n FVF+ GEDEditText w n -> getP w pText >>= addTo oldList n FVS+ GEDMultilineText w n -> getP w pText >>= addTo oldList n FVS++ let foldEitems oldList eitem = case eitem of+ GEDSingleElement widget -> getItem oldList eitem+ GEDCombinedElement _ widgetList -> foldM foldEitems oldList widgetList+ + foldEitems [] elem++_getFormStructure :: Form -> [String]+_getFormStructure (Form typename content) = + + let getItem oldList eitem = case eitem of+ WidgetFC widget -> case widget of+ Button n _ -> ("Button/" ++ n) : oldList+ RadioButton n _ -> ("RadioButton/" ++ n) : oldList+ CheckBox n _ -> ("CheckBox/" ++ n) : oldList+ ComboBox n _ -> ("ComboBox/" ++ n) : oldList+ ListBox n _ -> ("ListBox/" ++ n) : oldList+ Spinner n _ -> ("Spinner/" ++ n) : oldList+ Slider n _ -> ("Slider/" ++ n) : oldList+ EditText n _ -> ("EditText/" ++ n) : oldList+ MultilineText n _ -> ("MultilineText/" ++ n) : oldList+ LayoutFC layout itemList -> let+ subList = foldl getItem [] itemList+ in case layout of+ VerticalLayout props -> ["VLStart"] ++ subList ++ ["VLEnd"] ++ oldList+ HorizontalLayout props -> ["HLStart"] ++ subList ++ ["HLEnd"] ++ oldList+ GridLayout _ _ props -> ["GridStart"] ++ subList ++ ["GridEnd"] ++ oldList+ Window n props -> ["WStart"] ++ subList ++ ["WEnd"] ++ oldList+ + in getItem [typename] content+++setFormValues :: GUIEngineData -> [(String, FormValue)] -> IO ()+setFormValues (GUIEngineData elem form) valueList = do++ let filterItemSet w n prop valueList = do+ case filter (\(name, value) -> name == n) valueList of+ [] -> return ()+ ((n', v') : _) -> do+ setP w [prop v']+ return ()+ + let setItem valueList eitem = case eitem of+ GEDSingleElement widget -> case widget of+ GEDButton w n -> return ()+ GEDRadioButton w n -> filterItemSet w n (\v -> let (FVB v') = v in pSelected =: v') valueList+ GEDCheckBox w n -> filterItemSet w n (\v -> let (FVB v') = v in pSelected =: v') valueList+ GEDComboBox w n -> filterItemSet w n (\v -> let (FVS v') = v in pText =: v') valueList+ GEDListBox w n -> filterItemSet w n (\v -> let (FVTS v') = v in pTextSelection =: v') valueList+ GEDSpinner w n -> filterItemSet w n (\v -> let (FVF v') = v in pValue =: v') valueList+ GEDSlider w n -> filterItemSet w n (\v -> let (FVF v') = v in pValue =: v') valueList+ GEDEditText w n -> filterItemSet w n (\v -> let (FVS v') = v in pText =: v') valueList+ GEDMultilineText w n -> filterItemSet w n (\v -> let (FVS v') = v in pText =: v') valueList+ GEDCombinedElement _ widgetList -> mapM (setItem valueList) widgetList >> return ()++ setItem valueList elem+ return ()++removeForm :: GUISystem -> GUIEngineData -> IO ()+removeForm guis form = do+ let (GUIEngineData elem schema) = form+ + -- first detach from screen+ removeGuiElFromDisplay guis (_getWidget elem)++ -- then delete the elements in order+ let deleteSingleItem elem = case elem of+ GEDSingleElement w -> deleteGuiEl guis (_getWidget elem)+ GEDCombinedElement layout widgetList -> do+ -- remove childs from parent, then delete+ mapM (\el -> removeChildGuiEl (_getWidget elem) (_getWidget el)) widgetList+ mapM deleteSingleItem widgetList+ deleteGuiEl guis (_getWidget elem)++ deleteSingleItem elem+ return ()+++-- update form with same structure, apply properties again for all elements, which are different+_updateFormElement :: GUISystem -> GUIEngineDataElement -> FormContent -> FormContent -> IO ()+_updateFormElement guis elem oldFC newFC = do+ case (elem, oldFC, newFC) of+ (GEDSingleElement w, WidgetFC (Button _ oldProps), WidgetFC wid@(Button _ newProps)) -> do+ if oldProps /= newProps then _updateWidgetProps elem wid else return ()+ (GEDSingleElement w, WidgetFC (RadioButton _ oldProps), WidgetFC wid@(RadioButton _ newProps)) -> do+ if oldProps /= newProps then _updateWidgetProps elem wid else return ()+ (GEDSingleElement w, WidgetFC (CheckBox _ oldProps), WidgetFC wid@(CheckBox _ newProps)) -> do+ if oldProps /= newProps then _updateWidgetProps elem wid else return ()+ (GEDSingleElement w, WidgetFC (ComboBox _ oldProps), WidgetFC wid@(ComboBox _ newProps)) -> do+ if oldProps /= newProps then _updateWidgetProps elem wid else return ()+ (GEDSingleElement w, WidgetFC (ListBox _ oldProps), WidgetFC wid@(ListBox _ newProps)) -> do+ if oldProps /= newProps then _updateWidgetProps elem wid else return ()+ (GEDSingleElement w, WidgetFC (Spinner _ oldProps), WidgetFC wid@(Spinner _ newProps)) -> do+ if oldProps /= newProps then _updateWidgetProps elem wid else return ()+ (GEDSingleElement w, WidgetFC (Slider _ oldProps), WidgetFC wid@(Slider _ newProps)) -> do+ if oldProps /= newProps then _updateWidgetProps elem wid else return ()+ (GEDSingleElement w, WidgetFC (EditText _ oldProps), WidgetFC wid@(EditText _ newProps)) -> do+ if oldProps /= newProps then _updateWidgetProps elem wid else return ()+ (GEDSingleElement w, WidgetFC (MultilineText _ oldProps), WidgetFC wid@(MultilineText _ newProps)) -> do+ if oldProps /= newProps then _updateWidgetProps elem wid else return ()+ (GEDCombinedElement layout elems, LayoutFC oldLayout oldContentList, LayoutFC newLayout newContentList) -> do+ if oldLayout /= newLayout then _updateLayoutProps layout newLayout else return ()+ mapM (\(elem, oldContent, newContent) -> _updateFormElement guis elem oldContent newContent) (zip3 elems oldContentList newContentList)+ return ()+ +++updateForm :: GUISystem -> GUIEngineData -> Form -> IO GUIEngineData+updateForm guis edata form = do+ -- check if different structure, then redo+ let ed@(GUIEngineData elem oldForm) = edata+ if (_getFormStructure oldForm) /= (_getFormStructure form) then do+ removeForm guis ed+ createForm guis form+ -- if structure is the same, only update properties+ else do+ let (Form typename content) = form+ let (Form typename oldContent) = oldForm+ _updateFormElement guis elem oldContent content+ return edata+
+ HGamer3D/GUI/Internal/Properties.hs view
@@ -0,0 +1,201 @@+{-# OPTIONS_HADDOCK hide #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- GUI/Internal/Properties.hs++-- |Properties functionality of the GUI. Implementation module with internal data structures exposed. Public API in HGamer3D.GUI.++module HGamer3D.GUI.Internal.Properties+where+++import GHC.Ptr+import Data.List.Split+import Control.Monad++import HGamer3D.Data+import HGamer3D.Util++import HGamer3D.GUI.Internal.Base+import HGamer3D.GUI.Internal.Widgets++import HGamer3D.Data.HG3DClass+import qualified HGamer3D.Bindings.CEGUI.ClassHG3DWindowStaticFunctions as WinStat+import qualified HGamer3D.Bindings.CEGUI.ClassWindow as Win+import qualified HGamer3D.Bindings.CEGUI.ClassUDim as Ud+import HGamer3D.GUI.Schema.GUIDim+++type GUIButtonProperty b = GUIElementProperty GEButton b+type GUIEditTextProperty b = GUIElementProperty GEEditText b++type GUIHasSelectionProperty a b = GUIElementProperty a b+type GUIRadioButtonProperty b = GUIHasSelectionProperty GERadioButton b+type GUICheckBoxProperty b = GUIHasSelectionProperty GECheckBox b++type GUIHasValueProperty a b = GUIElementProperty a b+type GUISliderProperty b = GUIHasValueProperty GESlider b+type GUISpinnerProperty b = GUIHasValueProperty GESpinner b++type GUIListBoxProperty b = GUIElementProperty GEListBox b+type GUIComboBoxProperty b = GUIElementProperty GEComboBox b++_stringProp :: String -> GUIElementProperty a String+_stringProp name = ( + (flip getGuiElProperty) name, + (\pname guiel val -> setGuiElProperty guiel pname val) name+ )++_toBool :: String -> Bool+_toBool instr = case instr of+ "True" -> True+ "False" -> False+ _ -> False++_fromBool :: Bool -> String+_fromBool inb = case inb of+ True -> "True"+ False -> "False"+ _ -> "False"++_toFloat :: String -> Float+_toFloat = read++_fromFloat :: Float -> String+_fromFloat = show++_boolProp :: String -> GUIElementProperty a Bool+_boolProp name = ( + ((flip getGuiElProperty) name) >=> return . _toBool, + ((\pname guiel val -> setGuiElProperty guiel pname (_fromBool val)) name)+ )++_floatProp :: String -> GUIElementProperty a Float+_floatProp name = ( + ((flip getGuiElProperty) name) >=> return . _toFloat, + ((\pname guiel val -> setGuiElProperty guiel pname (_fromFloat val)) name)+ )++pText :: GUIElementProperty a String+pText = _stringProp "Text"++pDisabled :: GUIElementProperty a Bool+pDisabled = _boolProp "Disabled"++pVisible :: GUIElementProperty a Bool+pVisible = _boolProp "Visible"++pAlpha :: GUIElementProperty a Float+pAlpha = _floatProp "Alpha"++pAlwaysOnTop :: GUIElementProperty a Bool+pAlwaysOnTop = _boolProp "AlwaysOnTop"++pTooltip :: GUIElementProperty a String+pTooltip = _stringProp "Tooltip"++pFont :: GUIElementProperty a String+pFont = _stringProp "Font"++pX :: GUIElementProperty a GUIDim+pX = (getProp, setProp) where+ getProp (GUIElement window _) = do+ ud <- Win.getXPosition window+ scale <- WinStat.udScale ud+ offset <- WinStat.udOffset ud+ return $ GUIDim scale offset+ setProp (GUIElement window _) (GUIDim scale offset) = do+ ud <- Ud.new scale offset+ Win.setXPosition window ud+ Ud.delete ud+ return ()++pY :: GUIElementProperty a GUIDim+pY = (getProp, setProp) where+ getProp (GUIElement window _) = do+ ud <- Win.getYPosition window+ scale <- WinStat.udScale ud+ offset <- WinStat.udOffset ud+ return $ GUIDim scale offset+ setProp (GUIElement window _) (GUIDim scale offset) = do+ ud <- Ud.new scale offset+ Win.setYPosition window ud+ Ud.delete ud+ return ()++pWidth :: GUIElementProperty a GUIDim+pWidth = (getProp, setProp) where+ getProp (GUIElement window _) = do+ ud <- WinStat.getWindowWidth window+ scale <- WinStat.udScale ud+ offset <- WinStat.udOffset ud+ Ud.delete ud+ return $ GUIDim scale offset+ setProp (GUIElement window _) (GUIDim scale offset) = do+ ud <- Ud.new scale offset+ Win.setWidth window ud+ Ud.delete ud+ return ()++pHeight :: GUIElementProperty a GUIDim+pHeight = (getProp, setProp) where+ getProp (GUIElement window _) = do+ ud <- WinStat.getWindowHeight window+ scale <- WinStat.udScale ud+ offset <- WinStat.udOffset ud+ Ud.delete ud+ return $ GUIDim scale offset+ setProp (GUIElement window _) (GUIDim scale offset) = do+ ud <- Ud.new scale offset+ Win.setHeight window ud+ Ud.delete ud+ return ()++pMargin :: GUIElementProperty a GUIDim+pMargin = (getProp, setProp) where+ getProp (GUIElement window _) = do+ ud <- WinStat.getWindowMargin window+ scale <- WinStat.udScale ud+ offset <- WinStat.udOffset ud+ Ud.delete ud+ return $ GUIDim scale offset+ setProp (GUIElement window _) (GUIDim scale offset) = do+ ud <- Ud.new scale offset+ WinStat.setWindowMargin window ud+ Ud.delete ud+ return ()++pSelected :: GUIHasSelectionProperty a Bool+pSelected = _boolProp "Selected"++pValue :: GUIHasValueProperty a Float+pValue = _floatProp "CurrentValue"++pTextSelection :: GUIListBoxProperty [(String, Bool)]+pTextSelection = (listboxStatus, listboxInitialize)++pTextChoice :: GUIComboBoxProperty [String]+pTextChoice = (getProp, setProp) where+ setProp w strings = do+ comboboxRemoveAllText w+ mapM (comboboxAddText w) strings+ return ()+ getProp w = do+ comboboxStatus w+
+ HGamer3D/GUI/Internal/Widgets.hs view
@@ -0,0 +1,345 @@+{-# OPTIONS_HADDOCK hide #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2013 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- GUI/Internal/Widgets.hs++-- |Widget functionality of the GUI. Implementation module with internal data structures exposed. Public API in HGamer3D.GUI.++module HGamer3D.GUI.Internal.Widgets+where++import HGamer3D.Bindings.CEGUI.ClassOgreRenderer as CEGUIOgreRenderer+import HGamer3D.Bindings.CEGUI.ClassSystem as CEGUISystem+import HGamer3D.Bindings.CEGUI.ClassSystemHG3D as CEGUISystemHG3D+import HGamer3D.Bindings.CEGUI.ClassWindowManagerHG3D as CEGUIWindowManagerHG3D+import HGamer3D.Bindings.CEGUI.ClassWindowManager as CEGUIWindowManager+import HGamer3D.Bindings.CEGUI.ClassResourceProvider as CEGUIResourceProvider+import HGamer3D.Bindings.CEGUI.ClassDefaultResourceProvider as CEGUIDefaultResourceProvider+import HGamer3D.Bindings.CEGUI.ClassImageset as CEGUIImageset+import HGamer3D.Bindings.CEGUI.ClassFont as CEGUIFont+import HGamer3D.Bindings.CEGUI.ClassScheme as CEGUIScheme+import HGamer3D.Bindings.CEGUI.ClassWidgetLookManager as CEGUIWidgetLookManager+import HGamer3D.Bindings.CEGUI.ClassScriptModule as CEGUIScriptModule+import HGamer3D.Bindings.CEGUI.ClassLogger as CEGUILogger+import HGamer3D.Bindings.CEGUI.EnumLoggingLevel+import HGamer3D.Bindings.CEGUI.EnumMouseButton as CEGUIButton+import HGamer3D.Bindings.CEGUI.ClassFontManager as CEGUIFontManager+import HGamer3D.Bindings.CEGUI.ClassSchemeManager as CEGUISchemeManager+import HGamer3D.Bindings.CEGUI.ClassDefaultLogger as CEGUIDefaultLogger+import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController+import HGamer3D.Bindings.CEGUI.ClassWindowManagerHG3D as HG3DWindowManager+--import HGamer3D.Bindings.Ogre.ClassHG3DMessagePump as MessagePump+++import GHC.Ptr+import Data.List.Split+import Data.Maybe++import HGamer3D.Data+import HGamer3D.Util++-- import HGamer3D.Internal.WinEvent++import HGamer3D.Bindings.CEGUI.ClassPtr+import HGamer3D.Bindings.CEGUI.Utils++import HGamer3D.Bindings.CEGUI.ClassWindow as Window+import HGamer3D.Bindings.CEGUI.ClassWindowManager as WindowManager+import HGamer3D.Bindings.CEGUI.ClassWindowManagerHG3D as WindowManagerHG3D+import HGamer3D.Bindings.CEGUI.ClassWindow as Window+import HGamer3D.Bindings.CEGUI.ClassSystem as System+import HGamer3D.Bindings.CEGUI.ClassSystemHG3D as SystemHG3D+import HGamer3D.Bindings.CEGUI.ClassPropertySet as PropertySet+import HGamer3D.Bindings.CEGUI.ClassHG3DEventStaticFunctions as EvtSF +import HGamer3D.Bindings.CEGUI.ClassHG3DListboxStaticFunctions as ListboxSF+import HGamer3D.Bindings.CEGUI.ClassHG3DWindowStaticFunctions as WindowSF+import HGamer3D.Bindings.CEGUI.ClassListbox as Listbox+import HGamer3D.Bindings.CEGUI.ClassListboxItem as ListboxItem+import HGamer3D.Bindings.CEGUI.ClassCombobox as Combobox+import HGamer3D.Bindings.CEGUI.EnumKeyScan++import HGamer3D.Bindings.CEGUI.ClassHG3DEventStaticFunctions as EvtSF ++import HGamer3D.Bindings.CEGUI.EnumMouseButton as CEGUIButton++import HGamer3D.GUI.Internal.Base+-- import HGamer3D.GUI.Internal.Properties+import HGamer3D.Data.HG3DClass++import qualified HGamer3D.GUI.Schema.Widget as ScW+import qualified HGamer3D.GUI.Schema.Layout as ScL+import qualified HGamer3D.GUI.Schema.Form as ScF++-- | GUI Element, Sybtype Button+type GUIButton = GUIElement GEButton++-- | GUI Elements, which have a selection+type GUIHasSelection a = GUIElement a++-- | GUI Element, Sybtype CheckBox+type GUICheckBox = GUIHasSelection GECheckBox++-- | GUI Element, Sybtype RadioButton+type GUIRadioButton = GUIHasSelection GERadioButton++-- | GUI Element, Sybtype EditText+type GUIEditText = GUIElement GEEditText++-- | GUI Element, Sybtype MultilineText+type GUIMultilineText = GUIElement GEMultilineText++-- | GUI Element, Sybtype Listbox+type GUIListBox = GUIElement GEListBox++-- | GUI Element, Sybtype Combobox+type GUIComboBox = GUIElement GEComboBox++-- | GUI Element, which have a value+type GUIHasValue a = GUIElement a++-- | GUI Element, Sybtype Slider+type GUISlider = GUIHasValue GESlider++-- | GUI Element, Sybtype Spinner+type GUISpinner = GUIHasValue GESpinner++-- | GUI Element, Subtype FrameWindow+type GUIWindow = GUIElement GEWindow++-- | GUI Element, which is a layout container+type GUILayout a = GUIElement a++-- | GUI Element, vertical layout container+type GUIVLayout = GUILayout GEVLayout++-- | GUI Element, horizontal layout container+type GUIHLayout = GUILayout GEHLayout++-- | GUI Element, grid layout container+type GUIGridLayout = GUILayout GEGridLayout+++-- | get Type of GUI element as string+typeOfGuiEl :: GUIElement a -- ^ GUI element to enable+ -> IO String+typeOfGuiEl (GUIElement window _) = do+ Window.getType window++toGuiType :: String -> b -> GUIElement a -> IO (GUIElement b)+toGuiType typestr cons guiel@(GUIElement window _) = do+ tp <- typeOfGuiEl guiel+ -- CEGUI Types as String have the format "WindowLook/Button" for example+ -- sometimes they have no "xyzLook" part and no /+ let tp' = last (splitOn "/" tp) + let guiel' = case tp' of+ typestr -> GUIElement window cons+ _ -> error ("HGamer3D.GUI.Internal.Widgets.toGuiType: " ++ typestr ++ " not found!")+ return guiel'++_createElement :: String -> (GUIElement a -> IO (GUIElement b)) -> GUISystem -> String -> [GUIElement b -> IO ()] -> IO (GUIElement b)+_createElement elType convFunc guis style proplist = do+ let winMgr = guiWindowManager guis+ let uname = guiUniqueName guis+ elName <- nextUniqueName uname+ window <- WindowManager.createWindow winMgr (style ++ "/" ++ elType) elName+ el <- convFunc (GUIElement window undefined)+ -- set the properties+ setP el proplist + return el++_createElement' :: String -> (GUIElement a -> IO (GUIElement b)) -> GUISystem -> [GUIElement b -> IO ()] -> IO (GUIElement b)+_createElement' elType convFunc guis proplist = do+ let winMgr = guiWindowManager guis+ let uname = guiUniqueName guis+ elName <- nextUniqueName uname+ window <- WindowManager.createWindow winMgr (elType) elName+ el <- convFunc (GUIElement window undefined)+ -- set the properties+ setP el proplist + return el++button :: GUISystem -> String -> [GUIButton -> IO ()] -> IO GUIButton+button = _createElement "Button" toButton++radioButton :: GUISystem -> String -> [GUIRadioButton -> IO ()] -> IO GUIRadioButton+radioButton = _createElement "RadioButton" toRadioButton++checkBox :: GUISystem -> String -> [GUICheckBox -> IO ()] -> IO GUICheckBox+checkBox = _createElement "Checkbox" toCheckBox++editText :: GUISystem -> String -> [GUIEditText -> IO ()] -> IO GUIEditText+editText = _createElement "Editbox" toEditText++multilineText :: GUISystem -> String -> [GUIMultilineText -> IO ()] -> IO GUIMultilineText+multilineText = _createElement "MultiLineEditbox" toMultilineText++comboBox :: GUISystem -> String -> [GUIComboBox -> IO ()] -> IO GUIComboBox+comboBox = _createElement "Combobox" toComboBox++listBox :: GUISystem -> String -> [GUIListBox -> IO ()] -> IO GUIListBox+listBox = _createElement "Listbox" toListBox++spinner :: GUISystem -> String -> [GUISpinner -> IO ()] -> IO GUISpinner+spinner = _createElement "Spinner" toSpinner++slider :: GUISystem -> String -> [GUISlider -> IO ()] -> IO GUISlider+slider = _createElement "Slider" toSlider++window :: GUISystem -> String -> [GUIWindow -> IO ()] -> IO GUIWindow+window = _createElement "FrameWindow" toWindow++hLayout :: GUISystem -> [GUIHLayout -> IO ()] -> IO GUIHLayout+hLayout = _createElement' "HorizontalLayoutContainer" toHLayout++vLayout :: GUISystem -> [GUIVLayout -> IO ()] -> IO GUIVLayout+vLayout = _createElement' "VerticalLayoutContainer" toVLayout++gridLayout :: GUISystem -> [GUIGridLayout -> IO ()] -> IO GUIGridLayout+gridLayout = _createElement' "GridLayoutContainer" toGridLayout++toButton = toGuiType "Button" GEButton+toRadioButton = toGuiType "RadioButton" GERadioButton+toCheckBox = toGuiType "Checkbox" GECheckBox++toEditText = toGuiType "Editbox" GEEditText+toMultilineText = toGuiType "MultiLineEditbox" GEMultilineText++toComboBox = toGuiType "Combobox" GEComboBox+toListBox = toGuiType "Listbox" GEListBox++toSlider = toGuiType "Slider" GESlider+toSpinner = toGuiType "Spinner" GESpinner++toHLayout = toGuiType "HorizontalLayoutContainer" GEHLayout+toVLayout = toGuiType "VerticalLayoutContainer" GEVLayout+toGridLayout = toGuiType "GridLayoutContainer" GEGridLayout+toWindow = toGuiType "FrameWindow" GEWindow++findElement :: (GUIElement a -> IO (GUIElement b))+ ->String + -> GUIElement a + -> IO (GUIElement b)+findElement toNewType name topel = do+ mFound <- findChildGuiElRecursive topel name+ el <- toNewType (fromJust mFound)+ return el ++findButton = findElement toButton+findRadioButton = findElement toRadioButton+findCheckBox = findElement toCheckBox+findEditText = findElement toEditText+findMultilineText = findElement toMultilineText+findComboBox = findElement toComboBox+findListBox = findElement toListBox+findSpinner = findElement toSpinner+findSlider = findElement toSlider++-- | add one line of text as a selectable entry to a combobox+comboboxAddText :: GUIComboBox -- ^ GUI element, needs to be a combobox+ -> String -- ^ the entry string to add+ -> IO ()+comboboxAddText (GUIElement window GEComboBox) itemname = do+ realcombo <- WindowSF.castWindowToCombobox window+ ListboxSF.comboboxAddItem realcombo itemname+ +-- | removes all lines of entries from a combobox+comboboxRemoveAllText :: GUIComboBox -- ^ the GUI elements, needs to be a combobox+ -> IO ()+comboboxRemoveAllText (GUIElement window GEComboBox) = do+ realcombo <- WindowSF.castWindowToCombobox window+ Combobox.resetList realcombo+ +comboboxStatus :: GUIComboBox -- ^ GUI element, needs to be a listbox+ -> IO [String] -- ^ list of entry, selected pairs+comboboxStatus (GUIElement window GEComboBox) = do+ realbox <- WindowSF.castWindowToCombobox window+ count <- Combobox.getItemCount realbox+ outlist <- mapM ( \ind -> do+ item <- Combobox.getListboxItemFromIndex realbox ind+ txt <- ListboxItem.getText item+ return txt+ ) [0..(count-1)]+ return outlist++-- | add one line of text as a selectable entry to a listbox+listboxAddText :: GUIListBox -- ^ GUI element, needs to be a listbox+ -> String -- ^ the entry string to add+ -> IO ()+listboxAddText (GUIElement window GEListBox) itemname = do+ reallistbox <- WindowSF.castWindowToListbox window+ ListboxSF.listboxAddItem reallistbox itemname+ +_getTextListOfItem reallistbox item list = do+ let (HG3DClass ptra ptrb) = item+ if ptra /= nullPtr then do+ txt <- ListboxItem.getText item+ let list' = list ++ [txt]+ item' <- Listbox.getNextSelected reallistbox item+ list'' <- _getTextListOfItem reallistbox item' list'+ return list''+ else do+ return list+ +listboxInitialize :: GUIListBox -- ^ GUI element, needs to be a listbox+ -> [(String, Bool)] -- ^ list of entry, selected pairs+ -> IO ()+listboxInitialize (GUIElement window GEListBox) pairs = do+ reallistbox <- WindowSF.castWindowToListbox window+ Listbox.resetList reallistbox+ mapM ( \((entry, selected), ind) -> do+ ListboxSF.listboxAddItem reallistbox entry+ item <- Listbox.getListboxItemFromIndex reallistbox ind+ ListboxItem.setSelected item selected+ return ()+ ) (zip pairs [0..])+ return ()+ +listboxStatus :: GUIListBox -- ^ GUI element, needs to be a listbox+ -> IO [(String, Bool)] -- ^ list of entry, selected pairs+listboxStatus (GUIElement window GEListBox) = do+ reallistbox <- WindowSF.castWindowToListbox window+ count <- Listbox.getItemCount reallistbox+ outlist <- mapM ( \ind -> do+ item <- Listbox.getListboxItemFromIndex reallistbox ind+ sel <- ListboxItem.isSelected item+ txt <- ListboxItem.getText item+ return (txt, sel)+ ) [0..(count-1)]+ return outlist+ ++-- | return the selected items as an array of strings+listboxGetSelectedText :: GUIListBox -- ^ the GUI element, needs to be a listbox+ -> IO [String] -- ^ the selected items as an array of strings+listboxGetSelectedText (GUIElement window GEListBox) = do+ reallistbox <- WindowSF.castWindowToListbox window+ item <- Listbox.getFirstSelectedItem reallistbox+ list <- _getTextListOfItem reallistbox item ([]::[String])+ return list+ +-- | removes all lines of entries from a listbox+listboxRemoveAllText :: GUIListBox -- ^ the GUI element, needs to be a listbox+ -> IO ()+listboxRemoveAllText (GUIElement window GEListBox) = do+ reallistbox <- WindowSF.castWindowToListbox window+ Listbox.resetList reallistbox+ +++
+ HGamer3D/GUI/Schema/Form.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/GUI/Schema/Form.hs++-- | Types which describe the GUI Form+module HGamer3D.GUI.Schema.Form+where++import Data.Typeable+import HGamer3D.Data as Dat+import HGamer3D.GUI.Schema.GUIDim+import HGamer3D.GUI.Schema.Widget+import HGamer3D.GUI.Schema.Layout++data Form = Form String FormContent deriving (Eq, Show, Typeable)++data FormContent = WidgetFC Widget+ | LayoutFC Layout [FormContent]+ deriving (Eq, Show, Typeable)+ +data FormValue = FVF Float+ | FVS String+ | FVTC [String] -- Text Choice+ | FVTS [(String, Bool)] -- Text Selection+ | FVB Bool+ | FVE -- Empty+ deriving (Eq, Show, Typeable)
+ HGamer3D/GUI/Schema/GUIDim.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/GUI/Schema/GUIDim.hs++-- | Types which describe the GUI Dimensions+module HGamer3D.GUI.Schema.GUIDim+where++import Data.Typeable+import HGamer3D.Data as Dat++data GUIDim = GUIDim {+ gdScale :: Float,+ gdOffset :: Float + } deriving (Eq, Show, Typeable)++data GUIVec2 = GUIVec2 {+ gv2X :: GUIDim,+ gv2Y :: GUIDim +}+
+ HGamer3D/GUI/Schema/Layout.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/GUI/Schema/Layout.hs++-- | Types which describe the GUI Layout Schemes+module HGamer3D.GUI.Schema.Layout+where++import Data.Typeable+import HGamer3D.Data as Dat+import HGamer3D.GUI.Schema.GUIDim+import HGamer3D.GUI.Schema.Widget++data Layout = VerticalLayout [WidgetProperty]+ | HorizontalLayout [WidgetProperty]+ | GridLayout Int Int [WidgetProperty]+ | Window String [WidgetProperty]+ deriving (Eq, Show, Typeable)++ +
+ HGamer3D/GUI/Schema/Widget.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/GUI/Schema/Widget.hs++-- | Types which describe the GUI Widgets+module HGamer3D.GUI.Schema.Widget+where++import Data.Typeable+import HGamer3D.Data as Dat+import HGamer3D.GUI.Schema.GUIDim++-- | The data to specify a widget+data Widget = Button String [WidgetProperty]+ | RadioButton String [WidgetProperty]+ | CheckBox String [WidgetProperty]+ | ComboBox String [WidgetProperty]+ | ListBox String [WidgetProperty]+ | EditText String [WidgetProperty]+ | MultilineText String [WidgetProperty]+ | Spinner String [WidgetProperty]+ | Slider String [WidgetProperty]+ deriving (Eq, Show, Typeable)++-- | Widget Properties+data WidgetProperty = XPos GUIDim+ | YPos GUIDim+ | Width GUIDim+ | Height GUIDim+ | Visible Bool+ | Alpha Float+ | Text String+ | Margin GUIDim+ | Tooltip String+ | TextChoice [String] -- only ComboBox+ | TextSelection [(String, Bool)] -- only ListBox+ | Value Float -- only Spinner, Slider+ | Selected Bool -- only CheckBox, RadioButton+ deriving (Eq, Show, Typeable)++
+ HGamer3D/Internal/GUI.hs view
@@ -0,0 +1,35 @@+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2013 Peter Althainz+-- +-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- GUI.hs++-- |GUI functionality of HGamer3D, internal API.++module HGamer3D.Internal.GUI++(+module HGamer3D.GUI.Internal.Base,+module HGamer3D.GUI.Internal.Widgets,+module HGamer3D.GUI.Internal.Properties,+)++where+import HGamer3D.GUI.Internal.Base+import HGamer3D.GUI.Internal.Widgets+import HGamer3D.GUI.Internal.Properties+