Add file

src/Dodge/Camera.hs

@@ -0,0 +1,13 @@
+module Dodge.Camera where
+
+import Dodge.Data.Universe
+import Control.Lens
+
+useNormalCamera :: Universe -> Universe
+useNormalCamera = uvWorld . wCam . camControl .~ CamInGame
+
+pauseAndFloatCam :: Universe -> Universe
+pauseAndFloatCam = uvWorld . wCam . camControl .~ CamFloat
+
+pauseAndPanCam :: Universe -> Universe
+pauseAndPanCam = uvWorld . wCam . camControl .~ CamPan

src/Dodge/Data/Camera.hs

@@ -0,0 +1,36 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Dodge.Data.Camera where
+
+import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry.Data
+
+data CamControl
+    = CamInGame
+    | CamFloat
+    | CamPan
+  deriving (Eq,Show,Read,Enum,Bounded)
+
+data Camera = Camera
+    { _camCenter :: Point2
+    , _camRot :: Float
+    , _camZoom :: Float -- smaller values zoom out
+    , _camItemZoom :: Float
+    , _camDefaultZoom :: Float
+    , _camViewFrom :: Point2
+    , _camViewDistance :: Float -- need to work out what these bounds actually do
+    , _camBoundBox :: [Point2]
+    , _camBoundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
+    , _camControl :: CamControl
+    }
+
+makeLenses ''Camera
+concat
+    <$> mapM
+        (deriveJSON defaultOptions)
+        [''CamControl 
+        ,''Camera ]

src/Dodge/Debug.hs

@@ -0,0 +1,17 @@
+module Dodge.Debug where
+
+import Control.Lens
+import Dodge.Data.Universe
+import qualified Data.Set as S
+
+debugEvents :: Universe -> Universe
+debugEvents u = case dbools ^. at Enable_debug of
+    Nothing -> u 
+    Just () -> S.foldr debugEvent u dbools
+  where
+    dbools = u ^. uvConfig . debug_booleans
+
+debugEvent :: DebugBool -> Universe -> Universe
+debugEvent db u = case db of
+    Collision_test -> u
+    _ -> u

src/Dodge/Shadows.hs

@@ -0,0 +1,14 @@
+module Dodge.Shadows where
+
+import Shape.Data
+
+drawAllShadows :: Surface -> Bool
+drawAllShadows = const False
+
+drawShadowsByImportance :: Importance -> Surface -> Bool
+drawShadowsByImportance si = (si <) . _sfShadowImportance
+
+setShadowLimits :: (Size -> Importance) -> Surface -> Bool
+setShadowLimits f s = _sfShadowImportance s < f (_sfSize s)
+
+

src/Dodge/SmoothScroll.hs

@@ -0,0 +1,37 @@
+module Dodge.SmoothScroll where
+
+import Control.Lens
+import Dodge.Data.Input
+
+-- this is fairly arbitrary, translated across from smooth scrolling on scopes
+calcSmoothScroll :: Int -> Int -> Int
+calcSmoothScroll y
+    | y >= 3 = max 0 . (+ 100)
+    | y >= 2 = max 0 . (+ 10)
+    | y >= 1 = max 0 . (+ 1)
+    | y >= 0 = id
+    | y >= (-1) = min 0 . subtract 1
+    | y >= (-2) = min 0 . subtract 10
+    | otherwise = min 0 . subtract 100
+
+getSmoothScrollValue :: Input -> Int
+getSmoothScrollValue theinput = case theinput ^. smoothScrollAmount of
+    x
+        | x > 10 -> 3
+        | x > 5 -> 2
+        | x > 0 -> 1
+        | x == 0 -> 0
+        | x >= (-5) -> -1
+        | x >= (-10) -> -2
+        | otherwise -> -3
+
+-- this is fairly arbitrary, translated across from smooth scrolling on scopes
+advanceSmoothScroll :: (Ord a, Num a) => a -> a
+advanceSmoothScroll y
+    | y >= 20 = y - 3
+    | y >= 10 = y - 2
+    | y > 0 = y - 1
+    | y == 0 = 0
+    | y > (-10) = y + 1
+    | y > (-20) = y+2
+    | otherwise = y+3

src/HelpNum.hs

@@ -0,0 +1,5 @@
+module HelpNum where
+
+toClosestMultiple :: Float -> Float -> Float
+{-# INLINE toClosestMultiple #-}
+toClosestMultiple m x = m * fromIntegral (round (x / m) :: Int)