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

Mapper, ARHUD, radar sweeps update. Add dropper items

Browse Source
This commit is contained in:
justin
2025-01-03 10:43:06 +00:00
parent e9f5a39ed7
commit 386d6f47b0
27 changed files with 802 additions and 700 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/RadarSweep.hs
+28 -15
View File
@@ -1,29 +1,39 @@
{-# LANGUAGE TupleSections #-}
module Dodge.RadarSweep (
aRadarPulse,
updateRadarSweep,
) where
import Data.Maybe
import Dodge.Item.Location
import qualified Data.Set as S
import Color
import Data.Maybe
import qualified Data.Set as S
import Dodge.Data.World
import Dodge.Item.Location
import Dodge.Zoning.Wall
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import NewInt
aRadarPulse :: Maybe (NewInt ItmInt) -> ObjectType -> Creature -> World -> World
aRadarPulse itid ob cr =
aRadarPulse ::
NewInt ItmInt ->
Maybe (NewInt ItmInt) ->
Maybe (NewInt ItmInt) ->
ObjectType ->
Creature ->
World ->
World
aRadarPulse itid mitid armitid ob cr =
cWorld . lWorld . radarSweeps
.:~ RadarSweep
{ _rsTimer = 50
, _rsRad = 0
, _rsPos = _crPos cr
, _rsObject = ob
, _rsMapper = itid
, _rsMapper = mitid
, _rsAR = armitid
, _rsSource = itid
}
updateRadarSweep :: World -> RadarSweep -> (World, Maybe RadarSweep)
@@ -40,13 +50,16 @@ updateRadarSweep w pt
p = _rsPos pt
ob = _rsObject pt
x = _rsTimer pt
putBlips = cWorld . lWorld . radarBlips .++~ map
(makeBlip ob)
blips
(blips,wps) = findBlips ob p r w
putBlips
| isJust (pt ^. rsAR) = cWorld . lWorld . radarBlips
.++~ map
(makeBlip ob)
blips
| otherwise = id
(blips, wps) = findBlips ob p r w
r = fromIntegral (400 - x * 8)
findBlips :: ObjectType -> Point2 -> Float -> World -> ([Point2],S.Set (Point2,Point2))
findBlips :: ObjectType -> Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
findBlips ob = case ob of
ObCreature -> crBlips
ObItem -> itemBlips
@@ -71,20 +84,20 @@ blipAt r col i p =
, _rbPos = p
}
crBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2,Point2))
crBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
crBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures . _lWorld . _cWorld
where
f q = dist p q <= r && dist p q > r - 100
g cr = _crID cr /= 0
itemBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2,Point2))
itemBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
itemBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _flItPos . _unNIntMap . _floorItems . _lWorld . _cWorld
where
f q = dist p q <= r && dist p q > r - 4
wallBlips :: Point2 -> Float -> World -> ([Point2],S.Set (Point2,Point2))
wallBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
wallBlips p r = foldMap f . wlsNearCirc p r
where
f wl = case uncurry (intersectCircSeg p r) $ _wlLine wl of
[] -> mempty
xs -> (xs,S.singleton (wl ^. wlLine))
xs -> (xs, S.singleton (wl ^. wlLine))