Unify config files, add capability to remember window position

appDodge/Main.hs

@@ -1,6 +1,5 @@
 module Main where
 import Loop
-import LoadConfig
 import Dodge.Data
 import Dodge.Initialisation
 import Dodge.Update
@@ -22,24 +21,25 @@ import Data.Preload
 import Data.Preload.Render
 
 import Control.Lens
---import Foreign (Word32)
 import Control.Monad
---import System.Random
---import qualified Data.Map                  as M
 import qualified Data.IntMap               as IM
 import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate)
 import qualified SDL
 import qualified SDL.Mixer                 as Mix
---import qualified Control.Monad.Parallel as MP
 import Control.Parallel
 import qualified Data.Map.Strict as M
 
 main :: IO ()
 main = do
-    (sizex,sizey) <- loadConfig
+    con <- loadDodgeConfig
+    let sizex = floor $ _windowX con
+        sizey = floor $ _windowY con
+        posx = _windowPosX con
+        posy = _windowPosY con
     setupLoop
         20
         (sizex,sizey)
+        (posx,posy)
         theCleanup
         (firstWorldLoad (sizex,sizey))
         theUpdateStep

src/Dodge/Config/Data.hs

@@ -15,6 +15,8 @@ data Configuration = Configuration
     , _resolution_factor    :: Int -- ^ Higher values divide screen size, i.e. make the resolution worse
     , _windowX              :: Float
     , _windowY              :: Float
+    , _windowPosX           :: Int
+    , _windowPosY           :: Int
     , _rotate_to_wall       :: Bool
     , _show_sound           :: Bool
     , _debug_seconds_frame  :: Bool
@@ -41,6 +43,8 @@ defaultConfig = Configuration
     , _resolution_factor    = 1
     , _windowX              = 800
     , _windowY              = 600
+    , _windowPosX           = 0
+    , _windowPosY           = 0
     , _rotate_to_wall       = True
     , _show_sound           = False
     , _debug_seconds_frame  = True

src/Dodge/Event.hs

@@ -42,6 +42,7 @@ handleEvent e = case eventPayload e of
     MouseButtonEvent mbev       -> handleMouseButtonEvent mbev
     MouseWheelEvent mwev        -> handleMouseWheelEvent mwev
     WindowSizeChangedEvent sev  -> handleResizeEvent sev
+    WindowMovedEvent mev        -> handleWindowMoveEvent mev
     _                           -> Just
 
 handleMouseMotionEvent :: MouseMotionEventData -> World -> Maybe World
@@ -58,6 +59,14 @@ handleMouseButtonEvent mbev w = case mouseButtonEventMotion mbev of
   where 
     but = mouseButtonEventButton mbev
 
+{- | Sets window position in config.  -}
+handleWindowMoveEvent :: WindowMovedEventData -> World -> Maybe World
+handleWindowMoveEvent mev w = Just $ w 
+    & config . windowPosX .~ fromIntegral x
+    & config . windowPosY .~ fromIntegral y
+  where
+    P (V2 x y) = windowMovedEventPosition mev
+
 {- | Resets the world window size, and resizes the fbo that gets the light map drawn into it.  -}
 handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World
 handleResizeEvent sev w = Just 

src/LoadConfig.hs

@@ -1,29 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
-module LoadConfig where
-import Data.Aeson
---import Foreign.C.Types
-import GHC.Generics
---import qualified GHC.Int
---import qualified SDL
---import System.Directory
-
-data Configuration = Configuration
-  { windowxsize :: Int,
-    windowysize :: Int
-  }
-  deriving (Generic, Show)
-
-instance ToJSON Configuration where
-  toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Configuration
-
-loadConfig :: IO (Int, Int)
-loadConfig = do
-  mayConfig <- decodeFileStrict "config.json"
-  case mayConfig of
-    Just config -> return (windowxsize config, windowysize config)
-    Nothing -> do
-      putStrLn "invalid config.json, loading default config"
-      return (800, 600)

src/Loop.hs

@@ -13,24 +13,23 @@ import Control.Concurrent
 import Control.Exception
 import Control.Monad
 import System.Mem
---import Foreign.C
 import SDL
 import qualified Graphics.Rendering.OpenGL as GL
-
 -- | Create a game loop with an SDL window.
 setupLoop
     :: Int                  -- ^ Target seconds per frame
     -> (Int,Int)            -- ^ The window size.
