From a9b802b88336a33d4c8fa981ae54935bc0244e12 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 4 Nov 2021 10:38:30 +0000 Subject: [PATCH] Attempt to incorporate free link positions into placement chain --- src/Dodge/Initialisation.hs | 4 ++-- src/Dodge/Layout.hs | 7 ++++++- src/Dodge/LevelGen.hs | 5 ++++- src/Dodge/Placements/Button.hs | 4 ++-- src/Dodge/Placements/Spot.hs | 23 +++++++++++++++++++++++ src/Dodge/Room/LongDoor.hs | 3 ++- 6 files changed, 39 insertions(+), 7 deletions(-) create mode 100644 src/Dodge/Placements/Spot.hs diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 744313ea8..c58198cc4 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -28,8 +28,8 @@ import qualified Data.Map as M firstWorld :: IO World firstWorld = do - i <- randomRIO (0,5000) --- let i = 2 +-- i <- randomRIO (0,5000) + let i = 2 putStrLn $ "Seed for level generation: " ++ show ( i :: Int) return $ generateLevelFromRoomList (levx 1) $ initialWorld {_randGen = mkStdGen i} diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 5912ccd66..4818aebe8 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -56,6 +56,8 @@ generateLevelFromRoomList gr w rs = zipWith addTile zs . evalState gr $ _randGen w zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w +-- the idea is to allow use of link coordinates for placements +-- though the implementation is clunky assignPlacementSpots :: Room -> [Placement] assignPlacementSpots rm = plmnts ++ plmnts' where @@ -63,9 +65,12 @@ assignPlacementSpots rm = plmnts ++ plmnts' islnk Placement{_placementSpot=PSLnk{}} = True islnk _ = False (_,plmnts') = mapAccumR f (_rmLinks rm) lnkplmnts + (la,lb) = head $ _rmUsedLinks rm + lnkTo = (la,lb+1.5*pi) f lnks plmnt = let (x:xs,ys) = partition (_psLinkTest $ _placementSpot plmnt) lnks - thepair = _psLinkShift (_placementSpot plmnt) x + thepair = bimap (invShiftPointBy lnkTo) (\r -> r - snd lnkTo) + $ _psLinkShift (_placementSpot plmnt) x in (xs++ys, updatePS (updatePSLnkUsing thepair) plmnt) updatePSLnkUsing :: (Point2,Float) -> PlacementSpot -> PlacementSpot diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 679e9f565..169851b33 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -5,6 +5,7 @@ module Dodge.LevelGen ( shiftPlacement , shiftPointBy , placeSpot + , invShiftPointBy ) where import Dodge.Data import Dodge.LevelGen.Block @@ -77,6 +78,9 @@ placeWallPoly ps wl = rmCrossPaths . over walls (addWalls ps wl) shiftPointBy :: (Point2,Float) -> Point2 -> Point2 shiftPointBy (pos,rot) p = pos +.+ rotateV rot p +invShiftPointBy :: (Point2,Float) -> Point2 -> Point2 +invShiftPointBy (p1,r) p2 = rotateV (-r) $ p2 -.- p1 + shiftPoint3By :: (Point2,Float) -> Point3 -> Point3 shiftPoint3By (pos,rot) (V3 x y z) = addZ z $ pos +.+ rotateV rot (V2 x y) @@ -119,7 +123,6 @@ placeBt bt p a w = (i , over buttons addBT w) i = IM.newKey $ _buttons w addBT xs = IM.insert i (f bt) xs f = (btRot +~ a) . (btPos %~ ( (p +.+) . rotateV a )) . (btID .~ i) - --addBT bts = IM.insert (IM.newKey bts) (bt {_btPos = p, _btRot = rot, _btID = IM.newKey bts}) bts {- Creates a floor item at a given point. Assigns an id correctly. -} placeFlIt diff --git a/src/Dodge/Placements/Button.hs b/src/Dodge/Placements/Button.hs index b52fd47c5..da3c89005 100644 --- a/src/Dodge/Placements/Button.hs +++ b/src/Dodge/Placements/Button.hs @@ -23,10 +23,10 @@ putLitButtonID col p a subpl = mountLightAID ls p'' (addZ 40 p') ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 } putLitButtonID' :: Color -> ((Point2,Float) -> Bool) -> (Int -> Maybe Placement) -> Placement -putLitButtonID' col f subpl = setLocalPS thePS $ mountLightAID ls 0 (V3 20 0 40) +putLitButtonID' col f subpl = updatePSToLevel 3 (const thePS) $ mountLightAID ls 0 (V3 0 40 40) $ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = 0, _btRot = 0}) subpl 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 + thePS = PSLnk f (\(p,a)->(p,a)) diff --git a/src/Dodge/Placements/Spot.hs b/src/Dodge/Placements/Spot.hs new file mode 100644 index 000000000..035f22b45 --- /dev/null +++ b/src/Dodge/Placements/Spot.hs @@ -0,0 +1,23 @@ +module Dodge.Placements.Spot + ( setPS + , setLocalPS + , updatePS + , updatePSToLevel + ) where +import Dodge.LevelGen.Data + +setPS :: PlacementSpot -> Placement -> Placement +setPS = updatePS . const + +updatePSToLevel :: Int -> (PlacementSpot -> PlacementSpot) -> Placement -> Placement +updatePSToLevel 0 _ plmnt = plmnt +updatePSToLevel i f (PlacementUsingPos p pl) = PlacementUsingPos p (fmap (updatePSToLevel i f) pl) +updatePSToLevel i f (Placement ps pt pl) = Placement (f ps) pt (fmap (fmap (updatePSToLevel (i-1) f)) pl) + +setLocalPS :: PlacementSpot -> Placement -> Placement +setLocalPS ps (Placement _ pt f) = Placement ps pt f +setLocalPS _ plmnt = plmnt + +updatePS :: (PlacementSpot -> PlacementSpot) -> Placement -> Placement +updatePS f (Placement ps pt iplmnt) = Placement (f ps) pt ((fmap . fmap $ updatePS f) iplmnt) +updatePS f (PlacementUsingPos p plmnt) = PlacementUsingPos p (fmap (updatePS f) plmnt) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 59771c3c9..b9d20af9b 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -114,9 +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 bpos brot = putLitButtonID' col (const True) $ \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2 + --butPosCond (V2 _ y,_) = y < h col = dim $ light red cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff