This commit is contained in:
2022-07-16 18:07:43 +01:00
parent 11732358ed
commit 22adcb89e0
7 changed files with 31 additions and 34 deletions
+7 -7
View File
@@ -2,29 +2,29 @@ module Dodge.Creature.YourControl
( yourControl
) where
import Dodge.Data
import Dodge.LightSource
import Dodge.Base.Coordinate
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Test
import Dodge.Update.UsingInput
import Dodge.InputFocus
--import Dodge.Config.KeyConfig
import Geometry
import LensHelp
import Control.Lens
import qualified SDL
--import qualified Data.Set as S
import qualified Data.Map.Strict as M
--import qualified Data.IntMap.Strict as IM
--import Data.Maybe
{- | The AI equivalent for your control. -}
yourControl :: Creature -> World -> World
yourControl cr w
| inTermFocus w = w & updateUsingInput
| otherwise = w
| inTermFocus w = dimCreatureLight cr w & updateUsingInput
| otherwise = dimCreatureLight cr w
& creatures . ix (_crID cr) %~
(wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w))
& updateUsingInput
dimCreatureLight :: Creature -> World -> World
dimCreatureLight cr = 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
{- | Turn key presses into creature movement. -}
-6
View File
@@ -292,11 +292,6 @@ data Gust = Gust
, _guVel :: Point2
, _guTime :: Int
}
data TempLightSource = TLS
{ _tlsParam :: LSParam
, _tlsUpdate :: World -> TempLightSource -> Maybe TempLightSource
, _tlsTime :: !Int
}
data CreatureType
= Humanoid
{ _skinHead :: Color
@@ -1383,7 +1378,6 @@ makeLenses ''Damage
makeLenses ''DamageEffect
makeLenses ''World
makeLenses ''Creature
makeLenses ''TempLightSource
makeLenses ''Item
makeLenses ''ItemUse
makeLenses ''ItEffect
+6
View File
@@ -16,5 +16,11 @@ data LightSource = LS
, _lsDir :: !Float
, _lsPict :: LightSource -> Picture
}
data TempLightSource = TLS
{ _tlsParam :: LSParam
, _tlsUpdate :: TempLightSource -> Maybe TempLightSource
, _tlsTime :: !Int
}
makeLenses ''LSParam
makeLenses ''LightSource
makeLenses ''TempLightSource
+1 -1
View File
@@ -31,6 +31,6 @@ defaultTLS = TLS
, _tlsTime = 1
}
where
f _ t
f t
| _tlsTime t <= 0 = Nothing
| otherwise = Just $ t & tlsTime -~ 1
+13 -16
View File
@@ -10,10 +10,7 @@ import Geometry.Zone
--import Picture
import Geometry.Data
import Geometry.Polygon
--import Picture.Texture
--import Data.Preload
import Control.Lens
import System.Random
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
@@ -85,7 +82,7 @@ defaultWorld = World
, _carteRot = 0
}
, _lightSources = IM.empty
, _tempLightSources = [youLight]
, _tempLightSources = []
, _closeObjects = []
, _rbOptions = NoRightButtonOptions
, _seenLocations = IM.fromList
@@ -121,15 +118,15 @@ defaultWorld = World
}
defaultWorldHammers :: M.Map WorldHammer HammerPosition
defaultWorldHammers = M.fromSet (const HammerUp) $ S.fromList [minBound.. maxBound]
youLight :: TempLightSource
youLight = TLS
{ _tlsParam = LSParam
{_lsPos = V3 0 0 0
,_lsRad = 300
,_lsCol = 0.1
}
,_tlsUpdate = \w _ -> Just (youLight & tlsParam . lsPos .~ f (_crPos $ you w))
,_tlsTime = 0
}
where
f (V2 x y) = V3 x y 100
--youLight :: TempLightSource
--youLight = TLS
-- { _tlsParam = LSParam
-- {_lsPos = V3 0 0 0
-- ,_lsRad = 300
-- ,_lsCol = 0.1
-- }
-- ,_tlsUpdate = \w _ -> Just (youLight & tlsParam . lsPos .~ f (_crPos $ you w))
-- ,_tlsTime = 0
-- }
-- where
-- f (V2 x y) = V3 x y 100
+2 -2
View File
@@ -35,7 +35,7 @@ tlsTimeRadFunPos t rmax intensityF p = TLS
, _tlsTime = t
}
where
upF _ tls
upF tls
| _tlsTime tls <= 0 = Nothing
| otherwise = Just $ tls
& tlsTime -~ 1
@@ -83,7 +83,7 @@ tlsTimeRadColPos t rmax col (V3 x y z) = TLS
, _tlsTime = t
}
where
upF _ tls
upF tls
| _tlsTime tls <= 0 = Nothing
| otherwise = Just $ tls
& tlsTime -~ 1
+2 -2
View File
@@ -202,9 +202,9 @@ updateDistortions :: World -> World
updateDistortions = distortions %~ mapMaybe updateDistortion
updateLightSources :: World -> World
updateLightSources w = over tempLightSources f w
updateLightSources = tempLightSources %~ f
where
f = mapMaybe (\b -> _tlsUpdate b w b)
f = mapMaybe (\b -> _tlsUpdate b b)
updateRadarBlips :: World -> World
updateRadarBlips = radarBlips %~ mapMaybe updateRadarBlip