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

Delete cruft, add Reader monad to some internal ai

Browse Source
This commit is contained in:
jgk
2021-05-16 21:42:11 +02:00
parent 0798cc0b0e
commit d7fcdbf550
69 changed files with 721 additions and 2894 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+18 -11
View File
@@ -45,9 +45,9 @@ midPadL i x xs ys = take j (xs ++ repeat x) ++ ys
j = i - length ys
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil f ps = case span (not . f) ps of
takeUntil f ps = case break f ps of
(xs,[]) -> xs
(xs,(y:_)) -> xs ++ [y]
(xs, y:_ ) -> xs ++ [y]
you :: World -> Creature
you w = _creatures w IM.! _yourID w
@@ -63,7 +63,7 @@ crItem w cid = _crInv cr IM.! _crInvSel cr
where
cr = _creatures w IM.! cid
yourItemRef w = (creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w)))
yourItemRef w = creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))
wallNormal :: Wall -> Point2
wallNormal wl = normalizeV . vNormal $ a -.- b
@@ -73,22 +73,21 @@ wallNormal wl = normalizeV . vNormal $ a -.- b
wallsOnLine :: Point2 -> Point2 -> IM.IntMap Wall -> [Wall]
wallsOnLine p1 p2 ws = hitWalls
where
hitPoint w = intersectSegSeg' p1 p2 (fst $ _wlLine w) (snd $ _wlLine w)
hitPoint w = uncurry (intersectSegSeg' p1 p2) (_wlLine w)
hitWalls = filter (isJust . hitPoint) (IM.elems ws)
wallOnLine :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Wall
wallOnLine p1 p2 ws
= listToMaybe $ sortBy f hitWalls
where
hitPoint w = intersectSegSeg' p1 p2 (fst $ _wlLine w) (snd $ _wlLine w)
hitPoint w = uncurry (intersectSegSeg' p1 p2) (_wlLine w)
hitWalls = filter (isJust . hitPoint) (IM.elems ws)
f w1 w2 = compare (magV (p1 -.- fromJust (hitPoint w1))) (magV (p1 -.- fromJust (hitPoint w2)))
wallsOnCirc :: Point2 -> Float -> IM.IntMap Wall -> [Wall]
wallsOnCirc p r wls = IM.elems $ IM.filter f wls
wallsOnCirc :: Point2 -> Float -> IM.IntMap Wall -> IM.IntMap Wall
wallsOnCirc p r = IM.filter f
where
f wl = circOnSeg (fst $ _wlLine wl) (snd $ _wlLine wl) p r
f wl = uncurry circOnSeg (_wlLine wl) p r
allWalls :: World -> IM.IntMap Wall
allWalls w = IM.unions $ concatMap IM.elems $ IM.elems $ _wallsZone w
@@ -288,7 +287,7 @@ collidePointWallsNorm p1 p2 ws
= listToMaybe
. sortOn f
. IM.elems
$ IM.mapMaybe (( \(x,y) -> intersectSegSeg' p1 p2 x y <&> (, vNormal $ x -.- y ) )
$ IM.mapMaybe (( \(x,y) -> intersectSegSeg' p1 p2 x y <&> ( , vNormal $ x -.- y ) )
. _wlLine) ws
where
f (a,_) = magV (p1 -.- a)
@@ -301,7 +300,7 @@ collidePointWallsCol p1 p2 ws
. sortOn f
. IM.elems
$ IM.mapMaybe ( (\(m, c) -> m <&> (, c))
. (\w -> (intersectSegSeg' p1 p2 (fst $ _wlLine w) (snd $ _wlLine w), _wlColor w))) ws
. (\w -> (uncurry (intersectSegSeg' p1 p2) (_wlLine w), _wlColor w))) ws
where
f (a,_) = magV (p1 -.- a)
{- | Looks for first collision of a point with walls.
@@ -507,3 +506,11 @@ isAnimate cr = case _crActionPlan cr of
_ -> True
sigmoid x = x/sqrt(1+x^2)
{- | In order to force a list, apply with seq. -}
forceSpine :: [a] -> ()
forceSpine = foldr (const id) ()
forceList :: [a] -> [a]
forceList l = seq (forceSpine l) l