Add new weapons

src/Dodge/Tree/GenerateStructure.hs

@@ -14,6 +14,7 @@ import System.Random
 treePath :: Int -> Tree ()
 treePath 0 = Node () []
 treePath x = Node () [treePath (x-1)]
+
 {- Adds a branch at a certain point down a trunk.  -}
 addBranchAt 
     :: Int      -- ^ Depth to add branch at
@@ -24,6 +25,7 @@ addBranchAt 0 b (Node () xs) = Node () (xs ++ [b])
 addBranchAt i b (Node () (x:xs))
     = Node () (addBranchAt (i-1) b x : xs)
 addBranchAt _ _ _ = error "Trying to add a branch too far along a tree"
+
 {- Randomly generate a tree containing a maximum of three nodes.  -}
 smallBranch :: RandomGen g => State g (Tree ())
 smallBranch = takeOne
@@ -33,9 +35,7 @@ smallBranch = takeOne
     , addBranchAt 0 (treePath 0) (treePath 1)
     ]
 
-{-
-Randomly generate a small tree.
--}
+{- Randomly generate a small tree.  -}
 aTreeStrut :: RandomGen g => State g (Tree ())
 aTreeStrut = do
     d <- state $ randomR (9,11:: Int)

src/Dodge/Tree/Polymorphic.hs

@@ -16,8 +16,7 @@ module Dodge.Tree.Polymorphic
     , addToTrunk
     , inorderNumberTree
     , updateSingleNode
-    )
-    where
+    ) where
 import Dodge.RandomHelp
 
 import Data.Tree
@@ -25,18 +24,14 @@ import Control.Monad.State
 import System.Random
 import Control.Lens
 
-{- |
-Creates a linear tree.
-Safe.
--}
+{- | Creates a linear tree.
+Safe.  -}
 treeFromPost :: [a] -> a -> Tree a
 treeFromPost []     y = Node y []
 treeFromPost (x:xs) y = Node x [treeFromPost xs y]
 
-{- |
-Creates a tree with one trunk branch, 
-input as a list, that ends in another tree.
--}
+{- | Creates a tree with one trunk branch, 
+input as a list, that ends in another tree.  -}
 treeFromTrunk 
     :: [a]      -- ^ The trunk
     -> Tree a   -- ^ The end of the tree
@@ -44,9 +39,7 @@ treeFromTrunk
 treeFromTrunk [] t     = t
 treeFromTrunk (x:xs) t = Node x [treeFromTrunk xs t]
 
-{- |
-Applies a function to the root of a tree.
--}
+{- | Applies a function to the root of a tree.  -}
 applyToRoot :: (a -> a) -> Tree a -> Tree a
 applyToRoot f (Node t ts) = Node (f t) ts
 
@@ -55,10 +48,8 @@ applyToRoot f (Node t ts) = Node (f t) ts
 --treeSize :: Tree a -> Int
 --treeSize = length . flatten
 
-{- |
-Applies a function to a specific node determined by a list of indices.
-Unsafe (partial function).
--}
+{- | Applies a function to a specific node determined by a list of indices.
+Unsafe (partial function).  -}
 applyToNode :: [Int] -> (a -> a) -> Tree a -> Tree a
 applyToNode [] f t = applyToRoot f t
 applyToNode (i:is) f (Node x xs) = Node x (ys ++ [applyToNode is f z] ++ zs)
@@ -95,56 +86,42 @@ subMap _ [] = []
 --zipTree :: Tree a -> Tree b -> Tree (a,b)
 --zipTree (Node x xs) (Node y ys) = Node (x,y) $ zipWith zipTree xs ys
 
-{- |
-Makes each node into its child number, i.e. the index it has 
-in the list of children of its parent.
--}
+{- | Makes each node into its child number, i.e. the index it has 
+in the list of children of its parent.  -}
 treeChildNums :: Tree a -> Tree Int
 treeChildNums = setRoot 0
   where 
     setRoot :: Int -> Tree a -> Tree Int
     setRoot i (Node _ xs) = Node i (zipWith setRoot [0..] xs)
 
-{- |
-Makes each node into its path, i.e. the list of indices that, 
-when followed from the root, lead to the node.
--}
+{- | Makes each node into its path, i.e. the list of indices that, 
+when followed from the root, lead to the node.  -}
 treePaths :: Tree a -> Tree [a]
 treePaths (Node x xs) = (x :) <$> Node [] (map treePaths xs)
 
-{- |
-Picks a random path in the tree.
-Uniform probability that the path leads to any specific node.
--}
+{- | Picks a random path in the tree.
+Uniform probability that the path leads to any specific node.  -}
 randomPath :: RandomGen g => Tree a -> State g [Int]
 randomPath = takeOne . flatten . treePaths . treeChildNums
 
-{- |
-Apply a function to the value of a node; 
-the node is picked uniformly at random.
--}
+{- | Apply a function to the value of a node; 
+the node is picked uniformly at random.  -}
 applyToRandomNode :: RandomGen g => (a -> a) -> Tree a -> State g (Tree a)
 applyToRandomNode f t = do
     p <- randomPath t
     return $ applyToNode p f t
 
-{- |
-Add a forest to the end of a tree (along the trunk).
--}
+{- | Add a forest to the end of a tree (along the trunk).  -}
 addToTrunk :: Tree a -> [Tree a] -> Tree a
 addToTrunk (Node x []) f = Node x f
 addToTrunk (Node x (t:ts)) f = Node x (addToTrunk t f : ts)
 
-{- |
-Find the depth of a tree along the trunk.
--}
+{- | Find the depth of a tree along the trunk.  -}
 trunkDepth :: Tree a -> Int
 trunkDepth (Node _ []) = 0
 trunkDepth (Node _ (x:_)) = trunkDepth x + 1
 
-{- |
-Split a tree at a given point along its trunk.
--}
+{- | Split a tree at a given point along its trunk.  -}
 splitTrunkAt 
     :: Int      -- ^ Split depth
     -> Tree a -> (Tree a, [Tree a])
@@ -154,9 +131,7 @@ splitTrunkAt i (Node y (x:xs)) =
     in (Node y (t : xs) , ts)
 splitTrunkAt _ (Node _ []) = error "Trying to split to short a trunk"
 
-{- |
-Split a tree at a random point along its trunk.
--}
+{- | Split a tree at a random point along its trunk.  -}
 splitTrunk :: RandomGen g => Tree a -> State g (Tree a, [Tree a])
 splitTrunk t = do
     i <- state $ randomR (0, trunkDepth t)

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