Commit on return after gap

src/Dodge/Data/LWorld.hs

@@ -30,7 +30,7 @@ module Dodge.Data.LWorld (
     module Dodge.Data.Machine,
     module Dodge.Data.Magnet,
     module Dodge.Data.Modification,
---    module Dodge.Data.PathGraph,
+    --    module Dodge.Data.PathGraph,
     module Dodge.Data.PosEvent,
     module Dodge.Data.PressPlate,
     module Dodge.Data.Projectile,
@@ -46,10 +46,12 @@ module Dodge.Data.LWorld (
     module Dodge.Data.WorldEffect,
 ) where
 
-import NewInt
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
+--import Dodge.Data.PathGraph
+
+import qualified Data.Map.Strict as M
 import Dodge.Data.Beam
 import Dodge.Data.Block
 import Dodge.Data.Bounds
@@ -75,7 +77,6 @@ import Dodge.Data.LinearShockwave
 import Dodge.Data.Machine
 import Dodge.Data.Magnet
 import Dodge.Data.Modification
---import Dodge.Data.PathGraph
 import Dodge.Data.PosEvent
 import Dodge.Data.PressPlate
 import Dodge.Data.Projectile
@@ -91,8 +92,8 @@ import Dodge.Data.Wall
 import Dodge.Data.WorldEffect
 import Geometry.Data
 import qualified IntMapHelp as IM
+import NewInt
 import Picture.Data
-import qualified Data.Map.Strict as M
 
 data LWorld = LWorld
     { _creatures :: IM.IntMap Creature
@@ -102,20 +103,21 @@ data LWorld = LWorld
     , _gusts :: IM.IntMap Gust
     , _props :: IM.IntMap Prop
     , _projectiles :: IM.IntMap Projectile
---    , _instantBullets :: [Bullet]
+    , --    , _instantBullets :: [Bullet]
-    , _bullets :: [Bullet]
+      _bullets :: [Bullet]
     , _radarSweeps :: [RadarSweep]
     , _energyBalls :: [EnergyBall]
     , _posEvents :: [PosEvent]
     , _flames :: [Flame]
     , _sparks :: [Spark]
     , _radarBlips :: [RadarBlip]
-    , _flares :: Picture  -- picture drawn for one frame
+    , _flares :: Picture -- picture drawn for one frame
     , _teslaArcs :: [TeslaArc]
+    , _arcNode :: M.Map ArcNodeType Int
     , _shockwaves :: [Shockwave]
     , _lasers :: [Laser]
---    , _lasersToDraw :: [Laser]
+    , --    , _lasersToDraw :: [Laser]
-    , _linearShockwaves :: IM.IntMap LinearShockwave
+      _linearShockwaves :: IM.IntMap LinearShockwave
     , _tractorBeams :: [TractorBeam]
     , _walls :: IM.IntMap Wall
     , _wallDamages :: IM.IntMap [Damage]
@@ -146,6 +148,7 @@ data LWorld = LWorld
     , _hotkeys :: M.Map Hotkey (NewInt ItmInt)
     , _imHotkeys :: NewIntMap ItmInt Hotkey
     }
+
 --data WorldBeams = WorldBeams
 --    { _blockingBeams :: [Beam]
 --    , _lightBeams :: [Beam]
@@ -153,11 +156,28 @@ data LWorld = LWorld
 --    , _electronBeams :: [Beam]
 --    }
 
+data ArcNodeType
+    = WallArcNode
+        { _wanPos :: Point2
+        , _wanID :: Int
+        }
+    | CrArcNode
+        { _canID :: Int
+        }
+    deriving (Eq, Show, Read, Ord) --Generic, Flat)
+
+makeLenses ''ArcNodeType
 makeLenses ''LWorld
+deriveJSON defaultOptions ''ArcNodeType
+
+instance ToJSONKey ArcNodeType
+
+instance FromJSONKey ArcNodeType
+
 --makeLenses ''WorldBeams
 concat
     <$> mapM
         (deriveJSON defaultOptions)
