From 0d887354d5d96ffcd36e8b77838407b691b501f8 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Tue, 4 Feb 2014 13:58:12 +0100 Subject: [PATCH 1/5] added resize-handler, made event-code not as wide --- src/Main.hs | 173 +++++++++++++++++++++++++++++----------------------- 1 file changed, 96 insertions(+), 77 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index dcde748..85ce4bd 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -369,84 +369,103 @@ processEvents = do processEvent :: Event -> Pioneers () processEvent e = do case eventData e of - Window _ winEvent -> - case winEvent of - Closing -> modify $ \s -> s { - stateWinClose = True - } - _ -> return () - Keyboard movement _ repeat key -> --up/down window(ignored) true/false actualKey - -- need modifiers? use "keyModifiers key" to get them - case keyScancode key of - Escape -> modify $ \s -> s { - stateWinClose = True - } - SDL.Left -> modify $ \s -> s { - stateArrowsPressed = (stateArrowsPressed s) { - arrowLeft = movement == KeyDown - } - } - SDL.Right -> modify $ \s -> s { - stateArrowsPressed = (stateArrowsPressed s) { - arrowRight = movement == KeyDown - } - } - SDL.Up -> modify $ \s -> s { - stateArrowsPressed = (stateArrowsPressed s) { - arrowUp = movement == KeyDown - } - } - SDL.Down -> modify $ \s -> s { - stateArrowsPressed = (stateArrowsPressed s) { - arrowDown = movement == KeyDown - } - } - SDL.KeypadPlus -> when (movement == KeyDown) $ do - modify $ \s -> s { - stateTessellationFactor = min ((stateTessellationFactor s)+1) 5 - } - state <- get - liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] - SDL.KeypadMinus -> when (movement == KeyDown) $ do - modify $ \s -> s { - stateTessellationFactor = max ((stateTessellationFactor s)-1) 1 - } - state <- get - liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] - _ -> return () - MouseMotion _ id st (Position x y) xrel yrel -> do - state <- get - when (stateMouseDown state && not (stateDragging state)) $ - put $ state - { stateDragging = True - , stateDragStartX = fromIntegral x - , stateDragStartY = fromIntegral y - , stateDragStartXAngle = stateXAngle state - , stateDragStartYAngle = stateYAngle state + Window _ winEvent -> + case winEvent of + Closing -> + modify $ \s -> s { + stateWinClose = True } + Resized {windowResizedTo=size} -> do + modify $ \s -> s { + stateWindowWidth = sizeWidth size + ,stateWindowHeight = sizeHeight size + } + adjustWindow + SizeChanged -> + adjustWindow + _ -> + liftIO $ putStrLn $ unwords ["Unhandled Window-Event:",(show e)] + Keyboard movement _ repeat key -> --up/down window(ignored) true/false actualKey + -- need modifiers? use "keyModifiers key" to get them + case keyScancode key of + Escape -> modify $ \s -> s { - stateCursorPosX = fromIntegral x - , stateCursorPosY = fromIntegral y + stateWinClose = True } - MouseButton _ id button state (Position x y) -> - case button of - LeftButton -> do - let pressed = state == Pressed - modify $ \s -> s - { stateMouseDown = pressed - } - unless pressed $ - modify $ \s -> s - { stateDragging = False - } - _ -> return () - MouseWheel _ id hscroll vscroll -> do - env <- ask - modify $ \s -> s - { stateZDist = - let zDist' = stateZDist s + realToFrac (negate $ vscroll) - in curb (envZDistClosest env) (envZDistFarthest env) zDist' + SDL.Left -> + modify $ \s -> s { + stateArrowsPressed = (stateArrowsPressed s) { + arrowLeft = movement == KeyDown + } } - Quit -> modify $ \s -> s {stateWinClose = True} - -- there is more (joystic, touchInterface, ...), but currently ignored - _ -> liftIO $ putStrLn $ unwords ["Not processing Event:",(show e)] \ No newline at end of file + SDL.Right -> + modify $ \s -> s { + stateArrowsPressed = (stateArrowsPressed s) { + arrowRight = movement == KeyDown + } + } + SDL.Up -> + modify $ \s -> s { + stateArrowsPressed = (stateArrowsPressed s) { + arrowUp = movement == KeyDown + } + } + SDL.Down -> + modify $ \s -> s { + stateArrowsPressed = (stateArrowsPressed s) { + arrowDown = movement == KeyDown + } + } + SDL.KeypadPlus -> + when (movement == KeyDown) $ do + modify $ \s -> s { + stateTessellationFactor = min ((stateTessellationFactor s)+1) 5 + } + state <- get + liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] + SDL.KeypadMinus -> + when (movement == KeyDown) $ do + modify $ \s -> s { + stateTessellationFactor = max ((stateTessellationFactor s)-1) 1 + } + state <- get + liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] + _ -> + return () + MouseMotion _ id st (Position x y) xrel yrel -> do + state <- get + when (stateMouseDown state && not (stateDragging state)) $ + put $ state + { stateDragging = True + , stateDragStartX = fromIntegral x + , stateDragStartY = fromIntegral y + , stateDragStartXAngle = stateXAngle state + , stateDragStartYAngle = stateYAngle state + } + modify $ \s -> s { + stateCursorPosX = fromIntegral x + , stateCursorPosY = fromIntegral y + } + MouseButton _ id button state (Position x y) -> + case button of + LeftButton -> do + let pressed = state == Pressed + modify $ \s -> s { + stateMouseDown = pressed + } + unless pressed $ + modify $ \s -> s { + stateDragging = False + } + _ -> + return () + MouseWheel _ id hscroll vscroll -> do + env <- ask + modify $ \s -> s + { stateZDist = + let zDist' = stateZDist s + realToFrac (negate $ vscroll) + in curb (envZDistClosest env) (envZDistFarthest env) zDist' + } + Quit -> modify $ \s -> s {stateWinClose = True} + -- there is more (joystic, touchInterface, ...), but currently ignored + _ -> liftIO $ putStrLn $ unwords ["Not processing Event:",(show e)] \ No newline at end of file From 02c02454fd64989eb6557cd1c8275e3260184654 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Tue, 4 Feb 2014 14:11:16 +0100 Subject: [PATCH 2/5] cleaned up - removed unused imports - removed unneccessary $ - removed unneccessary () - changed variables hiding functions --- src/Main.hs | 53 ++++++++++++++++++++++++----------------------------- 1 file changed, 24 insertions(+), 29 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 85ce4bd..6bfeaa8 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,18 +2,14 @@ module Main where -- Monad-foo and higher functional stuff -import Control.Applicative import Control.Monad (unless, void, when, join) -import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) import Control.Arrow ((***)) -- data consistency/conversion import Control.Concurrent (threadDelay) -import Control.Concurrent.STM (TQueue, atomically, - newTQueueIO, - tryReadTQueue, - writeTQueue, isEmptyTQueue, - STM) +import Control.Concurrent.STM (TQueue, + newTQueueIO) + import Control.Monad.RWS.Strict (RWST, ask, asks, evalRWST, get, liftIO, modify, put) @@ -24,7 +20,7 @@ import Foreign (Ptr, castPtr, with) import Foreign.C (CFloat) -- Math -import Control.Lens (transposeOf, (^.)) +import Control.Lens ((^.)) import Linear as L -- GUI @@ -40,7 +36,7 @@ import Graphics.Rendering.OpenGL.Raw.ARB.TessellationShader import Map.Map import Render.Misc (checkError, createFrustum, getCam, - lookAt, up, curb) + curb) import Render.Render (initRendering, initShader) @@ -128,6 +124,7 @@ main = do let zDistClosest = 1 zDistFarthest = zDistClosest + 30 + --TODO: Move near/far/fov to state for runtime-changability & central storage fov = 90 --field of view near = 1 --near plane far = 100 --far plane @@ -188,7 +185,6 @@ main = do draw :: Pioneers () draw = do - env <- ask state <- get let xa = stateXAngle state ya = stateYAngle state @@ -212,23 +208,23 @@ draw = do GL.clear [GL.ColorBuffer, GL.DepthBuffer] checkError "foo" --set up projection (= copy from state) - with (distribute $ frust) $ \ptr -> + with (distribute frust) $ \ptr -> glUniformMatrix4fv proj 1 0 (castPtr (ptr :: Ptr (M44 CFloat))) checkError "foo" --set up camera let ! cam = getCam (camX,camY) zDist xa ya - with (distribute $ cam) $ \ptr -> + with (distribute cam) $ \ptr -> glUniformMatrix4fv vmat 1 0 (castPtr (ptr :: Ptr (M44 CFloat))) checkError "foo" --set up normal--Mat transpose((model*camera)^-1) - let normal = (case inv33 ((fmap (^._xyz) cam) ^. _xyz) of + let normal = (case inv33 (fmap (^. _xyz) cam ^. _xyz) of (Just a) -> a Nothing -> eye3) :: M33 CFloat - nmap = (collect (fmap id) normal) :: M33 CFloat --transpose... + nmap = collect id normal :: M33 CFloat --transpose... - with (distribute $ nmap) $ \ptr -> + with (distribute nmap) $ \ptr -> glUniformMatrix3fv nmat 1 0 (castPtr (ptr :: Ptr (M33 CFloat))) checkError "nmat" @@ -260,8 +256,7 @@ run = do -- draw Scene draw - liftIO $ do - glSwapWindow win + liftIO $ glSwapWindow win -- getEvents & process processEvents @@ -292,7 +287,7 @@ run = do -- get cursor-keys - if pressed --TODO: Add sin/cos from stateYAngle - (kxrot, kyrot) <- fmap ((join (***)) fromIntegral) getArrowMovement + (kxrot, kyrot) <- fmap (join (***) fromIntegral) getArrowMovement modify $ \s -> let multc = cos $ stateYAngle s @@ -315,8 +310,8 @@ run = do mt <- liftIO $ do now <- getCurrentTime diff <- return $ diffUTCTime now (stateClock state) -- get time-diffs - title <- return $ unwords ["Pioneers @ ",show $ ((round .fromRational.toRational $ 1/diff)::Int),"fps"] - setWindowTitle win $ title + title <- return $ unwords ["Pioneers @ ",show ((round .fromRational.toRational $ 1.0/diff)::Int),"fps"] + setWindowTitle win title sleepAmount <- return $ floor (max 0 (0.04 - diff))*1000000 -- get time until next frame in microseconds threadDelay sleepAmount return now @@ -384,8 +379,8 @@ processEvent e = do SizeChanged -> adjustWindow _ -> - liftIO $ putStrLn $ unwords ["Unhandled Window-Event:",(show e)] - Keyboard movement _ repeat key -> --up/down window(ignored) true/false actualKey + liftIO $ putStrLn $ unwords ["Unhandled Window-Event:",show e] + Keyboard movement _ isRepeated key -> --up/down window(ignored) true/false actualKey -- need modifiers? use "keyModifiers key" to get them case keyScancode key of Escape -> @@ -419,20 +414,20 @@ processEvent e = do SDL.KeypadPlus -> when (movement == KeyDown) $ do modify $ \s -> s { - stateTessellationFactor = min ((stateTessellationFactor s)+1) 5 + stateTessellationFactor = min (stateTessellationFactor s + 1) 5 } state <- get liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] SDL.KeypadMinus -> when (movement == KeyDown) $ do modify $ \s -> s { - stateTessellationFactor = max ((stateTessellationFactor s)-1) 1 + stateTessellationFactor = max (stateTessellationFactor s - 1) 1 } state <- get liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] _ -> return () - MouseMotion _ id st (Position x y) xrel yrel -> do + MouseMotion _ mouseId st (Position x y) xrel yrel -> do state <- get when (stateMouseDown state && not (stateDragging state)) $ put $ state @@ -446,7 +441,7 @@ processEvent e = do stateCursorPosX = fromIntegral x , stateCursorPosY = fromIntegral y } - MouseButton _ id button state (Position x y) -> + MouseButton _ mouseId button state (Position x y) -> case button of LeftButton -> do let pressed = state == Pressed @@ -459,13 +454,13 @@ processEvent e = do } _ -> return () - MouseWheel _ id hscroll vscroll -> do + MouseWheel _ mouseId hscroll vscroll -> do env <- ask modify $ \s -> s { stateZDist = - let zDist' = stateZDist s + realToFrac (negate $ vscroll) + let zDist' = stateZDist s + realToFrac (negate vscroll) in curb (envZDistClosest env) (envZDistFarthest env) zDist' } Quit -> modify $ \s -> s {stateWinClose = True} -- there is more (joystic, touchInterface, ...), but currently ignored - _ -> liftIO $ putStrLn $ unwords ["Not processing Event:",(show e)] \ No newline at end of file + _ -> liftIO $ putStrLn $ unwords ["Not processing Event:", show e] \ No newline at end of file From 2d97d4e8caa0d6495e8e282013349cee06ad9709 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Tue, 4 Feb 2014 14:15:15 +0100 Subject: [PATCH 3/5] added performance-compile-options - added various GHC-Option to perform a better compile - Using LLVM to optimize further --- Pioneers.cabal | 2 +- src/Main.hs | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/Pioneers.cabal b/Pioneers.cabal index e12f96b..338f404 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -6,7 +6,7 @@ author: sdressel executable Pioneers hs-source-dirs: src - ghc-options: -Wall + ghc-options: -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 -fllvm other-modules: Map.Map, Render.Misc, diff --git a/src/Main.hs b/src/Main.hs index 6bfeaa8..a872a91 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -378,8 +378,9 @@ processEvent e = do adjustWindow SizeChanged -> adjustWindow - _ -> - liftIO $ putStrLn $ unwords ["Unhandled Window-Event:",show e] + _ -> + return () + --liftIO $ putStrLn $ unwords ["Unhandled Window-Event:",show e] Keyboard movement _ isRepeated key -> --up/down window(ignored) true/false actualKey -- need modifiers? use "keyModifiers key" to get them case keyScancode key of From 1126cfc25af9e74d0f8abe8a55a70bcb3821691d Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 5 Feb 2014 16:33:32 +0100 Subject: [PATCH 4/5] moved types to types - moved types to types - added callback - included sdl-ttf --- Pioneers.cabal | 7 +++-- deps/getDeps.sh | 11 ++++++- src/Main.hs | 84 +++++++++++++------------------------------------ 3 files changed, 36 insertions(+), 66 deletions(-) diff --git a/Pioneers.cabal b/Pioneers.cabal index 338f404..f49b250 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -11,7 +11,9 @@ executable Pioneers Map.Map, Render.Misc, Render.Render, - Render.RenderObject + Render.RenderObject, + UI.Callbacks, + Types main-is: Main.hs build-depends: base >=4.6, @@ -29,5 +31,6 @@ executable Pioneers linear >=1.3.1 && <1.4, lens >=3.10.1 && <3.11, SDL2 >= 0.1.0, - time >=1.4.0 && <1.5 + time >=1.4.0 && <1.5, + SDL2-ttf >=0.1.0 && <0.2 diff --git a/deps/getDeps.sh b/deps/getDeps.sh index 4514f31..5c3ccad 100755 --- a/deps/getDeps.sh +++ b/deps/getDeps.sh @@ -63,6 +63,15 @@ else cd .. fi +if [ ! -d "hsSDL2-ttf" ] +then + git clone https://github.com/osa1/hsSDL2-ttf hsSDL2-ttf +else + cd hsSDL2-ttf + git pull + cd .. +fi + echo "trying to build" cabal install haddock @@ -79,7 +88,7 @@ do cabal configure cabal build cabal haddock --hyperlink-source - cabal install + cabal install --force-reinstalls cd .. fi done diff --git a/src/Main.hs b/src/Main.hs index a872a91..b0445db 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, DoAndIfThenElse #-} module Main where -- Monad-foo and higher functional stuff @@ -25,6 +25,8 @@ import Linear as L -- GUI import Graphics.UI.SDL as SDL +import Graphics.UI.SDL.TTF as TTF +import Graphics.UI.SDL.TTF.Types -- Render import qualified Graphics.Rendering.OpenGL.GL as GL @@ -39,66 +41,11 @@ import Render.Misc (checkError, curb) import Render.Render (initRendering, initShader) +import UI.Callbacks +import Types import qualified Debug.Trace as D (trace) -data ArrowKeyState = ArrowKeyState { - arrowUp :: !Bool - ,arrowDown :: !Bool - ,arrowLeft :: !Bool - ,arrowRight :: !Bool -} - ---Static Read-Only-State -data Env = Env - { envEventsChan :: TQueue Event - , envWindow :: !Window - , envZDistClosest :: !Double - , envZDistFarthest :: !Double - --, envGLContext :: !GLContext - } - ---Mutable State -data State = State - { stateWindowWidth :: !Int - , stateWindowHeight :: !Int - , stateWinClose :: !Bool - , stateClock :: !UTCTime - --- IO - , stateXAngle :: !Double - , stateYAngle :: !Double - , stateZDist :: !Double - , stateMouseDown :: !Bool - , stateDragging :: !Bool - , stateDragStartX :: !Double - , stateDragStartY :: !Double - , stateDragStartXAngle :: !Double - , stateDragStartYAngle :: !Double - , statePositionX :: !Double - , statePositionY :: !Double - , stateCursorPosX :: !Double - , stateCursorPosY :: !Double - , stateArrowsPressed :: !ArrowKeyState - , stateFrustum :: !(M44 CFloat) - --- pointer to bindings for locations inside the compiled shader - --- mutable because shaders may be changed in the future. - , shdrVertexIndex :: !GL.AttribLocation - , shdrColorIndex :: !GL.AttribLocation - , shdrNormalIndex :: !GL.AttribLocation - , shdrProjMatIndex :: !GL.UniformLocation - , shdrViewMatIndex :: !GL.UniformLocation - , shdrModelMatIndex :: !GL.UniformLocation - , shdrNormalMatIndex :: !GL.UniformLocation - , shdrTessInnerIndex :: !GL.UniformLocation - , shdrTessOuterIndex :: !GL.UniformLocation - , stateTessellationFactor :: !Int - --- the map - , stateMap :: !GL.BufferObject - , mapVert :: !GL.NumArrayIndices - } - -type Pioneers = RWST Env () State IO - -------------------------------------------------------------------------------- main :: IO () main = do @@ -108,9 +55,10 @@ main = do ,WindowResizable -- and resizable ,WindowInputFocus -- focused (=> active) ,WindowMouseFocus -- Mouse into it - --,WindowInputGrabbed-- never let go of input (KB/Mouse) + ,WindowInputGrabbed-- never let go of input (KB/Mouse) ] $ \window -> do withOpenGL window $ do + TTF.withInit $ do (Size fbWidth fbHeight) <- glGetDrawableSize window initRendering --generate map vertices @@ -121,6 +69,9 @@ main = do putStrLn "foo" now <- getCurrentTime putStrLn "foo" + font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10 + TTF.setFontStyle font TTFNormal + TTF.setFontHinting font TTFHNormal let zDistClosest = 1 zDistFarthest = zDistClosest + 30 @@ -141,6 +92,7 @@ main = do , envWindow = window , envZDistClosest = zDistClosest , envZDistFarthest = zDistFarthest + , envFont = font } state = State { stateWindowWidth = fbWidth @@ -449,10 +401,16 @@ processEvent e = do modify $ \s -> s { stateMouseDown = pressed } - unless pressed $ - modify $ \s -> s { - stateDragging = False - } + unless pressed $ do + st <- get + if stateDragging st then + modify $ \s -> s { + stateDragging = False + } + else + clickHandler (UI.Callbacks.Pixel x y) + RightButton -> do + when (state == Released) $ alternateClickHandler (UI.Callbacks.Pixel x y) _ -> return () MouseWheel _ mouseId hscroll vscroll -> do From 95a7a5b9f1ba0ce6f650f179639f6bb9e0960275 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 5 Feb 2014 21:06:19 +0100 Subject: [PATCH 5/5] forgot files -.- --- src/Types.hs | 71 +++++++++++++++++++++++++++++++++++++++++++++ src/UI/Callbacks.hs | 20 +++++++++++++ 2 files changed, 91 insertions(+) create mode 100644 src/Types.hs create mode 100644 src/UI/Callbacks.hs diff --git a/src/Types.hs b/src/Types.hs new file mode 100644 index 0000000..c896bba --- /dev/null +++ b/src/Types.hs @@ -0,0 +1,71 @@ +module Types where + +import Control.Concurrent.STM (TQueue) +import qualified Graphics.Rendering.OpenGL.GL as GL +import Graphics.UI.SDL as SDL +import Foreign.C (CFloat) +import Data.Time (UTCTime) +import Linear.Matrix (M44) +import Control.Monad.RWS.Strict (RWST) +import Graphics.UI.SDL.TTF.Types as TTF + + + + +data ArrowKeyState = ArrowKeyState { + arrowUp :: !Bool + ,arrowDown :: !Bool + ,arrowLeft :: !Bool + ,arrowRight :: !Bool +} + +--Static Read-Only-State +data Env = Env + { envEventsChan :: TQueue Event + , envWindow :: !Window + , envZDistClosest :: !Double + , envZDistFarthest :: !Double + --, envGLContext :: !GLContext + , envFont :: TTF.TTFFont + } + +--Mutable State +data State = State + { stateWindowWidth :: !Int + , stateWindowHeight :: !Int + , stateWinClose :: !Bool + , stateClock :: !UTCTime + --- IO + , stateXAngle :: !Double + , stateYAngle :: !Double + , stateZDist :: !Double + , stateMouseDown :: !Bool + , stateDragging :: !Bool + , stateDragStartX :: !Double + , stateDragStartY :: !Double + , stateDragStartXAngle :: !Double + , stateDragStartYAngle :: !Double + , statePositionX :: !Double + , statePositionY :: !Double + , stateCursorPosX :: !Double + , stateCursorPosY :: !Double + , stateArrowsPressed :: !ArrowKeyState + , stateFrustum :: !(M44 CFloat) + --- pointer to bindings for locations inside the compiled shader + --- mutable because shaders may be changed in the future. + , shdrVertexIndex :: !GL.AttribLocation + , shdrColorIndex :: !GL.AttribLocation + , shdrNormalIndex :: !GL.AttribLocation + , shdrProjMatIndex :: !GL.UniformLocation + , shdrViewMatIndex :: !GL.UniformLocation + , shdrModelMatIndex :: !GL.UniformLocation + , shdrNormalMatIndex :: !GL.UniformLocation + , shdrTessInnerIndex :: !GL.UniformLocation + , shdrTessOuterIndex :: !GL.UniformLocation + , stateTessellationFactor :: !Int + --- the map + , stateMap :: !GL.BufferObject + , mapVert :: !GL.NumArrayIndices + } + +type Pioneers = RWST Env () State IO \ No newline at end of file diff --git a/src/UI/Callbacks.hs b/src/UI/Callbacks.hs new file mode 100644 index 0000000..b4daff3 --- /dev/null +++ b/src/UI/Callbacks.hs @@ -0,0 +1,20 @@ +module UI.Callbacks where + +import Control.Monad.Trans (liftIO) +import Types + +data Pixel = Pixel Int Int + +-- | Handler for UI-Inputs. +-- Indicates a primary click on something (e.g. left-click, touch on Touchpad, fire on Gamepad, ... +clickHandler :: Pixel -> Pioneers () +clickHandler (Pixel x y) = liftIO $ putStrLn $ unwords ["button press on (",show x,",",show y,")"] + +-- | Handler for UI-Inputs. +-- Indicates an alternate click on something (e.g. right-click, touch&hold on Touchpad, ... +alternateClickHandler :: Pixel -> Pioneers () +alternateClickHandler (Pixel x y) = liftIO $ putStrLn $ unwords ["alternate press on (",show x,",",show y,")"] + + +--TODO: Add scroll-Handler, return (Pioneers Bool) to indicate event-bubbling etc. +--TODO: Maybe queues are better?