Separate out concrete part of world

This commit is contained in:
2022-07-25 12:10:50 +01:00
parent 3354d108be
commit b2efbd2b3e
134 changed files with 933 additions and 930 deletions
+1 -1
View File
@@ -97,7 +97,7 @@ updateRenderSplit u = do
playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound) playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound)
playSoundUnlessRewinding u playSoundUnlessRewinding u
| _timeFlow w == RewindingNow = return M.empty | _timeFlow (_cWorld w) == RewindingNow = return M.empty
| otherwise = playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (_toPlaySounds w) | otherwise = playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (_toPlaySounds w)
where where
w = _uvWorld u w = _uvWorld u
+3 -3
View File
@@ -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 = foldr ($) (hiss w & creatures . at (_crID cr) .~ newCr) pierceSparks | _crHP cr > 0 = foldr ($) (hiss w & cWorld . creatures . at (_crID cr) .~ newCr) pierceSparks
| otherwise = makeExplosionAt (_crPos cr) $ stopSounds w & creatures . at (_crID cr) .~ Nothing | otherwise = makeExplosionAt (_crPos cr) $ stopSounds w & cWorld . creatures . at (_crID cr) .~ Nothing
where where
g = _randGen w g = _randGen w
damages = _csDamage $ _crState cr damages = _csDamage $ _crState cr
@@ -40,7 +40,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 = creatures . at (_crID cr) .~ Nothing | otherwise = cWorld . creatures . at (_crID cr) .~ Nothing
damToExpBarrel :: [Damage] -> Creature -> Creature damToExpBarrel :: [Damage] -> Creature -> Creature
damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
+7 -7
View File
@@ -161,7 +161,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 = _cameraViewFrom w vPos = _cameraViewFrom $ _cWorld w
--allVisibleWalls :: World -> StreamOf (Point2,Wall) --allVisibleWalls :: World -> StreamOf (Point2,Wall)
--{-# INLINE allVisibleWalls #-} --{-# INLINE allVisibleWalls #-}
@@ -242,7 +242,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 ^? creatures . ix cid) || bl f cid bl = maybe False (\cr -> dist p (_crPos cr) < r + _crRad cr) (w ^? cWorld . creatures . ix cid) || bl
{- | More general collision tests follow -} {- | More general collision tests follow -}
@@ -274,22 +274,22 @@ 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 w IM.! i) p1 = _crPos (_creatures (_cWorld w) IM.! i)
p2 = _crPos (_creatures w IM.! j) p2 = _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 w IM.! i) ipos = _crPos (_creatures (_cWorld w) IM.! i)
jpos = _crPos (_creatures w IM.! j) jpos = _crPos (_creatures (_cWorld w) IM.! j)
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)
where where
hitCr = IS.foldr f False $ crsNearSeg sp ep w hitCr = IS.foldr f False $ crsNearSeg sp ep w
f cid bl = maybe False (\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep) f cid bl = maybe False (\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
(w ^? creatures . ix cid) (w ^? cWorld . creatures . ix cid)
|| bl || bl
hitWl = collideCircWalls sp ep rad $ wlsNearPoint ep w hitWl = collideCircWalls sp ep rad $ wlsNearPoint ep w
+12 -12
View File
@@ -7,31 +7,31 @@ import Geometry
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 -.- _cameraCenter w doTranslate p = p -.- _cameraCenter (_cWorld w)
doZoom p = _cameraZoom w *.* p doZoom p = _cameraZoom (_cWorld w) *.* p
doRotate p = rotateV (negate $ _cameraRot w) p doRotate p = rotateV (negate $ _cameraRot (_cWorld w)) 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.
- This allows for line thicknesses etc to correspond to pixel sizes.-} - This allows for line thicknesses etc to correspond to pixel sizes.-}
worldPosToScreen :: World -> Point2 -> Point2 worldPosToScreen :: World -> Point2 -> Point2
worldPosToScreen w worldPosToScreen w
= rotateV (negate $ _cameraRot w) = rotateV (negate $ _cameraRot (_cWorld w))
. (_cameraZoom w *.*) . (_cameraZoom (_cWorld w) *.*)
. (-.- _cameraCenter w) . (-.- _cameraCenter (_cWorld w))
{- | Transform coordinates from the map position to screen {- | Transform coordinates from the map position to screen
coordinates. -} 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 w) doTranslate p = p -.- _carteCenter (_hud (_cWorld w))
doZoom p = _carteZoom (_hud w) *.* p doZoom p = _carteZoom (_hud (_cWorld w)) *.* p
doRotate p = rotateV (negate $ _carteRot (_hud w)) p doRotate p = rotateV (negate $ _carteRot (_hud (_cWorld w))) 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)
{- | The mouse position in world coordinates. -} {- | The mouse position in world coordinates. -}
mouseWorldPos :: World -> Point2 mouseWorldPos :: World -> Point2
mouseWorldPos w = _cameraCenter w +.+ (1/_cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w) mouseWorldPos w = _cameraCenter (_cWorld w) +.+ (1/_cameraZoom (_cWorld w)) *.* rotateV (_cameraRot (_cWorld w)) (_mousePos (_cWorld w))
{- | The mouse position in map coordinates -} {- | The mouse position in map coordinates -}
mouseCartePos :: World -> Point2 mouseCartePos :: World -> Point2
mouseCartePos w = _carteCenter (_hud w) +.+ (1/_carteZoom (_hud w)) mouseCartePos w = _carteCenter (_hud (_cWorld w)) +.+ (1/_carteZoom (_hud (_cWorld w)))
*.* rotateV (_carteRot (_hud w)) (_mousePos w) *.* rotateV (_carteRot (_hud (_cWorld w))) (_mousePos (_cWorld w))
+5 -5
View File
@@ -15,10 +15,10 @@ screenPolygon :: Configuration -> World -> [Point2]
screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig
-- [tr,tl,bl,br] -- [tr,tl,bl,br]
where where
scRot = rotateV (_cameraRot w) scRot = rotateV (_cameraRot (_cWorld w))
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p scZoom p | _cameraZoom (_cWorld w) /= 0 = (1/_cameraZoom (_cWorld w)) *.* p
| otherwise = p | otherwise = p
scTran p = p +.+ _cameraCenter w scTran p = p +.+ _cameraCenter (_cWorld w)
-- tr = scTran $ scRot $ scZoom (V2 ( halfWidth w) ( halfHeight w)) -- tr = scTran $ scRot $ scZoom (V2 ( halfWidth w) ( halfHeight w))
-- tl = 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)) -- br = scTran $ scRot $ scZoom (V2 ( halfWidth w) (-halfHeight w))
@@ -35,9 +35,9 @@ screenPolygonBord xbord ybord cfig w = [tr,tl,bl,br]
where where
hw = halfWidth cfig - xbord hw = halfWidth cfig - xbord
hh = halfHeight cfig - ybord hh = halfHeight cfig - ybord
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p scZoom p | _cameraZoom (_cWorld w) /= 0 = (1/_cameraZoom (_cWorld w)) *.* p
| otherwise = p | otherwise = p
theTransform = (+.+ _cameraCenter w) . rotateV (_cameraRot w) . scZoom theTransform = (+.+ _cameraCenter (_cWorld w)) . rotateV (_cameraRot (_cWorld w)) . 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))
+1 -1
View File
@@ -5,7 +5,7 @@ import qualified IntMapHelp as IM
--import Control.Lens --import Control.Lens
you :: World -> Creature you :: World -> Creature
you w = _creatures w IM.! _yourID w you w = _creatures (_cWorld w) IM.! _yourID (_cWorld w)
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 -4
View File
@@ -27,20 +27,20 @@ flameBeamCombine (p,(a,b,_),(x,y,_))
lasBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) lasBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-> World -> World -> World -> World
lasBeamCombine (p,(a,b,_),(x,y,_)) lasBeamCombine (p,(a,b,_),(x,y,_))
= lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))) = cWorld . lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
splitBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) splitBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-> World -> World -> World -> World
splitBeamCombine (p,(a,b,_),(x,y,_)) splitBeamCombine (p,(a,b,_),(x,y,_))
= (lasers .:~ lasRayAt yellow 11 1 p (dir+0.5*pi)) = (cWorld . lasers .:~ lasRayAt yellow 11 1 p (dir+0.5*pi))
. (lasers .:~ lasRayAt yellow 11 1 p (dir-0.5*pi)) . (cWorld . 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))
teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-> World -> World -> World -> World
teslaBeamCombine (p,(a,b,bm),(x,y,_)) w teslaBeamCombine (p,(a,b,bm),(x,y,_)) w
= w' & pointToItem (_itemPositions w IM.! itid) . itParams . subParams ?~ ip = w' & pointToItem (_itemPositions (_cWorld w) IM.! 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))
+14 -14
View File
@@ -28,14 +28,14 @@ splinterBlock bl w = foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardC
(weakenMatS bm) (_blPos bl) (weakenMatS bm) (_blPos bl)
where where
bm = fromMaybe Stone $ do bm = fromMaybe Stone $ do
wlids <- w ^? blocks . ix (_blID bl) . blWallIDs wlids <- w ^? cWorld . blocks . ix (_blID bl) . blWallIDs
(wlid,_) <- IS.minView wlids (wlid,_) <- IS.minView wlids
w ^? walls . ix wlid . wlMaterial w ^? cWorld . walls . ix wlid . wlMaterial
unshadowBlock :: Int -> World -> World unshadowBlock :: Int -> World -> World
unshadowBlock wlid w = case w ^? walls . ix wlid of unshadowBlock wlid w = case w ^? cWorld . walls . ix wlid of
Just wl -> w Just wl -> w
& walls . ix wlid . wlUnshadowed .~ True & cWorld . walls . ix wlid . wlUnshadowed .~ True
& insertWallInZones (wl & wlUnshadowed .~ True) & insertWallInZones (wl & wlUnshadowed .~ True)
Nothing -> w Nothing -> w
@@ -50,13 +50,13 @@ destroyBlock bl w = 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
& blocks %~ IM.delete (_blID bl) & cWorld . blocks %~ IM.delete (_blID bl)
-- & matDesSound (_blMaterial bl) pos -- & matDesSound (_blMaterial bl) pos
& flip (foldr (wlDustAt awl)) (map (pos +.+) ps) & flip (foldr (wlDustAt awl)) (map (pos +.+) ps)
where where
wlids = _blWallIDs bl wlids = _blWallIDs bl
awl = _walls w IM.! IS.findMin wlids awl = _walls (_cWorld w) IM.! IS.findMin wlids
pos = fst . _wlLine $ _walls w IM.! IS.findMin wlids pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids
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
@@ -67,20 +67,20 @@ maybeClearPath :: World -> (Int,Int,PathEdge) -> World
maybeClearPath w (x,y,pe) maybeClearPath w (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 & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles .~ mempty) . FGL.delEdge (x,y) | otherwise = w & cWorld . pathGraph %~ FGL.insEdge (x,y,pe & peObstacles .~ mempty) . FGL.delEdge (x,y)
destroyDoor :: Door -> World -> World destroyDoor :: Door -> World -> World
destroyDoor dr w = w destroyDoor dr w = w
& doDrWdWd (_drDeath dr) dr & doDrWdWd (_drDeath dr) dr
& deleteWallIDs wlids & deleteWallIDs wlids
& doors %~ IM.delete (_drID dr) & cWorld . doors %~ IM.delete (_drID dr)
& flip (foldr (wlDustAt awl)) (map (pos +.+) ps) & flip (foldr (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 w IM.! IS.findMin wlids awl = _walls (_cWorld w) IM.! IS.findMin wlids
pos = fst . _wlLine $ _walls w IM.! IS.findMin wlids pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids
ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
destroyMounts :: [MountedObject] -> World -> World destroyMounts :: [MountedObject] -> World -> World
@@ -89,11 +89,11 @@ destroyMounts mos w = foldr 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 -> props . at prid .~ Nothing MountedProp prid -> cWorld . 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 ^? doors . ix drid dr <- w ^? cWorld . doors . ix drid
return $ w & doors . ix drid . drMech .~ DrWdId return $ w & cWorld . doors . ix drid . drMech .~ DrWdId
& stopPushing (_drPushes dr) & stopPushing (_drPushes dr)
+6 -6
View File
@@ -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 ^? doors . ix (_drID dr) . drWallIDs wlids <- w ^? cWorld . doors . ix (_drID dr) . drWallIDs
(wlid,_) <- IS.minView wlids (wlid,_) <- IS.minView wlids
wl <- w ^? walls . ix wlid wl <- w ^? cWorld . walls . ix wlid
return (_wlMaterial wl,_wlColor wl) return (_wlMaterial wl,_wlColor wl)
makeBlockDebris :: Block -> World -> World makeBlockDebris :: Block -> World -> World
@@ -32,9 +32,9 @@ makeBlockDebris bl w = foldr (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 ^? blocks . ix (_blID bl) . blWallIDs wlids <- w ^? cWorld . blocks . ix (_blID bl) . blWallIDs
(wlid,_) <- IS.minView wlids (wlid,_) <- IS.minView wlids
wl <- w ^? walls . ix wlid wl <- w ^? cWorld . 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
@@ -46,7 +46,7 @@ makeDebris = makeDebrisDirected 1 2 (2*pi) 0
makeDebrisDirectedHeight :: Float -> Float -> Float -> Float -> Float -> Material makeDebrisDirectedHeight :: Float -> Float -> Float -> Float -> Float -> Material
-> Color -> Point2 -> World -> World -> Color -> Point2 -> World -> World
makeDebrisDirectedHeight mindist maxdist arcrad dir maxh bm col p w = w makeDebrisDirectedHeight mindist maxdist arcrad dir maxh bm col p w = w
& flip (foldl' (flip $ plNew props prID)) thedebris & flip (foldl' (flip $ plNew (cWorld . 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
@@ -75,7 +75,7 @@ makeDebrisDirected :: Float
-> Point2 -> Point2
-> World -> World -> World -> World
makeDebrisDirected mindist maxdist arcrad dir bm col p w = w makeDebrisDirected mindist maxdist arcrad dir bm col p w = w
& flip (foldl' (flip $ plNew props prID)) thedebris & flip (foldl' (flip $ plNew (cWorld . 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
View File
@@ -25,7 +25,7 @@ updateBullet w bu = case _buState bu of
_ -> mvBullet 1 w bu _ -> mvBullet 1 w bu
useAmmoParams :: Item -> Creature -> World -> World useAmmoParams :: Item -> Creature -> World -> World
useAmmoParams it cr w = w & instantBullets .:~ (_amBullet bultype useAmmoParams it cr w = w & cWorld . instantBullets .:~ (_amBullet bultype
& buPos .~ sp & buPos .~ sp
& buTrajectory %~ settrajectory & buTrajectory %~ settrajectory
& buVel %~ (rotateV dir . (muzvel *.*)) & buVel %~ (rotateV dir . (muzvel *.*))
@@ -60,7 +60,7 @@ mvBullet x w bt'
partspawn <- bulletSpawn bt' partspawn <- bulletSpawn bt'
return $ partspawn p w' return $ partspawn p w'
hitstream = thingsHit p (p +.+ vel) w hitstream = thingsHit p (p +.+ vel) w
bt = foldr (\mg b -> doMagnetBuBu (_mgField mg) mg b) bt' (_magnets w) bt = foldr (\mg b -> doMagnetBuBu (_mgField mg) mg b) bt' (_magnets (_cWorld w))
& buState .~ NormalBulletState & buState .~ NormalBulletState
dodrag = case _buTrajectory bt of dodrag = case _buTrajectory bt of
BasicBulletTrajectory -> buVel .*.*~ drag BasicBulletTrajectory -> buVel .*.*~ drag
@@ -84,7 +84,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 -> shockwaves .:~ concBall p BulBall ConcBall -> Just $ \p -> cWorld . shockwaves .:~ concBall p
BulBall TeslaBall -> Just makeStaticBall BulBall TeslaBall -> Just makeStaticBall
hitEffFromBul :: Float -> Bullet hitEffFromBul :: Float -> Bullet
@@ -112,8 +112,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 -> creatures . ix (_crID cr) . crState . csDamage .++~ dams Left cr -> cWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams Right wl -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
where where
dams = setFromToDams bu p dams = setFromToDams bu p
+4 -4
View File
@@ -9,8 +9,8 @@ doButtonEvent :: ButtonEvent -> Button -> World -> World
doButtonEvent be = case be of doButtonEvent be = case be of
ButtonDoNothing -> const id ButtonDoNothing -> const id
ButtonPress newstate newevent thesound f -> \b -> doWorldEffect f ButtonPress newstate newevent thesound f -> \b -> doWorldEffect f
. set (buttons . ix (_btID b) . btState) newstate . set (cWorld . buttons . ix (_btID b) . btState) newstate
. set (buttons . ix (_btID b) . btEvent) newevent . set (cWorld . 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
@@ -19,9 +19,9 @@ doButtonEvent be = case be of
flipSwitch :: WdWd -> WdWd -> Button -> World -> World flipSwitch :: WdWd -> WdWd -> Button -> World -> World
flipSwitch oneff offeff bt flipSwitch oneff offeff bt
| _btState bt == BtOff = doWorldEffect oneff . dosound | _btState bt == BtOff = doWorldEffect oneff . dosound
. over (buttons . ix (_btID bt)) turnon . over (cWorld . buttons . ix (_btID bt)) turnon
| otherwise = doWorldEffect offeff . dosound | otherwise = doWorldEffect offeff . dosound
. over (buttons . ix (_btID bt)) turnoff . over (cWorld . 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/")
+1 -1
View File
@@ -9,5 +9,5 @@ clockCycle :: Int -> V.Vector a -> World -> a
clockCycle tPeriod xs w = xs V.! i clockCycle tPeriod xs w = xs V.! i
where where
l = V.length xs l = V.length xs
t = _worldClock w `mod` (l * tPeriod) t = _worldClock (_cWorld w) `mod` (l * tPeriod)
i = t `div` tPeriod i = t `div` tPeriod
+3 -3
View File
@@ -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 w) of toggleCombineInv w = case _hudElement (_hud (_cWorld w)) of
DisplayInventory CombineInventory {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory DisplayInventory CombineInventory {} -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & enterCombineInv _ -> w & enterCombineInv
enterCombineInv :: World -> World enterCombineInv :: World -> World
enterCombineInv w = w & hud . hudElement .~ DisplayInventory (CombineInventory mi) enterCombineInv w = w & cWorld . hud . hudElement .~ DisplayInventory (CombineInventory mi)
where where
mi = 0 <$ listToMaybe (combineItemListYou w) mi = 0 <$ listToMaybe (combineItemListYou w)
+15 -15
View File
@@ -66,7 +66,7 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
aimSp = case cr ^? crMvType . mvAimSpeed of aimSp = case cr ^? crMvType . mvAimSpeed of
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 | canSee' = _crPos (_creatures w IM.! tcid) tpos | canSee' = _crPos (_creatures (_cWorld w) IM.! tcid)
| otherwise = p | otherwise = p
performPathTo :: Creature -> World -> Point2 -> OutAction performPathTo :: Creature -> World -> Point2 -> OutAction
@@ -159,8 +159,8 @@ blinkActionFail
-> World -> World
blinkActionFail cr w = w blinkActionFail cr w = w
& soundMultiFrom [TeleSound 0,TeleSound 1] p3 teleS Nothing & soundMultiFrom [TeleSound 0,TeleSound 1] p3 teleS Nothing
& distortions .:~ distortionBulge & cWorld . distortions .:~ distortionBulge
& creatures . ix cid . crPos .~ p3 & cWorld . creatures . ix cid . crPos .~ p3
& inverseShockwaveAt cpos 40 2 2 & inverseShockwaveAt cpos 40 2 2
where where
distR = 120 distR = 120
@@ -176,8 +176,8 @@ blinkActionFail cr w = w
blinkAction :: Creature -> World -> World blinkAction :: Creature -> World -> World
blinkAction cr w = w blinkAction cr w = w
& soundMultiFrom [TeleSound 0,TeleSound 1] p3 teleS Nothing & soundMultiFrom [TeleSound 0,TeleSound 1] p3 teleS Nothing
& distortions .++~ distortionBulge & cWorld . distortions .++~ distortionBulge
& creatures . ix cid . crPos .~ p3 & cWorld . creatures . ix cid . crPos .~ p3
& blinkShockwave cid p3 & blinkShockwave cid p3
& inverseShockwaveAt cpos 40 2 2 & inverseShockwaveAt cpos 40 2 2
where where
@@ -201,13 +201,13 @@ unsafeBlinkAction
-> World -> World
unsafeBlinkAction cr w unsafeBlinkAction cr w
| success = soundMultiFrom [TeleSound 0,TeleSound 1] mwp teleS Nothing | success = soundMultiFrom [TeleSound 0,TeleSound 1] mwp teleS Nothing
. over distortions (distortionBulge ++) . (cWorld . distortions .++~ distortionBulge)
. set (creatures . ix cid . crPos) mwp . set (cWorld . creatures . ix cid . crPos) mwp
. blinkShockwave cid mwp . blinkShockwave cid mwp
$ inverseShockwaveAt cpos 40 2 2 w $ inverseShockwaveAt cpos 40 2 2 w
| otherwise = w | otherwise = w
& blinkActionFail cr & blinkActionFail cr
& creatures . ix cid . crState . csDamage .:~ & cWorld . 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
@@ -230,20 +230,20 @@ blinkShockwave
blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan
setMinInvSize :: Int -> Creature -> World -> World setMinInvSize :: Int -> Creature -> World -> World
setMinInvSize n cr = creatures . ix (_crID cr) . crInvCapacity .~ n setMinInvSize n cr = cWorld . 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 = organiseInvKeys (_crID cr) . stripNoItems cr = organiseInvKeys (_crID cr) .
( creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just ) ( cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just )
organiseInvKeys :: Int -> World -> World organiseInvKeys :: Int -> World -> World
organiseInvKeys cid w = w & creatures . ix cid %~ organiseInvKeys cid w = w & cWorld . creatures . ix cid %~
( ( crInvSel . iselPos .~ newSelKey ) ( ( crInvSel . iselPos .~ newSelKey )
. ( crInv .~ newInv ) . ( crInv .~ newInv )
. ( crInvSel . iselAction .~ NoInvSelAction) ) . ( crInvSel . iselAction .~ NoInvSelAction) )
where where
cr = _creatures w IM.! cid cr = _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
@@ -291,8 +291,8 @@ sizeSelf x cr w
-- | _crPos cr1 == _crPos cr2 = Just $ w -- | _crPos cr1 == _crPos cr2 = Just $ w
| not (crOnWall cr1 w) = Just $ w | not (crOnWall cr1 w) = Just $ w
& soundMultiFrom [TeleSound 0,TeleSound 1] cpos teleS Nothing & soundMultiFrom [TeleSound 0,TeleSound 1] cpos teleS Nothing
& over distortions (distortionBulge :) & cWorld . distortions .:~ distortionBulge
& creatures . ix cid %~ & cWorld . 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))
@@ -309,7 +309,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 w IM.! flid) w pickUpItemID cid flid w = pickUpItem cid (_floorItems (_cWorld w) IM.! flid) w
{- | Pick up a specific item. -} {- | Pick up a specific item. -}
pickUpItem :: Int -> FloorItem -> World -> World pickUpItem :: Int -> FloorItem -> World -> World
+8 -8
View File
@@ -175,7 +175,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 w IM.! _crGroupID (_crGroup $ _creatures w IM.! cid) cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup $ _creatures (_cWorld w) IM.! cid)
flockChaseTarget flockChaseTarget
:: (Creature -> IM.IntMap Creature -> Creature -> Creature) -- ^ Update with target :: (Creature -> IM.IntMap Creature -> Creature -> Creature) -- ^ Update with target
@@ -188,7 +188,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 w) is crs = IM.restrictKeys (_creatures (_cWorld w)) is
flockPointTarget flockPointTarget
:: (Creature -> IM.IntMap Creature -> Creature -> Point2) :: (Creature -> IM.IntMap Creature -> Creature -> Point2)
@@ -201,7 +201,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 w) is crs = IM.restrictKeys (_creatures (_cWorld w)) is
p = f crTarg crs cr p = f crTarg crs cr
flockToPointUsing flockToPointUsing
@@ -213,7 +213,7 @@ 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 w IM.! _crGroupID (_crGroup cr) cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
ptarg = pf tcr cenp cr ptarg = pf tcr cenp cr
flockToPointUsing' flockToPointUsing'
:: (Creature -> Point2 -> Creature -> Point2) :: (Creature -> Point2 -> Creature -> Point2)
@@ -225,7 +225,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 w IM.! _crGroupID (_crGroup cr) cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
ptarg = pf tcr cenp cr ptarg = pf tcr cenp cr
flockFunc flockFunc
@@ -237,7 +237,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 w IM.! _crGroupID (_crGroup cr) cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
p = f crTarg cenp cr p = f crTarg cenp cr
flockCenterFunc flockCenterFunc
@@ -249,7 +249,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 w IM.! _crGroupID (_crGroup cr) cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
p = f crTarg cenp cr p = f crTarg cenp cr
flockPointTargetR flockPointTargetR
@@ -262,7 +262,7 @@ 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 w) is crs = IM.restrictKeys (_creatures (_cWorld w)) is
p = f crTarg crs cr p = f crTarg crs cr
meleeHeadingMove meleeHeadingMove
+5 -5
View File
@@ -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 = foldl' (applyIndividualDamage cr) w ds' defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds'
& creatures . ix (_crID cr) %~ doPoisonDam & cWorld . 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 = foldl' (applyIndividualDamage cr) w ds'
applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World
applyDamageEffect dm de cr w = case de of applyDamageEffect dm de cr w = case de of
PushDamage push pushexp pushRad -> w PushDamage push pushexp pushRad -> w
& creatures . ix (_crID cr) . crPos .+.+~ pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir) & cWorld . 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 -> w PushBackDamage pback -> w
& creatures . ix (_crID cr) . crPos .+.+~ (pback/_crMass cr) *.* (_dmTo dm -.- fromDir) & cWorld . creatures . ix (_crID cr) . crPos .+.+~ (pback/_crMass cr) *.* (_dmTo dm -.- fromDir)
TorqueDamage rot -> w TorqueDamage rot -> w
& creatures . ix (_crID cr) . crDir +~ rot & cWorld . creatures . ix (_crID cr) . crDir +~ rot
NoDamageEffect -> w NoDamageEffect -> w
where where
fromDir = _dmFrom dm fromDir = _dmFrom dm
@@ -62,7 +62,7 @@ applyPiercingDamage cr dm
p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr) p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)
damageHP :: Creature -> Int -> World -> World damageHP :: Creature -> Int -> World -> World
damageHP cr x = creatures . ix (_crID cr) %~ damageHP cr x = cWorld . creatures . ix (_crID cr) %~
( (crHP -~ x) ( (crHP -~ x)
. (crPastDamage +~ x) . (crPastDamage +~ x)
) )
+4 -4
View File
@@ -24,14 +24,14 @@ impulsiveAIBeforeAfter
:: (World -> Creature -> Creature) :: (World -> Creature -> Creature)
-> (World -> Creature -> Creature) -> (World -> Creature -> Creature)
-> Creature -> World -> World -> Creature -> World -> World
impulsiveAIBeforeAfter startup endup cr w = w' & creatures . ix (_crID cr) .~ endup w' cr' impulsiveAIBeforeAfter startup endup cr w = w' & cWorld . creatures . ix (_crID cr) .~ endup w' cr'
where where
w' = g w w' = g w
(g,cr') = impulsiveAI startup cr w (g,cr') = impulsiveAI startup cr w
impulsiveAIBefore :: (World -> Creature -> Creature) impulsiveAIBefore :: (World -> Creature -> Creature)
-> Creature -> World -> World -> Creature -> World -> World
impulsiveAIBefore f cr w = g w & creatures . ix (_crID cr) .~ cr' impulsiveAIBefore f cr w = g w & cWorld . creatures . ix (_crID cr) .~ cr'
where where
(g,cr') = impulsiveAI f cr w (g,cr') = impulsiveAI f cr w
@@ -94,9 +94,9 @@ 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 w IM.! cid' posFromID cid' = _crPos $ _creatures (_cWorld w) IM.! cid'
rr a = randomR (-a,a) $ _randGen w rr a = randomR (-a,a) $ _randGen w
hitCr i = (creatures . ix i . crState . csDamage hitCr i = (cWorld . 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
+19 -14
View File
@@ -20,11 +20,11 @@ import Data.Maybe
useItem :: Creature -> World -> World useItem :: Creature -> World -> World
useItem cr' w = fromMaybe (f w) $ do useItem cr' w = fromMaybe (f w) $ do
cr <- w ^? creatures . ix (_crID cr') cr <- w ^? cWorld . 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 = creatures . ix (_crID cr') . crHammerPosition .~ HammerDown f = cWorld . 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
@@ -40,13 +40,13 @@ 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 = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown setuhamdown = cWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions w) (crSel cr) cr doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions (_cWorld w)) (crSel cr) cr
. activateEquipmentAt (_rbOptions w) cr) . activateEquipmentAt (_rbOptions (_cWorld w)) cr)
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 w && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False | _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons (_cWorld w) M.!? SDL.ButtonLeft == Just False
= crToggleReloading cr = crToggleReloading cr
| otherwise | otherwise
= (runIdentity . pointToItem (_itPos it) (return . (itUse . useHammer .~ HammerDown))) = (runIdentity . pointToItem (_itPos it) (return . (itUse . useHammer .~ HammerDown)))
@@ -58,7 +58,7 @@ itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic)
ic = _itConsumption it ic = _itConsumption it
activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
activateEquipmentAt rbo cr = creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of activateEquipmentAt rbo cr = cWorld . 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
@@ -67,31 +67,36 @@ toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World
toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
Just DoNotMoveEquipment -> w Just DoNotMoveEquipment -> w
Just PutOnEquipment {_allocNewPos = newp} Just PutOnEquipment {_allocNewPos = newp}
-> w & crpoint . crEquipment . at newp ?~ invid -> w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInvEquipped . at invid ?~ newp & crpoint . crInvEquipped . at invid ?~ newp
& onequip itm cr & onequip itm cr
Just MoveEquipment {_allocNewPos=newp,_allocOldPos = oldp } Just MoveEquipment {_allocNewPos=newp,_allocOldPos = oldp }
-> w & crpoint . crEquipment . at newp ?~ invid -> w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp .~ Nothing & crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInvEquipped . at invid ?~ newp & crpoint . crInvEquipped . at invid ?~ newp
Just SwapEquipment {_allocNewPos=newp, _allocOldPos = oldp, _allocSwapID = sid } Just SwapEquipment {_allocNewPos=newp, _allocOldPos = oldp, _allocSwapID = sid }
-> w & crpoint . crEquipment . at newp ?~ invid -> w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp ?~ sid & crpoint . crEquipment . at oldp ?~ sid
& crpoint . crInvEquipped . at invid ?~ newp & crpoint . crInvEquipped . at invid ?~ newp
& crpoint . crInvEquipped . at sid ?~ oldp & crpoint . crInvEquipped . at sid ?~ oldp
Just ReplaceEquipment {_allocNewPos = newp, _allocRemoveID = rid } Just ReplaceEquipment {_allocNewPos = newp, _allocRemoveID = rid }
-> w & crpoint . crEquipment . at newp ?~ invid -> w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInvEquipped . at invid ?~ newp & crpoint . crInvEquipped . at invid ?~ newp
& crpoint . crInvEquipped . at rid .~ Nothing & crpoint . crInvEquipped . at rid .~ Nothing
& onremove (itmat rid) cr & onremove (itmat rid) cr
& onequip itm cr & onequip itm cr
Just RemoveEquipment {_allocOldPos = oldp } Just RemoveEquipment {_allocOldPos = oldp }
-> w & crpoint . crEquipment . at oldp .~ Nothing -> w
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInvEquipped . at invid .~ Nothing & crpoint . crInvEquipped . at invid .~ Nothing
& 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 = creatures . ix (_crID cr) crpoint = cWorld . 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 ((_eqOnEquip . _eqEq . _itUse) itm') itm' onequip itm' = useE ((_eqOnEquip . _eqEq . _itUse) itm') itm'
@@ -110,7 +115,7 @@ useLeftItem cid w
. useL f itm cr . useL f itm cr
$ w $ w
where where
cr = _creatures w IM.! cid cr = _creatures (_cWorld w) IM.! cid
itmShouldBeUsed = isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse) itmShouldBeUsed = isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
|| ( isJust (cr ^? crInv . ix (crSel cr) . itUse . eqEq . eqUse) || ( isJust (cr ^? crInv . ix (crSel cr) . itUse . eqEq . eqUse)
&& _crLeftInvSel cr /= Just (crSel cr) && _crLeftInvSel cr /= Just (crSel cr)
+2 -2
View File
@@ -91,7 +91,7 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
in crActionPlan . apStrategy .~ StrategyActions WarningCry in crActionPlan . apStrategy .~ StrategyActions WarningCry
[ImpulsesList ([Bark soundid]: replicate numjits [RandomImpulse thejitter]++ [ImpulsesList ([Bark soundid]: replicate numjits [RandomImpulse thejitter]++
[[ChangeStrategy $ CloseToMelee 0] ]) [[ChangeStrategy $ CloseToMelee 0] ])
, AimAt 0 (_crPos $ _creatures w IM.! 0) , AimAt 0 (_crPos $ _creatures (_cWorld w) IM.! 0)
] ]
| otherwise = id | otherwise = id
@@ -139,7 +139,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 w IM.! cid tpos = _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
+2 -2
View File
@@ -21,8 +21,8 @@ creatureDisplayText w cr = setLayer DebugLayer
] ]
) w cr ) w cr
where where
campos = _cameraViewFrom w campos = _cameraViewFrom (_cWorld w)
theScale = 0.15 / _cameraZoom w theScale = 0.15 / _cameraZoom (_cWorld w)
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
+1 -1
View File
@@ -172,7 +172,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 w IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures w IM.! 0 Just (Cognizant _) -> _creatures (_cWorld w) IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
_ -> cr & crIntention . targetCr .~ Nothing _ -> cr & crIntention . targetCr .~ Nothing
searchIfDamaged :: Creature -> Creature searchIfDamaged :: Creature -> Creature
+1 -1
View File
@@ -10,6 +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 w IM.! 0 Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
_ -> cr & crIntention . targetCr .~ Nothing _ -> cr & crIntention . targetCr .~ Nothing
+16 -16
View File
@@ -32,7 +32,7 @@ foldCr :: [Creature -> World -> World]
--foldCr xs cr w = foldr ($ cr) w xs --foldCr xs cr w = foldr ($ cr) w xs
foldCr xs cr w = foldr f w xs foldCr xs cr w = foldr f w xs
where where
f g w' = case w' ^? creatures . ix (_crID cr) of f g w' = case w' ^? cWorld . creatures . ix (_crID cr) of
Just cr' -> g cr' w' Just cr' -> g cr' w'
Nothing -> w' Nothing -> w'
@@ -66,15 +66,15 @@ checkDeath cr w
& corpseOrGib cr & corpseOrGib cr
where where
removecr removecr
| _crID cr == 0 = (creatures . ix (_crID cr) . crType .~ NonDrawnCreature) | _crID cr == 0 = (cWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
. (creatures . ix (_crID cr) . crHP .~ 0) . (cWorld . 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 = creatures . at (_crID cr) .~ Nothing | otherwise = cWorld . 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 corpses cpID (thecorpse & cpSPic %~ scorchSPic) Just (FLAMING,_) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
Just (ELECTRICAL,_) -> w & plNew corpses cpID thecorpse Just (ELECTRICAL,_) -> w & plNew (cWorld . corpses) cpID thecorpse
Just (POISONDAM,_) -> w & plNew corpses cpID (thecorpse & cpSPic %~ poisonSPic) Just (POISONDAM,_) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
_ | _crPastDamage cr > 200 -> w & addCrGibs cr _ | _crPastDamage cr > 200 -> w & addCrGibs cr
& bloodPuddleAt cpos & bloodPuddleAt cpos
& bloodPuddleAt cpos & bloodPuddleAt cpos
@@ -82,7 +82,7 @@ corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
_ -> w _ -> w
& bloodPuddleAt cpos & bloodPuddleAt cpos
& bloodPuddleAt cpos & bloodPuddleAt cpos
& plNew corpses cpID thecorpse & plNew (cWorld . corpses) cpID thecorpse
where where
cpos = _crPos cr cpos = _crPos cr
thecorpse = makeDefaultCorpse cr thecorpse = makeDefaultCorpse cr
@@ -104,14 +104,14 @@ poisonSPic = over _1 $
bloodPuddleAt :: Point2 -> World -> World bloodPuddleAt :: Point2 -> World -> World
bloodPuddleAt p w = w bloodPuddleAt p w = w
& snd . plNewID decorations & snd . plNewID (cWorld . 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
(q,g) = randInCirc 10 & runState $ _randGen w (q,g) = randInCirc 10 & runState $ _randGen w
internalUpdate :: Creature -> World -> World internalUpdate :: Creature -> World -> World
internalUpdate cr = creatures . ix (_crID cr) %~ internalUpdate cr = cWorld . creatures . ix (_crID cr) %~
( (crHammerPosition %~ moveHammerUp) ( (crHammerPosition %~ moveHammerUp)
. stepReloading . stepReloading
. updateMovement . updateMovement
@@ -127,7 +127,7 @@ dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath o
clearDamage :: Creature -> World -> World clearDamage :: Creature -> World -> World
clearDamage cr w = w clearDamage cr w = w
& creatures . ix (_crID cr) . crState . csDamage .~ [] & cWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
doDamage :: Creature -> World -> World doDamage :: Creature -> World -> World
doDamage cr w = w doDamage cr w = w
@@ -140,13 +140,13 @@ doDamage cr w = w
applyPastDamages :: Creature -> World -> World applyPastDamages :: Creature -> World -> World
applyPastDamages cr w applyPastDamages cr w
| _crPastDamage cr > 200 = let (p,g) = runState (randInCirc 3) (_randGen w) | _crPastDamage cr > 200 = let (p,g) = runState (randInCirc 3) (_randGen w)
in w & creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100)) in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100))
& randGen .~ g & randGen .~ g
| _crPastDamage cr > 20 = let (p,g) = runState (randInCirc 2) (_randGen w) | _crPastDamage cr > 20 = let (p,g) = runState (randInCirc 2) (_randGen w)
in w & creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10)) in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10))
& randGen .~ g & randGen .~ g
| _crPastDamage cr > 0 = let (p,g) = runState (randInCirc 1) (_randGen w) | _crPastDamage cr > 0 = let (p,g) = runState (randInCirc 1) (_randGen w)
in w & creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1)) in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1))
& randGen .~ g & randGen .~ g
| otherwise = w | otherwise = w
@@ -184,7 +184,7 @@ useEquipment cr i = useE (_eqUse (_eqEq $ _itUse itm)) itm cr
itm = _crInv cr IM.! i itm = _crInv cr IM.! i
-- a map updating all inventory items -- a map updating all inventory items
upInv :: Creature -> World -> World upInv :: Creature -> World -> World
upInv cr = creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr) upInv cr = cWorld . 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
equipmentEffects cr = flip (foldr $ useEquipment cr) (IM.keys $ _crInvEquipped cr) equipmentEffects cr = flip (foldr $ useEquipment cr) (IM.keys $ _crInvEquipped cr)
@@ -226,7 +226,7 @@ doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of
Nothing -> w Nothing -> w
Just NoTargeting -> w Just NoTargeting -> w
Just t -> let (w',t') = updateTargeting (_tgUpdate t) (_crInv cr IM.! invid) cr w t Just t -> let (w',t') = updateTargeting (_tgUpdate t) (_crInv cr IM.! invid) cr w t
in w' & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t' in w' & cWorld . 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
+8 -8
View File
@@ -18,12 +18,12 @@ yourControl :: Creature -> World -> World
yourControl cr w yourControl cr w
| inTermFocus w = dimCreatureLight cr w & updateUsingInput | inTermFocus w = dimCreatureLight cr w & updateUsingInput
| otherwise = dimCreatureLight cr w | otherwise = dimCreatureLight cr w
& creatures . ix (_crID cr) %~ & cWorld . creatures . ix (_crID cr) %~
(wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w)) (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_cWorld w)))
& updateUsingInput & updateUsingInput
dimCreatureLight :: Creature -> World -> World dimCreatureLight :: Creature -> World -> World
dimCreatureLight cr = tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr) dimCreatureLight cr = cWorld . 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
@@ -35,7 +35,7 @@ wasdWithAiming
-> Creature -> Creature
wasdWithAiming w speed cr wasdWithAiming w speed cr
| isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr | isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr
| crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons w | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_cWorld w)
= addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr = addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr
| otherwise = theMovement $ theTurn $ removeTwist cr | otherwise = theMovement $ theTurn $ removeTwist cr
where where
@@ -52,12 +52,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 = _cameraRot w + argV movDir dir = _cameraRot (_cWorld w) + argV movDir
movAbs = rotateV (_cameraRot w) $ normalizeV movDir movAbs = rotateV (_cameraRot (_cWorld w)) $ 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) + _cameraRot w _ -> argV (_mousePos (_cWorld w)) + _cameraRot (_cWorld w)
wasdM :: SDL.Scancode -> Point2 wasdM :: SDL.Scancode -> Point2
wasdM scancode = case scancode of wasdM scancode = case scancode of
@@ -68,7 +68,7 @@ wasdM scancode = case scancode of
_ -> V2 0 0 _ -> V2 0 0
wasdDir :: World -> Point2 wasdDir :: World -> Point2
wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys . _cWorld
{- | Set posture according to mouse presses. -} {- | Set posture according to mouse presses. -}
mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature
+2 -2
View File
@@ -92,7 +92,7 @@ chooseMovementSpreadGun cr w
where where
d = dist cpos p d = dist cpos p
cpos = _crPos cr cpos = _crPos cr
tcr = _creatures w IM.! 0 tcr = _creatures (_cWorld w) IM.! 0
p = _crPos tcr p = _crPos tcr
chooseMovementLtAuto :: Creature -> World -> Action chooseMovementLtAuto :: Creature -> World -> Action
@@ -105,7 +105,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 w IM.! 0 tcr = _creatures (_cWorld w) IM.! 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)
+3 -3
View File
@@ -13,15 +13,15 @@ import Control.Lens
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 (_cameraCenter w) w | otherwise = fromMaybe (0,0,0,0) $ farWallDistDirection (_cameraCenter (_cWorld w)) w
where where
hw = halfWidth cfig hw = halfWidth cfig
hh = halfHeight cfig hh = halfHeight cfig
updateBounds :: Universe -> Universe updateBounds :: Universe -> Universe
updateBounds uv = uv updateBounds uv = uv
& uvWorld . boundDist .~ bdists & uvWorld . cWorld . boundDist .~ bdists
& uvWorld . boundBox .~ map ( (+.+ _cameraCenter w) . rotateV (_cameraRot w) ) (rectNSWE n s w' e) & uvWorld . cWorld . boundBox .~ map ( (+.+ _cameraCenter (_cWorld w)) . rotateV (_cameraRot (_cWorld w)) ) (rectNSWE n s w' e)
where where
w = _uvWorld uv w = _uvWorld uv
cfig = _uvConfig uv cfig = _uvConfig uv
+1 -1
View File
@@ -6,4 +6,4 @@ import Control.Lens
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 -> creatures . ix (_crID cr) . crHP +~ x CHeal x -> const $ \cr -> cWorld . creatures . ix (_crID cr) . crHP +~ x
+3 -3
View File
@@ -9,11 +9,11 @@ import qualified Data.Map.Strict as M
damageCrWlID :: Damage -> CrWlID -> World -> World damageCrWlID :: Damage -> CrWlID -> World -> World
damageCrWlID dam crwl = case crwl of damageCrWlID dam crwl = case crwl of
NothingID -> id NothingID -> id
CrID cid -> creatures . ix cid . crState . csDamage .:~ dam CrID cid -> cWorld . creatures . ix cid . crState . csDamage .:~ dam
WlID wlid -> wallDamages . ix wlid .:~ dam WlID wlid -> cWorld . wallDamages . ix wlid .:~ dam
damageCrWall :: Damage -> Either Creature Wall -> World -> World damageCrWall :: Damage -> Either Creature Wall -> World -> World
damageCrWall dt (Left cr) = creatures . ix (_crID cr) . crState . csDamage .:~ dt damageCrWall dt (Left cr) = cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ dt
damageCrWall dt (Right wl) = damageWall dt wl damageCrWall dt (Right wl) = damageWall dt wl
damageDirection :: [Damage] -> Maybe Float damageDirection :: [Damage] -> Maybe Float
+2 -2
View File
@@ -10,8 +10,8 @@ import Data.Foldable
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
damageCircle :: Float -> Point2 -> DamageType -> Int -> World -> World damageCircle :: Float -> Point2 -> DamageType -> Int -> World -> World
damageCircle r sp dt da w = w damageCircle r sp dt da w = w
& wallDamages %~ addwalldamages & cWorld . wallDamages %~ addwalldamages
& creatures %~ addcreaturedamages & cWorld . 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
+7 -3
View File
@@ -205,6 +205,12 @@ data GenWorld = GenWorld
, _genRooms :: IM.IntMap Room , _genRooms :: IM.IntMap Room
} }
data World = World data World = World
{ _cWorld :: CWorld
, _randGen :: StdGen
, _toPlaySounds :: M.Map SoundOrigin Sound
, _playingSounds :: M.Map SoundOrigin Sound
}
data CWorld = CWorld
{ _keys :: S.Set Scancode { _keys :: S.Set Scancode
, _mouseButtons :: M.Map MouseButton Bool , _mouseButtons :: M.Map MouseButton Bool
, _mousePos :: Point2 , _mousePos :: Point2
@@ -259,15 +265,12 @@ data World = World
, _wlZoning :: IM.IntMap (IM.IntMap IS.IntSet) -- Zoning IM.IntMap Wall , _wlZoning :: IM.IntMap (IM.IntMap IS.IntSet) -- Zoning IM.IntMap Wall
, _floorItems :: IM.IntMap FloorItem , _floorItems :: IM.IntMap FloorItem
, _floorTiles :: [(Point3,Point3)] , _floorTiles :: [(Point3,Point3)]
, _randGen :: StdGen
, _modifications :: IM.IntMap Modification , _modifications :: IM.IntMap Modification
, _yourID :: Int , _yourID :: Int
, _worldEvents :: [WdWd] , _worldEvents :: [WdWd]
, _delayedEvents :: [(Int,WdWd)] , _delayedEvents :: [(Int,WdWd)]
, _pressPlates :: IM.IntMap PressPlate , _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button , _buttons :: IM.IntMap Button
, _toPlaySounds :: M.Map SoundOrigin Sound
, _playingSounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Picture , _decorations :: IM.IntMap Picture
, _foregroundShapes :: IM.IntMap ForegroundShape , _foregroundShapes :: IM.IntMap ForegroundShape
, _corpses :: IM.IntMap Corpse , _corpses :: IM.IntMap Corpse
@@ -501,6 +504,7 @@ makeLenses ''Equipment
makeLenses ''ScreenLayer makeLenses ''ScreenLayer
makeLenses ''WorldBeams makeLenses ''WorldBeams
makeLenses ''GenWorld makeLenses ''GenWorld
makeLenses ''CWorld
----- ROOM LENSES ----- ROOM LENSES
+2 -2
View File
@@ -14,11 +14,11 @@ import Geometry.Vector
import Control.Lens import Control.Lens
addRoomPolyDecorations :: [Room] -> World -> World addRoomPolyDecorations :: [Room] -> World -> World
addRoomPolyDecorations rms w = w & decorations %~ addRoomPolyDecorations rms w = w & cWorld . decorations %~
IM.insertWithNewKeys (map roomPolyDecorations rms) IM.insertWithNewKeys (map roomPolyDecorations rms)
addRoomLinkDecorations :: [Room] -> World -> World addRoomLinkDecorations :: [Room] -> World -> World
addRoomLinkDecorations rms w = w & decorations %~ addRoomLinkDecorations rms w = w & cWorld . decorations %~
IM.insertWithNewKeys (map roomLinkDecorations rms) IM.insertWithNewKeys (map roomLinkDecorations rms)
roomLinkDecorations :: Room -> Picture roomLinkDecorations :: Room -> Picture
+6 -6
View File
@@ -19,10 +19,10 @@ printRotPoint r p = color white
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 (_cameraRot w) scRot = rotateV (_cameraRot (_cWorld w))
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p scZoom p | _cameraZoom (_cWorld w) /= 0 = (1/_cameraZoom (_cWorld w)) *.* p
| otherwise = error "Trying to set screen zoom to zero" | otherwise = error "Trying to set screen zoom to zero"
scTran p = p +.+ _cameraCenter w scTran p = p +.+ _cameraCenter (_cWorld w)
tr = f 3 3 tr = f 3 3
tl = f (-3) 3 tl = f (-3) 3
br = f 3 (-3) br = f 3 (-3)
@@ -37,9 +37,9 @@ lineOnScreenCone cfig w p1 p2 = pointInPolygon p1 sp
|| 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 = _cameraViewFrom w vp = _cameraViewFrom (_cWorld w)
sp | pointInPolygon vp sp' = sp' sp | pointInPolygon vp sp' = sp'
| otherwise = orderPolygon (_cameraViewFrom w : sp') | otherwise = orderPolygon (_cameraViewFrom (_cWorld w) : 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
@@ -52,7 +52,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 = _cameraViewFrom w sightFrom = _cameraViewFrom (_cWorld w)
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
+12 -12
View File
@@ -31,16 +31,16 @@ applyTerminalString ss = case ss of
applyTerminalCommand :: String -> Universe -> Universe applyTerminalCommand :: String -> Universe -> Universe
applyTerminalCommand s = case s of applyTerminalCommand s = case s of
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust "NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
"LOADME" -> (uvWorld . creatures . ix 0 . crInv .~ stackedInventory) "LOADME" -> (uvWorld . cWorld . creatures . ix 0 . crInv .~ stackedInventory)
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) . (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
"LM" -> applyTerminalCommand "LOADME" "LM" -> applyTerminalCommand "LOADME"
"LT" -> applyTerminalCommand "LOADTEST" "LT" -> applyTerminalCommand "LOADTEST"
['L',x] -> (uvWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0..] $ inventoryX x)) ['L',x] -> (uvWorld . cWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0..] $ inventoryX x))
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) . (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
"GODON" -> uvWorld . creatures . ix 0 . crMaterial .~ Crystal "GODON" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Crystal
"GODOFF" -> uvWorld . creatures . ix 0 . crMaterial .~ Flesh "GODOFF" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Flesh
"LOADTEST" -> (uvWorld . creatures . ix 0 . crInv .~ testInventory) "LOADTEST" -> (uvWorld . cWorld . creatures . ix 0 . crInv .~ testInventory)
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) . (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
_ -> id _ -> id
--applyTerminalString' ('s': 'e': 't': '_': 'h': 'p': ' ': hp) --applyTerminalString' ('s': 'e': 't': '_': 'h': 'p': ' ': hp)
-- | isNothing (readMaybe hp :: Maybe Int) = id -- | isNothing (readMaybe hp :: Maybe Int) = id
@@ -85,10 +85,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 . creatures . ix 0 . crHP .~ round (fromJust val') "hp" -> uvWorld . cWorld . creatures . ix 0 . crHP .~ round (fromJust val')
"invcap" -> uvWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val') "invcap" -> uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
"mass" -> uvWorld . creatures . ix 0 . crMass .~ fromJust val' "mass" -> uvWorld . cWorld . creatures . ix 0 . crMass .~ fromJust val'
"mvspeed" -> uvWorld . creatures . ix 0 . crMvType .mvSpeed .~ fromJust val' "mvspeed" -> uvWorld . cWorld . 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
+8 -3
View File
@@ -11,6 +11,14 @@ import Data.Graph.Inductive.Graph hiding ((&))
--import Data.Graph.Inductive.NodeMap --import Data.Graph.Inductive.NodeMap
defaultWorld :: World defaultWorld :: World
defaultWorld = World defaultWorld = World
{ _cWorld = defaultCWorld
, _toPlaySounds = M.empty
, _playingSounds = M.empty
, _randGen = mkStdGen 2
}
defaultCWorld :: CWorld
defaultCWorld = CWorld
{ _keys = S.empty { _keys = S.empty
, _magnets = IM.empty , _magnets = IM.empty
, _mouseButtons = mempty , _mouseButtons = mempty
@@ -62,15 +70,12 @@ defaultWorld = World
, _wlZoning = IM.empty --Zoning IM.empty wlZoneSize zoneOfWall , _wlZoning = IM.empty --Zoning IM.empty wlZoneSize zoneOfWall
, _floorItems = IM.empty , _floorItems = IM.empty
, _floorTiles = [] , _floorTiles = []
, _randGen = mkStdGen 2
, _mousePos = V2 0 0 , _mousePos = V2 0 0
, _yourID = 0 , _yourID = 0
, _worldEvents = [] , _worldEvents = []
, _delayedEvents = [] , _delayedEvents = []
, _pressPlates = IM.empty , _pressPlates = IM.empty
, _buttons = IM.empty , _buttons = IM.empty
, _toPlaySounds = M.empty
, _playingSounds = M.empty
, _corpses = IM.empty , _corpses = IM.empty
, _decorations = IM.empty , _decorations = IM.empty
--, _savedWorlds = M.empty --, _savedWorlds = M.empty
+5 -5
View File
@@ -26,7 +26,7 @@ doorMechanism dr w = case mvDir of
Just d -> w Just d -> w
& flip (IS.foldl' (flip (`translateWallID` d))) (_drWallIDs dr) & flip (IS.foldl' (flip (`translateWallID` d))) (_drWallIDs dr)
& moveUpdate & moveUpdate
& doors . ix drid . drPos . each %~ (+.+ d) & cWorld . doors . ix drid . drPos . each %~ (+.+ d)
& maybeClearDoorPaths (_drObstacleType dr) (_drObstructs dr) & maybeClearDoorPaths (_drObstacleType dr) (_drObstructs dr)
Nothing -> w Nothing -> w
where where
@@ -46,9 +46,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 = doors . ix drid . drStatus .~ DoorOpen | dist dpos dop < 1 = cWorld . doors . ix drid . drStatus .~ DoorOpen
| dist dpos dcp < 1 = doors . ix drid . drStatus .~ DoorClosed | dist dpos dcp < 1 = cWorld . doors . ix drid . drStatus .~ DoorClosed
| otherwise = doors . ix drid . drStatus .~ DoorHalfway | otherwise = cWorld . 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
@@ -70,7 +70,7 @@ doorMechanismStepwise nsteps wlids pss dr w
playSound = soundContinue (WallSound drid) (fst $ head pss) slideDoorS (Just 1) playSound = soundContinue (WallSound drid) (fst $ head pss) slideDoorS (Just 1)
toOpen = doWdBl (_drTrigger dr) w toOpen = doWdBl (_drTrigger dr) w
setWalls n = playSound (foldl' (&) w (zipWith moveWallID wlids newps)) setWalls n = playSound (foldl' (&) w (zipWith moveWallID wlids newps))
& doors . ix drid . drStatus .~ DoorInt n & cWorld . doors . ix drid . drStatus .~ DoorInt n
where where
newps = uncurry (rectanglePairs 9) (pss !! n) newps = uncurry (rectanglePairs 9) (pss !! n)
-- it is not at all clear that the zoning selects the correct walls -- it is not at all clear that the zoning selects the correct walls
+3 -3
View File
@@ -17,7 +17,7 @@ makeFlamelet
-> World -> World
makeFlamelet (V2 x y) z vel size time w = w makeFlamelet (V2 x y) z vel size time w = w
& randGen .~ g & randGen .~ g
& energyBalls .:~ EnergyBall & cWorld . energyBalls .:~ EnergyBall
{ _ebVel = vel { _ebVel = vel
, _ebColor = red , _ebColor = red
, _ebPos = V2 x y , _ebPos = V2 x y
@@ -39,7 +39,7 @@ moveEnergyBall w eb
incBallAt :: Point2 -> World -> World incBallAt :: Point2 -> World -> World
incBallAt p w = w & energyBalls .:~ theincball incBallAt p w = w & cWorld . energyBalls .:~ theincball
& randGen .~ g & randGen .~ g
where where
(theincball,g) = runState thestate (_randGen w) (theincball,g) = runState thestate (_randGen w)
@@ -58,6 +58,6 @@ incBallAt p w = w & energyBalls .:~ theincball
ebFlicker :: EnergyBall -> World -> World ebFlicker :: EnergyBall -> World -> World
ebFlicker pt ebFlicker pt
| _ebTimer pt `mod` 7 == 0 = tempLightSources | _ebTimer pt `mod` 7 == 0 = cWorld . 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
+21 -21
View File
@@ -46,7 +46,7 @@ handleEvent e = case eventPayload e of
_ -> return . Just _ -> return . Just
handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe
handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2 handleMouseMotionEvent mmev u = Just $ u & uvWorld . cWorld . mousePos .~ V2
(fromIntegral x - 0.5*_windowX cfig) (fromIntegral x - 0.5*_windowX cfig)
(0.5*_windowY cfig - fromIntegral y) (0.5*_windowY cfig - fromIntegral y)
where where
@@ -55,8 +55,8 @@ handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
handleMouseButtonEvent :: MouseButtonEventData -> World -> World handleMouseButtonEvent :: MouseButtonEventData -> World -> World
handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
Released -> mouseButtons . at thebutton .~ Nothing Released -> cWorld . mouseButtons . at thebutton .~ Nothing
Pressed -> mouseButtons . at thebutton ?~ False Pressed -> cWorld . mouseButtons . at thebutton ?~ False
where where
thebutton = mouseButtonEventButton mbev thebutton = mouseButtonEventButton mbev
@@ -89,19 +89,19 @@ handleMouseWheelEvent mwev w = case _menuLayers w of
_ -> Just w _ -> Just w
wheelEvent :: Float -> World -> World wheelEvent :: Float -> World -> World
wheelEvent y w = case _hudElement $ _hud w of wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
DisplayCarte DisplayCarte
| rbDown -> w & hud . carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * ) | rbDown -> w & cWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * )
| otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi) | otherwise -> w & cWorld . selLocation %~ (`mod` numLocs) . (+ yi)
DisplayInventory NoSubInventory DisplayInventory NoSubInventory
-- functions that modify the inventory should be centralised so that -- functions that modify the inventory should be centralised so that
-- this lock can be sensibly applied, perhaps -- this lock can be sensibly applied, perhaps
| _crInvLock (_creatures w IM.! _yourID w) -> w | _crInvLock (_creatures (_cWorld w) IM.! _yourID (_cWorld w)) -> w
| rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions w) of | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions (_cWorld w)) of
(_,EquipOptions{}) -> scrollRBOption y w (_,EquipOptions{}) -> scrollRBOption y w
(Nothing,_) -> closeObjScrollDir y w (Nothing,_) -> closeObjScrollDir y w
(Just f,_) -> w & creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w) (Just f,_) -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
| lbDown -> w & cameraZoom +~ y | lbDown -> w & cWorld . cameraZoom +~ y
| invKeyDown -> changeSwapInvSel yi w | invKeyDown -> changeSwapInvSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
DisplayInventory TweakInventory DisplayInventory TweakInventory
@@ -110,12 +110,12 @@ wheelEvent y w = case _hudElement $ _hud w of
| rbDown -> w & changeTweakParam yi | rbDown -> w & changeTweakParam yi
| otherwise -> w & moveTweakSel yi | otherwise -> w & moveTweakSel yi
DisplayInventory (CombineInventory _) -> w DisplayInventory (CombineInventory _) -> w
& hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) & cWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
DisplayInventory (DisplayTerminal tmid) DisplayInventory (DisplayTerminal tmid)
| rbDown && inTermFocus w -> guardDisconnectedID tmid w $ w | rbDown && inTermFocus w -> guardDisconnectedID tmid w $ w
& terminals . ix tmid %~ updatetermsubsel & cWorld . terminals . ix tmid %~ updatetermsubsel
| inTermFocus w -> w | inTermFocus w -> w
& terminals . ix tmid %~ updatetermsel & cWorld . terminals . ix tmid %~ updatetermsel
_ -> w _ -> w
where where
updatetermsel tm = case tm ^? tmInput . tiSel of updatetermsel tm = case tm ^? tmInput . tiSel of
@@ -134,10 +134,10 @@ wheelEvent y w = case _hudElement $ _hud w of
arg = getArguments' tc tm w' !! j arg = getArguments' tc tm w' !! j
numcombs = length $ combineItemListYou w numcombs = length $ combineItemListYou w
yi = round $ signum y yi = round $ signum y
numLocs = (fst . IM.findMax $ _seenLocations w) + 1 numLocs = (fst . IM.findMax $ _seenLocations (_cWorld w)) + 1
rbDown = ButtonRight `M.member` _mouseButtons w rbDown = ButtonRight `M.member` _mouseButtons (_cWorld w)
lbDown = ButtonLeft `M.member` _mouseButtons w lbDown = ButtonLeft `M.member` _mouseButtons (_cWorld w)
invKeyDown = ScancodeCapsLock `S.member` _keys w invKeyDown = ScancodeCapsLock `S.member` _keys (_cWorld w)
getArguments' :: TerminalCommand -> Terminal -> World -> [String] getArguments' :: TerminalCommand -> Terminal -> World -> [String]
getArguments' tc tm = ("" :) . getArguments tc tm getArguments' tc tm = ("" :) . getArguments tc tm
@@ -159,18 +159,18 @@ nullCommand = TerminalCommand
scrollRBOption :: Float -> World -> World scrollRBOption :: Float -> World -> World
scrollRBOption y w scrollRBOption y w
| y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w))-1) . (+1)) | y < 0 = w & cWorld . rbOptions . opSel %~ (min (length (_opEquip (_rbOptions (_cWorld w)))-1) . (+1))
| y > 0 = w & rbOptions . opSel %~ (max 0 . subtract 1) | y > 0 = w & cWorld . rbOptions . opSel %~ (max 0 . subtract 1)
| otherwise = w | otherwise = w
moveTweakSel :: Int -> World -> World moveTweakSel :: Int -> World -> World
moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
Just l -> w & creatures . ix (_yourID w) . crInv . ix (crSel (you w)) Just l -> w & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w))
. itTweaks . tweakSel %~ (`mod` length l) . subtract i . itTweaks . tweakSel %~ (`mod` length l) . subtract i
_ -> w _ -> w
changeTweakParam :: Int -> World -> World changeTweakParam :: Int -> World -> World
changeTweakParam i w = w changeTweakParam i w = w
& creatures . ix (_yourID w) . crInv . ix (crSel (you w)) %~ & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w)) %~
( (itTweaks . tweakParams . ix paramid . tweakVal .~ x) ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
. doTweak (_tweakType params) x) . doTweak (_tweakType params) x)
where where
+26 -26
View File
@@ -38,17 +38,17 @@ handleTextInput text u = u
& menuLayers . ix 0 . scInput %~ updateText & menuLayers . ix 0 . scInput %~ updateText
& updateTerminalText & updateTerminalText
where where
updateTerminalText = case u ^? uvWorld . hud . hudElement . subInventory of updateTerminalText = case u ^? uvWorld . cWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid) | hasfocus tmid Just (DisplayTerminal tmid) | hasfocus tmid
-> uvWorld %~ \w -> guardDisconnectedID tmid w (w & terminals . ix tmid . tmInput . tiText %~ updateText) -> uvWorld %~ \w -> guardDisconnectedID tmid w (w & cWorld . terminals . ix tmid . tmInput . tiText %~ updateText)
_ -> id _ -> id
hasfocus tmid = fromMaybe False $ u ^? uvWorld . terminals . ix tmid . tmInput . tiFocus hasfocus tmid = fromMaybe False $ u ^? uvWorld . cWorld . 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 ^? terminals . ix tmid . tmStatus of guardDisconnectedID tmid w w' = case w ^? cWorld . terminals . ix tmid . tmStatus of
Just TerminalReady -> w' Just TerminalReady -> w'
_ -> w _ -> w
@@ -60,23 +60,23 @@ see 'handlePressedKeyInGame'.
-} -}
handleKeyboardEvent :: KeyboardEventData -> Universe -> IO (Maybe Universe) handleKeyboardEvent :: KeyboardEventData -> Universe -> IO (Maybe Universe)
handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
Released -> return . Just $ u & uvWorld . keys %~ S.delete scode Released -> return . Just $ u & uvWorld . cWorld . keys %~ S.delete scode
Pressed -> handlePressedKey (keyboardEventRepeat kev) scode Pressed -> handlePressedKey (keyboardEventRepeat kev) scode
(u & uvWorld . keys %~ S.insert scode) (u & uvWorld . cWorld . keys %~ S.insert scode)
where where
scode = (keysymScancode . keyboardEventKeysym) kev scode = (keysymScancode . keyboardEventKeysym) kev
handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe) handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe)
handlePressedKey True ScancodeBackspace u handlePressedKey True ScancodeBackspace u
| _backspaceTimer (_uvWorld u) <= 0 = handlePressedKey False ScancodeBackspace u | _backspaceTimer (_cWorld $ _uvWorld u) <= 0 = handlePressedKey False ScancodeBackspace u
<&> _Just . uvWorld . backspaceTimer .~ 0 <&> _Just . uvWorld . cWorld . backspaceTimer .~ 0
| otherwise = return $ Just $ u & uvWorld . backspaceTimer -~ 1 | otherwise = return $ Just $ u & uvWorld . cWorld . backspaceTimer -~ 1
handlePressedKey True _ u = return $ Just u handlePressedKey True _ u = return $ Just u
handlePressedKey _ scode u = case scode of 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 (_menuLayers u) -> case u ^? uvWorld . hud . hudElement . subInventory of _ | null (_menuLayers u) -> case u ^? uvWorld . cWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u)
-> return $ uvWorld (Just . handlePressedKeyTerminal tmid scode) u -> return $ uvWorld (Just . handlePressedKeyTerminal tmid scode) u
_ -> return $ (Just . handlePressedKeyInGame scode) u _ -> return $ (Just . handlePressedKeyInGame scode) u
@@ -91,9 +91,9 @@ handlePressedKeyInGame scode uv = case scode of
ScancodeM -> over uvWorld toggleMap uv ScancodeM -> over uvWorld toggleMap uv
ScancodeR -> over uvWorld (crToggleReloading (you w)) uv ScancodeR -> over uvWorld (crToggleReloading (you w)) uv
ScancodeT -> over uvWorld testEvent uv ScancodeT -> over uvWorld testEvent uv
ScancodeX -> uv & uvWorld . hud . hudElement %~ toggleTweakInv ScancodeX -> uv & uvWorld . cWorld . hud . hudElement %~ toggleTweakInv
ScancodeC -> over uvWorld toggleCombineInv uv ScancodeC -> over uvWorld toggleCombineInv uv
ScancodeI -> uv & uvWorld . hud . hudElement %~ toggleInspectInv ScancodeI -> uv & uvWorld . cWorld . hud . hudElement %~ toggleInspectInv
_ -> uv _ -> uv
where where
w = _uvWorld uv w = _uvWorld uv
@@ -101,11 +101,11 @@ handlePressedKeyInGame scode uv = case scode of
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 & terminals . ix tmid . tmInput . tiFocus %~ const False ScancodeEscape -> w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
ScancodeReturn -> w & terminalReturnEffect (w ^?! terminals . ix tmid) ScancodeReturn -> w & terminalReturnEffect (w ^?! cWorld . terminals . ix tmid)
ScancodeBackspace -> w ScancodeBackspace -> w
& terminals . ix tmid . tmInput . tiText %~ doBackspace & cWorld . terminals . ix tmid . tmInput . tiText %~ doBackspace
& backspaceTimer .~ 5 & cWorld . backspaceTimer .~ 5
_ -> w _ -> w
where where
doBackspace t = case T.unsnoc t of doBackspace t = case T.unsnoc t of
@@ -128,26 +128,26 @@ gotoTerminal w = case _menuLayers w of
_ -> w & menuLayers .:~ InputScreen T.empty "Enter command" _ -> w & menuLayers .:~ InputScreen T.empty "Enter command"
spaceAction :: World -> World spaceAction :: World -> World
spaceAction w = case _hudElement $ _hud w of spaceAction w = case _hudElement $ _hud (_cWorld w) of
DisplayCarte -> w & hud . carteCenter .~ theLoc DisplayCarte -> w & cWorld . 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 & hud . hudElement .~ DisplayInventory NoSubInventory DisplayInventory DisplayTerminal {} -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & hud . hudElement .~ DisplayInventory NoSubInventory _ -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
where where
theLoc = doWorldPos (fst (_seenLocations w IM.! _selLocation w)) w theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w
-- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail -- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail
pauseGame :: Universe -> Universe pauseGame :: Universe -> Universe
pauseGame = menuLayers .~ [pauseMenu] pauseGame = menuLayers .~ [pauseMenu]
toggleMap :: World -> World toggleMap :: World -> World
toggleMap w = case _hudElement $ _hud w of toggleMap w = case _hudElement $ _hud (_cWorld w) of
DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory DisplayCarte -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & hud . hudElement .~ DisplayCarte _ -> w & cWorld . hud . hudElement .~ DisplayCarte
escapeMap :: World -> World escapeMap :: World -> World
escapeMap w = case _hudElement $ _hud w of escapeMap w = case _hudElement $ _hud (_cWorld w) of
DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory DisplayCarte -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w _ -> w
+5 -5
View File
@@ -53,8 +53,8 @@ doDamagesFL :: (Flame -> Point2 -> [Damage])
-> World -> World
-> World -> World
doDamagesFL fdm (p,thhit) bt = case thhit of doDamagesFL fdm (p,thhit) bt = case thhit of
Left cr -> creatures . ix (_crID cr) . crState . csDamage .++~ dams Left cr -> cWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams Right wl -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
where where
dams = fdm bt p dams = fdm bt p
@@ -97,7 +97,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 w damcrs = foldl' (flip $ \cr -> fst . hiteff [(p,Left cr)]) w $ IM.filter crt $ _creatures (_cWorld w)
damwls w' damwls w'
= foldl' = foldl'
(flip $ \wl -> fst . hiteff [(p,Right wl)]) (flip $ \wl -> fst . hiteff [(p,Right wl)])
@@ -108,12 +108,12 @@ flDamageInArea crt wlt pt w = damwls damcrs
flFlicker :: Flame -> World -> World flFlicker :: Flame -> World -> World
flFlicker pt flFlicker pt
| _flTimer pt `mod` 7 == 0 = tempLightSources | _flTimer pt `mod` 7 == 0 = cWorld . 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 = w makeFlame pos vel w = w
& flames .:~ aFlameParticle t pos vel & cWorld . 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)
+3 -3
View File
@@ -18,15 +18,15 @@ copyItemToFloor pos it = snd . copyItemToFloorID pos it
{- | Copy an item to the floor, returns the floor item's id. -} {- | Copy an item to the floor, returns the floor item's id. -}
copyItemToFloorID :: Point2 -> Item -> World -> (Int, World) copyItemToFloorID :: Point2 -> Item -> World -> (Int, World)
copyItemToFloorID pos it w = (,) flid $ w' copyItemToFloorID pos it w = (,) flid $ w'
& floorItems %~ IM.insert flid theflit & cWorld . 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 = case it ^? itID of updateLocation = case it ^? itID of
Just (Just i') -> itemPositions . ix i' .~ OnFloor flid Just (Just i') -> cWorld . itemPositions . ix i' .~ OnFloor flid
_ -> id _ -> id
flid = IM.newKey $ _floorItems w flid = IM.newKey $ _floorItems (_cWorld w)
theflit = FlIt theflit = FlIt
{_flIt = it & itConsumption . icAmount %~ const 1 {_flIt = it & itConsumption . icAmount %~ const 1
,_flItPos = p' ,_flItPos = p'
+4 -4
View File
@@ -360,10 +360,10 @@ overNozzles = overNozzles' . overNozzle
overNozzles' :: (Item -> Creature -> World -> Nozzle -> (World,Nozzle)) overNozzles' :: (Item -> Creature -> World -> Nozzle -> (World,Nozzle))
-> Item -> Creature -> World -> World -> Item -> Creature -> World -> World
overNozzles' eff it cr w = neww & creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles overNozzles' eff it cr w = neww & cWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
where where
cid = _crID cr cid = _crID cr
i = crSel $ _creatures w IM.! cid i = crSel $ _creatures (_cWorld w) IM.! cid
(neww,newNozzles) = mapAccumR (eff it cr) w $ _sprayNozzles (_itParams it) (neww,newNozzles) = mapAccumR (eff it cr) w $ _sprayNozzles (_itParams it)
overNozzle :: (Nozzle -> Item -> Creature -> World -> World) overNozzle :: (Nozzle -> Item -> Creature -> World -> World)
@@ -386,12 +386,12 @@ useGasParams nz it cr = createGas (_amCreateGas (_laAmmoType (_itConsumption it)
pos = _crPos cr +.+ (_nzLength nz *.* unitVectorAtAngle (_crDir cr)) pos = _crPos cr +.+ (_nzLength nz *.* unitVectorAtAngle (_crDir cr))
fireRemoteShell :: Item -> Creature -> World -> World fireRemoteShell :: Item -> Creature -> World -> World
fireRemoteShell it cr w = set (creatures . ix cid . crInv . ix j . itUse . rUse) fireRemoteShell it cr w = set (cWorld . creatures . ix cid . crInv . ix j . itUse . rUse)
(HeldExplodeRemoteShell itid i) (HeldExplodeRemoteShell itid i)
$ addRemRocket w' $ addRemRocket w'
where where
(w',itid) = getHeldItemLoc cr w (w',itid) = getHeldItemLoc cr w
i = IM.newKey $ _props w i = IM.newKey $ _props (_cWorld w)
cid = _crID cr cid = _crID cr
addRemRocket = makeShell it cr addRemRocket = makeShell it cr
[ PJSetScope itid [ PJSetScope itid
+1 -1
View File
@@ -170,7 +170,7 @@ chooseMovementPistol' cr w = takeOneWeighted [chargeProb,retreatProb,strafeProb,
where where
g = _randGen w g = _randGen w
cpos = _crPos cr cpos = _crPos cr
ycr = _creatures w IM.! 0 ycr = _creatures (_cWorld w) IM.! 0
ypos = _crPos ycr ypos = _crPos ycr
chargeProb | dist cpos ypos > 300 = 5 chargeProb | dist cpos ypos > 300 = 5
| dist cpos ypos > 150 = 1 | dist cpos ypos > 150 = 1
+6 -19
View File
@@ -13,26 +13,13 @@ import System.Random
import qualified Data.Set as S import qualified Data.Set as S
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import qualified Data.Map as M import qualified Data.Map as M
import Control.Lens
initialWorld :: World initialWorld :: World
initialWorld = defaultWorld initialWorld = defaultWorld
{ _keys = S.empty & cWorld . cameraZoom .~ 10
, _cameraCenter = V2 0 0 & cWorld . creatures .~ IM.fromList [(0,startCr)]
, _cameraRot = 0 & cWorld . yourID .~ 0
, _cameraZoom = 10 & cWorld . worldEvents .~ SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing
, _creatures = IM.fromList [(0,startCr)] : [MakeStartCloudAt (V3 x y 5) | x <- [-5,-4..5] , y <- [-5,-4..5]]
, _props = IM.empty
, _walls = IM.empty
, _floorItems = IM.empty
, _randGen = mkStdGen 2
, _mousePos = V2 0 0
, _yourID = 0
, _worldEvents = SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing
: [MakeStartCloudAt (V3 x y 5) | x <- [-5,-4..5] , y <- [-5,-4..5]]
, _pressPlates = IM.empty
, _buttons = IM.empty
, _toPlaySounds = M.empty
, _decorations = IM.empty
-- , _menuLayers = [TerminalScreen 300 rezText']
}
+3 -3
View File
@@ -6,7 +6,7 @@ import Data.Maybe
inTermFocus :: World -> Bool inTermFocus :: World -> Bool
inTermFocus w = fromMaybe False $ do inTermFocus w = fromMaybe False $ do
tmid <- w ^? hud . hudElement . subInventory . termID tmid <- w ^? cWorld . hud . hudElement . subInventory . termID
hasfocus <- w ^? terminals . ix tmid . tmInput . tiFocus hasfocus <- w ^? cWorld . terminals . ix tmid . tmInput . tiFocus
connectionstatus <- w ^? terminals . ix tmid . tmStatus connectionstatus <- w ^? cWorld . terminals . ix tmid . tmStatus
return $ hasfocus && connectionstatus == TerminalReady return $ hasfocus && connectionstatus == TerminalReady
+66 -61
View File
@@ -53,23 +53,24 @@ rmInvItem :: Int -- ^ Creature id
-> Int -- ^ Inventory position -> Int -- ^ Inventory position
-> World -> World
-> World -> World
rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itConsumption . icAmount of rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid . itConsumption . icAmount of
Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1 Just x | x > 1 -> w & cWorld . creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1
_ -> w & creatures . ix cid . crInv %~ f _ -> w
& creatures . ix cid . crInvSel %~ stopCrInvSelAction & cWorld . creatures . ix cid . crInv %~ f
& creatures . ix cid . crInvSel . iselPos %~ g & cWorld . creatures . ix cid . crInvSel %~ stopCrInvSelAction
& creatures . ix cid . crLeftInvSel %~ g' & cWorld . creatures . ix cid . crInvSel . iselPos %~ g
& cWorld . creatures . ix cid . crLeftInvSel %~ g'
& removeAnySlotEquipment & removeAnySlotEquipment
& dounequipfunction & dounequipfunction
& doanyitemeffect & doanyitemeffect
& creatures . ix cid . crInvEquipped %~ IM.delete invid & cWorld . creatures . ix cid . crInvEquipped %~ IM.delete invid
& creatures . ix cid . crInvEquipped %~ IM.mapKeys g & cWorld . creatures . ix cid . crInvEquipped %~ IM.mapKeys g
-- TODO check whether this can be mapKeysMonotonic -- TODO check whether this can be mapKeysMonotonic
where where
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 w IM.! cid cr = _creatures (_cWorld w) IM.! cid
itm = _crInv cr IM.! invid itm = _crInv cr IM.! invid
dounequipfunction = fromMaybe id $ do dounequipfunction = fromMaybe id $ do
rmf <- itm ^? itUse . eqEq . eqOnRemove rmf <- itm ^? itUse . eqEq . eqOnRemove
@@ -77,10 +78,10 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons
doanyitemeffect = fromMaybe id $ do doanyitemeffect = fromMaybe id $ do
rmf <- itm ^? itEffect . ieDrop rmf <- itm ^? itEffect . ieDrop
return $ doDropEffect rmf itm cr return $ doDropEffect rmf itm cr
removeAnySlotEquipment = case w ^? creatures . ix cid . crInvEquipped . ix invid of removeAnySlotEquipment = case w ^? cWorld . creatures . ix cid . crInvEquipped . ix invid of
Just epos -> creatures . ix cid . crEquipment . at epos .~ Nothing Just epos -> cWorld . creatures . ix cid . crEquipment . at epos .~ Nothing
Nothing -> id Nothing -> id
maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures w IM.! cid maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures (_cWorld w) IM.! cid
f inv = let (xs,ys) = IM.split invid inv f 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
g x | x > invid || Just x == maxk = max 0 $ x - 1 g x | x > invid || Just x == maxk = max 0 $ x - 1
@@ -92,7 +93,7 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons
| otherwise = Just x | otherwise = Just x
rmSelectedInvItem :: Int -> World -> World rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = rmInvItem cid (crSel (_creatures w IM.! cid)) w rmSelectedInvItem cid w = rmInvItem cid (crSel (_creatures (_cWorld w) IM.! cid)) w
augmentedInvSizes :: World -> IM.IntMap Int augmentedInvSizes :: World -> IM.IntMap Int
augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize
@@ -100,7 +101,7 @@ augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize
bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a
bimapAugmentInv f g w = IM.union bimapAugmentInv f g w = IM.union
(f <$> yourInv w) (f <$> yourInv w)
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects w) (IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects (_cWorld w))
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
@@ -154,18 +155,18 @@ updateTerminal :: World -> World
updateTerminal = checkTermDist updateTerminal = checkTermDist
checkTermDist :: World -> World checkTermDist :: World -> World
checkTermDist w = case w ^? hud . hudElement . subInventory . termID of checkTermDist w = case w ^? cWorld . hud . hudElement . subInventory . termID of
Just tmid -> fromMaybe (w & hud . hudElement .~ DisplayInventory NoSubInventory) $ do Just tmid -> fromMaybe (w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do
btid <- w ^? terminals . ix tmid . tmButtonID btid <- w ^? cWorld . terminals . ix tmid . tmButtonID
btpos <- w ^? buttons . ix btid . btPos btpos <- w ^? cWorld . 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
-- this looks ugly... -- this looks ugly...
updateCloseObjects :: World -> World updateCloseObjects :: World -> World
updateCloseObjects w = w updateCloseObjects w = w
& closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose & cWorld . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
& creatures . ix (_yourID w) . crInvSel . iselPos %~ updateinvsel & cWorld . creatures . ix (_yourID (_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
@@ -175,26 +176,26 @@ updateCloseObjects w = w
activeButtons = map Right activeButtons = map Right
. filter ( (/=) BtNoLabel . _btState) . filter ( (/=) BtNoLabel . _btState)
. IM.elems . IM.elems
$ _buttons w $ _buttons (_cWorld w)
currentClose = filt $ map Left (IM.elems $ _floorItems w) ++ activeButtons currentClose = filt $ map Left (IM.elems $ _floorItems (_cWorld w)) ++ activeButtons
oldClose = filt $ mapMaybe updatebyid $ _closeObjects w oldClose = filt $ mapMaybe updatebyid $ _closeObjects (_cWorld w)
oldCloseFiltered = intersectBy closeObjEq oldClose currentClose oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
updatebyid (Left flid) = fmap Left $ w ^? floorItems . ix (_flItID flid) updatebyid (Left flid) = fmap Left $ w ^? cWorld . floorItems . ix (_flItID flid)
updatebyid (Right btid) = fmap Right $ w ^? buttons . ix (_btID btid) updatebyid (Right btid) = fmap Right $ w ^? cWorld . buttons . ix (_btID btid)
updateRBList :: World -> World updateRBList :: World -> World
updateRBList w updateRBList w
| w ^? rbOptions . opCurInvPos == Just curinvid | w ^? cWorld . rbOptions . opCurInvPos == Just curinvid
= w & setEquipAllocation & setEquipActivation = w & setEquipAllocation & setEquipActivation
| otherwise = case cr ^? crInv . ix curinvid . itUse . eqEq . eqSite of | otherwise = case cr ^? crInv . ix curinvid . itUse . eqEq . eqSite of
Just esite -> w Just esite -> w
& rbOptions .~ EquipOptions (equipSiteToPositions esite) & cWorld . rbOptions .~ EquipOptions (equipSiteToPositions esite)
(chooseEquipmentPosition cr (equipSiteToPositions esite)) (chooseEquipmentPosition cr (equipSiteToPositions esite))
curinvid curinvid
DoNotMoveEquipment DoNotMoveEquipment
NoChangeActivateEquipment NoChangeActivateEquipment
& setEquipAllocation & setEquipActivation & setEquipAllocation & setEquipActivation
Nothing -> w & rbOptions .~ NoRightButtonOptions Nothing -> w & cWorld . rbOptions .~ NoRightButtonOptions
-- | otherwise = w & rbOptions .~ NoRightButtonOptions -- | otherwise = w & rbOptions .~ NoRightButtonOptions
where where
curinvid = crSel cr curinvid = crSel cr
@@ -211,53 +212,53 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
setEquipAllocation :: World -> World setEquipAllocation :: World -> World
setEquipAllocation w = case _rbOptions w of setEquipAllocation w = case _rbOptions (_cWorld w) of
EquipOptions {_opEquip = es,_opSel=i} -> EquipOptions {_opEquip = es,_opSel=i} ->
case you w ^? crInvEquipped . ix (crSel (you w)) of case you w ^? crInvEquipped . ix (crSel (you w)) of
Just epos | es !! i == epos Just epos | es !! i == epos
-> w & rbOptions . opAllocateEquipment .~ RemoveEquipment -> w & cWorld . rbOptions . opAllocateEquipment .~ RemoveEquipment
{_allocOldPos = epos} {_allocOldPos = epos}
Just epos | isJust (you w ^? crEquipment . ix (es !! i)) Just epos | isJust (you w ^? crEquipment . ix (es !! i))
-> w & rbOptions . opAllocateEquipment .~ SwapEquipment -> w & cWorld . rbOptions . opAllocateEquipment .~ SwapEquipment
{_allocOldPos = epos {_allocOldPos = epos
,_allocNewPos = es !! i ,_allocNewPos = es !! i
,_allocSwapID = _crEquipment (you w) M.! (es !! i) ,_allocSwapID = _crEquipment (you w) M.! (es !! i)
} }
Just epos -> w & rbOptions . opAllocateEquipment .~ MoveEquipment Just epos -> w & cWorld . rbOptions . opAllocateEquipment .~ MoveEquipment
{_allocOldPos = epos {_allocOldPos = epos
,_allocNewPos = es !! i ,_allocNewPos = es !! i
} }
Nothing | isJust (you w ^? crEquipment . ix (es !! i)) Nothing | isJust (you w ^? crEquipment . ix (es !! i))
-> w & rbOptions . opAllocateEquipment .~ ReplaceEquipment -> w & cWorld . rbOptions . opAllocateEquipment .~ ReplaceEquipment
{_allocNewPos = es !! i {_allocNewPos = es !! i
,_allocRemoveID = _crEquipment (you w) M.! (es !! i) ,_allocRemoveID = _crEquipment (you w) M.! (es !! i)
} }
Nothing -> w & rbOptions . opAllocateEquipment .~ PutOnEquipment Nothing -> w & cWorld . rbOptions . opAllocateEquipment .~ PutOnEquipment
{_allocNewPos = es !! i} {_allocNewPos = es !! i}
_ -> w _ -> w
-- where -- where
-- curpos = invSelPos w -- curpos = invSelPos w
setEquipActivation :: World -> World setEquipActivation :: World -> World
setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of setEquipActivation w = case w ^? cWorld . rbOptions . opAllocateEquipment of
Just DoNotMoveEquipment -> w Just DoNotMoveEquipment -> w
Just RemoveEquipment { } Just RemoveEquipment { }
-> case _crLeftInvSel (you w) of -> case _crLeftInvSel (you w) of
Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment Just i | i == invsel -> w & cWorld . rbOptions . opActivateEquipment .~ DeactivateEquipment
{_deactivateEquipment = i} {_deactivateEquipment = i}
_ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment _ -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just rbos Just rbos
-> case _crLeftInvSel (you w) of -> case _crLeftInvSel (you w) of
Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment Just i | i == invsel -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just i | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment Just i | invselcanactivate -> w & cWorld . rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment
{_activateEquipment = invsel,_deactivateEquipment = i} {_activateEquipment = invsel,_deactivateEquipment = i}
Just i | Just i == rbos ^? allocRemoveID Just i | Just i == rbos ^? allocRemoveID
-> w & rbOptions . opActivateEquipment .~ DeactivateEquipment i -> w & cWorld . rbOptions . opActivateEquipment .~ DeactivateEquipment i
Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment Just _ -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateEquipment Nothing | invselcanactivate -> w & cWorld . rbOptions . opActivateEquipment .~ ActivateEquipment
{_activateEquipment = invsel} {_activateEquipment = invsel}
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment Nothing -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment Nothing -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
where where
invsel = crSel (you w) invsel = crSel (you w)
invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . lUse) invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . lUse)
@@ -274,29 +275,32 @@ equipSiteToPositions es = case es of
closeObjScrollDir :: Float -> World -> World closeObjScrollDir :: Float -> World -> World
closeObjScrollDir x closeObjScrollDir x
| x > 0 = over closeObjects rotU | x > 0 = over (cWorld . closeObjects) rotU
| x < 0 = over closeObjects rotD | x < 0 = over (cWorld . closeObjects) rotD
| otherwise = id | otherwise = id
changeInvSel :: Int -> World -> World changeInvSel :: Int -> World -> World
changeInvSel i w changeInvSel i w
| n == 0 = w | n == 0 = w
| yourInvSel w < n = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ (`mod` n) . subtract i | yourInvSel w < n = w
& creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i
| otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ ((+n) . (`mod` numCO) . subtract (i+n)) & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
& creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction | otherwise = w
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ ((+n) . (`mod` numCO) . subtract (i+n))
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
-- arguably this should jump the invpos into the inventory proper -- arguably this should jump the invpos into the inventory proper
where where
n = length $ _crInv $ _creatures w IM.! _yourID w n = length $ _crInv $ _creatures (_cWorld w) IM.! _yourID (_cWorld w)
numCO = length $ _closeObjects w numCO = length $ _closeObjects (_cWorld w)
changeSwapInvSel :: Int -> World -> World changeSwapInvSel :: Int -> World -> World
changeSwapInvSel k w changeSwapInvSel k w
| n == 0 = w | n == 0 = w
| yourInvSel w < n = w | yourInvSel w < n = w
& creatures . ix (_yourID w) %~ updatecreature & cWorld . creatures . ix (_yourID (_cWorld w)) %~ updatecreature
| otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos .~ ico' | otherwise = w
& closeObjects %~ swapIndices (i - n) (ico' - n) & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos .~ ico'
& cWorld . closeObjects %~ swapIndices (i - n) (ico' - n)
where where
updatecreature = ( crInv %~ IM.safeSwapKeys (i `mod` n) swapi ) updatecreature = ( crInv %~ IM.safeSwapKeys (i `mod` n) swapi )
. (crLeftInvSel . _Just %~ updateLeftInvSel) . (crLeftInvSel . _Just %~ updateLeftInvSel)
@@ -315,18 +319,19 @@ 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 w numCO = length $ _closeObjects (_cWorld w)
changeAugInvSel :: Int -> World -> World changeAugInvSel :: Int -> World -> World
changeAugInvSel i w changeAugInvSel i w
| n == 0 = w | n == 0 = w
| otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ (`mod` n) . subtract i | otherwise = w
& creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
where where
n = length (yourInv w) + length (_closeObjects w) n = length (yourInv w) + length (_closeObjects (_cWorld w))
bestCloseObjectIndex :: World -> Maybe Int bestCloseObjectIndex :: World -> Maybe Int
bestCloseObjectIndex w = findIndex f $ _closeObjects w bestCloseObjectIndex w = findIndex f $ _closeObjects (_cWorld w)
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
@@ -342,4 +347,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 w !? n) selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects (_cWorld w) !? n)
+5 -5
View File
@@ -11,7 +11,7 @@ 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 w IM.! flid) w (i,w') <- tryPutItemInInv cid (_floorItems (_cWorld w) IM.! 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
@@ -23,15 +23,15 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
Nothing -> Nothing Nothing -> Nothing
Just i -> Just (i, w Just i -> Just (i, w
& updateItLocation i & updateItLocation i
& floorItems %~ IM.delete (_flItID flit) & cWorld . floorItems %~ IM.delete (_flItID flit)
& creatures . ix cid . crInv %~ putItemInInvSlot i it & cWorld . 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' = case _itID it of updateItLocation invid w' = case _itID it of
Nothing -> w' Nothing -> w'
Just j -> w' & itemPositions . ix j .~ InInv cid invid Just j -> w' & cWorld . itemPositions . ix j .~ InInv cid invid
--{- | Pick up a specific item. -} --{- | Pick up a specific item. -}
--putItemInInv :: Int -> FloorItem -> World -> World --putItemInInv :: Int -> FloorItem -> World -> World
@@ -48,5 +48,5 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
-- Nothing -> w' -- Nothing -> w'
-- 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 = uncurry (putItemInInvID (_yourID w)) createPutItem it w = uncurry (putItemInInvID (_yourID (_cWorld w)))
$ copyItemToFloorID (_crPos $ you w) (applyModules it) w $ copyItemToFloorID (_crPos $ you w) (applyModules it) w
+2 -2
View File
@@ -3,7 +3,7 @@ import Dodge.Data
import Control.Lens import Control.Lens
lockInv :: Int -> World -> World lockInv :: Int -> World -> World
lockInv cid = creatures . ix cid . crInvLock %~ (|| True) lockInv cid = cWorld . creatures . ix cid . crInvLock %~ (|| True)
unlockInv :: Int -> World -> World unlockInv :: Int -> World -> World
unlockInv cid = creatures . ix cid . crInvLock %~ (&& False) unlockInv cid = cWorld . creatures . ix cid . crInvLock %~ (&& False)
+7 -7
View File
@@ -29,16 +29,16 @@ onOffEff f g it
rewindEffect :: Item -> Creature -> World -> World rewindEffect :: Item -> Creature -> World -> World
rewindEffect itm cr w rewindEffect itm cr w
| Just invid == _crLeftInvSel cr = w & rewindWorlds %~ (take maxcharge . (w' : )) | Just invid == _crLeftInvSel cr = w & cWorld . rewindWorlds %~ (take maxcharge . (w' : ))
& ptrWpCharge .~ length (_rewindWorlds w) & ptrWpCharge .~ length (_rewindWorlds (_cWorld w))
| otherwise = w & rewindWorlds .~ [] | otherwise = w & cWorld . rewindWorlds .~ []
& ptrWpCharge .~ 0 & ptrWpCharge .~ 0
where where
invid = _ipInvID $ _itPos itm invid = _ipInvID $ _itPos itm
ptrWpCharge = creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge
maxcharge = _wpMaxCharge . _itConsumption $ itm maxcharge = _wpMaxCharge . _itConsumption $ itm
w' = w & rewindWorlds .~ [] w' = w & cWorld . rewindWorlds .~ []
& timeFlow .~ NormalTimeFlow & cWorld . timeFlow .~ NormalTimeFlow
resetAttachmentEffect :: Item -> Creature -> World -> World resetAttachmentEffect :: Item -> Creature -> World -> World
resetAttachmentEffect itm cr w resetAttachmentEffect itm cr w
@@ -47,7 +47,7 @@ resetAttachmentEffect itm cr w
where where
iteff = _itEffect itm iteff = _itEffect itm
invid = _ipInvID $ _itPos itm invid = _ipInvID $ _itPos itm
pointToIt = creatures . ix (_crID cr) . crInv . ix invid pointToIt = cWorld . creatures . ix (_crID cr) . crInv . ix invid
createHeldLight :: Item -> Creature -> World -> World createHeldLight :: Item -> Creature -> World -> World
createHeldLight itm cr = createTorchLightOffset cr itm 0 createHeldLight itm cr = createTorchLightOffset cr itm 0
+2 -2
View File
@@ -15,8 +15,8 @@ import qualified IntMapHelp as IM
charFiringStratI charFiringStratI
:: [(Char, ChainEffect)] -- ^ Different firing effects for different characters :: [(Char, ChainEffect)] -- ^ Different firing effects for different characters
-> ChainEffect -> ChainEffect
charFiringStratI strats eff item cr w = case w ^? creatures . ix cid . crInv charFiringStratI strats eff item cr w = case w ^? cWorld . creatures . ix cid . crInv
. ix (crSel $ _creatures w IM.! cid) . itAttachment . atCharMode of . ix (crSel $ _creatures (_cWorld w) IM.! cid) . itAttachment . atCharMode of
Just (c :<| _) -> fromMaybe id (Prelude.lookup c strats) eff item cr w Just (c :<| _) -> fromMaybe id (Prelude.lookup c strats) eff item cr w
_ -> w _ -> w
where where
+3 -3
View File
@@ -24,8 +24,8 @@ medkit i = defaultConsumable
heal25 :: Int -> World -> Maybe World heal25 :: Int -> World -> Maybe World
heal25 = heal 25 heal25 = heal 25
heal :: Int -> Int -> World -> Maybe World heal :: Int -> Int -> World -> Maybe World
heal hp n w | _crHP (_creatures w IM.! n) >= 10000 = Nothing heal hp n w | _crHP (_creatures (_cWorld w) IM.! n) >= 10000 = Nothing
| otherwise = Just $ soundStart (CrSound $ _crID cr) (_crPos cr) healS Nothing w | otherwise = Just $ soundStart (CrSound $ _crID cr) (_crPos cr) healS Nothing w
& creatures . ix n . crHP %~ min 10000 . (+ hp) & cWorld . creatures . ix n . crHP %~ min 10000 . (+ hp)
where where
cr = _creatures w IM.! n cr = _creatures (_cWorld w) IM.! n
+10 -10
View File
@@ -51,7 +51,7 @@ magShield = defaultEquipment
& itUse . eqEq . eqSite .~ GoesOnWrist & itUse . eqEq . eqSite .~ GoesOnWrist
& itType . iyBase .~ EQUIP MAGSHIELD & itType . iyBase .~ EQUIP MAGSHIELD
useMagShield :: Item -> Creature -> World -> World useMagShield :: Item -> Creature -> World -> World
useMagShield it cr w = w & magnets . at mgid ?~ themagnet useMagShield it cr w = w & cWorld . magnets . at mgid ?~ themagnet
where where
themagnet = Magnet themagnet = Magnet
{_mgID = mgid {_mgID = mgid
@@ -61,7 +61,7 @@ useMagShield it cr w = w & magnets . at mgid ?~ themagnet
} }
mgid = case it ^? itAttachment . atMInt . _Just of mgid = case it ^? itAttachment . atMInt . _Just of
Just mgid' -> mgid' Just mgid' -> mgid'
Nothing -> IM.newKey $ _magnets w Nothing -> IM.newKey $ _magnets (_cWorld w)
-- it = _crInv cr IM.! invid -- it = _crInv cr IM.! invid
flameShield :: Item flameShield :: Item
@@ -89,15 +89,15 @@ wristArmour = defaultEquipment
onEquipWristShield :: Item -> Creature -> World -> World onEquipWristShield :: Item -> Creature -> World -> World
onEquipWristShield itm cr w = w onEquipWristShield itm cr w = w
& creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ EquipID i & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ EquipID i
& walls . at i ?~ forceField {_wlID = i} & cWorld . walls . at i ?~ forceField {_wlID = i}
& setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr & setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr
where where
i = IM.newKey (_walls w) i = IM.newKey (_walls (_cWorld w))
onRemoveWristShield :: Item -> Creature -> World -> World onRemoveWristShield :: Item -> Creature -> World -> World
onRemoveWristShield itm cr w = w onRemoveWristShield itm cr w = w
& creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams
& deleteWallID i & deleteWallID i
where where
i = _eparamID $ _eqParams $ _eqEq $ _itUse itm i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
@@ -168,7 +168,7 @@ shieldWall crid = defaultWall
createShieldWall :: Item -> Creature -> World -> World createShieldWall :: Item -> Creature -> World -> World
createShieldWall it cr w = case _ieMID $ _itEffect it of createShieldWall it cr w = case _ieMID $ _itEffect it of
Nothing -> let (wlid,w') = createWall ((shieldWall crid) {_wlLine = wlline,_wlID = wlid}) w Nothing -> let (wlid,w') = createWall ((shieldWall crid) {_wlLine = wlline,_wlID = wlid}) w
in w' & creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid in w' & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid
Just wid -> moveWallID wid wlline w Just wid -> moveWallID wid wlline w
where where
invid = fromJust $ _itID it invid = fromJust $ _itID it
@@ -185,7 +185,7 @@ removeShieldWall :: Item -> Creature -> World -> World
removeShieldWall it cr w = case _ieMID $ _itEffect it of removeShieldWall it cr w = case _ieMID $ _itEffect it of
Nothing -> w Nothing -> w
Just wid -> w & deleteWallID wid Just wid -> w & deleteWallID wid
& creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing
where where
crid = _crID cr crid = _crID cr
invid = fromJust (_itID it) invid = fromJust (_itID it)
@@ -241,7 +241,7 @@ headLamp = defaultEquipment
createHeadLamp :: Item -> Creature -> World -> World createHeadLamp :: Item -> Creature -> World -> World
createHeadLamp _ cr = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 createHeadLamp _ cr = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 200 0.7
((_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)))
powerLegs :: Item powerLegs :: Item
@@ -268,4 +268,4 @@ wristInvisibility = defaultEquipment
& itType . iyBase .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist) & itType . iyBase .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
overCID f _ cr = creatures . ix (_crID cr) %~ f overCID f _ cr = cWorld . creatures . ix (_crID cr) %~ f
+3 -3
View File
@@ -40,10 +40,10 @@ boostSelfL x itm cr w = case boostPoint x cr w of
cid = _crID cr cid = _crID cr
cpos = _crPos cr cpos = _crPos cr
r = _crRad cr r = _crRad cr
pid = fromMaybe (IM.newKey $ _props w) pid = fromMaybe (IM.newKey $ _props (_cWorld w))
(cr ^? crInv . ix invid . itAttachment . atInt) (cr ^? crInv . ix invid . itAttachment . atInt)
crEff p ammoEff = addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w crEff p ammoEff = addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w
& creatures . ix cid %~ & cWorld . creatures . ix cid %~
(crPos .~ p) (crPos .~ p)
. (crInv . ix invid %~ . (crInv . ix invid %~
ammoEff ammoEff
@@ -57,7 +57,7 @@ addBoostShockwave
-> Point2 -> Point2
-> World -> World
-> World -> World
addBoostShockwave pjid p v w = w & linearShockwaves %~ addBoostShockwave pjid p v w = w & cWorld . linearShockwaves %~
IM.insertWith f pjid thePJ IM.insertWith f pjid thePJ
where where
thePJ = LinearShockwave thePJ = LinearShockwave
+8 -8
View File
@@ -11,27 +11,27 @@ setHeldItemLoc cr = fst . getHeldItemLoc cr
getHeldItemLoc :: Creature -> World -> (World,Int) getHeldItemLoc :: Creature -> World -> (World,Int)
getHeldItemLoc cr w = case maybeitid of getHeldItemLoc cr w = case maybeitid of
Nothing -> Nothing ->
( w & creatures . ix cid . crInv . ix j . itID ?~ newitid ( w & cWorld . creatures . ix cid . crInv . ix j . itID ?~ newitid
& itemPositions %~ IM.insert newitid (InInv cid j) & cWorld . itemPositions %~ IM.insert newitid (InInv cid j)
, itid) , itid)
_ -> (w, itid) _ -> (w, itid)
where where
cid = _crID cr cid = _crID cr
j = crSel cr j = crSel cr
newitid = IM.newKey $ _itemPositions w newitid = IM.newKey $ _itemPositions (_cWorld w)
maybeitid = cr ^? crInv . ix j . itID . _Just maybeitid = cr ^? crInv . ix j . itID . _Just
itid = fromMaybe newitid maybeitid itid = fromMaybe newitid maybeitid
getItem :: Int -> World -> Maybe Item getItem :: Int -> World -> Maybe Item
getItem itid w = do getItem itid w = do
itpos <- w ^? itemPositions . ix itid itpos <- w ^? cWorld . itemPositions . ix itid
case itpos of case itpos of
OnFloor flitid -> w ^? floorItems . ix flitid . flIt OnFloor flitid -> w ^? cWorld . floorItems . ix flitid . flIt
InInv cid invid -> w ^? creatures . ix cid . crInv . ix invid InInv cid invid -> w ^? cWorld . creatures . ix cid . crInv . ix invid
VoidItm -> Nothing VoidItm -> Nothing
pointToItem :: Applicative f => pointToItem :: Applicative f =>
ItemPos -> (Item -> f Item) -> World -> f World ItemPos -> (Item -> f Item) -> World -> f World
pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid pointToItem (InInv cid invid) = cWorld . creatures . ix cid . crInv . ix invid
pointToItem (OnFloor flid) = floorItems . ix flid . flIt pointToItem (OnFloor flid) = cWorld . floorItems . ix flid . flIt
pointToItem _ = const pure pointToItem _ = const pure
+6 -6
View File
@@ -276,14 +276,14 @@ tractorGunTweak = TweakParam
-- | assumes that the item is held -- | assumes that the item is held
shootTeslaArc :: Item -> Creature -> World -> World shootTeslaArc :: Item -> Creature -> World -> World
shootTeslaArc it cr w = w' shootTeslaArc it cr w = w'
& creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip & cWorld . 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
dir = _crDir cr dir = _crDir cr
shootLaser :: Item -> Creature -> World -> World shootLaser :: Item -> Creature -> World -> World
shootLaser it cr = lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir shootLaser it cr = cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
where where
pos = _crPos cr pos = _crPos cr
dir = _crDir cr dir = _crDir cr
@@ -294,7 +294,7 @@ shootLaser it cr = lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos
circleLaser :: Item -> Creature -> World -> World circleLaser :: Item -> Creature -> World -> World
circleLaser it cr w circleLaser it cr w
| hasLOSIndirect cpos pos w = w | hasLOSIndirect cpos pos w = w
& lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir & cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
| otherwise = w | otherwise = w
where where
cpos = _crPos cr cpos = _crPos cr
@@ -306,8 +306,8 @@ circleLaser it cr w
shootDualLaser :: Item -> Creature -> World -> World shootDualLaser :: Item -> Creature -> World -> World
shootDualLaser it cr w = w' shootDualLaser it cr w = w'
& newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl & cWorld . newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl
& newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr & cWorld . newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr
where where
(w',itid) = getHeldItemLoc cr w (w',itid) = getHeldItemLoc cr w
dir = _crDir cr dir = _crDir cr
@@ -346,7 +346,7 @@ dualRayAt bt itid w col dam phasev pos dir = basicBeamAt itid w col dam phasev p
& bmType .~ bt & bmType .~ bt
aTractorBeam :: Item -> Creature -> World -> World aTractorBeam :: Item -> Creature -> World -> World
aTractorBeam _ cr w = w & tractorBeams .:~ tractorBeamAt spos outpos dir power aTractorBeam _ cr w = w & cWorld . 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
+8 -8
View File
@@ -38,11 +38,11 @@ import qualified SDL
autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
autoEffect eff t sid itm cr w autoEffect eff t sid itm cr w
| _eparamInt (_eqParams (_eqEq $ _itUse itm)) < 1 = eff itm cr w | _eparamInt (_eqParams (_eqEq $ _itUse itm)) < 1 = eff itm cr w
& creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm) & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm)
. itUse . eqEq . eqParams . eparamInt .~ t . itUse . eqEq . eqParams . eparamInt .~ t
& soundStart OnceSound (_crPos cr) sid Nothing & soundStart OnceSound (_crPos cr) sid Nothing
| otherwise = w | otherwise = w
& creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm) & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm)
. itUse . eqEq . eqParams . eparamInt -~ 1 . itUse . eqEq . eqParams . eparamInt -~ 1
{- | Automatically send out radar pulses that detect walls. -} {- | Automatically send out radar pulses that detect walls. -}
@@ -83,7 +83,7 @@ targetRBCreatureUp it cr w t
& tgPos .~ Nothing & tgPos .~ Nothing
& tgActive .~ False & tgActive .~ False
) )
| SDL.ButtonRight `M.member` _mouseButtons w && isJust (t ^? tgID . _Just) | SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) && isJust (t ^? tgID . _Just)
&& canSeeTarget = (w, t & updatePos && canSeeTarget = (w, t & updatePos
& tgActive .~ True & tgActive .~ True
) )
@@ -99,10 +99,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 ^? creatures . ix i . crPos posFromMaybeID (Just i) = w ^? cWorld . creatures . ix i . crPos
canSeeTarget = fromMaybe False $ do canSeeTarget = fromMaybe False $ do
cid <- t ^? tgID . _Just cid <- t ^? tgID . _Just
cpos <- w ^? creatures . ix cid . crPos cpos <- w ^? cWorld . creatures . ix cid . crPos
Just $ hasLOS cpos (_crPos cr) w Just $ hasLOS cpos (_crPos cr) w
targetUpdateWith :: (World -> Targeting -> Targeting) targetUpdateWith :: (World -> Targeting -> Targeting)
@@ -113,7 +113,7 @@ targetUpdateWith f it _ w t
targetCursorUpdate :: World -> Targeting -> Targeting targetCursorUpdate :: World -> Targeting -> Targeting
targetCursorUpdate w t targetCursorUpdate w t
| SDL.ButtonRight `M.member` _mouseButtons w = t | SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) = t
& tgPos . _Just .~ mouseWorldPos w & tgPos . _Just .~ mouseWorldPos w
& tgActive .~ True & tgActive .~ True
| otherwise = t & tgPos %~ const Nothing | otherwise = t & tgPos %~ const Nothing
@@ -121,7 +121,7 @@ targetCursorUpdate w t
targetRBPressUpdate :: World -> Targeting -> Targeting targetRBPressUpdate :: World -> Targeting -> Targeting
targetRBPressUpdate w t targetRBPressUpdate w t
| SDL.ButtonRight `M.member` _mouseButtons w = t | SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) = t
& tgPos %~ maybe (Just $ mouseWorldPos w) Just & tgPos %~ maybe (Just $ mouseWorldPos w) Just
& tgActive .~ True & tgActive .~ True
| otherwise = t & tgPos %~ const Nothing | otherwise = t & tgPos %~ const Nothing
@@ -140,7 +140,7 @@ targetLaserUpdate _ cr w t
(mp, _) = reflectLaserAlong 0.2 sp ep w (mp, _) = reflectLaserAlong 0.2 sp ep w
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 = lasers .:~ LaserStart addLaserPic = cWorld . lasers .:~ LaserStart
{ _lpPhaseV = 1 { _lpPhaseV = 1
, _lpDir = _crDir cr , _lpDir = _crDir cr
, _lpPos = sp , _lpPos = sp
+4 -4
View File
@@ -99,12 +99,12 @@ explodeRemoteRocket
-> World -> World
-> World -> World
explodeRemoteRocket itid pjid w = w explodeRemoteRocket itid pjid w = w
& projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid] & cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid]
& projectiles . ix pjid . prjDraw .~ DrawBlankProjectile & cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
& itPoint . itUse . rUse .~ HeldDoNothing & itPoint . itUse . rUse .~ HeldDoNothing
& usePayload (_prjPayload thepj) (_prjPos thepj) & usePayload (_prjPayload thepj) (_prjPos thepj)
where where
itPoint = pointToItem $ _itemPositions w IM.! itid itPoint = pointToItem $ _itemPositions (_cWorld w) IM.! itid
thepj = _projectiles w IM.! pjid thepj = _projectiles (_cWorld w) IM.! pjid
+7 -7
View File
@@ -12,17 +12,17 @@ import qualified IntMapHelp as IM
import Control.Lens import Control.Lens
setRemoteBombScope :: Int -> Prop -> World -> World setRemoteBombScope :: Int -> Prop -> World -> World
setRemoteBombScope itid pj w' = case _itemPositions w' IM.! itid of setRemoteBombScope itid pj w' = case _itemPositions (_cWorld w') IM.! itid of
InInv cid invid InInv cid invid
-> w' & creatures . ix cid . crInv . ix invid . itScope -> w' & cWorld . creatures . ix cid . crInv . ix invid . itScope
. scopePos .~ (_prPos pj -.- _crPos (_creatures w' IM.! cid)) . scopePos .~ (_prPos pj -.- _crPos (_creatures (_cWorld w') IM.! cid))
& creatures . ix cid . crInv . ix invid . itUse . useAim . aimZoom & cWorld . creatures . ix cid . crInv . ix invid . itUse . useAim . 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' ^? itemPositions . ix itid of setRemoteScope itid pos w' = case w' ^? cWorld . itemPositions . ix itid of
Just (InInv cid' invid ) Just (InInv cid' invid )
-> w' & creatures . ix cid' . crInv . ix invid . itScope -> w' & cWorld . creatures . ix cid' . crInv . ix invid . itScope
. scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid')) . scopePos .~ (pos -.- _crPos (_creatures (_cWorld w') IM.! cid'))
_ -> w' _ -> w'
+1 -1
View File
@@ -6,7 +6,7 @@ import Geometry.Vector
import Control.Lens import Control.Lens
decTimMvVel :: Proj -> World -> World decTimMvVel :: Proj -> World -> World
decTimMvVel pj = projectiles . ix pjid %~ decTimMvVel pj = cWorld . projectiles . ix pjid %~
( (prjTimer -~ 1) ( (prjTimer -~ 1)
. (prjPos %~ (+.+ vel) ) . (prjPos %~ (+.+ vel) )
. (prjAcc %~ rotateV rot ) . (prjAcc %~ rotateV rot )
+2 -2
View File
@@ -24,9 +24,9 @@ spawnCrNextTo
-> Creature -- ^ existing creature that will be spawned next to -> Creature -- ^ existing creature that will be spawned next to
-> World -> World
-> World -> World
spawnCrNextTo cr sCr w = w & creatures %~ IM.insert k newCr spawnCrNextTo cr sCr w = w & cWorld . creatures %~ IM.insert k newCr
where where
k = IM.newKey $ _creatures w k = IM.newKey $ _creatures (_cWorld w)
newCr = cr newCr = cr
& crID .~ k & crID .~ k
& crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr) & crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
+30 -30
View File
@@ -95,7 +95,7 @@ type ChainEffect
-> World -> World
lockInvFor :: Int -> ChainEffect lockInvFor :: Int -> ChainEffect
lockInvFor i f it cr = f it cr . (delayedEvents .:~ (i, UnlockInv (_crID cr))) lockInvFor i f it cr = f it cr . (cWorld . delayedEvents .:~ (i, UnlockInv (_crID cr)))
. lockInv (_crID cr) . lockInv (_crID cr)
trigDoAlso' trigDoAlso'
@@ -139,7 +139,7 @@ withThickSmokeI eff item cr w = eff item cr
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 & creatures . ix (_crID cr) %~ crCancelReloading | otherwise = eff itm cr $ w & cWorld . creatures . ix (_crID cr) %~ crCancelReloading
where where
ic = _itConsumption itm ic = _itConsumption itm
@@ -149,7 +149,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 . useHammer of | otherwise = case it ^? itUse . useHammer of
Just HammerUp -> eff it cr $ w & creatures . ix (_crID cr) %~ crCancelReloading Just HammerUp -> eff it cr $ w & cWorld . creatures . ix (_crID cr) %~ crCancelReloading
_ -> w _ -> w
where where
ic = _itConsumption it ic = _itConsumption it
@@ -184,7 +184,7 @@ rateIncAB exeffFirst exeffCont eff item cr w
startRate = _rateMaxMax . _useDelay $ _itUse item startRate = _rateMaxMax . _useDelay $ _itUse item
cid = _crID cr cid = _crID cr
itRef = crSel cr itRef = crSel cr
pointItem = creatures . ix cid . crInv . ix itRef pointItem = cWorld . creatures . ix cid . crInv . ix itRef
currentRate = _rateMax (_useDelay (_itUse item)) currentRate = _rateMax (_useDelay (_itUse item))
repeatFire = crWeaponReady cr && _rateTime (_useDelay (_itUse item)) == 1 repeatFire = crWeaponReady cr && _rateTime (_useDelay (_itUse item)) == 1
firstFire = crWeaponReady cr && _rateTime (_useDelay (_itUse item)) == 0 firstFire = crWeaponReady cr && _rateTime (_useDelay (_itUse item)) == 0
@@ -203,7 +203,7 @@ withWarmUp soundID f item cr w
where where
cid = _crID cr cid = _crID cr
itRef = crSel cr itRef = crSel cr
pointerToItem = creatures . ix cid . crInv . ix itRef pointerToItem = cWorld . creatures . ix cid . crInv . ix itRef
curWarmUp = _warmTime . _useDelay $ _itUse item curWarmUp = _warmTime . _useDelay $ _itUse item
maxWarmUp = _warmMax . _useDelay $ _itUse item maxWarmUp = _warmMax . _useDelay $ _itUse item
withSoundItemChoiceStart withSoundItemChoiceStart
@@ -259,12 +259,12 @@ withSoundForVol vol soundid playTime f item cr
afterRecoil afterRecoil
:: Float -- ^ Recoil amount :: Float -- ^ Recoil amount
-> ChainEffect -> ChainEffect
afterRecoil recoilAmount eff item cr = eff item (pushback cr) . over (creatures . ix cid) pushback afterRecoil recoilAmount eff item cr = eff item (pushback cr) . over (cWorld . 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 (creatures . ix cid) pushback withRecoil eff it cr = eff it cr . over (cWorld . creatures . ix cid) pushback
where where
cid = _crID cr cid = _crID cr
recoilAmount = fromMaybe 0 $ it ^? itParams . recoil recoilAmount = fromMaybe 0 $ it ^? itParams . recoil
@@ -275,7 +275,7 @@ withSidePushI
:: Float -- ^ Maximal possible side push amount :: Float -- ^ Maximal possible side push amount
-> ChainEffect -> ChainEffect
withSidePushI maxSide eff item cr w = eff item (push cr) $ w withSidePushI maxSide eff item cr w = eff item (push cr) $ w
& creatures . ix cid %~ push & cWorld . creatures . ix cid %~ push
& randGen .~ g & randGen .~ g
where where
cid = _crID cr cid = _crID cr
@@ -287,7 +287,7 @@ Applied after the underlying effect. -}
withSidePushAfterI withSidePushAfterI
:: Float -- ^ Maximal possible side push amount :: Float -- ^ Maximal possible side push amount
-> ChainEffect -> ChainEffect
withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff item cr $ w withSidePushAfterI maxSide eff item cr w = over (cWorld . creatures . ix cid) push . eff item cr $ w
& randGen .~ g & randGen .~ g
where where
cid = _crID cr cid = _crID cr
@@ -295,14 +295,14 @@ withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff
(pushAmount, g) = randomR (-maxSide,maxSide) $ _randGen w (pushAmount, g) = randomR (-maxSide,maxSide) $ _randGen w
useAllAmmo :: ChainEffect useAllAmmo :: ChainEffect
useAllAmmo eff item cr = eff item cr useAllAmmo eff item cr = eff item cr
. (creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded .~ 0) . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded .~ 0)
useAmmoUpTo :: Int -> ChainEffect useAmmoUpTo :: Int -> ChainEffect
useAmmoUpTo amAmount eff item cr = eff item cr useAmmoUpTo amAmount eff item cr = eff item cr
. (creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded
%~ (max 0 . subtract amAmount)) %~ (max 0 . subtract amAmount))
useAmmoAmount :: Int -> ChainEffect useAmmoAmount :: Int -> ChainEffect
useAmmoAmount amAmount eff item cr = eff item cr useAmmoAmount amAmount eff item cr = eff item cr
. (creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded -~ amAmount) . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded -~ amAmount)
{- | {- |
Applies a world effect after an item use cooldown check. -} Applies a world effect after an item use cooldown check. -}
useTimeCheck :: ChainEffect useTimeCheck :: ChainEffect
@@ -311,7 +311,7 @@ useTimeCheck f item cr w = case item ^? itUse . useDelay . rateTime of
_ -> w _ -> w
where where
cid = _crID cr cid = _crID cr
setUseTime = creatures . ix cid . crInv . ix (crSel cr) . itUse . useDelay . rateTime +~ userate setUseTime = cWorld . creatures . ix cid . crInv . ix (crSel cr) . itUse . useDelay . rateTime +~ userate
userate = fromMaybe 0 $ item ^? itUse . useDelay . rateMax userate = fromMaybe 0 $ item ^? itUse . useDelay . rateMax
{- | Applies a world effect after a hammer position check. -} {- | Applies a world effect after a hammer position check. -}
hammerCheckI :: ChainEffect hammerCheckI :: ChainEffect
@@ -332,7 +332,7 @@ ammoUseCheck f item cr w
where where
cid = _crID cr cid = _crID cr
itRef = crSel cr itRef = crSel cr
pointerToItem = creatures . ix cid . crInv . ix itRef pointerToItem = cWorld . creatures . ix cid . crInv . ix itRef
fireCondition = crWeaponReady cr fireCondition = crWeaponReady cr
&& _rateTime (_useDelay (_itUse item)) == 0 && _rateTime (_useDelay (_itUse item)) == 0
&& _laLoaded (_itConsumption item) > 0 && _laLoaded (_itConsumption item) > 0
@@ -364,7 +364,7 @@ shootL f item cr w
where where
cid = _crID cr cid = _crID cr
invid = _ipInvID $ _itPos item invid = _ipInvID $ _itPos item
pointerToItem = creatures . ix cid . crInv . ix invid pointerToItem = cWorld . creatures . ix cid . crInv . ix invid
fireCondition = _rateTime (_useDelay (_itUse item)) == 0 fireCondition = _rateTime (_useDelay (_itUse item)) == 0
&& _arLoaded (_itConsumption item) > 0 && _arLoaded (_itConsumption item) > 0
-- reloadCondition = _laLoaded (_itConsumption item) == 0 -- reloadCondition = _laLoaded (_itConsumption item) == 0
@@ -373,20 +373,20 @@ 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 . (creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up) withItemUpdate' up f it cr = f (up it) cr . (cWorld . 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 . (creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up) withItemUpdate up g f it cr = g it f it cr . (cWorld . 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 = eff item cr withTempLight time rad col eff item cr = eff item cr
. over tempLightSources (theTLS :) . over (cWorld . 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)
modClock :: Int -> ChainEffect -> ChainEffect modClock :: Int -> ChainEffect -> ChainEffect
modClock n chainEff eff it cr w modClock n chainEff eff it cr w
| _worldClock w `mod` n == 0 = chainEff eff it cr w | _worldClock (_cWorld w) `mod` n == 0 = chainEff eff it cr w
| otherwise = eff it cr w | otherwise = eff it cr w
withMuzFlareI :: ChainEffect withMuzFlareI :: ChainEffect
@@ -491,9 +491,9 @@ torqueBefore
torqueBefore torque feff item cr w torqueBefore torque feff item cr w
| cid == 0 = feff item (cr & crDir +~ rot) $ w | cid == 0 = feff item (cr & crDir +~ rot) $ w
& randGen .~ g & randGen .~ g
& creatures . ix cid . crDir +~ rot & cWorld . creatures . ix cid . crDir +~ rot
& cameraRot +~ rot & cWorld . cameraRot +~ rot
| otherwise = feff item cr $ set randGen g $ over (creatures . ix cid . crDir) (+rot) w | otherwise = feff item cr $ set randGen g $ over (cWorld . 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
@@ -506,9 +506,9 @@ torqueBeforeAtLeast
torqueBeforeAtLeast minTorque exTorque feff item cr w torqueBeforeAtLeast minTorque exTorque feff item cr w
| cid == 0 = feff item (cr & crDir +~ rot') $ w | cid == 0 = feff item (cr & crDir +~ rot') $ w
& randGen .~ g & randGen .~ g
& creatures . ix cid . crDir +~ rot' & cWorld . creatures . ix cid . crDir +~ rot'
& cameraRot +~ rot' & cWorld . cameraRot +~ rot'
| otherwise = feff item cr $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w | otherwise = feff item cr $ set randGen g $ over (cWorld . 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
@@ -518,8 +518,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 cameraRot (+rot) $ feff item cr w | cid == 0 = set randGen g $ over (cWorld . cameraRot) (+rot) $ feff item cr w
| otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff item cr w | otherwise = set randGen g $ over (cWorld . 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
@@ -547,12 +547,12 @@ sideEffectOnFrame :: Int
-> (Item -> Creature -> WdWd) -> (Item -> Creature -> WdWd)
-> ChainEffect -> ChainEffect
sideEffectOnFrame i sf f it cr w = f it cr w sideEffectOnFrame i sf f it cr w = f it cr w
& delayedEvents .:~ (i, sf it cr) & cWorld . 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 cameraRot (+rot) w | cid == 0 = set randGen g $ over (cWorld . cameraRot) (+rot) w
| otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) w | otherwise = set randGen g $ over (cWorld . 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
+3 -3
View File
@@ -90,11 +90,11 @@ useForceFieldGun itm cr w = fromMaybe w $ do
b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a) b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a)
wlline = (a,b) wlline = (a,b)
return $ w return $ w
& walls %~ IM.insertWith (\_ x -> x) i forceField {_wlID = i} & cWorld . walls %~ IM.insertWith (\_ x -> x) i forceField {_wlID = i}
& creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itParams . paramMID ?~ i & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itParams . paramMID ?~ i
& moveWallIDUnsafe i wlline & moveWallIDUnsafe i wlline
where where
i = fromMaybe (IM.newKey (_walls w)) $ itm ^? itParams . paramMID . _Just i = fromMaybe (IM.newKey (_walls (_cWorld w))) $ itm ^? itParams . paramMID . _Just
-- grapGun = defaultGun -- grapGun = defaultGun
-- { _itName = "grapGun" -- { _itName = "grapGun"
+5 -5
View File
@@ -10,16 +10,16 @@ import LensHelp
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
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 -> let i = IM.newKey (_lightSources w) Nothing -> let i = IM.newKey (_lightSources (_cWorld w))
in w & lightSources %~ IM.insert i (lsColPosID lcol (addZ h cpos) i) in w & cWorld . lightSources %~ IM.insert i (lsColPosID lcol (addZ h cpos) i)
Just i Just i
| _crHP cr < 0 -> w | _crHP cr < 0 -> 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
& lightSources . at i .~ Nothing & cWorld . lightSources . at i .~ Nothing
& creatures . at cid .~ Nothing & cWorld . creatures . at cid .~ Nothing
| otherwise -> w | otherwise -> w
& lightSources . ix i . lsParam . lsPos .~ addZ h cpos & cWorld . lightSources . ix i . lsParam . lsPos .~ addZ h cpos
& doDamage cr & doDamage cr
where where
cpos = _crPos cr cpos = _crPos cr
+10 -11
View File
@@ -41,12 +41,11 @@ generateLevelFromRoomList gr' w = over gwWorld initWallZoning
. doIndividualPlacements . doIndividualPlacements
. setFloors . setFloors
. worldToGenWorld rs' . worldToGenWorld rs'
$ w { _walls = wallsFromRooms rs $ w & cWorld . walls .~ wallsFromRooms rs
, _gameRooms = gameRoomsFromRooms (IM.elems rs') & cWorld . gameRooms .~ gameRoomsFromRooms (IM.elems rs')
, _pathGraph = path & cWorld . pathGraph .~ path
} & cWorld . pnZoning .~ foldl' (flip zonePn) mempty (labNodes path)
& pnZoning .~ foldl' (flip zonePn) mempty (labNodes path) & cWorld . peZoning .~ foldl' (flip zonePe) mempty (labEdges path)
& peZoning .~ foldl' (flip zonePe) mempty (labEdges path)
where where
(_,path) = pairsToGraph pairPath' (_,path) = pairsToGraph pairPath'
pairPath = foldMap _rmPath rs pairPath = foldMap _rmPath rs
@@ -55,10 +54,10 @@ generateLevelFromRoomList gr' w = over gwWorld initWallZoning
rs'= mapM shuffleRoomPos gr' & evalState $ _randGen w rs'= mapM shuffleRoomPos gr' & evalState $ _randGen w
randomCompass :: World -> World randomCompass :: World -> World
randomCompass w = w & cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w) randomCompass w = w & cWorld . cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w)
putFloorTiles :: GenWorld -> GenWorld putFloorTiles :: GenWorld -> GenWorld
putFloorTiles gw = gw & gwWorld . floorTiles .~ floorsFromGenWorld gw putFloorTiles gw = gw & gwWorld . cWorld . floorTiles .~ floorsFromGenWorld gw
setFloors :: GenWorld -> GenWorld setFloors :: GenWorld -> GenWorld
setFloors = putFloorTiles . setTiles setFloors = putFloorTiles . setTiles
@@ -124,7 +123,7 @@ doRoomPlacements :: GenWorld -> Room -> (GenWorld, Room)
doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm
setupWorldBounds :: World -> World setupWorldBounds :: World -> World
setupWorldBounds w = w & worldBounds %~ setupWorldBounds w = w & cWorld . worldBounds %~
( (bdMinX .~ f minx) ( (bdMinX .~ f minx)
. (bdMaxX .~ f maxx) . (bdMaxX .~ f maxx)
. (bdMinY .~ f miny) . (bdMinY .~ f miny)
@@ -132,7 +131,7 @@ setupWorldBounds w = w & worldBounds %~
) )
where where
f = fromMaybe 0 f = fromMaybe 0
ps = IM.map (fst . _wlLine) $ _walls w ps = IM.map (fst . _wlLine) $ _walls (_cWorld w)
(minx,maxx,miny,maxy) = L.fold ((,,,) (minx,maxx,miny,maxy) = L.fold ((,,,)
<$> L.premap fstV2 L.minimum <$> L.premap fstV2 L.minimum
<*> L.premap fstV2 L.maximum <*> L.premap fstV2 L.maximum
@@ -144,7 +143,7 @@ setupWorldBounds w = w & worldBounds %~
--polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges --polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges
initWallZoning :: World -> World initWallZoning :: World -> World
initWallZoning w = foldl' (flip insertWallInZones) (w & wlZoning .~ IM.empty) (_walls w) initWallZoning w = foldl' (flip insertWallInZones) (w & cWorld . wlZoning .~ IM.empty) (_walls (_cWorld w))
--makePath :: Tree Room -> [(Point2,Point2)] --makePath :: Tree Room -> [(Point2,Point2)]
--makePath = concatMap _rmPath . flatten --makePath = concatMap _rmPath . flatten
+3 -3
View File
@@ -29,17 +29,17 @@ generateWorldFromSeed i = do
return -- $ saveLevelStartSlot return -- $ saveLevelStartSlot
$ postGenerationProcessing $ postGenerationProcessing
$ _gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i}) $ _gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i})
& roomClipping .~ bounds & cWorld . roomClipping .~ bounds
postGenerationProcessing :: World -> World postGenerationProcessing :: World -> World
postGenerationProcessing w = foldl' assignPushDoors w (_doors w) postGenerationProcessing w = foldl' assignPushDoors w (_doors (_cWorld w))
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 & doors . ix i . drPushes ?~ _drID dr PushedBy i -> w & cWorld . doors . ix i . drPushes ?~ _drID dr
_ -> w _ -> w
layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room,[ConvexPoly]) layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room,[ConvexPoly])
+1 -1
View File
@@ -18,7 +18,7 @@ import qualified Data.Map.Strict as M
worldToGenWorld :: IM.IntMap Room -> World -> GenWorld worldToGenWorld :: IM.IntMap Room -> World -> GenWorld
worldToGenWorld rms w = GenWorld worldToGenWorld rms w = GenWorld
{ _gwWorld = w & genParams .~ evalState generateGenParams (_randGen w) { _gwWorld = w & cWorld . genParams .~ evalState generateGenParams (_randGen w)
, _genRooms = rms , _genRooms = rms
, _genPlacements = mempty , _genPlacements = mempty
} }
+4 -4
View File
@@ -84,19 +84,19 @@ tlsTimeRadColPos t rmax col (V3 x y z) = TLS
} }
makeTlsTimeRadColPos :: Int -> Float -> Point3 -> Point3 -> World -> World makeTlsTimeRadColPos :: Int -> Float -> Point3 -> Point3 -> World -> World
makeTlsTimeRadColPos i rad (V3 r g b) p = tempLightSources .:~ tlsTimeRadColPos i rad (V3 r g b) p makeTlsTimeRadColPos i rad (V3 r g b) p = cWorld . tempLightSources .:~ tlsTimeRadColPos i rad (V3 r g b) p
destroyLS :: Int -> World -> World destroyLS :: Int -> World -> World
destroyLS lsid w = w destroyLS lsid w = w
& lightSources . at lsid .~ Nothing & cWorld . 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 ^?! lightSources . ix lsid ls = w ^?! cWorld . 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') = tempLightSources .:~ tlsTimeRadFunPos 20 150 destroyLSFlashAt (V3 x' y' z') = cWorld . tempLightSources .:~ tlsTimeRadFunPos 20 150
(TLSFade 1 10) (TLSFade 1 10)
(addZ z' p) (addZ z' p)
where where
+1 -1
View File
@@ -6,7 +6,7 @@ import Dodge.Item.Draw -- heldItemOffset needs to be moved somewhere more sensi
import Dodge.LightSource -- this needs to be split! import Dodge.LightSource -- this needs to be split!
createTorchLightOffset :: Creature -> Item -> Point3 -> World -> World createTorchLightOffset :: Creature -> Item -> Point3 -> World -> World
createTorchLightOffset cr it off = tempLightSources .:~ tlsTimeRadColPos 1 250 0.7 createTorchLightOffset cr it off = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 250 0.7
(p +.+.+ rotate3 (_crDir cr) (heldItemOffset it cr (off +.+.+ V3 8 0 1.5))) (p +.+.+ rotate3 (_crDir cr) (heldItemOffset it cr (off +.+.+ V3 8 0 1.5)))
where where
p = addZ 0 $ _crPos cr p = addZ 0 $ _crPos cr
+2 -2
View File
@@ -7,8 +7,8 @@ import Control.Lens
updateLinearShockwave :: LinearShockwave -> World -> World updateLinearShockwave :: LinearShockwave -> World -> World
updateLinearShockwave lw w updateLinearShockwave lw w
| t < 1 = w & linearShockwaves %~ IM.delete lwid | t < 1 = w & cWorld . linearShockwaves %~ IM.delete lwid
| otherwise = w & linearShockwaves . ix lwid . lwTimer -~ 1 | otherwise = w & cWorld . linearShockwaves . ix lwid . lwTimer -~ 1
where where
lwid = _lwID lw lwid = _lwID lw
t = _lwTimer lw t = _lwTimer lw
+5 -5
View File
@@ -16,18 +16,18 @@ useL lu = case lu of
LBoost -> boostSelfL 10 LBoost -> boostSelfL 10
useRewindGun :: Item -> Creature -> World -> World useRewindGun :: Item -> Creature -> World -> World
useRewindGun _ _ w = case _rewindWorlds w of useRewindGun _ _ w = case _rewindWorlds (_cWorld w) of
[w'] -> rewindusing w' [w'] [w'] -> rewindusing w' [w']
(w':ws) -> rewindusing w' ws (w':ws) -> rewindusing w' ws
_ -> w _ -> w
where where
rewindusing w' ws = w rewindusing w' ws = w
& maybeWorld .~ Just' ( w' & cWorld . maybeWorld .~ Just' ( w'
-- & creatures . ix (_crID cr) .~ cr -- & creatures . ix (_crID cr) .~ cr
& upbuts & upbuts
& rewindWorlds .~ ws & cWorld . rewindWorlds .~ ws
) )
upbuts = (keys .~ _keys w) . (mouseButtons .~ _mouseButtons w) upbuts = (cWorld . keys .~ _keys (_cWorld w)) . (cWorld . mouseButtons .~ _mouseButtons (_cWorld w))
-- be careful changing this around; potential problems include updating the -- be careful changing this around; potential problems include updating the
-- creature but using the old crInvSel value -- creature but using the old crInvSel value
@@ -39,5 +39,5 @@ useShrinkGun it cr w = if _atBool $ _itAttachment it
where where
invid = _ipInvID $ _itPos it invid = _ipInvID $ _itPos it
tryResize x g = maybe w g $ sizeSelf x cr w tryResize x g = maybe w g $ sizeSelf x cr w
f isInUse cstatus = creatures . ix (_crID cr) . crInv . ix invid %~ f isInUse cstatus = cWorld . creatures . ix (_crID cr) . crInv . ix invid %~
( (itAttachment . atBool .~ isInUse) . (itCurseStatus .~ cstatus) ) ( (itAttachment . atBool .~ isInUse) . (itCurseStatus .~ cstatus) )
+4 -4
View File
@@ -19,9 +19,9 @@ machineUpdateLiveDieEff
-> Machine -> World -> World -> Machine -> World -> World
machineUpdateLiveDieEff livef dief mc machineUpdateLiveDieEff livef dief mc
| _mcHP mc < 1 = dief mc | _mcHP mc < 1 = dief mc
. (machines %~ IM.delete mcid) . (cWorld . machines %~ IM.delete mcid)
. deleteWallIDs (_mcWallIDs mc) . deleteWallIDs (_mcWallIDs mc)
| otherwise = livef mc . (machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) )) | otherwise = livef mc . (cWorld . 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
@@ -30,9 +30,9 @@ machineUpdateDeathEff :: (Machine -> World -> World)
-> Machine -> World -> World -> Machine -> World -> World
machineUpdateDeathEff f mc machineUpdateDeathEff f mc
| _mcHP mc < 1 = f mc | _mcHP mc < 1 = f mc
. (machines %~ IM.delete mcid) . (cWorld . machines %~ IM.delete mcid)
. deleteWallIDs (_mcWallIDs mc) . deleteWallIDs (_mcWallIDs mc)
| otherwise = machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) ) | otherwise = cWorld . 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
+1 -1
View File
@@ -3,7 +3,7 @@ import Dodge.Data
import LensHelp import LensHelp
basicMachineApplyDamage :: Machine -> World -> World basicMachineApplyDamage :: Machine -> World -> World
basicMachineApplyDamage mc = machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) ) basicMachineApplyDamage mc = cWorld . 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
+3 -3
View File
@@ -9,7 +9,7 @@ import Data.Maybe
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
destroyMachine :: Machine -> World -> World destroyMachine :: Machine -> World -> World
destroyMachine mc = (machines %~ IM.delete (_mcID mc)) destroyMachine mc = (cWorld . machines %~ IM.delete (_mcID mc))
. deleteWallIDs (_mcWallIDs mc) . deleteWallIDs (_mcWallIDs mc)
. makeExplosionAt (_mcPos mc) . makeExplosionAt (_mcPos mc)
. mcKillTerm mc . mcKillTerm mc
@@ -18,11 +18,11 @@ destroyMachine mc = (machines %~ IM.delete (_mcID mc))
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 ^? terminals . ix tmid tm <- w ^? cWorld . terminals . ix tmid
return $ w return $ w
& doTmWdWd (_tmDeathEffect tm) tm & doTmWdWd (_tmDeathEffect tm) tm
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 & buttons . at btid .~ Nothing return $ w & cWorld . buttons . at btid .~ Nothing
+21 -21
View File
@@ -34,7 +34,7 @@ mcTurretUpdate mc = case _mcType mc of
-- this needs a major cleanup -- this needs a major cleanup
updateTurret :: Float -> Machine -> World -> World updateTurret :: Float -> Machine -> World -> World
updateTurret rotSpeed mc w updateTurret rotSpeed mc w
| _mcHP mc < 1 = w & machines %~ IM.delete mcid | _mcHP mc < 1 = w & cWorld . machines %~ IM.delete mcid
& deleteWallIDs (_mcWallIDs mc) & deleteWallIDs (_mcWallIDs mc)
& makeExplosionAt mcpos & makeExplosionAt mcpos
& copyItemToFloor mcpos lasGun & copyItemToFloor mcpos lasGun
@@ -47,12 +47,12 @@ updateTurret rotSpeed mc w
where where
deleteHomonculus = case _tuMCrID (_mcType mc) of deleteHomonculus = case _tuMCrID (_mcType mc) of
Nothing -> id Nothing -> id
Just cid -> creatures . at cid .~ Nothing Just cid -> cWorld . creatures . at cid .~ Nothing
initHomonculus w' = case w' ^? machines . ix mcid . mcType . tuMCrID . _Just of initHomonculus w' = case w' ^? cWorld . machines . ix mcid . mcType . tuMCrID . _Just of
Nothing -> w' & machines . ix mcid . mcType . tuMCrID ?~ cid Nothing -> w' & cWorld . machines . ix mcid . mcType . tuMCrID ?~ cid
& creatures . at cid ?~ thecreature & cWorld . creatures . at cid ?~ thecreature
where where
cid = IM.newKey (_creatures w') cid = IM.newKey (_creatures (_cWorld w'))
thecreature = defaultCreature thecreature = defaultCreature
& crID .~ cid & crID .~ cid
& crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10 & crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10
@@ -65,9 +65,9 @@ updateTurret rotSpeed mc w
& crStance . posture .~ Aiming & crStance . posture .~ Aiming
& crMaterial .~ Crystal & crMaterial .~ Crystal
Just cid -> w' Just cid -> w'
& creatures . ix cid . crPos .~ mcpos & cWorld . creatures . ix cid . crPos .~ mcpos
& creatures . ix cid . crDir .~ mcdir & cWorld . creatures . ix cid . crDir .~ mcdir
dodamage = machines . ix mcid %~ dodamage = cWorld . 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)
) )
@@ -78,7 +78,7 @@ updateTurret rotSpeed mc w
| _tuFireTime (_mcType mc) > 0 | _tuFireTime (_mcType mc) > 0
= fromMaybe id $ do = fromMaybe id $ do
cid <- _tuMCrID (_mcType mc) cid <- _tuMCrID (_mcType mc)
return $ creatures . ix cid . crActionPlan . apImpulse .~ [UseItem] return $ cWorld . creatures . ix cid . crActionPlan . apImpulse .~ [UseItem]
| otherwise = id | otherwise = id
mcid = _mcID mc mcid = _mcID mc
ypos = _crPos $ you w ypos = _crPos $ you w
@@ -89,18 +89,18 @@ 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 = machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos | seesYou = cWorld . machines . ix mcid . mcDir %~ 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 = machines . ix mcid . mcType . tuFireTime .~ 20 | closeFireAngle = cWorld . machines . ix mcid . mcType . tuFireTime .~ 20
| otherwise = machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1) | otherwise = cWorld . machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
mcSensorTriggerUpdate :: Machine -> World -> World mcSensorTriggerUpdate :: Machine -> World -> World
mcSensorTriggerUpdate mc = fromMaybe id $ do mcSensorTriggerUpdate mc = fromMaybe id $ do
trid <- mc ^? mcMounts . ix ObTrigger trid <- mc ^? mcMounts . ix ObTrigger
bval <- mcTriggerVal mc bval <- mcTriggerVal mc
return $ triggers . ix trid .~ bval return $ cWorld . triggers . ix trid .~ bval
mcTriggerVal :: Machine -> Maybe Bool mcTriggerVal :: Machine -> Maybe Bool
mcTriggerVal mc = case mc ^. mcSensor of mcTriggerVal mc = case mc ^. mcSensor of
@@ -119,7 +119,7 @@ mcPlaySound mc w = case _mcCloseSound mc of
mcApplyDamage :: [Damage] -> Machine -> World -> World mcApplyDamage :: [Damage] -> Machine -> World -> World
mcApplyDamage ds mc = case _mcSensor mc of mcApplyDamage ds mc = case _mcSensor mc of
NoSensor -> machines . ix (_mcID mc) %~ NoSensor -> cWorld . machines . ix (_mcID mc) %~
( (mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)) ) ( (mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)) )
_ -> id _ -> id
@@ -137,12 +137,12 @@ mcProximitySensorUpdate mc w = case
, dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of , dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of
(_,True,_,_) -> w (_,True,_,_) -> w
(_,False,True,True) -> w (_,False,True,True) -> w
& machines . ix (_mcID mc) . mcSensor . sensToggle .~ True & cWorld . machines . ix (_mcID mc) . mcSensor . sensToggle .~ True
& playsound dedaS & playsound dedaS
& machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose & cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
(NotClose,_,False,True) -> w & playsound dedumS (NotClose,_,False,True) -> w & playsound dedumS
& machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose & cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
(_,_,_,False) -> w & machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose (_,_,_,False) -> w & cWorld . machines . ix (_mcID mc) . 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
@@ -158,7 +158,7 @@ mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
cr = you w cr = you w
senseDamage :: DamageType -> Machine -> World -> World senseDamage :: DamageType -> Machine -> World -> World
senseDamage dt mc = (machines . ix mcid %~ upmc) senseDamage dt mc = (cWorld . machines . ix mcid %~ upmc)
. updatels . updatels
where where
upmc = mcSensor . sensAmount %~ min 1000 . max 0 . (+ (newsense - 5)) upmc = mcSensor . sensAmount %~ min 1000 . max 0 . (+ (newsense - 5))
@@ -167,7 +167,7 @@ senseDamage dt mc = (machines . ix mcid %~ upmc)
ni = fromIntegral (_sensAmount $ _mcSensor mc) / 1000 ni = fromIntegral (_sensAmount $ _mcSensor mc) / 1000
updatels = fromMaybe id $ do updatels = fromMaybe id $ do
lsid <- mc ^? mcMounts . ix ObLightSource lsid <- mc ^? mcMounts . ix ObLightSource
return $ lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni return $ cWorld . 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
+2 -2
View File
@@ -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 ^?! triggers . ix (_mdExternalID2 md) MdTrigIf ftrue ffalse -> \md w -> if w ^?! cWorld . 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 & lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ col MdSetLSCol col -> \md w -> w & cWorld . 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
+6 -6
View File
@@ -34,13 +34,13 @@ import qualified Streaming.Prelude as S
--import Data.Graph.Inductive.Graph hiding ((&)) --import Data.Graph.Inductive.Graph hiding ((&))
getNodePos :: Int -> World -> Maybe Point2 getNodePos :: Int -> World -> Maybe Point2
getNodePos i w = _pathGraph w `lab` i getNodePos i w = _pathGraph (_cWorld w) `lab` i
makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int] makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int]
makePathBetween a b w = do -- join $ sp <$> a' <*> b' <*> return (_pathGraph w) makePathBetween a b w = do -- 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 w)) sp na nb (second _peDist (efilter (not . pathEdgeObstructed . (^. _3)) $ _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
@@ -53,15 +53,15 @@ walkableNodeNear :: World -> Point2 -> Maybe Int
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 = runIdentity . S.toList_ $ nearPoint _pnZoning p w --nodesNear = runIdentity . S.toList_ $ nearPoint _pnZoning p w
nodesNear = zonesExtract (w ^. pnZoning) $ zonesAroundPoint pnZoneSize p nodesNear = zonesExtract (w ^. cWorld . pnZoning) $ zonesAroundPoint pnZoneSize p
makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2] makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph w) <$> makePathBetween a b w makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph (_cWorld w)) <$> 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 w g = _pathGraph (_cWorld w)
pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2 pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2
@@ -137,7 +137,7 @@ addEdges nodemap gr = runIdentity . S.fold_ f (mempty,gr) id
obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World -> ( World, [(Int,Int,PathEdge)]) obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World -> ( World, [(Int,Int,PathEdge)])
obstructPathsCrossing obstacletype sp' ep w = obstructPathsCrossing obstacletype sp' ep w =
( w & pathGraph %~ updateedges ( w & cWorld . pathGraph %~ updateedges
, es , es
) )
where where
+8 -8
View File
@@ -20,9 +20,9 @@ fixedSizePicAt pic p w
. scale theScale theScale . scale theScale theScale
$ pic $ pic
where where
campos = _cameraViewFrom w campos = _cameraViewFrom (_cWorld w)
v = p -.- campos v = p -.- campos
theScale = 1 / _cameraZoom w theScale = 1 / _cameraZoom (_cWorld w)
(V2 x y) = campos +.+ v (V2 x y) = campos +.+ v
fixedSizePicClamp fixedSizePicClamp
@@ -40,11 +40,11 @@ fixedSizePicClamp xbord ybord pic p cfig w
. scale theScale theScale . scale theScale theScale
$ pic $ pic
where where
r = negate $ _cameraRot w r = negate $ _cameraRot (_cWorld w)
z = _cameraZoom w z = _cameraZoom (_cWorld w)
campos = _cameraViewFrom w campos = _cameraViewFrom (_cWorld w)
v = p -.- campos v = p -.- campos
theScale = 1 / _cameraZoom w theScale = 1 / _cameraZoom (_cWorld w)
(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
@@ -71,8 +71,8 @@ fixedSizePicClampArrow xbord ybord pic p cfig w = pictures
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 = _cameraCenter w campos = _cameraCenter (_cWorld w)
theScale = 1 / _cameraZoom w theScale = 1 / _cameraZoom (_cWorld w)
absClamp absClamp
:: Float -- ^ clamping value, assumed positive :: Float -- ^ clamping value, assumed positive
@@ -18,13 +18,13 @@ flickerMod pl = Just $ sps0 $ PutMod $ ModIDTimerPoint3Bool
flickerUpdate :: Modification -> World -> World flickerUpdate :: Modification -> World -> World
flickerUpdate md w flickerUpdate md w
| _mdTimer md > 0 = w & modifications . ix mdid . mdTimer -~ 1 | _mdTimer md > 0 = w & cWorld . modifications . ix mdid . mdTimer -~ 1
| otherwise = w & lightSources . ix lsid . lsParam . lsCol .~ mdcol | otherwise = w & cWorld . lightSources . ix lsid . lsParam . lsCol .~ mdcol
& modifications . ix mdid & cWorld . modifications . ix mdid
%~ ( (mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not) ) %~ ( (mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not) )
where where
mdcol = _mdPoint3 md mdcol = _mdPoint3 md
lscol = _lsCol $ _lsParam $ _lightSources w IM.! lsid lscol = w ^?! cWorld . 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
+1 -1
View File
@@ -29,7 +29,7 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1)
& mcColor .~ yellow & mcColor .~ yellow
& mcMounts . at ObTrigger .~ mtrid & mcMounts . at ObTrigger .~ mtrid
& mcMounts . at ObLightSource ?~ lsid & mcMounts . at ObLightSource ?~ lsid
& mcDraw .~ MachineDrawDamageSensor wdth (_sensorCoding (_genParams gw) M.! dt) & mcDraw .~ MachineDrawDamageSensor wdth (_sensorCoding (_genParams (_cWorld gw)) M.! dt)
& mcSensor .~ DamageSensor False 0 dt & mcSensor .~ DamageSensor False 0 dt
) )
defaultSensorWall defaultSensorWall
+4 -4
View File
@@ -29,10 +29,10 @@ putTerminal mc tm
$ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl) $ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl)
where where
setids tmpl btpl mcpl w = w setids tmpl btpl mcpl w = w
& terminals . ix tmid . tmButtonID .~ btid & cWorld . terminals . ix tmid . tmButtonID .~ btid
& terminals . ix tmid . tmMachineID .~ mcid & cWorld . terminals . ix tmid . tmMachineID .~ mcid
& machines . ix mcid . mcMounts . at ObTerminal ?~ tmid & cWorld . machines . ix mcid . mcMounts . at ObTerminal ?~ tmid
& buttons . ix btid . btTermMID ?~ tmid & cWorld . buttons . ix btid . btTermMID ?~ tmid
where where
tmid = fromJust (_plMID tmpl) tmid = fromJust (_plMID tmpl)
btid = fromJust (_plMID btpl) btid = fromJust (_plMID btpl)
+13 -13
View File
@@ -39,7 +39,7 @@ lasTurret = Turret
-- this needs a major cleanup -- this needs a major cleanup
updateTurret :: Float -> Machine -> World -> World updateTurret :: Float -> Machine -> World -> World
updateTurret rotSpeed mc w updateTurret rotSpeed mc w
| _mcHP mc < 1 = w & machines %~ IM.delete mcid | _mcHP mc < 1 = w & cWorld . machines %~ IM.delete mcid
& deleteWallIDs (_mcWallIDs mc) & deleteWallIDs (_mcWallIDs mc)
& makeExplosionAt mcpos & makeExplosionAt mcpos
& copyItemToFloor mcpos lasGun & copyItemToFloor mcpos lasGun
@@ -52,12 +52,12 @@ updateTurret rotSpeed mc w
where where
deleteHomonculus = case _tuMCrID (_mcType mc) of deleteHomonculus = case _tuMCrID (_mcType mc) of
Nothing -> id Nothing -> id
Just cid -> creatures . at cid .~ Nothing Just cid -> cWorld . creatures . at cid .~ Nothing
initHomonculus w' = case w' ^? machines . ix mcid . mcType . tuMCrID . _Just of initHomonculus w' = case w' ^? cWorld . machines . ix mcid . mcType . tuMCrID . _Just of
Nothing -> w' & machines . ix mcid . mcType . tuMCrID ?~ cid Nothing -> w' & cWorld . machines . ix mcid . mcType . tuMCrID ?~ cid
& creatures . at cid ?~ thecreature & cWorld . creatures . at cid ?~ thecreature
where where
cid = IM.newKey (_creatures w') cid = IM.newKey (_creatures (_cWorld w'))
thecreature = defaultCreature thecreature = defaultCreature
& crID .~ cid & crID .~ cid
& crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10 & crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10
@@ -70,9 +70,9 @@ updateTurret rotSpeed mc w
& crStance . posture .~ Aiming & crStance . posture .~ Aiming
& crMaterial .~ Crystal & crMaterial .~ Crystal
Just cid -> w' Just cid -> w'
& creatures . ix cid . crPos .~ mcpos & cWorld . creatures . ix cid . crPos .~ mcpos
& creatures . ix cid . crDir .~ mcdir & cWorld . creatures . ix cid . crDir .~ mcdir
dodamage = machines . ix mcid %~ dodamage = cWorld . 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)
) )
@@ -83,7 +83,7 @@ updateTurret rotSpeed mc w
| _tuFireTime (_mcType mc) > 0 | _tuFireTime (_mcType mc) > 0
= fromMaybe id $ do = fromMaybe id $ do
cid <- _tuMCrID (_mcType mc) cid <- _tuMCrID (_mcType mc)
return $ creatures . ix cid . crActionPlan . apImpulse .~ [UseItem] return $ cWorld . creatures . ix cid . crActionPlan . apImpulse .~ [UseItem]
| otherwise = id | otherwise = id
mcid = _mcID mc mcid = _mcID mc
ypos = _crPos $ you w ypos = _crPos $ you w
@@ -94,12 +94,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 = machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos | seesYou = cWorld . machines . ix mcid . mcDir %~ 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 = machines . ix mcid . mcType . tuFireTime .~ 20 | closeFireAngle = cWorld . machines . ix mcid . mcType . tuFireTime .~ 20
| otherwise = machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1) | otherwise = cWorld . machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
drawTurret :: Machine -> SPic drawTurret :: Machine -> SPic
+17 -17
View File
@@ -88,21 +88,21 @@ placeSpotID ps pt gw = let (i,w) = placeSpotID' ps pt (_gwWorld 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 triggers cnd w PutTrigger cnd -> plNewID (cWorld . triggers) cnd w
PutMod mdi -> plNewUpID modifications mdID mdi w PutMod mdi -> plNewUpID (cWorld . modifications) mdID mdi w
PutProp prp -> plNewUpID props prID (mvProp p rot prp) w PutProp prp -> plNewUpID (cWorld . props) prID (mvProp p rot prp) w
PutButton bt -> plNewUpID buttons btID (mvButton p rot bt) w PutButton bt -> plNewUpID (cWorld . buttons) btID (mvButton p rot bt) w
PutTerminal tm -> plNewUpID terminals tmID tm w PutTerminal tm -> plNewUpID (cWorld . terminals) tmID tm w
PutFlIt itm -> plNewUpID floorItems flItID (createFlIt p rot itm) w PutFlIt itm -> plNewUpID (cWorld . floorItems) flItID (createFlIt p rot itm) w
PutCrit cr -> plNewUpID creatures crID (mvCr p rot cr) w PutCrit cr -> plNewUpID (cWorld . creatures) crID (mvCr p rot cr) w
PutForeground fs -> plNewUpID foregroundShapes fsID (mvFS p rot fs) w PutForeground fs -> plNewUpID (cWorld . foregroundShapes) fsID (mvFS p rot fs) w
PutDecoration pic -> plNewID decorations (shiftDec p rot pic) w PutDecoration pic -> plNewID (cWorld . 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 lightSources lsID (mvLS p' rot ls) w PutLS ls -> plNewUpID (cWorld . lightSources) lsID (mvLS p' rot ls) w
PutPPlate pp -> plNewUpID pressPlates ppID (mvPP p rot pp) w PutPPlate pp -> plNewUpID (cWorld . 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 coordinates (doShift cp) w PutCoord cp -> plNewID (cWorld . 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' -> plBlock (map doShift ps') (bl & blPos %~ doShift & blDir .~ rot) PutBlock bl wl ps' -> plBlock (map doShift ps') (bl & blPos %~ doShift & blDir .~ rot)
@@ -148,7 +148,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 = w & plNew walls wlID (wl & wlLine .~ l) addPane wl w l = w & plNew (cWorld . walls) wlID (wl & wlLine .~ l)
& fst . uncurry (obstructPathsCrossing WallObstacle) l & fst . uncurry (obstructPathsCrossing WallObstacle) l
-- where -- where
-- wlid = IM.newKey (_walls w) -- wlid = IM.newKey (_walls w)
@@ -174,14 +174,14 @@ 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 = (mcid plMachine wallpoly mc wl p rot gw = (mcid
, gw & machines %~ addMc , gw & cWorld . machines %~ addMc
& walls %~ placeMachineWalls wl col wallpoly mcid wlid & cWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
) )
where where
col = _mcColor mc col = _mcColor mc
w' = gw w' = gw
mcid = IM.newKey $ _machines w' mcid = IM.newKey $ _machines (_cWorld w')
wlid = IM.newKey $ _walls w' 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})
+8 -8
View File
@@ -23,7 +23,7 @@ plBlock
-> (Int,World) -> (Int,World)
plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon" plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon"
plBlock (p:ps) bl wl w = (,) blid $ w plBlock (p:ps) bl wl w = (,) blid $ w
& blocks . at blid ?~ bl & cWorld . blocks . at blid ?~ bl
{ _blID = blid { _blID = blid
, _blWallIDs = IS.fromList is , _blWallIDs = IS.fromList is
, _blShadows = [] , _blShadows = []
@@ -31,9 +31,9 @@ plBlock (p:ps) bl wl w = (,) blid $ w
} }
& insertWalls blid wls & insertWalls blid wls
where where
blid = IM.newKey $ _blocks w blid = IM.newKey $ _blocks (_cWorld w)
lns = zip (p:ps) (ps ++ [p]) lns = zip (p:ps) (ps ++ [p])
i = IM.newKey $ _walls w i = IM.newKey $ _walls (_cWorld w)
is = [i.. i + length lns-1] is = [i.. i + length lns-1]
wls = zipWith wls = zipWith
(\j ln -> wl & wlLine .~ ln & wlID .~ j & wlStructure .~ BlockPart blid) (\j ln -> wl & wlLine .~ ln & wlID .~ j & wlStructure .~ BlockPart blid)
@@ -62,11 +62,11 @@ plLineBlock basePane blwidth a b gw = ( 0
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 gw wlid = IM.newKey $ _walls (_cWorld gw)
blid = IM.newKey $ _blocks gw blid = IM.newKey $ _blocks (_cWorld gw)
insertBlock (i,p) = insertBlock (i,p) =
insertWalls (i + blid) (makeWallAt p i) insertWalls (i + blid) (makeWallAt p i)
. over blocks (IM.insert (i+blid) Block . over (cWorld . blocks) (IM.insert (i+blid) Block
{ _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i { _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i
, _blHP = 1000, _blShadows = shadowsAt i , _blHP = 1000, _blShadows = shadowsAt i
, _blDir = 0 -- THIS IS NOT SENSIBLE. TODO rethink block positioning , _blDir = 0 -- THIS IS NOT SENSIBLE. TODO rethink block positioning
@@ -96,10 +96,10 @@ plLineBlock basePane blwidth a b gw = ( 0
-- | 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' & blocks . ix blid . blObstructs .~ concat paths insertWalls blid wls w = w' & cWorld . blocks . ix blid . blObstructs .~ concat paths
where where
(w',paths) = mapAccumR (flip insertWall) w wls (w',paths) = mapAccumR (flip insertWall) w wls
insertWall :: Wall -> World -> (World,[(Int,Int,PathEdge)]) insertWall :: Wall -> World -> (World,[(Int,Int,PathEdge)])
insertWall wl = uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl) insertWall wl = uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl)
. (walls . at (_wlID wl) ?~ wl) . (cWorld . walls . at (_wlID wl) ?~ wl)
+10 -10
View File
@@ -27,9 +27,9 @@ plDoor :: Color
-- Bumped out up and down by 9, not widened -- Bumped out up and down by 9, not widened
-> World -> World
-> (Int,World) -> (Int,World)
plDoor col eo cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull with the ordering of addWalls plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
where where
drid = IM.newKey $ _doors gw drid = IM.newKey $ _doors (_cWorld gw)
addDoor = IM.insert drid $ defaultDoor addDoor = IM.insert drid $ defaultDoor
{ _drID = drid { _drID = drid
, _drWallIDs = IS.fromList wlids , _drWallIDs = IS.fromList wlids
@@ -42,18 +42,18 @@ plDoor col eo cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull
, _drObstacleType = eo , _drObstacleType = eo
} }
nsteps = length pss - 1 nsteps = length pss - 1
wlids = take 4 [IM.newKey $ _walls gw ..] wlids = take 4 [IM.newKey $ _walls (_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) = w' addDoorWall eo drid wl w (wlid,wlps) = w'
& walls %~ IM.insert wlid wl & cWorld . walls %~ IM.insert wlid wl
{ _wlLine = wlps { _wlLine = wlps
, _wlID = wlid , _wlID = wlid
, _wlStructure = DoorPart drid , _wlStructure = DoorPart drid
} }
& doors . ix drid . drObstructs .++~ es & cWorld . doors . ix drid . drObstructs .++~ es
where where
(w',es) = uncurry (obstructPathsCrossing eo) wlps w (w',es) = uncurry (obstructPathsCrossing eo) wlps w
@@ -63,9 +63,9 @@ maybeClearDoorPaths eo es w = foldl' (maybeClearDoorPath eo) w es
maybeClearDoorPath :: EdgeObstacle -> World -> (Int,Int,PathEdge) -> World maybeClearDoorPath :: EdgeObstacle -> World -> (Int,Int,PathEdge) -> World
maybeClearDoorPath eo w (x,y,pe) maybeClearDoorPath eo w (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 & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x,y) = w & cWorld . pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x,y)
| otherwise | otherwise
= w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x,y) = w & cWorld . pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x,y)
plSlideDoor plSlideDoor
:: Door :: Door
@@ -77,9 +77,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 & doors %~ addDoor) = (drid, addDoorWalls $ gw & cWorld . doors %~ addDoor)
where where
drid = IM.newKey $ _doors gw drid = IM.newKey $ _doors (_cWorld gw)
addDoor = IM.insert drid $ dr addDoor = IM.insert drid $ dr
{ _drID = drid { _drID = drid
, _drWallIDs = IS.fromList wlids , _drWallIDs = IS.fromList wlids
@@ -93,7 +93,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 gw ..] wlids = take 4 [IM.newKey $ _walls (_cWorld gw) ..]
-- old code that may help with pathing -- old code that may help with pathing
--import Dodge.LevelGen.Pathing --import Dodge.LevelGen.Pathing
--import Data.Graph.Inductive hiding ((&)) --import Data.Graph.Inductive hiding ((&))
+2 -2
View File
@@ -22,7 +22,7 @@ fireShell it cr = makeShell it cr
spinamount = _shellSpinAmount params spinamount = _shellSpinAmount params
thrustdelay = _shellThrustDelay params thrustdelay = _shellThrustDelay params
makeShell :: Item -> Creature -> [ProjectileUpdate] -> World -> World makeShell :: Item -> Creature -> [ProjectileUpdate] -> World -> World
makeShell it cr theupdate w = w & projectiles %~ IM.insert i Shell makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell
{ _prjPos = pos { _prjPos = pos
, _prjZ = 20 , _prjZ = 20
, _prjStartPos = pos , _prjStartPos = pos
@@ -38,7 +38,7 @@ makeShell it cr theupdate w = w & projectiles %~ IM.insert i Shell
, _prjMITID = _itID it , _prjMITID = _itID it
} }
where where
i = IM.newKey $ _props w i = IM.newKey $ _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 = _itConsumption it am = _itConsumption it
+19 -19
View File
@@ -46,7 +46,7 @@ updateRemoteShell pj w
doExplode = w doExplode = w
& usePayload (_prjPayload pj) oldPos & usePayload (_prjPayload pj) oldPos
& stopSoundFrom (ShellSound i) & stopSoundFrom (ShellSound i)
& projectiles %~ IM.delete i & cWorld . projectiles %~ IM.delete i
i = _prjID pj i = _prjID pj
oldPos = _prjPos pj oldPos = _prjPos pj
vel = _prjVel pj vel = _prjVel pj
@@ -58,15 +58,15 @@ explodeRemoteRocket'
-> World -> World
-> World -> World
explodeRemoteRocket' mitid thepj w = w explodeRemoteRocket' mitid thepj w = w
& projectiles . ix pjid . prjDraw .~ DrawBlankProjectile & cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
& usePayload (_prjPayload thepj) (_prjPos thepj) & usePayload (_prjPayload thepj) (_prjPos thepj)
& updateitem & updateitem
where where
updateitem = fromMaybe (projectiles . at pjid .~ Nothing) $ do updateitem = fromMaybe (cWorld . projectiles . at pjid .~ Nothing) $ do
itid <- mitid itid <- mitid
itpos <- w ^? itemPositions . ix itid itpos <- w ^? cWorld . itemPositions . ix itid
return $ (pointToItem itpos . itUse . rUse .~ HeldDoNothing) return $ (pointToItem itpos . itUse . rUse .~ HeldDoNothing)
. (projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid]) . (cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid])
pjid = _prjID thepj pjid = _prjID thepj
updateShell :: Proj -> World -> World updateShell :: Proj -> World -> World
@@ -82,7 +82,7 @@ updateShell pj w
doExplode = w doExplode = w
& usePayload (_prjPayload pj) oldPos & usePayload (_prjPayload pj) oldPos
& stopSoundFrom (ShellSound i) & stopSoundFrom (ShellSound i)
& projectiles %~ IM.delete i & cWorld . projectiles %~ IM.delete i
i = _prjID pj i = _prjID pj
oldPos = _prjPos pj oldPos = _prjPos pj
vel = _prjVel pj vel = _prjVel pj
@@ -108,7 +108,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 -> projectiles . ix pjid . prjUpdates . ix 0 . pjuTimer -~ 1 PJRetireRemote _ _ pjid -> cWorld . 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
@@ -116,26 +116,26 @@ upProjectile pu pj = case pu of
retireRemoteProj'' :: Int -> Int -> World -> World retireRemoteProj'' :: Int -> Int -> World -> World
retireRemoteProj'' itid pjid w = w retireRemoteProj'' itid pjid w = w
& pointToItem (_itemPositions w IM.! itid) %~ & pointToItem (_itemPositions (_cWorld w) IM.! itid) %~
( (itScope . scopePos .~ V2 0 0) ( (itScope . scopePos .~ V2 0 0)
. (itUse . rUse .~ HeldFireRemoteShell) . (itUse . rUse .~ HeldFireRemoteShell)
) )
& props %~ IM.delete pjid & cWorld . props %~ IM.delete pjid
setRemoteDir :: Int -> Int -> Proj -> World -> World setRemoteDir :: Int -> Int -> Proj -> World -> World
setRemoteDir cid itid pj w = w & projectiles . ix i . prjDir .~ newdir setRemoteDir cid itid pj w = w & cWorld . projectiles . ix i . prjDir .~ newdir
where where
i = _prjID pj i = _prjID pj
newdir newdir
| SDL.ButtonRight `M.member` _mouseButtons w | SDL.ButtonRight `M.member` _mouseButtons (_cWorld w)
&& w ^? creatures . ix cid . crInvSel . iselPos == w ^? itemPositions . ix itid . ipInvID && w ^? cWorld . creatures . ix cid . crInvSel . iselPos == w ^? cWorld . itemPositions . ix itid . ipInvID
= _cameraRot w + argV (_mousePos w) = _cameraRot (_cWorld w) + argV (_mousePos (_cWorld w))
| otherwise = _prjDir pj | otherwise = _prjDir pj
doThrust' :: Proj -> World -> World doThrust' :: Proj -> World -> World
doThrust' pj w = w doThrust' pj w = w
& randGen .~ g & randGen .~ g
& projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v) & cWorld . 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)))
@@ -155,11 +155,11 @@ trySpinByCID'
-> Proj -> Proj
-> World -> World
-> World -> World
trySpinByCID' cid i pj w = w & projectiles . ix pjid . prjSpin .~ newSpin trySpinByCID' cid i pj w = w & cWorld . projectiles . ix pjid . prjSpin .~ newSpin
where where
pjid = _prjID pj pjid = _prjID pj
dir = argV $ _prjVel pj dir = argV $ _prjVel pj
newSpin = case w ^? creatures . ix cid of newSpin = case w ^? cWorld . 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)
@@ -169,9 +169,9 @@ pjTrack' itid pj w = rotateToTarget pj w
where where
rotateToTarget _ = fromMaybe id $ do rotateToTarget _ = fromMaybe id $ do
tpos <- w ^? itPoint . itTargeting . tgPos . _Just tpos <- w ^? itPoint . itTargeting . tgPos . _Just
return $ projectiles . ix (_prjID pj) . prjSpin .~ turnToAmount 0.15 (_prjPos pj) tpos return $ cWorld . projectiles . ix (_prjID pj) . prjSpin .~ turnToAmount 0.15 (_prjPos pj) tpos
(argV $ _prjAcc pj) (argV $ _prjAcc pj)
itPoint = pointToItem $ _itemPositions w IM.! itid itPoint = pointToItem $ _itemPositions (_cWorld w) IM.! itid
reduceSpinBy' :: Float -> Proj -> World -> World reduceSpinBy' :: Float -> Proj -> World -> World
reduceSpinBy' x pj = projectiles . ix (_prjID pj) . prjSpin *~ x reduceSpinBy' x pj = cWorld . projectiles . ix (_prjID pj) . prjSpin *~ x
+3 -3
View File
@@ -68,7 +68,7 @@ addGibsAtDir dir minh maxh col p w = foldl' (flip $ addGib4 p col) w (zip4 vels
addGib4 :: Point2 -> Color -> (Point2, Float, Q.Quaternion Float, Float) addGib4 :: Point2 -> Color -> (Point2, Float, Q.Quaternion Float, Float)
-> World -> World -> World -> World
addGib4 p col (v,zs,q,h) = plNew props prID (aGib & prPos .~ p +.+ (5 *.* normalizeV v) addGib4 p col (v,zs,q,h) = plNew (cWorld . props) prID (aGib & prPos .~ p +.+ (5 *.* normalizeV v)
& prColor .~ col & prColor .~ col
& prVel .~ v & prVel .~ v
& prQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1) & prQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
@@ -79,7 +79,7 @@ addGib4 p col (v,zs,q,h) = plNew props prID (aGib & prPos .~ p +.+ (5 *.* normal
addGibAt :: Float -> Color -> Point2 -> World -> World addGibAt :: Float -> Color -> Point2 -> World -> World
addGibAt h col p w = w addGibAt h col p w = w
& plNew props prID gib & plNew (cWorld . props) prID gib
& randGen .~ newg & randGen .~ newg
where where
(gib,newg) = runState f $ _randGen w (gib,newg) = runState f $ _randGen w
@@ -100,7 +100,7 @@ addGibAt h col p w = w
addGibAtDir :: Float -> Float -> Color -> Point2 -> World -> World addGibAtDir :: Float -> Float -> Color -> Point2 -> World -> World
addGibAtDir dir h col p w = w addGibAtDir dir h col p w = w
& plNew props prID gib & plNew (cWorld . props) prID gib
& randGen .~ newg & randGen .~ newg
where where
(gib,newg) = runState f $ _randGen w (gib,newg) = runState f $ _randGen w
+3 -3
View File
@@ -9,12 +9,12 @@ import LensHelp
fallSmallBounceDamage :: Prop -> World -> World fallSmallBounceDamage :: Prop -> World -> World
fallSmallBounceDamage pr w = w fallSmallBounceDamage pr w = w
& dodamage & dodamage
& props . ix (_prID pr) %~ fallSmallBounce' w & cWorld . 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 = creatures %~ fmap dodamage' | _prPosZ pr < 25 = cWorld . creatures %~ fmap dodamage'
| otherwise = id | otherwise = id
dodamage' cr dodamage' cr
| dist (_crPos cr) p < _crRad cr + 5 = cr & crState . csDamage | dist (_crPos cr) p < _crRad cr + 5 = cr & crState . csDamage
@@ -23,7 +23,7 @@ fallSmallBounceDamage pr w = w
fallSmallBounce :: Prop -> World -> World fallSmallBounce :: Prop -> World -> World
fallSmallBounce pr w = w fallSmallBounce pr w = w
& props . ix (_prID pr) %~ fallSmallBounce' w & cWorld . props . ix (_prID pr) %~ fallSmallBounce' w
fallSmallBounce' :: World -> Prop -> Prop fallSmallBounce' :: World -> Prop -> Prop
fallSmallBounce' w pr fallSmallBounce' w pr
+5 -5
View File
@@ -17,7 +17,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 & lightSources . ix lsid %~ doPrWdLsLs x pr w PropUpdateLS lsid x -> \w -> w & cWorld . 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]
@@ -32,8 +32,8 @@ propUpdateIf wb x y pr w
propUpdatePosition :: WdP2f -> Prop -> World -> World propUpdatePosition :: WdP2f -> Prop -> World -> World
propUpdatePosition x pr w = w propUpdatePosition x pr w = w
& props . ix (_prID pr) . prPos .~ fst (doWdP2f x w) & cWorld . props . ix (_prID pr) . prPos .~ fst (doWdP2f x w)
& props . ix (_prID pr) . prRot .~ snd (doWdP2f x w) & cWorld . 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
@@ -45,9 +45,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 & props . ix (_prID pr) . prToggle .~ cond w setToggle cond pr w = w & cWorld . props . ix (_prID pr) . prToggle .~ cond w
rotateProp :: Float -> Prop -> World -> World rotateProp :: Float -> Prop -> World -> World
rotateProp rotAmount pr w = w rotateProp rotAmount pr w = w
& props . ix (_prID pr) . prRot +~ rotAmount & cWorld . props . ix (_prID pr) . prRot +~ rotAmount
+4 -4
View File
@@ -9,7 +9,7 @@ import Data.Maybe
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
aRadarPulse :: Object -> Creature -> World -> World aRadarPulse :: Object -> Creature -> World -> World
aRadarPulse ob cr = radarSweeps .:~ RadarSweep aRadarPulse ob cr = cWorld . radarSweeps .:~ RadarSweep
{ _rsTimer = 100 { _rsTimer = 100
, _rsRad = 0 , _rsRad = 0
, _rsPos = _crPos cr , _rsPos = _crPos cr
@@ -29,7 +29,7 @@ updateRadarSweep w pt
blipsF = findBlips ob blipsF = findBlips ob
bf = makeBlip ob bf = makeBlip ob
x = _rsTimer pt x = _rsTimer pt
putBlips = radarBlips .++~ blips putBlips = cWorld . 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)
@@ -58,13 +58,13 @@ blipAt r col i p = RadarBlip
} }
crBlips :: Point2 -> Float -> World -> [Point2] crBlips :: Point2 -> Float -> World -> [Point2]
crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures . _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 itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems . _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
+3 -3
View File
@@ -37,12 +37,12 @@ tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itConsumption . laProg
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 & creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction ReloadAction {} -> w & cWorld . creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction
_ -> w & creatures . ix (_crID cr) %~ tryStartLoading _ -> w & cWorld . creatures . ix (_crID cr) %~ tryStartLoading
crHoldReloading :: Creature -> World -> World crHoldReloading :: Creature -> World -> World
crHoldReloading cr w = w crHoldReloading cr w = w
& creatures . ix (_crID cr) . crInvSel . iselAction . actionHammer .~ HasHammer HammerDown & cWorld . 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
View File
@@ -34,14 +34,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 = _cameraRot w rot = _cameraRot (_cWorld w)
camzoom = _cameraZoom w camzoom = _cameraZoom (_cWorld w)
trans = _cameraCenter w trans = _cameraCenter (_cWorld w)
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) = _cameraViewFrom w viewFroms@(V2 vfx vfy) = _cameraViewFrom (_cWorld w)
viewFrom3d = Vector3 vfx vfy 20 viewFrom3d = Vector3 vfx vfy 20
shadV = _pictureShaders pdata shadV = _pictureShaders pdata
lwShad = _lightingWallShadShader pdata lwShad = _lightingWallShadShader pdata
@@ -64,7 +64,7 @@ doDrawing pdata u = do
(shadVBOptr $ _textureArrayShader pdata) (shadVBOptr $ _textureArrayShader pdata)
wallPointsCol wallPointsCol
windowPoints windowPoints
(_floorTiles w) (_floorTiles (_cWorld w))
) )
( pokeShape' ( pokeShape'
(_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata) (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
@@ -248,7 +248,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 w of case _distortions (_cWorld w) of
[] -> do [] -> do
bindTO $ fst $ snd $ _fboBase pdata bindTO $ fst $ snd $ _fboBase pdata
bindFramebuffer Framebuffer $= defaultFramebufferObject bindFramebuffer Framebuffer $= defaultFramebufferObject
+14 -14
View File
@@ -34,7 +34,7 @@ import qualified Data.Text as T
--import Data.Bifunctor --import Data.Bifunctor
hudDrawings :: Universe -> Picture hudDrawings :: Universe -> Picture
hudDrawings uv = case _hudElement $ _hud w of hudDrawings uv = case _hudElement $ _hud (_cWorld w) of
DisplayCarte -> drawCarte cfig w DisplayCarte -> drawCarte cfig w
DisplayInventory subinv -> drawInGameHUD uv DisplayInventory subinv -> drawInGameHUD uv
<> subInventoryDisplay subinv cfig w <> subInventoryDisplay subinv cfig w
@@ -59,7 +59,7 @@ inventoryDisplay cfig w = listPicturesAt 0 0 cfig invlist
inv = _crInv cr inv = _crInv cr
invlist = concatMap (itemText' cr) (IM.toList inv) invlist = concatMap (itemText' cr) (IM.toList inv)
++ displayFreeSlots ++ displayFreeSlots
++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w) ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects (_cWorld w))
-- ++ 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
@@ -131,7 +131,7 @@ subInventoryDisplay subinv cfig w = case subinv of
selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it
selcursor = selcursor' selcursortype selcursor = selcursor' selcursortype
selcursortype selcursortype
| ButtonRight `M.member` _mouseButtons w = listCursorNESW | ButtonRight `M.member` _mouseButtons (_cWorld w) = listCursorNESW
| otherwise = listCursorNSW | otherwise = listCursorNSW
curpos = invSelPos w curpos = invSelPos w
cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w) cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w)
@@ -140,8 +140,8 @@ subInventoryDisplay subinv cfig w = case subinv of
_ -> mempty _ -> mempty
equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr) equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
rboptions = if ButtonRight `M.member` _mouseButtons w rboptions = if ButtonRight `M.member` _mouseButtons (_cWorld w)
then drawRBOptions cfig w (_rbOptions w) then drawRBOptions cfig w (_rbOptions (_cWorld w))
else mempty else mempty
itmInfo :: Maybe Item -> [String] itmInfo :: Maybe Item -> [String]
@@ -151,7 +151,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 ^? terminals . ix tid tm <- w ^? cWorld . terminals . ix tid
return $ pictures return $ pictures
[ invHead cfig (_tmTitle tm ++ ":T" ++ show tid) [ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
, renderListAt subInvX 60 cfig , renderListAt subInvX 60 cfig
@@ -187,7 +187,7 @@ drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=a
where where
midtext str = listTextPictureAt 252 0 cfig curpos (text str) midtext str = listTextPictureAt 252 0 cfig curpos (text str)
extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext)) extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of deactivatetext = case w ^? cWorld . rbOptions . opActivateEquipment . deactivateEquipment of
Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k)) Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
Nothing -> "" Nothing -> ""
curpos = invSelPos w curpos = invSelPos w
@@ -255,9 +255,9 @@ topCursorTypeWidth ctype width cfig w i
= ctype 0 0 cfig (selNumPos i w) (selNumCol i w) width (selNumSlots i w) = ctype 0 0 cfig (selNumPos i w) (selNumCol i w) width (selNumSlots i w)
determineInvSelCursorWidth :: World -> Int determineInvSelCursorWidth :: World -> Int
determineInvSelCursorWidth w = case _rbOptions w of determineInvSelCursorWidth w = case _rbOptions (_cWorld w) of
NoRightButtonOptions -> topInvW NoRightButtonOptions -> topInvW
EquipOptions {} -> if ButtonRight `M.member` _mouseButtons w EquipOptions {} -> if ButtonRight `M.member` _mouseButtons (_cWorld w)
then 47 then 47
else topInvW else topInvW
@@ -309,9 +309,9 @@ drawCarte cfig w = pictures $
++ mapOverlay cfig w ++ mapOverlay cfig w
++ [mainListCursor white iPos cfig] ++ [mainListCursor white iPos cfig]
where where
iPos = _selLocation w iPos = _selLocation (_cWorld w)
locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ (_cWorld w)
locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations $ w locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations $ (_cWorld w)
locTexts = map fst locs locTexts = map fst locs
displayListEndCoords :: Configuration -> [String] -> [Point2] displayListEndCoords :: Configuration -> [String] -> [Point2]
@@ -325,7 +325,7 @@ displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [
mapOverlay :: Configuration -> World -> [Picture] mapOverlay :: Configuration -> World -> [Picture]
mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) : mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
(mapMaybe (mapWall cfig w) . IM.elems $ _walls w) (mapMaybe (mapWall cfig w) . IM.elems $ _walls (_cWorld w))
mapWall :: Configuration -> World -> Wall -> Maybe Picture mapWall :: Configuration -> World -> Wall -> Maybe Picture
mapWall cfig w wl = mapWall cfig w wl =
@@ -419,4 +419,4 @@ displayHP cid cfig w = translate (halfWidth cfig-80) (halfHeight cfig-20)
. leftPad 5 ' ' . leftPad 5 ' '
. show . show
. _crHP . _crHP
$ _creatures w IM.! cid $ _creatures (_cWorld w) IM.! cid
+4 -4
View File
@@ -9,13 +9,13 @@ import Data.Maybe
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
lightsToRender :: Configuration -> World -> [(Point3,Float,Point3)] lightsToRender :: Configuration -> World -> [(Point3,Float,Point3)]
lightsToRender cfig w = mapMaybe getLS (IM.elems $ _lightSources w) lightsToRender cfig w = mapMaybe getLS (IM.elems $ _lightSources (_cWorld w))
++ mapMaybe getTLS (_tempLightSources w) ++ mapMaybe getTLS (_tempLightSources (_cWorld w))
where where
getLS = getlsparam . _lsParam getLS = getlsparam . _lsParam
getTLS = getlsparam . _tlsParam getTLS = getlsparam . _tlsParam
cbox = _boundBox w cbox = _boundBox (_cWorld w)
cpos = _cameraCenter w cpos = _cameraCenter (_cWorld w)
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)
+1 -1
View File
@@ -23,6 +23,6 @@ fixedCoordPictures u = case _menuLayers u of
customMouseCursor :: Configuration -> World -> Picture customMouseCursor :: Configuration -> World -> Picture
customMouseCursor cfig w = winScale cfig customMouseCursor cfig w = winScale cfig
. uncurryV translate (_mousePos w) . uncurryV translate (_mousePos (_cWorld w))
. color white . color white
$ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ] $ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ]
+44 -44
View File
@@ -78,7 +78,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 w) filtOn f g = IM.filter (pointIsClose . f) (g (_cWorld w))
pointIsClose = cullPoint cfig w pointIsClose = cullPoint cfig w
anyTargeting :: Configuration -> World -> SPic anyTargeting :: Configuration -> World -> SPic
@@ -128,30 +128,30 @@ shiftDraw' fpos fdir fdraw x = uncurryV translateSPf (fpos 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 (_boundBox w) | debugOn Close_shape_culling cfig = pointInPolygon p (_boundBox (_cWorld w))
| otherwise = dist (_cameraCenter w) p < _viewDistance w | otherwise = dist (_cameraCenter (_cWorld w)) p < _viewDistance (_cWorld w)
extraPics :: Configuration -> World -> Picture extraPics :: Configuration -> World -> Picture
extraPics cfig w = pictures (_decorations w) extraPics cfig w = pictures (_decorations (_cWorld w))
<> concatMapPic drawTractorBeam (_tractorBeams w) <> concatMapPic drawTractorBeam (_tractorBeams (_cWorld w))
<> concatMapPic drawLinearShockwave (_linearShockwaves w) <> concatMapPic drawLinearShockwave (_linearShockwaves (_cWorld w))
<> concatMapPic drawShockwave (_shockwaves w) <> concatMapPic drawShockwave (_shockwaves (_cWorld w))
<> concatMapPic drawLaser (_lasersToDraw w) <> concatMapPic drawLaser (_lasersToDraw (_cWorld w))
<> concatMapPic drawTeslaArc (_teslaArcs w) <> concatMapPic drawTeslaArc (_teslaArcs (_cWorld w))
-- <> concatMapPic drawParticle (_particles w) -- <> concatMapPic drawParticle (_particles w)
<> concatMapPic drawRadarSweep (_radarSweeps w) <> concatMapPic drawRadarSweep (_radarSweeps (_cWorld w))
<> concatMapPic drawFlame (_flames w) <> concatMapPic drawFlame (_flames (_cWorld w))
<> concatMapPic drawEnergyBall (_energyBalls w) <> concatMapPic drawEnergyBall (_energyBalls (_cWorld w))
<> concatMapPic drawSpark (_sparks w) <> concatMapPic drawSpark (_sparks (_cWorld w))
<> concatMapPic drawBul (_bullets w) <> concatMapPic drawBul (_bullets (_cWorld w))
<> concatMapPic drawBlip (_radarBlips w) <> concatMapPic drawBlip (_radarBlips (_cWorld w))
<> concatMapPic drawFlare (_flares w) <> concatMapPic drawFlare (_flares (_cWorld w))
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams w) <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams (_cWorld w))
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams w) <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams (_cWorld w))
<> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources w) <> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources (_cWorld w))
<> testPic cfig w <> testPic cfig w
<> concatMapPic clDraw (_clouds w ) <> concatMapPic clDraw (_clouds (_cWorld w) )
<> concatMapPic ppDraw (_pressPlates w ) <> concatMapPic ppDraw (_pressPlates (_cWorld w) )
<> viewClipBounds cfig w <> viewClipBounds cfig w
<> debugDraw cfig w <> debugDraw cfig w
@@ -196,7 +196,7 @@ debugDraw' cfig w bl = case bl of
rdraw pic = (mempty,pic) rdraw pic = (mempty,pic)
drawCreatureDisplayTexts :: World -> Picture drawCreatureDisplayTexts :: World -> Picture
drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures w) drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures (_cWorld w))
drawPathBetween :: World -> Picture drawPathBetween :: World -> Picture
drawPathBetween w = setLayer DebugLayer drawPathBetween w = setLayer DebugLayer
@@ -207,22 +207,22 @@ drawPathBetween w = setLayer DebugLayer
where where
nodepos = (`getNodePos` w) nodepos = (`getNodePos` w)
nodelist = makePathBetween sp ep w nodelist = makePathBetween sp ep w
sp = _lSelect w sp = _lSelect (_cWorld w)
ep = _rSelect w ep = _rSelect (_cWorld w)
drawNodesNearSelect :: World -> Picture drawNodesNearSelect :: World -> Picture
drawNodesNearSelect w = setLayer DebugLayer drawNodesNearSelect w = setLayer DebugLayer
$ runIdentity (S.foldMap_ (drawZoneCol orange pnZoneSize) (zoneAroundPoint pnZoneSize sp)) $ runIdentity (S.foldMap_ (drawZoneCol orange pnZoneSize) (zoneAroundPoint pnZoneSize sp))
<> color green (drawCross sp) <> color green (drawCross sp)
where where
sp = _lSelect w sp = _lSelect (_cWorld w)
drawInspectWalls :: World -> Picture drawInspectWalls :: World -> Picture
drawInspectWalls w = foldMap (drawInspectWall w) drawInspectWalls w = foldMap (drawInspectWall w)
$ filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) $ filter (isJust . uncurry (intersectSegSeg a b) . _wlLine)
$ IM.elems $ _walls w $ IM.elems $ _walls (_cWorld w)
where where
(a,b) = _lLine w (a,b) = _lLine (_cWorld w)
drawInspectWall :: World -> Wall -> Picture drawInspectWall :: World -> Wall -> Picture
drawInspectWall w wl = setLayer DebugLayer drawInspectWall w wl = setLayer DebugLayer
@@ -233,7 +233,7 @@ drawInspectWall w wl = setLayer DebugLayer
drawDoorPaths :: World -> Int -> Picture drawDoorPaths :: World -> Int -> Picture
drawDoorPaths w drid = fromMaybe mempty $ do drawDoorPaths w drid = fromMaybe mempty $ do
paths <- w ^? doors . ix drid . drObstructs paths <- w ^? cWorld . doors . ix drid . drObstructs
return $ foldMap (drawPathEdge . (^. _3)) paths return $ foldMap (drawPathEdge . (^. _3)) paths
drawPathEdge :: PathEdge -> Picture drawPathEdge :: PathEdge -> Picture
@@ -252,8 +252,8 @@ drawWorldSelect w = setLayer DebugLayer
$ color cyan (line [a,b]) $ color cyan (line [a,b])
<> color magenta (line [c,d]) <> color magenta (line [c,d])
where where
(a,b) = _lLine w (a,b) = _lLine (_cWorld w)
(c,d) = _rLine w (c,d) = _rLine (_cWorld w)
drawFarWallDetect :: World -> Picture drawFarWallDetect :: World -> Picture
drawFarWallDetect w = setLayer DebugLayer drawFarWallDetect w = setLayer DebugLayer
@@ -264,7 +264,7 @@ drawFarWallDetect w = setLayer DebugLayer
] ) ] )
$ runIdentity $ S.toList_ $ streamViewpoints p w $ runIdentity $ S.toList_ $ streamViewpoints p w
where where
p = _cameraViewFrom w p = _cameraViewFrom (_cWorld w)
drawDDATest :: World -> Picture drawDDATest :: World -> Picture
drawDDATest w = runIdentity (S.foldMap_ (drawZoneCol orange 50) ps) drawDDATest w = runIdentity (S.foldMap_ (drawZoneCol orange 50) ps)
@@ -273,12 +273,12 @@ drawDDATest w = runIdentity (S.foldMap_ (drawZoneCol orange 50) ps)
<> 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 = _cameraViewFrom w cvf = _cameraViewFrom (_cWorld w)
mwp = mouseWorldPos w mwp = mouseWorldPos w
ps = ddaStreamX 50 cvf mwp ps = ddaStreamX 50 cvf mwp
ps' = ddaStreamY 50 (_cameraViewFrom w) (mouseWorldPos w) ps' = ddaStreamY 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
qs = xIntercepts 50 (_cameraViewFrom w) (mouseWorldPos w) qs = xIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
qs' = yIntercepts 50 (_cameraViewFrom w) (mouseWorldPos w) qs' = yIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
drawCross :: Point2 -> Picture drawCross :: Point2 -> Picture
drawCross p = setLayer DebugLayer . color red . uncurryV translate p $ crossPic 5 drawCross p = setLayer DebugLayer . color red . uncurryV translate p $ crossPic 5
@@ -299,7 +299,7 @@ drawWallSearchRays :: World -> Picture
drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
where where
f p = setLayer DebugLayer $ color yellow $ uncurryV translate p (circle 5) f p = setLayer DebugLayer $ color yellow $ uncurryV translate p (circle 5)
<> line [_cameraViewFrom w, p] <> line [_cameraViewFrom (_cWorld w), p]
testPic :: Configuration -> World -> Picture testPic :: Configuration -> World -> Picture
testPic _ _ = mempty testPic _ _ = mempty
@@ -307,7 +307,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) = _boundBox w (x:xs) = _boundBox (_cWorld w)
clDraw :: Cloud -> Picture clDraw :: Cloud -> Picture
clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c) clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c)
@@ -329,7 +329,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
where where
p = _soundPos s p = _soundPos s
thePic thePic
= rotate (_cameraRot w) = rotate (_cameraRot (_cWorld w))
. scale theScale theScale . scale theScale theScale
. centerText . centerText
. soundToOnomato . soundToOnomato
@@ -348,7 +348,7 @@ drawMousePosition cfig w = setLayer FixedCoordLayer . winScale cfig
mwp = mouseWorldPos w mwp = mouseWorldPos w
drawWlIDs :: Configuration -> World -> Picture drawWlIDs :: Configuration -> World -> Picture
drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (_walls w) drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (_walls (_cWorld w))
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"
@@ -374,7 +374,7 @@ drawPathing cfig w = setLayer DebugLayer
<> 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 w gr = _pathGraph (_cWorld w)
crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2,[String]) crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2,[String])
crDisplayInfo cfig w cr crDisplayInfo cfig w cr
@@ -401,7 +401,7 @@ fpreShow str = fmap (((rightPad 7 '.'str ++ "...") ++) . show)
drawCrInfo :: Configuration -> World -> Picture drawCrInfo :: Configuration -> World -> Picture
drawCrInfo cfig w = setLayer FixedCoordLayer drawCrInfo cfig w = setLayer FixedCoordLayer
$ renderInfoListsAt (2*hw - 400) 0 cfig w $ renderInfoListsAt (2*hw - 400) 0 cfig w
$ mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures w $ mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures (_cWorld w)
where where
hw = halfWidth cfig hw = halfWidth cfig
@@ -410,14 +410,14 @@ viewBoundaries w = setLayer DebugLayer $ color green (foldMap (polygonWire . _gr
<> color yellow (foldMap (\q -> line [p,q]) $ farWallPoints p w) <> color yellow (foldMap (\q -> line [p,q]) $ farWallPoints p w)
where where
p = _crPos $ you w p = _crPos $ you w
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w) grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms (_cWorld w))
viewClipBounds :: Configuration -> World -> Picture viewClipBounds :: Configuration -> World -> Picture
viewClipBounds cfig w viewClipBounds cfig w
| _debug_view_clip_bounds cfig == AllRoomClipBoundaries | _debug_view_clip_bounds cfig == AllRoomClipBoundaries
= setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_roomClipping w) = setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_roomClipping (_cWorld w))
| _debug_view_clip_bounds cfig == IntersectingRoomClipBoundaries | _debug_view_clip_bounds cfig == IntersectingRoomClipBoundaries
= setLayer DebugLayer $ f (_roomClipping w) = setLayer DebugLayer $ f (_roomClipping (_cWorld w))
| otherwise = mempty | otherwise = mempty
where where
f (x:xs) = g x xs <> f xs f (x:xs) = g x xs <> f xs
+1 -1
View File
@@ -23,7 +23,7 @@ wallsToDraw w
<$> L.prefilter wlOpaqueDraw (L.premap f L.list) <$> L.prefilter wlOpaqueDraw (L.premap f L.list)
<*> 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 ^. wlZoning) $ zoneOfSight' wlZoneSize w) ) (wlsFromIXs w $ zonesExtract (w ^. cWorld . wlZoning) $ zoneOfSight' wlZoneSize w)
--wallsToDraw --wallsToDraw
-- :: World -- :: World
-- -> ( [((Point2,Point2),Point4)] ,[((Point2,Point2),Point4)], SPic ) -- -> ( [((Point2,Point2),Point4)] ,[((Point2,Point2),Point4)], SPic )
+1 -1
View File
@@ -105,7 +105,7 @@ addButtonSlowDoor x h rm = do
(V3 15 xoff 89) (aShape (V2 15 0) (V3 15 xoff 90)) (V3 15 xoff 89) (aShape (V2 15 0) (V3 15 xoff 90))
$ \plls plpr -> Just $ ptCont (PutWorldUpdate (const $ setmount dr plls plpr)) $ \plls plpr -> Just $ ptCont (PutWorldUpdate (const $ setmount dr plls plpr))
$ const mpl $ const mpl
setmount pldr plls plpr = doors . ix (fromJust $ _plMID pldr) . drMounts .++~ setmount pldr plls plpr = cWorld . 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
+1 -1
View File
@@ -28,7 +28,7 @@ doQuicksave :: Universe -> Universe
doQuicksave = saveWorldInSlot QuicksaveSlot doQuicksave = saveWorldInSlot QuicksaveSlot
clearKeys :: World -> World clearKeys :: World -> World
clearKeys = (keys .~ mempty) . (mouseButtons .~ mempty) clearKeys = (cWorld . keys .~ mempty) . (cWorld . mouseButtons .~ mempty)
saveLevelStartSlot :: Universe -> Universe saveLevelStartSlot :: Universe -> Universe
--saveLevelStartSlot = id --saveLevelStartSlot = id
+2 -2
View File
@@ -28,7 +28,7 @@ moveShockwave w sw
t = _swTimer sw t = _swTimer 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' = over creatures (IM.map damCr) doDams w' = over (cWorld . 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'
@@ -56,7 +56,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 creatures (IM.map damCr) -- . flip (foldr (damageBlocksBy 1)) hitBlocks dams = over (cWorld . 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
+2 -2
View File
@@ -146,9 +146,9 @@ soundAngle p w
. radToDeg . radToDeg
. normalizeAngle . normalizeAngle
. (+ pi) . (+ pi)
$ argV (vNormal (p -.- earPos)) - _cameraRot w $ argV (vNormal (p -.- earPos)) - _cameraRot (_cWorld w)
where where
earPos = _cameraViewFrom w earPos = _cameraViewFrom (_cWorld w)
{-| 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. -}

Some files were not shown because too many files have changed in this diff Show More