justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup

Browse Source
This commit is contained in:
justin
2022-02-13 17:29:32 +00:00
parent eba1713895
commit 40f1d987cb
21 changed files with 109 additions and 171 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WorldEvent/Sound.hs
+7 -5
View File
@@ -3,8 +3,7 @@ module Dodge.WorldEvent.Sound
, mkSoundSplinterGlass
, mkSoundSplinterBlock
, originIDsAt
)
where
) where
import Dodge.Data
import Dodge.SoundLogic
import Sound.Data
@@ -20,10 +19,13 @@ originIDsAt so sids p w = soundStart so p sid Nothing $ set randGen g w
(sid,g) = _randGen w & runState (takeOne sids)
mkSoundBreakGlass :: Point2 -> World -> World
mkSoundBreakGlass = originIDsAt (GlassBreakSound 0) [glassShat1S,glassShat2S,glassShat3S,glassShat4S]
mkSoundBreakGlass = originIDsAt (GlassBreakSound 0)
[glassShat1S,glassShat2S,glassShat3S,glassShat4S]
mkSoundSplinterGlass :: Point2 -> World -> World
mkSoundSplinterGlass = originIDsAt (GlassBreakSound 1) [smallGlass1S,smallGlass2S,smallGlass3S,smallGlass4S]
mkSoundSplinterGlass = originIDsAt (GlassBreakSound 1)
[smallGlass1S,smallGlass2S,smallGlass3S,smallGlass4S]
mkSoundSplinterBlock :: Point2 -> World -> World
mkSoundSplinterBlock = originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S,impact4S]
mkSoundSplinterBlock = originIDsAt (BlockDegradeSound 1)
[impact1S,impact2S,impact3S,impact4S]
src/Dodge/WorldEvent/ThingsHit.hs
+7 -19
View File
@@ -19,7 +19,7 @@ import Geometry
import qualified Data.IntMap.Strict as IM
import Data.List
import Data.Maybe
--import Data.Bifunctor
import Data.Bifunctor
{- List those objects that appear on a line. -}
thingsHit
:: Point2 -- ^ Line start point
@@ -34,16 +34,11 @@ thingsHit sp ep w
(\cr -> (,Left cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep))
. IM.elems
$ _creatures w
hitWls = wallsOnLine sp ep
wls = map (second Right) . IM.elems $ wallsOnLineHit sp ep
$ IM.unions [f b $ f a $ _znObjects $ _wallsZone w
| a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
-- $ _walls w
(x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
f i m = case IM.lookup i m of
Just val -> val
_ -> IM.empty
wls = zip (map (fromJust . hitPoint) hitWls) (map Right hitWls)
hitPoint w' = uncurry (intersectSegSeg sp ep) (_wlLine w')
f i = fromMaybe IM.empty . IM.lookup i
thingHit :: Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
thingHit sp ep = listToMaybe . thingsHit sp ep
{- List objects that appear on a line.
@@ -69,16 +64,12 @@ wallsHit sp ep w
| sp == ep = []
| otherwise = sortOn (dist sp . fst) wls
where
hitWls = wallsOnLine sp ep
wls = IM.elems $ wallsOnLineHit sp ep
$ IM.unions [f b $ f a $ _znObjects $ _wallsZone w
| a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
-- $ _walls w
(x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
f i m = case IM.lookup i m of
Just val -> val
_ -> IM.empty
wls = zip (map (fromJust . hitPoint) hitWls) hitWls
hitPoint w' = uncurry (intersectSegSeg sp ep) (_wlLine w')
f i = fromMaybe IM.empty . IM.lookup i
thingsHitExceptCrLongLine
:: Maybe Int
@@ -96,13 +87,10 @@ thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either Creature Wall
thingsHitLongLine sp ep w
| sp == ep = []
| otherwise = sortOn (dist sp . fst) (crs ++ wls)
where
where
crs = mapMaybe
(\cr -> (,Left cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep))
. IM.elems
$ _creatures w
-- $ creaturesAlongLine sp ep w
wls = zip (map (fromJust . hitPoint) hitWls) (map Right hitWls)
--hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
hitWls = wallsOnLine sp ep $ _walls w
hitPoint wl = uncurry (intersectSegSeg sp ep) (_wlLine wl)
wls = map (second Right) . IM.elems $ wallsOnLineHit sp ep $ _walls w