From eb393708c45b986938ed7becff69d2b885533746 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 30 Sep 2021 13:36:07 +0100 Subject: [PATCH] Commit before making all walls zoned --- src/Dodge/Initialisation.hs | 25 ++++++++----------------- src/Dodge/Layout.hs | 3 ++- src/Dodge/LevelGen/TriggerDoor.hs | 4 ++-- src/Dodge/LightSources/Fitting.hs | 16 +++++++++++++++- src/Dodge/Room/LongDoor.hs | 3 ++- src/Dodge/Room/Start.hs | 2 +- src/Dodge/Zone.hs | 6 ++++-- 7 files changed, 34 insertions(+), 25 deletions(-) diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 9afc51987..672a7b765 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -4,7 +4,7 @@ import Dodge.Save import Dodge.Data import Dodge.Data.SoundOrigin import Dodge.Creature -import Dodge.Zone +--import Dodge.Zone import Dodge.Floor import Dodge.Layout import Dodge.Story @@ -24,8 +24,8 @@ import qualified Data.Set as S import qualified Data.IntMap.Strict as IM import qualified Data.Map as M import Data.Maybe -import Control.Lens -import Data.List (partition) +--import Control.Lens +--import Data.List (partition) --import Data.List (sortOn) firstWorld :: IO World @@ -60,17 +60,8 @@ initialWorld = defaultWorld , _menuLayers = [TerminalScreen 300 rezText'] , _worldState = M.empty } --- TODO delete this duplicate -wallsAndWindows - :: World - -> ( [((Point2,Point2),Point4)] ,[((Point2,Point2),Point4)] ) -wallsAndWindows w - = (map f wls, map f $ filter (fromMaybe True . (^? blVisible)) wins) - where - f wl = (_wlLine wl, _wlColor wl) - (wins,wls) = partition _wlIsSeeThrough . IM.elems $ wallsDoubleScreen w testStringInit :: World -> [String] -testStringInit _ = [] +--testStringInit _ = [] --testStringInit w = -- [show $ _worldMinX w -- ,show $ _worldMaxX w @@ -84,10 +75,10 @@ testStringInit _ = [] --testStringInit = map show . filter ((== col) . snd) . fst . wallsAndWindows -- where -- col = dim $ dim $ bright red ---testStringInit = mapMaybe f . IM.elems . flattenIMIMIM . _wallsZone --- where --- f (dr@Door{}) = Just . show $ _wlLine dr --- f _ = Nothing +testStringInit = mapMaybe f . IM.elems . _walls + where + f dr | _wlColor dr == V4 0 1 0 1 = Just . show $ _wlLine dr + | otherwise = Nothing --testStringInit _ = [] --testStringInit w = [show . length $ newSounds w] --testStringInit w = (show . _crPos $ _creatures w IM.! 0) diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 0aeefbbae..5c4edcf2e 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TupleSections #-} module Dodge.Layout where import Dodge.Data @@ -55,7 +56,7 @@ generateLevelFromRoomList gr w where path = pairsToGraph dist pairPath pairPath = concatMap _rmPath rs - plmnts = concat $ map (\r -> map ((,) (_rmShift r)) (_rmPS r)) rs + plmnts = concatMap (\r -> map (_rmShift r ,) (_rmPS r)) rs rs = zipWith addTile zs rs' zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w rs' = evalState gr $ _randGen w diff --git a/src/Dodge/LevelGen/TriggerDoor.hs b/src/Dodge/LevelGen/TriggerDoor.hs index e99b5b9f3..7a3c82189 100644 --- a/src/Dodge/LevelGen/TriggerDoor.hs +++ b/src/Dodge/LevelGen/TriggerDoor.hs @@ -32,7 +32,7 @@ addButtonDoor c btp btr a b speed w $ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph)) $ set pathGraph newGraph $ set pathGraphP newGraphPairs - $ (snd $ putSingleDoor False c cond a b speed w) + $ snd (putSingleDoor False c cond a b speed w) where bid = IM.newKey $ _buttons w cond w' = BtNoLabel == _btState (_buttons w' IM.! bid) @@ -90,7 +90,7 @@ doorMechanismStepwise nsteps drid wlids pss dr w playSound = soundContinue (WallSound drid) (fst $ head pss) slideDoorS (Just 1) toOpen = _drTrigger dr w cpss = uncurry (rectanglePairs 9) (head pss) - setWalls n = (playSound $ foldl' setWall w (zip3 wlids newps cpss)) + setWalls n = playSound (foldl' setWall w (zip3 wlids newps cpss)) & doors . ix drid . drStatus .~ DoorInt n where newps = uncurry (rectanglePairs 9) (pss !! n) diff --git a/src/Dodge/LightSources/Fitting.hs b/src/Dodge/LightSources/Fitting.hs index eb6600098..8b07af55f 100644 --- a/src/Dodge/LightSources/Fitting.hs +++ b/src/Dodge/LightSources/Fitting.hs @@ -22,6 +22,20 @@ wallMountL wallpos lamppos@(V3 x y z) wallposUp = wallpos +.+ n turnpos = V2 x y +.+ n +wallMountJ :: Point2 -> Point3 -> Placement +wallMountJ wallpos lamppos@(V3 x y z) + = place0 (PutLS $ colorLightAt 0.75 lamppos 0) + $ \_ -> jsps0 $ PutForeground $ highBar (z + 5) wallposUp turn1 + <> highBar (z + 5) turn1 turn2 + <> highBar (z + 5) turn2 (endpos `extendAway` turn2) + where + n = vNormal (wallpos -.- endpos) + wallposUp = wallpos +.+ n + endpos = V2 x y + turnpos = endpos +.+ n + turn1 = 0.5 *.* (wallposUp +.+ turnpos) + turn2 = 0.5 *.* (turnpos +.+ endpos) + wallMountl :: Point2 -> Point3 -> Placement wallMountl wallpos lamppos@(V3 x y z) = place0 (PutLS $ colorLightAt 0.75 lamppos 0) @@ -57,4 +71,4 @@ jsps0 :: PSType -> Maybe Placement jsps0 pst = Just $ sPS (V2 0 0) 0 pst place0 :: PSType -> (Int -> Maybe Placement) -> Placement -place0 pst plm = Placement (PS (V2 0 0) 0 pst) plm +place0 pst = Placement (PS (V2 0 0) 0 pst) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 7c8d1c3b0..acebb89a2 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -68,7 +68,8 @@ twinSlowDoorRoom drid w h x = defaultRoom ,rectNSWE 20 (-h) (negate x) x ] cond w' = or $ M.lookup (DoorNumOpen drid) (_worldState w') - col = dim $ dim $ bright red + --col = dim $ dim $ bright red + col = V4 0 1 0 1 twinSlowDoorChasers :: RandomGen g diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index b825cd10c..1533e90bb 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -32,6 +32,6 @@ startRoom = do <$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0) $ roomRectAutoLinks w h & rmPS .~ [ fground - , wallMountA (V2 0 (h/3)) (V3 40 (h/3) 70) + , wallMountJ (V2 0 (h/3)) (V3 40 (h/3) 70) ] ) diff --git a/src/Dodge/Zone.hs b/src/Dodge/Zone.hs index c2a7aecb3..0afbadaca 100644 --- a/src/Dodge/Zone.hs +++ b/src/Dodge/Zone.hs @@ -156,8 +156,10 @@ wallsAlongLine a b w = IM.foldlWithKey' g IM.empty kps wallsAlongCirc :: Point2 -> Float -> World -> IM.IntMap Wall wallsAlongCirc p r w = IM.unions [f y $ f x $ _znObjects $ _wallsZone w | (x,y) <- zoneOfCircle p r] - where f i m = case IM.lookup i m of Just val -> val - _ -> IM.empty + where + f i m = case IM.lookup i m of + Just val -> val + _ -> IM.empty wallsNearPoint :: Point2 -> World -> IM.IntMap Wall wallsNearPoint p w = IM.unions [f b $ f a $ _znObjects $ _wallsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]