-- 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 []