Refactor, try to limit dependencies

2022-07-28 00:59:56 +01:00
parent 8aa5c17ab9
commit 160560af5f
418 changed files with 15104 additions and 13342 deletions
@@ -1,124 +1,116 @@
-module Dodge.Tesla.Arc
-    where
-import Dodge.Data
+module Dodge.Tesla.Arc where
+
+import Dodge.Data.CrWlID
+import Dodge.Data.ArcStep
+import Data.Maybe
+import Dodge.ArcStep
 import Dodge.Damage
+import Dodge.Data.World
 import Dodge.Spark
-import RandomHelp
-import Picture
 import Geometry
 import LensHelp
-import Dodge.ArcStep
--import Dodge.Data
--import Geometry
--import LensHelp
--import RandomHelp
--import Color
--import Dodge.Item.Location
--import Dodge.WorldEvent.Damage
--import Dodge.WorldEvent.ThingsHit
--import Dodge.WorldEvent.HelperParticle
--import Dodge.Item.Weapon.LaserPath
--import Geometry
--import LensHelp
--import Picture
--import RandomHelp
--import Dodge.Zone
--import Dodge.Base.Collide
--import Shape
-
--import qualified IntMapHelp as IM
--import Data.List (sortOn)
 import MonadHelp
-import Data.Maybe
--import qualified IntMapHelp as IM
+import Picture
+import RandomHelp

 aTeslaArcAt :: Color -> [ArcStep] -> TeslaArc
-aTeslaArcAt col thearc = TeslaArc
-    { _taPoints = map (^. asPos) thearc
-    , _taArcSteps = thearc
-    , _taTimer = 2
-    , _taColor = brightX 100 1.5 col
-    }
+aTeslaArcAt col thearc =
+    TeslaArc
+        { _taPoints = map (^. asPos) thearc
+        , _taArcSteps = thearc
+        , _taTimer = 2
+        , _taColor = brightX 100 1.5 col
+        }

-moveTeslaArc :: World
-    -> TeslaArc
-    -> (World,Maybe TeslaArc)
+moveTeslaArc ::
+    World ->
+    TeslaArc ->
+    (World, Maybe TeslaArc)
 moveTeslaArc w pt
-    | _taTimer pt == 2  = (makesparks $ foldr damthings w thearc, Just $ pt & taTimer -~ 1)
-    | _taTimer pt < 1   = (w, Nothing)
-    | otherwise         = (w, Just $ pt & taTimer -~ 1)
+    | _taTimer pt == 2 = (makesparks $ foldr damthings w thearc, Just $ pt & taTimer -~ 1)
+    | _taTimer pt < 1 = (w, Nothing)
+    | otherwise = (w, Just $ pt & taTimer -~ 1)
  where
    thearc = _taArcSteps pt
-    rcol = brightX 100 1.5 <$> takeOne [white,azure,blue,cyan]
-    rdir = state (randomR (-0.7,0.7)) <&> (+ ld)
-    rspeed = state (randomR (3,6))
+    rcol = brightX 100 1.5 <$> takeOne [white, azure, blue, cyan]
+    rdir = state (randomR (-0.7, 0.7)) <&> (+ ld)
+    rspeed = state (randomR (3, 6))
    makeaspark = randSpark ELECTRICAL rspeed rcol rdir lp
    makesparks = makeaspark . makeaspark . makeaspark
-    (lp,ld) = case last thearc of
-        ArcStep lp' ld' NothingID -> (lp',ld')
+    (lp, ld) = case last thearc of
+        ArcStep lp' ld' NothingID -> (lp', ld')
        ArcStep lp' ld' (CrID crid) -> case w ^? cWorld . creatures . ix crid of
-            Nothing -> (lp',ld')
-            Just cr -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld',ld'+pi)
+            Nothing -> (lp', ld')
+            Just cr -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld', ld' + pi)
        ArcStep lp' ld' (WlID wlid) -> case w ^? cWorld . walls . ix wlid of