+    -> (Int,Int)            -- ^ The window position.
     -> (world -> IO ())    -- ^ Function for cleaning up parameters, applied when exiting loop.
     -> IO world             -- ^ Initial simulation state.
     -> (world -> IO world)   -- ^ update, called once per frame. Allows for side effects such as rendering.
     -> (world -> Event -> Maybe world)
                             -- ^ SDL Event handling, once per frame. Evaluating 'Nothing' exits the loop.
     -> IO ()
-setupLoop spf (xSize,ySize) paramCleanup ioStartWorld sideEffects eventFn = do 
+setupLoop spf (xSize,ySize) (xPos,yPos) paramCleanup ioStartWorld sideEffects eventFn = do 
     initializeAll
     bracket 
-        (createWindow (T.pack "Simple Game Loop") (winConfig xSize ySize)) 
+        (createWindow (T.pack "Simple Game Loop") (winConfig xSize ySize xPos yPos)) 
         destroyWindow 
         $ \window -> bracket 
             (glCreateContext window) 
@@ -79,14 +78,13 @@ applyEventIO fn mw e = case eventPayload e of
                         -> GL.viewport $= (GL.Position 0 0,GL.Size x y) >> return (mw >>= \w -> fn w e)
     _                   -> return $ mw >>= flip fn e
 -- | Create an OpenGL SDL window configuration with a given x and y size.
-winConfig :: Int -> Int -> WindowConfig
+winConfig :: Int -> Int -> Int -> Int -> WindowConfig
-winConfig x y = defaultWindow 
+winConfig x y px py = defaultWindow 
     { windowGraphicsContext = OpenGLContext $ defaultOpenGL 
         { glProfile = Core Normal 4 3
         , glColorPrecision = V4 8 8 8 8
         } 
+    , windowPosition = Absolute (P (V2 (fromIntegral px) (fromIntegral py)))
     , windowInitialSize = V2 (fromIntegral x) (fromIntegral y)
     , windowResizable =True
     }
-
-

src/MatrixHelper.hs

@@ -2,11 +2,9 @@ module MatrixHelper
     ( perspectiveMatrixb
     , isoMatrix
     ) where
---import Geometry
 import Geometry.Data
 
 import Linear.Matrix
---import Linear.V4
 import Graphics.Rendering.OpenGL (GLfloat)
 
 perspectiveMatrixb 
