diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 125c9dcb7..0fd2279ef 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -34,9 +34,9 @@ initialAnoTree = padSucWithCorridors $ treeFromTrunk [[StartRoom] ,[ChainAnos [[SetLabel 0 $ return $ roomRectAutoLinks 100 100 - & rmExtPmnt ?~ externalButton red (anyLnkInPS 5) - & rmStartWires .~ IM.fromList [(0,RoomWire 0 0)] - & rmLinkEff .~ [putWireEnd 0] + & rmExtPmnt ?~ externalButton red (anyLnkInPS 5 & psLnkRoomEff .~ putWireStart 0) +-- & rmStartWires .~ IM.fromList [(0,RoomWire 0 0)] + & rmLinkEff .~ [putWireEndInvRmShift 0] ] ,[UseLabel 0 $ return switchDoorRoom] ] @@ -107,7 +107,8 @@ layoutLevelFromSeed i seed = do putStrLn $ "After " ++ show i' ++ " attempt(s), Successful generation of level with seed " ++ show seed - return (fmap setLastLinkToUsed rs) + --return (fmap setLastLinkToUsed rs) + return rs Nothing -> do putStr $ "Level generation with seed " ++ show seed ++ " failed: " let (seed',_) = random g diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 7e1669f82..317e9a5d2 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -53,7 +53,7 @@ placeRoomWires rm w = IM.foldr ($) w $ IM.intersectionWith (placeWire rm) (_rmStartWires rm) (_rmEndWires rm) placeWire :: Room -> RoomWire -> RoomWire -> World -> World -placeWire rm (RoomWire p' _) (RoomWire q' _) w = w & foregroundShape %~ (thinHighBar 40 p q <>) +placeWire rm (RoomWire p' _) (RoomWire q' _) w = w & foregroundShape %~ (thinHighBar 80 p q <>) where rs = _rmShift rm p = shiftPointBy rs p' diff --git a/src/Dodge/Layout/Tree/Shift.hs b/src/Dodge/Layout/Tree/Shift.hs index c994c24d7..a3c63490f 100644 --- a/src/Dodge/Layout/Tree/Shift.hs +++ b/src/Dodge/Layout/Tree/Shift.hs @@ -29,7 +29,7 @@ posRms -> IO (Maybe [Room]) posRms _ _ [] Empty = return $ Just [] posRms bounds (rtoadd,_) [] (Node (r,i) ts :<| tseq) - = fmap (setLastLinkToUsed rtoadd:) <$> posRms bounds (r,i) ts tseq + = fmap (finalLinksUpdate rtoadd:) <$> posRms bounds (r,i) ts tseq posRms bounds (r,i) (t@(Node (_,i') _):ts) tseq = do putStr $ "Trying to place room " ++ show i' ++ ": " tryLinks (0::Int) (_rmLinks r) diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 8a8611873..f2331eeff 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -119,7 +119,8 @@ assigning no bounds will allow rooms to overlap. -} data Room = Room { _rmPolys :: [ [Point2] ] - , _rmLinks :: [(Point2,Float)] + , _rmLinks :: [(Point2,Float)] + -- update the room when assigning the next link to an adjacent room with the head of of this list, return the tail , _rmLinkEff :: [(Point2,Float) -> Room -> Room] , _rmPos :: [RoomPos] , _rmPath :: [(Point2, Point2)] @@ -142,6 +143,7 @@ data RoomWire data RoomPos = OutLink Int Point2 Float | InLink Point2 Float + | UnusedLink Point2 Float | PosPl Point2 Float | LabPos Int RoomPos deriving (Eq,Ord,Show) diff --git a/src/Dodge/Placements/LightSource.hs b/src/Dodge/Placements/LightSource.hs index afcc125a5..5e6a40a12 100644 --- a/src/Dodge/Placements/LightSource.hs +++ b/src/Dodge/Placements/LightSource.hs @@ -81,13 +81,13 @@ 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) - $ mntLS shp 0 (V3 0 (-40) 40) + $ mntLS shp 0 (V3 0 (-40) 90) -- note that this perhaps pushes the vshape light out too far mntLight :: Point2 -> Point2 -> Placement mntLight a b = RandomPlacement $ do shp <- takeOne [vShape,iShape,lShape,jShape,liShape] - return $ mntLS shp a (addZ 50 b) + return $ mntLS shp a (addZ 90 b) mntLightLnkCond :: ((Point2,Float) -> Bool) -> Placement mntLightLnkCond f = RandomPlacement $ do diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index 177c292d1..13fa37a66 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -13,7 +13,7 @@ module Dodge.Room.Link , randomiseOutLinks , randomiseLinksBy , invShiftLinkBy - , setLastLinkToUsed + , finalLinksUpdate ) where import Dodge.LevelGen import Dodge.LevelGen.Data @@ -78,7 +78,7 @@ shiftRoomToLink l r r where (p,a) = last $ _rmLinks r --- NOTE placements are shifted by the room shift +-- NOTE placements, when placed, will be shifted by the value _rmShift shiftRoomBy :: (Point2,Float) -> Room -> Room shiftRoomBy shift r = r & rmPolys %~ fmap (map (shiftPointBy shift)) @@ -105,9 +105,11 @@ shiftPathBy -> (Point2,Point2) shiftPathBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2) -setLastLinkToUsed :: Room -> Room -setLastLinkToUsed rm = case _rmLinks rm of +finalLinksUpdate :: Room -> Room +finalLinksUpdate rm = case _rmLinks rm of (_:_) -> rm & rmLinks %~ init - & rmPos %~ (uncurry InLink (last (_rmLinks rm)) :) + & rmPos %~ ( (uncurry InLink (last thelnks) :) . (map (uncurry UnusedLink) (init thelnks) ++) ) _ -> rm + where + thelnks = _rmLinks rm diff --git a/src/Dodge/Wire.hs b/src/Dodge/Wire.hs index 7aac2f664..5ae564e5c 100644 --- a/src/Dodge/Wire.hs +++ b/src/Dodge/Wire.hs @@ -6,5 +6,12 @@ import Geometry import qualified Data.IntMap.Strict as IM import Control.Lens -putWireEnd :: Int -> (Point2,Float) -> Room -> Room -putWireEnd i pos rm = rm & rmEndWires %~ IM.insert i (uncurry RoomWire $ invShiftLinkBy (_rmShift rm) pos) +putWireEndInvRmShift :: Int -> (Point2,Float) -> Room -> Room +putWireEndInvRmShift i pos rm = + rm & rmEndWires %~ IM.insert i (uncurry RoomWire $ invShiftLinkBy (_rmShift rm) pos) + +putWireStart :: Int -> (Point2,Float) -> Room -> Room +putWireStart i pos rm = rm + & rmStartWires %~ IM.insert i (uncurry RoomWire pos) + +