Add in "linear" lWorld to separate time reversable worlds
This commit is contained in:
@@ -18,8 +18,8 @@ updateBarreloid cr = case cr ^?! crType . barrelType of
|
|||||||
-- should generate the sparks externally using new random generators
|
-- should generate the sparks externally using new random generators
|
||||||
updateExpBarrel :: Creature -> World -> World
|
updateExpBarrel :: Creature -> World -> World
|
||||||
updateExpBarrel cr w
|
updateExpBarrel cr w
|
||||||
| _crHP cr > 0 = foldl' (flip ($)) (hiss w & cWorld . creatures . at (_crID cr) .~ newCr) pierceSparks
|
| _crHP cr > 0 = foldl' (flip ($)) (hiss w & cWorld . lWorld . creatures . at (_crID cr) .~ newCr) pierceSparks
|
||||||
| otherwise = makeExplosionAt (_crPos cr) $ stopSounds w & cWorld . creatures . at (_crID cr) .~ Nothing
|
| otherwise = makeExplosionAt (_crPos cr) $ stopSounds w & cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
|
||||||
where
|
where
|
||||||
g = _randGen w
|
g = _randGen w
|
||||||
damages = _csDamage $ _crState cr
|
damages = _csDamage $ _crState cr
|
||||||
@@ -45,7 +45,7 @@ updateExpBarrel cr w
|
|||||||
updateBarrel :: Creature -> World -> World
|
updateBarrel :: Creature -> World -> World
|
||||||
updateBarrel cr
|
updateBarrel cr
|
||||||
| _crHP cr > 0 = doDamage cr
|
| _crHP cr > 0 = doDamage cr
|
||||||
| otherwise = cWorld . creatures . at (_crID cr) .~ Nothing
|
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
|
||||||
|
|
||||||
damsToExpBarrel :: [Damage] -> Creature -> Creature
|
damsToExpBarrel :: [Damage] -> Creature -> Creature
|
||||||
damsToExpBarrel ds cr = foldl' damToExpBarrel (foldl' damToExpBarrel cr pierceDam) otherDam
|
damsToExpBarrel ds cr = foldl' damToExpBarrel (foldl' damToExpBarrel cr pierceDam) otherDam
|
||||||
|
|||||||
@@ -44,7 +44,6 @@ import Dodge.Data.World
|
|||||||
import Dodge.Zoning
|
import Dodge.Zoning
|
||||||
import FoldableHelp
|
import FoldableHelp
|
||||||
import Geometry
|
import Geometry
|
||||||
import qualified IntMapHelp as IM
|
|
||||||
|
|
||||||
collidePoint ::
|
collidePoint ::
|
||||||
Point2 ->
|
Point2 ->
|
||||||
@@ -141,7 +140,7 @@ allVisibleWalls :: World -> [(Point2, Wall)]
|
|||||||
{-# INLINE allVisibleWalls #-}
|
{-# INLINE allVisibleWalls #-}
|
||||||
allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 20
|
allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 20
|
||||||
where
|
where
|
||||||
vPos = w ^. cWorld . cwCam . cwcViewFrom
|
vPos = w ^. cWorld . lWorld . cwCam . cwcViewFrom
|
||||||
|
|
||||||
--allVisibleWalls :: World -> StreamOf (Point2,Wall)
|
--allVisibleWalls :: World -> StreamOf (Point2,Wall)
|
||||||
--{-# INLINE allVisibleWalls #-}
|
--{-# INLINE allVisibleWalls #-}
|
||||||
@@ -217,7 +216,7 @@ circOnAnyCr :: Point2 -> Float -> World -> Bool
|
|||||||
{-# INLINE circOnAnyCr #-}
|
{-# INLINE circOnAnyCr #-}
|
||||||
circOnAnyCr p r w = IS.foldr f False $ crIXsNearPoint p w
|
circOnAnyCr p r w = IS.foldr f False $ crIXsNearPoint p w
|
||||||
where
|
where
|
||||||
f cid bl = maybe False (\cr -> dist p (_crPos cr) < r + _crRad cr) (w ^? cWorld . creatures . ix cid) || bl
|
f cid bl = maybe False (\cr -> dist p (_crPos cr) < r + _crRad cr) (w ^? cWorld . lWorld . creatures . ix cid) || bl
|
||||||
|
|
||||||
-- | More general collision tests follow
|
-- | More general collision tests follow
|
||||||
hasLOS :: Point2 -> Point2 -> World -> Bool
|
hasLOS :: Point2 -> Point2 -> World -> Bool
|
||||||
@@ -252,15 +251,15 @@ canSee :: Int -> Int -> World -> Bool
|
|||||||
{-# INLINE canSee #-}
|
{-# INLINE canSee #-}
|
||||||
canSee i j w = hasLOS p1 p2 w
|
canSee i j w = hasLOS p1 p2 w
|
||||||
where
|
where
|
||||||
p1 = _crPos (_creatures (_cWorld w) IM.! i)
|
p1 = w ^?! cWorld . lWorld . creatures . ix i . crPos -- _crPos (_creatures (_cWorld w) IM.! i)
|
||||||
p2 = _crPos (_creatures (_cWorld w) IM.! j) -- unsafe
|
p2 = w ^?! cWorld . lWorld . creatures . ix j . crPos -- _crPos (_creatures (_cWorld w) IM.! j) -- unsafe
|
||||||
|
|
||||||
canSeeIndirect :: Int -> Int -> World -> Bool
|
canSeeIndirect :: Int -> Int -> World -> Bool
|
||||||
{-# INLINE canSeeIndirect #-}
|
{-# INLINE canSeeIndirect #-}
|
||||||
canSeeIndirect i j w = hasLOSIndirect ipos jpos w
|
canSeeIndirect i j w = hasLOSIndirect ipos jpos w
|
||||||
where
|
where
|
||||||
ipos = _crPos (_creatures (_cWorld w) IM.! i)
|
ipos = w ^?! cWorld . lWorld . creatures . ix i . crPos
|
||||||
jpos = _crPos (_creatures (_cWorld w) IM.! j)
|
jpos = w ^?! cWorld . lWorld . creatures . ix j . crPos
|
||||||
|
|
||||||
anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
|
anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
|
||||||
anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
|
anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
|
||||||
@@ -270,7 +269,7 @@ anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
|
|||||||
maybe
|
maybe
|
||||||
False
|
False
|
||||||
(\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
|
(\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
|
||||||
(w ^? cWorld . creatures . ix cid)
|
(w ^? cWorld . lWorld . creatures . ix cid)
|
||||||
|| bl
|
|| bl
|
||||||
|
|
||||||
hitWl = collideCircWalls sp ep rad $ wlsNearPoint ep w
|
hitWl = collideCircWalls sp ep rad $ wlsNearPoint ep w
|
||||||
|
|||||||
@@ -9,9 +9,9 @@ import Control.Lens
|
|||||||
worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2
|
worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2
|
||||||
worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
|
worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
|
||||||
where
|
where
|
||||||
doTranslate p = p -.- (w ^. cWorld . cwCam . cwcCenter)
|
doTranslate p = p -.- (w ^. cWorld . lWorld . cwCam . cwcCenter)
|
||||||
doZoom p = (w ^. cWorld . cwCam . cwcZoom) *.* p
|
doZoom p = (w ^. cWorld . lWorld . cwCam . cwcZoom) *.* p
|
||||||
doRotate p = rotateV (negate (w ^. cWorld . cwCam . cwcRot)) p
|
doRotate p = rotateV (negate (w ^. cWorld . lWorld . cwCam . cwcRot)) p
|
||||||
|
|
||||||
{- | Transform world coordinates to scaled screen coordinates.
|
{- | Transform world coordinates to scaled screen coordinates.
|
||||||
- These have to be scaled according to the size of the window to get actual screen positions.
|
- These have to be scaled according to the size of the window to get actual screen positions.
|
||||||
@@ -19,9 +19,9 @@ worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTransla
|
|||||||
-}
|
-}
|
||||||
worldPosToScreen :: World -> Point2 -> Point2
|
worldPosToScreen :: World -> Point2 -> Point2
|
||||||
worldPosToScreen w =
|
worldPosToScreen w =
|
||||||
rotateV (negate $ w ^. cWorld . cwCam . cwcRot)
|
rotateV (negate $ w ^. cWorld . lWorld . cwCam . cwcRot)
|
||||||
. ((w ^. cWorld . cwCam . cwcZoom) *.*)
|
. ((w ^. cWorld . lWorld . cwCam . cwcZoom) *.*)
|
||||||
. (-.- (w ^. cWorld . cwCam . cwcCenter))
|
. (-.- (w ^. cWorld . lWorld . cwCam . cwcCenter))
|
||||||
|
|
||||||
{- | Transform coordinates from the map position to screen
|
{- | Transform coordinates from the map position to screen
|
||||||
coordinates.
|
coordinates.
|
||||||
@@ -29,9 +29,11 @@ coordinates.
|
|||||||
cartePosToScreen :: Configuration -> World -> Point2 -> Point2
|
cartePosToScreen :: Configuration -> World -> Point2 -> Point2
|
||||||
cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
|
cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
|
||||||
where
|
where
|
||||||
doTranslate p = p -.- _carteCenter (_hud (_cWorld w))
|
doTranslate p = p -.- (w ^. cWorld . lWorld . hud . carteCenter) -- _carteCenter (_hud (_cWorld w))
|
||||||
doZoom p = _carteZoom (_hud (_cWorld w)) *.* p
|
--doZoom p = _carteZoom (_hud (_cWorld w)) *.* p
|
||||||
doRotate p = rotateV (negate $ _carteRot (_hud (_cWorld w))) p
|
doZoom p = (w ^. cWorld . lWorld . hud . carteZoom) *.* p
|
||||||
|
--doRotate p = rotateV (negate $ _carteRot (_hud (_cWorld w))) p
|
||||||
|
doRotate p = rotateV (negate $ w ^. cWorld . lWorld . hud . carteRot) p
|
||||||
|
|
||||||
crToMousePosOffset :: Creature -> World -> (Point2, Float)
|
crToMousePosOffset :: Creature -> World -> (Point2, Float)
|
||||||
crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0)
|
crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0)
|
||||||
@@ -39,11 +41,14 @@ crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0)
|
|||||||
-- | The mouse position in world coordinates.
|
-- | The mouse position in world coordinates.
|
||||||
mouseWorldPos :: World -> Point2
|
mouseWorldPos :: World -> Point2
|
||||||
mouseWorldPos w =
|
mouseWorldPos w =
|
||||||
(w ^. cWorld . cwCam . cwcCenter)
|
(w ^. cWorld . lWorld . cwCam . cwcCenter)
|
||||||
+.+ (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* rotateV (w ^. cWorld . cwCam . cwcRot) (_mousePos w)
|
+.+ (1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)) *.* rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) (_mousePos w)
|
||||||
|
|
||||||
-- | The mouse position in map coordinates
|
-- | The mouse position in map coordinates
|
||||||
mouseCartePos :: World -> Point2
|
mouseCartePos :: World -> Point2
|
||||||
mouseCartePos w =
|
mouseCartePos w = (w ^. cWorld . lWorld . hud . carteCenter)
|
||||||
_carteCenter (_hud (_cWorld w))
|
+.+
|
||||||
+.+ (1 / _carteZoom (_hud (_cWorld w))) *.* rotateV (_carteRot (_hud (_cWorld w))) (_mousePos w)
|
(1 / (w ^. cWorld . lWorld . hud . carteZoom))
|
||||||
|
*.* rotateV (w ^. cWorld . lWorld . hud . carteRot) (_mousePos w)
|
||||||
|
-- _carteCenter (_hud (_cWorld w))
|
||||||
|
-- +.+ (1 / _carteZoom (_hud (_cWorld w))) *.* rotateV (_carteRot (_hud (_cWorld w))) (_mousePos w)
|
||||||
|
|||||||
@@ -15,16 +15,11 @@ import Control.Lens
|
|||||||
screenPolygon :: Configuration -> World -> [Point2]
|
screenPolygon :: Configuration -> World -> [Point2]
|
||||||
screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig
|
screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig
|
||||||
where
|
where
|
||||||
scRot = rotateV (w ^. cWorld . cwCam . cwcRot)
|
scRot = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot)
|
||||||
scZoom p
|
scZoom p
|
||||||
| (w ^. cWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* p
|
| (w ^. cWorld . lWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)) *.* p
|
||||||
| otherwise = p
|
| otherwise = p
|
||||||
scTran p = p +.+ (w ^. cWorld . cwCam . cwcCenter)
|
scTran p = p +.+ (w ^. cWorld . lWorld . cwCam . cwcCenter)
|
||||||
|
|
||||||
-- tr = scTran $ scRot $ scZoom (V2 ( halfWidth w) ( halfHeight w))
|
|
||||||
-- tl = scTran $ scRot $ scZoom (V2 (-halfWidth w) ( halfHeight w))
|
|
||||||
-- br = scTran $ scRot $ scZoom (V2 ( halfWidth w) (-halfHeight w))
|
|
||||||
-- bl = scTran $ scRot $ scZoom (V2 (-halfWidth w) (-halfHeight w))
|
|
||||||
|
|
||||||
-- | A box covering the screen in world coordinates, with a x and y border
|
-- | A box covering the screen in world coordinates, with a x and y border
|
||||||
screenPolygonBord ::
|
screenPolygonBord ::
|
||||||
@@ -40,9 +35,9 @@ screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br]
|
|||||||
hw = halfWidth cfig - xbord
|
hw = halfWidth cfig - xbord
|
||||||
hh = halfHeight cfig - ybord
|
hh = halfHeight cfig - ybord
|
||||||
scZoom p
|
scZoom p
|
||||||
| (w ^. cWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* p
|
| (w ^. cWorld . lWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)) *.* p
|
||||||
| otherwise = p
|
| otherwise = p
|
||||||
theTransform = (+.+ (w ^. cWorld . cwCam . cwcCenter)) . rotateV (w ^. cWorld . cwCam . cwcRot) . scZoom
|
theTransform = (+.+ (w ^. cWorld . lWorld . cwCam . cwcCenter)) . rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) . scZoom
|
||||||
tr = theTransform (V2 hw hh)
|
tr = theTransform (V2 hw hh)
|
||||||
tl = theTransform (V2 (- hw) hh)
|
tl = theTransform (V2 (- hw) hh)
|
||||||
br = theTransform (V2 hw (- hh))
|
br = theTransform (V2 hw (- hh))
|
||||||
|
|||||||
@@ -2,9 +2,11 @@ module Dodge.Base.You where
|
|||||||
|
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import qualified IntMapHelp as IM
|
import qualified IntMapHelp as IM
|
||||||
|
import Control.Lens
|
||||||
|
|
||||||
you :: World -> Creature
|
you :: World -> Creature
|
||||||
you w = _creatures (_cWorld w) IM.! _yourID (_cWorld w)
|
--you w = _creatures (_cWorld w) IM.! _yourID (_cWorld w)
|
||||||
|
you w = w ^?! cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID)
|
||||||
|
|
||||||
yourItem :: World -> Maybe Item
|
yourItem :: World -> Maybe Item
|
||||||
yourItem w = _crInv (you w) IM.!? crSel (you w)
|
yourItem w = _crInv (you w) IM.!? crSel (you w)
|
||||||
|
|||||||
+4
-5
@@ -6,7 +6,6 @@ import Dodge.Flame
|
|||||||
import Dodge.Item.Location
|
import Dodge.Item.Location
|
||||||
import Dodge.Tesla.Arc
|
import Dodge.Tesla.Arc
|
||||||
import Geometry
|
import Geometry
|
||||||
import qualified IntMapHelp as IM
|
|
||||||
import LensHelp
|
import LensHelp
|
||||||
import Picture
|
import Picture
|
||||||
|
|
||||||
@@ -34,15 +33,15 @@ lasBeamCombine ::
|
|||||||
World ->
|
World ->
|
||||||
World
|
World
|
||||||
lasBeamCombine (p, (a, b, _), (x, y, _)) =
|
lasBeamCombine (p, (a, b, _), (x, y, _)) =
|
||||||
cWorld . lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x)))
|
cWorld . lWorld . lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x)))
|
||||||
|
|
||||||
splitBeamCombine ::
|
splitBeamCombine ::
|
||||||
(Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
|
(Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
|
||||||
World ->
|
World ->
|
||||||
World
|
World
|
||||||
splitBeamCombine (p, (a, b, _), (x, y, _)) =
|
splitBeamCombine (p, (a, b, _), (x, y, _)) =
|
||||||
(cWorld . lasers .:~ lasRayAt yellow 11 1 p (dir + 0.5 * pi))
|
(cWorld . lWorld . lasers .:~ lasRayAt yellow 11 1 p (dir + 0.5 * pi))
|
||||||
. (cWorld . lasers .:~ lasRayAt yellow 11 1 p (dir -0.5 * pi))
|
. (cWorld . lWorld . lasers .:~ lasRayAt yellow 11 1 p (dir -0.5 * pi))
|
||||||
where
|
where
|
||||||
dir = argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x))
|
dir = argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x))
|
||||||
|
|
||||||
@@ -51,7 +50,7 @@ teslaBeamCombine ::
|
|||||||
World ->
|
World ->
|
||||||
World
|
World
|
||||||
teslaBeamCombine (p, (a, b, bm), (x, y, _)) w =
|
teslaBeamCombine (p, (a, b, bm), (x, y, _)) w =
|
||||||
w' & pointerToItemLocation (_itemLocations (_cWorld w) IM.! itid) . itParams . subParams ?~ ip
|
w' & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itid) . itParams . subParams ?~ ip
|
||||||
where
|
where
|
||||||
itid = fromJust $ _bmOrigin bm
|
itid = fromJust $ _bmOrigin bm
|
||||||
dir = argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x))
|
dir = argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x))
|
||||||
|
|||||||
+16
-14
@@ -31,15 +31,15 @@ splinterBlock bl w =
|
|||||||
(_blPos bl)
|
(_blPos bl)
|
||||||
where
|
where
|
||||||
bm = fromMaybe Stone $ do
|
bm = fromMaybe Stone $ do
|
||||||
wlids <- w ^? cWorld . blocks . ix (_blID bl) . blWallIDs
|
wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs
|
||||||
(wlid, _) <- IS.minView wlids
|
(wlid, _) <- IS.minView wlids
|
||||||
w ^? cWorld . walls . ix wlid . wlMaterial
|
w ^? cWorld . lWorld . walls . ix wlid . wlMaterial
|
||||||
|
|
||||||
unshadowBlock :: World -> Int -> World
|
unshadowBlock :: World -> Int -> World
|
||||||
unshadowBlock w wlid = case w ^? cWorld . walls . ix wlid of
|
unshadowBlock w wlid = case w ^? cWorld . lWorld . walls . ix wlid of
|
||||||
Just wl ->
|
Just wl ->
|
||||||
w
|
w
|
||||||
& cWorld . walls . ix wlid . wlUnshadowed .~ True
|
& cWorld . lWorld . walls . ix wlid . wlUnshadowed .~ True
|
||||||
& insertWallInZones (wl & wlUnshadowed .~ True)
|
& insertWallInZones (wl & wlUnshadowed .~ True)
|
||||||
Nothing -> w
|
Nothing -> w
|
||||||
|
|
||||||
@@ -55,13 +55,14 @@ destroyBlock bl w =
|
|||||||
& makeBlockDebris bl
|
& makeBlockDebris bl
|
||||||
& deleteWallIDs wlids
|
& deleteWallIDs wlids
|
||||||
& maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted
|
& maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted
|
||||||
& cWorld . blocks %~ IM.delete (_blID bl)
|
& cWorld . lWorld . blocks %~ IM.delete (_blID bl)
|
||||||
-- & matDesSound (_blMaterial bl) pos
|
-- & matDesSound (_blMaterial bl) pos
|
||||||
& flip (foldl' $ flip (wlDustAt awl)) (map (pos +.+) ps)
|
& flip (foldl' $ flip (wlDustAt awl)) (map (pos +.+) ps)
|
||||||
where
|
where
|
||||||
wlids = _blWallIDs bl
|
wlids = _blWallIDs bl
|
||||||
awl = _walls (_cWorld w) IM.! IS.findMin wlids
|
--awl = _walls (_cWorld w) IM.! IS.findMin wlids
|
||||||
pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids
|
awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids)
|
||||||
|
pos = fst . _wlLine $ awl
|
||||||
ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
|
ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
|
||||||
|
|
||||||
-- this does not handle eg doors blocking the path as well
|
-- this does not handle eg doors blocking the path as well
|
||||||
@@ -72,21 +73,22 @@ maybeClearPath :: World -> PathEdgeNodes -> World
|
|||||||
maybeClearPath w (PathEdgeNodes x y pe)
|
maybeClearPath w (PathEdgeNodes x y pe)
|
||||||
| not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w =
|
| not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w =
|
||||||
w
|
w
|
||||||
| otherwise = w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles .~ mempty) . FGL.delEdge (x, y)
|
| otherwise = w & cWorld . lWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles .~ mempty) . FGL.delEdge (x, y)
|
||||||
|
|
||||||
destroyDoor :: Door -> World -> World
|
destroyDoor :: Door -> World -> World
|
||||||
destroyDoor dr w =
|
destroyDoor dr w =
|
||||||
w
|
w
|
||||||
& doDrWdWd (_drDeath dr) dr
|
& doDrWdWd (_drDeath dr) dr
|
||||||
& deleteWallIDs wlids
|
& deleteWallIDs wlids
|
||||||
& cWorld . doors %~ IM.delete (_drID dr)
|
& cWorld . lWorld . doors %~ IM.delete (_drID dr)
|
||||||
& flip (foldl' (flip $ wlDustAt awl)) (map (pos +.+) ps)
|
& flip (foldl' (flip $ wlDustAt awl)) (map (pos +.+) ps)
|
||||||
& stopPushing (_drPushes dr)
|
& stopPushing (_drPushes dr)
|
||||||
& destroyMounts (_drMounts dr)
|
& destroyMounts (_drMounts dr)
|
||||||
where
|
where
|
||||||
wlids = _drWallIDs dr
|
wlids = _drWallIDs dr
|
||||||
awl = _walls (_cWorld w) IM.! IS.findMin wlids
|
--awl = _walls (_cWorld w) IM.! IS.findMin wlids
|
||||||
pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids
|
awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids)
|
||||||
|
pos = fst . _wlLine $ awl
|
||||||
ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
|
ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
|
||||||
|
|
||||||
destroyMounts :: [MountedObject] -> World -> World
|
destroyMounts :: [MountedObject] -> World -> World
|
||||||
@@ -95,12 +97,12 @@ destroyMounts mos w = foldl' (flip destroyMount) w mos
|
|||||||
destroyMount :: MountedObject -> World -> World
|
destroyMount :: MountedObject -> World -> World
|
||||||
destroyMount mo = case mo of
|
destroyMount mo = case mo of
|
||||||
MountedLS lsid -> destroyLS lsid
|
MountedLS lsid -> destroyLS lsid
|
||||||
MountedProp prid -> cWorld . props . at prid .~ Nothing
|
MountedProp prid -> cWorld . lWorld . props . at prid .~ Nothing
|
||||||
|
|
||||||
stopPushing :: Maybe Int -> World -> World
|
stopPushing :: Maybe Int -> World -> World
|
||||||
stopPushing mdrid w = fromMaybe w $ do
|
stopPushing mdrid w = fromMaybe w $ do
|
||||||
drid <- mdrid
|
drid <- mdrid
|
||||||
dr <- w ^? cWorld . doors . ix drid
|
dr <- w ^? cWorld . lWorld . doors . ix drid
|
||||||
return $
|
return $
|
||||||
w & cWorld . doors . ix drid . drMech .~ DrWdId
|
w & cWorld . lWorld . doors . ix drid . drMech .~ DrWdId
|
||||||
& stopPushing (_drPushes dr)
|
& stopPushing (_drPushes dr)
|
||||||
|
|||||||
@@ -20,9 +20,9 @@ makeDoorDebris dr w = w & makeDebris mt col p
|
|||||||
where
|
where
|
||||||
p = uncurry midPoint (_drPos dr)
|
p = uncurry midPoint (_drPos dr)
|
||||||
(mt, col) = fromMaybe (Stone, greyN 0.5) $ do
|
(mt, col) = fromMaybe (Stone, greyN 0.5) $ do
|
||||||
wlids <- w ^? cWorld . doors . ix (_drID dr) . drWallIDs
|
wlids <- w ^? cWorld . lWorld . doors . ix (_drID dr) . drWallIDs
|
||||||
(wlid, _) <- IS.minView wlids
|
(wlid, _) <- IS.minView wlids
|
||||||
wl <- w ^? cWorld . walls . ix wlid
|
wl <- w ^? cWorld . lWorld . walls . ix wlid
|
||||||
return (_wlMaterial wl, _wlColor wl)
|
return (_wlMaterial wl, _wlColor wl)
|
||||||
|
|
||||||
makeBlockDebris :: Block -> World -> World
|
makeBlockDebris :: Block -> World -> World
|
||||||
@@ -31,9 +31,9 @@ makeBlockDebris bl w = foldl' (flip $ makeDebris mt col) w ps
|
|||||||
dsize = debrisSize mt
|
dsize = debrisSize mt
|
||||||
ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_blFootprint bl)
|
ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_blFootprint bl)
|
||||||
(mt, col) = fromMaybe (Stone, greyN 0.5) $ do
|
(mt, col) = fromMaybe (Stone, greyN 0.5) $ do
|
||||||
wlids <- w ^? cWorld . blocks . ix (_blID bl) . blWallIDs
|
wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs
|
||||||
(wlid, _) <- IS.minView wlids
|
(wlid, _) <- IS.minView wlids
|
||||||
wl <- w ^? cWorld . walls . ix wlid
|
wl <- w ^? cWorld . lWorld . walls . ix wlid
|
||||||
return (_wlMaterial wl, _wlColor wl)
|
return (_wlMaterial wl, _wlColor wl)
|
||||||
|
|
||||||
makeDebrisToHeight :: Float -> Material -> Color -> Point2 -> World -> World
|
makeDebrisToHeight :: Float -> Material -> Color -> Point2 -> World -> World
|
||||||
@@ -55,7 +55,7 @@ makeDebrisDirectedHeight ::
|
|||||||
World
|
World
|
||||||
makeDebrisDirectedHeight mindist maxdist arcrad dir maxh bm col p w =
|
makeDebrisDirectedHeight mindist maxdist arcrad dir maxh bm col p w =
|
||||||
w
|
w
|
||||||
& flip (foldl' (flip $ plNew (cWorld . props) prID)) thedebris
|
& flip (foldl' (flip $ plNew (cWorld . lWorld . props) prID)) thedebris
|
||||||
& randGen .~ newg
|
& randGen .~ newg
|
||||||
& originsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p
|
& originsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p
|
||||||
where
|
where
|
||||||
@@ -88,7 +88,7 @@ makeDebrisDirected ::
|
|||||||
World
|
World
|
||||||
makeDebrisDirected mindist maxdist arcrad dir bm col p w =
|
makeDebrisDirected mindist maxdist arcrad dir bm col p w =
|
||||||
w
|
w
|
||||||
& flip (foldl' (flip $ plNew (cWorld . props) prID)) thedebris
|
& flip (foldl' (flip $ plNew (cWorld . lWorld . props) prID)) thedebris
|
||||||
& randGen .~ newg
|
& randGen .~ newg
|
||||||
& originsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p
|
& originsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p
|
||||||
where
|
where
|
||||||
|
|||||||
+5
-5
@@ -40,7 +40,7 @@ mvBullet x w bu
|
|||||||
|
|
||||||
applyMagnetsToBul :: Bullet -> World -> Bullet
|
applyMagnetsToBul :: Bullet -> World -> Bullet
|
||||||
applyMagnetsToBul bu =
|
applyMagnetsToBul bu =
|
||||||
foldl' (flip doMagnetBuBu) bu . _magnets . _cWorld
|
foldl' (flip doMagnetBuBu) bu . _magnets . _lWorld . _cWorld
|
||||||
|
|
||||||
updateBulVel :: Bullet -> Bullet
|
updateBulVel :: Bullet -> Bullet
|
||||||
updateBulVel bt = case _buTrajectory bt of
|
updateBulVel bt = case _buTrajectory bt of
|
||||||
@@ -55,7 +55,7 @@ updateBulVel bt = case _buTrajectory bt of
|
|||||||
|
|
||||||
useAmmoParams :: Item -> Creature -> World -> World
|
useAmmoParams :: Item -> Creature -> World -> World
|
||||||
useAmmoParams it cr w =
|
useAmmoParams it cr w =
|
||||||
w & cWorld . instantBullets
|
w & cWorld . lWorld . instantBullets
|
||||||
.:~ ( _amBullet bultype
|
.:~ ( _amBullet bultype
|
||||||
& buPos .~ sp
|
& buPos .~ sp
|
||||||
& buTrajectory %~ settrajectory
|
& buTrajectory %~ settrajectory
|
||||||
@@ -89,7 +89,7 @@ bulletSpawn :: Bullet -> Maybe (Point2 -> World -> World)
|
|||||||
bulletSpawn bu = case _buSpawn bu of
|
bulletSpawn bu = case _buSpawn bu of
|
||||||
BulSpark -> Nothing
|
BulSpark -> Nothing
|
||||||
BulBall IncBall -> Just incBallAt
|
BulBall IncBall -> Just incBallAt
|
||||||
BulBall ConcBall -> Just $ \p -> cWorld . shockwaves .:~ concBall p
|
BulBall ConcBall -> Just $ \p -> cWorld . lWorld . shockwaves .:~ concBall p
|
||||||
BulBall TeslaBall -> Just makeStaticBall
|
BulBall TeslaBall -> Just makeStaticBall
|
||||||
|
|
||||||
hitEffFromBul ::
|
hitEffFromBul ::
|
||||||
@@ -125,8 +125,8 @@ setFromToDams bu p = map f (_buDamages bu)
|
|||||||
|
|
||||||
damageThingHit :: Bullet -> (Point2, Either Creature Wall) -> World -> World
|
damageThingHit :: Bullet -> (Point2, Either Creature Wall) -> World -> World
|
||||||
damageThingHit bu (p, crwl) = case crwl of
|
damageThingHit bu (p, crwl) = case crwl of
|
||||||
Left cr -> cWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
|
Left cr -> cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
|
||||||
Right wl -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
|
Right wl -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
|
||||||
where
|
where
|
||||||
dams = setFromToDams bu p
|
dams = setFromToDams bu p
|
||||||
|
|
||||||
|
|||||||
@@ -10,8 +10,8 @@ doButtonEvent be = case be of
|
|||||||
ButtonDoNothing -> const id
|
ButtonDoNothing -> const id
|
||||||
ButtonPress newstate newevent thesound f -> \b ->
|
ButtonPress newstate newevent thesound f -> \b ->
|
||||||
doWdWd f
|
doWdWd f
|
||||||
. set (cWorld . buttons . ix (_btID b) . btState) newstate
|
. set (cWorld . lWorld . buttons . ix (_btID b) . btState) newstate
|
||||||
. set (cWorld . buttons . ix (_btID b) . btEvent) newevent
|
. set (cWorld . lWorld . buttons . ix (_btID b) . btEvent) newevent
|
||||||
. soundStart (LeverSound 0) (_btPos b) thesound Nothing
|
. soundStart (LeverSound 0) (_btPos b) thesound Nothing
|
||||||
--ButtonSwitch onstate onevent onsound oneff offstate offevent offsound offeff -> undefined
|
--ButtonSwitch onstate onevent onsound oneff offstate offevent offsound offeff -> undefined
|
||||||
ButtonSimpleSwith oneff offeff -> flipSwitch oneff offeff
|
ButtonSimpleSwith oneff offeff -> flipSwitch oneff offeff
|
||||||
@@ -21,10 +21,10 @@ flipSwitch :: WdWd -> WdWd -> Button -> World -> World
|
|||||||
flipSwitch oneff offeff bt
|
flipSwitch oneff offeff bt
|
||||||
| _btState bt == BtOff =
|
| _btState bt == BtOff =
|
||||||
doWdWd oneff . dosound
|
doWdWd oneff . dosound
|
||||||
. over (cWorld . buttons . ix (_btID bt)) turnon
|
. over (cWorld . lWorld . buttons . ix (_btID bt)) turnon
|
||||||
| otherwise =
|
| otherwise =
|
||||||
doWdWd offeff . dosound
|
doWdWd offeff . dosound
|
||||||
. over (cWorld . buttons . ix (_btID bt)) turnoff
|
. over (cWorld . lWorld . buttons . ix (_btID bt)) turnoff
|
||||||
where
|
where
|
||||||
turnon = (btState .~ BtOn) . (btText .~ "SWITCH\\")
|
turnon = (btState .~ BtOn) . (btText .~ "SWITCH\\")
|
||||||
turnoff = (btState .~ BtOff) . (btText .~ "SWITCH/")
|
turnoff = (btState .~ BtOff) . (btText .~ "SWITCH/")
|
||||||
|
|||||||
@@ -86,12 +86,12 @@ fullModuleName :: ItemModuleType -> String
|
|||||||
fullModuleName = fromMaybe "EMPTYMODULE" . moduleName
|
fullModuleName = fromMaybe "EMPTYMODULE" . moduleName
|
||||||
|
|
||||||
toggleCombineInv :: World -> World
|
toggleCombineInv :: World -> World
|
||||||
toggleCombineInv w = case _hudElement (_hud (_cWorld w)) of
|
toggleCombineInv w = case w ^. cWorld . lWorld . hud . hudElement of
|
||||||
DisplayInventory CombineInventory{} -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
|
DisplayInventory CombineInventory{} -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
|
||||||
_ -> w & enterCombineInv
|
_ -> w & enterCombineInv
|
||||||
|
|
||||||
enterCombineInv :: World -> World
|
enterCombineInv :: World -> World
|
||||||
enterCombineInv w = w & cWorld . hud . hudElement .~ DisplayInventory (CombineInventory mi)
|
enterCombineInv w = w & cWorld . lWorld . hud . hudElement .~ DisplayInventory (CombineInventory mi)
|
||||||
where
|
where
|
||||||
mi = 0 <$ listToMaybe (combineItemListYou w)
|
mi = 0 <$ listToMaybe (combineItemListYou w)
|
||||||
|
|
||||||
|
|||||||
@@ -57,7 +57,7 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
|
|||||||
Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
|
Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
|
||||||
Nothing -> error "creature without aiming type"
|
Nothing -> error "creature without aiming type"
|
||||||
tpos
|
tpos
|
||||||
| canSee' = _crPos (_creatures (_cWorld w) IM.! tcid)
|
| canSee' = w ^?! cWorld . lWorld . creatures . ix tcid . crPos
|
||||||
| otherwise = p
|
| otherwise = p
|
||||||
|
|
||||||
performPathTo :: Creature -> World -> Point2 -> OutAction
|
performPathTo :: Creature -> World -> Point2 -> OutAction
|
||||||
@@ -146,23 +146,23 @@ performAction cr w ac = case ac of
|
|||||||
|
|
||||||
|
|
||||||
setMinInvSize :: Int -> Creature -> World -> World
|
setMinInvSize :: Int -> Creature -> World -> World
|
||||||
setMinInvSize n cr = cWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
|
setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
|
||||||
|
|
||||||
-- maybe this should be removed...
|
-- maybe this should be removed...
|
||||||
stripNoItems :: Creature -> World -> World
|
stripNoItems :: Creature -> World -> World
|
||||||
stripNoItems cr =
|
stripNoItems cr =
|
||||||
organiseInvKeys (_crID cr)
|
organiseInvKeys (_crID cr)
|
||||||
. (cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just)
|
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just)
|
||||||
|
|
||||||
organiseInvKeys :: Int -> World -> World
|
organiseInvKeys :: Int -> World -> World
|
||||||
organiseInvKeys cid w =
|
organiseInvKeys cid w =
|
||||||
w & cWorld . creatures . ix cid
|
w & cWorld . lWorld . creatures . ix cid
|
||||||
%~ ( (crInvSel . iselPos .~ newSelKey)
|
%~ ( (crInvSel . iselPos .~ newSelKey)
|
||||||
. (crInv .~ newInv)
|
. (crInv .~ newInv)
|
||||||
. (crInvSel . iselAction .~ NoInvSelAction)
|
. (crInvSel . iselAction .~ NoInvSelAction)
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
cr = _creatures (_cWorld w) IM.! cid
|
cr = w ^?! cWorld . lWorld . creatures . ix cid-- _creatures (_cWorld w) IM.! cid
|
||||||
pairs = IM.toList (_crInv cr)
|
pairs = IM.toList (_crInv cr)
|
||||||
newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs
|
newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs
|
||||||
newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs
|
newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs
|
||||||
@@ -216,8 +216,8 @@ sizeSelf x cr w
|
|||||||
Just $
|
Just $
|
||||||
w
|
w
|
||||||
& soundMultiFrom [TeleSound 0, TeleSound 1] cpos teleS Nothing
|
& soundMultiFrom [TeleSound 0, TeleSound 1] cpos teleS Nothing
|
||||||
& cWorld . distortions .:~ distortionBulge
|
& cWorld . lWorld . distortions .:~ distortionBulge
|
||||||
& cWorld . creatures . ix cid
|
& cWorld . lWorld . creatures . ix cid
|
||||||
%~ ( (crRad .~ 10 * x)
|
%~ ( (crRad .~ 10 * x)
|
||||||
. (crMvType . mvSpeed .~ yourDefaultSpeed * x)
|
. (crMvType . mvSpeed .~ yourDefaultSpeed * x)
|
||||||
. (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x))
|
. (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x))
|
||||||
@@ -234,7 +234,7 @@ sizeSelf x cr w
|
|||||||
cpos = _crPos cr
|
cpos = _crPos cr
|
||||||
|
|
||||||
pickUpItemID :: Int -> Int -> World -> World
|
pickUpItemID :: Int -> Int -> World -> World
|
||||||
pickUpItemID cid flid w = pickUpItem cid (_floorItems (_cWorld w) IM.! flid) w
|
pickUpItemID cid flid w = pickUpItem cid (w ^?! cWorld . lWorld . floorItems . ix flid) w
|
||||||
|
|
||||||
-- | Pick up a specific item.
|
-- | Pick up a specific item.
|
||||||
pickUpItem :: Int -> FloorItem -> World -> World
|
pickUpItem :: Int -> FloorItem -> World -> World
|
||||||
|
|||||||
@@ -21,7 +21,7 @@ blinkActionMousePos cr w =
|
|||||||
w
|
w
|
||||||
& soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
|
& soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
|
||||||
& blinkDistortions cpos p3
|
& blinkDistortions cpos p3
|
||||||
& cWorld . creatures . ix cid . crPos .~ p3
|
& cWorld . lWorld . creatures . ix cid . crPos .~ p3
|
||||||
& blinkShockwave cid p3
|
& blinkShockwave cid p3
|
||||||
& inverseShockwaveAt cpos 40 2 2
|
& inverseShockwaveAt cpos 40 2 2
|
||||||
where
|
where
|
||||||
@@ -38,7 +38,7 @@ blinkActionMousePos cr w =
|
|||||||
pushIntoMaybe (x,my) = (x,) <$> my
|
pushIntoMaybe (x,my) = (x,) <$> my
|
||||||
|
|
||||||
blinkDistortions :: Point2 -> Point2 -> World -> World
|
blinkDistortions :: Point2 -> Point2 -> World -> World
|
||||||
blinkDistortions sp ep = cWorld . distortions .++~ distortionBulge
|
blinkDistortions sp ep = cWorld . lWorld . distortions .++~ distortionBulge
|
||||||
where
|
where
|
||||||
distR = 120
|
distR = 120
|
||||||
distortionBulge =
|
distortionBulge =
|
||||||
@@ -57,13 +57,13 @@ unsafeBlinkAction cr w
|
|||||||
| success =
|
| success =
|
||||||
soundMultiFrom [TeleSound 0, TeleSound 1] mwp teleS Nothing
|
soundMultiFrom [TeleSound 0, TeleSound 1] mwp teleS Nothing
|
||||||
. blinkDistortions cpos mwp
|
. blinkDistortions cpos mwp
|
||||||
. set (cWorld . creatures . ix cid . crPos) mwp
|
. set (cWorld . lWorld . creatures . ix cid . crPos) mwp
|
||||||
. blinkShockwave cid mwp
|
. blinkShockwave cid mwp
|
||||||
$ inverseShockwaveAt cpos 40 2 2 w
|
$ inverseShockwaveAt cpos 40 2 2 w
|
||||||
| otherwise =
|
| otherwise =
|
||||||
w
|
w
|
||||||
& blinkActionFail cr
|
& blinkActionFail cr
|
||||||
& cWorld . creatures . ix cid . crState . csDamage
|
& cWorld . lWorld . creatures . ix cid . crState . csDamage
|
||||||
.:~ Damage ENTERREMENT 10000 mwp mwp mwp NoDamageEffect
|
.:~ Damage ENTERREMENT 10000 mwp mwp mwp NoDamageEffect
|
||||||
where
|
where
|
||||||
success = fromMaybe True $ do
|
success = fromMaybe True $ do
|
||||||
@@ -89,8 +89,8 @@ blinkActionFail ::
|
|||||||
blinkActionFail cr w =
|
blinkActionFail cr w =
|
||||||
w
|
w
|
||||||
& soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
|
& soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
|
||||||
& cWorld . distortions .:~ distortionBulge
|
& cWorld . lWorld . distortions .:~ distortionBulge
|
||||||
& cWorld . creatures . ix cid . crPos .~ p3
|
& cWorld . lWorld . creatures . ix cid . crPos .~ p3
|
||||||
& inverseShockwaveAt cpos 40 2 2
|
& inverseShockwaveAt cpos 40 2 2
|
||||||
where
|
where
|
||||||
distR = 120
|
distR = 120
|
||||||
|
|||||||
@@ -179,7 +179,7 @@ swarmUsingCenter updT upd w cr = case _targetCr $ _crIntention cr of
|
|||||||
Just tcr -> updT tcr cenp cr
|
Just tcr -> updT tcr cenp cr
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup $ _creatures (_cWorld w) IM.! cid)
|
cenp = _crGroupCenter $ _creatureGroups (_lWorld (_cWorld w)) IM.! _crGroupID (_crGroup $ _creatures (_lWorld (_cWorld w)) IM.! cid)
|
||||||
|
|
||||||
flockChaseTarget ::
|
flockChaseTarget ::
|
||||||
-- | Update with target
|
-- | Update with target
|
||||||
@@ -194,7 +194,7 @@ flockChaseTarget updT upd w cr = case _targetCr $ _crIntention cr of
|
|||||||
Just tcr -> updT tcr crs cr
|
Just tcr -> updT tcr crs cr
|
||||||
where
|
where
|
||||||
is = _swarm $ _crGroup cr
|
is = _swarm $ _crGroup cr
|
||||||
crs = IM.restrictKeys (_creatures (_cWorld w)) is
|
crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is
|
||||||
|
|
||||||
flockPointTarget ::
|
flockPointTarget ::
|
||||||
(Creature -> IM.IntMap Creature -> Creature -> Point2) ->
|
(Creature -> IM.IntMap Creature -> Creature -> Point2) ->
|
||||||
@@ -208,7 +208,7 @@ flockPointTarget f targFunc w cr = case targFunc cr w of
|
|||||||
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
|
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
|
||||||
where
|
where
|
||||||
is = _swarm $ _crGroup cr
|
is = _swarm $ _crGroup cr
|
||||||
crs = IM.restrictKeys (_creatures (_cWorld w)) is
|
crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is
|
||||||
p = f crTarg crs cr
|
p = f crTarg crs cr
|
||||||
|
|
||||||
flockToPointUsing ::
|
flockToPointUsing ::
|
||||||
@@ -220,7 +220,8 @@ flockToPointUsing pf mvf cr = reader $ \w -> case _targetCr $ _crIntention cr of
|
|||||||
Nothing -> cr
|
Nothing -> cr
|
||||||
Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr
|
Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr
|
||||||
where
|
where
|
||||||
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
|
cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter
|
||||||
|
-- crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
|
||||||
ptarg = pf tcr cenp cr
|
ptarg = pf tcr cenp cr
|
||||||
|
|
||||||
flockToPointUsing' ::
|
flockToPointUsing' ::
|
||||||
@@ -233,7 +234,7 @@ flockToPointUsing' pf mvf w cr = case _targetCr $ _crIntention cr of
|
|||||||
Nothing -> cr
|
Nothing -> cr
|
||||||
Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr
|
Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr
|
||||||
where
|
where
|
||||||
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
|
cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter
|
||||||
ptarg = pf tcr cenp cr
|
ptarg = pf tcr cenp cr
|
||||||
|
|
||||||
flockFunc ::
|
flockFunc ::
|
||||||
@@ -246,7 +247,7 @@ flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of
|
|||||||
Nothing -> cr
|
Nothing -> cr
|
||||||
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
|
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
|
||||||
where
|
where
|
||||||
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
|
cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter
|
||||||
p = f crTarg cenp cr
|
p = f crTarg cenp cr
|
||||||
|
|
||||||
flockCenterFunc ::
|
flockCenterFunc ::
|
||||||
@@ -259,7 +260,7 @@ flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of
|
|||||||
Nothing -> cr
|
Nothing -> cr
|
||||||
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
|
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
|
||||||
where
|
where
|
||||||
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
|
cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter
|
||||||
p = f crTarg cenp cr
|
p = f crTarg cenp cr
|
||||||
|
|
||||||
flockPointTargetR ::
|
flockPointTargetR ::
|
||||||
@@ -273,7 +274,8 @@ flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of
|
|||||||
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
|
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
|
||||||
where
|
where
|
||||||
is = _swarm $ _crGroup cr
|
is = _swarm $ _crGroup cr
|
||||||
crs = IM.restrictKeys (_creatures (_cWorld w)) is
|
--crs = IM.restrictKeys (_creatures (_cWorld w)) is
|
||||||
|
crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is
|
||||||
p = f crTarg crs cr
|
p = f crTarg crs cr
|
||||||
|
|
||||||
meleeHeadingMove ::
|
meleeHeadingMove ::
|
||||||
|
|||||||
@@ -20,7 +20,7 @@ applyCreatureDamage dms cr = case _crMaterial cr of
|
|||||||
defaultApplyDamage :: [Damage] -> Creature -> World -> World
|
defaultApplyDamage :: [Damage] -> Creature -> World -> World
|
||||||
defaultApplyDamage ds cr w =
|
defaultApplyDamage ds cr w =
|
||||||
foldl' (applyIndividualDamage cr) w ds'
|
foldl' (applyIndividualDamage cr) w ds'
|
||||||
& cWorld . creatures . ix (_crID cr) %~ doPoisonDam
|
& cWorld . lWorld . creatures . ix (_crID cr) %~ doPoisonDam
|
||||||
where
|
where
|
||||||
(ps, ds') = partition isPoison ds
|
(ps, ds') = partition isPoison ds
|
||||||
isPoison Damage{_dmType = POISONDAM} = True
|
isPoison Damage{_dmType = POISONDAM} = True
|
||||||
@@ -31,15 +31,15 @@ defaultApplyDamage ds cr w =
|
|||||||
applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World
|
applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World
|
||||||
applyDamageEffect dm de cr = case de of
|
applyDamageEffect dm de cr = case de of
|
||||||
PushDamage push pushexp pushRad ->
|
PushDamage push pushexp pushRad ->
|
||||||
cWorld . creatures . ix (_crID cr) . crPos .+.+~ pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir)
|
cWorld . lWorld . creatures . ix (_crID cr) . crPos .+.+~ pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir)
|
||||||
where
|
where
|
||||||
pushAmount
|
pushAmount
|
||||||
| dist (_crPos cr) fromDir == 0 = 0
|
| dist (_crPos cr) fromDir == 0 = 0
|
||||||
| otherwise = min 5 $ (push * 5 * pushRad / (dist (_crPos cr) fromDir * _crMass cr)) ** pushexp
|
| otherwise = min 5 $ (push * 5 * pushRad / (dist (_crPos cr) fromDir * _crMass cr)) ** pushexp
|
||||||
PushBackDamage pback ->
|
PushBackDamage pback ->
|
||||||
cWorld . creatures . ix (_crID cr) . crPos .+.+~ (pback / _crMass cr) *.* (_dmTo dm -.- fromDir)
|
cWorld . lWorld . creatures . ix (_crID cr) . crPos .+.+~ (pback / _crMass cr) *.* (_dmTo dm -.- fromDir)
|
||||||
TorqueDamage rot ->
|
TorqueDamage rot ->
|
||||||
cWorld . creatures . ix (_crID cr) . crDir +~ rot
|
cWorld . lWorld . creatures . ix (_crID cr) . crDir +~ rot
|
||||||
NoDamageEffect -> id
|
NoDamageEffect -> id
|
||||||
where
|
where
|
||||||
fromDir = _dmFrom dm
|
fromDir = _dmFrom dm
|
||||||
@@ -64,7 +64,7 @@ applyPiercingDamage cr dm
|
|||||||
|
|
||||||
damageHP :: Creature -> Int -> World -> World
|
damageHP :: Creature -> Int -> World -> World
|
||||||
damageHP cr x =
|
damageHP cr x =
|
||||||
cWorld . creatures . ix (_crID cr)
|
cWorld . lWorld . creatures . ix (_crID cr)
|
||||||
%~ ( (crHP -~ x)
|
%~ ( (crHP -~ x)
|
||||||
. (crPastDamage +~ x)
|
. (crPastDamage +~ x)
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -16,7 +16,6 @@ import Dodge.FloatFunction
|
|||||||
import Dodge.RandImpulse
|
import Dodge.RandImpulse
|
||||||
import Dodge.SoundLogic
|
import Dodge.SoundLogic
|
||||||
import Geometry
|
import Geometry
|
||||||
import qualified IntMapHelp as IM
|
|
||||||
import LensHelp
|
import LensHelp
|
||||||
import System.Random
|
import System.Random
|
||||||
|
|
||||||
@@ -25,7 +24,7 @@ impulsiveAIBefore ::
|
|||||||
Creature ->
|
Creature ->
|
||||||
World ->
|
World ->
|
||||||
World
|
World
|
||||||
impulsiveAIBefore f cr w = g w & cWorld . creatures . ix (_crID cr) .~ cr'
|
impulsiveAIBefore f cr w = g w & cWorld . lWorld . creatures . ix (_crID cr) .~ cr'
|
||||||
where
|
where
|
||||||
(g, cr') = followImpulses w $ f w cr
|
(g, cr') = followImpulses w $ f w cr
|
||||||
|
|
||||||
@@ -80,10 +79,10 @@ followImpulse cr w imp = case imp of
|
|||||||
cpos = _crPos cr
|
cpos = _crPos cr
|
||||||
cdir = _crDir cr
|
cdir = _crDir cr
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
posFromID cid' = _crPos $ _creatures (_cWorld w) IM.! cid'
|
posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos
|
||||||
rr a = randomR (- a, a) $ _randGen w
|
rr a = randomR (- a, a) $ _randGen w
|
||||||
hitCr i =
|
hitCr i =
|
||||||
( cWorld . creatures . ix i . crState . csDamage
|
( cWorld . lWorld . creatures . ix i . crState . csDamage
|
||||||
.:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i) NoDamageEffect
|
.:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i) NoDamageEffect
|
||||||
)
|
)
|
||||||
. soundStart (CrSound cid) cpos hitS Nothing
|
. soundStart (CrSound cid) cpos hitS Nothing
|
||||||
|
|||||||
@@ -21,11 +21,11 @@ import qualified SDL
|
|||||||
|
|
||||||
useItem :: Creature -> World -> World
|
useItem :: Creature -> World -> World
|
||||||
useItem cr' w = fromMaybe (f w) $ do
|
useItem cr' w = fromMaybe (f w) $ do
|
||||||
cr <- w ^? cWorld . creatures . ix (_crID cr')
|
cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr')
|
||||||
it <- cr ^? crInv . ix (crSel cr)
|
it <- cr ^? crInv . ix (crSel cr)
|
||||||
return $ itemEffect cr it w
|
return $ itemEffect cr it w
|
||||||
where
|
where
|
||||||
f = cWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
|
f = cWorld . lWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
|
||||||
|
|
||||||
itemEffect :: Creature -> Item -> World -> World
|
itemEffect :: Creature -> Item -> World -> World
|
||||||
itemEffect cr it w = case it ^. itUse of
|
itemEffect cr it w = case it ^. itUse of
|
||||||
@@ -41,7 +41,7 @@ itemEffect cr it w = case it ^. itUse of
|
|||||||
hammerTest f = case _crHammerPosition cr of
|
hammerTest f = case _crHammerPosition cr of
|
||||||
HammerUp -> f w
|
HammerUp -> f w
|
||||||
_ -> w & setuhamdown
|
_ -> w & setuhamdown
|
||||||
setuhamdown = cWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
|
setuhamdown = cWorld . lWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
|
||||||
doequipmentchange =
|
doequipmentchange =
|
||||||
setuhamdown $
|
setuhamdown $
|
||||||
hammerTest
|
hammerTest
|
||||||
@@ -51,7 +51,7 @@ itemEffect cr it w = case it ^. itUse of
|
|||||||
|
|
||||||
tryReload :: Creature -> Item -> World -> (World -> World) -> World -> World
|
tryReload :: Creature -> Item -> World -> (World -> World) -> World -> World
|
||||||
tryReload cr it w f
|
tryReload cr it w f
|
||||||
| _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False =
|
| _crID cr == (w ^. cWorld . lWorld . yourID) && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False =
|
||||||
crToggleReloading cr
|
crToggleReloading cr
|
||||||
| otherwise =
|
| otherwise =
|
||||||
(runIdentity . pointerToItemLocation (_itLocation it) (return . (itUse . heldHammer .~ HammerDown)))
|
(runIdentity . pointerToItemLocation (_itLocation it) (return . (itUse . heldHammer .~ HammerDown)))
|
||||||
@@ -64,7 +64,7 @@ itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic)
|
|||||||
|
|
||||||
activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
|
activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
|
||||||
activateEquipmentAt rbo cr =
|
activateEquipmentAt rbo cr =
|
||||||
cWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
|
cWorld . lWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
|
||||||
(Just i, _) -> crLeftInvSel ?~ i
|
(Just i, _) -> crLeftInvSel ?~ i
|
||||||
(_, Just _) -> crLeftInvSel .~ Nothing
|
(_, Just _) -> crLeftInvSel .~ Nothing
|
||||||
_ -> id
|
_ -> id
|
||||||
@@ -102,7 +102,7 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
|
|||||||
& onremove itm cr
|
& onremove itm cr
|
||||||
Nothing -> error "tried to toggle equipment whilst not prepared"
|
Nothing -> error "tried to toggle equipment whilst not prepared"
|
||||||
where
|
where
|
||||||
crpoint = cWorld . creatures . ix (_crID cr)
|
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
|
||||||
itmat i = _crInv cr IM.! i
|
itmat i = _crInv cr IM.! i
|
||||||
itm = itmat (crSel cr)
|
itm = itmat (crSel cr)
|
||||||
onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
|
onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
|
||||||
@@ -122,7 +122,7 @@ useLeftItem cid w
|
|||||||
. useL f itm cr
|
. useL f itm cr
|
||||||
$ w
|
$ w
|
||||||
where
|
where
|
||||||
cr = _creatures (_cWorld w) IM.! cid
|
cr = w ^?! cWorld . lWorld . creatures . ix cid-- _creatures (_cWorld w) IM.! cid
|
||||||
itmIsConsumable =
|
itmIsConsumable =
|
||||||
isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
|
isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
|
||||||
itmIsEquipable =
|
itmIsEquipable =
|
||||||
|
|||||||
@@ -99,7 +99,7 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
|
|||||||
replicate numjits [RandomImpulse thejitter]
|
replicate numjits [RandomImpulse thejitter]
|
||||||
++ [[ChangeStrategy $ CloseToMelee 0]]
|
++ [[ChangeStrategy $ CloseToMelee 0]]
|
||||||
)
|
)
|
||||||
, AimAt 0 (_crPos $ _creatures (_cWorld w) IM.! 0)
|
, AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos) --_crPos $ _creatures (_cWorld w) IM.! 0)
|
||||||
]
|
]
|
||||||
| otherwise = id
|
| otherwise = id
|
||||||
|
|
||||||
@@ -152,7 +152,7 @@ newExtraAwareness cr w cid
|
|||||||
| otherwise = Just . Suspicious $ doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d * awakeLevelPerception cr
|
| otherwise = Just . Suspicious $ doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d * awakeLevelPerception cr
|
||||||
where
|
where
|
||||||
vi = _cpVision $ _crPerception cr
|
vi = _cpVision $ _crPerception cr
|
||||||
tpos = _crPos $ _creatures (_cWorld w) IM.! cid
|
tpos = w ^?! cWorld . lWorld . creatures . ix cid . crPos -- _crPos $ _creatures (_cWorld w) IM.! cid
|
||||||
cpos = _crPos cr
|
cpos = _crPos cr
|
||||||
ang = angleVV (unitVectorAtAngle (_crDir cr)) (tpos - cpos)
|
ang = angleVV (unitVectorAtAngle (_crDir cr)) (tpos - cpos)
|
||||||
d = dist tpos cpos
|
d = dist tpos cpos
|
||||||
|
|||||||
@@ -27,8 +27,8 @@ creatureDisplayText w cr =
|
|||||||
w
|
w
|
||||||
cr
|
cr
|
||||||
where
|
where
|
||||||
campos = w ^. cWorld . cwCam . cwcViewFrom
|
campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom
|
||||||
theScale = 0.15 / (w ^. cWorld . cwCam . cwcZoom)
|
theScale = 0.15 / (w ^. cWorld . lWorld . cwCam . cwcZoom)
|
||||||
cpos = _crPos cr
|
cpos = _crPos cr
|
||||||
v = cpos -.- campos
|
v = cpos -.- campos
|
||||||
(V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v
|
(V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v
|
||||||
|
|||||||
@@ -26,7 +26,6 @@ import Dodge.Data.World
|
|||||||
import Dodge.Zoning.Creature
|
import Dodge.Zoning.Creature
|
||||||
import FoldableHelp
|
import FoldableHelp
|
||||||
import Geometry
|
import Geometry
|
||||||
import qualified IntMapHelp as IM
|
|
||||||
|
|
||||||
overrideMeleeCloseTarget :: Creature -> Creature
|
overrideMeleeCloseTarget :: Creature -> Creature
|
||||||
overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
|
overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
|
||||||
@@ -192,7 +191,7 @@ targetYouWhenCognizant :: World -> Creature -> Creature
|
|||||||
targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
|
targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
|
||||||
-- so this caused a space leak: be careful with ?~
|
-- so this caused a space leak: be careful with ?~
|
||||||
-- consider changing targeted creature to be just an index
|
-- consider changing targeted creature to be just an index
|
||||||
Just (Cognizant _) -> _creatures (_cWorld w) IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
|
Just (Cognizant _) -> (w ^?! cWorld . lWorld . creatures . ix 0) `seq` cr & crIntention . targetCr ?~ (w ^?! cWorld . lWorld . creatures . ix 0)
|
||||||
_ -> cr & crIntention . targetCr .~ Nothing
|
_ -> cr & crIntention . targetCr .~ Nothing
|
||||||
|
|
||||||
searchIfDamaged :: Creature -> Creature
|
searchIfDamaged :: Creature -> Creature
|
||||||
|
|||||||
@@ -3,7 +3,6 @@ module Dodge.Creature.SetTarget where
|
|||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import qualified IntMapHelp as IM
|
|
||||||
|
|
||||||
-- | Assumes that you are id 0: if creature is cognizant of you, sets you as target
|
-- | Assumes that you are id 0: if creature is cognizant of you, sets you as target
|
||||||
targetYouWhenCognizant ::
|
targetYouWhenCognizant ::
|
||||||
@@ -11,5 +10,6 @@ targetYouWhenCognizant ::
|
|||||||
Creature ->
|
Creature ->
|
||||||
Creature
|
Creature
|
||||||
targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
|
targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
|
||||||
Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
|
--Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
|
||||||
|
Just (Cognizant _) -> cr & crIntention . targetCr ?~ (w ^?! cWorld . lWorld . creatures . ix 0)
|
||||||
_ -> cr & crIntention . targetCr .~ Nothing
|
_ -> cr & crIntention . targetCr .~ Nothing
|
||||||
|
|||||||
+16
-16
@@ -37,7 +37,7 @@ foldCr ::
|
|||||||
World
|
World
|
||||||
foldCr xs cr w = foldl' f w xs
|
foldCr xs cr w = foldl' f w xs
|
||||||
where
|
where
|
||||||
f w' g = case w' ^? cWorld . creatures . ix (_crID cr) of
|
f w' g = case w' ^? cWorld . lWorld . creatures . ix (_crID cr) of
|
||||||
Just cr' -> g cr' w'
|
Just cr' -> g cr' w'
|
||||||
Nothing -> w'
|
Nothing -> w'
|
||||||
|
|
||||||
@@ -85,16 +85,16 @@ checkDeath cr w
|
|||||||
where
|
where
|
||||||
removecr
|
removecr
|
||||||
| _crID cr == 0 =
|
| _crID cr == 0 =
|
||||||
(cWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
|
(cWorld . lWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
|
||||||
. (cWorld . creatures . ix (_crID cr) . crHP .~ 0)
|
. (cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0)
|
||||||
-- hack to get around player creature being killed but left with more than 0 hp
|
-- hack to get around player creature being killed but left with more than 0 hp
|
||||||
| otherwise = cWorld . creatures . at (_crID cr) .~ Nothing
|
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
|
||||||
|
|
||||||
corpseOrGib :: Creature -> World -> World
|
corpseOrGib :: Creature -> World -> World
|
||||||
corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
|
corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
|
||||||
Just (FLAMING, _) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
|
Just (FLAMING, _) -> w & plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
|
||||||
Just (ELECTRICAL, _) -> w & plNew (cWorld . corpses) cpID thecorpse
|
Just (ELECTRICAL, _) -> w & plNew (cWorld . lWorld . corpses) cpID thecorpse
|
||||||
Just (POISONDAM, _) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
|
Just (POISONDAM, _) -> w & plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
|
||||||
_
|
_
|
||||||
| _crPastDamage cr > 200 ->
|
| _crPastDamage cr > 200 ->
|
||||||
w & addCrGibs cr
|
w & addCrGibs cr
|
||||||
@@ -105,7 +105,7 @@ corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
|
|||||||
w
|
w
|
||||||
& bloodPuddleAt cpos
|
& bloodPuddleAt cpos
|
||||||
& bloodPuddleAt cpos
|
& bloodPuddleAt cpos
|
||||||
& plNew (cWorld . corpses) cpID thecorpse
|
& plNew (cWorld . lWorld . corpses) cpID thecorpse
|
||||||
where
|
where
|
||||||
cpos = _crPos cr
|
cpos = _crPos cr
|
||||||
thecorpse = makeDefaultCorpse cr
|
thecorpse = makeDefaultCorpse cr
|
||||||
@@ -132,7 +132,7 @@ bloodPuddleAt p w =
|
|||||||
w
|
w
|
||||||
& snd
|
& snd
|
||||||
. plNewID
|
. plNewID
|
||||||
(cWorld . decorations)
|
(cWorld . lWorld . decorations)
|
||||||
(color (dark $ dark red) . setDepth 01 . uncurryV translate (p +.+ q) $ circleSolid 10)
|
(color (dark $ dark red) . setDepth 01 . uncurryV translate (p +.+ q) $ circleSolid 10)
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
where
|
where
|
||||||
@@ -140,7 +140,7 @@ bloodPuddleAt p w =
|
|||||||
|
|
||||||
internalUpdate :: Creature -> World -> World
|
internalUpdate :: Creature -> World -> World
|
||||||
internalUpdate cr =
|
internalUpdate cr =
|
||||||
cWorld . creatures . ix (_crID cr)
|
cWorld . lWorld . creatures . ix (_crID cr)
|
||||||
%~ ( (crHammerPosition %~ moveHammerUp)
|
%~ ( (crHammerPosition %~ moveHammerUp)
|
||||||
. stepReloading
|
. stepReloading
|
||||||
. updateMovement
|
. updateMovement
|
||||||
@@ -158,7 +158,7 @@ dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath o
|
|||||||
clearDamage :: Creature -> World -> World
|
clearDamage :: Creature -> World -> World
|
||||||
clearDamage cr w =
|
clearDamage cr w =
|
||||||
w
|
w
|
||||||
& cWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
|
& cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
|
||||||
|
|
||||||
doDamage :: Creature -> World -> World
|
doDamage :: Creature -> World -> World
|
||||||
doDamage cr w =
|
doDamage cr w =
|
||||||
@@ -173,15 +173,15 @@ applyPastDamages :: Creature -> World -> World
|
|||||||
applyPastDamages cr w
|
applyPastDamages cr w
|
||||||
| _crPastDamage cr > 200 =
|
| _crPastDamage cr > 200 =
|
||||||
let (p, g) = runState (randInCirc 3) (_randGen w)
|
let (p, g) = runState (randInCirc 3) (_randGen w)
|
||||||
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100))
|
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100))
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
| _crPastDamage cr > 20 =
|
| _crPastDamage cr > 20 =
|
||||||
let (p, g) = runState (randInCirc 2) (_randGen w)
|
let (p, g) = runState (randInCirc 2) (_randGen w)
|
||||||
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10))
|
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10))
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
| _crPastDamage cr > 0 =
|
| _crPastDamage cr > 0 =
|
||||||
let (p, g) = runState (randInCirc 1) (_randGen w)
|
let (p, g) = runState (randInCirc 1) (_randGen w)
|
||||||
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1))
|
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1))
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
| otherwise = w
|
| otherwise = w
|
||||||
|
|
||||||
@@ -225,7 +225,7 @@ useEquipment cr i = useE (_eeUse (_equipEffect $ _itUse itm)) itm cr
|
|||||||
|
|
||||||
-- a map updating all inventory items
|
-- a map updating all inventory items
|
||||||
upInv :: Creature -> World -> World
|
upInv :: Creature -> World -> World
|
||||||
upInv cr = cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr)
|
upInv cr = cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr)
|
||||||
|
|
||||||
-- a loop going over equipped items
|
-- a loop going over equipped items
|
||||||
equipmentEffects :: Creature -> World -> World
|
equipmentEffects :: Creature -> World -> World
|
||||||
@@ -275,7 +275,7 @@ doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of
|
|||||||
Just NoTargeting -> w
|
Just NoTargeting -> w
|
||||||
Just t ->
|
Just t ->
|
||||||
let (w', t') = updateTargeting (_tgUpdate t) (_crInv cr IM.! invid) cr w t
|
let (w', t') = updateTargeting (_tgUpdate t) (_crInv cr IM.! invid) cr w t
|
||||||
in w' & cWorld . creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t'
|
in w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t'
|
||||||
|
|
||||||
weaponReloadSounds :: Creature -> World -> World
|
weaponReloadSounds :: Creature -> World -> World
|
||||||
weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of
|
weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of
|
||||||
|
|||||||
@@ -21,12 +21,12 @@ yourControl cr w
|
|||||||
| inTermFocus w = dimCreatureLight cr w & updateUsingInput
|
| inTermFocus w = dimCreatureLight cr w & updateUsingInput
|
||||||
| otherwise =
|
| otherwise =
|
||||||
dimCreatureLight cr w
|
dimCreatureLight cr w
|
||||||
& cWorld . creatures . ix (_crID cr)
|
& cWorld . lWorld . creatures . ix (_crID cr)
|
||||||
%~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w))
|
%~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w))
|
||||||
& updateUsingInput
|
& updateUsingInput
|
||||||
|
|
||||||
dimCreatureLight :: Creature -> World -> World
|
dimCreatureLight :: Creature -> World -> World
|
||||||
dimCreatureLight cr = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
|
dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
|
||||||
|
|
||||||
-- note the order of operation, setting the posture first--this prevents the twist fire bug
|
-- note the order of operation, setting the posture first--this prevents the twist fire bug
|
||||||
|
|
||||||
@@ -57,12 +57,12 @@ wasdWithAiming w speed cr
|
|||||||
| otherwise = crMvAbsolute (speed *.* movAbs) . set crMvDir dir
|
| otherwise = crMvAbsolute (speed *.* movAbs) . set crMvDir dir
|
||||||
theTurn cr' = creatureTurnTowardDir (_crMvDir cr') 0.2 cr'
|
theTurn cr' = creatureTurnTowardDir (_crMvDir cr') 0.2 cr'
|
||||||
movDir = wasdDir w
|
movDir = wasdDir w
|
||||||
dir = (w ^. cWorld . cwCam . cwcRot) + argV movDir
|
dir = (w ^. cWorld . lWorld . cwCam . cwcRot) + argV movDir
|
||||||
movAbs = rotateV (w ^. cWorld . cwCam . cwcRot) $ normalizeV movDir
|
movAbs = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) $ normalizeV movDir
|
||||||
isAiming = _posture (_crStance cr) == Aiming
|
isAiming = _posture (_crStance cr) == Aiming
|
||||||
mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of
|
mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of
|
||||||
Just _ -> argV $ mouseWorldPos w -.- _crPos cr
|
Just _ -> argV $ mouseWorldPos w -.- _crPos cr
|
||||||
_ -> argV (_mousePos w) + (w ^. cWorld . cwCam . cwcRot)
|
_ -> argV (_mousePos w) + (w ^. cWorld . lWorld . cwCam . cwcRot)
|
||||||
|
|
||||||
wasdM :: SDL.Scancode -> Point2
|
wasdM :: SDL.Scancode -> Point2
|
||||||
wasdM scancode = case scancode of
|
wasdM scancode = case scancode of
|
||||||
|
|||||||
@@ -7,7 +7,7 @@ import Dodge.Data.CreatureEffect
|
|||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import Dodge.Path
|
import Dodge.Path
|
||||||
import Geometry
|
import Geometry
|
||||||
import qualified IntMapHelp as IM
|
import Control.Lens
|
||||||
|
|
||||||
doWdCrCr :: WdCrCr -> World -> Creature -> Creature
|
doWdCrCr :: WdCrCr -> World -> Creature -> Creature
|
||||||
doWdCrCr ce = case ce of
|
doWdCrCr ce = case ce of
|
||||||
@@ -97,7 +97,8 @@ chooseMovementSpreadGun cr w
|
|||||||
where
|
where
|
||||||
d = dist cpos p
|
d = dist cpos p
|
||||||
cpos = _crPos cr
|
cpos = _crPos cr
|
||||||
tcr = _creatures (_cWorld w) IM.! 0
|
--tcr = _creatures (_cWorld w) IM.! 0
|
||||||
|
tcr = w ^?! cWorld . lWorld . creatures . ix 0
|
||||||
p = _crPos tcr
|
p = _crPos tcr
|
||||||
|
|
||||||
chooseMovementLtAuto :: Creature -> World -> Action
|
chooseMovementLtAuto :: Creature -> World -> Action
|
||||||
@@ -110,7 +111,7 @@ chooseMovementLtAuto cr w
|
|||||||
DoImpulses [UseItem, TurnToward p' 0.05, Move (V2 0 3)]
|
DoImpulses [UseItem, TurnToward p' 0.05, Move (V2 0 3)]
|
||||||
where
|
where
|
||||||
cpos = _crPos cr
|
cpos = _crPos cr
|
||||||
tcr = _creatures (_cWorld w) IM.! 0
|
tcr = w ^?! cWorld . lWorld . creatures . ix 0
|
||||||
p = _crPos tcr
|
p = _crPos tcr
|
||||||
v = vNormal $ p -.- cpos
|
v = vNormal $ p -.- cpos
|
||||||
p' = p +.+ 0.5 *.* (v -.- 20 *.* normalizeV v)
|
p' = p +.+ 0.5 *.* (v -.- 20 *.* normalizeV v)
|
||||||
|
|||||||
@@ -12,7 +12,7 @@ import Geometry
|
|||||||
findBoundDists :: Configuration -> World -> (Float, Float, Float, Float)
|
findBoundDists :: Configuration -> World -> (Float, Float, Float, Float)
|
||||||
findBoundDists cfig w
|
findBoundDists cfig w
|
||||||
| debugOn Bound_box_screen cfig = (hh, - hh, hw, - hw)
|
| debugOn Bound_box_screen cfig = (hh, - hh, hw, - hw)
|
||||||
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . cwCam . cwcCenter) w
|
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . lWorld . cwCam . cwcCenter) w
|
||||||
where
|
where
|
||||||
hw = halfWidth cfig
|
hw = halfWidth cfig
|
||||||
hh = halfHeight cfig
|
hh = halfHeight cfig
|
||||||
@@ -20,9 +20,9 @@ findBoundDists cfig w
|
|||||||
updateBounds :: Universe -> Universe
|
updateBounds :: Universe -> Universe
|
||||||
updateBounds uv =
|
updateBounds uv =
|
||||||
uv
|
uv
|
||||||
& uvWorld . cWorld . cwCam . cwcBoundDist .~ bdists
|
& uvWorld . cWorld . lWorld . cwCam . cwcBoundDist .~ bdists
|
||||||
& uvWorld . cWorld . cwCam . cwcBoundBox
|
& uvWorld . cWorld . lWorld . cwCam . cwcBoundBox
|
||||||
.~ map ((+.+ w ^. cWorld . cwCam . cwcCenter) . rotateV (w ^. cWorld . cwCam . cwcRot)) (rectNSWE n s w' e)
|
.~ map ((+.+ w ^. cWorld . lWorld . cwCam . cwcCenter) . rotateV (w ^. cWorld . lWorld . cwCam . cwcRot)) (rectNSWE n s w' e)
|
||||||
where
|
where
|
||||||
w = _uvWorld uv
|
w = _uvWorld uv
|
||||||
cfig = _uvConfig uv
|
cfig = _uvConfig uv
|
||||||
|
|||||||
+1
-1
@@ -6,4 +6,4 @@ import Dodge.Data.World
|
|||||||
useC :: Cuse -> Item -> Creature -> World -> World
|
useC :: Cuse -> Item -> Creature -> World -> World
|
||||||
useC cu = case cu of
|
useC cu = case cu of
|
||||||
CDoNothing -> const $ const id
|
CDoNothing -> const $ const id
|
||||||
CHeal x -> const $ \cr -> cWorld . creatures . ix (_crID cr) . crHP +~ x
|
CHeal x -> const $ \cr -> cWorld . lWorld . creatures . ix (_crID cr) . crHP +~ x
|
||||||
|
|||||||
+4
-4
@@ -17,12 +17,12 @@ import qualified IntMapHelp as IM
|
|||||||
damageCrWlID :: Damage -> CrWlID -> World -> World
|
damageCrWlID :: Damage -> CrWlID -> World -> World
|
||||||
damageCrWlID dam = \case
|
damageCrWlID dam = \case
|
||||||
NothingID -> id
|
NothingID -> id
|
||||||
CrID cid -> cWorld . creatures . ix cid . crState . csDamage .:~ dam
|
CrID cid -> cWorld . lWorld . creatures . ix cid . crState . csDamage .:~ dam
|
||||||
WlID wlid -> cWorld . wallDamages %~ IM.insertWith (++) wlid [dam]
|
WlID wlid -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) wlid [dam]
|
||||||
|
|
||||||
damageCrWl :: Damage -> Either Creature Wall -> World -> World
|
damageCrWl :: Damage -> Either Creature Wall -> World -> World
|
||||||
damageCrWl dt (Left cr) = cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ dt
|
damageCrWl dt (Left cr) = cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .:~ dt
|
||||||
damageCrWl dt (Right wl) = cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) [dt]
|
damageCrWl dt (Right wl) = cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) [dt]
|
||||||
|
|
||||||
damageDirection :: [Damage] -> Maybe Float
|
damageDirection :: [Damage] -> Maybe Float
|
||||||
damageDirection ds = do
|
damageDirection ds = do
|
||||||
|
|||||||
@@ -12,8 +12,8 @@ import LensHelp
|
|||||||
damageCircle :: Float -> Point2 -> DamageType -> Int -> World -> World
|
damageCircle :: Float -> Point2 -> DamageType -> Int -> World -> World
|
||||||
damageCircle r sp dt da w =
|
damageCircle r sp dt da w =
|
||||||
w
|
w
|
||||||
& cWorld . wallDamages %~ addwalldamages
|
& cWorld . lWorld . wallDamages %~ addwalldamages
|
||||||
& cWorld . creatures %~ addcreaturedamages
|
& cWorld . lWorld . creatures %~ addcreaturedamages
|
||||||
where
|
where
|
||||||
--addwalldamages wlds = runIdentity $ S.fold_ (damageWlCircle wldam) wlds id wlstodam
|
--addwalldamages wlds = runIdentity $ S.fold_ (damageWlCircle wldam) wlds id wlstodam
|
||||||
addwalldamages wlds = foldl' (damageWlCircle wldam) wlds wlstodam
|
addwalldamages wlds = foldl' (damageWlCircle wldam) wlds wlstodam
|
||||||
|
|||||||
@@ -114,6 +114,11 @@ data CWCam = CWCam
|
|||||||
}
|
}
|
||||||
|
|
||||||
data CWorld = CWorld
|
data CWorld = CWorld
|
||||||
|
{ _lWorld :: LWorld
|
||||||
|
, _cwGen :: CWGen
|
||||||
|
}
|
||||||
|
|
||||||
|
data LWorld = LWorld
|
||||||
{ _cwCam :: CWCam
|
{ _cwCam :: CWCam
|
||||||
, _creatures :: IM.IntMap Creature
|
, _creatures :: IM.IntMap Creature
|
||||||
, _crZoning :: IM.IntMap (IM.IntMap IS.IntSet)
|
, _crZoning :: IM.IntMap (IM.IntMap IS.IntSet)
|
||||||
@@ -165,7 +170,6 @@ data CWorld = CWorld
|
|||||||
, _corpses :: IM.IntMap Corpse
|
, _corpses :: IM.IntMap Corpse
|
||||||
, _pathGraph :: Gr Point2 PathEdge
|
, _pathGraph :: Gr Point2 PathEdge
|
||||||
, _pnZoning :: IM.IntMap (IM.IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
|
, _pnZoning :: IM.IntMap (IM.IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
|
||||||
--, _peZoning :: IM.IntMap (IM.IntMap [(Int, Int, PathEdge)]) --Zoning IM.IntMap Creature
|
|
||||||
, _peZoning :: IM.IntMap (IM.IntMap (Set PathEdgeNodes))
|
, _peZoning :: IM.IntMap (IM.IntMap (Set PathEdgeNodes))
|
||||||
, _hud :: HUD
|
, _hud :: HUD
|
||||||
, _lightSources :: IM.IntMap LightSource
|
, _lightSources :: IM.IntMap LightSource
|
||||||
@@ -174,16 +178,8 @@ data CWorld = CWorld
|
|||||||
, _seenLocations :: IM.IntMap (WdP2, String)
|
, _seenLocations :: IM.IntMap (WdP2, String)
|
||||||
, _selLocation :: Int
|
, _selLocation :: Int
|
||||||
, _distortions :: [Distortion]
|
, _distortions :: [Distortion]
|
||||||
, _cwGen :: CWGen
|
|
||||||
}
|
}
|
||||||
|
|
||||||
--deriving (Eq, Show, Read) --, Generic)
|
|
||||||
--h--deriving (Eq, Show, Read) --Generic, Flat)
|
|
||||||
|
|
||||||
|
|
||||||
--deriving (Eq, Show, Read) --, Generic)
|
|
||||||
--h--deriving (Eq, Show, Read) --Generic, Flat)
|
|
||||||
|
|
||||||
data CWGen = CWGen
|
data CWGen = CWGen
|
||||||
{ _cwgParams :: GenParams
|
{ _cwgParams :: GenParams
|
||||||
, _cwgWorldBounds :: Bounds
|
, _cwgWorldBounds :: Bounds
|
||||||
@@ -201,9 +197,8 @@ data WorldBeams = WorldBeams
|
|||||||
, _electronBeams :: [Beam]
|
, _electronBeams :: [Beam]
|
||||||
}
|
}
|
||||||
|
|
||||||
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
|
||||||
|
|
||||||
makeLenses ''CWorld
|
makeLenses ''CWorld
|
||||||
|
makeLenses ''LWorld
|
||||||
makeLenses ''WorldBeams
|
makeLenses ''WorldBeams
|
||||||
makeLenses ''CWCam
|
makeLenses ''CWCam
|
||||||
makeLenses ''CWGen
|
makeLenses ''CWGen
|
||||||
@@ -213,6 +208,6 @@ concat
|
|||||||
[ ''WorldBeams
|
[ ''WorldBeams
|
||||||
, ''CWCam
|
, ''CWCam
|
||||||
, ''CWGen
|
, ''CWGen
|
||||||
-- , ''CWTime
|
|
||||||
, ''CWorld
|
, ''CWorld
|
||||||
|
, ''LWorld
|
||||||
]
|
]
|
||||||
|
|||||||
@@ -60,6 +60,8 @@ data TimeFlowStatus
|
|||||||
, _futureWorlds :: [CWorld]
|
, _futureWorlds :: [CWorld]
|
||||||
, _scrollItemLocation :: Int
|
, _scrollItemLocation :: Int
|
||||||
}
|
}
|
||||||
|
| RewindLeftClick
|
||||||
|
{ _reverseAmount :: Int }
|
||||||
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
||||||
|
|
||||||
data WorldHammer
|
data WorldHammer
|
||||||
|
|||||||
@@ -13,12 +13,12 @@ import Picture
|
|||||||
|
|
||||||
addRoomPolyDecorations :: [Room] -> World -> World
|
addRoomPolyDecorations :: [Room] -> World -> World
|
||||||
addRoomPolyDecorations rms w =
|
addRoomPolyDecorations rms w =
|
||||||
w & cWorld . decorations
|
w & cWorld . lWorld . decorations
|
||||||
%~ IM.insertWithNewKeys (map roomPolyDecorations rms)
|
%~ IM.insertWithNewKeys (map roomPolyDecorations rms)
|
||||||
|
|
||||||
addRoomLinkDecorations :: [Room] -> World -> World
|
addRoomLinkDecorations :: [Room] -> World -> World
|
||||||
addRoomLinkDecorations rms w =
|
addRoomLinkDecorations rms w =
|
||||||
w & cWorld . decorations
|
w & cWorld . lWorld . decorations
|
||||||
%~ IM.insertWithNewKeys (map roomLinkDecorations rms)
|
%~ IM.insertWithNewKeys (map roomLinkDecorations rms)
|
||||||
|
|
||||||
roomLinkDecorations :: Room -> Picture
|
roomLinkDecorations :: Room -> Picture
|
||||||
|
|||||||
@@ -20,11 +20,11 @@ printRotPoint r p =
|
|||||||
outsideScreenPolygon :: Configuration -> World -> [Point2]
|
outsideScreenPolygon :: Configuration -> World -> [Point2]
|
||||||
outsideScreenPolygon cfig w = [tr, tl, bl, br]
|
outsideScreenPolygon cfig w = [tr, tl, bl, br]
|
||||||
where
|
where
|
||||||
scRot = rotateV (w ^. cWorld . cwCam . cwcRot)
|
scRot = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot)
|
||||||
scZoom p
|
scZoom p
|
||||||
| (w ^. cWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* p
|
| (w ^. cWorld . lWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)) *.* p
|
||||||
| otherwise = error "Trying to set screen zoom to zero"
|
| otherwise = error "Trying to set screen zoom to zero"
|
||||||
scTran p = p +.+ (w ^. cWorld . cwCam . cwcCenter)
|
scTran p = p +.+ (w ^. cWorld . lWorld . cwCam . cwcCenter)
|
||||||
tr = f 3 3
|
tr = f 3 3
|
||||||
tl = f (-3) 3
|
tl = f (-3) 3
|
||||||
br = f 3 (-3)
|
br = f 3 (-3)
|
||||||
@@ -40,10 +40,10 @@ lineOnScreenCone cfig w p1 p2 =
|
|||||||
|| any (isJust . uncurry (intersectSegSeg p1 p2)) sps
|
|| any (isJust . uncurry (intersectSegSeg p1 p2)) sps
|
||||||
where
|
where
|
||||||
sp' = screenPolygon cfig w
|
sp' = screenPolygon cfig w
|
||||||
vp = w ^. cWorld . cwCam . cwcViewFrom
|
vp = w ^. cWorld . lWorld . cwCam . cwcViewFrom
|
||||||
sp
|
sp
|
||||||
| pointInPolygon vp sp' = sp'
|
| pointInPolygon vp sp' = sp'
|
||||||
| otherwise = orderPolygon ((w ^. cWorld . cwCam . cwcViewFrom) : sp')
|
| otherwise = orderPolygon ((w ^. cWorld . lWorld . cwCam . cwcViewFrom) : sp')
|
||||||
sps = zip sp (tail sp ++ [head sp])
|
sps = zip sp (tail sp ++ [head sp])
|
||||||
|
|
||||||
pointOnScreen :: Configuration -> World -> Point2 -> Bool
|
pointOnScreen :: Configuration -> World -> Point2 -> Bool
|
||||||
@@ -56,7 +56,7 @@ drawWallFace cfig w wall
|
|||||||
where
|
where
|
||||||
(x, y) = _wlLine wall
|
(x, y) = _wlLine wall
|
||||||
points = extendConeToScreenEdge cfig w sightFrom (x, y)
|
points = extendConeToScreenEdge cfig w sightFrom (x, y)
|
||||||
sightFrom = w ^. cWorld . cwCam . cwcViewFrom
|
sightFrom = w ^. cWorld . lWorld . cwCam . cwcViewFrom
|
||||||
|
|
||||||
extendConeToScreenEdge :: Configuration -> World -> Point2 -> (Point2, Point2) -> [Point2]
|
extendConeToScreenEdge :: Configuration -> World -> Point2 -> (Point2, Point2) -> [Point2]
|
||||||
extendConeToScreenEdge cfig w c (x, y) = orderPolygon $ wallScreenIntersect ++ [x, y] ++ borderPs ++ cornerPs
|
extendConeToScreenEdge cfig w c (x, y) = orderPolygon $ wallScreenIntersect ++ [x, y] ++ borderPs ++ cornerPs
|
||||||
|
|||||||
@@ -30,10 +30,10 @@ applyTerminalCommand s = case s of
|
|||||||
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
|
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
|
||||||
['L', x] ->
|
['L', x] ->
|
||||||
(uvWorld . cWorld %~ initSpecificCrItemLocations 0)
|
(uvWorld . cWorld %~ initSpecificCrItemLocations 0)
|
||||||
. (uvWorld . cWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x))
|
. (uvWorld . cWorld . lWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x))
|
||||||
. (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
|
. (uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ 50)
|
||||||
"GODON" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Crystal
|
"GODON" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMaterial .~ Crystal
|
||||||
"GODOFF" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Flesh
|
"GODOFF" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMaterial .~ Flesh
|
||||||
_ -> id
|
_ -> id
|
||||||
|
|
||||||
applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
|
applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
|
||||||
@@ -65,10 +65,10 @@ applySetTerminalString :: String -> Universe -> Universe
|
|||||||
applySetTerminalString [] = id
|
applySetTerminalString [] = id
|
||||||
applySetTerminalString var = case key' of
|
applySetTerminalString var = case key' of
|
||||||
"" -> showTerminalError ("set " ++ var) ("Unable to read as argument as float: " ++ val)
|
"" -> showTerminalError ("set " ++ var) ("Unable to read as argument as float: " ++ val)
|
||||||
"hp" -> uvWorld . cWorld . creatures . ix 0 . crHP .~ round (fromJust val')
|
"hp" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crHP .~ round (fromJust val')
|
||||||
"invcap" -> uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
|
"invcap" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
|
||||||
"mass" -> uvWorld . cWorld . creatures . ix 0 . crMass .~ fromJust val'
|
"mass" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMass .~ fromJust val'
|
||||||
"mvspeed" -> uvWorld . cWorld . creatures . ix 0 . crMvType . mvSpeed .~ fromJust val'
|
"mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMvType . mvSpeed .~ fromJust val'
|
||||||
_ -> showTerminalError ("set " ++ var) ("Invalid set command: " ++ key) -- never reached?
|
_ -> showTerminalError ("set " ++ var) ("Invalid set command: " ++ key) -- never reached?
|
||||||
where
|
where
|
||||||
(key, val) = getSplitString var
|
(key, val) = getSplitString var
|
||||||
|
|||||||
@@ -64,8 +64,14 @@ defaultCWCam =
|
|||||||
defaultCWorld :: CWorld
|
defaultCWorld :: CWorld
|
||||||
defaultCWorld =
|
defaultCWorld =
|
||||||
CWorld
|
CWorld
|
||||||
{ _cwCam = defaultCWCam
|
{ _lWorld = defaultLWorld
|
||||||
, _cwGen = defaultCWGen
|
, _cwGen = defaultCWGen
|
||||||
|
}
|
||||||
|
|
||||||
|
defaultLWorld :: LWorld
|
||||||
|
defaultLWorld =
|
||||||
|
LWorld
|
||||||
|
{ _cwCam = defaultCWCam
|
||||||
, _magnets = IM.empty
|
, _magnets = IM.empty
|
||||||
, _modifications = IM.empty
|
, _modifications = IM.empty
|
||||||
, _creatures = IM.empty
|
, _creatures = IM.empty
|
||||||
|
|||||||
+5
-5
@@ -27,7 +27,7 @@ doorMechanism dr w = case mvDir of
|
|||||||
w
|
w
|
||||||
& flip (IS.foldl' (flip (`translateWallID` d))) (_drWallIDs dr)
|
& flip (IS.foldl' (flip (`translateWallID` d))) (_drWallIDs dr)
|
||||||
& moveUpdate
|
& moveUpdate
|
||||||
& cWorld . doors . ix drid . drPos . each %~ (+.+ d)
|
& cWorld . lWorld . doors . ix drid . drPos . each %~ (+.+ d)
|
||||||
& maybeClearDoorPaths (_drObstacleType dr) (_drObstructs dr)
|
& maybeClearDoorPaths (_drObstacleType dr) (_drObstructs dr)
|
||||||
Nothing -> w
|
Nothing -> w
|
||||||
where
|
where
|
||||||
@@ -47,9 +47,9 @@ doorMechanism dr w = case mvDir of
|
|||||||
dop = snd $ _drOpenPos dr
|
dop = snd $ _drOpenPos dr
|
||||||
dcp = snd $ _drClosePos dr
|
dcp = snd $ _drClosePos dr
|
||||||
setStatus
|
setStatus
|
||||||
| dist dpos dop < 1 = cWorld . doors . ix drid . drStatus .~ DoorOpen
|
| dist dpos dop < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorOpen
|
||||||
| dist dpos dcp < 1 = cWorld . doors . ix drid . drStatus .~ DoorClosed
|
| dist dpos dcp < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorClosed
|
||||||
| otherwise = cWorld . doors . ix drid . drStatus .~ DoorHalfway
|
| otherwise = cWorld . lWorld . doors . ix drid . drStatus .~ DoorHalfway
|
||||||
|
|
||||||
-- TODO use vector instead of list, perhaps also memoisation of rectanglePairs
|
-- TODO use vector instead of list, perhaps also memoisation of rectanglePairs
|
||||||
-- TODO update _drPos
|
-- TODO update _drPos
|
||||||
@@ -72,7 +72,7 @@ doorMechanismStepwise nsteps wlids pss dr w
|
|||||||
toOpen = doWdBl (_drTrigger dr) w
|
toOpen = doWdBl (_drTrigger dr) w
|
||||||
setWalls n =
|
setWalls n =
|
||||||
playSound (foldl' (&) w (zipWith moveWallID wlids newps))
|
playSound (foldl' (&) w (zipWith moveWallID wlids newps))
|
||||||
& cWorld . doors . ix drid . drStatus .~ DoorInt n
|
& cWorld . lWorld . doors . ix drid . drStatus .~ DoorInt n
|
||||||
where
|
where
|
||||||
newps = uncurry (rectanglePairs 9) (pss !! n)
|
newps = uncurry (rectanglePairs 9) (pss !! n)
|
||||||
|
|
||||||
|
|||||||
@@ -24,7 +24,7 @@ makeFlamelet ::
|
|||||||
makeFlamelet (V2 x y) z vel size time w =
|
makeFlamelet (V2 x y) z vel size time w =
|
||||||
w
|
w
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
& cWorld . energyBalls
|
& cWorld . lWorld . energyBalls
|
||||||
.:~ EnergyBall
|
.:~ EnergyBall
|
||||||
{ _ebVel = vel
|
{ _ebVel = vel
|
||||||
, _ebColor = red
|
, _ebColor = red
|
||||||
@@ -48,7 +48,7 @@ moveEnergyBall w eb
|
|||||||
|
|
||||||
incBallAt :: Point2 -> World -> World
|
incBallAt :: Point2 -> World -> World
|
||||||
incBallAt p w =
|
incBallAt p w =
|
||||||
w & cWorld . energyBalls .:~ theincball
|
w & cWorld . lWorld . energyBalls .:~ theincball
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
where
|
where
|
||||||
(theincball, g) = runState thestate (_randGen w)
|
(theincball, g) = runState thestate (_randGen w)
|
||||||
@@ -69,6 +69,6 @@ incBallAt p w =
|
|||||||
ebFlicker :: EnergyBall -> World -> World
|
ebFlicker :: EnergyBall -> World -> World
|
||||||
ebFlicker pt
|
ebFlicker pt
|
||||||
| _ebTimer pt `mod` 7 == 0 =
|
| _ebTimer pt `mod` 7 == 0 =
|
||||||
cWorld . tempLightSources
|
cWorld . lWorld . tempLightSources
|
||||||
.:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_ebColor pt)) (addZ 20 $ _ebPos pt)
|
.:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_ebColor pt)) (addZ 20 $ _ebPos pt)
|
||||||
| otherwise = id
|
| otherwise = id
|
||||||
|
|||||||
+6
-6
@@ -31,7 +31,7 @@ useE eo = case eo of
|
|||||||
EoffWristShield -> onRemoveWristShield
|
EoffWristShield -> onRemoveWristShield
|
||||||
|
|
||||||
useMagShield :: Item -> Creature -> World -> World
|
useMagShield :: Item -> Creature -> World -> World
|
||||||
useMagShield it cr w = w & cWorld . magnets . at mgid ?~ themagnet
|
useMagShield it cr w = w & cWorld . lWorld . magnets . at mgid ?~ themagnet
|
||||||
where
|
where
|
||||||
themagnet =
|
themagnet =
|
||||||
Magnet
|
Magnet
|
||||||
@@ -42,16 +42,16 @@ useMagShield it cr w = w & cWorld . magnets . at mgid ?~ themagnet
|
|||||||
}
|
}
|
||||||
mgid = case it ^? itParams . magShieldMgMIX . _Just of
|
mgid = case it ^? itParams . magShieldMgMIX . _Just of
|
||||||
Just mgid' -> mgid'
|
Just mgid' -> mgid'
|
||||||
Nothing -> IM.newKey $ _magnets (_cWorld w)
|
Nothing -> IM.newKey $ w ^. cWorld . lWorld . magnets
|
||||||
|
|
||||||
onEquipWristShield :: Item -> Creature -> World -> World
|
onEquipWristShield :: Item -> Creature -> World -> World
|
||||||
onEquipWristShield itm cr w =
|
onEquipWristShield itm cr w =
|
||||||
w
|
w
|
||||||
& pointerToItem itm . itUse . equipEffect . eeParams .~ EquipID i
|
& pointerToItem itm . itUse . equipEffect . eeParams .~ EquipID i
|
||||||
& cWorld . walls . at i ?~ forceField{_wlID = i}
|
& cWorld . lWorld . walls . at i ?~ forceField{_wlID = i}
|
||||||
& setWristShieldPos (itm & itUse . equipEffect . eeParams .~ EquipID i) cr
|
& setWristShieldPos (itm & itUse . equipEffect . eeParams .~ EquipID i) cr
|
||||||
where
|
where
|
||||||
i = IM.newKey (_walls (_cWorld w))
|
i = IM.newKey (w ^. cWorld . lWorld . walls)
|
||||||
|
|
||||||
onRemoveWristShield :: Item -> Creature -> World -> World
|
onRemoveWristShield :: Item -> Creature -> World -> World
|
||||||
onRemoveWristShield itm _ =
|
onRemoveWristShield itm _ =
|
||||||
@@ -122,7 +122,7 @@ removeShieldWall it _ w = case it ^? itParams . flatShieldWlMIX . _Just of
|
|||||||
|
|
||||||
createHeadLamp :: Item -> Creature -> World -> World
|
createHeadLamp :: Item -> Creature -> World -> World
|
||||||
createHeadLamp _ cr =
|
createHeadLamp _ cr =
|
||||||
cWorld . tempLightSources
|
cWorld . lWorld . tempLightSources
|
||||||
.:~ tlsTimeRadColPos
|
.:~ tlsTimeRadColPos
|
||||||
1
|
1
|
||||||
200
|
200
|
||||||
@@ -130,4 +130,4 @@ createHeadLamp _ cr =
|
|||||||
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
|
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
|
||||||
|
|
||||||
overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
|
overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
|
||||||
overCID f _ cr = cWorld . creatures . ix (_crID cr) %~ f
|
overCID f _ cr = cWorld . lWorld . creatures . ix (_crID cr) %~ f
|
||||||
|
|||||||
@@ -16,22 +16,9 @@ module Dodge.Event (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import LensHelp
|
import LensHelp
|
||||||
import qualified Data.Map.Strict as M
|
|
||||||
import Data.Maybe
|
|
||||||
import qualified Data.Set as S
|
|
||||||
import qualified Data.Text as T
|
|
||||||
import Dodge.Base
|
|
||||||
import Dodge.Combine
|
|
||||||
import Dodge.Data.Universe
|
import Dodge.Data.Universe
|
||||||
import Dodge.Event.Keyboard
|
import Dodge.Event.Keyboard
|
||||||
import Dodge.HeldScroll
|
|
||||||
import Dodge.InputFocus
|
|
||||||
import Dodge.Inventory
|
|
||||||
import Dodge.PreloadData
|
import Dodge.PreloadData
|
||||||
import Dodge.SoundLogic
|
|
||||||
import Dodge.Terminal
|
|
||||||
import Dodge.Tweak
|
|
||||||
import qualified IntMapHelp as IM
|
|
||||||
import SDL
|
import SDL
|
||||||
|
|
||||||
handleEvent :: Event -> Universe -> IO (Maybe Universe)
|
handleEvent :: Event -> Universe -> IO (Maybe Universe)
|
||||||
@@ -95,103 +82,3 @@ handleMouseWheelEvent mwev w = case _uvScreenLayers w of
|
|||||||
V2 _ y -> Just $ w -- & uvWorld %~ wheelEvent (fromIntegral y)
|
V2 _ y -> Just $ w -- & uvWorld %~ wheelEvent (fromIntegral y)
|
||||||
& uvWorld . scrollAmount +~ fromIntegral y
|
& uvWorld . scrollAmount +~ fromIntegral y
|
||||||
_ -> Just w
|
_ -> Just w
|
||||||
|
|
||||||
wheelEvent :: Float -> World -> World
|
|
||||||
wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
|
|
||||||
DisplayCarte
|
|
||||||
| rbDown -> w & cWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *)
|
|
||||||
| otherwise -> w & cWorld . selLocation %~ (`mod` numLocs) . (+ yi)
|
|
||||||
DisplayInventory NoSubInventory
|
|
||||||
-- functions that modify the inventory should be centralised so that
|
|
||||||
-- this lock can be sensibly applied, perhaps
|
|
||||||
| _crInvLock (_creatures (_cWorld w) IM.! _yourID (_cWorld w)) -> w
|
|
||||||
| rbDown -> case (yourItem w ^? _Just . itUse . heldScroll, _rbOptions w) of
|
|
||||||
(_, EquipOptions{}) -> scrollRBOption y w
|
|
||||||
(Nothing, _) -> closeObjScrollDir y w
|
|
||||||
(Just f, _) -> doHeldScroll f y (you w) w
|
|
||||||
| lbDown -> w & cWorld . cwCam . cwcZoom +~ y
|
|
||||||
| invKeyDown -> changeSwapInvSel yi w
|
|
||||||
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
|
|
||||||
DisplayInventory (TweakInventory mi)
|
|
||||||
| invKeyDown && rbDown -> w & moveTweakSel yi
|
|
||||||
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
|
|
||||||
| rbDown -> w & changeTweakParam mi yi
|
|
||||||
| otherwise -> w & moveTweakSel yi
|
|
||||||
DisplayInventory CombineInventory{} ->
|
|
||||||
w
|
|
||||||
& cWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
|
|
||||||
DisplayInventory (DisplayTerminal tmid)
|
|
||||||
| rbDown && inTermFocus w ->
|
|
||||||
guardDisconnectedID tmid w $
|
|
||||||
w
|
|
||||||
& cWorld . terminals . ix tmid %~ updatetermsubsel
|
|
||||||
| inTermFocus w ->
|
|
||||||
w
|
|
||||||
& cWorld . terminals . ix tmid %~ updatetermsel
|
|
||||||
_ -> w
|
|
||||||
where
|
|
||||||
updatetermsel tm = case tm ^? tmInput . tiSel of
|
|
||||||
Nothing -> tm & tmInput . tiSel .~ (0, 0)
|
|
||||||
Just (i, _) ->
|
|
||||||
let newi = (i - yi) `mod` length (scrollCommands tm)
|
|
||||||
in tm & setInput newi 0 w
|
|
||||||
updatetermsubsel tm = case tm ^? tmInput . tiSel of
|
|
||||||
Nothing -> tm & tmInput . tiSel .~ (0, 0)
|
|
||||||
Just (i, j) ->
|
|
||||||
let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w)
|
|
||||||
in tm & setInput i newj w
|
|
||||||
setInput i j w' tm =
|
|
||||||
tm
|
|
||||||
& tmInput . tiSel .~ (i, j)
|
|
||||||
& tmInput . tiText .~ T.pack (_tcString tc ++ " " ++ arg)
|
|
||||||
where
|
|
||||||
tc = scrollCommands tm !! i
|
|
||||||
arg = getArguments' tc tm w' !! j
|
|
||||||
numcombs = length $ combineItemListYou w
|
|
||||||
yi = round $ signum y
|
|
||||||
numLocs = (fst . IM.findMax $ _seenLocations (_cWorld w)) + 1
|
|
||||||
rbDown = ButtonRight `M.member` _mouseButtons w
|
|
||||||
lbDown = ButtonLeft `M.member` _mouseButtons w
|
|
||||||
invKeyDown = ScancodeCapsLock `S.member` _keys w
|
|
||||||
|
|
||||||
getArguments' :: TerminalCommand -> Terminal -> World -> [String]
|
|
||||||
getArguments' tc tm = ("" :) . getArguments tc tm
|
|
||||||
|
|
||||||
getArguments :: TerminalCommand -> Terminal -> World -> [String]
|
|
||||||
getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
|
|
||||||
NoArguments{} -> []
|
|
||||||
OneArgument _ m -> M.keys m
|
|
||||||
|
|
||||||
scrollCommands :: Terminal -> [TerminalCommand]
|
|
||||||
scrollCommands = (nullCommand :) . _tmScrollCommands
|
|
||||||
|
|
||||||
nullCommand :: TerminalCommand
|
|
||||||
nullCommand =
|
|
||||||
TerminalCommand
|
|
||||||
{ _tcString = ""
|
|
||||||
, _tcAlias = []
|
|
||||||
, _tcHelp = ""
|
|
||||||
, _tcEffect = TerminalCommandEffectNone -- \_ _ -> NoArguments []
|
|
||||||
}
|
|
||||||
|
|
||||||
scrollRBOption :: Float -> World -> World
|
|
||||||
scrollRBOption y w
|
|
||||||
| y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w)) -1) . (+ 1))
|
|
||||||
| y > 0 = w & rbOptions . opSel %~ (max 0 . subtract 1)
|
|
||||||
| otherwise = w
|
|
||||||
|
|
||||||
moveTweakSel :: Int -> World -> World
|
|
||||||
moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
|
|
||||||
Just l -> w & cWorld . hud . hudElement . subInventory . tweakInvSel . _Just %~ (`mod` length l) . subtract i
|
|
||||||
_ -> w
|
|
||||||
|
|
||||||
changeTweakParam :: Maybe Int -> Int -> World -> World
|
|
||||||
changeTweakParam mi i w = fromMaybe w $ do
|
|
||||||
paramid <- mi
|
|
||||||
params <- yourItem w ^? _Just . itTweaks . tweakParams . ix paramid
|
|
||||||
let x = (_tweakVal params + i) `mod` _tweakMax params
|
|
||||||
return $
|
|
||||||
w & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w))
|
|
||||||
%~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
|
|
||||||
. doTweak (_tweakType params) x
|
|
||||||
)
|
|
||||||
|
|||||||
+22
-22
@@ -27,7 +27,6 @@ import Dodge.Reloading
|
|||||||
import Dodge.Save
|
import Dodge.Save
|
||||||
import Dodge.Terminal.LeftButton
|
import Dodge.Terminal.LeftButton
|
||||||
import Dodge.WorldPos
|
import Dodge.WorldPos
|
||||||
import qualified IntMapHelp as IM
|
|
||||||
import LensHelp
|
import LensHelp
|
||||||
import SDL
|
import SDL
|
||||||
|
|
||||||
@@ -41,18 +40,18 @@ handleTextInput text u =
|
|||||||
& uvScreenLayers . ix 0 . scInput %~ updateText
|
& uvScreenLayers . ix 0 . scInput %~ updateText
|
||||||
& updateTerminalText
|
& updateTerminalText
|
||||||
where
|
where
|
||||||
updateTerminalText = case u ^? uvWorld . cWorld . hud . hudElement . subInventory of
|
updateTerminalText = case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
|
||||||
Just (DisplayTerminal tmid)
|
Just (DisplayTerminal tmid)
|
||||||
| hasfocus tmid ->
|
| hasfocus tmid ->
|
||||||
uvWorld %~ \w -> guardDisconnectedID tmid w (w & cWorld . terminals . ix tmid . tmInput . tiText %~ updateText)
|
uvWorld %~ \w -> guardDisconnectedID tmid w (w & cWorld . lWorld . terminals . ix tmid . tmInput . tiText %~ updateText)
|
||||||
_ -> id
|
_ -> id
|
||||||
hasfocus tmid = fromMaybe False $ u ^? uvWorld . cWorld . terminals . ix tmid . tmInput . tiFocus
|
hasfocus tmid = fromMaybe False $ u ^? uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
|
||||||
updateText s = case T.unpack text of
|
updateText s = case T.unpack text of
|
||||||
";" -> s
|
";" -> s
|
||||||
_ -> s `T.append` T.toUpper text
|
_ -> s `T.append` T.toUpper text
|
||||||
|
|
||||||
guardDisconnectedID :: Int -> World -> World -> World
|
guardDisconnectedID :: Int -> World -> World -> World
|
||||||
guardDisconnectedID tmid w w' = case w ^? cWorld . terminals . ix tmid . tmStatus of
|
guardDisconnectedID tmid w w' = case w ^? cWorld . lWorld . terminals . ix tmid . tmStatus of
|
||||||
Just TerminalReady -> w'
|
Just TerminalReady -> w'
|
||||||
_ -> w
|
_ -> w
|
||||||
|
|
||||||
@@ -85,7 +84,7 @@ handlePressedKey _ scode u = case scode of
|
|||||||
ScancodeF5 -> return . Just $ doQuicksave u
|
ScancodeF5 -> return . Just $ doQuicksave u
|
||||||
ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u
|
ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u
|
||||||
ScancodeSemicolon -> return . Just $ gotoTerminal u
|
ScancodeSemicolon -> return . Just $ gotoTerminal u
|
||||||
_ | null (_uvScreenLayers u) -> case u ^? uvWorld . cWorld . hud . hudElement . subInventory of
|
_ | null (_uvScreenLayers u) -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
|
||||||
Just (DisplayTerminal tmid)
|
Just (DisplayTerminal tmid)
|
||||||
| inTermFocus (_uvWorld u) ->
|
| inTermFocus (_uvWorld u) ->
|
||||||
return $ uvWorld (Just . handlePressedKeyTerminal tmid scode) u
|
return $ uvWorld (Just . handlePressedKeyTerminal tmid scode) u
|
||||||
@@ -103,18 +102,18 @@ handlePressedKeyInGame scode uv = case scode of
|
|||||||
ScancodeT -> over uvWorld testEvent uv
|
ScancodeT -> over uvWorld testEvent uv
|
||||||
ScancodeX -> uv & uvWorld %~ toggleTweakInv
|
ScancodeX -> uv & uvWorld %~ toggleTweakInv
|
||||||
ScancodeC -> over uvWorld toggleCombineInv uv
|
ScancodeC -> over uvWorld toggleCombineInv uv
|
||||||
ScancodeI -> uv & uvWorld . cWorld . hud . hudElement %~ toggleInspectInv
|
ScancodeI -> uv & uvWorld . cWorld . lWorld . hud . hudElement %~ toggleInspectInv
|
||||||
_ -> uv
|
_ -> uv
|
||||||
where
|
where
|
||||||
w = _uvWorld uv
|
w = _uvWorld uv
|
||||||
|
|
||||||
handlePressedKeyTerminal :: Int -> Scancode -> World -> World
|
handlePressedKeyTerminal :: Int -> Scancode -> World -> World
|
||||||
handlePressedKeyTerminal tmid scode w = case scode of
|
handlePressedKeyTerminal tmid scode w = case scode of
|
||||||
ScancodeEscape -> w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
|
ScancodeEscape -> w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
|
||||||
ScancodeReturn -> w & terminalReturnEffect (w ^?! cWorld . terminals . ix tmid)
|
ScancodeReturn -> w & terminalReturnEffect (w ^?! cWorld . lWorld . terminals . ix tmid)
|
||||||
ScancodeBackspace ->
|
ScancodeBackspace ->
|
||||||
w
|
w
|
||||||
& cWorld . terminals . ix tmid . tmInput . tiText %~ doBackspace
|
& cWorld . lWorld . terminals . ix tmid . tmInput . tiText %~ doBackspace
|
||||||
& backspaceTimer .~ 5
|
& backspaceTimer .~ 5
|
||||||
_ -> w
|
_ -> w
|
||||||
where
|
where
|
||||||
@@ -123,11 +122,11 @@ handlePressedKeyTerminal tmid scode w = case scode of
|
|||||||
Just (t', _) -> t'
|
Just (t', _) -> t'
|
||||||
|
|
||||||
toggleTweakInv :: World -> World
|
toggleTweakInv :: World -> World
|
||||||
toggleTweakInv w = case w ^. cWorld . hud . hudElement of
|
toggleTweakInv w = case w ^. cWorld . lWorld . hud . hudElement of
|
||||||
DisplayInventory TweakInventory{} -> w & thepointer .~ DisplayInventory NoSubInventory
|
DisplayInventory TweakInventory{} -> w & thepointer .~ DisplayInventory NoSubInventory
|
||||||
_ -> w & thepointer .~ DisplayInventory (TweakInventory mi)
|
_ -> w & thepointer .~ DisplayInventory (TweakInventory mi)
|
||||||
where
|
where
|
||||||
thepointer = cWorld . hud . hudElement
|
thepointer = cWorld . lWorld . hud . hudElement
|
||||||
mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
|
mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
|
||||||
|
|
||||||
toggleInspectInv :: HUDElement -> HUDElement
|
toggleInspectInv :: HUDElement -> HUDElement
|
||||||
@@ -141,16 +140,17 @@ gotoTerminal w = case _uvScreenLayers w of
|
|||||||
_ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command"
|
_ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command"
|
||||||
|
|
||||||
spaceAction :: World -> World
|
spaceAction :: World -> World
|
||||||
spaceAction w = case _hudElement $ _hud (_cWorld w) of
|
spaceAction w = case w ^?! cWorld . lWorld . hud . hudElement of
|
||||||
DisplayCarte -> w & cWorld . hud . carteCenter .~ theLoc
|
DisplayCarte -> w & cWorld . lWorld . hud . carteCenter .~ theLoc
|
||||||
DisplayInventory NoSubInventory -> case selectedCloseObject w of
|
DisplayInventory NoSubInventory -> case selectedCloseObject w of
|
||||||
Just (_, Left flit) -> pickUpItem 0 flit w
|
Just (_, Left flit) -> pickUpItem 0 flit w
|
||||||
Just (_, Right but) -> doButtonEvent (_btEvent but) but w
|
Just (_, Right but) -> doButtonEvent (_btEvent but) but w
|
||||||
_ -> w
|
_ -> w
|
||||||
DisplayInventory DisplayTerminal{} -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
|
DisplayInventory DisplayTerminal{} -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
|
||||||
_ -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
|
_ -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
|
||||||
where
|
where
|
||||||
theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w
|
--theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w
|
||||||
|
theLoc = doWorldPos (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) w
|
||||||
|
|
||||||
-- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail
|
-- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail
|
||||||
|
|
||||||
@@ -158,11 +158,11 @@ pauseGame :: Universe -> Universe
|
|||||||
pauseGame = uvScreenLayers .~ [pauseMenu]
|
pauseGame = uvScreenLayers .~ [pauseMenu]
|
||||||
|
|
||||||
toggleMap :: World -> World
|
toggleMap :: World -> World
|
||||||
toggleMap w = case _hudElement $ _hud (_cWorld w) of
|
toggleMap w = case w ^?! cWorld . lWorld . hud . hudElement of
|
||||||
DisplayCarte -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
|
DisplayCarte -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
|
||||||
_ -> w & cWorld . hud . hudElement .~ DisplayCarte
|
_ -> w & cWorld . lWorld . hud . hudElement .~ DisplayCarte
|
||||||
|
|
||||||
escapeMap :: World -> World
|
escapeMap :: World -> World
|
||||||
escapeMap w = case _hudElement $ _hud (_cWorld w) of
|
escapeMap w = case w ^?! cWorld . lWorld . hud . hudElement of
|
||||||
DisplayCarte -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
|
DisplayCarte -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
|
||||||
_ -> w
|
_ -> w
|
||||||
|
|||||||
+5
-5
@@ -62,8 +62,8 @@ doDamagesFL ::
|
|||||||
World ->
|
World ->
|
||||||
World
|
World
|
||||||
doDamagesFL fdm (p, thhit) bt = case thhit of
|
doDamagesFL fdm (p, thhit) bt = case thhit of
|
||||||
Left cr -> cWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
|
Left cr -> cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
|
||||||
Right wl -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
|
Right wl -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
|
||||||
where
|
where
|
||||||
dams = fdm bt p
|
dams = fdm bt p
|
||||||
|
|
||||||
@@ -112,7 +112,7 @@ flDamageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Flame -> World -> Worl
|
|||||||
flDamageInArea crt wlt pt w = damwls damcrs
|
flDamageInArea crt wlt pt w = damwls damcrs
|
||||||
where
|
where
|
||||||
p = _flPos pt
|
p = _flPos pt
|
||||||
damcrs = foldl' (flip $ \cr -> fst . hiteff [(p, Left cr)]) w $ IM.filter crt $ _creatures (_cWorld w)
|
damcrs = foldl' (flip $ \cr -> fst . hiteff [(p, Left cr)]) w $ IM.filter crt $ w ^. cWorld . lWorld . creatures--_creatures (_cWorld w)
|
||||||
damwls w' =
|
damwls w' =
|
||||||
foldl'
|
foldl'
|
||||||
(flip $ \wl -> fst . hiteff [(p, Right wl)])
|
(flip $ \wl -> fst . hiteff [(p, Right wl)])
|
||||||
@@ -124,14 +124,14 @@ flDamageInArea crt wlt pt w = damwls damcrs
|
|||||||
flFlicker :: Flame -> World -> World
|
flFlicker :: Flame -> World -> World
|
||||||
flFlicker pt
|
flFlicker pt
|
||||||
| _flTimer pt `mod` 7 == 0 =
|
| _flTimer pt `mod` 7 == 0 =
|
||||||
cWorld . tempLightSources
|
cWorld . lWorld . tempLightSources
|
||||||
.:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_flColor pt)) (addZ 10 $ _flPos pt)
|
.:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_flColor pt)) (addZ 10 $ _flPos pt)
|
||||||
| otherwise = id
|
| otherwise = id
|
||||||
|
|
||||||
makeFlame :: Point2 -> Point2 -> World -> World
|
makeFlame :: Point2 -> Point2 -> World -> World
|
||||||
makeFlame pos vel w =
|
makeFlame pos vel w =
|
||||||
w
|
w
|
||||||
& cWorld . flames .:~ aFlameParticle t pos vel
|
& cWorld . lWorld . flames .:~ aFlameParticle t pos vel
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
where
|
where
|
||||||
(t, g) = randomR (99, 101) (_randGen w)
|
(t, g) = randomR (99, 101) (_randGen w)
|
||||||
|
|||||||
@@ -20,13 +20,13 @@ copyItemToFloorID :: Point2 -> Item -> World -> (Int, World)
|
|||||||
copyItemToFloorID pos it w =
|
copyItemToFloorID pos it w =
|
||||||
(,) flid $
|
(,) flid $
|
||||||
w'
|
w'
|
||||||
& cWorld . floorItems %~ IM.insert flid theflit
|
& cWorld . lWorld . floorItems %~ IM.insert flid theflit
|
||||||
& updateLocation
|
& updateLocation
|
||||||
where
|
where
|
||||||
(p', w') = findWallFreeDropPoint (_dimRad $ _itDimension it) pos w
|
(p', w') = findWallFreeDropPoint (_dimRad $ _itDimension it) pos w
|
||||||
rot = fst . randomR (- pi, pi) $ _randGen w
|
rot = fst . randomR (- pi, pi) $ _randGen w
|
||||||
updateLocation = cWorld . itemLocations . ix (_itID it) .~ OnFloor flid
|
updateLocation = cWorld . lWorld . itemLocations . ix (_itID it) .~ OnFloor flid
|
||||||
flid = IM.newKey $ _floorItems (_cWorld w)
|
flid = IM.newKey $ _floorItems (_lWorld (_cWorld w))
|
||||||
theflit =
|
theflit =
|
||||||
FlIt
|
FlIt
|
||||||
{ _flIt = it & itUse . useAmount %~ const 1
|
{ _flIt = it & itUse . useAmount %~ const 1
|
||||||
|
|||||||
@@ -19,7 +19,7 @@ doHeldScroll hs = case hs of
|
|||||||
HeldScrollTime -> doScrollTime
|
HeldScrollTime -> doScrollTime
|
||||||
HeldScrollInt{} -> undefined
|
HeldScrollInt{} -> undefined
|
||||||
where
|
where
|
||||||
overYourItem f x cr w = w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ f x cr
|
overYourItem f x cr w = w & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ f x cr
|
||||||
|
|
||||||
doScrollTime :: Float -> Creature -> World -> World
|
doScrollTime :: Float -> Creature -> World -> World
|
||||||
doScrollTime _ _ w = w
|
doScrollTime _ _ w = w
|
||||||
|
|||||||
@@ -404,10 +404,10 @@ overNozzles' ::
|
|||||||
Creature ->
|
Creature ->
|
||||||
World ->
|
World ->
|
||||||
World
|
World
|
||||||
overNozzles' eff it cr w = neww & cWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
|
overNozzles' eff it cr w = neww & cWorld . lWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
i = crSel $ _creatures (_cWorld w) IM.! cid
|
i = crSel $ w ^?! cWorld . lWorld . creatures . ix cid
|
||||||
(neww, newNozzles) = mapAccumR (eff it cr) w $ _sprayNozzles (_itParams it)
|
(neww, newNozzles) = mapAccumR (eff it cr) w $ _sprayNozzles (_itParams it)
|
||||||
|
|
||||||
overNozzle ::
|
overNozzle ::
|
||||||
@@ -443,12 +443,12 @@ useGasParams nz it cr =
|
|||||||
fireRemoteShell :: Item -> Creature -> World -> World
|
fireRemoteShell :: Item -> Creature -> World -> World
|
||||||
fireRemoteShell it cr w =
|
fireRemoteShell it cr w =
|
||||||
set
|
set
|
||||||
(cWorld . creatures . ix cid . crInv . ix j . itUse . heldUse)
|
(cWorld . lWorld . creatures . ix cid . crInv . ix j . itUse . heldUse)
|
||||||
(HeldExplodeRemoteShell itid i)
|
(HeldExplodeRemoteShell itid i)
|
||||||
$ addRemRocket w
|
$ addRemRocket w
|
||||||
where
|
where
|
||||||
itid = _itID it
|
itid = _itID it
|
||||||
i = IM.newKey $ _props (_cWorld w)
|
i = IM.newKey $ w ^. cWorld . lWorld . props
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
addRemRocket =
|
addRemRocket =
|
||||||
makeShell
|
makeShell
|
||||||
@@ -488,7 +488,7 @@ coneRandItemParams = do
|
|||||||
}
|
}
|
||||||
|
|
||||||
mcShootLaser :: Item -> Machine -> World -> World
|
mcShootLaser :: Item -> Machine -> World -> World
|
||||||
mcShootLaser it mc = cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
|
mcShootLaser it mc = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
|
||||||
where
|
where
|
||||||
pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
|
pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
|
||||||
dir = mc ^?! mcType . _McTurret . tuDir
|
dir = mc ^?! mcType . _McTurret . tuDir
|
||||||
@@ -499,7 +499,7 @@ mcShootLaser it mc = cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam
|
|||||||
shootTeslaArc :: Item -> Creature -> World -> World
|
shootTeslaArc :: Item -> Creature -> World -> World
|
||||||
shootTeslaArc it cr w =
|
shootTeslaArc it cr w =
|
||||||
w'
|
w'
|
||||||
& cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip
|
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip
|
||||||
where
|
where
|
||||||
(w', ip) = shootTeslaArc' (_itParams it) pos dir w
|
(w', ip) = shootTeslaArc' (_itParams it) pos dir w
|
||||||
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
|
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
|
||||||
|
|||||||
@@ -6,7 +6,6 @@ import Dodge.Creature
|
|||||||
import Dodge.Data.CreatureEffect
|
import Dodge.Data.CreatureEffect
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import Geometry
|
import Geometry
|
||||||
import qualified IntMapHelp as IM
|
|
||||||
import LensHelp
|
import LensHelp
|
||||||
import RandomHelp
|
import RandomHelp
|
||||||
|
|
||||||
@@ -221,7 +220,7 @@ chooseMovementPistol' cr w =
|
|||||||
where
|
where
|
||||||
g = _randGen w
|
g = _randGen w
|
||||||
cpos = _crPos cr
|
cpos = _crPos cr
|
||||||
ycr = _creatures (_cWorld w) IM.! 0
|
ycr = w ^?! cWorld . lWorld . creatures . ix 0
|
||||||
ypos = _crPos ycr
|
ypos = _crPos ycr
|
||||||
chargeProb
|
chargeProb
|
||||||
| dist cpos ypos > 300 = 5
|
| dist cpos ypos > 300 = 5
|
||||||
|
|||||||
@@ -11,12 +11,12 @@ import qualified IntMapHelp as IM
|
|||||||
splashScreen :: World
|
splashScreen :: World
|
||||||
splashScreen =
|
splashScreen =
|
||||||
defaultWorld
|
defaultWorld
|
||||||
& cWorld . creatures .~ IM.fromList [(0, startCr)]
|
& cWorld . lWorld . creatures .~ IM.fromList [(0, startCr)]
|
||||||
|
|
||||||
initialWorld :: World
|
initialWorld :: World
|
||||||
initialWorld =
|
initialWorld =
|
||||||
defaultWorld
|
defaultWorld
|
||||||
& cWorld . cwCam . cwcZoom .~ 10
|
& cWorld . lWorld . cwCam . cwcZoom .~ 10
|
||||||
& cWorld . creatures .~ IM.fromList [(0, startCr)]
|
& cWorld . lWorld . creatures .~ IM.fromList [(0, startCr)]
|
||||||
& cWorld . worldEvents .~ SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing :
|
& cWorld . lWorld . worldEvents .~ SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing :
|
||||||
[MakeStartCloudAt (V3 x y 5) | x <- [-5, -4 .. 5], y <- [-5, -4 .. 5]]
|
[MakeStartCloudAt (V3 x y 5) | x <- [-5, -4 .. 5], y <- [-5, -4 .. 5]]
|
||||||
|
|||||||
@@ -6,7 +6,7 @@ import LensHelp
|
|||||||
|
|
||||||
inTermFocus :: World -> Bool
|
inTermFocus :: World -> Bool
|
||||||
inTermFocus w = fromMaybe False $ do
|
inTermFocus w = fromMaybe False $ do
|
||||||
tmid <- w ^? cWorld . hud . hudElement . subInventory . termID
|
tmid <- w ^? cWorld . lWorld . hud . hudElement . subInventory . termID
|
||||||
hasfocus <- w ^? cWorld . terminals . ix tmid . tmInput . tiFocus
|
hasfocus <- w ^? cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
|
||||||
connectionstatus <- w ^? cWorld . terminals . ix tmid . tmStatus
|
connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
|
||||||
return $ hasfocus && connectionstatus == TerminalReady
|
return $ hasfocus && connectionstatus == TerminalReady
|
||||||
|
|||||||
+44
-42
@@ -49,26 +49,26 @@ rmInvItem ::
|
|||||||
Int ->
|
Int ->
|
||||||
World ->
|
World ->
|
||||||
World
|
World
|
||||||
rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount of
|
rmInvItem cid invid w = case w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount of
|
||||||
Just x | x > 1 -> w & cWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount %~ subtract 1
|
Just x | x > 1 -> w & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount %~ subtract 1
|
||||||
_ ->
|
_ ->
|
||||||
w
|
w
|
||||||
& cWorld . creatures . ix cid . crInv %~ f
|
& cWorld . lWorld . creatures . ix cid . crInv %~ f
|
||||||
& cWorld . creatures . ix cid . crInvSel %~ stopCrInvSelAction
|
& cWorld . lWorld . creatures . ix cid . crInvSel %~ stopCrInvSelAction
|
||||||
& cWorld . creatures . ix cid . crInvSel . iselPos %~ g
|
& cWorld . lWorld . creatures . ix cid . crInvSel . iselPos %~ g
|
||||||
& cWorld . creatures . ix cid . crLeftInvSel %~ g'
|
& cWorld . lWorld . creatures . ix cid . crLeftInvSel %~ g'
|
||||||
& removeAnySlotEquipment
|
& removeAnySlotEquipment
|
||||||
& dounequipfunction
|
& dounequipfunction
|
||||||
& doanyitemeffect
|
& doanyitemeffect
|
||||||
& cWorld . creatures . ix cid . crInvEquipped %~ IM.delete invid
|
& cWorld . lWorld . creatures . ix cid . crInvEquipped %~ IM.delete invid
|
||||||
& cWorld . creatures . ix cid . crInvEquipped %~ IM.mapKeys g
|
& cWorld . lWorld . creatures . ix cid . crInvEquipped %~ IM.mapKeys g
|
||||||
where
|
where
|
||||||
-- TODO check whether this can be mapKeysMonotonic
|
-- TODO check whether this can be mapKeysMonotonic
|
||||||
|
|
||||||
stopCrInvSelAction (InvSel i a)
|
stopCrInvSelAction (InvSel i a)
|
||||||
| i == invid = InvSel i NoInvSelAction
|
| i == invid = InvSel i NoInvSelAction
|
||||||
| otherwise = InvSel i a
|
| otherwise = InvSel i a
|
||||||
cr = _creatures (_cWorld w) IM.! cid
|
cr = w ^?! cWorld . lWorld . creatures . ix cid
|
||||||
itm = _crInv cr IM.! invid
|
itm = _crInv cr IM.! invid
|
||||||
dounequipfunction = fromMaybe id $ do
|
dounequipfunction = fromMaybe id $ do
|
||||||
rmf <- itm ^? itUse . equipEffect . eeOnRemove
|
rmf <- itm ^? itUse . equipEffect . eeOnRemove
|
||||||
@@ -76,10 +76,10 @@ rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid
|
|||||||
doanyitemeffect = fromMaybe id $ do
|
doanyitemeffect = fromMaybe id $ do
|
||||||
rmf <- itm ^? itEffect . ieOnDrop
|
rmf <- itm ^? itEffect . ieOnDrop
|
||||||
return $ doInvEffect rmf itm cr
|
return $ doInvEffect rmf itm cr
|
||||||
removeAnySlotEquipment = case w ^? cWorld . creatures . ix cid . crInvEquipped . ix invid of
|
removeAnySlotEquipment = case w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid of
|
||||||
Just epos -> cWorld . creatures . ix cid . crEquipment . at epos .~ Nothing
|
Just epos -> cWorld . lWorld . creatures . ix cid . crEquipment . at epos .~ Nothing
|
||||||
Nothing -> id
|
Nothing -> id
|
||||||
maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures (_cWorld w) IM.! cid
|
maxk = fmap fst $ IM.lookupMax $ w ^?! cWorld . lWorld . creatures . ix cid . crInv
|
||||||
f inv =
|
f inv =
|
||||||
let (xs, ys) = IM.split invid inv
|
let (xs, ys) = IM.split invid inv
|
||||||
in xs `IM.union` IM.mapKeys (subtract 1) ys
|
in xs `IM.union` IM.mapKeys (subtract 1) ys
|
||||||
@@ -93,7 +93,7 @@ rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid
|
|||||||
| otherwise = Just x
|
| otherwise = Just x
|
||||||
|
|
||||||
rmSelectedInvItem :: Int -> World -> World
|
rmSelectedInvItem :: Int -> World -> World
|
||||||
rmSelectedInvItem cid w = rmInvItem cid (crSel (_creatures (_cWorld w) IM.! cid)) w
|
rmSelectedInvItem cid w = rmInvItem cid (crSel (w ^?! cWorld . lWorld . creatures . ix cid)) w
|
||||||
|
|
||||||
augmentedInvSizes :: World -> IM.IntMap Int
|
augmentedInvSizes :: World -> IM.IntMap Int
|
||||||
augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize
|
augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize
|
||||||
@@ -102,7 +102,7 @@ bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.
|
|||||||
bimapAugmentInv f g w =
|
bimapAugmentInv f g w =
|
||||||
IM.union
|
IM.union
|
||||||
(f <$> yourInv w)
|
(f <$> yourInv w)
|
||||||
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects (_cWorld w))
|
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ w ^. cWorld . lWorld . closeObjects)
|
||||||
|
|
||||||
invSelSize :: Int -> World -> Int
|
invSelSize :: Int -> World -> Int
|
||||||
invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
|
invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
|
||||||
@@ -157,10 +157,10 @@ updateTerminal :: World -> World
|
|||||||
updateTerminal = checkTermDist
|
updateTerminal = checkTermDist
|
||||||
|
|
||||||
checkTermDist :: World -> World
|
checkTermDist :: World -> World
|
||||||
checkTermDist w = case w ^? cWorld . hud . hudElement . subInventory . termID of
|
checkTermDist w = case w ^? cWorld . lWorld . hud . hudElement . subInventory . termID of
|
||||||
Just tmid -> fromMaybe (w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do
|
Just tmid -> fromMaybe (w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do
|
||||||
btid <- w ^? cWorld . terminals . ix tmid . tmButtonID
|
btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
|
||||||
btpos <- w ^? cWorld . buttons . ix btid . btPos
|
btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
|
||||||
if dist btpos (_crPos $ you w) < 40 then Just w else Nothing
|
if dist btpos (_crPos $ you w) < 40 then Just w else Nothing
|
||||||
Nothing -> w
|
Nothing -> w
|
||||||
|
|
||||||
@@ -168,8 +168,8 @@ checkTermDist w = case w ^? cWorld . hud . hudElement . subInventory . termID of
|
|||||||
updateCloseObjects :: World -> World
|
updateCloseObjects :: World -> World
|
||||||
updateCloseObjects w =
|
updateCloseObjects w =
|
||||||
w
|
w
|
||||||
& cWorld . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
|
& cWorld . lWorld . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
|
||||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ updateinvsel
|
& cWorld . lWorld . creatures . ix (_yourID (_lWorld (_cWorld w))) . crInvSel . iselPos %~ updateinvsel
|
||||||
where
|
where
|
||||||
updateinvsel curinvsel
|
updateinvsel curinvsel
|
||||||
| length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1
|
| length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1
|
||||||
@@ -180,12 +180,12 @@ updateCloseObjects w =
|
|||||||
map Right
|
map Right
|
||||||
. filter ((/=) BtNoLabel . _btState)
|
. filter ((/=) BtNoLabel . _btState)
|
||||||
. IM.elems
|
. IM.elems
|
||||||
$ _buttons (_cWorld w)
|
$ w ^. cWorld . lWorld . buttons
|
||||||
currentClose = filt $ map Left (IM.elems $ _floorItems (_cWorld w)) ++ activeButtons
|
currentClose = filt $ map Left (IM.elems $ w ^. cWorld . lWorld . floorItems) ++ activeButtons
|
||||||
oldClose = filt $ mapMaybe updatebyid $ _closeObjects (_cWorld w)
|
oldClose = filt $ mapMaybe updatebyid $ w ^. cWorld . lWorld . closeObjects
|
||||||
oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
|
oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
|
||||||
updatebyid (Left flid) = fmap Left $ w ^? cWorld . floorItems . ix (_flItID flid)
|
updatebyid (Left flid) = fmap Left $ w ^? cWorld . lWorld . floorItems . ix (_flItID flid)
|
||||||
updatebyid (Right btid) = fmap Right $ w ^? cWorld . buttons . ix (_btID btid)
|
updatebyid (Right btid) = fmap Right $ w ^? cWorld . lWorld . buttons . ix (_btID btid)
|
||||||
|
|
||||||
updateRBList :: World -> World
|
updateRBList :: World -> World
|
||||||
updateRBList w
|
updateRBList w
|
||||||
@@ -310,8 +310,8 @@ equipSiteToPositions es = case es of
|
|||||||
|
|
||||||
closeObjScrollDir :: Float -> World -> World
|
closeObjScrollDir :: Float -> World -> World
|
||||||
closeObjScrollDir x
|
closeObjScrollDir x
|
||||||
| x > 0 = over (cWorld . closeObjects) rotU
|
| x > 0 = over (cWorld . lWorld . closeObjects) rotU
|
||||||
| x < 0 = over (cWorld . closeObjects) rotD
|
| x < 0 = over (cWorld . lWorld . closeObjects) rotD
|
||||||
| otherwise = id
|
| otherwise = id
|
||||||
|
|
||||||
changeInvSel :: Int -> World -> World
|
changeInvSel :: Int -> World -> World
|
||||||
@@ -319,29 +319,30 @@ changeInvSel i w
|
|||||||
| n == 0 = w
|
| n == 0 = w
|
||||||
| yourInvSel w < n =
|
| yourInvSel w < n =
|
||||||
w
|
w
|
||||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i
|
& cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) . crInvSel . iselPos %~ (`mod` n) . subtract i
|
||||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
|
& cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) . crInvSel . iselAction .~ NoInvSelAction
|
||||||
| otherwise =
|
| otherwise =
|
||||||
w
|
w
|
||||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ ((+ n) . (`mod` numCO) . subtract (i + n))
|
& cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) . crInvSel . iselPos %~ ((+ n) . (`mod` numCO) . subtract (i + n))
|
||||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
|
& cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) . crInvSel . iselAction .~ NoInvSelAction
|
||||||
where
|
where
|
||||||
-- arguably this should jump the invpos into the inventory proper
|
-- arguably this should jump the invpos into the inventory proper
|
||||||
|
|
||||||
n = length $ _crInv $ _creatures (_cWorld w) IM.! _yourID (_cWorld w)
|
n = length $ _crInv $ _creatures (_lWorld (_cWorld w)) IM.! _yourID (_lWorld (_cWorld w))
|
||||||
numCO = length $ _closeObjects (_cWorld w)
|
numCO = length $ w ^. cWorld . lWorld . closeObjects
|
||||||
|
|
||||||
changeSwapInvSel :: Int -> World -> World
|
changeSwapInvSel :: Int -> World -> World
|
||||||
changeSwapInvSel k w
|
changeSwapInvSel k w
|
||||||
| n == 0 = w
|
| n == 0 = w
|
||||||
| yourInvSel w < n =
|
| yourInvSel w < n =
|
||||||
w
|
w
|
||||||
& cWorld . creatures . ix (_yourID (_cWorld w)) %~ updatecreature
|
& cWorld . lWorld . creatures . ix yid %~ updatecreature
|
||||||
| otherwise =
|
| otherwise =
|
||||||
w
|
w
|
||||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos .~ ico'
|
& cWorld . lWorld . creatures . ix yid . crInvSel . iselPos .~ ico'
|
||||||
& cWorld . closeObjects %~ swapIndices (i - n) (ico' - n)
|
& cWorld . lWorld . closeObjects %~ swapIndices (i - n) (ico' - n)
|
||||||
where
|
where
|
||||||
|
yid = w ^. cWorld . lWorld . yourID
|
||||||
updatecreature =
|
updatecreature =
|
||||||
(crInv %~ IM.safeSwapKeys (i `mod` n) swapi)
|
(crInv %~ IM.safeSwapKeys (i `mod` n) swapi)
|
||||||
. (crLeftInvSel . _Just %~ updateLeftInvSel)
|
. (crLeftInvSel . _Just %~ updateLeftInvSel)
|
||||||
@@ -361,20 +362,21 @@ changeSwapInvSel k w
|
|||||||
i = crSel cr
|
i = crSel cr
|
||||||
ico' = ((i - (k + n)) `mod` numCO) + n
|
ico' = ((i - (k + n)) `mod` numCO) + n
|
||||||
n = length $ _crInv cr
|
n = length $ _crInv cr
|
||||||
numCO = length $ _closeObjects (_cWorld w)
|
numCO = length $ w ^. cWorld . lWorld . closeObjects
|
||||||
|
|
||||||
changeAugInvSel :: Int -> World -> World
|
changeAugInvSel :: Int -> World -> World
|
||||||
changeAugInvSel i w
|
changeAugInvSel i w
|
||||||
| n == 0 = w
|
| n == 0 = w
|
||||||
| otherwise =
|
| otherwise =
|
||||||
w
|
w
|
||||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i
|
& cWorld . lWorld . creatures . ix yid . crInvSel . iselPos %~ (`mod` n) . subtract i
|
||||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
|
& cWorld . lWorld . creatures . ix yid . crInvSel . iselAction .~ NoInvSelAction
|
||||||
where
|
where
|
||||||
n = length (yourInv w) + length (_closeObjects (_cWorld w))
|
yid = w ^. cWorld . lWorld . yourID
|
||||||
|
n = length (yourInv w) + length (w ^. cWorld . lWorld . closeObjects)
|
||||||
|
|
||||||
bestCloseObjectIndex :: World -> Maybe Int
|
bestCloseObjectIndex :: World -> Maybe Int
|
||||||
bestCloseObjectIndex w = findIndex f $ _closeObjects (_cWorld w)
|
bestCloseObjectIndex w = findIndex f $ w ^. cWorld . lWorld . closeObjects
|
||||||
where
|
where
|
||||||
f (Right _) = True
|
f (Right _) = True
|
||||||
f (Left flit) = itSlotsTaken (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr
|
f (Left flit) = itSlotsTaken (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr
|
||||||
@@ -390,4 +392,4 @@ selectedCloseObject w
|
|||||||
inv = _crInv cr
|
inv = _crInv cr
|
||||||
|
|
||||||
selectNthCloseObject :: World -> Int -> Maybe (Int, Either FloorItem Button)
|
selectNthCloseObject :: World -> Int -> Maybe (Int, Either FloorItem Button)
|
||||||
selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects (_cWorld w) !? n)
|
selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects (_lWorld (_cWorld w)) !? n)
|
||||||
|
|||||||
@@ -11,7 +11,8 @@ import qualified IntMapHelp as IM
|
|||||||
|
|
||||||
putItemInInvID :: Int -> Int -> World -> (Maybe Int, World)
|
putItemInInvID :: Int -> Int -> World -> (Maybe Int, World)
|
||||||
putItemInInvID cid flid w = fromMaybe (Nothing, w) $ do
|
putItemInInvID cid flid w = fromMaybe (Nothing, w) $ do
|
||||||
(i, w') <- tryPutItemInInv cid (_floorItems (_cWorld w) IM.! flid) w
|
--(i, w') <- tryPutItemInInv cid (_floorItems (_cWorld w) IM.! flid) w
|
||||||
|
(i, w') <- tryPutItemInInv cid (w ^?! cWorld . lWorld . floorItems . ix flid) w
|
||||||
return (Just i, w')
|
return (Just i, w')
|
||||||
|
|
||||||
putItemInInvSlot :: Int -> Item -> IM.IntMap Item -> IM.IntMap Item
|
putItemInInvSlot :: Int -> Item -> IM.IntMap Item -> IM.IntMap Item
|
||||||
@@ -26,13 +27,13 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
|
|||||||
( i
|
( i
|
||||||
, w
|
, w
|
||||||
& updateItLocation i
|
& updateItLocation i
|
||||||
& cWorld . floorItems %~ IM.delete (_flItID flit)
|
& cWorld . lWorld . floorItems %~ IM.delete (_flItID flit)
|
||||||
& cWorld . creatures . ix cid . crInv %~ putItemInInvSlot i it
|
& cWorld . lWorld . creatures . ix cid . crInv %~ putItemInInvSlot i it
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
it = _flIt flit
|
it = _flIt flit
|
||||||
maybeInvSlot = checkInvSlotsYou it w
|
maybeInvSlot = checkInvSlotsYou it w
|
||||||
updateItLocation invid w' = w' & cWorld . itemLocations . ix (_itID it) .~ InInv cid invid
|
updateItLocation invid w' = w' & cWorld . lWorld . itemLocations . ix (_itID it) .~ InInv cid invid
|
||||||
|
|
||||||
--{- | Pick up a specific item. -}
|
--{- | Pick up a specific item. -}
|
||||||
--putItemInInv :: Int -> FloorItem -> World -> World
|
--putItemInInv :: Int -> FloorItem -> World -> World
|
||||||
@@ -50,5 +51,5 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
|
|||||||
-- Just j -> w' & itemPositions . ix j .~ InInv cid invid
|
-- Just j -> w' & itemPositions . ix j .~ InInv cid invid
|
||||||
createPutItem :: Item -> World -> (Maybe Int, World)
|
createPutItem :: Item -> World -> (Maybe Int, World)
|
||||||
createPutItem it w =
|
createPutItem it w =
|
||||||
uncurry (putItemInInvID (_yourID (_cWorld w))) $
|
uncurry (putItemInInvID (_yourID (_lWorld (_cWorld w)))) $
|
||||||
copyItemToFloorID (_crPos $ you w) (applyModules it) w
|
copyItemToFloorID (_crPos $ you w) (applyModules it) w
|
||||||
|
|||||||
@@ -4,7 +4,7 @@ import Control.Lens
|
|||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
|
|
||||||
lockInv :: Int -> World -> World
|
lockInv :: Int -> World -> World
|
||||||
lockInv cid = cWorld . creatures . ix cid . crInvLock ||~ True
|
lockInv cid = cWorld . lWorld . creatures . ix cid . crInvLock ||~ True
|
||||||
|
|
||||||
unlockInv :: Int -> World -> World
|
unlockInv :: Int -> World -> World
|
||||||
unlockInv cid = cWorld . creatures . ix cid . crInvLock &&~ False
|
unlockInv cid = cWorld . lWorld . creatures . ix cid . crInvLock &&~ False
|
||||||
|
|||||||
@@ -36,7 +36,7 @@ chargeIfInInventory itm cr w =
|
|||||||
w & ptrWpCharge %~ (min maxcharge . (+ 1))
|
w & ptrWpCharge %~ (min maxcharge . (+ 1))
|
||||||
where
|
where
|
||||||
invid = _ipInvID $ _itLocation itm
|
invid = _ipInvID $ _itLocation itm
|
||||||
ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
|
ptrWpCharge = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
|
||||||
maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
|
maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
|
||||||
|
|
||||||
|
|
||||||
@@ -48,7 +48,7 @@ chargeIfEquipped itm cr w
|
|||||||
w & ptrWpCharge .~ 0
|
w & ptrWpCharge .~ 0
|
||||||
where
|
where
|
||||||
invid = _ipInvID $ _itLocation itm
|
invid = _ipInvID $ _itLocation itm
|
||||||
ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
|
ptrWpCharge = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
|
||||||
maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
|
maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -4,7 +4,6 @@ import Control.Lens
|
|||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import Dodge.Default
|
import Dodge.Default
|
||||||
import Dodge.SoundLogic
|
import Dodge.SoundLogic
|
||||||
import qualified IntMapHelp as IM
|
|
||||||
|
|
||||||
medkit :: Int -> Item
|
medkit :: Int -> Item
|
||||||
medkit i =
|
medkit i =
|
||||||
@@ -17,10 +16,10 @@ heal25 = heal 25
|
|||||||
|
|
||||||
heal :: Int -> Int -> World -> Maybe World
|
heal :: Int -> Int -> World -> Maybe World
|
||||||
heal hp n w
|
heal hp n w
|
||||||
| _crHP (_creatures (_cWorld w) IM.! n) >= 10000 = Nothing
|
| (w ^?! cWorld . lWorld . creatures . ix n . crHP) >= 10000 = Nothing
|
||||||
| otherwise =
|
| otherwise =
|
||||||
Just $
|
Just $
|
||||||
soundStart (CrSound $ _crID cr) (_crPos cr) healS Nothing w
|
soundStart (CrSound $ _crID cr) (_crPos cr) healS Nothing w
|
||||||
& cWorld . creatures . ix n . crHP %~ min 10000 . (+ hp)
|
& cWorld . lWorld . creatures . ix n . crHP %~ min 10000 . (+ hp)
|
||||||
where
|
where
|
||||||
cr = _creatures (_cWorld w) IM.! n
|
cr = w ^?! cWorld . lWorld . creatures . ix n --_creatures (_cWorld w) IM.! n
|
||||||
|
|||||||
@@ -9,11 +9,11 @@ import Dodge.Data.World
|
|||||||
|
|
||||||
getItem :: Int -> World -> Maybe Item
|
getItem :: Int -> World -> Maybe Item
|
||||||
getItem itid w = do
|
getItem itid w = do
|
||||||
itpos <- w ^? cWorld . itemLocations . ix itid
|
itpos <- w ^? cWorld . lWorld . itemLocations . ix itid
|
||||||
case itpos of
|
case itpos of
|
||||||
OnFloor flitid -> w ^? cWorld . floorItems . ix flitid . flIt
|
OnFloor flitid -> w ^? cWorld . lWorld . floorItems . ix flitid . flIt
|
||||||
InInv cid invid -> w ^? cWorld . creatures . ix cid . crInv . ix invid
|
InInv cid invid -> w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
|
||||||
OnTurret mcid -> w ^? cWorld . machines . ix mcid . mcType . _McTurret . tuWeapon
|
OnTurret mcid -> w ^? cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuWeapon
|
||||||
InVoid -> Nothing
|
InVoid -> Nothing
|
||||||
|
|
||||||
pointerToItemLocation ::
|
pointerToItemLocation ::
|
||||||
@@ -22,8 +22,8 @@ pointerToItemLocation ::
|
|||||||
(Item -> f Item) ->
|
(Item -> f Item) ->
|
||||||
World ->
|
World ->
|
||||||
f World
|
f World
|
||||||
pointerToItemLocation (InInv cid invid) = cWorld . creatures . ix cid . crInv . ix invid
|
pointerToItemLocation (InInv cid invid) = cWorld . lWorld . creatures . ix cid . crInv . ix invid
|
||||||
pointerToItemLocation (OnFloor flid) = cWorld . floorItems . ix flid . flIt
|
pointerToItemLocation (OnFloor flid) = cWorld . lWorld . floorItems . ix flid . flIt
|
||||||
pointerToItemLocation _ = const pure
|
pointerToItemLocation _ = const pure
|
||||||
|
|
||||||
pointerToItem ::
|
pointerToItem ::
|
||||||
|
|||||||
@@ -9,24 +9,24 @@ initItemLocations :: CWorld -> CWorld
|
|||||||
initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
|
initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
|
||||||
|
|
||||||
initCrsItemLocations :: CWorld -> CWorld
|
initCrsItemLocations :: CWorld -> CWorld
|
||||||
initCrsItemLocations w = w' & creatures .~ newcreatures
|
initCrsItemLocations w = w' & lWorld . creatures .~ newcreatures
|
||||||
where
|
where
|
||||||
(w', newcreatures) = mapAccumR initCrItemLocations w (_creatures w)
|
(w', newcreatures) = mapAccumR initCrItemLocations w (w ^. lWorld . creatures)
|
||||||
|
|
||||||
initFlItemsLocations :: CWorld -> CWorld
|
initFlItemsLocations :: CWorld -> CWorld
|
||||||
initFlItemsLocations w = w' & floorItems .~ newfloorItems
|
initFlItemsLocations w = w' & lWorld . floorItems .~ newfloorItems
|
||||||
where
|
where
|
||||||
(w', newfloorItems) = mapAccumR initFlItemLocation w (_floorItems w)
|
(w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. lWorld . floorItems)
|
||||||
|
|
||||||
initTusItemLocations :: CWorld -> CWorld
|
initTusItemLocations :: CWorld -> CWorld
|
||||||
initTusItemLocations w = w' & machines .~ newmachines
|
initTusItemLocations w = w' & lWorld . machines .~ newmachines
|
||||||
where
|
where
|
||||||
(w', newmachines) = mapAccumR initTuItemLocation w (_machines w)
|
(w', newmachines) = mapAccumR initTuItemLocation w (w ^. lWorld . machines)
|
||||||
|
|
||||||
initSpecificCrItemLocations :: Int -> CWorld -> CWorld
|
initSpecificCrItemLocations :: Int -> CWorld -> CWorld
|
||||||
initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
|
initSpecificCrItemLocations crid w = w' & lWorld . creatures . ix crid .~ newcr
|
||||||
where
|
where
|
||||||
(w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid)
|
(w',newcr) = initCrItemLocations w (w ^?! lWorld . creatures . ix crid)
|
||||||
|
|
||||||
initCrItemLocations :: CWorld -> Creature -> (CWorld, Creature)
|
initCrItemLocations :: CWorld -> Creature -> (CWorld, Creature)
|
||||||
initCrItemLocations w cr = (w', cr & crInv .~ newinv)
|
initCrItemLocations w cr = (w', cr & crInv .~ newinv)
|
||||||
@@ -34,30 +34,30 @@ initCrItemLocations w cr = (w', cr & crInv .~ newinv)
|
|||||||
(w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
|
(w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
|
||||||
|
|
||||||
initCrItemLocation :: Creature -> Int -> CWorld -> Item -> (CWorld,Item)
|
initCrItemLocation :: Creature -> Int -> CWorld -> Item -> (CWorld,Item)
|
||||||
initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
|
initCrItemLocation cr invid w it = (w & lWorld . itemLocations . at locid ?~ loc
|
||||||
,it & itID .~ locid
|
,it & itID .~ locid
|
||||||
& itLocation .~ loc)
|
& itLocation .~ loc)
|
||||||
where
|
where
|
||||||
locid = IM.newKey (_itemLocations w)
|
locid = IM.newKey ( w ^. lWorld . itemLocations)
|
||||||
loc = InInv (_crID cr) invid
|
loc = InInv (_crID cr) invid
|
||||||
|
|
||||||
|
|
||||||
initFlItemLocation :: CWorld -> FloorItem -> (CWorld, FloorItem)
|
initFlItemLocation :: CWorld -> FloorItem -> (CWorld, FloorItem)
|
||||||
initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
|
initFlItemLocation w flit = (w & lWorld . itemLocations . at locid ?~ loc
|
||||||
, flit & flIt . itID .~ locid
|
, flit & flIt . itID .~ locid
|
||||||
& flIt . itLocation .~ loc
|
& flIt . itLocation .~ loc
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
locid = IM.newKey (_itemLocations w)
|
locid = IM.newKey (w ^. lWorld . itemLocations )
|
||||||
loc = OnFloor (_flItID flit)
|
loc = OnFloor (_flItID flit)
|
||||||
|
|
||||||
initTuItemLocation :: CWorld -> Machine -> (CWorld, Machine)
|
initTuItemLocation :: CWorld -> Machine -> (CWorld, Machine)
|
||||||
initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
|
initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
|
||||||
Nothing -> (w, mc)
|
Nothing -> (w, mc)
|
||||||
Just _ ->
|
Just _ ->
|
||||||
let locid = IM.newKey (_itemLocations w)
|
let locid = IM.newKey ( w ^. lWorld . itemLocations)
|
||||||
loc = OnTurret (_mcID mc)
|
loc = OnTurret (_mcID mc)
|
||||||
in ( w & itemLocations . at locid ?~ loc
|
in ( w & lWorld . itemLocations . at locid ?~ loc
|
||||||
, mc & mcType . _McTurret . tuWeapon . itID .~ locid
|
, mc & mcType . _McTurret . tuWeapon . itID .~ locid
|
||||||
& mcType . _McTurret . tuWeapon . itLocation .~ loc
|
& mcType . _McTurret . tuWeapon . itLocation .~ loc
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -132,7 +132,7 @@ import Picture
|
|||||||
|
|
||||||
|
|
||||||
shootLaser :: Item -> Creature -> World -> World
|
shootLaser :: Item -> Creature -> World -> World
|
||||||
shootLaser it cr = cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
|
shootLaser it cr = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
|
||||||
where
|
where
|
||||||
pos = _crPos cr
|
pos = _crPos cr
|
||||||
dir = _crDir cr
|
dir = _crDir cr
|
||||||
@@ -144,7 +144,7 @@ circleLaser :: Item -> Creature -> World -> World
|
|||||||
circleLaser it cr w
|
circleLaser it cr w
|
||||||
| hasLOSIndirect cpos pos w =
|
| hasLOSIndirect cpos pos w =
|
||||||
w
|
w
|
||||||
& cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
|
& cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
|
||||||
| otherwise = w
|
| otherwise = w
|
||||||
where
|
where
|
||||||
cpos = _crPos cr
|
cpos = _crPos cr
|
||||||
@@ -157,8 +157,8 @@ circleLaser it cr w
|
|||||||
shootDualLaser :: Item -> Creature -> World -> World
|
shootDualLaser :: Item -> Creature -> World -> World
|
||||||
shootDualLaser it cr w =
|
shootDualLaser it cr w =
|
||||||
w
|
w
|
||||||
& cWorld . newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl
|
& cWorld . lWorld . newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl
|
||||||
& cWorld . newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr
|
& cWorld . lWorld . newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr
|
||||||
where
|
where
|
||||||
itid = _itID it
|
itid = _itID it
|
||||||
dir = _crDir cr
|
dir = _crDir cr
|
||||||
@@ -200,7 +200,7 @@ dualRayAt bt itid w col dam phasev pos dir =
|
|||||||
& bmType .~ bt
|
& bmType .~ bt
|
||||||
|
|
||||||
aTractorBeam :: Item -> Creature -> World -> World
|
aTractorBeam :: Item -> Creature -> World -> World
|
||||||
aTractorBeam _ cr w = w & cWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
|
aTractorBeam _ cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
|
||||||
where
|
where
|
||||||
cpos = _crPos cr
|
cpos = _crPos cr
|
||||||
spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
|
spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
|
||||||
|
|||||||
@@ -38,7 +38,7 @@ autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item ->
|
|||||||
autoEffect eff t sid itm cr w
|
autoEffect eff t sid itm cr w
|
||||||
| _eparamInt (_eeParams (_equipEffect $ _itUse itm)) < 1 =
|
| _eparamInt (_eeParams (_equipEffect $ _itUse itm)) < 1 =
|
||||||
eff itm cr w
|
eff itm cr w
|
||||||
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
|
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
|
||||||
. itUse
|
. itUse
|
||||||
. equipEffect
|
. equipEffect
|
||||||
. eeParams
|
. eeParams
|
||||||
@@ -47,7 +47,7 @@ autoEffect eff t sid itm cr w
|
|||||||
& soundStart OnceSound (_crPos cr) sid Nothing
|
& soundStart OnceSound (_crPos cr) sid Nothing
|
||||||
| otherwise =
|
| otherwise =
|
||||||
w
|
w
|
||||||
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
|
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
|
||||||
. itUse
|
. itUse
|
||||||
. equipEffect
|
. equipEffect
|
||||||
. eeParams
|
. eeParams
|
||||||
@@ -86,10 +86,10 @@ targetRBCreatureUp it cr w t
|
|||||||
mwp = mouseWorldPos w
|
mwp = mouseWorldPos w
|
||||||
updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
|
updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
|
||||||
posFromMaybeID Nothing = Nothing
|
posFromMaybeID Nothing = Nothing
|
||||||
posFromMaybeID (Just i) = w ^? cWorld . creatures . ix i . crPos
|
posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
|
||||||
canSeeTarget = fromMaybe False $ do
|
canSeeTarget = fromMaybe False $ do
|
||||||
cid <- t ^? tgID . _Just
|
cid <- t ^? tgID . _Just
|
||||||
cpos <- w ^? cWorld . creatures . ix cid . crPos
|
cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
|
||||||
Just $ hasLOS cpos (_crPos cr) w
|
Just $ hasLOS cpos (_crPos cr) w
|
||||||
|
|
||||||
targetUpdateWith ::
|
targetUpdateWith ::
|
||||||
@@ -141,7 +141,7 @@ targetLaserUpdate _ cr w t
|
|||||||
sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
|
sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
|
||||||
ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp)
|
ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp)
|
||||||
addLaserPic =
|
addLaserPic =
|
||||||
cWorld . lasers
|
cWorld . lWorld . lasers
|
||||||
.:~ LaserStart
|
.:~ LaserStart
|
||||||
{ _lpPhaseV = 1
|
{ _lpPhaseV = 1
|
||||||
, _lpDir = _crDir cr
|
, _lpDir = _crDir cr
|
||||||
|
|||||||
@@ -6,7 +6,6 @@ import Control.Lens
|
|||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import Dodge.Item.Location
|
import Dodge.Item.Location
|
||||||
import Dodge.Payload
|
import Dodge.Payload
|
||||||
import qualified IntMapHelp as IM
|
|
||||||
|
|
||||||
explodeRemoteRocket ::
|
explodeRemoteRocket ::
|
||||||
-- | Item id
|
-- | Item id
|
||||||
@@ -17,10 +16,10 @@ explodeRemoteRocket ::
|
|||||||
World
|
World
|
||||||
explodeRemoteRocket itid pjid w =
|
explodeRemoteRocket itid pjid w =
|
||||||
w
|
w
|
||||||
& cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid]
|
& cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid]
|
||||||
& cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
|
& cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
|
||||||
& itPoint . itUse . heldUse .~ HeldDoNothing
|
& itPoint . itUse . heldUse .~ HeldDoNothing
|
||||||
& usePayload (_prjPayload thepj) (_prjPos thepj)
|
& usePayload (_prjPayload thepj) (_prjPos thepj)
|
||||||
where
|
where
|
||||||
itPoint = pointerToItemLocation $ _itemLocations (_cWorld w) IM.! itid
|
itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid-- _itemLocations (_cWorld w) IM.! itid
|
||||||
thepj = _projectiles (_cWorld w) IM.! pjid
|
thepj = w ^?! cWorld . lWorld . projectiles . ix pjid
|
||||||
|
|||||||
@@ -7,24 +7,23 @@ import Control.Lens
|
|||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import Dodge.Default
|
import Dodge.Default
|
||||||
import Geometry
|
import Geometry
|
||||||
import qualified IntMapHelp as IM
|
|
||||||
|
|
||||||
setRemoteBombScope :: Int -> Prop -> World -> World
|
setRemoteBombScope :: Int -> Prop -> World -> World
|
||||||
setRemoteBombScope itid pj w' = case _itemLocations (_cWorld w') IM.! itid of
|
setRemoteBombScope itid pj w = case w ^?! cWorld . lWorld . itemLocations . ix itid of
|
||||||
InInv cid invid ->
|
InInv cid invid ->
|
||||||
w'
|
w
|
||||||
& cWorld . creatures . ix cid . crInv . ix invid . itScope
|
& cWorld . lWorld . creatures . ix cid . crInv . ix invid . itScope
|
||||||
. scopePos
|
. scopePos
|
||||||
.~ (_prPos pj -.- _crPos (_creatures (_cWorld w') IM.! cid))
|
.~ (_prPos pj -.- (w ^?! cWorld . lWorld . creatures . ix cid . crPos))
|
||||||
& cWorld . creatures . ix cid . crInv . ix invid . itUse . heldAim . aimZoom
|
& cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse . heldAim . aimZoom
|
||||||
.~ (defaultItZoom{_itZoomMax = 0.5, _itZoomMin = 0.5})
|
.~ (defaultItZoom{_itZoomMax = 0.5, _itZoomMin = 0.5})
|
||||||
_ -> w'
|
_ -> w
|
||||||
|
|
||||||
setRemoteScope :: Int -> Point2 -> World -> World
|
setRemoteScope :: Int -> Point2 -> World -> World
|
||||||
setRemoteScope itid pos w' = case w' ^? cWorld . itemLocations . ix itid of
|
setRemoteScope itid pos w = case w ^? cWorld . lWorld . itemLocations . ix itid of
|
||||||
Just (InInv cid' invid) ->
|
Just (InInv cid' invid) ->
|
||||||
w'
|
w
|
||||||
& cWorld . creatures . ix cid' . crInv . ix invid . itScope
|
& cWorld . lWorld . creatures . ix cid' . crInv . ix invid . itScope
|
||||||
. scopePos
|
. scopePos
|
||||||
.~ (pos -.- _crPos (_creatures (_cWorld w') IM.! cid'))
|
.~ (pos -.- (w ^?! cWorld . lWorld . creatures . ix cid' . crPos))
|
||||||
_ -> w'
|
_ -> w
|
||||||
|
|||||||
@@ -8,7 +8,7 @@ import Geometry.Vector
|
|||||||
|
|
||||||
decTimMvVel :: Proj -> World -> World
|
decTimMvVel :: Proj -> World -> World
|
||||||
decTimMvVel pj =
|
decTimMvVel pj =
|
||||||
cWorld . projectiles . ix pjid
|
cWorld . lWorld . projectiles . ix pjid
|
||||||
%~ ( (prjTimer -~ 1)
|
%~ ( (prjTimer -~ 1)
|
||||||
. (prjPos %~ (+.+ vel))
|
. (prjPos %~ (+.+ vel))
|
||||||
. (prjAcc %~ rotateV rot)
|
. (prjAcc %~ rotateV rot)
|
||||||
|
|||||||
@@ -24,9 +24,9 @@ spawnCrNextTo ::
|
|||||||
Creature ->
|
Creature ->
|
||||||
World ->
|
World ->
|
||||||
World
|
World
|
||||||
spawnCrNextTo cr sCr w = w & cWorld . creatures %~ IM.insert k newCr
|
spawnCrNextTo cr sCr w = w & cWorld . lWorld . creatures %~ IM.insert k newCr
|
||||||
where
|
where
|
||||||
k = IM.newKey $ _creatures (_cWorld w)
|
k = IM.newKey $ w ^?! cWorld . lWorld . creatures -- _creatures (_cWorld w)
|
||||||
newCr =
|
newCr =
|
||||||
cr
|
cr
|
||||||
& crID .~ k
|
& crID .~ k
|
||||||
|
|||||||
@@ -90,7 +90,7 @@ type ChainEffect =
|
|||||||
|
|
||||||
lockInvFor :: Int -> ChainEffect
|
lockInvFor :: Int -> ChainEffect
|
||||||
lockInvFor i f it cr =
|
lockInvFor i f it cr =
|
||||||
f it cr . (cWorld . delayedEvents .:~ (i, UnlockInv (_crID cr)))
|
f it cr . (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv (_crID cr)))
|
||||||
. lockInv (_crID cr)
|
. lockInv (_crID cr)
|
||||||
|
|
||||||
trigDoAlso' ::
|
trigDoAlso' ::
|
||||||
@@ -138,7 +138,7 @@ withThickSmokeI eff item cr w =
|
|||||||
ammoCheckI :: ChainEffect
|
ammoCheckI :: ChainEffect
|
||||||
ammoCheckI eff itm cr w
|
ammoCheckI eff itm cr w
|
||||||
| _laLoaded ic <= 0 || not (_laPrimed ic) = w
|
| _laLoaded ic <= 0 || not (_laPrimed ic) = w
|
||||||
| otherwise = eff itm cr $ w & cWorld . creatures . ix (_crID cr) %~ crCancelReloading
|
| otherwise = eff itm cr $ w & cWorld . lWorld . creatures . ix (_crID cr) %~ crCancelReloading
|
||||||
where
|
where
|
||||||
ic = _heldConsumption $ _itUse itm
|
ic = _heldConsumption $ _itUse itm
|
||||||
|
|
||||||
@@ -148,7 +148,7 @@ ammoHammerCheck :: ChainEffect
|
|||||||
ammoHammerCheck eff it cr w
|
ammoHammerCheck eff it cr w
|
||||||
| _laLoaded ic <= 0 || not (_laPrimed ic) = w -- fromMaybe w (startReloadingWeapon cr w)
|
| _laLoaded ic <= 0 || not (_laPrimed ic) = w -- fromMaybe w (startReloadingWeapon cr w)
|
||||||
| otherwise = case it ^? itUse . heldHammer of
|
| otherwise = case it ^? itUse . heldHammer of
|
||||||
Just HammerUp -> eff it cr $ w & cWorld . creatures . ix (_crID cr) %~ crCancelReloading
|
Just HammerUp -> eff it cr $ w & cWorld . lWorld . creatures . ix (_crID cr) %~ crCancelReloading
|
||||||
_ -> w
|
_ -> w
|
||||||
where
|
where
|
||||||
ic = _heldConsumption $ _itUse it
|
ic = _heldConsumption $ _itUse it
|
||||||
@@ -192,7 +192,7 @@ rateIncAB exeffFirst exeffCont eff item cr w
|
|||||||
startRate = _rateMaxMax . _heldDelay $ _itUse item
|
startRate = _rateMaxMax . _heldDelay $ _itUse item
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
itRef = crSel cr
|
itRef = crSel cr
|
||||||
pointItem = cWorld . creatures . ix cid . crInv . ix itRef
|
pointItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
|
||||||
currentRate = _rateMax (_heldDelay (_itUse item))
|
currentRate = _rateMax (_heldDelay (_itUse item))
|
||||||
repeatFire = crWeaponReady cr && _rateTime (_heldDelay (_itUse item)) == 1
|
repeatFire = crWeaponReady cr && _rateTime (_heldDelay (_itUse item)) == 1
|
||||||
firstFire = crWeaponReady cr && _rateTime (_heldDelay (_itUse item)) == 0
|
firstFire = crWeaponReady cr && _rateTime (_heldDelay (_itUse item)) == 0
|
||||||
@@ -216,7 +216,7 @@ withWarmUp soundID f item cr w
|
|||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
itRef = crSel cr
|
itRef = crSel cr
|
||||||
pointerToItem = cWorld . creatures . ix cid . crInv . ix itRef
|
pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
|
||||||
curWarmUp = _warmTime . _heldDelay $ _itUse item
|
curWarmUp = _warmTime . _heldDelay $ _itUse item
|
||||||
maxWarmUp = _warmMax . _heldDelay $ _itUse item
|
maxWarmUp = _warmMax . _heldDelay $ _itUse item
|
||||||
|
|
||||||
@@ -291,13 +291,13 @@ afterRecoil ::
|
|||||||
-- | Recoil amount
|
-- | Recoil amount
|
||||||
Float ->
|
Float ->
|
||||||
ChainEffect
|
ChainEffect
|
||||||
afterRecoil recoilAmount eff item cr = eff item (pushback cr) . over (cWorld . creatures . ix cid) pushback
|
afterRecoil recoilAmount eff item cr = eff item (pushback cr) . over (cWorld . lWorld . creatures . ix cid) pushback
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
pushback = over crPos (+.+ rotateV (_crDir cr) (V2 ((- recoilAmount) / _crMass cr) 0))
|
pushback = over crPos (+.+ rotateV (_crDir cr) (V2 ((- recoilAmount) / _crMass cr) 0))
|
||||||
|
|
||||||
withRecoil :: ChainEffect
|
withRecoil :: ChainEffect
|
||||||
withRecoil eff it cr = eff it cr . over (cWorld . creatures . ix cid) pushback
|
withRecoil eff it cr = eff it cr . over (cWorld . lWorld . creatures . ix cid) pushback
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
recoilAmount = fromMaybe 0 $ it ^? itParams . recoil
|
recoilAmount = fromMaybe 0 $ it ^? itParams . recoil
|
||||||
@@ -313,7 +313,7 @@ withSidePushI ::
|
|||||||
withSidePushI maxSide eff item cr w =
|
withSidePushI maxSide eff item cr w =
|
||||||
eff item (push cr) $
|
eff item (push cr) $
|
||||||
w
|
w
|
||||||
& cWorld . creatures . ix cid %~ push
|
& cWorld . lWorld . creatures . ix cid %~ push
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
@@ -330,7 +330,7 @@ withSidePushAfterI ::
|
|||||||
Float ->
|
Float ->
|
||||||
ChainEffect
|
ChainEffect
|
||||||
withSidePushAfterI maxSide eff item cr w =
|
withSidePushAfterI maxSide eff item cr w =
|
||||||
over (cWorld . creatures . ix cid) push . eff item cr $
|
over (cWorld . lWorld . creatures . ix cid) push . eff item cr $
|
||||||
w
|
w
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
where
|
where
|
||||||
@@ -341,19 +341,19 @@ withSidePushAfterI maxSide eff item cr w =
|
|||||||
useAllAmmo :: ChainEffect
|
useAllAmmo :: ChainEffect
|
||||||
useAllAmmo eff item cr =
|
useAllAmmo eff item cr =
|
||||||
eff item cr
|
eff item cr
|
||||||
. (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded .~ 0)
|
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded .~ 0)
|
||||||
|
|
||||||
useAmmoUpTo :: Int -> ChainEffect
|
useAmmoUpTo :: Int -> ChainEffect
|
||||||
useAmmoUpTo amAmount eff item cr =
|
useAmmoUpTo amAmount eff item cr =
|
||||||
eff item cr
|
eff item cr
|
||||||
. ( cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded
|
. ( cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded
|
||||||
%~ (max 0 . subtract amAmount)
|
%~ (max 0 . subtract amAmount)
|
||||||
)
|
)
|
||||||
|
|
||||||
useAmmoAmount :: Int -> ChainEffect
|
useAmmoAmount :: Int -> ChainEffect
|
||||||
useAmmoAmount amAmount eff item cr =
|
useAmmoAmount amAmount eff item cr =
|
||||||
eff item cr
|
eff item cr
|
||||||
. (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded -~ amAmount)
|
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded -~ amAmount)
|
||||||
|
|
||||||
{- |
|
{- |
|
||||||
Applies a world effect after an item use cooldown check.
|
Applies a world effect after an item use cooldown check.
|
||||||
@@ -364,7 +364,7 @@ useTimeCheck f item cr w = case item ^? itUse . heldDelay . rateTime of
|
|||||||
_ -> w
|
_ -> w
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
setUseTime = cWorld . creatures . ix cid . crInv . ix (crSel cr) . itUse . heldDelay . rateTime +~ userate
|
setUseTime = cWorld . lWorld . creatures . ix cid . crInv . ix (crSel cr) . itUse . heldDelay . rateTime +~ userate
|
||||||
userate = fromMaybe 0 $ item ^? itUse . heldDelay . rateMax
|
userate = fromMaybe 0 $ item ^? itUse . heldDelay . rateMax
|
||||||
|
|
||||||
-- | Applies a world effect after a hammer position check.
|
-- | Applies a world effect after a hammer position check.
|
||||||
@@ -390,7 +390,7 @@ ammoUseCheck f item cr w
|
|||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
itRef = crSel cr
|
itRef = crSel cr
|
||||||
pointerToItem = cWorld . creatures . ix cid . crInv . ix itRef
|
pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
|
||||||
fireCondition =
|
fireCondition =
|
||||||
crWeaponReady cr
|
crWeaponReady cr
|
||||||
&& _rateTime (_heldDelay (_itUse item)) == 0
|
&& _rateTime (_heldDelay (_itUse item)) == 0
|
||||||
@@ -433,7 +433,7 @@ shootL f item cr w
|
|||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
invid = _ipInvID $ _itLocation item
|
invid = _ipInvID $ _itLocation item
|
||||||
pointerToItem = cWorld . creatures . ix cid . crInv . ix invid
|
pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix invid
|
||||||
fireCondition =
|
fireCondition =
|
||||||
_rateTime (_leftDelay (_itUse item)) == 0
|
_rateTime (_leftDelay (_itUse item)) == 0
|
||||||
&& _arLoaded (_leftConsumption (_itUse item)) > 0
|
&& _arLoaded (_leftConsumption (_itUse item)) > 0
|
||||||
@@ -444,15 +444,15 @@ withItem g f it = g it f it
|
|||||||
|
|
||||||
-- not ideal
|
-- not ideal
|
||||||
withItemUpdate' :: (Item -> Item) -> ChainEffect
|
withItemUpdate' :: (Item -> Item) -> ChainEffect
|
||||||
withItemUpdate' up f it cr = f (up it) cr . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
|
withItemUpdate' up f it cr = f (up it) cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
|
||||||
|
|
||||||
withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
|
withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
|
||||||
withItemUpdate up g f it cr = g it f it cr . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
|
withItemUpdate up g f it cr = g it f it cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
|
||||||
|
|
||||||
withTempLight :: Int -> Float -> V3 Float -> ChainEffect
|
withTempLight :: Int -> Float -> V3 Float -> ChainEffect
|
||||||
withTempLight time rad col eff item cr =
|
withTempLight time rad col eff item cr =
|
||||||
eff item cr
|
eff item cr
|
||||||
. over (cWorld . tempLightSources) (theTLS :)
|
. over (cWorld . lWorld . tempLightSources) (theTLS :)
|
||||||
where
|
where
|
||||||
theTLS = tlsTimeRadColPos time rad col (V3 x y 10)
|
theTLS = tlsTimeRadColPos time rad col (V3 x y 10)
|
||||||
V2 x y = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
|
V2 x y = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
|
||||||
@@ -578,9 +578,9 @@ torqueBefore torque feff item cr w
|
|||||||
feff item (cr & crDir +~ rot) $
|
feff item (cr & crDir +~ rot) $
|
||||||
w
|
w
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
& cWorld . creatures . ix cid . crDir +~ rot
|
& cWorld . lWorld . creatures . ix cid . crDir +~ rot
|
||||||
& cWorld . cwCam . cwcRot +~ rot
|
& cWorld . lWorld . cwCam . cwcRot +~ rot
|
||||||
| otherwise = feff item cr $ set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) w
|
| otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
(rot, g) = randomR (- torque, torque) $ _randGen w
|
(rot, g) = randomR (- torque, torque) $ _randGen w
|
||||||
@@ -599,9 +599,9 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
|
|||||||
feff item (cr & crDir +~ rot') $
|
feff item (cr & crDir +~ rot') $
|
||||||
w
|
w
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
& cWorld . creatures . ix cid . crDir +~ rot'
|
& cWorld . lWorld . creatures . ix cid . crDir +~ rot'
|
||||||
& cWorld . cwCam . cwcRot +~ rot'
|
& cWorld . lWorld . cwCam . cwcRot +~ rot'
|
||||||
| otherwise = feff item cr $ set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot') w
|
| otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot') w
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
(rot, g) = randomR (- exTorque, exTorque) $ _randGen w
|
(rot, g) = randomR (- exTorque, exTorque) $ _randGen w
|
||||||
@@ -613,8 +613,8 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
|
|||||||
withTorqueAfter :: ChainEffect
|
withTorqueAfter :: ChainEffect
|
||||||
withTorqueAfter feff item cr w
|
withTorqueAfter feff item cr w
|
||||||
-- | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w
|
-- | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w
|
||||||
| cid == 0 = set randGen g $ over (cWorld . cwCam . cwcRot) (+ rot) $ feff item cr w
|
| cid == 0 = set randGen g $ over (cWorld . lWorld . cwCam . cwcRot) (+ rot) $ feff item cr w
|
||||||
| otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) $ feff item cr w
|
| otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) $ feff item cr w
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
(rot, g) = randomR (- torque, torque) $ _randGen w
|
(rot, g) = randomR (- torque, torque) $ _randGen w
|
||||||
@@ -647,12 +647,12 @@ sideEffectOnFrame ::
|
|||||||
ChainEffect
|
ChainEffect
|
||||||
sideEffectOnFrame i sf f it cr w =
|
sideEffectOnFrame i sf f it cr w =
|
||||||
f it cr w
|
f it cr w
|
||||||
& cWorld . delayedEvents .:~ (i, sf it cr)
|
& cWorld . lWorld . delayedEvents .:~ (i, sf it cr)
|
||||||
|
|
||||||
torqueSideEffect :: Float -> Item -> Creature -> World -> World
|
torqueSideEffect :: Float -> Item -> Creature -> World -> World
|
||||||
torqueSideEffect torque _ cr w
|
torqueSideEffect torque _ cr w
|
||||||
| cid == 0 = set randGen g $ over (cWorld . cwCam . cwcRot) (+ rot) w
|
| cid == 0 = set randGen g $ over (cWorld . lWorld . cwCam . cwcRot) (+ rot) w
|
||||||
| otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) w
|
| otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
|
||||||
where
|
where
|
||||||
cid = _crID cr
|
cid = _crID cr
|
||||||
(rot, g) = randomR (- torque, torque) $ _randGen w
|
(rot, g) = randomR (- torque, torque) $ _randGen w
|
||||||
@@ -663,7 +663,7 @@ repeatOnFrames :: [Int] -> HeldMod -> ChainEffect
|
|||||||
repeatOnFrames is hm f it cr w =
|
repeatOnFrames is hm f it cr w =
|
||||||
f it cr $
|
f it cr $
|
||||||
w
|
w
|
||||||
& cWorld . delayedEvents .++~ (is <&> (,WdWdFromItCrixWdWd (it & itUse . heldMods .~ hm) (_crID cr) ItCrWdItemEffect))
|
& cWorld . lWorld . delayedEvents .++~ (is <&> (,WdWdFromItCrixWdWd (it & itUse . heldMods .~ hm) (_crID cr) ItCrWdItemEffect))
|
||||||
|
|
||||||
-- where
|
-- where
|
||||||
-- f' = fromMaybe w' $ do
|
-- f' = fromMaybe w' $ do
|
||||||
|
|||||||
@@ -89,11 +89,11 @@ useForceFieldGun itm cr w = fromMaybe w $ do
|
|||||||
wlline = (a, b)
|
wlline = (a, b)
|
||||||
return $
|
return $
|
||||||
w
|
w
|
||||||
& cWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i}
|
& cWorld . lWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i}
|
||||||
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itLocation itm)) . itParams . paramMID ?~ i
|
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itLocation itm)) . itParams . paramMID ?~ i
|
||||||
& moveWallIDUnsafe i wlline
|
& moveWallIDUnsafe i wlline
|
||||||
where
|
where
|
||||||
i = fromMaybe (IM.newKey (_walls (_cWorld w))) $ itm ^? itParams . paramMID . _Just
|
i = fromMaybe (IM.newKey (_walls (_lWorld (_cWorld w)))) $ itm ^? itParams . paramMID . _Just
|
||||||
|
|
||||||
-- grapGun = defaultGun
|
-- grapGun = defaultGun
|
||||||
-- { _itName = "grapGun"
|
-- { _itName = "grapGun"
|
||||||
|
|||||||
@@ -13,19 +13,19 @@ import LensHelp
|
|||||||
updateLampoid :: Creature -> World -> World
|
updateLampoid :: Creature -> World -> World
|
||||||
updateLampoid cr w = case cr ^?! crType . lampLSID of
|
updateLampoid cr w = case cr ^?! crType . lampLSID of
|
||||||
Nothing ->
|
Nothing ->
|
||||||
let i = IM.newKey (_lightSources (_cWorld w))
|
let i = IM.newKey (w ^. cWorld . lWorld . lightSources)
|
||||||
in w & cWorld . lightSources %~ IM.insert i (lsColPosID lcol (addZ h cpos) i)
|
in w & cWorld . lWorld . lightSources %~ IM.insert i (lsColPosID lcol (addZ h cpos) i)
|
||||||
& cWorld . creatures . ix (_crID cr) . crType . lampLSID ?~ i
|
& cWorld . lWorld . creatures . ix (_crID cr) . crType . lampLSID ?~ i
|
||||||
Just i
|
Just i
|
||||||
| _crHP cr < 0 ->
|
| _crHP cr < 0 ->
|
||||||
w
|
w
|
||||||
& explosionFlashAt cpos
|
& explosionFlashAt cpos
|
||||||
& originsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) cpos
|
& originsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) cpos
|
||||||
& cWorld . lightSources . at i .~ Nothing
|
& cWorld . lWorld . lightSources . at i .~ Nothing
|
||||||
& cWorld . creatures . at cid .~ Nothing
|
& cWorld . lWorld . creatures . at cid .~ Nothing
|
||||||
| otherwise ->
|
| otherwise ->
|
||||||
w
|
w
|
||||||
& cWorld . lightSources . ix i . lsParam . lsPos .~ addZ h cpos
|
& cWorld . lWorld . lightSources . ix i . lsParam . lsPos .~ addZ h cpos
|
||||||
& doDamage cr
|
& doDamage cr
|
||||||
where
|
where
|
||||||
cpos = _crPos cr
|
cpos = _crPos cr
|
||||||
|
|||||||
+9
-8
@@ -42,11 +42,11 @@ generateLevelFromRoomList gr' w =
|
|||||||
. doIndividualPlacements
|
. doIndividualPlacements
|
||||||
. setFloors
|
. setFloors
|
||||||
. worldToGenWorld rs'
|
. worldToGenWorld rs'
|
||||||
$ w & cWorld . walls .~ wallsFromRooms rs
|
$ w & cWorld . lWorld . walls .~ wallsFromRooms rs
|
||||||
& cWorld . cwGen . cwgGameRooms .~ gameRoomsFromRooms (IM.elems rs')
|
& cWorld . cwGen . cwgGameRooms .~ gameRoomsFromRooms (IM.elems rs')
|
||||||
& cWorld . pathGraph .~ path
|
& cWorld . lWorld . pathGraph .~ path
|
||||||
& cWorld . pnZoning .~ foldl' (flip zonePn) mempty (labNodes path)
|
& cWorld . lWorld . pnZoning .~ foldl' (flip zonePn) mempty (labNodes path)
|
||||||
& cWorld . peZoning .~ foldl' (flip zonePe) mempty (map fromEdgeTuple $ labEdges path)
|
& cWorld . lWorld . peZoning .~ foldl' (flip zonePe) mempty (map fromEdgeTuple $ labEdges path)
|
||||||
where
|
where
|
||||||
(_, path) = pairsToGraph pairPath'
|
(_, path) = pairsToGraph pairPath'
|
||||||
pairPath = foldMap _rmPath rs
|
pairPath = foldMap _rmPath rs
|
||||||
@@ -58,10 +58,10 @@ fromEdgeTuple :: (Int,Int,PathEdge) -> PathEdgeNodes
|
|||||||
fromEdgeTuple (a,b,pe) = PathEdgeNodes a b pe
|
fromEdgeTuple (a,b,pe) = PathEdgeNodes a b pe
|
||||||
|
|
||||||
randomCompass :: World -> World
|
randomCompass :: World -> World
|
||||||
randomCompass w = w & cWorld . cwCam . cwcRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
|
randomCompass w = w & cWorld . lWorld . cwCam . cwcRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
|
||||||
|
|
||||||
putFloorTiles :: GenWorld -> GenWorld
|
putFloorTiles :: GenWorld -> GenWorld
|
||||||
putFloorTiles gw = gw & gwWorld . cWorld . floorTiles .~ floorsFromGenWorld gw
|
putFloorTiles gw = gw & gwWorld . cWorld . lWorld . floorTiles .~ floorsFromGenWorld gw
|
||||||
|
|
||||||
setFloors :: GenWorld -> GenWorld
|
setFloors :: GenWorld -> GenWorld
|
||||||
setFloors = putFloorTiles . setTiles
|
setFloors = putFloorTiles . setTiles
|
||||||
@@ -139,7 +139,7 @@ setupWorldBounds w =
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
f = fromMaybe 0
|
f = fromMaybe 0
|
||||||
ps = IM.map (fst . _wlLine) $ _walls (_cWorld w)
|
ps = IM.map (fst . _wlLine) $ w ^. cWorld . lWorld . walls-- _walls (_cWorld w)
|
||||||
(minx, maxx, miny, maxy) =
|
(minx, maxx, miny, maxy) =
|
||||||
L.fold
|
L.fold
|
||||||
( (,,,)
|
( (,,,)
|
||||||
@@ -154,7 +154,8 @@ setupWorldBounds w =
|
|||||||
--polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges
|
--polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges
|
||||||
|
|
||||||
initWallZoning :: World -> World
|
initWallZoning :: World -> World
|
||||||
initWallZoning w = foldl' (flip insertWallInZones) (w & cWorld . wlZoning .~ IM.empty) (_walls (_cWorld w))
|
initWallZoning w = foldl' (flip insertWallInZones) (w & cWorld . lWorld . wlZoning .~ IM.empty)
|
||||||
|
(w ^. cWorld . lWorld . walls)
|
||||||
|
|
||||||
--makePath :: Tree Room -> [(Point2,Point2)]
|
--makePath :: Tree Room -> [(Point2,Point2)]
|
||||||
--makePath = concatMap _rmPath . flatten
|
--makePath = concatMap _rmPath . flatten
|
||||||
|
|||||||
@@ -31,14 +31,14 @@ generateWorldFromSeed i = do
|
|||||||
& cWorld . cwGen . cwgSeed .~ i
|
& cWorld . cwGen . cwgSeed .~ i
|
||||||
|
|
||||||
postGenerationProcessing :: World -> World
|
postGenerationProcessing :: World -> World
|
||||||
postGenerationProcessing w = foldl' assignPushDoors w (_doors (_cWorld w))
|
postGenerationProcessing w = foldl' assignPushDoors w (w ^. cWorld . lWorld . doors)
|
||||||
|
|
||||||
generateGraphs :: IO ()
|
generateGraphs :: IO ()
|
||||||
generateGraphs = TIO.writeFile "graph/itemCombinations.gv" combinationsDotGraph
|
generateGraphs = TIO.writeFile "graph/itemCombinations.gv" combinationsDotGraph
|
||||||
|
|
||||||
assignPushDoors :: World -> Door -> World
|
assignPushDoors :: World -> Door -> World
|
||||||
assignPushDoors w dr = case dr ^?! drPushedBy of
|
assignPushDoors w dr = case dr ^?! drPushedBy of
|
||||||
PushedBy i -> w & cWorld . doors . ix i . drPushes ?~ _drID dr
|
PushedBy i -> w & cWorld . lWorld . doors . ix i . drPushes ?~ _drID dr
|
||||||
_ -> w
|
_ -> w
|
||||||
|
|
||||||
layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room, [ConvexPoly])
|
layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room, [ConvexPoly])
|
||||||
|
|||||||
@@ -93,21 +93,21 @@ tlsTimeRadColPos t rmax col (V3 x y z) =
|
|||||||
}
|
}
|
||||||
|
|
||||||
makeTlsTimeRadColPos :: Int -> Float -> Point3 -> Point3 -> World -> World
|
makeTlsTimeRadColPos :: Int -> Float -> Point3 -> Point3 -> World -> World
|
||||||
makeTlsTimeRadColPos i rad (V3 r g b) p = cWorld . tempLightSources .:~ tlsTimeRadColPos i rad (V3 r g b) p
|
makeTlsTimeRadColPos i rad (V3 r g b) p = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos i rad (V3 r g b) p
|
||||||
|
|
||||||
destroyLS :: Int -> World -> World
|
destroyLS :: Int -> World -> World
|
||||||
destroyLS lsid w =
|
destroyLS lsid w =
|
||||||
w
|
w
|
||||||
& cWorld . lightSources . at lsid .~ Nothing
|
& cWorld . lWorld . lightSources . at lsid .~ Nothing
|
||||||
& destroyLSFlashAt p3
|
& destroyLSFlashAt p3
|
||||||
& originsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) (xyV3 p3)
|
& originsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) (xyV3 p3)
|
||||||
where
|
where
|
||||||
ls = w ^?! cWorld . lightSources . ix lsid -- unsafe
|
ls = w ^?! cWorld . lWorld . lightSources . ix lsid -- unsafe
|
||||||
p3 = _lsPos $ _lsParam ls
|
p3 = _lsPos $ _lsParam ls
|
||||||
|
|
||||||
destroyLSFlashAt :: Point3 -> World -> World
|
destroyLSFlashAt :: Point3 -> World -> World
|
||||||
destroyLSFlashAt (V3 x' y' z') =
|
destroyLSFlashAt (V3 x' y' z') =
|
||||||
cWorld . tempLightSources
|
cWorld . lWorld . tempLightSources
|
||||||
.:~ tlsTimeRadFunPos
|
.:~ tlsTimeRadFunPos
|
||||||
20
|
20
|
||||||
150
|
150
|
||||||
|
|||||||
@@ -8,7 +8,7 @@ import LensHelp
|
|||||||
|
|
||||||
createTorchLightOffset :: Creature -> Item -> Point3 -> World -> World
|
createTorchLightOffset :: Creature -> Item -> Point3 -> World -> World
|
||||||
createTorchLightOffset cr it off =
|
createTorchLightOffset cr it off =
|
||||||
cWorld . tempLightSources
|
cWorld . lWorld . tempLightSources
|
||||||
.:~ tlsTimeRadColPos
|
.:~ tlsTimeRadColPos
|
||||||
1
|
1
|
||||||
250
|
250
|
||||||
|
|||||||
@@ -7,8 +7,8 @@ import Control.Lens
|
|||||||
|
|
||||||
updateLinearShockwave :: LinearShockwave -> World -> World
|
updateLinearShockwave :: LinearShockwave -> World -> World
|
||||||
updateLinearShockwave lw w
|
updateLinearShockwave lw w
|
||||||
| t < 1 = w & cWorld . linearShockwaves %~ IM.delete lwid
|
| t < 1 = w & cWorld . lWorld . linearShockwaves %~ IM.delete lwid
|
||||||
| otherwise = w & cWorld . linearShockwaves . ix lwid . lwTimer -~ 1
|
| otherwise = w & cWorld . lWorld . linearShockwaves . ix lwid . lwTimer -~ 1
|
||||||
where
|
where
|
||||||
lwid = _lwID lw
|
lwid = _lwID lw
|
||||||
t = _lwTimer lw
|
t = _lwTimer lw
|
||||||
|
|||||||
+4
-3
@@ -29,7 +29,8 @@ useTimeScrollGun itm _ w = w & timeFlow .~ ScrollTimeFlow
|
|||||||
}
|
}
|
||||||
|
|
||||||
useRewindGun :: Item -> Creature -> World -> World
|
useRewindGun :: Item -> Creature -> World -> World
|
||||||
useRewindGun _ _ w = w
|
useRewindGun itm _ w = w & timeFlow .~ RewindLeftClick (itm ^?! itUse . leftConsumption . wpCharge)
|
||||||
|
|
||||||
--useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
|
--useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
|
||||||
-- [w'] -> w & cwTime . maybeWorld .~ Just' w'
|
-- [w'] -> w & cwTime . maybeWorld .~ Just' w'
|
||||||
-- (w' : ws) -> w
|
-- (w' : ws) -> w
|
||||||
@@ -50,7 +51,7 @@ useShrinkGun it cr w = case it ^? itParams . shrinkGunStatus of
|
|||||||
invid = _ipInvID $ _itLocation it
|
invid = _ipInvID $ _itLocation it
|
||||||
tryResize x g = maybe w g $ sizeSelf x cr w
|
tryResize x g = maybe w g $ sizeSelf x cr w
|
||||||
f isInUse cstatus =
|
f isInUse cstatus =
|
||||||
cWorld . creatures . ix (_crID cr) . crInv . ix invid
|
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid
|
||||||
%~ ((itParams . shrinkGunStatus .~ isInUse) . (itCurseStatus .~ cstatus))
|
%~ ((itParams . shrinkGunStatus .~ isInUse) . (itCurseStatus .~ cstatus))
|
||||||
|
|
||||||
boostSelfL ::
|
boostSelfL ::
|
||||||
@@ -107,7 +108,7 @@ addBoostShockwave ::
|
|||||||
World ->
|
World ->
|
||||||
World
|
World
|
||||||
addBoostShockwave pjid p v w =
|
addBoostShockwave pjid p v w =
|
||||||
w & cWorld . linearShockwaves
|
w & cWorld . lWorld . linearShockwaves
|
||||||
%~ IM.insertWith f pjid thePJ
|
%~ IM.insertWith f pjid thePJ
|
||||||
where
|
where
|
||||||
thePJ =
|
thePJ =
|
||||||
|
|||||||
@@ -24,9 +24,9 @@ machineUpdateLiveDieEff ::
|
|||||||
machineUpdateLiveDieEff livef dief mc
|
machineUpdateLiveDieEff livef dief mc
|
||||||
| _mcHP mc < 1 =
|
| _mcHP mc < 1 =
|
||||||
dief mc
|
dief mc
|
||||||
. (cWorld . machines %~ IM.delete mcid)
|
. (cWorld . lWorld . machines %~ IM.delete mcid)
|
||||||
. deleteWallIDs (_mcWallIDs mc)
|
. deleteWallIDs (_mcWallIDs mc)
|
||||||
| otherwise = livef mc . (cWorld . machines . ix mcid %~ ((mcDamage .~ []) . (mcHP -~ dams)))
|
| otherwise = livef mc . (cWorld . lWorld . machines . ix mcid %~ ((mcDamage .~ []) . (mcHP -~ dams)))
|
||||||
where
|
where
|
||||||
dams = sum $ map _dmAmount $ _mcDamage mc
|
dams = sum $ map _dmAmount $ _mcDamage mc
|
||||||
mcid = _mcID mc
|
mcid = _mcID mc
|
||||||
@@ -39,9 +39,9 @@ machineUpdateDeathEff ::
|
|||||||
machineUpdateDeathEff f mc
|
machineUpdateDeathEff f mc
|
||||||
| _mcHP mc < 1 =
|
| _mcHP mc < 1 =
|
||||||
f mc
|
f mc
|
||||||
. (cWorld . machines %~ IM.delete mcid)
|
. (cWorld . lWorld . machines %~ IM.delete mcid)
|
||||||
. deleteWallIDs (_mcWallIDs mc)
|
. deleteWallIDs (_mcWallIDs mc)
|
||||||
| otherwise = cWorld . machines . ix mcid %~ ((mcDamage .~ []) . (mcHP -~ dams))
|
| otherwise = cWorld . lWorld . machines . ix mcid %~ ((mcDamage .~ []) . (mcHP -~ dams))
|
||||||
where
|
where
|
||||||
dams = sum $ map _dmAmount $ _mcDamage mc
|
dams = sum $ map _dmAmount $ _mcDamage mc
|
||||||
mcid = _mcID mc
|
mcid = _mcID mc
|
||||||
|
|||||||
@@ -4,7 +4,7 @@ import Dodge.Data.World
|
|||||||
import LensHelp
|
import LensHelp
|
||||||
|
|
||||||
basicMachineApplyDamage :: Machine -> World -> World
|
basicMachineApplyDamage :: Machine -> World -> World
|
||||||
basicMachineApplyDamage mc = cWorld . machines . ix mcid %~ ((mcDamage .~ []) . (mcHP -~ dams))
|
basicMachineApplyDamage mc = cWorld . lWorld . machines . ix mcid %~ ((mcDamage .~ []) . (mcHP -~ dams))
|
||||||
where
|
where
|
||||||
dams = sum $ map _dmAmount $ _mcDamage mc
|
dams = sum $ map _dmAmount $ _mcDamage mc
|
||||||
mcid = _mcID mc
|
mcid = _mcID mc
|
||||||
|
|||||||
@@ -11,7 +11,7 @@ import LensHelp
|
|||||||
|
|
||||||
destroyMachine :: Machine -> World -> World
|
destroyMachine :: Machine -> World -> World
|
||||||
destroyMachine mc =
|
destroyMachine mc =
|
||||||
(cWorld . machines %~ IM.delete (_mcID mc))
|
(cWorld . lWorld . machines %~ IM.delete (_mcID mc))
|
||||||
. deleteWallIDs (_mcWallIDs mc)
|
. deleteWallIDs (_mcWallIDs mc)
|
||||||
. makeExplosionAt (_mcPos mc)
|
. makeExplosionAt (_mcPos mc)
|
||||||
. mcKillTerm mc
|
. mcKillTerm mc
|
||||||
@@ -26,7 +26,7 @@ destroyMcType mt mc = case mt of
|
|||||||
mcKillTerm :: Machine -> World -> World
|
mcKillTerm :: Machine -> World -> World
|
||||||
mcKillTerm mc w = fromMaybe w $ do
|
mcKillTerm mc w = fromMaybe w $ do
|
||||||
tmid <- mc ^? mcMounts . ix ObTerminal
|
tmid <- mc ^? mcMounts . ix ObTerminal
|
||||||
tm <- w ^? cWorld . terminals . ix tmid
|
tm <- w ^? cWorld . lWorld . terminals . ix tmid
|
||||||
return $
|
return $
|
||||||
w
|
w
|
||||||
& doTmWdWd (_tmDeathEffect tm) tm
|
& doTmWdWd (_tmDeathEffect tm) tm
|
||||||
@@ -34,4 +34,4 @@ mcKillTerm mc w = fromMaybe w $ do
|
|||||||
mcKillBut :: Machine -> World -> World
|
mcKillBut :: Machine -> World -> World
|
||||||
mcKillBut mc w = fromMaybe w $ do
|
mcKillBut mc w = fromMaybe w $ do
|
||||||
btid <- mc ^? mcMounts . ix ObButton
|
btid <- mc ^? mcMounts . ix ObButton
|
||||||
return $ w & cWorld . buttons . at btid .~ Nothing
|
return $ w & cWorld . lWorld . buttons . at btid .~ Nothing
|
||||||
|
|||||||
+12
-12
@@ -36,7 +36,7 @@ updateTurret rotSpeed mc w =
|
|||||||
& elecDamBranch
|
& elecDamBranch
|
||||||
where
|
where
|
||||||
dodamage =
|
dodamage =
|
||||||
cWorld . machines . ix mcid
|
cWorld . lWorld . machines . ix mcid
|
||||||
%~ ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect])
|
%~ ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect])
|
||||||
. (mcHP -~ dam)
|
. (mcHP -~ dam)
|
||||||
)
|
)
|
||||||
@@ -51,12 +51,12 @@ updateTurret rotSpeed mc w =
|
|||||||
dam = sum $ map _dmAmount dams
|
dam = sum $ map _dmAmount dams
|
||||||
elecDam = sum $ map _dmAmount elecDams
|
elecDam = sum $ map _dmAmount elecDams
|
||||||
doTurn
|
doTurn
|
||||||
| seesYou = cWorld . machines . ix mcid . mcType . _McTurret . tuDir %~ turnTo rotSpeed mcpos ypos
|
| seesYou = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuDir %~ turnTo rotSpeed mcpos ypos
|
||||||
| otherwise = id
|
| otherwise = id
|
||||||
closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
|
closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
|
||||||
updateFiringStatus
|
updateFiringStatus
|
||||||
| closeFireAngle = cWorld . machines . ix mcid . mcType . _McTurret . tuFireTime .~ 20
|
| closeFireAngle = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime .~ 20
|
||||||
| otherwise = cWorld . machines . ix mcid . mcType . _McTurret . tuFireTime %~ (max 0 . subtract 1)
|
| otherwise = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime %~ (max 0 . subtract 1)
|
||||||
|
|
||||||
mcUseItem :: Machine -> World -> World
|
mcUseItem :: Machine -> World -> World
|
||||||
mcUseItem mc = fromMaybe id $ do
|
mcUseItem mc = fromMaybe id $ do
|
||||||
@@ -70,7 +70,7 @@ mcSensorTriggerUpdate :: Sensor -> Machine -> World -> World
|
|||||||
mcSensorTriggerUpdate se mc = fromMaybe id $ do
|
mcSensorTriggerUpdate se mc = fromMaybe id $ do
|
||||||
trid <- mc ^? mcMounts . ix ObTrigger
|
trid <- mc ^? mcMounts . ix ObTrigger
|
||||||
bval <- mcTriggerVal se
|
bval <- mcTriggerVal se
|
||||||
return $ cWorld . triggers . ix trid ||~ bval
|
return $ cWorld . lWorld . triggers . ix trid ||~ bval
|
||||||
|
|
||||||
mcTriggerVal :: Sensor -> Maybe Bool
|
mcTriggerVal :: Sensor -> Maybe Bool
|
||||||
mcTriggerVal se = case se of
|
mcTriggerVal se = case se of
|
||||||
@@ -94,7 +94,7 @@ mcApplyDamage ds mc = case mc ^? mcType . _McSensor of
|
|||||||
_ -> mcpointer
|
_ -> mcpointer
|
||||||
%~ (mcDamage .~ [])
|
%~ (mcDamage .~ [])
|
||||||
where
|
where
|
||||||
mcpointer = cWorld . machines . ix (_mcID mc)
|
mcpointer = cWorld . lWorld . machines . ix (_mcID mc)
|
||||||
|
|
||||||
mcSensorUpdate :: Sensor -> Machine -> World -> World
|
mcSensorUpdate :: Sensor -> Machine -> World -> World
|
||||||
mcSensorUpdate se mc w = case se of
|
mcSensorUpdate se mc w = case se of
|
||||||
@@ -110,13 +110,13 @@ mcProximitySensorUpdate mc w = case ( _proxStatus sens
|
|||||||
(_, True, _, _) -> w
|
(_, True, _, _) -> w
|
||||||
(_, False, True, True) ->
|
(_, False, True, True) ->
|
||||||
w
|
w
|
||||||
& cWorld . machines . ix (_mcID mc) . mcType . _McSensor . sensToggle .~ True
|
& cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . sensToggle .~ True
|
||||||
& playsound dedaS
|
& playsound dedaS
|
||||||
& cWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose
|
& cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose
|
||||||
(NotClose, _, False, True) ->
|
(NotClose, _, False, True) ->
|
||||||
w & playsound dedumS
|
w & playsound dedumS
|
||||||
& cWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose
|
& cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose
|
||||||
(_, _, _, False) -> w & cWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ NotClose
|
(_, _, _, False) -> w & cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ NotClose
|
||||||
_ -> w
|
_ -> w
|
||||||
where
|
where
|
||||||
playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
|
playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
|
||||||
@@ -133,7 +133,7 @@ mcProxTest mc w = case mc ^? mcType . _McSensor . proxRequirement of
|
|||||||
|
|
||||||
senseDamage :: Int -> DamageType -> Machine -> World -> World
|
senseDamage :: Int -> DamageType -> Machine -> World -> World
|
||||||
senseDamage threshold dt mc =
|
senseDamage threshold dt mc =
|
||||||
(cWorld . machines . ix mcid %~ upmc)
|
(cWorld . lWorld . machines . ix mcid %~ upmc)
|
||||||
. updatels
|
. updatels
|
||||||
where
|
where
|
||||||
upmc = mcType . _McSensor . sensAmount %~ min (100 * threshold) . max 0 . (+ newsense)
|
upmc = mcType . _McSensor . sensAmount %~ min (100 * threshold) . max 0 . (+ newsense)
|
||||||
@@ -146,7 +146,7 @@ senseDamage threshold dt mc =
|
|||||||
ni = fromIntegral (mc ^?! mcType . _McSensor . sensAmount) / fromIntegral threshold
|
ni = fromIntegral (mc ^?! mcType . _McSensor . sensAmount) / fromIntegral threshold
|
||||||
updatels = fromMaybe id $ do
|
updatels = fromMaybe id $ do
|
||||||
lsid <- mc ^? mcMounts . ix ObLightSource
|
lsid <- mc ^? mcMounts . ix ObLightSource
|
||||||
return $ cWorld . lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni
|
return $ cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni
|
||||||
|
|
||||||
damageUsing :: DamageType -> Damage -> Either Int Int
|
damageUsing :: DamageType -> Damage -> Either Int Int
|
||||||
damageUsing dt dm
|
damageUsing dt dm
|
||||||
|
|||||||
@@ -7,11 +7,11 @@ import Control.Lens
|
|||||||
doModificationEffect :: MdWdWd -> Modification -> World -> World
|
doModificationEffect :: MdWdWd -> Modification -> World -> World
|
||||||
doModificationEffect mww = case mww of
|
doModificationEffect mww = case mww of
|
||||||
MdWdId -> const id
|
MdWdId -> const id
|
||||||
MdTrigIf ftrue ffalse -> \md w -> if w ^?! cWorld . triggers . ix (_mdExternalID2 md)
|
MdTrigIf ftrue ffalse -> \md w -> if w ^?! cWorld . lWorld . triggers . ix (_mdExternalID2 md)
|
||||||
then w & doModificationEffect ftrue md
|
then w & doModificationEffect ftrue md
|
||||||
else w & doModificationEffect ffalse md
|
else w & doModificationEffect ffalse md
|
||||||
-- note this uses the second external ix
|
-- note this uses the second external ix
|
||||||
MdSetLSCol col -> \md w -> w & cWorld . lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ col
|
MdSetLSCol col -> \md w -> w & cWorld . lWorld . lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ col
|
||||||
-- note this uses the first external ix, this should be made more
|
-- note this uses the first external ix, this should be made more
|
||||||
-- transparent
|
-- transparent
|
||||||
MdFlickerUpdate -> flickerUpdate
|
MdFlickerUpdate -> flickerUpdate
|
||||||
|
|||||||
+10
-6
@@ -29,14 +29,16 @@ import Geometry
|
|||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
|
|
||||||
getNodePos :: Int -> World -> Maybe Point2
|
getNodePos :: Int -> World -> Maybe Point2
|
||||||
getNodePos i w = _pathGraph (_cWorld w) `lab` i
|
--getNodePos i w = _pathGraph (_cWorld w) `lab` i
|
||||||
|
getNodePos i w = (w ^. cWorld . lWorld . pathGraph) `lab` i
|
||||||
|
|
||||||
makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int]
|
makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int]
|
||||||
makePathBetween a b w = do
|
makePathBetween a b w = do
|
||||||
-- join $ sp <$> a' <*> b' <*> return (_pathGraph w)
|
-- join $ sp <$> a' <*> b' <*> return (_pathGraph w)
|
||||||
na <- walkableNodeNear w a
|
na <- walkableNodeNear w a
|
||||||
nb <- walkableNodeNear w b
|
nb <- walkableNodeNear w b
|
||||||
sp na nb (second _peDist (efilter (not . pathEdgeObstructed . (^. _3)) $ _pathGraph (_cWorld w)))
|
sp na nb (second _peDist (efilter (not . pathEdgeObstructed . (^. _3)) $ w ^. cWorld . lWorld . pathGraph))
|
||||||
|
--_pathGraph (_cWorld w)))
|
||||||
|
|
||||||
pathEdgeObstructed :: PathEdge -> Bool
|
pathEdgeObstructed :: PathEdge -> Bool
|
||||||
pathEdgeObstructed pe = DoorObstacle `Set.member` obs || BlockObstacle `Set.member` obs
|
pathEdgeObstructed pe = DoorObstacle `Set.member` obs || BlockObstacle `Set.member` obs
|
||||||
@@ -47,15 +49,17 @@ walkableNodeNear :: World -> Point2 -> Maybe Int
|
|||||||
{-# INLINE walkableNodeNear #-}
|
{-# INLINE walkableNodeNear #-}
|
||||||
walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear
|
walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear
|
||||||
where
|
where
|
||||||
nodesNear = zonesExtract (w ^. cWorld . pnZoning) $ zonesAroundPoint pnZoneSize p
|
nodesNear = zonesExtract (w ^. cWorld . lWorld . pnZoning) $ zonesAroundPoint pnZoneSize p
|
||||||
|
|
||||||
makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
|
makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
|
||||||
makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph (_cWorld w)) <$> makePathBetween a b w
|
--makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph (_cWorld w)) <$> makePathBetween a b w
|
||||||
|
makePathBetweenPs a b w = mapMaybe (lab $ w ^. cWorld . lWorld . pathGraph) <$> makePathBetween a b w
|
||||||
|
|
||||||
bfsNodePoints :: Int -> World -> [Point2]
|
bfsNodePoints :: Int -> World -> [Point2]
|
||||||
bfsNodePoints n w = mapMaybe (lab g) $ bfs n g
|
bfsNodePoints n w = mapMaybe (lab g) $ bfs n g
|
||||||
where
|
where
|
||||||
g = _pathGraph (_cWorld w)
|
--g = _pathGraph (_cWorld w)
|
||||||
|
g = w ^. cWorld . lWorld . pathGraph
|
||||||
|
|
||||||
pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2
|
pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2
|
||||||
pointTowardsImpulse a b w = (find (flip (isWalkable a) w) . reverse) =<< makePathBetweenPs a b w
|
pointTowardsImpulse a b w = (find (flip (isWalkable a) w) . reverse) =<< makePathBetweenPs a b w
|
||||||
@@ -134,7 +138,7 @@ addEdges nodemap gr = foldl' f (mempty, gr)
|
|||||||
|
|
||||||
obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World -> (World, Set PathEdgeNodes)
|
obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World -> (World, Set PathEdgeNodes)
|
||||||
obstructPathsCrossing obstacletype sp' ep w =
|
obstructPathsCrossing obstacletype sp' ep w =
|
||||||
( w & cWorld . pathGraph %~ updateedges
|
( w & cWorld . lWorld . pathGraph %~ updateedges
|
||||||
, es
|
, es
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|||||||
@@ -19,9 +19,9 @@ fixedSizePicAt pic p w =
|
|||||||
. scale theScale theScale
|
. scale theScale theScale
|
||||||
$ pic
|
$ pic
|
||||||
where
|
where
|
||||||
campos = w ^. cWorld . cwCam . cwcViewFrom
|
campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom
|
||||||
v = p -.- campos
|
v = p -.- campos
|
||||||
theScale = 1 / (w ^. cWorld . cwCam . cwcZoom)
|
theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)
|
||||||
(V2 x y) = campos +.+ v
|
(V2 x y) = campos +.+ v
|
||||||
|
|
||||||
fixedSizePicClamp ::
|
fixedSizePicClamp ::
|
||||||
@@ -41,11 +41,11 @@ fixedSizePicClamp xbord ybord pic p cfig w =
|
|||||||
. scale theScale theScale
|
. scale theScale theScale
|
||||||
$ pic
|
$ pic
|
||||||
where
|
where
|
||||||
r = negate $ w ^. cWorld . cwCam . cwcRot
|
r = negate $ w ^. cWorld . lWorld . cwCam . cwcRot
|
||||||
z = w ^. cWorld . cwCam . cwcZoom
|
z = w ^. cWorld . lWorld . cwCam . cwcZoom
|
||||||
campos = w ^. cWorld . cwCam . cwcViewFrom
|
campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom
|
||||||
v = p -.- campos
|
v = p -.- campos
|
||||||
theScale = 1 / (w ^. cWorld . cwCam . cwcZoom)
|
theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)
|
||||||
(V2 x y) = campos +.+ rotateV (negate r) (V2 xr' yr')
|
(V2 x y) = campos +.+ rotateV (negate r) (V2 xr' yr')
|
||||||
(V2 xr yr) = rotateV r v
|
(V2 xr yr) = rotateV r v
|
||||||
xr' = absClamp ((halfWidth cfig - fromIntegral xbord) / z) xr
|
xr' = absClamp ((halfWidth cfig - fromIntegral xbord) / z) xr
|
||||||
@@ -75,8 +75,8 @@ fixedSizePicClampArrow xbord ybord pic p cfig w =
|
|||||||
Nothing -> blank
|
Nothing -> blank
|
||||||
Just bp -> thickLine 5 [bp, fromMaybe p windowPoint]
|
Just bp -> thickLine 5 [bp, fromMaybe p windowPoint]
|
||||||
(V2 x y) = fromMaybe p borderPoint
|
(V2 x y) = fromMaybe p borderPoint
|
||||||
campos = w ^. cWorld . cwCam . cwcCenter
|
campos = w ^. cWorld . lWorld . cwCam . cwcCenter
|
||||||
theScale = 1 / (w ^. cWorld . cwCam . cwcZoom)
|
theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)
|
||||||
|
|
||||||
absClamp ::
|
absClamp ::
|
||||||
-- | clamping value, assumed positive
|
-- | clamping value, assumed positive
|
||||||
|
|||||||
@@ -23,14 +23,14 @@ flickerMod pl =
|
|||||||
|
|
||||||
flickerUpdate :: Modification -> World -> World
|
flickerUpdate :: Modification -> World -> World
|
||||||
flickerUpdate md w
|
flickerUpdate md w
|
||||||
| _mdTimer md > 0 = w & cWorld . modifications . ix mdid . mdTimer -~ 1
|
| _mdTimer md > 0 = w & cWorld . lWorld . modifications . ix mdid . mdTimer -~ 1
|
||||||
| otherwise =
|
| otherwise =
|
||||||
w & cWorld . lightSources . ix lsid . lsParam . lsCol .~ mdcol
|
w & cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ mdcol
|
||||||
& cWorld . modifications . ix mdid
|
& cWorld . lWorld . modifications . ix mdid
|
||||||
%~ ((mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not))
|
%~ ((mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not))
|
||||||
where
|
where
|
||||||
mdcol = _mdPoint3 md
|
mdcol = _mdPoint3 md
|
||||||
lscol = w ^?! cWorld . lightSources . ix lsid . lsParam . lsCol -- _lsCol $ _lsParam $ _lightSources w IM.! lsid
|
lscol = w ^?! cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol -- _lsCol $ _lsParam $ _lightSources w IM.! lsid
|
||||||
lsid = _mdExternalID md
|
lsid = _mdExternalID md
|
||||||
mdid = _mdID md
|
mdid = _mdID md
|
||||||
timerange
|
timerange
|
||||||
|
|||||||
@@ -31,10 +31,10 @@ putTerminal mc tm =
|
|||||||
where
|
where
|
||||||
setids tmpl btpl mcpl w =
|
setids tmpl btpl mcpl w =
|
||||||
w
|
w
|
||||||
& cWorld . terminals . ix tmid . tmButtonID .~ btid
|
& cWorld . lWorld . terminals . ix tmid . tmButtonID .~ btid
|
||||||
& cWorld . terminals . ix tmid . tmMachineID .~ mcid
|
& cWorld . lWorld . terminals . ix tmid . tmMachineID .~ mcid
|
||||||
& cWorld . machines . ix mcid . mcMounts . at ObTerminal ?~ tmid
|
& cWorld . lWorld . machines . ix mcid . mcMounts . at ObTerminal ?~ tmid
|
||||||
& cWorld . buttons . ix btid . btTermMID ?~ tmid
|
& cWorld . lWorld . buttons . ix btid . btTermMID ?~ tmid
|
||||||
where
|
where
|
||||||
tmid = fromJust (_plMID tmpl)
|
tmid = fromJust (_plMID tmpl)
|
||||||
btid = fromJust (_plMID btpl)
|
btid = fromJust (_plMID btpl)
|
||||||
|
|||||||
@@ -94,21 +94,21 @@ placeSpotID ps pt gw =
|
|||||||
-- the Int here is some id that is assigned when the placement is placed
|
-- the Int here is some id that is assigned when the placement is placed
|
||||||
placeSpotID' :: PlacementSpot -> PSType -> World -> (Int, World)
|
placeSpotID' :: PlacementSpot -> PSType -> World -> (Int, World)
|
||||||
placeSpotID' ps pt w = case pt of
|
placeSpotID' ps pt w = case pt of
|
||||||
PutTrigger cnd -> plNewID (cWorld . triggers) cnd w
|
PutTrigger cnd -> plNewID (cWorld . lWorld . triggers) cnd w
|
||||||
PutMod mdi -> plNewUpID (cWorld . modifications) mdID mdi w
|
PutMod mdi -> plNewUpID (cWorld . lWorld . modifications) mdID mdi w
|
||||||
PutProp prp -> plNewUpID (cWorld . props) prID (mvProp p rot prp) w
|
PutProp prp -> plNewUpID (cWorld . lWorld . props) prID (mvProp p rot prp) w
|
||||||
PutButton bt -> plNewUpID (cWorld . buttons) btID (mvButton p rot bt) w
|
PutButton bt -> plNewUpID (cWorld . lWorld . buttons) btID (mvButton p rot bt) w
|
||||||
PutTerminal tm -> plNewUpID (cWorld . terminals) tmID tm w
|
PutTerminal tm -> plNewUpID (cWorld . lWorld . terminals) tmID tm w
|
||||||
PutFlIt itm -> plNewUpID (cWorld . floorItems) flItID (createFlIt p rot itm) w
|
PutFlIt itm -> plNewUpID (cWorld . lWorld . floorItems) flItID (createFlIt p rot itm) w
|
||||||
PutCrit cr -> plNewUpID (cWorld . creatures) crID (mvCr p rot cr) w
|
PutCrit cr -> plNewUpID (cWorld . lWorld . creatures) crID (mvCr p rot cr) w
|
||||||
PutForeground fs -> plNewUpID (cWorld . foregroundShapes) fsID (mvFS p rot fs) w
|
PutForeground fs -> plNewUpID (cWorld . lWorld . foregroundShapes) fsID (mvFS p rot fs) w
|
||||||
PutDecoration pic -> plNewID (cWorld . decorations) (shiftDec p rot pic) w
|
PutDecoration pic -> plNewID (cWorld . lWorld . decorations) (shiftDec p rot pic) w
|
||||||
PutMachine pps mc wl -> plMachine (map doShift pps) mc wl p rot w
|
PutMachine pps mc wl -> plMachine (map doShift pps) mc wl p rot w
|
||||||
PutLS ls -> plNewUpID (cWorld . lightSources) lsID (mvLS p' rot ls) w
|
PutLS ls -> plNewUpID (cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
|
||||||
PutPPlate pp -> plNewUpID (cWorld . pressPlates) ppID (mvPP p rot pp) w
|
PutPPlate pp -> plNewUpID (cWorld . lWorld . pressPlates) ppID (mvPP p rot pp) w
|
||||||
RandPS rgn -> evaluateRandPS rgn ps w
|
RandPS rgn -> evaluateRandPS rgn ps w
|
||||||
PutDoor col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
|
PutDoor col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
|
||||||
PutCoord cp -> plNewID (cWorld . coordinates) (doShift cp) w
|
PutCoord cp -> plNewID (cWorld . lWorld . coordinates) (doShift cp) w
|
||||||
PutSlideDr wl dr eo off a b ->
|
PutSlideDr wl dr eo off a b ->
|
||||||
plSlideDoor wl dr eo off (doShift a) (doShift b) w
|
plSlideDoor wl dr eo off (doShift a) (doShift b) w
|
||||||
PutBlock bl wl ps' ->
|
PutBlock bl wl ps' ->
|
||||||
@@ -160,7 +160,7 @@ placeWallPoly qs wl w = foldl' (addPane wl) w pairs
|
|||||||
addPane :: Wall -> World -> (Point2, Point2) -> World
|
addPane :: Wall -> World -> (Point2, Point2) -> World
|
||||||
--addPane wl w l = w & walls %~ IM.insert wlid (wl { _wlLine = l, _wlID = wlid })
|
--addPane wl w l = w & walls %~ IM.insert wlid (wl { _wlLine = l, _wlID = wlid })
|
||||||
addPane wl w l =
|
addPane wl w l =
|
||||||
w & plNew (cWorld . walls) wlID (wl & wlLine .~ l)
|
w & plNew (cWorld . lWorld . walls) wlID (wl & wlLine .~ l)
|
||||||
& fst . uncurry (obstructPathsCrossing WallObstacle) l
|
& fst . uncurry (obstructPathsCrossing WallObstacle) l
|
||||||
|
|
||||||
-- where
|
-- where
|
||||||
@@ -188,14 +188,13 @@ mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +.+) . rotateV a))
|
|||||||
plMachine :: [Point2] -> Machine -> Wall -> Point2 -> Float -> World -> (Int, World)
|
plMachine :: [Point2] -> Machine -> Wall -> Point2 -> Float -> World -> (Int, World)
|
||||||
plMachine wallpoly mc wl p rot gw =
|
plMachine wallpoly mc wl p rot gw =
|
||||||
( mcid
|
( mcid
|
||||||
, gw & cWorld . machines %~ addMc
|
, gw & cWorld . lWorld . machines %~ addMc
|
||||||
& cWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
|
& cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
col = _mcColor mc
|
col = _mcColor mc
|
||||||
w' = gw
|
mcid = IM.newKey $ gw ^. cWorld . lWorld . machines
|
||||||
mcid = IM.newKey $ _machines (_cWorld w')
|
wlid = IM.newKey $ gw ^. cWorld . lWorld . walls
|
||||||
wlid = IM.newKey $ _walls (_cWorld w')
|
|
||||||
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
|
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
|
||||||
--addMc = IM.insert mcid (mc {_mcPos = centroid wallpoly,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids})
|
--addMc = IM.insert mcid (mc {_mcPos = centroid wallpoly,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids})
|
||||||
addMc = IM.insert mcid (mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids})
|
addMc = IM.insert mcid (mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids})
|
||||||
|
|||||||
@@ -27,7 +27,7 @@ plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon"
|
|||||||
plBlock (p : ps) bl wl w =
|
plBlock (p : ps) bl wl w =
|
||||||
(,) blid $
|
(,) blid $
|
||||||
w
|
w
|
||||||
& cWorld . blocks . at blid
|
& cWorld . lWorld . blocks . at blid
|
||||||
?~ bl
|
?~ bl
|
||||||
{ _blID = blid
|
{ _blID = blid
|
||||||
, _blWallIDs = IS.fromList is
|
, _blWallIDs = IS.fromList is
|
||||||
@@ -36,9 +36,9 @@ plBlock (p : ps) bl wl w =
|
|||||||
}
|
}
|
||||||
& insertWalls blid wls
|
& insertWalls blid wls
|
||||||
where
|
where
|
||||||
blid = IM.newKey $ _blocks (_cWorld w)
|
blid = IM.newKey $ w ^. cWorld . lWorld . blocks
|
||||||
lns = zip (p : ps) (ps ++ [p])
|
lns = zip (p : ps) (ps ++ [p])
|
||||||
i = IM.newKey $ _walls (_cWorld w)
|
i = IM.newKey $ w ^. cWorld . lWorld . walls
|
||||||
is = [i .. i + length lns -1]
|
is = [i .. i + length lns -1]
|
||||||
wls =
|
wls =
|
||||||
zipWith
|
zipWith
|
||||||
@@ -72,12 +72,12 @@ plLineBlock basePane blwidth a b gw =
|
|||||||
cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block
|
cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block
|
||||||
cornersAt p = fmap ((p +.+) . rotateV (argV (b -.- a))) cornerPoints
|
cornersAt p = fmap ((p +.+) . rotateV (argV (b -.- a))) cornerPoints
|
||||||
linesAt p = loopPairs $ cornersAt p
|
linesAt p = loopPairs $ cornersAt p
|
||||||
wlid = IM.newKey $ _walls (_cWorld gw)
|
wlid = IM.newKey $ gw ^. cWorld . lWorld . walls
|
||||||
blid = IM.newKey $ _blocks (_cWorld gw)
|
blid = IM.newKey $ gw ^. cWorld . lWorld . blocks
|
||||||
insertBlock (i, p) =
|
insertBlock (i, p) =
|
||||||
insertWalls (i + blid) (makeWallAt p i)
|
insertWalls (i + blid) (makeWallAt p i)
|
||||||
. over
|
. over
|
||||||
(cWorld . blocks)
|
(cWorld . lWorld . blocks)
|
||||||
( IM.insert
|
( IM.insert
|
||||||
(i + blid)
|
(i + blid)
|
||||||
Block
|
Block
|
||||||
@@ -115,11 +115,11 @@ plLineBlock basePane blwidth a b gw =
|
|||||||
|
|
||||||
-- | Must be done after inserting the block
|
-- | Must be done after inserting the block
|
||||||
insertWalls :: Int -> [Wall] -> World -> World
|
insertWalls :: Int -> [Wall] -> World -> World
|
||||||
insertWalls blid wls w = w' & cWorld . blocks . ix blid . blObstructs .~ Set.unions paths
|
insertWalls blid wls w = w' & cWorld . lWorld . blocks . ix blid . blObstructs .~ Set.unions paths
|
||||||
where
|
where
|
||||||
(w', paths) = mapAccumR (flip insertWall) w wls
|
(w', paths) = mapAccumR (flip insertWall) w wls
|
||||||
|
|
||||||
insertWall :: Wall -> World -> (World, Set PathEdgeNodes)
|
insertWall :: Wall -> World -> (World, Set PathEdgeNodes)
|
||||||
insertWall wl =
|
insertWall wl =
|
||||||
uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl)
|
uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl)
|
||||||
. (cWorld . walls . at (_wlID wl) ?~ wl)
|
. (cWorld . lWorld . walls . at (_wlID wl) ?~ wl)
|
||||||
|
|||||||
@@ -29,9 +29,9 @@ plDoor ::
|
|||||||
[(Point2, Point2)] ->
|
[(Point2, Point2)] ->
|
||||||
World ->
|
World ->
|
||||||
(Int, World)
|
(Int, World)
|
||||||
plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
|
plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
|
||||||
where
|
where
|
||||||
drid = IM.newKey $ _doors (_cWorld gw)
|
drid = IM.newKey $ _doors (_lWorld (_cWorld gw))
|
||||||
addDoor =
|
addDoor =
|
||||||
IM.insert drid $
|
IM.insert drid $
|
||||||
defaultDoor
|
defaultDoor
|
||||||
@@ -46,14 +46,14 @@ plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . doors %~ addDoor) --
|
|||||||
, _drObstacleType = eo
|
, _drObstacleType = eo
|
||||||
}
|
}
|
||||||
nsteps = length pss - 1
|
nsteps = length pss - 1
|
||||||
wlids = take 4 [IM.newKey $ _walls (_cWorld gw) ..]
|
wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld gw)) ..]
|
||||||
wlps' = uncurry (rectanglePairs 9) $ head pss
|
wlps' = uncurry (rectanglePairs 9) $ head pss
|
||||||
addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids wlps'
|
addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids wlps'
|
||||||
|
|
||||||
addDoorWall :: EdgeObstacle -> Int -> Wall -> World -> (Int, (Point2, Point2)) -> World
|
addDoorWall :: EdgeObstacle -> Int -> Wall -> World -> (Int, (Point2, Point2)) -> World
|
||||||
addDoorWall eo drid wl w (wlid, wlps) =
|
addDoorWall eo drid wl w (wlid, wlps) =
|
||||||
w'
|
w'
|
||||||
& cWorld . walls
|
& cWorld . lWorld . walls
|
||||||
%~ IM.insert
|
%~ IM.insert
|
||||||
wlid
|
wlid
|
||||||
wl
|
wl
|
||||||
@@ -61,7 +61,7 @@ addDoorWall eo drid wl w (wlid, wlps) =
|
|||||||
, _wlID = wlid
|
, _wlID = wlid
|
||||||
, _wlStructure = DoorPart drid
|
, _wlStructure = DoorPart drid
|
||||||
}
|
}
|
||||||
& cWorld . doors . ix drid . drObstructs <>~ es
|
& cWorld . lWorld . doors . ix drid . drObstructs <>~ es
|
||||||
where
|
where
|
||||||
(w', es) = uncurry (obstructPathsCrossing eo) wlps w
|
(w', es) = uncurry (obstructPathsCrossing eo) wlps w
|
||||||
|
|
||||||
@@ -71,9 +71,9 @@ maybeClearDoorPaths eo es w = foldl' (maybeClearDoorPath eo) w es
|
|||||||
maybeClearDoorPath :: EdgeObstacle -> World -> PathEdgeNodes -> World
|
maybeClearDoorPath :: EdgeObstacle -> World -> PathEdgeNodes -> World
|
||||||
maybeClearDoorPath eo w (PathEdgeNodes x y pe)
|
maybeClearDoorPath eo w (PathEdgeNodes x y pe)
|
||||||
| not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w =
|
| not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w =
|
||||||
w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x, y)
|
w & cWorld . lWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x, y)
|
||||||
| otherwise =
|
| otherwise =
|
||||||
w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x, y)
|
w & cWorld . lWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x, y)
|
||||||
|
|
||||||
plSlideDoor ::
|
plSlideDoor ::
|
||||||
Door ->
|
Door ->
|
||||||
@@ -85,9 +85,9 @@ plSlideDoor ::
|
|||||||
World ->
|
World ->
|
||||||
(Int, World)
|
(Int, World)
|
||||||
plSlideDoor dr wl eo shiftOffset a b gw =
|
plSlideDoor dr wl eo shiftOffset a b gw =
|
||||||
(drid, addDoorWalls $ gw & cWorld . doors %~ addDoor)
|
(drid, addDoorWalls $ gw & cWorld . lWorld . doors %~ addDoor)
|
||||||
where
|
where
|
||||||
drid = IM.newKey $ _doors (_cWorld gw)
|
drid = IM.newKey $ _doors (_lWorld (_cWorld gw))
|
||||||
addDoor =
|
addDoor =
|
||||||
IM.insert drid $
|
IM.insert drid $
|
||||||
dr
|
dr
|
||||||
@@ -103,7 +103,7 @@ plSlideDoor dr wl eo shiftOffset a b gw =
|
|||||||
addDoorWalls w' = foldl' (addDoorWall eo drid wl) w' $ zip wlids pairs
|
addDoorWalls w' = foldl' (addDoorWall eo drid wl) w' $ zip wlids pairs
|
||||||
pairs = rectanglePairs 9 a b
|
pairs = rectanglePairs 9 a b
|
||||||
shiftLeft = (+.+ (a -.- b +.+ shiftOffset *.* normalizeV (b -.- a)))
|
shiftLeft = (+.+ (a -.- b +.+ shiftOffset *.* normalizeV (b -.- a)))
|
||||||
wlids = take 4 [IM.newKey $ _walls (_cWorld gw) ..]
|
wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld gw)) ..]
|
||||||
|
|
||||||
-- old code that may help with pathing
|
-- old code that may help with pathing
|
||||||
--import Dodge.LevelGen.Pathing
|
--import Dodge.LevelGen.Pathing
|
||||||
|
|||||||
@@ -29,7 +29,7 @@ fireShell it cr =
|
|||||||
|
|
||||||
makeShell :: Item -> Creature -> [ProjectileUpdate] -> World -> World
|
makeShell :: Item -> Creature -> [ProjectileUpdate] -> World -> World
|
||||||
makeShell it cr theupdate w =
|
makeShell it cr theupdate w =
|
||||||
w & cWorld . projectiles . at i
|
w & cWorld . lWorld . projectiles . at i
|
||||||
?~ Shell
|
?~ Shell
|
||||||
{ _prjPos = pos
|
{ _prjPos = pos
|
||||||
, _prjZ = 20
|
, _prjZ = 20
|
||||||
@@ -46,7 +46,7 @@ makeShell it cr theupdate w =
|
|||||||
, _prjMITID = Just $ _itID it
|
, _prjMITID = Just $ _itID it
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
i = IM.newKey $ _props (_cWorld w)
|
i = IM.newKey $ w ^. cWorld . lWorld . props-- _props (_cWorld w)
|
||||||
dir = _crDir cr
|
dir = _crDir cr
|
||||||
pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0)
|
pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0)
|
||||||
am = _heldConsumption $ _itUse it
|
am = _heldConsumption $ _itUse it
|
||||||
|
|||||||
@@ -48,7 +48,7 @@ plainShellCollisionCheck :: Proj -> World -> World
|
|||||||
plainShellCollisionCheck = shellCollisionCheck $ \pj ->
|
plainShellCollisionCheck = shellCollisionCheck $ \pj ->
|
||||||
usePayload (_prjPayload pj) (_prjPos pj)
|
usePayload (_prjPayload pj) (_prjPos pj)
|
||||||
. stopSoundFrom (ShellSound (_prjID pj))
|
. stopSoundFrom (ShellSound (_prjID pj))
|
||||||
. (cWorld . projectiles %~ IM.delete (_prjID pj))
|
. (cWorld . lWorld . projectiles %~ IM.delete (_prjID pj))
|
||||||
|
|
||||||
upsProjectile :: Proj -> World -> World
|
upsProjectile :: Proj -> World -> World
|
||||||
upsProjectile pj w' = foldr (`upProjectile` pj) w' (_prjUpdates pj)
|
upsProjectile pj w' = foldr (`upProjectile` pj) w' (_prjUpdates pj)
|
||||||
@@ -73,7 +73,7 @@ upProjectile pu pj = case pu of
|
|||||||
| otherwise -> id
|
| otherwise -> id
|
||||||
PJSetScope itid -> setRemoteScope itid (_prjPos pj)
|
PJSetScope itid -> setRemoteScope itid (_prjPos pj)
|
||||||
PJRetireRemote itid 0 pjid -> retireRemoteProj itid pjid
|
PJRetireRemote itid 0 pjid -> retireRemoteProj itid pjid
|
||||||
PJRetireRemote _ _ pjid -> cWorld . projectiles . ix pjid . prjUpdates . ix 0 . pjuTimer -~ 1
|
PJRetireRemote _ _ pjid -> cWorld . lWorld . projectiles . ix pjid . prjUpdates . ix 0 . pjuTimer -~ 1
|
||||||
where
|
where
|
||||||
time = _prjTimer pj
|
time = _prjTimer pj
|
||||||
act st et = time <= st && time >= et
|
act st et = time <= st && time >= et
|
||||||
@@ -82,29 +82,29 @@ upProjectile pu pj = case pu of
|
|||||||
retireRemoteProj :: Int -> Int -> World -> World
|
retireRemoteProj :: Int -> Int -> World -> World
|
||||||
retireRemoteProj itid pjid w =
|
retireRemoteProj itid pjid w =
|
||||||
w
|
w
|
||||||
& pointerToItemLocation (_itemLocations (_cWorld w) IM.! itid)
|
& pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itid)
|
||||||
%~ ( (itScope . scopePos .~ V2 0 0)
|
%~ ( (itScope . scopePos .~ V2 0 0)
|
||||||
. (itUse . heldUse .~ HeldFireRemoteShell)
|
. (itUse . heldUse .~ HeldFireRemoteShell)
|
||||||
)
|
)
|
||||||
& cWorld . props %~ IM.delete pjid
|
& cWorld . lWorld . props %~ IM.delete pjid
|
||||||
|
|
||||||
setRemoteDir :: Int -> Int -> Proj -> World -> World
|
setRemoteDir :: Int -> Int -> Proj -> World -> World
|
||||||
setRemoteDir cid itid pj w = w & cWorld . projectiles . ix (_prjID pj) . prjAcc .~ turntonewdir
|
setRemoteDir cid itid pj w = w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc .~ turntonewdir
|
||||||
where
|
where
|
||||||
turntonewdir = magV (_prjAcc pj) *.* unitVectorAtAngle newdir
|
turntonewdir = magV (_prjAcc pj) *.* unitVectorAtAngle newdir
|
||||||
--i = _prjID pj
|
--i = _prjID pj
|
||||||
newdir
|
newdir
|
||||||
| SDL.ButtonRight `M.member` _mouseButtons w
|
| SDL.ButtonRight `M.member` _mouseButtons w
|
||||||
&& w ^? cWorld . creatures . ix cid . crInvSel . iselPos
|
&& w ^? cWorld . lWorld . creatures . ix cid . crInvSel . iselPos
|
||||||
== w ^? cWorld . itemLocations . ix itid . ipInvID
|
== w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID
|
||||||
= (w ^. cWorld . cwCam . cwcRot) + argV (_mousePos w)
|
= (w ^. cWorld . lWorld . cwCam . cwcRot) + argV (_mousePos w)
|
||||||
| otherwise = _prjDir pj
|
| otherwise = _prjDir pj
|
||||||
|
|
||||||
doThrust :: Proj -> World -> World
|
doThrust :: Proj -> World -> World
|
||||||
doThrust pj w =
|
doThrust pj w =
|
||||||
w
|
w
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
& cWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v)
|
& cWorld . lWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v)
|
||||||
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
|
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
|
||||||
& makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi + sparkD) accel) 3 10
|
& makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi + sparkD) accel) 3 10
|
||||||
& shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
|
& shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
|
||||||
@@ -126,11 +126,11 @@ trySpinByCID ::
|
|||||||
Proj ->
|
Proj ->
|
||||||
World ->
|
World ->
|
||||||
World
|
World
|
||||||
trySpinByCID cid i pj w = w & cWorld . projectiles . ix pjid . prjSpin .~ newSpin
|
trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . prjSpin .~ newSpin
|
||||||
where
|
where
|
||||||
pjid = _prjID pj
|
pjid = _prjID pj
|
||||||
dir = argV $ _prjVel pj
|
dir = argV $ _prjVel pj
|
||||||
newSpin = case w ^? cWorld . creatures . ix cid of
|
newSpin = case w ^? cWorld . lWorld . creatures . ix cid of
|
||||||
Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
|
Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
|
||||||
_ -> 0
|
_ -> 0
|
||||||
spinFactor = 5 * (6 - fromIntegral i)
|
spinFactor = 5 * (6 - fromIntegral i)
|
||||||
@@ -141,13 +141,13 @@ pjTrack itid pj w = rotateToTarget pj w
|
|||||||
rotateToTarget _ = fromMaybe id $ do
|
rotateToTarget _ = fromMaybe id $ do
|
||||||
tpos <- w ^? itPoint . itTargeting . tgPos . _Just
|
tpos <- w ^? itPoint . itTargeting . tgPos . _Just
|
||||||
return $
|
return $
|
||||||
cWorld . projectiles . ix (_prjID pj) . prjSpin
|
cWorld . lWorld . projectiles . ix (_prjID pj) . prjSpin
|
||||||
.~ turnToAmount
|
.~ turnToAmount
|
||||||
0.15
|
0.15
|
||||||
(_prjPos pj)
|
(_prjPos pj)
|
||||||
tpos
|
tpos
|
||||||
(argV $ _prjAcc pj)
|
(argV $ _prjAcc pj)
|
||||||
itPoint = pointerToItemLocation $ _itemLocations (_cWorld w) IM.! itid
|
itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid
|
||||||
|
|
||||||
reduceSpinBy :: Float -> Proj -> World -> World
|
reduceSpinBy :: Float -> Proj -> World -> World
|
||||||
reduceSpinBy x pj = cWorld . projectiles . ix (_prjID pj) . prjSpin *~ x
|
reduceSpinBy x pj = cWorld . lWorld . projectiles . ix (_prjID pj) . prjSpin *~ x
|
||||||
|
|||||||
@@ -79,7 +79,7 @@ addGib4 ::
|
|||||||
World
|
World
|
||||||
addGib4 p col (v, zs, q, h) =
|
addGib4 p col (v, zs, q, h) =
|
||||||
plNew
|
plNew
|
||||||
(cWorld . props)
|
(cWorld . lWorld . props)
|
||||||
prID
|
prID
|
||||||
( aGib & prPos .~ p +.+ (5 *.* normalizeV v)
|
( aGib & prPos .~ p +.+ (5 *.* normalizeV v)
|
||||||
& prColor .~ col
|
& prColor .~ col
|
||||||
@@ -93,7 +93,7 @@ addGib4 p col (v, zs, q, h) =
|
|||||||
addGibAt :: Float -> Color -> Point2 -> World -> World
|
addGibAt :: Float -> Color -> Point2 -> World -> World
|
||||||
addGibAt h col p w =
|
addGibAt h col p w =
|
||||||
w
|
w
|
||||||
& plNew (cWorld . props) prID gib
|
& plNew (cWorld . lWorld . props) prID gib
|
||||||
& randGen .~ newg
|
& randGen .~ newg
|
||||||
where
|
where
|
||||||
(gib, newg) = runState f $ _randGen w
|
(gib, newg) = runState f $ _randGen w
|
||||||
@@ -116,7 +116,7 @@ addGibAt h col p w =
|
|||||||
addGibAtDir :: Float -> Float -> Color -> Point2 -> World -> World
|
addGibAtDir :: Float -> Float -> Color -> Point2 -> World -> World
|
||||||
addGibAtDir dir h col p w =
|
addGibAtDir dir h col p w =
|
||||||
w
|
w
|
||||||
& plNew (cWorld . props) prID gib
|
& plNew (cWorld . lWorld . props) prID gib
|
||||||
& randGen .~ newg
|
& randGen .~ newg
|
||||||
where
|
where
|
||||||
(gib, newg) = runState f $ _randGen w
|
(gib, newg) = runState f $ _randGen w
|
||||||
|
|||||||
@@ -12,12 +12,12 @@ fallSmallBounceDamage :: Prop -> World -> World
|
|||||||
fallSmallBounceDamage pr w =
|
fallSmallBounceDamage pr w =
|
||||||
w
|
w
|
||||||
& dodamage
|
& dodamage
|
||||||
& cWorld . props . ix (_prID pr) %~ fallSmallBounce' w
|
& cWorld . lWorld . props . ix (_prID pr) %~ fallSmallBounce' w
|
||||||
where
|
where
|
||||||
p = _prPos pr
|
p = _prPos pr
|
||||||
v = _prVel pr
|
v = _prVel pr
|
||||||
dodamage
|
dodamage
|
||||||
| _prPosZ pr < 25 = cWorld . creatures %~ fmap dodamage'
|
| _prPosZ pr < 25 = cWorld . lWorld . creatures %~ fmap dodamage'
|
||||||
| otherwise = id
|
| otherwise = id
|
||||||
dodamage' cr
|
dodamage' cr
|
||||||
| dist (_crPos cr) p < _crRad cr + 5 =
|
| dist (_crPos cr) p < _crRad cr + 5 =
|
||||||
@@ -28,7 +28,7 @@ fallSmallBounceDamage pr w =
|
|||||||
fallSmallBounce :: Prop -> World -> World
|
fallSmallBounce :: Prop -> World -> World
|
||||||
fallSmallBounce pr w =
|
fallSmallBounce pr w =
|
||||||
w
|
w
|
||||||
& cWorld . props . ix (_prID pr) %~ fallSmallBounce' w
|
& cWorld . lWorld . props . ix (_prID pr) %~ fallSmallBounce' w
|
||||||
|
|
||||||
fallSmallBounce' :: World -> Prop -> Prop
|
fallSmallBounce' :: World -> Prop -> Prop
|
||||||
fallSmallBounce' w pr
|
fallSmallBounce' w pr
|
||||||
|
|||||||
@@ -16,7 +16,7 @@ updateProp pr = case _prUpdate pr of
|
|||||||
PropRotate x -> rotateProp x pr
|
PropRotate x -> rotateProp x pr
|
||||||
PropSetToggleAnd wb pu -> propSetToggleAnd wb pu pr
|
PropSetToggleAnd wb pu -> propSetToggleAnd wb pu pr
|
||||||
PropUpdates pus -> doPropUpdates pr pus
|
PropUpdates pus -> doPropUpdates pr pus
|
||||||
PropUpdateLS lsid x -> \w -> w & cWorld . lightSources . ix lsid %~ doPrWdLsLs x pr w
|
PropUpdateLS lsid x -> \w -> w & cWorld . lWorld . lightSources . ix lsid %~ doPrWdLsLs x pr w
|
||||||
PropUpdatePosition x -> propUpdatePosition x pr
|
PropUpdatePosition x -> propUpdatePosition x pr
|
||||||
PropUpdateWhen t x -> propUpdateIf t x PropUpdateId pr
|
PropUpdateWhen t x -> propUpdateIf t x PropUpdateId pr
|
||||||
PropUpdateAnd x y -> doPropUpdates pr [x, y]
|
PropUpdateAnd x y -> doPropUpdates pr [x, y]
|
||||||
@@ -30,8 +30,8 @@ propUpdateIf wb x y pr w
|
|||||||
propUpdatePosition :: WdP2f -> Prop -> World -> World
|
propUpdatePosition :: WdP2f -> Prop -> World -> World
|
||||||
propUpdatePosition x pr w =
|
propUpdatePosition x pr w =
|
||||||
w
|
w
|
||||||
& cWorld . props . ix (_prID pr) . prPos .~ fst (doWdP2f x w)
|
& cWorld . lWorld . props . ix (_prID pr) . prPos .~ fst (doWdP2f x w)
|
||||||
& cWorld . props . ix (_prID pr) . prRot .~ snd (doWdP2f x w)
|
& cWorld . lWorld . props . ix (_prID pr) . prRot .~ snd (doWdP2f x w)
|
||||||
|
|
||||||
doPropUpdates :: Prop -> [PropUpdate] -> World -> World
|
doPropUpdates :: Prop -> [PropUpdate] -> World -> World
|
||||||
doPropUpdates pr pus w = foldl' f w pus
|
doPropUpdates pr pus w = foldl' f w pus
|
||||||
@@ -44,9 +44,9 @@ propSetToggleAnd wb pu pr = setToggle (doWdBl wb) pr . updateProp (pr & prUpdate
|
|||||||
-- fugly
|
-- fugly
|
||||||
|
|
||||||
setToggle :: (World -> Bool) -> Prop -> World -> World
|
setToggle :: (World -> Bool) -> Prop -> World -> World
|
||||||
setToggle cond pr w = w & cWorld . props . ix (_prID pr) . prToggle .~ cond w
|
setToggle cond pr w = w & cWorld . lWorld . props . ix (_prID pr) . prToggle .~ cond w
|
||||||
|
|
||||||
rotateProp :: Float -> Prop -> World -> World
|
rotateProp :: Float -> Prop -> World -> World
|
||||||
rotateProp rotAmount pr w =
|
rotateProp rotAmount pr w =
|
||||||
w
|
w
|
||||||
& cWorld . props . ix (_prID pr) . prRot +~ rotAmount
|
& cWorld . lWorld . props . ix (_prID pr) . prRot +~ rotAmount
|
||||||
|
|||||||
@@ -13,7 +13,7 @@ import LensHelp
|
|||||||
|
|
||||||
aRadarPulse :: ObjectType -> Creature -> World -> World
|
aRadarPulse :: ObjectType -> Creature -> World -> World
|
||||||
aRadarPulse ob cr =
|
aRadarPulse ob cr =
|
||||||
cWorld . radarSweeps
|
cWorld . lWorld . radarSweeps
|
||||||
.:~ RadarSweep
|
.:~ RadarSweep
|
||||||
{ _rsTimer = 100
|
{ _rsTimer = 100
|
||||||
, _rsRad = 0
|
, _rsRad = 0
|
||||||
@@ -35,7 +35,7 @@ updateRadarSweep w pt
|
|||||||
blipsF = findBlips ob
|
blipsF = findBlips ob
|
||||||
bf = makeBlip ob
|
bf = makeBlip ob
|
||||||
x = _rsTimer pt
|
x = _rsTimer pt
|
||||||
putBlips = cWorld . radarBlips .++~ blips
|
putBlips = cWorld . lWorld . radarBlips .++~ blips
|
||||||
blips = map bf circPoints
|
blips = map bf circPoints
|
||||||
circPoints = blipsF p r w
|
circPoints = blipsF p r w
|
||||||
r = fromIntegral (400 - x * 4)
|
r = fromIntegral (400 - x * 4)
|
||||||
@@ -66,13 +66,13 @@ blipAt r col i p =
|
|||||||
}
|
}
|
||||||
|
|
||||||
crBlips :: Point2 -> Float -> World -> [Point2]
|
crBlips :: Point2 -> Float -> World -> [Point2]
|
||||||
crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures . _cWorld
|
crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures . _lWorld . _cWorld
|
||||||
where
|
where
|
||||||
f q = dist p q <= r && dist p q > r - 100
|
f q = dist p q <= r && dist p q > r - 100
|
||||||
g cr = _crID cr /= 0
|
g cr = _crID cr /= 0
|
||||||
|
|
||||||
itemBlips :: Point2 -> Float -> World -> [Point2]
|
itemBlips :: Point2 -> Float -> World -> [Point2]
|
||||||
itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems . _cWorld
|
itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems . _lWorld . _cWorld
|
||||||
where
|
where
|
||||||
f q = dist p q <= r && dist p q > r - 4
|
f q = dist p q <= r && dist p q > r - 4
|
||||||
|
|
||||||
|
|||||||
@@ -40,13 +40,13 @@ tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itUse . heldConsumptio
|
|||||||
|
|
||||||
crToggleReloading :: Creature -> World -> World
|
crToggleReloading :: Creature -> World -> World
|
||||||
crToggleReloading cr w = case cr ^?! crInvSel . iselAction of
|
crToggleReloading cr w = case cr ^?! crInvSel . iselAction of
|
||||||
ReloadAction{} -> w & cWorld . creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction
|
ReloadAction{} -> w & cWorld . lWorld . creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction
|
||||||
_ -> w & cWorld . creatures . ix (_crID cr) %~ tryStartLoading
|
_ -> w & cWorld . lWorld . creatures . ix (_crID cr) %~ tryStartLoading
|
||||||
|
|
||||||
crHoldReloading :: Creature -> World -> World
|
crHoldReloading :: Creature -> World -> World
|
||||||
crHoldReloading cr w =
|
crHoldReloading cr w =
|
||||||
w
|
w
|
||||||
& cWorld . creatures . ix (_crID cr) . crInvSel . iselAction . actionHammer .~ HasHammer HammerDown
|
& cWorld . lWorld . creatures . ix (_crID cr) . crInvSel . iselAction . actionHammer .~ HasHammer HammerDown
|
||||||
|
|
||||||
tryStartLoading :: Creature -> Creature
|
tryStartLoading :: Creature -> Creature
|
||||||
tryStartLoading cr = case ic ^? laProgress . _Just . ix 0 of
|
tryStartLoading cr = case ic ^? laProgress . _Just . ix 0 of
|
||||||
|
|||||||
+6
-6
@@ -32,14 +32,14 @@ doDrawing pdata u = do
|
|||||||
sTicks <- SDL.ticks
|
sTicks <- SDL.ticks
|
||||||
let w = _uvWorld u
|
let w = _uvWorld u
|
||||||
cfig = _uvConfig u
|
cfig = _uvConfig u
|
||||||
rot = w ^. cWorld . cwCam . cwcRot
|
rot = w ^. cWorld . lWorld . cwCam . cwcRot
|
||||||
camzoom = w ^. cWorld . cwCam . cwcZoom
|
camzoom = w ^. cWorld . lWorld . cwCam . cwcZoom
|
||||||
trans = w ^. cWorld . cwCam . cwcCenter
|
trans = w ^. cWorld . lWorld . cwCam . cwcCenter
|
||||||
wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
|
wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
|
||||||
resFact = resFactorNum $ cfig ^. graphics_resolution_factor
|
resFact = resFactorNum $ cfig ^. graphics_resolution_factor
|
||||||
(wallPointsCol, windowPoints, wallSPics) = wallsToDraw w
|
(wallPointsCol, windowPoints, wallSPics) = wallsToDraw w
|
||||||
lightPoints = lightsToRender cfig w
|
lightPoints = lightsToRender cfig w
|
||||||
viewFroms@(V2 vfx vfy) = w ^. cWorld . cwCam . cwcViewFrom
|
viewFroms@(V2 vfx vfy) = w ^. cWorld . lWorld . cwCam . cwcViewFrom
|
||||||
viewFrom3d = Vector3 vfx vfy 20
|
viewFrom3d = Vector3 vfx vfy 20
|
||||||
shadV = _pictureShaders pdata
|
shadV = _pictureShaders pdata
|
||||||
lwShad = _lightingWallShadShader pdata
|
lwShad = _lightingWallShadShader pdata
|
||||||
@@ -63,7 +63,7 @@ doDrawing pdata u = do
|
|||||||
(shadVBOptr $ _textureArrayShader pdata)
|
(shadVBOptr $ _textureArrayShader pdata)
|
||||||
wallPointsCol
|
wallPointsCol
|
||||||
windowPoints
|
windowPoints
|
||||||
(_floorTiles (_cWorld w))
|
(w ^. cWorld . lWorld . floorTiles)
|
||||||
)
|
)
|
||||||
( pokeShape
|
( pokeShape
|
||||||
(_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
|
(_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
|
||||||
@@ -254,7 +254,7 @@ doDrawing pdata u = do
|
|||||||
depthFunc $= Just Always
|
depthFunc $= Just Always
|
||||||
blendFunc $= (One, Zero)
|
blendFunc $= (One, Zero)
|
||||||
-- perform any radial distortion
|
-- perform any radial distortion
|
||||||
case _distortions (_cWorld w) of
|
case w ^. cWorld . lWorld . distortions of
|
||||||
[] -> do
|
[] -> do
|
||||||
bindTO $ fst $ snd $ _fboBase pdata
|
bindTO $ fst $ snd $ _fboBase pdata
|
||||||
bindFramebuffer Framebuffer $= defaultFramebufferObject
|
bindFramebuffer Framebuffer $= defaultFramebufferObject
|
||||||
|
|||||||
@@ -27,7 +27,7 @@ import Picture
|
|||||||
import SDL (MouseButton (..))
|
import SDL (MouseButton (..))
|
||||||
|
|
||||||
hudDrawings :: Universe -> Picture
|
hudDrawings :: Universe -> Picture
|
||||||
hudDrawings uv = case _hudElement $ _hud (_cWorld w) of
|
hudDrawings uv = case w ^. cWorld . lWorld . hud . hudElement of
|
||||||
DisplayCarte -> drawCarte cfig w
|
DisplayCarte -> drawCarte cfig w
|
||||||
DisplayInventory subinv ->
|
DisplayInventory subinv ->
|
||||||
drawInGameHUD uv
|
drawInGameHUD uv
|
||||||
@@ -55,7 +55,7 @@ inventoryDisplay cfig w = listPicturesAt 0 0 cfig invlist
|
|||||||
invlist =
|
invlist =
|
||||||
concatMap (itemText' cr) (IM.toList inv)
|
concatMap (itemText' cr) (IM.toList inv)
|
||||||
++ displayFreeSlots
|
++ displayFreeSlots
|
||||||
++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects (_cWorld w))
|
++ concatMap (closeObjectToTextPictures nfreeslots) (w ^. cWorld . lWorld . closeObjects)
|
||||||
-- ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w))
|
-- ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w))
|
||||||
-- floorItemsColor = case _hudElement (_hud w) of
|
-- floorItemsColor = case _hudElement (_hud w) of
|
||||||
-- DisplayInventory NoSubInventory -> id
|
-- DisplayInventory NoSubInventory -> id
|
||||||
@@ -162,7 +162,7 @@ itmInfo mit = fromMaybe [] $ do
|
|||||||
|
|
||||||
displayTerminal :: Int -> Configuration -> World -> Picture
|
displayTerminal :: Int -> Configuration -> World -> Picture
|
||||||
displayTerminal tid cfig w = fromMaybe mempty $ do
|
displayTerminal tid cfig w = fromMaybe mempty $ do
|
||||||
tm <- w ^? cWorld . terminals . ix tid
|
tm <- w ^? cWorld . lWorld . terminals . ix tid
|
||||||
return $
|
return $
|
||||||
pictures
|
pictures
|
||||||
[ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
|
[ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
|
||||||
@@ -332,9 +332,9 @@ drawCarte cfig w =
|
|||||||
++ mapOverlay cfig w
|
++ mapOverlay cfig w
|
||||||
++ [mainListCursor white iPos cfig]
|
++ [mainListCursor white iPos cfig]
|
||||||
where
|
where
|
||||||
iPos = _selLocation (_cWorld w)
|
iPos = w ^. cWorld . lWorld . selLocation
|
||||||
locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations $ _cWorld w
|
locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations . _lWorld $ _cWorld w
|
||||||
locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations $ _cWorld w
|
locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
|
||||||
locTexts = map fst locs
|
locTexts = map fst locs
|
||||||
|
|
||||||
displayListEndCoords :: Configuration -> [String] -> [Point2]
|
displayListEndCoords :: Configuration -> [String] -> [Point2]
|
||||||
@@ -348,7 +348,7 @@ displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [
|
|||||||
mapOverlay :: Configuration -> World -> [Picture]
|
mapOverlay :: Configuration -> World -> [Picture]
|
||||||
mapOverlay cfig w =
|
mapOverlay cfig w =
|
||||||
(color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
|
(color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
|
||||||
(mapMaybe (mapWall cfig w) . IM.elems $ _walls (_cWorld w))
|
(mapMaybe (mapWall cfig w) . IM.elems $ w ^. cWorld . lWorld . walls)
|
||||||
|
|
||||||
mapWall :: Configuration -> World -> Wall -> Maybe Picture
|
mapWall :: Configuration -> World -> Wall -> Maybe Picture
|
||||||
mapWall cfig w wl =
|
mapWall cfig w wl =
|
||||||
@@ -445,5 +445,4 @@ displayHP cid cfig w =
|
|||||||
. text
|
. text
|
||||||
. leftPad 5 ' '
|
. leftPad 5 ' '
|
||||||
. show
|
. show
|
||||||
. _crHP
|
$ w ^?! cWorld . lWorld . creatures . ix cid . crHP
|
||||||
$ _creatures (_cWorld w) IM.! cid
|
|
||||||
|
|||||||
@@ -10,13 +10,13 @@ import Control.Lens
|
|||||||
|
|
||||||
lightsToRender :: Configuration -> World -> [(Point3, Float, Point3)]
|
lightsToRender :: Configuration -> World -> [(Point3, Float, Point3)]
|
||||||
lightsToRender cfig w =
|
lightsToRender cfig w =
|
||||||
mapMaybe getLS (IM.elems $ _lightSources (_cWorld w))
|
mapMaybe getLS (IM.elems $ w ^. cWorld . lWorld . lightSources)
|
||||||
++ mapMaybe getTLS (_tempLightSources (_cWorld w))
|
++ mapMaybe getTLS (w ^. cWorld . lWorld . tempLightSources)
|
||||||
where
|
where
|
||||||
getLS = getlsparam . _lsParam
|
getLS = getlsparam . _lsParam
|
||||||
getTLS = getlsparam . _tlsParam
|
getTLS = getlsparam . _tlsParam
|
||||||
cbox = w ^. cWorld . cwCam . cwcBoundBox
|
cbox = w ^. cWorld . lWorld . cwCam . cwcBoundBox
|
||||||
cpos = w ^. cWorld . cwCam . cwcCenter
|
cpos = w ^. cWorld . lWorld . cwCam . cwcCenter
|
||||||
getlsparam ls
|
getlsparam ls
|
||||||
| not (pointInPolygon lpos cbox) && extraculltest = Nothing
|
| not (pointInPolygon lpos cbox) && extraculltest = Nothing
|
||||||
| otherwise = Just (_lsPos ls, rad ^ (2 :: Int), _lsCol ls)
|
| otherwise = Just (_lsPos ls, rad ^ (2 :: Int), _lsCol ls)
|
||||||
|
|||||||
@@ -58,7 +58,7 @@ worldSPic cfig w =
|
|||||||
<> singleSPic (anyTargeting cfig w)
|
<> singleSPic (anyTargeting cfig w)
|
||||||
where
|
where
|
||||||
foldup = foldMap'
|
foldup = foldMap'
|
||||||
filtOn f g = IM.filter (pointIsClose . f) (g (_cWorld w))
|
filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w)))
|
||||||
pointIsClose = cullPoint cfig w
|
pointIsClose = cullPoint cfig w
|
||||||
|
|
||||||
anyTargeting :: Configuration -> World -> SPic
|
anyTargeting :: Configuration -> World -> SPic
|
||||||
@@ -116,33 +116,35 @@ shiftDraw' fpos fdir fdraw x =
|
|||||||
|
|
||||||
cullPoint :: Configuration -> World -> Point2 -> Bool
|
cullPoint :: Configuration -> World -> Point2 -> Bool
|
||||||
cullPoint cfig w p
|
cullPoint cfig w p
|
||||||
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . cwCam . cwcBoundBox)
|
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . lWorld . cwCam . cwcBoundBox)
|
||||||
| otherwise = dist (w ^. cWorld . cwCam . cwcCenter) p < (w ^. cWorld . cwCam . cwcViewDistance)
|
| otherwise = dist (w ^. cWorld . lWorld . cwCam . cwcCenter) p < (w ^. cWorld . lWorld . cwCam . cwcViewDistance)
|
||||||
|
|
||||||
extraPics :: Configuration -> World -> Picture
|
extraPics :: Configuration -> World -> Picture
|
||||||
extraPics cfig w =
|
extraPics cfig w =
|
||||||
pictures (_decorations (_cWorld w))
|
pictures (_decorations lw)
|
||||||
<> concatMapPic drawTractorBeam (_tractorBeams (_cWorld w))
|
<> concatMapPic drawTractorBeam (_tractorBeams lw)
|
||||||
<> concatMapPic drawLinearShockwave (_linearShockwaves (_cWorld w))
|
<> concatMapPic drawLinearShockwave (_linearShockwaves lw)
|
||||||
<> concatMapPic drawShockwave (_shockwaves (_cWorld w))
|
<> concatMapPic drawShockwave (_shockwaves lw)
|
||||||
<> concatMapPic drawLaser (_lasersToDraw (_cWorld w))
|
<> concatMapPic drawLaser (_lasersToDraw lw)
|
||||||
<> concatMapPic drawTeslaArc (_teslaArcs (_cWorld w))
|
<> concatMapPic drawTeslaArc (_teslaArcs lw)
|
||||||
-- <> concatMapPic drawParticle (_particles w)
|
-- <> concatMapPic drawParticle (_particles w)
|
||||||
<> concatMapPic drawRadarSweep (_radarSweeps (_cWorld w))
|
<> concatMapPic drawRadarSweep (_radarSweeps lw)
|
||||||
<> concatMapPic drawFlame (_flames (_cWorld w))
|
<> concatMapPic drawFlame (_flames lw)
|
||||||
<> concatMapPic drawEnergyBall (_energyBalls (_cWorld w))
|
<> concatMapPic drawEnergyBall (_energyBalls lw)
|
||||||
<> concatMapPic drawSpark (_sparks (_cWorld w))
|
<> concatMapPic drawSpark (_sparks lw)
|
||||||
<> concatMapPic drawBul (_bullets (_cWorld w))
|
<> concatMapPic drawBul (_bullets lw)
|
||||||
<> concatMapPic drawBlip (_radarBlips (_cWorld w))
|
<> concatMapPic drawBlip (_radarBlips lw)
|
||||||
<> concatMapPic drawFlare (_flares (_cWorld w))
|
<> concatMapPic drawFlare (_flares lw)
|
||||||
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams (_cWorld w))
|
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams lw)
|
||||||
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams (_cWorld w))
|
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams lw)
|
||||||
<> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources (_cWorld w))
|
<> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources lw)
|
||||||
<> testPic cfig w
|
<> testPic cfig w
|
||||||
<> concatMapPic clDraw (_clouds (_cWorld w))
|
<> concatMapPic clDraw (_clouds lw)
|
||||||
<> concatMapPic ppDraw (_pressPlates (_cWorld w))
|
<> concatMapPic ppDraw (_pressPlates lw)
|
||||||
<> viewClipBounds cfig w
|
<> viewClipBounds cfig w
|
||||||
<> debugDraw cfig w
|
<> debugDraw cfig w
|
||||||
|
where
|
||||||
|
lw = w ^. cWorld . lWorld
|
||||||
|
|
||||||
debugDraw :: Configuration -> World -> Picture
|
debugDraw :: Configuration -> World -> Picture
|
||||||
{-# INLINE debugDraw #-}
|
{-# INLINE debugDraw #-}
|
||||||
@@ -195,7 +197,7 @@ drawCollisionTest cfig w =
|
|||||||
(a, b) = _lrLine w
|
(a, b) = _lrLine w
|
||||||
|
|
||||||
drawCreatureDisplayTexts :: World -> Picture
|
drawCreatureDisplayTexts :: World -> Picture
|
||||||
drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures (_cWorld w))
|
drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures)
|
||||||
|
|
||||||
drawPathBetween :: World -> Picture
|
drawPathBetween :: World -> Picture
|
||||||
drawPathBetween w =
|
drawPathBetween w =
|
||||||
@@ -223,7 +225,7 @@ drawInspectWalls w =
|
|||||||
setLayer DebugLayer (color orange $ line [a,b]) <>
|
setLayer DebugLayer (color orange $ line [a,b]) <>
|
||||||
foldMap (drawInspectWall w) (
|
foldMap (drawInspectWall w) (
|
||||||
filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) $
|
filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) $
|
||||||
IM.elems $ _walls (_cWorld w)
|
IM.elems $ w ^. cWorld . lWorld . walls
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
(a, b) = _lLine w
|
(a, b) = _lLine w
|
||||||
@@ -238,7 +240,7 @@ drawInspectWall w wl =
|
|||||||
|
|
||||||
drawDoorPaths :: World -> Int -> Picture
|
drawDoorPaths :: World -> Int -> Picture
|
||||||
drawDoorPaths w drid = fromMaybe mempty $ do
|
drawDoorPaths w drid = fromMaybe mempty $ do
|
||||||
paths <- w ^? cWorld . doors . ix drid . drObstructs
|
paths <- w ^? cWorld . lWorld . doors . ix drid . drObstructs
|
||||||
return $ foldMap' (drawPathEdge . (^. penPathEdge)) paths
|
return $ foldMap' (drawPathEdge . (^. penPathEdge)) paths
|
||||||
|
|
||||||
drawPathEdge :: PathEdge -> Picture
|
drawPathEdge :: PathEdge -> Picture
|
||||||
@@ -276,7 +278,7 @@ drawFarWallDetect w =
|
|||||||
$ getViewpoints p w
|
$ getViewpoints p w
|
||||||
-- $ runIdentity $ S.toList_ $ streamViewpoints p w
|
-- $ runIdentity $ S.toList_ $ streamViewpoints p w
|
||||||
where
|
where
|
||||||
p = w ^. cWorld . cwCam . cwcViewFrom
|
p = w ^. cWorld . lWorld . cwCam . cwcViewFrom
|
||||||
|
|
||||||
drawDDATest :: World -> Picture
|
drawDDATest :: World -> Picture
|
||||||
drawDDATest w =
|
drawDDATest w =
|
||||||
@@ -287,7 +289,7 @@ drawDDATest w =
|
|||||||
-- <> color blue (runIdentity (S.foldMap_ drawCross qs'))
|
-- <> color blue (runIdentity (S.foldMap_ drawCross qs'))
|
||||||
<> setLayer DebugLayer (color yellow (line [cvf, mwp]))
|
<> setLayer DebugLayer (color yellow (line [cvf, mwp]))
|
||||||
where
|
where
|
||||||
cvf = w ^. cWorld . cwCam . cwcViewFrom
|
cvf = w ^. cWorld . lWorld . cwCam . cwcViewFrom
|
||||||
mwp = mouseWorldPos w
|
mwp = mouseWorldPos w
|
||||||
--ps = ddaStreamX 50 cvf mwp
|
--ps = ddaStreamX 50 cvf mwp
|
||||||
ps = zoneOfSeg 50 cvf mwp
|
ps = zoneOfSeg 50 cvf mwp
|
||||||
@@ -314,7 +316,7 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
|
|||||||
setLayer DebugLayer $
|
setLayer DebugLayer $
|
||||||
color yellow $
|
color yellow $
|
||||||
uncurryV translate p (circle 5)
|
uncurryV translate p (circle 5)
|
||||||
<> line [w ^. cWorld . cwCam . cwcViewFrom , p]
|
<> line [w ^. cWorld . lWorld . cwCam . cwcViewFrom , p]
|
||||||
|
|
||||||
testPic :: Configuration -> World -> Picture
|
testPic :: Configuration -> World -> Picture
|
||||||
testPic _ _ = mempty
|
testPic _ _ = mempty
|
||||||
@@ -330,7 +332,7 @@ testPic _ _ = mempty
|
|||||||
drawBoundingBox :: World -> Picture
|
drawBoundingBox :: World -> Picture
|
||||||
drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
|
drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
|
||||||
where
|
where
|
||||||
(x : xs) = w ^. cWorld . cwCam . cwcBoundBox
|
(x : xs) = w ^. cWorld . lWorld . cwCam . cwcBoundBox
|
||||||
|
|
||||||
clDraw :: Cloud -> Picture
|
clDraw :: Cloud -> Picture
|
||||||
clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c)
|
clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c)
|
||||||
@@ -358,7 +360,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
|
|||||||
where
|
where
|
||||||
p = _soundPos s
|
p = _soundPos s
|
||||||
thePic =
|
thePic =
|
||||||
rotate (w ^. cWorld . cwCam . cwcRot)
|
rotate (w ^. cWorld . lWorld . cwCam . cwcRot)
|
||||||
. scale theScale theScale
|
. scale theScale theScale
|
||||||
. centerText
|
. centerText
|
||||||
. soundToOnomato
|
. soundToOnomato
|
||||||
@@ -378,7 +380,7 @@ drawMousePosition cfig w =
|
|||||||
mwp = mouseWorldPos w
|
mwp = mouseWorldPos w
|
||||||
|
|
||||||
drawWlIDs :: Configuration -> World -> Picture
|
drawWlIDs :: Configuration -> World -> Picture
|
||||||
drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (_walls (_cWorld w))
|
drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls)
|
||||||
where
|
where
|
||||||
f wl
|
f wl
|
||||||
| dist (_crPos $ you w) (fst (_wlLine wl)) > 200 = mempty -- this should be improved with a better "on screen test"
|
| dist (_crPos $ you w) (fst (_wlLine wl)) > 200 = mempty -- this should be improved with a better "on screen test"
|
||||||
@@ -406,7 +408,7 @@ drawPathing cfig w =
|
|||||||
<> foldMap dispInc (graphToIncidence gr)
|
<> foldMap dispInc (graphToIncidence gr)
|
||||||
where
|
where
|
||||||
dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
|
dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
|
||||||
gr = _pathGraph (_cWorld w)
|
gr = w ^. cWorld . lWorld . pathGraph
|
||||||
|
|
||||||
crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2, [String])
|
crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2, [String])
|
||||||
crDisplayInfo cfig w cr
|
crDisplayInfo cfig w cr
|
||||||
@@ -437,7 +439,7 @@ drawCrInfo :: Configuration -> World -> Picture
|
|||||||
drawCrInfo cfig w =
|
drawCrInfo cfig w =
|
||||||
setLayer FixedCoordLayer $
|
setLayer FixedCoordLayer $
|
||||||
renderInfoListsAt (2 * hw - 400) 0 cfig w $
|
renderInfoListsAt (2 * hw - 400) 0 cfig w $
|
||||||
mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures (_cWorld w)
|
mapMaybe (crDisplayInfo cfig w) $ IM.elems $ w ^. cWorld . lWorld . creatures
|
||||||
where
|
where
|
||||||
hw = halfWidth cfig
|
hw = halfWidth cfig
|
||||||
|
|
||||||
|
|||||||
@@ -25,7 +25,7 @@ wallsToDraw w =
|
|||||||
<*> L.prefilter wlSeeThroughDraw (L.premap f L.list)
|
<*> L.prefilter wlSeeThroughDraw (L.premap f L.list)
|
||||||
<*> L.premap getWallSPic L.mconcat
|
<*> L.premap getWallSPic L.mconcat
|
||||||
)
|
)
|
||||||
(wlsFromIXs w $ zonesExtract (w ^. cWorld . wlZoning) $ zoneOfSight' wlZoneSize w)
|
(wlsFromIXs w $ zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfSight' wlZoneSize w)
|
||||||
|
|
||||||
--wallsToDraw
|
--wallsToDraw
|
||||||
-- :: World
|
-- :: World
|
||||||
|
|||||||
@@ -121,7 +121,7 @@ addButtonSlowDoor x h rm = do
|
|||||||
ptCont (PutWorldUpdate (const $ setmount dr plls plpr)) $
|
ptCont (PutWorldUpdate (const $ setmount dr plls plpr)) $
|
||||||
const mpl
|
const mpl
|
||||||
setmount pldr plls plpr =
|
setmount pldr plls plpr =
|
||||||
cWorld . doors . ix (fromJust $ _plMID pldr) . drMounts
|
cWorld . lWorld . doors . ix (fromJust $ _plMID pldr) . drMounts
|
||||||
.++~ [MountedLS (fromJust $ _plMID plls), MountedProp (fromJust $ _plMID plpr)]
|
.++~ [MountedLS (fromJust $ _plMID plls), MountedProp (fromJust $ _plMID plpr)]
|
||||||
-- TODO make the height of this light source and of other mounted lights
|
-- TODO make the height of this light source and of other mounted lights
|
||||||
-- be taken from a single consistent source
|
-- be taken from a single consistent source
|
||||||
|
|||||||
@@ -28,7 +28,7 @@ moveShockwave w sw
|
|||||||
tFraction = fromIntegral t / fromIntegral (_swMaxTime sw)
|
tFraction = fromIntegral t / fromIntegral (_swMaxTime sw)
|
||||||
rad = r - (3 / 4) * r * tFraction
|
rad = r - (3 / 4) * r * tFraction
|
||||||
doDams w' =
|
doDams w' =
|
||||||
over (cWorld . creatures) (IM.map damCr) $
|
over (cWorld . lWorld . creatures) (IM.map damCr) $
|
||||||
foldl'
|
foldl'
|
||||||
(flip $ damageWall (Damage EXPLOSIVE 10000 p p p NoDamageEffect))
|
(flip $ damageWall (Damage EXPLOSIVE 10000 p p p NoDamageEffect))
|
||||||
w'
|
w'
|
||||||
@@ -62,7 +62,7 @@ moveInverseShockwave w sw
|
|||||||
r = _swRad sw
|
r = _swRad sw
|
||||||
t = _swTimer sw
|
t = _swTimer sw
|
||||||
rad = r - 0.1 * r * fromIntegral (10 - t)
|
rad = r - 0.1 * r * fromIntegral (10 - t)
|
||||||
dams = over (cWorld . creatures) (IM.map damCr) -- . flip (foldr (damageBlocksBy 1)) hitBlocks
|
dams = over (cWorld . lWorld . creatures) (IM.map damCr) -- . flip (foldr (damageBlocksBy 1)) hitBlocks
|
||||||
-- hitBlocks = wallsOnCirc' p rad $ wallsNearPoint' p w
|
-- hitBlocks = wallsOnCirc' p rad $ wallsNearPoint' p w
|
||||||
damCr cr
|
damCr cr
|
||||||
| dist (_crPos cr) p >= rad + _crRad cr = cr
|
| dist (_crPos cr) p >= rad + _crRad cr = cr
|
||||||
|
|||||||
@@ -212,9 +212,9 @@ soundAngle p w
|
|||||||
. radToDeg
|
. radToDeg
|
||||||
. normalizeAngle
|
. normalizeAngle
|
||||||
. (+ pi)
|
. (+ pi)
|
||||||
$ argV (vNormal (p -.- earPos)) - _cwcRot (_cwCam (_cWorld w))
|
$ argV (vNormal (p -.- earPos)) - (w ^. cWorld . lWorld . cwCam . cwcRot)
|
||||||
where
|
where
|
||||||
earPos = w ^. cWorld . cwCam . cwcViewFrom
|
earPos = w ^. cWorld . lWorld . cwCam . cwcViewFrom
|
||||||
|
|
||||||
{- | Uses the first free origin from a list.
|
{- | Uses the first free origin from a list.
|
||||||
Does nothing if all origins are already creating sounds.
|
Does nothing if all origins are already creating sounds.
|
||||||
|
|||||||
+2
-2
@@ -56,7 +56,7 @@ randColDirSpark ::
|
|||||||
randColDirSpark randcol randdir pos w =
|
randColDirSpark randcol randdir pos w =
|
||||||
w
|
w
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
& cWorld . sparks
|
& cWorld . lWorld . sparks
|
||||||
.:~ Spark
|
.:~ Spark
|
||||||
{ _skVel = rotateV dir (V2 5 0)
|
{ _skVel = rotateV dir (V2 5 0)
|
||||||
, _skColor = col
|
, _skColor = col
|
||||||
@@ -82,7 +82,7 @@ randSpark ::
|
|||||||
randSpark dt randspeed randcol randdir pos w =
|
randSpark dt randspeed randcol randdir pos w =
|
||||||
w
|
w
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
& cWorld . sparks
|
& cWorld . lWorld . sparks
|
||||||
.:~ Spark
|
.:~ Spark
|
||||||
{ _skVel = rotateV dir (V2 speed 0)
|
{ _skVel = rotateV dir (V2 speed 0)
|
||||||
, _skColor = col
|
, _skColor = col
|
||||||
|
|||||||
@@ -186,7 +186,7 @@ getSensor f tm w =
|
|||||||
maybe
|
maybe
|
||||||
[]
|
[]
|
||||||
(makeTermPara . map toUpper . show . f)
|
(makeTermPara . map toUpper . show . f)
|
||||||
(w ^? cWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor)
|
(w ^? cWorld . lWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor)
|
||||||
|
|
||||||
toggleCommand :: TerminalCommand
|
toggleCommand :: TerminalCommand
|
||||||
toggleCommand =
|
toggleCommand =
|
||||||
@@ -212,14 +212,14 @@ sensorCommand =
|
|||||||
disconnectTerminal :: Terminal -> World -> World
|
disconnectTerminal :: Terminal -> World -> World
|
||||||
disconnectTerminal tm w =
|
disconnectTerminal tm w =
|
||||||
w
|
w
|
||||||
& cWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff
|
& cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff
|
||||||
& exitTerminalSubInv
|
& exitTerminalSubInv
|
||||||
& cWorld . terminals . ix (_tmID tm) . tmFutureLines
|
& cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
|
||||||
.~ [TerminalLineTerminalEffect 0 TmTmClearDisplayedLines]
|
.~ [TerminalLineTerminalEffect 0 TmTmClearDisplayedLines]
|
||||||
|
|
||||||
exitTerminalSubInv :: World -> World
|
exitTerminalSubInv :: World -> World
|
||||||
exitTerminalSubInv w = case w ^? cWorld . hud . hudElement . subInventory . termID of
|
exitTerminalSubInv w = case w ^? cWorld . lWorld . hud . hudElement . subInventory . termID of
|
||||||
Just _ -> w & cWorld . hud . hudElement . subInventory .~ NoSubInventory
|
Just _ -> w & cWorld . lWorld . hud . hudElement . subInventory .~ NoSubInventory
|
||||||
_ -> w
|
_ -> w
|
||||||
|
|
||||||
damageCodeCommand :: TerminalCommand
|
damageCodeCommand :: TerminalCommand
|
||||||
@@ -233,7 +233,7 @@ damageCodeCommand =
|
|||||||
|
|
||||||
infoClearInput :: Terminal -> [TerminalLine] -> World -> World
|
infoClearInput :: Terminal -> [TerminalLine] -> World -> World
|
||||||
infoClearInput tm tls =
|
infoClearInput tm tls =
|
||||||
cWorld . terminals . ix (_tmID tm)
|
cWorld . lWorld . terminals . ix (_tmID tm)
|
||||||
%~ ( (tmInput .~ TerminalInput T.empty True (0, 0))
|
%~ ( (tmInput .~ TerminalInput T.empty True (0, 0))
|
||||||
. (tmFutureLines ++.~ tls)
|
. (tmFutureLines ++.~ tls)
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -9,7 +9,7 @@ import LensHelp
|
|||||||
doTerminalEffectLB :: Terminal -> World -> World
|
doTerminalEffectLB :: Terminal -> World -> World
|
||||||
doTerminalEffectLB tm w = guardDisconnected tm w $
|
doTerminalEffectLB tm w = guardDisconnected tm w $
|
||||||
fromMaybe w $ do
|
fromMaybe w $ do
|
||||||
s <- fmap T.unpack $ w ^? cWorld . terminals . ix (_tmID tm) . tmInput . tiText
|
s <- fmap T.unpack $ w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
|
||||||
if null (words s)
|
if null (words s)
|
||||||
then Just $ defocusTerminalInput w
|
then Just $ defocusTerminalInput w
|
||||||
else return $ terminalReturnEffect tm w
|
else return $ terminalReturnEffect tm w
|
||||||
@@ -17,20 +17,20 @@ doTerminalEffectLB tm w = guardDisconnected tm w $
|
|||||||
terminalReturnEffect :: Terminal -> World -> World
|
terminalReturnEffect :: Terminal -> World -> World
|
||||||
terminalReturnEffect tm w = guardDisconnected tm w $
|
terminalReturnEffect tm w = guardDisconnected tm w $
|
||||||
fromMaybe w $ do
|
fromMaybe w $ do
|
||||||
s <- fmap T.unpack $ w ^? cWorld . terminals . ix (_tmID tm) . tmInput . tiText
|
s <- fmap T.unpack $ w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
|
||||||
return $
|
return $
|
||||||
runTerminalString s tm $
|
runTerminalString s tm $
|
||||||
w
|
w
|
||||||
& cWorld . terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>' : s)]
|
& cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>' : s)]
|
||||||
|
|
||||||
defocusTerminalInput :: World -> World
|
defocusTerminalInput :: World -> World
|
||||||
defocusTerminalInput w = fromMaybe w $ do
|
defocusTerminalInput w = fromMaybe w $ do
|
||||||
tmid <- w ^? cWorld . hud . hudElement . subInventory . termID
|
tmid <- w ^? cWorld . lWorld . hud . hudElement . subInventory . termID
|
||||||
return $ w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
|
return $ w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
|
||||||
|
|
||||||
runTerminalString :: String -> Terminal -> World -> World
|
runTerminalString :: String -> Terminal -> World -> World
|
||||||
runTerminalString s tm w =
|
runTerminalString s tm w =
|
||||||
w & cWorld . terminals . ix (_tmID tm)
|
w & cWorld . lWorld . terminals . ix (_tmID tm)
|
||||||
%~ ( (tmInput .~ TerminalInput T.empty True (0, 0))
|
%~ ( (tmInput .~ TerminalInput T.empty True (0, 0))
|
||||||
. (tmFutureLines ++.~ commandFutureLines s tm w)
|
. (tmFutureLines ++.~ commandFutureLines s tm w)
|
||||||
. (tmCommandHistory %~ take 10 . (s :))
|
. (tmCommandHistory %~ take 10 . (s :))
|
||||||
|
|||||||
@@ -43,10 +43,10 @@ moveTeslaArc w pt
|
|||||||
makesparks = makeaspark . makeaspark . makeaspark
|
makesparks = makeaspark . makeaspark . makeaspark
|
||||||
(lp, ld) = case last thearc of
|
(lp, ld) = case last thearc of
|
||||||
ArcStep lp' ld' NothingID -> (lp', ld')
|
ArcStep lp' ld' NothingID -> (lp', ld')
|
||||||
ArcStep lp' ld' (CrID crid) -> case w ^? cWorld . creatures . ix crid of
|
ArcStep lp' ld' (CrID crid) -> case w ^? cWorld . lWorld . creatures . ix crid of
|
||||||
Nothing -> (lp', ld')
|
Nothing -> (lp', ld')
|
||||||
Just cr -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld', ld' + pi)
|
Just cr -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld', ld' + pi)
|
||||||
ArcStep lp' ld' (WlID wlid) -> case w ^? cWorld . walls . ix wlid of
|
ArcStep lp' ld' (WlID wlid) -> case w ^? cWorld . lWorld . walls . ix wlid of
|
||||||
Nothing -> (lp', ld')
|
Nothing -> (lp', ld')
|
||||||
Just _ -> (lp' -.- 2 *.* unitVectorAtAngle ld', ld' + pi)
|
Just _ -> (lp' -.- 2 *.* unitVectorAtAngle ld', ld' + pi)
|
||||||
damthings (ArcStep p dir crwl) = damageCrWlID (thedamage p dir) crwl
|
damthings (ArcStep p dir crwl) = damageCrWlID (thedamage p dir) crwl
|
||||||
@@ -57,7 +57,7 @@ moveTeslaArc w pt
|
|||||||
shootTeslaArc' :: ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
|
shootTeslaArc' :: ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
|
||||||
shootTeslaArc' ip pos dir w =
|
shootTeslaArc' ip pos dir w =
|
||||||
( w & randGen .~ g
|
( w & randGen .~ g
|
||||||
& cWorld . teslaArcs .:~ aTeslaArcAt col newarc
|
& cWorld . lWorld . teslaArcs .:~ aTeslaArcAt col newarc
|
||||||
, ip & currentArc ?~ newarc
|
, ip & currentArc ?~ newarc
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|||||||
@@ -31,7 +31,7 @@ defaultArcStep itparams w (ArcStep p dir _) = do
|
|||||||
. sortOn (dist center . _crPos)
|
. sortOn (dist center . _crPos)
|
||||||
. filter (\cr -> dist center (_crPos cr) < csize)
|
. filter (\cr -> dist center (_crPos cr) < csize)
|
||||||
. IM.elems
|
. IM.elems
|
||||||
$ _creatures (_cWorld w)
|
$ w ^. cWorld . lWorld . creatures --_creatures (_cWorld w)
|
||||||
mwl =
|
mwl =
|
||||||
listToMaybe
|
listToMaybe
|
||||||
. sortOn (dist p . fst)
|
. sortOn (dist p . fst)
|
||||||
|
|||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user