Add more wall reflection/randomisation

src/Dodge/Tesla/Arc.hs

@@ -31,29 +31,42 @@ updateTeslaArc ::
     TeslaArc ->
     (World, Maybe TeslaArc)
 updateTeslaArc w pt
-    | _taTimer pt == 2 = (makesparks $ foldl' (flip damthings) w thearc, Just $ pt & taTimer -~ 1)
+    | _taTimer pt == 2 = (makesparks $ foldl' (flip 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)
+--    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')
+    rp x = randPeakedParam 2 (x - 0.7) x (x +0.7)
+    (lp, rdir) = case last thearc of
+        ArcStep lp' ld' NothingID -> (lp', rp ld')
         ArcStep lp' ld' (CrID crid) -> case w ^? cWorld . lWorld . creatures . ix crid of
-            Nothing -> (lp', ld')
-            Just cr -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld', ld' + pi)
+            Nothing -> (lp', rp ld')
+            Just cr -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld', rp $ ld' + pi)
         ArcStep lp' ld' (WlID wlid) -> case w ^? cWorld . lWorld . walls . ix wlid of
-            Nothing -> (lp', ld')
-            Just _ -> (lp' -.- 2 *.* unitVectorAtAngle ld', ld' + pi)
+            Nothing -> (lp', rp ld')
+            --Just _ -> (lp' -.- 2 *.* unitVectorAtAngle ld', ld' + pi)
+            Just wl -> (lp' -.- 2 *.* unitVectorAtAngle ld'
+--                , uncurry (reflectAngle ld') (_wlLine wl))
+                , randWallReflect ld' wl)
     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
 
+randWallReflect :: RandomGen g => Float -> Wall -> State g Float
+randWallReflect a wl = do
+    let (x,y) = _wlLine wl
+        outa = reflectAngle a x y
+        a1 = nearestAngleRep outa $ argV (x-y)
+        a2 = if a1 < outa then a1 + pi else a1 - pi
+    randPeaked a1 outa a2
+
 makeTeslaArc :: ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
 makeTeslaArc ip pos dir w =
     ( w & randGen .~ g

src/Geometry.hs

@@ -139,6 +139,20 @@ difference x y
 reflectIn :: Point2 -> Point2 -> Point2
 reflectIn line vec = rotateV (2 * angleBetween line vec) vec
 
+-- takes an angle of entry (measured from x axis) and two wall points and gives a
+-- reflected angle (from x axis)
+reflectAngle :: Float -> Point2 -> Point2 -> Float
+reflectAngle a x y = 2 * argV (x - y) - a
+
+{- | Find the representation (by applying +-pi) of an angle 
+ - that is nearest to another given angle -}
+nearestAngleRep :: Float -> Float -> Float
+nearestAngleRep a b
+    | b >= a && b - a <= pi = b
+    | b >= a = nearestAngleRep a (b - 2*pi)
+    | a - b <= pi = b
+    | otherwise = nearestAngleRep a (b + 2*pi)
+
 {- | Find angle between two points.
  Not normalised, ranges from -2*pi to 2*pi.
 -}

src/RandomHelp.hs

@@ -121,3 +121,14 @@ randsSpread (a, b) i
 
 randsOnCirc :: RandomGen g => Int -> State g [Float]
 randsOnCirc = randsSpread (0, 2 * pi)
+
+randPeakedParam :: RandomGen g => Int -> Float -> Float -> Float -> State g Float
+randPeakedParam i a b c = do
+    x <- state $ randomR (-1, 1)
+    let y = x ^ i
+    return $ if y < 0
+        then a + y * (a-b)
+        else b + y * (c-b)
+
+randPeaked :: RandomGen g => Float -> Float -> Float -> State g Float
+randPeaked = randPeakedParam 3