moved types to types

- moved types to types
- added callback
- included sdl-ttf

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
 

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

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 $
+                        unless pressed $ do
-                            modify $ \s -> s {
+                            st <- get
-                                stateDragging = False
+                            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