diff --git a/src/Dodge/Creature/Action/Flee.hs b/src/Dodge/Creature/Action/Flee.hs index 8587efdb2..c3451edbd 100644 --- a/src/Dodge/Creature/Action/Flee.hs +++ b/src/Dodge/Creature/Action/Flee.hs @@ -1,16 +1,13 @@ module Dodge.Creature.Action.Flee where import Dodge.Data +import Dodge.Base.Collide import Geometry -import Data.List -import Data.Maybe - retreatPointForFrom :: Float -> World -> Creature -> Point2 -> Maybe Point2 retreatPointForFrom d _ cr p - = listToMaybe - . sortOn (dist cpos) + = safeMinimumOn (dist cpos) $ divideCircle 10 p d where cpos = _crPos cr diff --git a/src/Dodge/Creature/ArmourChase.hs b/src/Dodge/Creature/ArmourChase.hs index 0d0f963c9..4de30a95d 100644 --- a/src/Dodge/Creature/ArmourChase.hs +++ b/src/Dodge/Creature/ArmourChase.hs @@ -17,7 +17,6 @@ import Picture import Geometry import Data.Maybe -import Data.List import qualified Data.IntMap.Strict as IM import Control.Lens import Control.Monad.Reader @@ -59,7 +58,7 @@ mFlockACC cr w = do && dist (_crPos cr') tpos > dist cpos tpos -- && circOnSeg (_crPos cr') tpos cpos (_crRad cr + _crRad cr') nearACCs = IM.filter isFarACC $ creaturesNearPointI 3 cpos w - acr <- listToMaybe $ sortOn (dist cpos . _crPos) $ IM.elems nearACCs + acr <- safeMinimumOn (dist cpos . _crPos) nearACCs let r = _crRad acr + _crRad cr + 10 horDir = normalizeV (vNormal (cpos -.- tpos)) horShift = if isLHS tpos cpos (_crPos acr) diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 6cffad420..2540a6790 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -4,7 +4,7 @@ import Dodge.Data import Dodge.Base import Geometry -import Data.Maybe +--import Data.Maybe import Data.List import qualified Data.IntMap.Strict as IM --import System.Random @@ -52,7 +52,7 @@ rmSelectedInvItem rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w -- for now, left are floor items, right are buttons closestActiveObject :: World -> Maybe (Either FloorItem Button) -closestActiveObject w = listToMaybe $ sortOn (dist ypos . pos) actObjs +closestActiveObject w = safeMinimumOn (dist ypos . pos) actObjs where ypos = _crPos $ you w actObjs = filter (\obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w) diff --git a/src/Dodge/LevelGen/StaticWalls.hs b/src/Dodge/LevelGen/StaticWalls.hs index ba907cda9..b6865bc52 100644 --- a/src/Dodge/LevelGen/StaticWalls.hs +++ b/src/Dodge/LevelGen/StaticWalls.hs @@ -5,6 +5,7 @@ Description : Concerns carving out of static walls to create the general room pl module Dodge.LevelGen.StaticWalls where import Dodge.Data +import Dodge.Base.Collide import Geometry --import Control.Lens @@ -180,8 +181,7 @@ addPolyWall (p1,p2) wls = else (p1,p2) : wls Nothing -> (p1,p2) : wls where - maybeWs = listToMaybe hitWls - hitWls = sortOn (dist p3 . fromJust . f) $ filter (isJust . f) wls + maybeWs = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls p3 = 0.5 *.* (p1 +.+ p2) p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1) f = uncurry $ myIntersectSegSeg p3 p4 @@ -289,19 +289,18 @@ brokenAdd :: WallP brokenAdd = head brokenAddedWalls findShadowWall :: WallP -> [WallP] -> Maybe WallP -findShadowWall (p1,p2) wls = listToMaybe hitWls +findShadowWall (p1,p2) wls = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls where p3 = 0.5 *.* (p1 +.+ p2) p4 = p3 +.+ 10000 *.* rotateV (negate $ pi/4) (vNormal (p2 -.- p1)) - hitWls = sortOn (dist p3 . fromJust . f) $ filter (isJust . f) wls f = uncurry $ myIntersectSegSeg p3 p4 findShadowWalls :: WallP -> [WallP] -> [WallP] findShadowWalls (p1,p2) wls = hitWls where + hitWls = sortOn (dist p3 . fromJust . f) $ filter (isJust . f) wls p3 = 0.5 *.* (p1 +.+ p2) p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1) - hitWls = sortOn (dist p3 . fromJust . f) $ filter (isJust . f) wls f = uncurry $ myIntersectSegSeg p3 p4 addWallDebug :: WallP -> [WallP] -> [WallP] @@ -312,8 +311,7 @@ addWallDebug (p1,p2) wls = else (p1,p2) : wls Nothing -> (p1,p2) : wls where - maybeWs = listToMaybe hitWls - hitWls = sortOn (dist p3 . fromJust . f) $ filter (isJust . f) wls + maybeWs = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls p3 = 0.5 *.* (p1 +.+ p2) p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1) f = uncurry $ myIntersectSegSeg p3 p4