diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 0fd2279ef..c132cbe2b 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -34,7 +34,8 @@ initialAnoTree = padSucWithCorridors $ treeFromTrunk [[StartRoom] ,[ChainAnos [[SetLabel 0 $ return $ roomRectAutoLinks 100 100 - & rmExtPmnt ?~ externalButton red (anyLnkInPS 5 & psLnkRoomEff .~ putWireStart 0) + & rmExtPmnt ?~ externalButton red + (anyLnkInPS 5 & psLnkRoomEff .~ (putWireStart 0 . extractRoomPos) ) -- & rmStartWires .~ IM.fromList [(0,RoomWire 0 0)] & rmLinkEff .~ [putWireEndInvRmShift 0] ] diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index fa83beaaf..721574c1b 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -14,8 +14,8 @@ import Dodge.LevelGen.Pathing import Dodge.LevelGen.TriggerDoor import Dodge.LevelGen.Data import Dodge.Default.Wall -import Dodge.RandomHelp -import Dodge.Placements.Spot +--import Dodge.RandomHelp +--import Dodge.Placements.Spot import Geometry import Geometry.Vector3D import Shape @@ -26,13 +26,14 @@ import System.Random import Control.Monad.State import Control.Lens import qualified Data.IntSet as IS +import Data.Bifunctor -- when placing a placement, we update the world and the room and assign an id -- to the placement placeSpot :: (World,Room) -> Placement -> ( (World,Room), [Placement] ) placeSpot (w,rm) plmnt = case plmnt of Placement{_plSpot = PSRoomRand i} -> placeSpotRoomRand rm i plmnt w - Placement{_plSpot = PSLnk{}} -> placeSpotUsingLink w rm plmnt + Placement{_plSpot = PSLnk extract eff fallback} -> placeSpotUsingLink w rm plmnt extract eff fallback Placement{} -> let (i,w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w newplmnt = plmnt & plMID ?~ i @@ -48,37 +49,33 @@ placeSpot (w,rm) plmnt = case plmnt of where shift = _rmShift rm +invShiftPSBy :: (Point2,Float) -> PlacementSpot -> PlacementSpot +invShiftPSBy (pos,rot) (PS p r) = PS (invShiftPointBy (pos,rot) p) (r - rot) +invShiftPSBy _ ps = ps + + -- this should be tidied up -placeSpotUsingLink :: World -> Room -> Placement -> ((World, Room), [Placement]) -placeSpotUsingLink w rm plmnt = case lnks of - ((lnki,lnk):_) -> placeSpot (w & randGen .~ g,uselnk lnki lnk) (updatePS (f lnk) plmnt) - [] -> case fallback of +placeSpotUsingLink :: World -> Room -> Placement + -> (RoomPos -> Maybe PlacementSpot) + -> (RoomPos -> Room -> Room) + -> Maybe Placement + -> ((World, Room), [Placement]) +placeSpotUsingLink w rm plmnt extract eff fallback = case searchedPoss (_rmPos rm) of + Just (ps,pos,newrmpos) -> placeSpot (w, eff pos $ rm & rmPos .~ newrmpos) (plmnt & plSpot .~ ps) + Nothing -> case fallback of Nothing -> ((w,rm),[plmnt]) Just plmnt' -> placeSpot (w,rm) plmnt' where - uselnk lnki lnk = _psLnkRoomEff rps (f' lnk rps) rm & rmLinks %~ deletei lnki - rps = _plSpot plmnt - fallback = _psLnkFallback rps - test = _psLnkTest rps - (lnks,g) = runState (shuffle $ filter (test . snd) $ zip [0..] - $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm) $ _randGen w - f' x (PSLnk t s _ _) - | t x = s x - f' _ _ = error "wrong type of link: something is wrong" - f x (PSLnk t s _ _) - | t x = uncurry PS $ s x - f _ ps = ps - invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float) - invShiftLinkBy (pos,rot) (p,r) = (invShiftPointBy (pos,rot) p, r - rot) + searchedPoss [] = error "no correct pos type for lnk placement" + searchedPoss (pos:poss) = case extract (invShiftPosBy (_rmShift rm) pos) of + Nothing -> second (pos:) <$> searchedPoss poss + Just ps -> Just ( ps,pos, poss) placeSpotRoomRand :: Room -> Int -> Placement -> World -> ((World,Room),[Placement]) placeSpotRoomRand rm i plmnt w = let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w in placeSpot (w & randGen .~ g,rm) (plmnt & plSpot .~ uncurry PS ps) -deletei :: Int -> [a] -> [a] -deletei i xs = take i xs ++ drop (i+1) xs - shiftPlacement :: (Point2,Float) -> Placement -> Placement shiftPlacement shift plmnt = case plmnt of Placement {} -> plmnt & plSpot %~ shiftPSBy shift @@ -138,6 +135,17 @@ shiftPointBy (pos,rot) p = pos +.+ rotateV rot p invShiftPointBy :: (Point2,Float) -> Point2 -> Point2 invShiftPointBy (p1,r) p2 = rotateV (-r) $ p2 -.- p1 +invShiftPosBy :: (Point2,Float) -> RoomPos -> RoomPos +invShiftPosBy s rp = case rp of + OutLink i p a -> uncurry (OutLink i) $ invShiftLinkBy s (p,a) + InLink p a -> uncurry (InLink) $ invShiftLinkBy s (p,a) + UnusedLink p a -> uncurry (UnusedLink) $ invShiftLinkBy s (p,a) + PosPl p a -> uncurry (PosPl) $ invShiftLinkBy s (p,a) + LabPos i rp' -> LabPos i $ invShiftPosBy s rp' + +invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float) +invShiftLinkBy (pos,rot) (p,r) = (invShiftPointBy (pos,rot) p, r - rot) + shiftPoint3By :: (Point2,Float) -> Point3 -> Point3 shiftPoint3By (pos,rot) (V3 x y z) = addZ z $ pos +.+ rotateV rot (V2 x y) diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index f2331eeff..150f9e369 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -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' diff --git a/src/Dodge/Placements/Button.hs b/src/Dodge/Placements/Button.hs index 53d079175..ac385cb07 100644 --- a/src/Dodge/Placements/Button.hs +++ b/src/Dodge/Placements/Button.hs @@ -10,18 +10,24 @@ import Dodge.LevelGen.Switch import Dodge.Placements.LightSource import Dodge.Placements.Spot +import Data.Maybe import Control.Lens externalButton :: Color -> PlacementSpot -> Placement -externalButton col ps = pContID ps (PutTrigger (const False)) - $ \trigid -> Just $ pContID ps (PutButton (makeSwitch col col (oneff trigid) (offeff trigid))) +--externalButton col ps = pContID ps (PutTrigger (const False)) +-- $ \trigid -> Just $ pContID ps (PutButton (makeSwitch col col (oneff trigid) (offeff trigid))) +-- (const Nothing) +externalButton col ps = plCont ps (PutTrigger (const False)) + $ \tp -> Just $ pContID ps (PutButton (makeSwitch col col (oneff $ trigid tp) (offeff $ trigid tp))) (const Nothing) where + trigid tp = fromJust $ _plMID tp oneff tid = triggers . ix tid .~ const True offeff tid = triggers . ix tid .~ const False putLitButtonID :: Color -> Point2 -> Float -> (Int -> Maybe Placement) -> Placement putLitButtonID col p a subpl = mntLSOn aShape (Just col) ls p'' (addZ 40 p') + $ contToIDCont $ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = p, _btRot = a}) subpl where @@ -30,12 +36,13 @@ putLitButtonID col p a subpl = mntLSOn aShape (Just col) ls p'' (addZ 40 p') changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0 ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 } -putLitButtonID' :: Color -> ((Point2,Float) -> Bool) -> (Int -> Maybe Placement) -> Placement -putLitButtonID' col f subpl - = updatePSToLevel 3 (const thePS) $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40) - $ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = V2 0 (-1), _btRot = pi}) - subpl +putLitButOnPos :: Color -> (RoomPos -> Maybe PlacementSpot) -> (Int -> Maybe Placement) -> Placement +putLitButOnPos col f subpl + = updatePSToLevel 1 (const thePS) $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40) + $ \plmnt -> let lsid = fromJust $ _plMID plmnt + in jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = V2 0 (-1), _btRot = pi}) + subpl <&> plSpot .~ _plSpot plmnt where changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0 ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 } - thePS = PSLnk f id (const id) Nothing + thePS = PSLnk f (const id) Nothing diff --git a/src/Dodge/Placements/LightSource.hs b/src/Dodge/Placements/LightSource.hs index 5e6a40a12..480dcf46b 100644 --- a/src/Dodge/Placements/LightSource.hs +++ b/src/Dodge/Placements/LightSource.hs @@ -17,10 +17,10 @@ import Shape mntLSOn :: (Point2 -> Point3 -> Shape) -- ^ function describing the mount shape -> Maybe Color -- ^ describing a possible color override for the shape - -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement + -> LightSource -> Point2 -> Point3 -> (Placement -> Maybe Placement) -> Placement mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _) - = ps0j (PutForeground . setCol $ shapeF wallp lsp) - . ps0 (PutLS $ ls {_lsPos = lsp'}) + = ps0jPushPS (PutForeground . setCol $ shapeF wallp lsp) + . pt0 (PutLS $ ls {_lsPos = lsp'}) where lsp' = lsp -.-.- V3 x y 1 -- hack! perturb the light position @@ -79,8 +79,8 @@ vShape wallpos (V3 x y z) = mntLS :: (Point2 -> Point3 -> Shape) -> Point2 -> Point3 -> Placement mntLS shp wallp lampp = mntLSOn shp Nothing defaultLS wallp lampp (const Nothing) -mntLSCond :: (Point2 -> Point3 -> Shape) -> ((Point2,Float) -> Bool) -> Placement -mntLSCond shp cond = updatePSToLevel 2 (const $ PSLnk cond id (const id) Nothing) +mntLSCond :: (Point2 -> Point3 -> Shape) -> (RoomPos -> Maybe PlacementSpot) -> Placement +mntLSCond shp shift = updatePSToLevel 2 (const $ PSLnk shift (const id) Nothing) $ mntLS shp 0 (V3 0 (-40) 90) -- note that this perhaps pushes the vshape light out too far @@ -89,11 +89,16 @@ mntLight a b = RandomPlacement $ do shp <- takeOne [vShape,iShape,lShape,jShape,liShape] return $ mntLS shp a (addZ 90 b) -mntLightLnkCond :: ((Point2,Float) -> Bool) -> Placement +mntLightLnkCond :: (RoomPos -> Maybe PlacementSpot) -> Placement mntLightLnkCond f = RandomPlacement $ do shp <- takeOne [vShape,iShape,lShape,jShape,liShape] return $ mntLSCond shp f +unusedLnkToPS :: RoomPos -> Maybe PlacementSpot +unusedLnkToPS rp = case rp of + UnusedLink p a -> Just $ PS p a + _ -> Nothing + spanColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement spanColLightI col h a b = ps0j (PutLS $ colorLightAt col (V3 x y (h-5)) 0) $ sps0 $ PutForeground $ thinHighBar h a b diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index f1ed9bfe2..f1222fd34 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -114,10 +114,10 @@ addButtonSlowDoor x h rm = do openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2) belowH y = (sndV2 . fst) y < h - 40 aboveH y = (sndV2 . fst) y > h + 40 - butDoor _ _ = putLitButtonID' col butPosCond - --butDoor bpos brot = putLitButtonID col bpos brot + butDoor _ _ = putLitButOnPos col butPosCond $ \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2 - butPosCond (V2 _ y,_) = y < h + butPosCond (UnusedLink (V2 x' y') a') | y' < 0.5 * h = Just $ PS (V2 x' y') a' + butPosCond _ = Nothing --butPosCond _ = True -- y < h col = dim $ light red cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index ae4406958..f6dfc3a78 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -71,7 +71,7 @@ roomRectAutoLinks x y = (roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - {_rmPmnts = plmnts} where plmnts = - [mntLightLnkCond (const True) + [mntLightLnkCond unusedLnkToPS -- ,sps0 $ PutForeground $ thinHighBarChain 50 $ rectNSWE y 0 0 x ] {- Combines two rooms into one room. diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 2d10b4627..67f3d6982 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -104,10 +104,11 @@ glassSwitchBack = do hgt <- state $ randomR (400,600) wllen <- state $ randomR (60,wth/2-40) let hf = hgt/5 - con1 (V2 _ y,_) = y < 0.5*hgt + con1 cond (UnusedLink (V2 x y) a) | cond y = Just $ PS (V2 x y) a + con1 _ _ = Nothing plmnts = - [ mntLightLnkCond con1 - , mntLightLnkCond (not . con1) + [ mntLightLnkCond $ con1 (< 0.5 * hgt) + , mntLightLnkCond $ con1 (> 0.5 * hgt) ,windowLine (V2 (wth-60 ) hf ) (V2 wllen hf ) ,windowLine (V2 (wth-wllen) (2*hf)) (V2 60 (2*hf)) ,windowLine (V2 (wth-60 ) (3*hf)) (V2 wllen (3*hf)) @@ -199,8 +200,8 @@ roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst) , blockLine (V2 125 115) (V2 125 125) --, sPS (V2 40 120) 0 putLamp --, sPS (V2 200 120) 0 putLamp - , mntLightLnkCond (const True) - , mntLightLnkCond (const True) + , mntLightLnkCond unusedLnkToPS + , mntLightLnkCond unusedLnkToPS ] roomOctogon :: Room @@ -249,7 +250,7 @@ weaponEmptyRoom = do ,sPS (V2 20 20) (pi/2) randC1 ,sPS (V2 (w-20) 20) (pi/2) randC1 --,sPS (V2 (w/2) (h/2)) 0 putLamp - ,mntLightLnkCond (const True) + ,mntLightLnkCond unusedLnkToPS ] (fmap connectRoom . randomiseOutLinks) =<< changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts plmnts $ roomRect w h 2 2) @@ -441,10 +442,12 @@ pillarGrid = do y <- takeOne ys a <- state $ randomR (0,2*pi) return (V2 (x+gap) y,a) - cornerRestrict (V2 x y,_) - = (x > 40 && x < h - 40) - || (y > 40 && y < h - 40) - let plmnts = replicate 8 (mntLightLnkCond cornerRestrict) +-- the following was used to stop lights from being mounted in corners and +-- potentially overlapping, might want to redo +-- cornerRestrict (V2 x y,_) +-- = (x > 40 && x < h - 40) +-- || (y > 40 && y < h - 40) + let plmnts = replicate 8 (mntLightLnkCond unusedLnkToPS) ++ concat [f x y | x<-xs,y<-ys] return $ roomRect w h (max i 2) (max i 2) diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index ea4284e84..1b4452f10 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -40,6 +40,6 @@ startRoom = do <$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0) $ roomRectAutoLinks w h & rmPmnts %~ (plmnts ++) - & rmStartWires .~ IM.fromList [(0,RoomWire (V2 0 0) 0)] - & rmEndWires .~ IM.fromList [(0,RoomWire (V2 (500) 500) 0)] + & rmStartWires .~ IM.fromList [(0,RoomWire (V2 0 0) 0)] + & rmEndWires .~ IM.fromList [(0,RoomWire (V2 500 500) 0)] )