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
2021-10-31 15:03:05 +00:00
parent c443cc4372
commit 74a4267393
14 changed files with 85 additions and 167 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+1 -11
View File
@@ -59,7 +59,6 @@ data World = World
, _doors :: IM.IntMap Door
, _blocks :: IM.IntMap Block
, _wallsZone :: Zone (IM.IntMap Wall)
, _forceFields :: IM.IntMap ForceField
, _floorItems :: IM.IntMap FloorItem
, _floorTiles :: [(Point3,Point3)]
, _randGen :: StdGen
@@ -453,7 +452,7 @@ data Particle
, _btTimer' :: Int
}
type HitEffect = Particle
-> [(Point2, Either3 Creature Wall ForceField)]
-> [(Point2, Either Creature Wall)]
-> World
-> (World,Maybe Particle)
@@ -572,13 +571,6 @@ data Wall = Wall
}
-- | Strict maybe
data Maybe' a = Just' a | Nothing'
data ForceField = FF
{ _ffLine :: [Point2] , _ffID :: Int
, _ffColor :: Color
, _ffDeflect :: Maybe (StdGen -> Point2 -> ForceField -> (Point2,StdGen))
, _ffState :: FFState
}
newtype FFState = FFDestroyable { _ffsHP :: Int }
data ActionPlan
= Inanimate
@@ -757,8 +749,6 @@ makeLenses ''PjParam
makeLenses ''Prop
makeLenses ''Particle
makeLenses ''Wall
makeLenses ''ForceField
makeLenses ''FFState
makeLenses ''PressPlate
makeLenses ''Button
makeLenses ''ActionPlan
src/Dodge/Default/World.hs
-1
View File
@@ -38,7 +38,6 @@ defaultWorld = World
, _blocks = IM.empty
, _doors = IM.empty
, _wallsZone = Zone IM.empty
, _forceFields = IM.empty
, _floorItems = IM.empty
, _floorTiles = []
, _randGen = mkStdGen 2
src/Dodge/Initialisation.hs
-1
View File
@@ -42,7 +42,6 @@ initialWorld = defaultWorld
, _creatures = IM.fromList [(0,startCr)]
, _props = IM.empty
, _walls = IM.empty
, _forceFields = IM.empty
, _floorItems = IM.empty
, _randGen = mkStdGen 2
, _mousePos = V2 0 0
src/Dodge/Item/Weapon/Bezier.hs
+1 -1
View File
@@ -61,7 +61,7 @@ shootBezier targetp cr w = w & particles %~ (theBullet :)
startp
(controlp +.+ randPos)
(targetp +.+ randPos')
(destroyOnImpact bulHitCr bulHitWall bulHitFF')
(destroyOnImpact bulHitCr bulHitWall)
5
controlp = mouseWorldPos w
cid = _crID cr
src/Dodge/Item/Weapon/Bullet.hs
+3 -3
View File
@@ -8,21 +8,21 @@ import Geometry.Data
basicBullet :: Ammo
basicBullet = BulletAmmo
{ _amString = "BULLET"
, _amBulEff = destroyOnImpact bulHitCr bulHitWall bulHitFF'
, _amBulEff = destroyOnImpact bulHitCr bulHitWall
, _amBulWth = 2
, _amBulVel = V2 50 0
}
ltBullet :: Ammo
ltBullet = BulletAmmo
{ _amString = "LTBULLET"
, _amBulEff = destroyOnImpact bulHitCr bulHitWall bulHitFF'
, _amBulEff = destroyOnImpact bulHitCr bulHitWall
, _amBulWth = 2
, _amBulVel = V2 40 0
}
hvBullet :: Ammo
hvBullet = BulletAmmo
{ _amString = "HVBULLET"
, _amBulEff = penWalls hvBulHitCr hvBulHitWall' bulHitFF'
, _amBulEff = penWalls hvBulHitCr hvBulHitWall'
, _amBulWth = 6
, _amBulVel = V2 80 0
}
src/Dodge/Item/Weapon/Laser.hs
+6 -11
View File
@@ -60,11 +60,11 @@ moveLaser phaseV pos dir w pt
xp = pos +.+ 800 *.* unitVectorAtAngle dir
(a,g) = randomR (-0.7,0.7) $ _randGen w
reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (xp -.- pos))
f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either3 Creature Wall ForceField),[Point2])
f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either Creature Wall),[Point2])
f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of
Just (p,E3x2 wl)
Just (p,Right wl)
| _wlIsSeeThrough wl -> f' p $ f (wl:seenWs) p (h x y wl p)
| otherwise -> (Just (p,E3x2 wl), [p])
| otherwise -> (Just (p,Right wl), [p])
Just (p,obj) -> (Just (p,obj), [p])
Nothing -> (Nothing, [y])
f' p (x,ps') = (x,p:ps')
@@ -92,25 +92,20 @@ moveLaser phaseV pos dir w pt
reflectInternal = 1 < abs (phaseV * sin angleInc')
reflectExternal = 1 < abs (sin angleInc / phaseV)
h' ws (_,E3x2 wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws
h' ws (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws
h' _ _ = True
(thHit, ps) = f [] pos xp
hitEffect
= case thHit of
Just (p,E3x1 cr)
Just (p,Left cr)
-> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 19 pos p xp)
Just (p,E3x2 wl) -> createSparkCol 8 (V4 20 (-5) 0 1) (p +.+ safeNormalizeV (pos -.- p))
Just (p,Right wl) -> createSparkCol 8 (V4 20 (-5) 0 1) (p +.+ safeNormalizeV (pos -.- p))
(reflectDir wl)
_ -> id
pic = setLayer 1 $ pictures
[ setDepth 19 . color (brightX 0 0.5 yellow) $ lineOfThickness 20 (pos:ps)
, setDepth 19.5 . color (brightX 10 1 yellow) $ lineOfThickness 3 (pos:ps)
]
-- $ pictures
--[ fadeLine pos (head ps) 0.2 40 yellow
--, setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (pos:ps)
--, setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (pos:ps)
--]
fadeLine :: Point2 -> Point2 -> Float -> Float -> Color -> Picture
fadeLine sp ep alph width col = setLayer 1 $ polygonCol
src/Dodge/Particle/Bullet/HitEffect.hs
-2
View File
@@ -208,5 +208,3 @@ hvBulHitWall' bt p x w = damageBlocksBy 5 x $ set randGen g $ foldr ($) w (spar
ts = randomRs (4,8) $ _randGen w
sparks pos vel = zipWith3 (\t c d -> createSparkCol t c pos (argV vel + d)) ts cs ds
bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World
bulHitFF' _ _ _ = id
src/Dodge/Render/Picture.hs
-34
View File
@@ -8,7 +8,6 @@ import Dodge.Base
import Dodge.Base.Window
import Dodge.Zone
import Dodge.Graph
import Dodge.Picture
import Dodge.Picture.SizeInvariant
import Dodge.Picture.Layer
import Dodge.Render.HUD
@@ -211,39 +210,6 @@ extendConeToScreenEdge w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] +
rectangleSolid :: Float -> Float -> Picture
rectangleSolid x y = polygon $ map toV2 [(x,y),(x,-y),(-x,-y),(-x,y)]
ffToDraw :: World -> [ForceField]
ffToDraw _ = []
-- filter (lineOnScreen w . _ffLine) $
-- IM.elems $ over ffLine (map ( -.- _cameraCenter w)) <$>
-- _forceFields w
drawFF :: ForceField -> Picture
drawFF FF{_ffLine = l, _ffColor = col} = pictures
[color white $ line l
, color col $ lineOfThickness 6 l
]
drawFFShadow :: World -> ForceField -> [Picture]
drawFFShadow w ff
| youOnFF = []
| otherwise = map (rotate ( _cameraRot w) . pane) [0,0.05..0.25]
where
x = rotateV (-_cameraRot w) x'
y = rotateV (-_cameraRot w) y'
yp = _crPos $ you w
(x1:y1:_) = _ffLine ff
(x':y':_) | isRHS x1 y1 yp = [y1,x1]
| otherwise = [x1,y1]
col = _ffColor ff
ypShift = yp -.- _cameraCenter w
youOnFF = circOnSeg x' y' ypShift (_crRad $ you w)
pane j = color (withAlpha 0.1 col)
$ polygon
[ x
, x +.+ ((0.1 + j) *.* (x -.- ypShift))
, y +.+ ((0.1 + j) *.* (y -.- ypShift))
, y]
wallsAndWindows
:: World
-> ( [((Point2,Point2),Point4)] ,[((Point2,Point2),Point4)] )
src/Dodge/Update/Camera.hs
+40 -58
View File
@@ -56,41 +56,35 @@ moveCamera w = w
updateScopeZoom :: World -> World
updateScopeZoom w
| SDL.ButtonRight `S.member` _mouseButtons w = case w ^? scppoint of
| SDL.ButtonRight `S.member` _mouseButtons w
= case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . scopeZoomChange of
Just x
| x > 9 -> zoomInLongGun $ zoomInLongGun
$ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . scopeZoomChange -~ 2
| x > 0 -> zoomInLongGun
$ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . scopeZoomChange -~ 1
| x < -9 -> zoomOutLongGun $ zoomOutLongGun
$ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . scopeZoomChange +~ 2
| x < 0 -> zoomOutLongGun $ zoomOutLongGun
$ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . scopeZoomChange +~ 1
| x > 9 -> zoomInLongGun $ zoomInLongGun $ w
| x > 0 -> zoomInLongGun $ w
| x < -9 -> zoomOutLongGun $ zoomOutLongGun $ w
| x < 0 -> zoomOutLongGun $ w
| otherwise -> w
_ -> w
| otherwise = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment %~ updateScope
where
scppoint = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . scopeZoomChange
updateScope (ItScope _ _ _ bl) = ItScope (V2 0 0) 0 1 bl
updateScope otherAtt = otherAtt
zoomSpeed :: Float
zoomSpeed = 39/40
-- TODO unify zoom in and out, use scroll speed
zoomInLongGun :: World -> World
zoomInLongGun w
| currentZoom < 8 = over (wpPointer . itAttachment . scopePos)
(\p -> p +.+ (4-(4*zoomSpeed)) / currentZoom *.* mousep)
(\p -> p +.+ (4-(4*zoomSpeed)) / currentZoom *.* mousep)
$ over (wpPointer . itAttachment . scopeZoom) (/ zoomSpeed)
$ decreaseScopeZoomChange
w
| otherwise = w
| otherwise = decreaseScopeZoomChange w
where
decreaseScopeZoomChange = wpPointer . itAttachment . scopeZoomChange -~ 1
wpPointer = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
wp = _crInv (_creatures w IM.! 0) IM.! _crInvSel (_creatures w IM.! 0)
Just currentZoom = wp ^? itAttachment . scopeZoom
@@ -98,40 +92,36 @@ zoomInLongGun w
zoomOutLongGun :: World -> World
zoomOutLongGun w
| currentZoom > 0.5 = over (wpPointer . itAttachment . scopeZoom) (* zoomSpeed) w
| otherwise = w
| currentZoom > 0.5 = over (wpPointer . itAttachment . scopeZoom) (* zoomSpeed)
$ increaseScopeZoomChange w
| otherwise = increaseScopeZoomChange w
where
increaseScopeZoomChange = wpPointer . itAttachment . scopeZoomChange +~ 1
wpPointer = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
wp = _crInv (_creatures w IM.! 0) IM.! _crInvSel (_creatures w IM.! 0)
Just currentZoom = wp ^? itAttachment . scopeZoom
rotCam :: World -> World
rotCam = rotateCameraL
. rotateCameraR
. zoomCamIn . zoomCamOut
. autoZoomCam
rotCam = rotateCameraKey . autoZoomCam
rotateCameraL :: World -> World
rotateCameraL w
| rotateCameraPlusKey (_keyConfig w) `S.member` _keys w
= w & cameraRot +~ 0.015
& creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . scopePos %~ rotateV 0.015
rotateCameraBy :: Float -> World -> World
rotateCameraBy x w = w
& cameraRot +~ x
& creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . scopePos %~ rotateV x
rotateCameraKey :: World -> World
rotateCameraKey w
| keyl && keyr = w
| keyl = rotateCameraBy 0.015 w
| keyr = rotateCameraBy (-0.015) w
| otherwise = w
rotateCameraR :: World -> World
rotateCameraR w | rotateCameraMinusKey (_keyConfig w) `S.member` _keys w
= w & cameraRot -~ 0.015
& creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . scopePos %~ rotateV (-0.015)
| otherwise = w
zoomCamIn :: World -> World
zoomCamIn w | zoomInKey (_keyConfig w) `S.member` _keys w
= w {_cameraZoom = _cameraZoom w + 0.01}
| otherwise = w
zoomCamOut :: World -> World
zoomCamOut w | zoomOutKey (_keyConfig w) `S.member` _keys w
= w {_cameraZoom = max (_cameraZoom w - 0.01) 0.01}
| otherwise = w
where
keyl = rotateCameraPlusKey (_keyConfig w) `S.member` _keys w
keyr = rotateCameraMinusKey (_keyConfig w) `S.member` _keys w
zoomCamBy :: Float -> World -> World
zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01}
zoomFromItem
:: ItZoom
@@ -145,7 +135,12 @@ zoomNoItem
zoomNoItem = min 20 . max 0.2
{- Automatically sets the zoom of the camera according to the surrounding walls. -}
autoZoomCam :: World -> World
autoZoomCam w = over cameraZoom changeZoom w
autoZoomCam w
| zoomInKey (_keyConfig w) `S.member` _keys w
= zoomCamBy 0.01 w
| zoomOutKey (_keyConfig w) `S.member` _keys w
= zoomCamBy (-0.01) w
| otherwise = w & cameraZoom %~ changeZoom
where
camPos = _cameraViewFrom w
wallZoom = farWallDist camPos w
@@ -185,18 +180,5 @@ farWallPoints p w = concatMap _grViewpoints grs ++ linkvps
extend :: Point2 -> Point2
extend outp = p +.+ maxViewDistance *.* safeNormalizeV (outp -.- p)
--farWallDist :: Point2 -> World -> Float
--farWallDist p w = (winFac /) $ fromMaybe maxViewDistance
-- $ L.fold (L.premap (dist p) L.maximum) vdists
-- where
-- hw = halfWidth w
-- hh = halfHeight w
-- winFac = min hw hh
-- vdists :: [Point2]
-- vdists = map (flip (collidePointUpToIndirect p) wos) vps
-- vps = concatMap _grViewpoints grs
-- grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
-- wos = wallsOnScreen w
maxViewDistance :: Float
maxViewDistance = 800
src/Dodge/Update/UsingInput.hs
+4 -5
View File
@@ -1,8 +1,8 @@
{-
Functions that affect the world according to what pressed buttons are stored in a Set.
{- Functions that affect the world according to what pressed buttons are stored in a Set.
-}
module Dodge.Update.UsingInput
where
( updateUsingInput
) where
import Dodge.Data
import Dodge.Item.Data
import Dodge.Creature.Impulse.UseItem
@@ -13,8 +13,7 @@ import qualified Data.Set as S
import Control.Lens
updateUsingInput :: World -> World
updateUsingInput w =
if _carteDisplay w
updateUsingInput w = if _carteDisplay w
then updatePressedButtonsCarte (_mouseButtons w) w
else updatePressedButtons (_mouseButtons w) w
src/Dodge/WorldEvent.hs
+1 -1
View File
@@ -40,7 +40,7 @@ createBarrelSpark pos dir maycid time colid w
, _btPassThrough' = maycid
, _btWidth' = 1
, _btTimer' = time
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
, _btHitEffect' = destroyOnImpact sparkEff noEff
}
x = fst $ randomR (0,20) $ _randGen w
pos' = pos +.+ rotateV dir (V2 x 0)
src/Dodge/WorldEvent/HitEffect.hs
+10 -15
View File
@@ -15,7 +15,6 @@ import Control.Lens
type HitCreatureEffect = Particle -> Point2 -> Creature -> World -> World
type HitWallEffect = Particle -> Point2 -> Wall -> World -> World
type HitForceFieldEffect = Particle -> Point2 -> ForceField -> World -> World
--passThroughAll
-- :: HitCreatureEffect
@@ -36,16 +35,14 @@ type HitForceFieldEffect = Particle -> Point2 -> ForceField -> World -> World
destroyOnImpact
:: HitCreatureEffect
-> HitWallEffect
-> HitForceFieldEffect
-> Particle
-> [(Point2, Either3 Creature Wall ForceField)]
-> [(Point2, Either Creature Wall)]
-> World
-> (World, Maybe Particle)
destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
destroyOnImpact crEff wlEff pt hitThings w = case hitThings of
[] -> ( w, mvPt pt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p pt)
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p pt)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p pt)
((p,Left cr):_) -> (crEff pt p cr w, destroyAt p pt)
((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt)
mvPt :: Particle -> Maybe Particle
mvPt pt = Just $ pt
@@ -63,18 +60,16 @@ destroyAt hitp pt = Just $ pt
penWalls
:: HitCreatureEffect
-> HitWallEffect
-> HitForceFieldEffect
-> Particle
-> [(Point2, Either3 Creature Wall ForceField)]
-> [(Point2, Either Creature Wall)]
-> World
-> (World, Maybe Particle)
penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
penWalls crEff wlEff pt hitThings w = case hitThings of
[] -> ( w, mvPt pt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p pt)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p pt)
((p,E3x2 wl):hs) | isJust (wl ^? wlBlockID)
-> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p pt)
((p,Left cr):_) -> (crEff pt p cr w, destroyAt p pt)
((p,Right wl):hs) | isJust (wl ^? wlBlockID)
-> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w
((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt)
doFlameDam :: Int -> Particle -> Point2 -> Creature -> World -> World
doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage %~
src/Dodge/WorldEvent/SpawnParticle.hs
+7 -7
View File
@@ -55,7 +55,7 @@ aFlameParticle t pos vel maycid = PtZ
, _btPassThrough' = maycid
, _btWidth' = 4
, _btTimer' = t
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff
, _ptZ = 20
}
drawFlame
@@ -98,8 +98,8 @@ moveFlame
moveFlame rotd w pt
| time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing)
| otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of
((_,E3x1 _):_) -> (doSound damcrs , mvPt 0.7)
(thing@(p,E3x2 wl):_) -> (doSound . fst $ hiteff [thing] damcrs , rfl wl p)
((_,Left _):_) -> (doSound damcrs , mvPt 0.7)
(thing@(p,Right wl):_) -> (doSound . fst $ hiteff [thing] damcrs , rfl wl p)
_ -> (flameFlicker pt $ doSound damcrs , mvPt 0.98)
where
time = _btTimer' pt
@@ -112,7 +112,7 @@ moveFlame rotd w pt
, _btPos' = ep
, _btPassThrough' = Nothing
, _btVel' = speed *.* vel }
damcrs = foldr (\cr -> fst . hiteff [(ep,E3x1 cr)]) w
damcrs = foldr (\cr -> fst . hiteff [(ep,Left cr)]) w
$ IM.filter closeCrs $ _creatures w
closeCrs cr = dist ep (_crPos cr)
< _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
@@ -150,7 +150,7 @@ makeFlameletTimed (V2 x y) z vel maycid size time w = w
, _btPassThrough' = maycid
, _btWidth' = size
, _btTimer' = time
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff
, _ptZ = z
}
(rot ,g) = randomR (0,3) $ _randGen w
@@ -205,7 +205,7 @@ Applies movement and attaches damage to nearby creatures. -}
moveFlamelet :: World -> Particle -> (World, Maybe Particle)
moveFlamelet w pt
| _btTimer' pt <= 0 = ( w, Nothing)
| otherwise = (flameFlicker pt $ damcrs, mvPt)
| otherwise = (flameFlicker pt damcrs, mvPt)
where
sp = _btPos' pt
vel = _btVel' pt
@@ -389,7 +389,7 @@ createSparkCol time col pos dir = worldEvents %~ ( over particles (spark :) . )
, _btPassThrough' = Nothing
, _btWidth' = 1
, _btTimer' = time
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
, _btHitEffect' = destroyOnImpact sparkEff noEff
}
sparkEff bt p cr
= creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
src/Dodge/WorldEvent/ThingsHit.hs
+12 -17
View File
@@ -11,7 +11,6 @@ module Dodge.WorldEvent.ThingsHit
import Dodge.Data
import Dodge.Base
import Dodge.Zone
--import Dodge.Zone.Data
import Geometry
import qualified Data.IntMap.Strict as IM
@@ -22,27 +21,25 @@ thingsHit
:: Point2 -- ^ Line start point
-> Point2 -- ^ Line end point
-> World
-> [(Point2, Either3 Creature Wall ForceField)]
-> [(Point2, Either Creature Wall)]
thingsHit sp ep w
| sp == ep = []
| otherwise = sortOn (dist sp . fst) (crs ++ wls ++ ffs)
| otherwise = sortOn (dist sp . fst) (crs ++ wls)
where
hitCrs = IM.elems
$ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
$ _creatures w
-- $ creaturesAlongLine sp ep w
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
crs = zip crPs (map E3x1 hitCrs)
crs = zip crPs (map Left hitCrs)
hitWls = wallsOnLine sp ep (IM.unions [f b $ f a $ _znObjects $ _wallsZone w | a<-[x-1,x,x+1]
, b<-[y-1,y,y+1]])
(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 E3x2 hitWls)
wls = zip (map (fromJust . hitPoint) hitWls) (map Right hitWls)
hitPoint w' = uncurry (intersectSegSeg sp ep) (_wlLine w')
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
{- List objects that appear on a line.
Can filter out a creature. -}
thingsHitExceptCr
@@ -50,11 +47,11 @@ thingsHitExceptCr
-> Point2 -- ^ Line start point
-> Point2 -- ^ Line end point
-> World
-> [(Point2, Either3 Creature Wall ForceField)]
-> [(Point2, Either Creature Wall)]
thingsHitExceptCr Nothing sp ep = thingsHit sp ep
thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
where
crNotCid (_,E3x1 cr) = _crID cr /= cid
crNotCid (_,Left cr) = _crID cr /= cid
crNotCid _ = True
thingsHitExceptCrLongLine
@@ -62,26 +59,24 @@ thingsHitExceptCrLongLine
-> Point2
-> Point2
-> World
-> [(Point2, Either3 Creature Wall ForceField)]
-> [(Point2, Either Creature Wall)]
thingsHitExceptCrLongLine Nothing sp ep = thingsHitLongLine sp ep
thingsHitExceptCrLongLine (Just cid) sp ep = filter crNotCid . thingsHitLongLine sp ep
where
crNotCid (_,E3x1 cr) = _crID cr /= cid
crNotCid (_,Left cr) = _crID cr /= cid
crNotCid _ = True
thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either3 Creature Wall ForceField)]
thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either Creature Wall)]
thingsHitLongLine sp ep w
| sp == ep = []
| otherwise = sortOn (dist sp . fst) (crs ++ wls ++ ffs)
| otherwise = sortOn (dist sp . fst) (crs ++ wls)
where
crs = zip crPs (map E3x1 hitCrs)
crs = zip crPs (map Left hitCrs)
hitCrs = IM.elems
. IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
$ _creatures w
-- $ creaturesAlongLine sp ep w
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
wls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
wls = zip (map (fromJust . hitPoint) hitWls) (map Right hitWls)
hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
hitPoint wl = uncurry (intersectSegSeg sp ep) (_wlLine wl)
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs