cleaning

src/MindMap.hs

@@ -18,12 +18,12 @@ import Data.List (find)
 
 import Types
 
-repKonst = 0.03
+friction :: Double
-friction = 0.05 :: Double
+friction = 0.05
-eqRep    = 96
+l0 :: Double
-l0 = 1 :: Double
+l0 = 1
+springKonst :: Double
 springKonst = 0.8 -- N/m
-gravKonst = 1/2 -- 6.67408e-11
 
 buildMindMap :: Int -> Word -> IO (AG.Graph MMNode)
 buildMindMap num difficulty = do
@@ -31,7 +31,7 @@ buildMindMap num difficulty = do
     makeVert
     [MMNode (V2 10 10) (-1)]
     [1 .. (1 + fromIntegral difficulty)]
-  aux <- randomRIO (0, floor (fromIntegral num * 5 / 8)) :: IO Int
+  aux <- randomRIO (0, floor (fromIntegral num * 5 / 8 :: Double)) :: IO Int
   auxPaths <- mapM (\_ -> do
     len <- randomRIO (0, num `div` 10)
     (path . (MMNode (V2 0 0) 0 :)) <$> foldM makeVert [] [1 .. len]
@@ -61,24 +61,17 @@ springField inGraph =
             | mmId a == mmId node =
               acc + V2 0 0
             | a `elem` map snd (filter ((== node) . fst) $ edgeList graph) =
-              -- acc - fmap (* (1000 / (len (mmPos a - mmPos node)) ^ 2))
-              --   (signorm (mmPos a - mmPos node))
               acc + fmap (* (springKonst * (distance (mmPos a) (mmPos node) - l0)))
                 (normv (mmPos a - mmPos node))
             | node `elem` map snd (filter ((== a) . fst) $ edgeList graph) =
-              -- acc - fmap (* (1000 / (len (mmPos a - mmPos node)) ^ 2))
-              --   (signorm (mmPos a - mmPos node))
               acc - fmap (* (springKonst * (distance (mmPos a) (mmPos node) - l0)))
                 (normv (mmPos node - mmPos a))
             | otherwise =
-              -- acc - V2 0 0
+              acc - fmap (* (1000 / ((distance (mmPos node) (mmPos a)) ^ (2 :: Int))))
-              acc - fmap (* (1000 / ((distance (mmPos node) (mmPos a)) ^ 2)))
                 (normv (mmPos a - mmPos node))
-              -- acc - fmap (* (springKonst * (len (mmPos a - mmPos node))))
-              --   (signorm (mmPos a - mmPos node))
       in  (mmId node, fmap (* friction) accel)
     calcul graph =
-      let deltas = foldl (\acc a -> calculDelta graph a : acc) [] (vertexList graph)
+      let deltas = map (calculDelta graph) (vertexList graph)
       in  if any (\(_, v) -> len v > 0.1)
             (A.log A.Debug ("deltas: " ++ show deltas) deltas)
             -- deltas
@@ -94,39 +87,12 @@ springField inGraph =
     normv v@(V2 0 0) = v
     normv v          = signorm v
 
-forceField :: AG.Graph MMNode -> AG.Graph MMNode
-forceField input =
-  calcul input
-  where
-    calculDelta :: AG.Graph MMNode -> MMNode -> V2 Double
-    calculDelta inGraph n =
-      let accel :: V2 Double
-          accel =
-            foldl (\acc a ->
-              acc +
-                (if n == a || distance (mmPos n) (mmPos a) > eqRep
-                  then V2 0 0
-                  else fmap
-                    (* (repKonst * (dist a - eqRep) / dist a))
-                    (mmPos n - mmPos a)
-                  )
-              )
-            (V2 0 0 :: V2 Double)
-            inGraph
-          dist :: MMNode -> Double
-          dist a = distance (mmPos n) (mmPos a)
-      in  fmap (* friction) accel
-    calcul inGraph =
-      let deltaSum = foldl (\acc a -> acc + (calculDelta inGraph a)) (V2 0 0) inGraph
-      in  if sqrt (deltaSum `dot` deltaSum) > 1e-15
-        then A.log A.Verbose (show deltaSum)
-          (calcul ((\n -> n { mmPos = mmPos n + calculDelta inGraph n }) <$> inGraph))
-        else A.log A.Verbose (show deltaSum) inGraph
-
 buildFloorMap :: AG.Graph MMNode -> M.Matrix Int
 buildFloorMap inGraph =
   foldl
-    (\amat (MMNode (V2 r c) id) -> M.setElem (if id == 0 then -2 else id) (floor r + 2, floor c + 2) amat)
+    (\amat (MMNode (V2 r c) i) -> M.setElem (if i == 0 then -2 else i)
+      (floor r + 2, floor c + 2) amat
+      )
     emptyFloor
     (A.log A.Debug ("floorGraph: " ++ show floorGraph) floorGraph)
   where