diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index dfdeb702b..1b2d39ce7 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -29,6 +29,12 @@ import Data.Maybe takeUntil :: Foldable t => (a -> Bool) -> t a -> [a] takeUntil p = foldr (\x xs -> x : if p x then [] else xs) [] + +safeHead :: [a] -> Maybe a +safeHead (x:_) = Just x +safeHead _ = Nothing + + you :: World -> Creature you w = _creatures w IM.! _yourID w diff --git a/src/Dodge/Item/Weapon/Booster.hs b/src/Dodge/Item/Weapon/Booster.hs index 37b3f3038..7bdc298f4 100644 --- a/src/Dodge/Item/Weapon/Booster.hs +++ b/src/Dodge/Item/Weapon/Booster.hs @@ -110,10 +110,6 @@ drawBoostShockwave pj = (,) mempty $ setLayer 1 $ onLayer UPtLayer $ pictures $ f (p,v) x = p +.+ x *.* vNormal v g (p,v) x = p -.- x *.* vNormal v -safeHead :: [a] -> Maybe a -safeHead (x:_) = Just x -safeHead _ = Nothing - maxT :: Int maxT = 20 diff --git a/src/Dodge/LevelGen/LineBlock.hs b/src/Dodge/LevelGen/LineBlock.hs index fd56d10e7..d837d4b4b 100644 --- a/src/Dodge/LevelGen/LineBlock.hs +++ b/src/Dodge/LevelGen/LineBlock.hs @@ -39,7 +39,7 @@ putLineBlock basePane blockWidth depth a b w linesAt p = makeLoopPairs $ cornersAt p k = IM.newKey $ _walls w blid = IM.newKey $ _blocks w - insertBlock' i = over blocks $ IM.insert (i+blid) Block' {_blID = i + blid, _blWallIDs = ksAtI i, _blHPs = [5,5], _blShadows' = []} + insertBlock' i = over blocks $ IM.insert (i+blid) Block' {_blID = i + blid, _blWallIDs = ksAtI i, _blHPs = [5,5], _blShadows' = shadowsAt i} insertBlocks' = flip (foldr insertBlock') is ksAtI i = map ( + (k + i*4) ) [0,1,2,3] visibilityAt i diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 7c8f33d68..6a4bf87c8 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -53,8 +53,7 @@ roomC x y = defaultRoom { _rmPolys = [rectNSWE y 0 0 x] , _rmLinks = lnks , _rmPath = pth - --, _rmPS = [windowLine (V2 (x/2) 0) (V2 (x/2) (y-60)) - , _rmPS = [windowLine (V2 (x/2) 10) (V2 (x/2) (20)) + , _rmPS = [windowLine (V2 (x/2) 0) (V2 (x/2) (y-60)) ] , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)] } diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 21a2e2b88..6d27679de 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -16,6 +16,7 @@ import Dodge.Update.Camera import Dodge.SoundLogic import Dodge.Inventory import Geometry +import Geometry.ConvexPoly import Geometry.Vector3D import SDL (MouseButton (..)) @@ -80,22 +81,40 @@ functionalUpdate w = case _menuLayers w of where (x,y) = cloudZoneOfPoint $ stripZ $ _clPos cl +splinterBlock :: Block' -> World -> World +splinterBlock bl w = foldr unshadowBlock w (_blShadows' bl) -- foldr shiftTowardCen w (_blWallIDs bl) + & blocks . ix (_blID bl) . blHPs %~ tail + where + wls = map (_walls w IM.!) (_blWallIDs bl) + ps = map (fst . _wlLine) wls + cen = centroid ps + shiftTowardCen wlid = walls . ix wlid . wlLine %~ bimap f f + f x = 0.5 *.* (x +.+ cen) + +unshadowBlock :: Int -> World -> World +unshadowBlock wlid w = case w ^? walls . ix wlid of + Just wl -> w + & walls . ix wlid . blVisible .~ True + & wallsZone . znObjects . ix x . ix y . ix wlid . blVisible .~ True + where + (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl) + Nothing -> w + updateBlocks :: World -> World updateBlocks w = foldr f w $ _blocks w where - f bl w' - | head (_blHPs bl) < 1 = w' + f bl w' = case safeHead $ _blHPs bl of + Just x | x < 1 -> splinterBlock bl w' + | otherwise -> w' + Nothing -> w' & walls %~ removeIDs (_blWallIDs bl) & flip (foldr removeFromZone) (_blWallIDs bl) & blocks %~ IM.delete (_blID bl) - | otherwise = w' removeIDs is wls = foldr IM.delete wls is removeFromZone wlid w' = over (wallsZone . znObjects . ix x . ix y) (IM.delete (_wlID wl)) w' - --removeFromZone wlid w' = set (wallsZone . znObjects) IM.empty w' - --removeFromZone wlid w' = over (wallsZone . znObjects . ix x . ix y . ix (_wlID wl)) setCol w' where (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl) - wl = _walls w IM.! wlid + wl = _walls w IM.! wlid -- note the use of w not w' setCol = wlColor .~ V4 1 1 0 1 -- | Note the explict use of record syntax. Using lens creates a space leak.