diff --git a/HGamer3D-GUI.cabal b/HGamer3D-GUI.cabal --- a/HGamer3D-GUI.cabal +++ b/HGamer3D-GUI.cabal @@ -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: diff --git a/HGamer3D/GUI.hs b/HGamer3D/GUI.hs deleted file mode 100644 --- a/HGamer3D/GUI.hs +++ /dev/null @@ -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 [] diff --git a/HGamer3D/GUI/BaseAPI.hs b/HGamer3D/GUI/BaseAPI.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/GUI/BaseAPI.hs @@ -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 diff --git a/HGamer3D/GUI/Internal/Base.hs b/HGamer3D/GUI/Internal/Base.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/GUI/Internal/Base.hs @@ -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 + diff --git a/HGamer3D/GUI/Internal/Form.hs b/HGamer3D/GUI/Internal/Form.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/GUI/Internal/Form.hs @@ -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 + diff --git a/HGamer3D/GUI/Internal/Properties.hs b/HGamer3D/GUI/Internal/Properties.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/GUI/Internal/Properties.hs @@ -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 + diff --git a/HGamer3D/GUI/Internal/Widgets.hs b/HGamer3D/GUI/Internal/Widgets.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/GUI/Internal/Widgets.hs @@ -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 + + + + diff --git a/HGamer3D/GUI/Schema/Form.hs b/HGamer3D/GUI/Schema/Form.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/GUI/Schema/Form.hs @@ -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) diff --git a/HGamer3D/GUI/Schema/GUIDim.hs b/HGamer3D/GUI/Schema/GUIDim.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/GUI/Schema/GUIDim.hs @@ -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 +} + diff --git a/HGamer3D/GUI/Schema/Layout.hs b/HGamer3D/GUI/Schema/Layout.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/GUI/Schema/Layout.hs @@ -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) + + + diff --git a/HGamer3D/GUI/Schema/Widget.hs b/HGamer3D/GUI/Schema/Widget.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/GUI/Schema/Widget.hs @@ -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) + + diff --git a/HGamer3D/Internal/GUI.hs b/HGamer3D/Internal/GUI.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/Internal/GUI.hs @@ -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 +