diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 4818aebe8..b4e496787 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -64,13 +64,12 @@ assignPlacementSpots rm = plmnts ++ plmnts' (lnkplmnts, plmnts) = partition islnk (_rmPS rm) islnk Placement{_placementSpot=PSLnk{}} = True islnk _ = False - (_,plmnts') = mapAccumR f (_rmLinks rm) lnkplmnts - (la,lb) = head $ _rmUsedLinks rm - lnkTo = (la,lb+1.5*pi) + (_,plmnts') = mapAccumR f (map (invShiftLinkBy lnkTo) $ _rmLinks rm) lnkplmnts + (la,lb) = _rmShift rm + lnkTo = (la,lb) f lnks plmnt = let (x:xs,ys) = partition (_psLinkTest $ _placementSpot plmnt) lnks - thepair = bimap (invShiftPointBy lnkTo) (\r -> r - snd lnkTo) - $ _psLinkShift (_placementSpot plmnt) x + thepair = _psLinkShift (_placementSpot plmnt) x in (xs++ys, updatePS (updatePSLnkUsing thepair) plmnt) updatePSLnkUsing :: (Point2,Float) -> PlacementSpot -> PlacementSpot diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index e83ab814e..d0bc47b47 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -6,7 +6,16 @@ The last link in the list is considered the incoming link, the other links are the outgoing links. -} module Dodge.Room.Link - where + ( shiftRoomToLink + , shiftRoomBy + , randomiseAllLinks + , filterLinks + , changeLinkTo + , changeLinkFrom + , randomiseOutLinks + , randomiseLinksBy + , invShiftLinkBy + ) where import Dodge.LevelGen import Dodge.Room.Data import Dodge.RandomHelp @@ -16,8 +25,7 @@ import Data.Tile import System.Random import Control.Monad.State import Control.Lens -import Data.List (delete) - +import Data.List {- Shuffle the initial links of a room randomly. -} randomiseOutLinks :: RandomGen g => Room -> State g Room randomiseOutLinks r = do @@ -42,8 +50,16 @@ filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room filterLinks cond r = do newLinks <- shuffle $ filter cond $ init $ _rmLinks r return $ r {_rmLinks = newLinks ++ [last $ _rmLinks r]} +{- | Swaps the first link in the list with one that satisfies a given property. + - Does not change the last link in the list -} +changeLinkFrom :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room +changeLinkFrom cond r = do + let (possibleLnks,otherLnks) = partition cond . init $ _rmLinks r + newLnks <- shuffle possibleLnks + return $ r {_rmLinks = newLnks ++ otherLnks ++ [last $ _rmLinks r]} {- | Swaps the last link in the list with one that satisfies a given - - property (it might swap with itself). Unsafe. -} + - property (it might swap with itself). Unsafe. + - Be careful about calling this after changeLinkFrom. -} changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room changeLinkTo cond r = do l <- takeOne $ filter cond $ _rmLinks r @@ -56,8 +72,10 @@ This is intended to work when the external point is an outgoing link from anothe shiftRoomToLink :: (Point2,Float) -> Room -> Room shiftRoomToLink l r = shiftRoomBy l - . shiftRoomBy (V2 0 0 -.- rotateV (pi-a) p , 0) - $ shiftRoomBy (V2 0 0 ,pi-a) + . shiftRoomBy (V2 0 0 , pi-a) + $ shiftRoomBy (V2 0 0 -.- p , 0) +-- . shiftRoomBy (V2 0 0 -.- rotateV (pi-a) p , 0) +-- $ shiftRoomBy (V2 0 0 ,pi-a) r where (p,a) = last $ _rmLinks r @@ -76,12 +94,12 @@ shiftRoomBy shift r = r ) & rmViewpoints %~ map (shiftPointBy shift) -shiftLinkBy - :: (Point2,Float) - -> (Point2,Float) - -> (Point2,Float) +shiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float) shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot) +invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float) +invShiftLinkBy (pos,rot) (p,r) = (invShiftPointBy (pos,rot) p, r - rot) + shiftPathBy :: (Point2,Float) -> (Point2,Point2) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index b9d20af9b..f99119b7d 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -102,11 +102,11 @@ addSouthPillars x h r = do addButtonSlowDoor :: RandomGen g => Float -> Float -> Room -> State g Room addButtonSlowDoor x h rm = do (butPos,butRot) <- takeOne - [( V2 (x/2-50) 5,0) - ,( V2 (x/2+50) 5,0) + [( V2 (x/2-50) 5,0::Float) + ,( V2 (x/2+50) 5,0::Float) ] thePlacement <- takeOne [butDoor butPos butRot ] - filterLinks aboveH =<< changeLinkTo belowH (rm + changeLinkFrom aboveH =<< changeLinkTo belowH (rm & rmPS %~ (thePlacement :) & rmBound %~ (openDoorBound :) ) @@ -114,10 +114,11 @@ 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 _ _ = putLitButtonID' col butPosCond + --butDoor bpos brot = putLitButtonID col bpos brot $ \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2 - --butPosCond (V2 _ y,_) = y < h + butPosCond (V2 _ y,_) = y < h + --butPosCond _ = True -- y < h col = dim $ light red cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff