Cleanup, add unpause clock

src/Dodge/Data/CWorld.hs

@@ -6,26 +6,24 @@
 module Dodge.Data.CWorld (
     module Dodge.Data.CWorld,
     module Dodge.Data.LWorld,
-    module Dodge.Data.Camera
+    module Dodge.Data.Camera,
 ) where
 
-import Data.Tile
-import Geometry.Data
-import Dodge.Data.LWorld
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
---import Dodge.Data.GenParams
+import Data.Graph.Inductive
+import Data.Tile
+import Dodge.Data.Camera
+import Dodge.Data.LWorld
 import Dodge.GameRoom
 import Geometry.ConvexPoly
-import Dodge.Data.Camera
-import Data.Graph.Inductive
+import Geometry.Data
 
 data CWorld = CWorld
     { _lWorld :: LWorld
     , _cwGen :: CWGen
     , _cClock :: Int
---    , _seenWalls :: IS.IntSet
     , _cwTiles :: [Tile]
     , _pathGraph :: Gr Point2 PathEdge
     , _numberFloorVerxs :: Int
@@ -41,7 +39,6 @@ data CWGen = CWGen
 
 --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-
 makeLenses ''CWorld
 makeLenses ''CWGen
 concat
@@ -49,5 +46,5 @@ concat
         (deriveJSON defaultOptions)
         [ ''CWGen
         , ''CWorld
---        , ''TimeFlowStatus
+        --        , ''TimeFlowStatus
         ]

src/Dodge/Data/World.hs

@@ -51,6 +51,7 @@ data World = World
     , _peZoning :: IntMap (IntMap (Set PathEdgeNodes))
     , _gsZoning :: IntMap (IntMap IntSet)
     , _wCam :: Camera
+    , _unpauseClock :: Int
     }
 
 data TimeFlowStatus

src/Dodge/Default/World.hs

@@ -52,6 +52,7 @@ defaultWorld =
         , _pnZoning = mempty
         , _peZoning = mempty
         , _gsZoning = mempty --Zoning IM.empty clZoneSize (zonePos _guPos)
+        , _unpauseClock = 0
         }
 
 defaultCWGen :: CWGen

src/Dodge/Default/World.hs.orig

@@ -105,7 +105,7 @@ defaultWorld = World
     , _distortions     = []
     , _gameRooms = []
     , _roomClipping = []
-    , _worldClock = 0
+    , _unpauseClock = 0
     , _worldBounds = defaultBounds
     , _maybeWorld = Nothing'
     , _rewindWorlds = []

src/Dodge/Render/Picture.hs

@@ -2,6 +2,7 @@ module Dodge.Render.Picture (
     fixedCoordPictures,
 ) where
 
+import Control.Monad
 import Control.Lens
 import Data.Maybe
 import Dodge.Base.Coordinate
@@ -27,7 +28,7 @@ fixedCoordPictures u =
                 (u ^. uvWorld . cWorld . lWorld . lTestString)
             )
         <> displayFrameTicks u
-        <> aimDelaySweep (u ^. uvWorld)
+        <> aimDelaySweep u
         <> drawMouseCursor u
         <> ( toTopLeft cfig . translate (1.3 * halfWidth cfig) 0
                 . drawList
@@ -261,25 +262,20 @@ drawGapPlus x =
         , line [V2 (-0.5 * x) (- x), V2 (-0.5 * x) x]
         ]
 
-aimDelaySweep :: World -> Picture
-aimDelaySweep w = fold $ do
+aimDelaySweep :: Universe -> Picture
+aimDelaySweep u = fold $ do
+    let w = u ^. uvWorld
+    guard $ null $ u ^. uvScreenLayers
     cr <- w ^? cWorld . lWorld . creatures . ix 0
-    --    aimstatus <- cr ^? crStance . posture
-    --    guard (aimstatus == Aiming)
     Aiming{} <- cr ^? crStance . posture
     return $ drawAimSweep cr w
 
 drawAimSweep :: Creature -> World -> Picture
 drawAimSweep cr w = fold $ do
     a <- safeArgV (mwp -.- p)
-    let a'
-            | a - cdir > pi = cdir + 2 * pi
-            | a - cdir < - pi = cdir - 2 * pi
-            | otherwise = cdir
     return $
         uncurryV translate (worldPosToScreen campos p) $
             arcFull (a - rot) 10 white (a + diffAngles cdir a - rot) 1 white (5 + dist mwp p * campos ^. camZoom) white
-            --arcFull (a - rot) 10 white (a' - rot) 1 white (5 + dist mwp p * campos ^. camZoom) white
   where
     cdir = _crDir cr
     rot = campos ^. camRot

src/Dodge/TestString.hs

@@ -26,7 +26,7 @@ import qualified IntMapHelp as IM
 import qualified Data.Map.Strict as M
 
 testStringInit :: Universe -> [String]
-testStringInit _ = []
+testStringInit u = [show $ u ^. uvWorld . unpauseClock]
 --    foldMap prettyShort $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crTwist
 --    prettyShort $ u ^.. uvWorld . cWorld . lWorld . teslaArcs . ix 0 . taArcSteps . each . asObject
 --testStringInit u = foldMap prettyShort $ u ^. uvWorld . cWorld . lWorld . projectiles

src/Dodge/Update.hs

@@ -158,8 +158,9 @@ updateUniverseMid :: Universe -> Universe
 updateUniverseMid u = case _uvScreenLayers u of
     (OptionScreen{_scOptionFlag = LoadingScreen} : _) -> u
 --    (sl@OptionScreen{_scOptionFlag = GameOverOptions} : _) -> u & updateUseInputOnScreen sl
-    (sl : _) -> u & updateUseInputOnScreen sl
+    (sl : _) -> u & uvWorld . unpauseClock .~ 0 & updateUseInputOnScreen sl
     [] ->
+        (uvWorld . unpauseClock +~ 1) .
         timeFlowUpdate . updateUseInputInGame $
             over
                 uvWorld

src/Dodge/Update/Camera.hs

@@ -190,9 +190,7 @@ setViewDistance cfig w =
         .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. camZoom)
 
 farWallDistDirection :: Point2 -> World -> Maybe (Float, Float, Float, Float)
-farWallDistDirection p w =
-    boundPoints $
-        map f $ getViewpoints p (_cWorld w)
+farWallDistDirection p w = boundPoints $ map f $ getViewpoints p (_cWorld w)
   where
     f q = (rotateV (negate (w ^. wCam . camRot)) . (-.- p)) (foldl' findPoint q (wls q))
     wls q = filter wlIsOpaque $ wlsNearSeg p q w