diff --git a/src/Dodge/Data/Machine.hs b/src/Dodge/Data/Machine.hs index b5da546ab..0c9c5dd92 100644 --- a/src/Dodge/Data/Machine.hs +++ b/src/Dodge/Data/Machine.hs @@ -33,7 +33,6 @@ data Machine = Machine , _mcMaterial :: Material , _mcPos :: Point2 , _mcDir :: Float --- , _mcColor :: Color , _mcHP :: Int , _mcDamage :: [Damage] , _mcType :: MachineType diff --git a/src/Dodge/Placement/Instance/Pipe.hs b/src/Dodge/Placement/Instance/Pipe.hs index c24f6861c..edf5acf2d 100644 --- a/src/Dodge/Placement/Instance/Pipe.hs +++ b/src/Dodge/Placement/Instance/Pipe.hs @@ -4,7 +4,7 @@ import Geometry import Quaternion verticalPipe :: Float -> Shape -verticalPipe = flip (upperBox Small Typical) (polyCirc 2 5) +verticalPipe = flip (upperCylinder Small Typical) (polyCirc 2 5) horPipe :: Float -> Point2 -> Point2 -> Shape horPipe h x y = translateSH (x `v2z` h) $ overPosSH (rotateToZ (V3 xd yd 0)) $ verticalPipe (dist x y) diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 2ef9d7927..a6ecc13a8 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -13,6 +13,10 @@ module Dodge.Room.Room ( distributerRoom, ) where +import Linear +import Color +import Dodge.Placement.Instance.Pipe +import ShapePicture import Shape import Dodge.Default import Dodge.Data.AmmoType @@ -411,6 +415,7 @@ critsRoom i = distributerRoom :: AmmoType -> Int -> State LayoutVars Room distributerRoom atype aamount = do i <- nextLayoutInt + i1 <- nextLayoutInt w <- state $ randomR (100, 400) h <- state $ randomR (200, 400) r <- roomRectAutoLinks w h @@ -425,8 +430,21 @@ distributerRoom atype aamount = do dst gw = let mj = gw ^? genPmnt . ix i . plMID . _Just in sps (unusedOffPathAwayFromLink 50) (PutMachine (reverse $ square 10) (mcdist mj) Nothing) + & plExternalID ?~ i1 + thepipe gw = + let p1 = gw ^?! genPmnt . ix i . plSpot . psPos + p2 = gw ^?! genPmnt . ix i1 . plSpot . psPos + in sps (PS p1 0) + (PutForeground + (ForegroundShape 0 0 + (noPic . colorSH orange $ horPipe 70 0 (p2 - p1) + <> translateSH (V3 0 0 30) (verticalPipe (70 - 30)) + <> translateSH (0 & _xy .~p2 - p1) (verticalPipe 70) + ) + ) + ) return $ r & rmPmnts .:~ store - & rmInPmnt .:~ (0,dst) + & rmInPmnt <>~ [(0,dst),(1,thepipe)] -- cor <- shuffleLinks corridor -- return $ tToBTree "corDoor" $ treePost [door,cor,cleatOnward door]