Add new weapons

src/Dodge/Tree/Shift.hs

@@ -11,13 +11,14 @@ import Dodge.RoomLink
 import Geometry.ConvexPoly
 import Geometry.Data
 import Padding
+import LensHelp hiding (Empty, (<|) , (|>))
+--import Control.Lens hiding (Empty, (<|) , (|>))
 
 import qualified Data.Set as S
 import Data.Tree
 import Data.Sequence hiding (zipWith)
 import Data.List (delete)
 import Data.Bifunctor
-import Control.Lens hiding (Empty, (<|) , (|>))
 
 type RoomInt = (Room,Int)
 
@@ -42,7 +43,7 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
     child = fst childi
     outlinks = zipCount 
         . Prelude.filter (not . S.null . S.intersection (_rmConnectsTo child) . _rlType) 
-        $ _rmLinks parent 
+        $ _rmLinks parent
     tryParentLinks [] = putStrLn "no viable link pairs, backtrack" >> return Nothing
     tryParentLinks ((j,outlnk):ls) = tryChildLinks $ zipCount (rmInLinks $ fst childi)
       where
@@ -50,7 +51,7 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
         tryChildLinks ((numinlink,il):ils) 
             | clipping  = tryChildLinks ils
             | otherwise = do
-                putStrLn $ show j ++ "-"++show numinlink
+                putStrLn $ show j ++ "-" ++ show numinlink
                 mayrs <- posRms (newBounds ++ bounds) 
                     (first updateparent parenti) its (tseq |> shiftedt)
                 case mayrs of
@@ -58,14 +59,13 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
                     Nothing -> printInfo parenti numChild childi
                         >> tryChildLinks ils
           where
-            newBounds = map pointsToPoly $ _rmBound r'
+            newBounds = map pointsToPoly . _rmBound . doRoomShift . fst $ rootLabel shiftedt
             clipping = or (convexPolysOverlap <$> newBounds <*> bounds)
             updateparent rm = doLnkEff (lnkPosDir outlnk) $ rm 
                 & rmLinks %~ delete outlnk 
-                & rmPos %~ (uncurry (UsedOutLink numChild (snd childi)) (lnkPosDir outlnk) :)
-                & rmChildren %~ (snd childi :)
+                & rmPos .:~ uncurry (UsedOutLink numChild (snd childi)) (lnkPosDir outlnk)
+                & rmChildren .:~ snd childi
             shiftedoutlink = shiftLinkBy (_rmShift parent) outlnk
-            r' = doRoomShift . fst $ rootLabel shiftedt
             updatechild rm = rm 
                 & rmMParent ?~ snd parenti
                 & rmMID     ?~ snd childi