{-# 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. -- | Windowing and Event functionality for HGamer3D, implementation module. This modules exposes internal data structures, public API is in HGamer3D.WinEvent. module HGamer3D.Graphics3D.WinEvent ( EnumWinEventInit (..), SDLSystem, initWinEvent, freeWinEvent, attachToWindow, openWindow, pollWinEvent, showCursor, module HGamer3D.Bindings.SDL2.StructSDLEvent, module HGamer3D.Bindings.SDL2.EnumSDLEventType, module HGamer3D.Bindings.SDL2.EnumSDLKeymod, module HGamer3D.Bindings.SDL2.EnumSDLScancode, module HGamer3D.Bindings.SDL2.EnumSDLWindowEventID, module HGamer3D.Bindings.SDL2.EnumSDLWindowFlags, ) where import GHC.Ptr import HGamer3D.Data import HGamer3D.Data.Window import HGamer3D.Bindings.SDL2.ClassPtr import HGamer3D.Bindings.SDL2.Utils import HGamer3D.Bindings.SDL2.EnumSDLEventType import HGamer3D.Bindings.SDL2.EnumSDLKeymod import HGamer3D.Bindings.SDL2.EnumSDLScancode import HGamer3D.Bindings.SDL2.EnumSDLWindowEventID import HGamer3D.Bindings.SDL2.EnumSDLWindowFlags import HGamer3D.Bindings.SDL2.StructSDLEvent import HGamer3D.Bindings.SDL2.HeaderSDL import HGamer3D.Bindings.SDL2.HeaderSDLVideo import HGamer3D.Bindings.SDL2.HeaderSDLEvents import HGamer3D.Bindings.SDL2.EnumSDLWindowFlags import HGamer3D.Bindings.SDL2.HeaderSDLMouse import HGamer3D.Bindings.SDL2.ClassHG3DUtilities import Foreign.Marshal.Utils import Control.Monad import Control.Applicative data SDLSystem = SDLSystem (Ptr SDLWindow) -- WinEvent Initialization Flags data EnumWinEventInit = WEV_INIT_VIDEO -- ^ initialize Video subsystem | WEV_INIT_TIMER -- ^ initialize Timer subsystem | WEV_INIT_EVENTS -- ^ initialize Event subsystem instance Enum EnumWinEventInit where toEnum 0x20 = WEV_INIT_VIDEO toEnum 0x4000 = WEV_INIT_EVENTS toEnum 0x01 = WEV_INIT_TIMER fromEnum WEV_INIT_VIDEO = 0x20 fromEnum WEV_INIT_EVENTS = 0x4000 fromEnum WEV_INIT_TIMER = 0x01 -- show instance for SDLEvent instance Show SDLEvent where show (EvtQuit ts) = "Event-Quit" show (EvtKeyUp ts window keyscan keycode keymode) = "Event-KeyUp " ++ (show (fromEnum keyscan)) show (EvtKeyDown ts window keyscan keycode keymode) = "Event-KeyDown " ++ (show (fromEnum keyscan)) show (EvtText ts window text) = "Event-Text " ++ text show (EvtMouseButtonUp ts window mid button x y) = "Event-MouseButtonUp " ++ (show button) ++ " " ++ (show x) ++ " " ++ (show y) show (EvtMouseButtonDown ts window mid button x y) = "Event-MouseButtonDown " ++ (show button) ++ " " ++ (show x) ++ " " ++ (show y) show (EvtMouseMotion ts window mid x y rx ry) = "Event-MouseMotion " ++ (show x) ++ " " ++ (show y) ++ " r: " ++ (show rx) ++ " " ++ (show ry) show (EvtWindow ts window weid x y) = "Event-Window " ++ (show (fromEnum weid)) ++ " " ++ (show x) ++ " " ++ (show y) show _ = "Specific Event is not in show instance" -- | Initialization of WinEvent initWinEvent :: [EnumWinEventInit] -- ^ Initialization Flags -> IO Int -- ^ result != 0 in case of errors initWinEvent flags = do res <- sdlInit $ sum (fmap fromEnum flags) return res -- | Un-initialize WinEvent and free resources freeWinEvent :: IO () freeWinEvent = sdlQuit attachToWindow :: Window -> IO (SDLSystem) attachToWindow (Window handle) = do res <- createWindowFromHandle handle return $ SDLSystem res -- | open new window openWindow :: String -- ^ Window Display Name -> Int -- ^ X coordinate of Window -> Int -- ^ Y coordinate of Window -> Int -- ^ Width of Window -> Int -- ^ Height of Window -> [EnumSDLWindowFlags] -- ^ initialization flags -> IO (SDLSystem) openWindow title x y w h flags = do win <- sdlCreateWindow title x y w h (sum $ fmap fromEnum flags) return $ SDLSystem win -- | query for events from windowing system pollWinEvent :: IO (Maybe SDLEvent) pollWinEvent = do (sdlevt, res) <- sdlPollEvent let r = case res of 0 -> Nothing 1 -> Just sdlevt _ -> Nothing return r -- | show / hide cursor, returns previous state showCursor :: Bool -> IO Bool showCursor flag = do ival <- sdlShowCursor (fromBool flag) return (toBool ival)