-            Nothing -> (lp',ld')
-            Just _ -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi)
+            Nothing -> (lp', ld')
+            Just _ -> (lp' -.- 2 *.* unitVectorAtAngle ld', ld' + pi)
    --damthings (ArcStep _ _ NothingID) = id
    damthings (ArcStep p dir crwl) = damageCrWlID (thedamage p dir) crwl
    thedamage p dir = Damage ELECTRICAL 50 (p -.- q) p (p +.+ q) NoDamageEffect
      where
        q = 5 *.* unitVectorAtAngle dir

-shootTeslaArc' :: ItemParams -> Point2 -> Float -> World -> (World,ItemParams)
-shootTeslaArc' ip pos dir w = 
-    (w & randGen .~ g
-       & cWorld . teslaArcs .:~ aTeslaArcAt col newarc
+shootTeslaArc' :: ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
+shootTeslaArc' ip pos dir w =
+    ( w & randGen .~ g
+        & cWorld . teslaArcs .:~ aTeslaArcAt col newarc
    , ip & currentArc ?~ newarc
    )
  where
-    (col,g) = takeOne [white,azure,blue,cyan] & runState $ _randGen w
+    (col, g) = takeOne [white, azure, blue, cyan] & runState $ _randGen w
    newarc = createArc ip w pos dir & evalState $ _randGen w

-createArc :: ItemParams
-    -> World
-    -> Point2
-    -> Float
-    -> State StdGen [ArcStep]
+createArc ::
+    ItemParams ->
+    World ->
+    Point2 ->
+    Float ->
+    State StdGen [ArcStep]
 createArc arcparams@Arcing{_currentArc = Nothing} w p dir = createNewArc arcparams w p dir
 createArc arcparams w p dir = updateArc arcparams w p dir

-createNewArc :: ItemParams -> World -> Point2 -> Float
-    -> State StdGen [ArcStep]
-createNewArc arcparams w p dir = take (_arcNumber arcparams)
-    <$> unfoldrMID (doStep (_newArcStep arcparams) arcparams w) (ArcStep p dir NothingID)
+createNewArc ::
+    ItemParams ->
+    World ->
+    Point2 ->
+    Float ->
+    State StdGen [ArcStep]
+createNewArc arcparams w p dir =
+    take (_arcNumber arcparams)
+        <$> unfoldrMID (doStep (_newArcStep arcparams) arcparams w) (ArcStep p dir NothingID)

-updateArc :: ItemParams
-    -> World
-    -> Point2
-    -> Float
-    -> State StdGen [ArcStep]
+updateArc ::
+    ItemParams ->
+    World ->
+    Point2 ->
+    Float ->
+    State StdGen [ArcStep]
 updateArc ip w p dir = take (_arcNumber ip) <$> zipArcs ip w (ArcStep p dir NothingID) carc
  where
    carc = tail $ fromJust $ _currentArc ip

-zipArcs :: ItemParams
-    -> World
-    -> ArcStep
-    -> [ArcStep]
-    -> State StdGen [ArcStep]
-zipArcs ip w x (y:ys) = (x :) <$> do  
-    defaultnext <- doStep (_newArcStep ip) ip w x
-    case defaultnext of
-        Nothing -> return []
-        Just z@(ArcStep _ _ (CrID _)) -> return [z]
-        Just z@(ArcStep _ _ (WlID _)) -> return [z]
-        Just z -> do
-            p <- randInCirc 5
-            let csize = _arcSize ip
-                center = _asPos x +.+ csize *.* unitVectorAtAngle (_asDir x)
-                newp = _asPos y +.+ p
-                --newdir = argV $ newp -.- _asPos x
-                newdir = _asDir x
-            if dist newp center < csize
-                then zipArcs ip w (y & asPos .~ newp & asDir .~ newdir) ys
-                else zipArcs ip w z ys
+zipArcs ::
+    ItemParams ->
+    World ->
+    ArcStep ->
+    [ArcStep] ->
+    State StdGen [ArcStep]
+zipArcs ip w x (y : ys) =
+    (x :) <$> do
+        defaultnext <- doStep (_newArcStep ip) ip w x
+        case defaultnext of
+            Nothing -> return []
+            Just z@(ArcStep _ _ (CrID _)) -> return [z]
+            Just z@(ArcStep _ _ (WlID _)) -> return [z]
+            Just z -> do
+                p <- randInCirc 5
+                let csize = _arcSize ip
+                    center = _asPos x +.+ csize *.* unitVectorAtAngle (_asDir x)
+                    newp = _asPos y +.+ p
+                    --newdir = argV $ newp -.- _asPos x
+                    newdir = _asDir x
+                if dist newp center < csize
+                    then zipArcs ip w (y & asPos .~ newp & asDir .~ newdir) ys
+                    else zipArcs ip w z ys
 zipArcs ip w y _ = createNewArc ip w (_asPos y) (_asDir y)
@@ -1,36 +1,44 @@
 module Dodge.Tesla.Arc.Default where
-import Dodge.Data
-import RandomHelp
-import Geometry
+
+import Dodge.Data.CrWlID
+import Data.List (sortOn)
+import Data.Maybe
 import Dodge.Base.Collide
+import Dodge.Data.ArcStep
+import Dodge.Data.World
+import Geometry
+import qualified IntMapHelp as IM
 import LensHelp
+import RandomHelp
 import Shape

-import Data.Maybe
-import Data.List (sortOn)
-import qualified IntMapHelp as IM
-
-defaultArcStep :: RandomGen g => ItemParams -> World -> ArcStep
-    -> State g (Maybe ArcStep)
-defaultArcStep _     _ (ArcStep _ _ (CrID _)) = return Nothing
-defaultArcStep _     _ (ArcStep _ _ (WlID _)) = return Nothing
+defaultArcStep ::
+    RandomGen g =>
+    ItemParams ->
+    World ->
+    ArcStep ->
+    State g (Maybe ArcStep)
+defaultArcStep _ _ (ArcStep _ _ (CrID _)) = return Nothing
+defaultArcStep _ _ (ArcStep _ _ (WlID _)) = return Nothing
 defaultArcStep itparams w (ArcStep p dir _) = do
    let csize = _arcSize itparams
    --rot <- takeOne [pi/4,negate pi/4]
    rot <- takeOne [0]
    let center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p
    newp <- (center +.+) <$> randInCirc csize
-    let mcr = listToMaybe 
-            . sortOn (dist center . _crPos) 
-            . filter (\cr -> dist center (_crPos cr) < csize)
-            . IM.elems
-            $ _creatures (_cWorld w)
-        mwl = listToMaybe
-            . sortOn (dist p . fst)
-            . mapMaybe (\ q -> sequence $ collidePointWallsFilterStream (const True) p (center +.+ q) w)
+    let mcr =
+            listToMaybe
+                . sortOn (dist center . _crPos)
+                . filter (\cr -> dist center (_crPos cr) < csize)
+                . IM.elems
+                $ _creatures (_cWorld w)
+        mwl =
+            listToMaybe
+                . sortOn (dist p . fst)
+                . mapMaybe (\q -> sequence $ collidePointWallsFilterStream (const True) p (center +.+ q) w)
                -- collidePointWallsWall and wlsnearpoint
-            $ polyCirc 6 csize
-        f (q,wl) = ArcStep q dir (WlID $ _wlID wl)
-        g cr   = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (CrID $ _crID cr)
-    return . listToMaybe . sortOn (dist p . (^. asPos))
-        $ ArcStep newp dir NothingID : catMaybes [fmap f mwl,fmap g mcr]
+                $ polyCirc 6 csize
+        f (q, wl) = ArcStep q dir (WlID $ _wlID wl)
+        g cr = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (CrID $ _crID cr)
+    return . listToMaybe . sortOn (dist p . (^. asPos)) $
+        ArcStep newp dir NothingID : catMaybes [fmap f mwl, fmap g mcr]
@@ -1,12 +1,15 @@
 module Dodge.Tesla.Arc.Draw where
+
 import Dodge.Data.TeslaArc
 import Geometry
 import Picture
+
 drawTeslaArc :: TeslaArc -> Picture
-drawTeslaArc pt = setLayer BloomNoZWrite $ pictures 
-    [ setDepth 20.5 $ color (brightX 2 1 $ _taColor pt) $ thickLine  3 ps
-    , setDepth 20   $ color (V4 0 0 0 0.5)              $ thickLine 10 ps
-    ]
+drawTeslaArc pt =
+    setLayer BloomNoZWrite $
+        pictures
+            [ setDepth 20.5 $ color (brightX 2 1 $ _taColor pt) $ thickLine 3 ps
+            , setDepth 20 $ color (V4 0 0 0 0.5) $ thickLine 10 ps
+            ]
  where
    ps = _taPoints pt
-
@@ -1,5 +1,6 @@
 module Dodge.Tesla.Ball where
-import Dodge.Data
+
+import Dodge.Data.World
 import Geometry

 makeTeslaBallAt :: Point2 -> World -> World
@@ -1,11 +1,14 @@
 module Dodge.Tesla.ItemParams where
-import Dodge.Data
+
+import Dodge.Data.ArcStep
+import Dodge.Data.Item.Params

 teslaParams :: ItemParams
-teslaParams = Arcing 
-    { _currentArc = Nothing
-    , _arcSize = 20
-    , _arcNumber = 10
-    , _newArcStep = DefaultArcStep --defaultArcStep
-    , _previousArcEffect = NoPreviousArcEffect
-    }
+teslaParams =
+    Arcing
+        { _currentArc = Nothing
+        , _arcSize = 20
+        , _arcNumber = 10
+        , _newArcStep = DefaultArcStep --defaultArcStep
+        , _previousArcEffect = NoPreviousArcEffect
+        }