switch from list to seq; simplify state update

3 files changed, 51 insertions, 37 deletions

diff --git a/lib/Grav2ty/Control.hs b/lib/Grav2ty/Control.hs
index 120924a..78f6c26 100644
--- a/lib/Grav2ty/Control.hs
+++ b/lib/Grav2ty/Control.hs
@@ -15,7 +15,10 @@ module Grav2ty.Control
 import Grav2ty.Simulation
 
 import Control.Lens
+import Data.Foldable
 import Data.Maybe
+import Data.Sequence ((<|), (|>), (><))
+import qualified Data.Sequence as S
 import Linear.V2
 import Linear.Vector
 import qualified Data.Map as Map
@@ -62,19 +65,19 @@ projectile (pos,speed) tick ship =
   where pPos = objectLoc ship + rotateV2 (objectRot ship) pos
         pSpeed = (15 * rotateV2 (objectRot ship) speed) + objectSpeed ship
 
-applyControls :: RealFloat a => ControlState a -> Object a -> [Object a]
-applyControls _ obj@Static {} = [obj]
+applyControls :: RealFloat a => ControlState a -> Object a -> World a
+applyControls _ obj@Static {} = S.singleton obj
 applyControls cs obj@Dynamic {} =
   if isNothing life || fromJust life >= cs^.ctrlTick
      then moddedObjs
-     else []
+     else S.empty
   where life = objectLife obj
         moddedObjs =
           case objectMod obj of
-            NoMod -> [obj]
+            NoMod -> S.singleton obj
             LocalMod ->
               case Map.lookup (objectMod obj) (cs^.ctrlInputs) of
