Slightly broken placements
This commit is contained in:
+87
-59
@@ -36,9 +36,8 @@ data PSType = PutCrit {_unPutCrit :: Creature}
|
||||
data PlacementSpot
|
||||
= PS { _psPos :: Point2 , _psRot :: Float }
|
||||
| PSLnk
|
||||
{ _psLnkTest :: (Point2,Float) -> Bool
|
||||
, _psLnkShift :: (Point2,Float) -> (Point2,Float)
|
||||
, _psLnkRoomEff :: (Point2,Float) -> Room -> Room
|
||||
{ _psLnkShift :: RoomPos -> Maybe PlacementSpot
|
||||
, _psLnkRoomEff :: RoomPos -> Room -> Room
|
||||
, _psLnkFallback :: Maybe Placement
|
||||
}
|
||||
| PSRoomRand { _psRoomRandPointNum :: Int }
|
||||
@@ -51,62 +50,6 @@ data Placement = Placement
|
||||
| PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position
|
||||
| RandomPlacement {_unRandomPlacement :: State StdGen Placement}
|
||||
|
||||
anyLnkOutPS :: PlacementSpot
|
||||
anyLnkOutPS = PSLnk (const True) id (const id) Nothing
|
||||
|
||||
anyLnkInPS :: Float -- ^ amount to shift inward
|
||||
-> PlacementSpot
|
||||
anyLnkInPS x = PSLnk (const True) f (const id) Nothing
|
||||
where
|
||||
f (v,a) = (v -.- x *.* unitVectorAtAngle (a + 0.5 * pi), a+ pi)
|
||||
|
||||
spNoID :: PlacementSpot -> PSType -> Placement
|
||||
spNoID ps pst = Placement ps pst Nothing (const Nothing)
|
||||
|
||||
pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement
|
||||
pContID ps pt = Placement ps pt Nothing . intPlPlPl
|
||||
|
||||
plCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement
|
||||
plCont ps pt = Placement ps pt Nothing
|
||||
|
||||
sPS :: Point2 -> Float -> PSType -> Placement
|
||||
sPS p a pt = Placement (PS p a) pt Nothing (const Nothing)
|
||||
|
||||
jsps :: Point2 -> Float -> PSType -> Maybe Placement
|
||||
jsps p a pst = Just $ Placement (PS p a) pst Nothing $ const Nothing
|
||||
|
||||
jsps0 :: PSType -> Maybe Placement
|
||||
jsps0 pst = Just $ sPS (V2 0 0) 0 pst
|
||||
|
||||
sps0 :: PSType -> Placement
|
||||
sps0 = sPS (V2 0 0) 0
|
||||
|
||||
jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement
|
||||
jspsJ p a pst plm = Just $ Placement (PS p a) pst Nothing $ \_ -> Just plm
|
||||
|
||||
jsps0J :: PSType -> Placement -> Maybe Placement
|
||||
jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst Nothing $ \_ -> Just plm
|
||||
|
||||
ps0 :: PSType -> (Int -> Maybe Placement) -> Placement
|
||||
ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing . intPlPlPl
|
||||
|
||||
intPlPlPl :: (Int -> Maybe Placement) -> Placement -> Maybe Placement
|
||||
intPlPlPl f = f . fromJust . _plMID
|
||||
|
||||
jps0 :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
|
||||
jps0 pst = Just . Placement (PS (V2 0 0) 0) pst Nothing . intPlPlPl
|
||||
|
||||
ps0j :: PSType -> Placement -> Placement
|
||||
ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (const $ Just plmnt)
|
||||
|
||||
addPlmnt :: Placement -> Placement -> Placement
|
||||
addPlmnt pl pl2 = case pl2 of
|
||||
(PlacementUsingPos p f) -> PlacementUsingPos p (fmap (addPlmnt pl) f)
|
||||
(RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
|
||||
(Placement ps pt mi f) -> Placement ps pt mi (fmap g f)
|
||||
where
|
||||
g Nothing = Just pl
|
||||
g (Just pl') = Just $ addPlmnt pl pl'
|
||||
|
||||
{-
|
||||
The '_rmPolys' list states which polygons should be cut out to form the indestructible walls of the room.
|
||||
@@ -147,7 +90,92 @@ data RoomPos
|
||||
| PosPl Point2 Float
|
||||
| LabPos Int RoomPos
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
extractRoomPos :: RoomPos -> (Point2,Float)
|
||||
extractRoomPos rp = case rp of
|
||||
OutLink _ p a -> (p,a)
|
||||
InLink p a -> (p,a)
|
||||
UnusedLink p a -> (p,a)
|
||||
PosPl p a -> (p,a)
|
||||
LabPos _ rp' -> extractRoomPos rp'
|
||||
|
||||
makeLenses ''Room
|
||||
makeLenses ''PSType
|
||||
makeLenses ''PlacementSpot
|
||||
makeLenses ''Placement
|
||||
|
||||
-- TODO rename to any unused link facing out
|
||||
anyLnkOutPS :: PlacementSpot
|
||||
anyLnkOutPS = PSLnk f (const id) Nothing
|
||||
where
|
||||
f (UnusedLink p a) = Just $ PS p a
|
||||
f _ = Nothing
|
||||
|
||||
|
||||
anyLnkInPS :: Float -- ^ amount to shift inward
|
||||
-> PlacementSpot
|
||||
anyLnkInPS x = PSLnk f (const id) Nothing
|
||||
where
|
||||
f (UnusedLink v a) = Just $ PS (v -.- x *.* unitVectorAtAngle (a + 0.5 * pi)) (a+ pi)
|
||||
f _ = Nothing
|
||||
|
||||
spNoID :: PlacementSpot -> PSType -> Placement
|
||||
spNoID ps pst = Placement ps pst Nothing (const Nothing)
|
||||
|
||||
pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement
|
||||
pContID ps pt = Placement ps pt Nothing . intPlPlPl
|
||||
|
||||
plCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement
|
||||
plCont ps pt = Placement ps pt Nothing
|
||||
|
||||
sPS :: Point2 -> Float -> PSType -> Placement
|
||||
sPS p a pt = Placement (PS p a) pt Nothing (const Nothing)
|
||||
|
||||
jsps :: Point2 -> Float -> PSType -> Maybe Placement
|
||||
jsps p a pst = Just $ Placement (PS p a) pst Nothing $ const Nothing
|
||||
|
||||
jsps0 :: PSType -> Maybe Placement
|
||||
jsps0 pst = Just $ sPS (V2 0 0) 0 pst
|
||||
|
||||
sps0 :: PSType -> Placement
|
||||
sps0 = sPS (V2 0 0) 0
|
||||
|
||||
jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement
|
||||
jspsJ p a pst plm = Just $ Placement (PS p a) pst Nothing $ \_ -> Just plm
|
||||
|
||||
jsps0J :: PSType -> Placement -> Maybe Placement
|
||||
jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst Nothing $ \_ -> Just plm
|
||||
|
||||
ps0 :: PSType -> (Int -> Maybe Placement) -> Placement
|
||||
ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing . intPlPlPl
|
||||
|
||||
pt0 :: PSType -> (Placement -> Maybe Placement) -> Placement
|
||||
pt0 pst = Placement (PS (V2 0 0) 0) pst Nothing
|
||||
|
||||
contToIDCont :: (Int -> Maybe Placement) -> Placement -> Maybe Placement
|
||||
contToIDCont f plmnt = f $ fromJust (_plMID plmnt)
|
||||
|
||||
intPlPlPl :: (Int -> Maybe Placement) -> Placement -> Maybe Placement
|
||||
intPlPlPl f = f . fromJust . _plMID
|
||||
|
||||
jps0 :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
|
||||
jps0 pst = Just . Placement (PS (V2 0 0) 0) pst Nothing . intPlPlPl
|
||||
|
||||
jps0PushPS :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
|
||||
jps0PushPS pst f = Just . Placement (PS (V2 0 0) 0) pst Nothing
|
||||
$ \plmnt -> (f (fromJust $ _plMID plmnt) <&> plSpot .~ _plSpot plmnt)
|
||||
|
||||
ps0j :: PSType -> Placement -> Placement
|
||||
ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (const $ Just plmnt)
|
||||
|
||||
ps0jPushPS :: PSType -> Placement -> Placement
|
||||
ps0jPushPS pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (\p -> Just $ plmnt & plSpot .~ _plSpot p)
|
||||
|
||||
addPlmnt :: Placement -> Placement -> Placement
|
||||
addPlmnt pl pl2 = case pl2 of
|
||||
(PlacementUsingPos p f) -> PlacementUsingPos p (fmap (addPlmnt pl) f)
|
||||
(RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
|
||||
(Placement ps pt mi f) -> Placement ps pt mi (fmap g f)
|
||||
where
|
||||
g Nothing = Just pl
|
||||
g (Just pl') = Just $ addPlmnt pl pl'
|
||||
|
||||
Reference in New Issue
Block a user