-        [-- ''WorldBeams
+        [ -- ''WorldBeams
-         ''LWorld
+          ''LWorld
         ]

src/Dodge/Default/World.hs

@@ -116,6 +116,7 @@ defaultLWorld =
         , --        , _newBeams = WorldBeams [] [] [] []
           --        , _beams = WorldBeams [] [] [] []
           _teslaArcs = []
+        , _arcNode = mempty
         , _shockwaves = []
         , _lasers = []
 --        , _lasersToDraw = []

src/Dodge/Inventory/Path.hs

@@ -11,7 +11,7 @@ getInventoryPath x ip itid cr = case ip of
     RELCURS -> do
         selid <- cr ^? crManipulation . manObject . imSelectedItem
         guard $ (x + selid) `IM.member` (cr ^. crInv)
-        return $ (x + selid)
+        return (x + selid)
     RELITEM
         | (itid + x) `IM.member` (cr ^. crInv) ->
             return $ itid + x

src/Dodge/Inventory/SelectionList.hs

@@ -46,7 +46,7 @@ invSelectionItem w indent loc =
 -- space leak
 itemDisplay :: World -> Creature -> ComposedItem -> [String]
 itemDisplay w cr ci = -- f
-        (basicItemDisplay itm)
+        basicItemDisplay itm
 --        (itemNumberDisplay w cr ci)
         `g` anyextra
   where
@@ -104,7 +104,7 @@ itemExternalValue itm w cr
     | otherwise = mempty
 
 ugateCalc :: Int -> Int -> Int
-ugateCalc x y = (x `div` ((2::Int) ^ ((f y) ::Int))::Int) `mod` 2
+ugateCalc x y = (x `div` ((2::Int) ^ (f y ::Int))::Int) `mod` 2
   where
     f i | i > 0 = 1
         | otherwise = 0

src/Dodge/Tesla.hs

@@ -1,11 +1,10 @@
 module Dodge.Tesla (
     makeTeslaArc,
---    updateTeslaArc,
+    --    updateTeslaArc,
 ) where
 
-import Dodge.Movement.Turn
+import Control.Applicative
 import Control.Monad
-import Dodge.WorldEvent.ThingsHit
 --import Control.Applicative
 --import Data.Foldable
 --import Data.List (uncons) --(sortOn)
@@ -15,6 +14,8 @@ import Data.Maybe
 import Dodge.Data.ArcStep
 import Dodge.Data.CrWlID
 import Dodge.Data.World
+import Dodge.Movement.Turn
+import Dodge.WorldEvent.ThingsHit
 --import Dodge.Spark
 import Geometry
 --import qualified IntMapHelp as IM
@@ -22,6 +23,7 @@ import LensHelp
 --import MonadHelp
 import Picture
 import RandomHelp
+
 --import Shape
 
 makeTeslaArc :: ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
@@ -40,36 +42,58 @@ makeTeslaArc ip pos dir w =
     newarc = updateArc ip w pos dir & evalState $ _randGen w
 
 updateArc :: ItemParams -> World -> Point2 -> Float -> State StdGen [ArcStep]
-updateArc ip w p dir = take 10 <$> zipArcs dir w (ArcStep p dir NothingID) carc
+updateArc ip w p dir = take 10 <$> zipArcs endarc w (ArcStep p dir NothingID) carc
   where
+    endarc = snd <$> unsnoc (_currentArc ip)
     carc = case _currentArc ip of
         (_ : xs) -> xs
         [] -> []
 
-zipArcs :: Float -> World -> ArcStep -> [ArcStep] -> State StdGen [ArcStep]
+zipArcs :: Maybe ArcStep -> World -> ArcStep -> [ArcStep] -> State StdGen [ArcStep]
-zipArcs d w x ys = (x:) <$> do
+zipArcs d w x ys =
-    let mys = uncons ys
+    (x :) <$> do
-    na <- nextArc d w x (fmap fst mys)
+        let mys = uncons ys
-    case na of
+        na <- nextArc d w x (fmap fst mys)
-        Just a -> zipArcs d w a (join $ maybeToList (fmap snd mys))
+        case na of
-        Nothing -> return []
+            Just a -> zipArcs d w a (join $ maybeToList (fmap snd mys))
+            Nothing -> return []
 
-nextArc :: Float -> World -> ArcStep -> Maybe ArcStep -> State StdGen (Maybe ArcStep)
+nextArc ::
-nextArc _ w lastarc mx
+    Maybe ArcStep ->
+    World ->
+    ArcStep ->
+    Maybe ArcStep ->
+    State StdGen (Maybe ArcStep)
+nextArc endarc w lastarc mx
     | ArcStep p d NothingID <- lastarc = do
-        offset <- randInCirc 5
+        offset <- randInCirc 20
         let pdir = 20 * unitVectorAtAngle d
-            (dout,pout) = fromMaybe (d,pdir) $ do
+            (dout, pout) = fromMaybe (d, pdir) $ do
-                p' <- mx ^? _Just . asPos
+                p' <- endArcPos endarc <|> mx ^? _Just . asPos
-                let d' = turnTo 0.5 p p' d
+                let tangle = 0.5
-                return $ (d', vecTurnTo 0.5 p p' pdir)
+                    d' = turnTo tangle p p' d
-            newp = p + pout + offset
+                return (d', vecTurnTo tangle p p' pdir)
+            newp = fromMaybe (p + pout + offset) $ do
+                p' <- endArcPos endarc
+                guard $ dist p' p < 20
+                return p'
         return $ case thingHit p newp w of
             Nothing -> Just $ ArcStep newp dout NothingID
             Just (p', Left cr) -> Just $ ArcStep p' dout (CrID (_crID cr))
             Just (p', Right wl) -> Just $ ArcStep p' dout (WlID (_wlID wl))
     | otherwise = return Nothing
 
+-- might want to check whether any cr/wall exists
+endArcPos :: Maybe ArcStep -> Maybe Point2
+endArcPos mas = do
+    as <- mas
+    case as ^. asObject of
+        NothingID -> Nothing
+        CrID {} -> do
+            as ^? asPos
+        WlID {} -> do
+            as ^? asPos
+
 --nextArc :: Float -> World -> ArcStep -> Maybe ArcStep -> State StdGen (Maybe ArcStep)
 --nextArc d w lastarc mx
 --    | ArcStep p d NothingID <- lastarc = do

src/Geometry/Vector.hs

@@ -192,11 +192,7 @@ dist :: Point2 -> Point2 -> Float
 dist !p1 !p2 = magV (p2 -.- p1)
 
 -- | Finds a new angle a given fraction between two other angles
-tweenAngles ::
+tweenAngles :: Float -> Float -> Float -> Float
-    Float ->
-    Float ->
-    Float ->
-    Float
 {-# INLINE tweenAngles #-}
 tweenAngles frac a1 a2
     | abs (a1 - a2) < pi = frac * (a1 - a2) + a2