@@ -23,7 +21,6 @@ perspectiveMatrixb rot zoom (V2 tranx trany) (V2 winx winy) (V2 viewFromx viewFr
     $ scaleMat (V2 (2*zoom/winx) (2*zoom/winy))
         !*! rotMatr (-rot)
         !*! transMat (V2 (viewFromx-tranx) (viewFromy-trany))
-       -- !*! perMat (zoom * 0.4)
         !*! perMat 0.4
         !*! transMat (V2 (-viewFromx) (-viewFromy))
         !*! vertScale (negate 0.005)

src/Music.hs

@@ -1,5 +1,6 @@
 module Music
-  where
+    ( MusicData (..)
+    ) where
 import qualified SDL.Mixer as Mix
 import qualified Data.IntMap.Strict as IM
 

src/Padding.hs

@@ -1,6 +1,12 @@
-{-| Basic padding and "justification" of lists.
+{-| Basic padding and "justification" of lists.  -}
- -}
 module Padding
+    ( leftPad
+    , rightPad
+    , midPad
+    , midPadL
+    , rotU
+    , rotD
+    )
     where
 leftPad :: Int -> a -> [a] -> [a]
 {-# INLINE leftPad #-}

src/Picture.hs

@@ -41,18 +41,9 @@ module Picture
   where
 import Geometry
 import Geometry.Vector3D
---import Geometry.Data
 import Picture.Data
 import Color
 
---import Data.List
---import Data.Bifunctor
---import qualified Data.DList as DL
---import Graphics.Rendering.OpenGL (lineWidth, ($=))
---import Control.Lens
---import Data.Foldable
---import qualified Data.Vector.Fusion.Stream.Monadic as VS
-
 blank :: Picture
 {-# INLINE blank #-}
 blank = []
@@ -157,7 +148,7 @@ translate x = map . overPos . translateH x
 
 translate3 :: Point3 -> Picture -> Picture
 {-# INLINE translate3 #-}
-translate3 v = map $ overPos (+.+.+ v)
+translate3 = map . overPos . (+.+.+)
 
 tranRot :: V2 Float -> Float -> Picture -> Picture
 {-# INLINE tranRot #-}

src/PolyPic.hs

@@ -1,29 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-module PolyPic
-    where
---import Linear.V3
-import Linear.V4
-import Geometry
-import Picture
-
-import Control.Lens
-
-data Vert = Vert
-    {_vtPos :: !(V2 Float)
-    ,_vtCol :: !(V4 Float)
-    }
-makeLenses ''Vert
-
-type Pic2d = [Vert]
-
-polygon2d :: [Point2] -> Pic2d
-polygon2d = map f . polyToTris
-  where
-    f p = Vert p black
-
-color2d :: RGBA -> Pic2d -> Pic2d
-color2d = map . set vtCol
-
-translate2d :: Float -> Float -> Pic2d -> Pic2d
-translate2d x y = map $ over vtPos (+.+ V2 x y)
-

src/Polyhedra.hs

@@ -11,7 +11,6 @@ module Polyhedra
     )
     where
 import Geometry
---import Geometry.Data
 import Geometry.Vector3D
 import Polyhedra.Data
 import Picture.Data
@@ -21,7 +20,6 @@ import Data.Maybe
 import Data.List
 import Data.Bifunctor
 import Control.Lens
---import qualified Data.Vector.Fusion.Stream.Monadic as VS
 
 translateXY :: Float -> Float -> Polyhedra -> Polyhedra
 translateXY x y = pyFaces %~ map (map $ first tran)
@@ -31,12 +29,6 @@ translateXY x y = pyFaces %~ map (map $ first tran)
 rotateXY :: Float -> Polyhedra -> Polyhedra
 rotateXY a = over pyFaces $ map $ map $ first $ rotate3 a
 
--- Another representation of polyhedra is as a list of edges.
--- Each edge is a tuple containing four points: the first two are the two edge
--- coordinates, the last two being the normals of two planes of the polyhedra
--- that the edge connects.
-    --, _pyEdges :: [(Point3,Point3,Point3,Point3)]
-
 constructEdges :: [[Point3]] -> [(Point3,Point3,Point3,Point3)]
 constructEdges (face:faces) = mapMaybe (findReverseEdge otherEdges) (faceEdges face) 
     ++ constructEdges faces
@@ -53,7 +45,6 @@ constructEdgesList (face:faces) = concatMap (findReverseEdgeList otherEdges) (fa
     otherEdges = concatMap faceEdges faces
 constructEdgesList _ = []
 
-
 findReverseEdge 
     :: [(Point3,Point3,Point3)] 
     -> (Point3,Point3,Point3) 
@@ -130,7 +121,6 @@ polyToPics :: Polyhedra -> [Picture]
 polyToPics = map helpPoly3D . _pyFaces
 
 helpPoly3D :: [(Point3, Point4)] -> Picture
---{-# INLINE helpPoly3D #-}
 helpPoly3D vs = map f $ polyToTris vs
   where
     f (pos,col) = Verx pos col [] 0 polyNum
@@ -147,6 +137,5 @@ denormalEdges (a,b,n,m) = (a,b,a - x, b - y)
     x = crossProd (b - a) n
     y = crossProd (a - b) m
     
-
 polyToGeoRender :: Polyhedra -> [Point3]
 polyToGeoRender = concatMap (polyToTris . map fst) . _pyFaces

src/Preload.hs

@@ -1,14 +1,13 @@
 module Preload
+    ( cleanUpPreload
+    )
   where
 import Data.Preload
 import Preload.Render
 import Sound.Data
 
---import Control.Lens
---import GHC.Word (Word32)
 import qualified SDL.Mixer as Mix
 
-
 cleanUpPreload :: PreloadData -> IO ()
 cleanUpPreload pd = do
     cleanUpRenderPreload $ _renderData pd

src/Quaternion.hs

@@ -1,4 +1,6 @@
 module Quaternion
+    ( rotateToZ
+    )
     where
 import Geometry.Data
 import Geometry.Vector3D

src/SameConstr.hs

@@ -2,7 +2,9 @@
 {- | Pulled from
 https://stackoverflow.com/questions/10112733/haskell-simple-constructor-comparison-function
  -}
-module SameConstr where
+module SameConstr 
+    ( eqConstr
+    ) where
 
 import GHC.Generics
 import Data.Function (on)
@@ -34,4 +36,3 @@ instance (GEqC f, GEqC g) => GEqC (f :+: g) where
   geqConstr (L1 x) (L1 y) = geqConstr x y
   geqConstr (R1 x) (R1 y) = geqConstr x y
   geqConstr _ _ = False
-