Unify block wall types

src/Dodge/LevelGen/Block.hs

@@ -11,90 +11,14 @@ import Dodge.Zone
 --import Dodge.SoundLogic.LoadSound
 --import Dodge.WorldEvent.Sound
 import Dodge.LevelGen.Pathing
+import Dodge.Default.Wall
 --import Dodge.RandomHelp
 import Geometry
 import qualified IntMapHelp as IM
 import Color
 
 import Control.Lens
---import Control.Monad.State
 import Data.List
---import Data.Maybe
---import Data.Function
---import System.Random
-
---updateBlocks :: World -> World
---updateBlocks w 
---    = w --(\w' -> seq (_wallsZone w') w') 
---    $ flip (foldl' $ flip removeFromZone) deadPanes 
---    $ over walls (\wls -> wls `seq` IM.filter (not . blockIsDead) wls) degradeBlocks 
--- where  
---    --degradeBlocks = deadBlocks `seq` foldl' (flip killBlock) w deadBlocks
---    removeFromZone :: Wall -> World -> World
---    removeFromZone bl = over (wallsZone . znObjects . ix x . ix y) (IM.delete (_wlID bl))
---      where 
---        (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine bl)
---    deadPanes w' = filter (blockIsDead w') (IM.elems $ _walls w)
---    --deadBlocks = nubBy ((==) `on` _blIDs) deadPanes
---    blockIsDead w' wl = case IM.lookup (_wlBlockID wl) $ _blocks w of 
---        Just x  -> x <= 0
---        Nothing -> False
-
-{- | Destroy a block.
-Plays destruction sound and sets to be displayed other walls that were shadowed by this wall. -}
---killBlock :: Wall -> World -> World
---killBlock bl w =  f bl . flip (foldl' $ flip unshadow) (_blShadows bl) $ w
---  where
---    f :: Wall -> World -> World
---    f bl'
---        | isJust (bl ^? blDegrades . ix 0) = degradeBlock bl' . breakHitSound bl
---        | otherwise = hitSound' bl'
---    pos = fst $ _wlLine bl
---    breakHitSound bl' 
---        | _wlIsSeeThrough bl' = mkSoundBreakGlass pos
---        | otherwise = soundMultiFrom sos (fst $ _wlLine bl') impactSound Nothing
---    hitSound' bl' 
---        | _wlIsSeeThrough bl' = mkSoundSplinterGlass pos
---        | otherwise = soundMultiFrom sos (fst $ _wlLine bl') impactSound Nothing
---    sos = [BlockDegradeSound 0,BlockDegradeSound 1]
---    impactSound = evalState (takeOne [impact1S,impact2S,impact3S,impact4S]) $ _randGen w
---    unshadow :: Int -> World -> World
---    unshadow bid w' = case w' ^? walls . ix bid of 
---        Just b -> 
---            let (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine b)
---            in w & wallsZone . znObjects . ix x . ix y . ix bid . blVisible %~ const True
---                 & walls . ix bid . blVisible %~ const True
---        Nothing -> w
-
---degradeBlock :: Wall -> World -> World
---degradeBlock bl w = 
---    let blid = _wlID bl
---        bls = map (\i -> _walls w IM.! i) (_blIDs $ _walls w IM.! blid)
---        ps = reverse $ orderPolygon $ nub $ concatMap ((\(a,b) -> [a,b]) . _wlLine) bls
---        (newPs,g) = runState (shrinkPolygon 0.5 ps) $ _randGen w
---        (x:xs) = _blDegrades bl
---    in addBlock newPs (x + _blHP bl) (_wlColor bl) (_wlIsSeeThrough bl) xs $ set randGen g w
-
-{-
-This does not have clear behaviour in my mind, and should probably be replaced with something more obvious...
- -}
---pushPointTowardsBy 
---    :: RandomGen g 
---    => Float 
---    -> Point2 
---    -> [Point2] 
---    -> State g Point2
---pushPointTowardsBy x p ps = do
---    xs <- replicateM (length ps) $ state $ randomR (0, x / fromIntegral (length ps))
---    let toAdd p' y = y *.* (p' -.- p)
---    return $ p +.+ foldl1' (+.+) (zipWith toAdd ps xs)
-
---shrinkPolygon 
---    :: RandomGen g 
---    => Float        -- ^ Shrink parameter
---    -> [Point2] 
---    -> State g [Point2]
---shrinkPolygon x ps = mapM (flip (pushPointTowardsBy x) ps) ps
 
 addBlock 
     :: [Point2]     -- ^ Block polygon
@@ -110,25 +34,19 @@ addBlock (p:ps) hp col isSeeThrough hps w
     | otherwise = w  
         & wallsZone . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes
         & walls  %~ IM.union panes
-        & blocks %~ IM.insert blid (Block' {_blID = blid,_blWallIDs = is, _blHPs = hp:hps, _blShadows'=[]})
+        & blocks %~ IM.insert blid (Block {_blID = blid,_blWallIDs = is, _blHPs = hp:hps, _blShadows=[]})
   where 
     blid = IM.newKey $ _blocks w
     lns = zip (p:ps) (ps ++ [p])
     i = IM.newKey $ _walls w
     is = [i.. i + length lns-1]
     panes = IM.fromList $ zip is $ zipWith 
-        (\j (a,b) -> Block 
+        (\j (a,b) -> defaultWall 
             { _wlLine = (a,b)
             , _wlID = j
             , _wlColor = col
-            , _wlSeen = False
-            , _blIDs = is
             , _wlIsSeeThrough = isSeeThrough
-            , _blVisible = True
-            , _blShadows = []
-            , _wlDraw = True
-            , _wlRotateTo = True
-            , _wlBlockID = blid
+            , _wlBlockID = Just blid
             }
         ) is lns
     wallInZone wl