Work on autodoor pathing
This commit is contained in:
@@ -112,7 +112,7 @@ switchDoor btpos btrot dra drb col = pContID
|
||||
sps0 (doorbetween btid drb drc)
|
||||
where
|
||||
--doorbetween btid a b = PutSlideDr thedoor (switchWallCol col)
|
||||
doorbetween btid a b = PutSlideDr thedoor defaultSwitchWall
|
||||
doorbetween btid a b = PutSlideDr thedoor defaultDoorWall
|
||||
(S.fromList (WallObstacle <$> [WallNotAutoOpen,WallBlockVisibility])) 1 a b
|
||||
where
|
||||
thedoor =
|
||||
|
||||
@@ -29,7 +29,6 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
|
||||
(damageTypeThreshold dt)
|
||||
)
|
||||
)
|
||||
-- defaultMachineWall
|
||||
Nothing
|
||||
|
||||
damageTypeThreshold :: SensorType -> Int
|
||||
|
||||
@@ -36,7 +36,6 @@ putTerminalFull f col mc tm =
|
||||
( mc & mcMounts . at OTButton ?~ fromJust (_plMID btpl)
|
||||
& mcMounts . at OTTerminal .~ _plMID tmpl
|
||||
)
|
||||
-- defaultMachineWall
|
||||
Nothing
|
||||
)
|
||||
$ \mcpl -> Just $ pt0 (PutWorldUpdate $ const $ const $ over gwWorld (setids tmpl btpl mcpl)) (\_ -> f tmpl btpl mcpl)
|
||||
|
||||
@@ -1,10 +1,19 @@
|
||||
module Dodge.Placement.Instance.Wall where
|
||||
module Dodge.Placement.Instance.Wall
|
||||
(invisibleWall, crystalLine, blockLine, putBlockRect
|
||||
,baseBlockPane
|
||||
,midWall
|
||||
,windowLine
|
||||
,putBlockN
|
||||
,putBlockV
|
||||
,heightWallPS
|
||||
,replacePutID
|
||||
) where
|
||||
|
||||
import qualified Data.Set as S
|
||||
import Dodge.Material.Color
|
||||
import Control.Lens
|
||||
import Data.List
|
||||
import Dodge.Data.GenWorld
|
||||
import Dodge.Default.Block
|
||||
import Dodge.Default.Wall
|
||||
import Dodge.LevelGen.PlacementHelper
|
||||
import Dodge.Placement.Instance.Block
|
||||
@@ -27,13 +36,13 @@ invisibleWall ps =
|
||||
midWall :: [Point2] -> Placement
|
||||
midWall = heightWallPS (PS 0 0) 50
|
||||
|
||||
singleBlock :: Point2 -> [Placement]
|
||||
singleBlock a =
|
||||
[ sPS a 0 $
|
||||
PutBlock defaultBlock baseBlockPane $
|
||||
reverse $
|
||||
square 10
|
||||
]
|
||||
--singleBlock :: Point2 -> [Placement]
|
||||
--singleBlock a =
|
||||
-- [ sPS a 0 $
|
||||
-- PutBlock defaultBlock baseBlockPane $
|
||||
-- reverse $
|
||||
-- square 10
|
||||
-- ]
|
||||
|
||||
{-
|
||||
Places a line of blocks between two points.
|
||||
@@ -65,35 +74,28 @@ crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall 7 a b
|
||||
-- ]
|
||||
-- left = 7 *.* normalizeV (a-.-b)
|
||||
-- up = vNormal left
|
||||
{- Places an unbreakable wall between two points.
|
||||
Depth 15, does not extend wider than points.
|
||||
-}
|
||||
wallLine :: Point2 -> Point2 -> Placement
|
||||
wallLine a b = sps0 $ PutWall ps defaultWall
|
||||
where
|
||||
ps =
|
||||
[ a +.+ up
|
||||
, a -.- up
|
||||
, b -.- up
|
||||
, b +.+ up
|
||||
]
|
||||
left = 15 *.* normalizeV (a -.- b)
|
||||
up = vNormal left
|
||||
--
|
||||
--{- Places an unbreakable wall between two points.
|
||||
--Depth 15, does not extend wider than points.
|
||||
-- -}
|
||||
--wallLine :: Point2 -> Point2 -> Placement
|
||||
--wallLine a b = sps0 $ PutWall ps defaultWall
|
||||
-- where
|
||||
-- ps =
|
||||
-- [ a +.+ up
|
||||
-- , a -.- up
|
||||
-- , b -.- up
|
||||
-- , b +.+ up
|
||||
-- ]
|
||||
-- left = 15 *.* normalizeV (a -.- b)
|
||||
-- up = vNormal left
|
||||
|
||||
windowLineType :: Point2 -> Point2 -> PSType
|
||||
windowLineType = PutLineBlock defaultWindow 8
|
||||
--windowLineType :: Point2 -> Point2 -> PSType
|
||||
--windowLineType = PutLineBlock defaultWindow 8
|
||||
|
||||
baseBlockPane :: Wall
|
||||
baseBlockPane =
|
||||
defaultWall
|
||||
{ _wlLine = (V2 0 0, V2 50 0)
|
||||
, _wlID = 0
|
||||
--, _wlColor = greyN 0.5
|
||||
-- , _wlColor = dark $ dark orange
|
||||
--, _wlOpacity = Opaque 10
|
||||
, _wlOpacity = Opaque 17
|
||||
, _wlUnshadowed = True
|
||||
}
|
||||
baseBlockPane = defaultWall & wlOpacity .~ Opaque 17
|
||||
& wlPathFlag .~ S.fromList [WallBlockVisibility, WallNotAutoOpen]
|
||||
|
||||
-- TODO find home for this
|
||||
{- Replaces instances of a given 'PutID' with 'PSType's drawn from a list. -}
|
||||
@@ -127,18 +129,18 @@ subZipWith f g xs ys =
|
||||
isPutID :: Int -> Placement -> Bool
|
||||
isPutID i ps = Just i == ps ^? plType . putID
|
||||
|
||||
putBlockRect' :: Float -> Float -> Placement
|
||||
putBlockRect' w h =
|
||||
ps0jPushPS (aline tl tr) $
|
||||
ps0jPushPS (aline tr br) $
|
||||
ps0jPushPS (aline br bl) $
|
||||
sps0 (aline bl tl)
|
||||
where
|
||||
tl = V2 (- w) h
|
||||
tr = V2 w h
|
||||
br = V2 w (- h)
|
||||
bl = V2 (- w) (- h)
|
||||
aline = PutLineBlock baseBlockPane 9
|
||||
--putBlockRect' :: Float -> Float -> Placement
|
||||
--putBlockRect' w h =
|
||||
-- ps0jPushPS (aline tl tr) $
|
||||
-- ps0jPushPS (aline tr br) $
|
||||
-- ps0jPushPS (aline br bl) $
|
||||
-- sps0 (aline bl tl)
|
||||
-- where
|
||||
-- tl = V2 (- w) h
|
||||
-- tr = V2 w h
|
||||
-- br = V2 w (- h)
|
||||
-- bl = V2 (- w) (- h)
|
||||
-- aline = PutLineBlock baseBlockPane 9
|
||||
|
||||
putBlockRect :: Float -> Float -> Float -> Float -> [Placement]
|
||||
putBlockRect a x b y =
|
||||
@@ -154,12 +156,12 @@ putBlockV a x b y =
|
||||
, blockLine (V2 x b) (V2 a b)
|
||||
]
|
||||
|
||||
putBlockC :: Float -> Float -> Float -> Float -> [Placement]
|
||||
putBlockC a x b y =
|
||||
[ blockLine (V2 a b) (V2 a y)
|
||||
, blockLine (V2 x b) (V2 a b)
|
||||
, blockLine (V2 a y) (V2 x y)
|
||||
]
|
||||
--putBlockC :: Float -> Float -> Float -> Float -> [Placement]
|
||||
--putBlockC a x b y =
|
||||
-- [ blockLine (V2 a b) (V2 a y)
|
||||
-- , blockLine (V2 x b) (V2 a b)
|
||||
-- , blockLine (V2 a y) (V2 x y)
|
||||
-- ]
|
||||
|
||||
putBlockN :: Float -> Float -> Float -> Float -> [Placement]
|
||||
putBlockN a x b y =
|
||||
|
||||
@@ -44,7 +44,7 @@ plDoor eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld
|
||||
wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..]
|
||||
wlps' = rectanglePairs 9 0 (V2 l 0)
|
||||
--addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids
|
||||
addWalls w' = foldl' (addDoorWall eo drid defaultSwitchWall) w' $ zip wlids
|
||||
addWalls w' = foldl' (addDoorWall eo drid defaultDoorWall) w' $ zip wlids
|
||||
$ wlps' & each . each %~ shiftPointBy p1
|
||||
|
||||
addDoorWall :: S.Set EdgeObstacle
|
||||
|
||||
Reference in New Issue
Block a user