Commit before making all walls zoned

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 Control.Lens
-import Data.List (partition)
+--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
+testStringInit = mapMaybe f . IM.elems . _walls
---  where
+  where
---    f (dr@Door{}) = Just . show $ _wlLine dr
+    f dr | _wlColor dr == V4 0 1 0 1 = Just . show $ _wlLine dr
---    f _ = Nothing
+         | otherwise = Nothing
 --testStringInit _ = []
 --testStringInit w = [show . length $ newSounds w]
 --testStringInit w = (show . _crPos $ _creatures w IM.! 0) 

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

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)

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)

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 

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)
             ]
             )

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
+  where 
-                                        _        -> IM.empty
+    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]]