-                Nothing -> [obj]
+                Nothing -> S.singleton obj
                 Just (Modification rot acc fire) ->
                   let newObj = obj
                        { objectRot = rot
@@ -83,28 +86,26 @@ applyControls cs obj@Dynamic {} =
                       -- Note: we are relying on laziness here: if objectCannon
                       -- is Nothing the pObj never gets evaluated.
                       pObj = projectile (fromJust . objectCannon $ obj) (cs^.ctrlTick) newObj
-                      pList = if cs^.ctrlTick /= fire || isNothing (objectCannon obj)
-                                 then []
-                                 else [pObj]
-                   in newObj : pList
+                   in if cs^.ctrlTick /= fire || isNothing (objectCannon obj)
+                                 then S.singleton newObj
+                                 else S.fromList [pObj, newObj]
 
-type ExtractFunction a b = Object a -> (State a b -> State a b)
+type ExtractFunction a b = Object a -> Maybe (State a b -> State a b)
 
 updateState :: (RealFloat a, Ord a) => a -> ExtractFunction a b
                 -> State a b -> State a b
 updateState t extract state =
   over (control.ctrlTick) (+ 1)
   . set world newWorld
-  . updateState' $ state
+  . fromMaybe id updateState' $ state
   where oldWorld = state^.world
-        (newWorld, updateState') = tailCall oldWorld ([], id)
-        tailCall [] acc = acc
-        tailCall (x:xs) (nw, f) = tailCall xs $
+        (newWorld, updateState') = foldl' updateAndExtract (S.empty, Nothing) oldWorld
+        updateAndExtract acc@(seq, f) x =
           if coll x
-             then (nw, f)
-             else (updateObject' x ++ nw, extract x . f)
+             then acc
+             else (updateObject' x >< seq, (.) <$> extract x <*> f)
         coll obj = isDynamic obj && collisionWithWorld oldWorld obj
         scaledT = state^.control^.ctrlTimeScale * t
         updateObject' obj =
-          map (updateObject scaledT (gravitationForces oldWorld obj))
+          fmap (updateObject scaledT (gravitationForces oldWorld obj))
           . applyControls (state^.control) $ obj
diff --git a/lib/Grav2ty/Simulation.hs b/lib/Grav2ty/Simulation.hs
index 2b61e51..f23b134 100644
--- a/lib/Grav2ty/Simulation.hs
+++ b/lib/Grav2ty/Simulation.hs
@@ -22,6 +22,9 @@ module Grav2ty.Simulation
 
 import Control.Lens
 import Data.Complex
+import Data.Foldable
+import Data.Sequence (Seq (..))
+import qualified Data.Sequence as S
 import Linear.Matrix
 import Linear.Metric (norm, distance)
 import Linear.V2
@@ -144,8 +147,11 @@ collision (HCombined as) b = any (collision b) as
 collision a b@(HCombined _) = collision b a
 
 collisionWithWorld :: (Ord a, RealFloat a) => World a -> Object a -> Bool
-collisionWithWorld world obj = any (\obj' ->
-  obj /= obj' && collision (realHitbox obj) (realHitbox obj')) world
+collisionWithWorld world obj = any
+  (\obj' ->
+    obj /= obj' &&
+    (objectLoc obj == objectLoc obj'
+      ||  collision (realHitbox obj) (realHitbox obj'))) world
 
 data Modifier
   = NoMod            -- ^ Not modified, purely physics based.
@@ -189,7 +195,7 @@ isDynamic :: Object a -> Bool
 isDynamic Dynamic {} = True
 isDynamic _ = False
 
-type World a = [Object a]
+type World a = Seq (Object a)
 
 separated :: (Floating a, Ord a) => Object a -> Object a -> Bool
 separated a b = distance (objectLoc a) (objectLoc b) > 3
@@ -202,18 +208,17 @@ gravitationForce a b = (gravityConst *
         distance = objectLoc b - objectLoc a
         absDistance = norm distance
 
-gravitationForces :: (Ord a, Floating a) => [Object a] -> Object a -> [V2 a]
-gravitationForces []     _   = []
-gravitationForces (w:ws) obj =
-  if separated obj w
-     then gravitationForce obj w : gravitationForces ws obj
-     else gravitationForces ws obj
+gravitationForces :: (Ord a, Floating a) => World a -> Object a -> V2 a
+gravitationForces world obj = foldl' calcSum (pure 0) world
+  where calcSum force x = if separated obj x
+                             then force + gravitationForce obj x
+                             else force
 
-updateObject :: Fractional a =>  a -> [V2 a] -> Object a -> Object a
+updateObject :: Fractional a =>  a -> V2 a -> Object a -> Object a
 updateObject _ _ obj@Static {} = obj
-updateObject timeStep forces obj@Dynamic {} = obj
+updateObject timeStep force obj@Dynamic {} = obj
     { objectLoc   = objectLoc obj + (objectSpeed obj ^* timeStep)
     , objectSpeed = objectSpeed obj +
-      (((sum forces ^/ objectMass obj) + objectAcc obj) ^* timeStep)
+      (((force ^/ objectMass obj) + objectAcc obj) ^* timeStep)
     }
 
diff --git a/src/Main.hs b/src/Main.hs
index 9d30370..4e95e32 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -8,7 +8,9 @@ import Grav2ty.Control
 import Control.Lens
 import Linear.V2
 import Data.Fixed (mod')
+import Data.Foldable
 import Data.Maybe
+import qualified Data.Sequence as S
 import Data.Tuple (uncurry)
 import qualified Data.Map as Map
 import Data.Map.Lens
@@ -58,7 +60,7 @@ renderStars center = undefined
 
 renderGame :: State Float GlossState -> Picture
 renderGame state = Pictures [ renderUi  state, applyViewPort objs ]
-  where objs = Pictures . map renderObject $ state^.world
+  where objs = Pictures . foldl' (\l x -> renderObject x : l) [] $ state^.world
         applyViewPort = if state^.graphics . glossCenterView
                            then applyViewPortToPicture viewport
                            else id
@@ -104,22 +106,28 @@ eventHandler _ s = s
 
 updateWorld :: Float -> State Float GlossState -> State Float GlossState
 updateWorld ts state = updateState ts extract state
-  where extract obj@Dynamic { objectMod = LocalMod } = set
+  where extract obj@Dynamic { objectMod = LocalMod } = Just $ set
           (graphics.glossViewPortCenter)
           (vectorToPoint . objectLoc $ obj)
-        extract _ = id
+        extract _ = Nothing
 
 initialWorld :: Fractional a => State a GlossState
 initialWorld = State
   (ControlState (Map.fromList [(LocalMod, zeroModification)]) 1 0)
-  (GlossState (800, 800) (0, 0) 1 True)
-  [ Dynamic shipHitbox 0 10000 (V2 200 0) (V2 0 0) (V2 0 0) LocalMod (Just (V2 15 0, V2 1 0)) Nothing
-  , Dynamic (centeredCircle 10) 0 5000 (V2 0 200) (V2 15 0) (V2 0 0) NoMod Nothing Nothing
-  , Static (centeredCircle 80) 0 moonMass (V2 0 0)
+  (GlossState (800, 800) (0, 0) 1 True) $ S.fromList
+    [ Dynamic shipHitbox 0 10000 (V2 200 0) (V2 0 0) (V2 0 0) LocalMod (Just (V2 15 0, V2 1 0)) Nothing
+    , Dynamic (centeredCircle 10) 0 5000 (V2 0 200) (V2 15 0) (V2 0 0) NoMod Nothing Nothing
+    , Static (centeredCircle 80) 0 moonMass (V2 0 0)
 --  , Static (centeredCircle 40) 0 (0.5 * moonMass) (V2 250 250)
-  ]
+    ]
   where moonMass = 8e14
 
+testWorld :: State Float GlossState
+testWorld = State
+  (ControlState (Map.empty) 1 0)
+  (GlossState (800, 800) (0, 0) 1 True) .  S.fromList $
+    map (\x -> Dynamic (centeredCircle 2) 0 1000000 (V2 0 (fromIntegral x * 5)) (V2 0 0) (V2 0 0) NoMod Nothing Nothing) [1..10]
+
 main :: IO ()
 main = play
   (InWindow "grav2ty" (initialWorld^.graphics.glossViewPort) (0,0))