diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 6799020be..e7c8ba931 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -67,8 +67,7 @@ spawnerCrit = defaultCreature miniGunCrit :: Creature miniGunCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = defaultImpulsive $ - [sentinelFireType (const shootTillEmpty)] + , _crUpdate = defaultImpulsive [sentinelFireType (const shootTillEmpty)] , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] @@ -88,7 +87,7 @@ longCrit :: Creature longCrit = defaultCreature { _crPict = basicCrPict red -- , _crUpdate = stateUpdate sniperAI - , _crUpdate = defaultImpulsive $ [sentinelFireType $ const shootTillEmpty] + , _crUpdate = defaultImpulsive [sentinelFireType $ const shootTillEmpty] , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] @@ -108,7 +107,7 @@ multGunCrit = defaultCreature , _crInvSel = 0 , _crRad = 10 , _crHP = 300 - , _crUpdate = defaultImpulsive $ [sentinelExtraWatchUpdate + , _crUpdate = defaultImpulsive [sentinelExtraWatchUpdate [ ( const $ not . crHasAmmo , \_ _ -> StrategyActions Reload reloadActions ) @@ -150,7 +149,7 @@ startCr = defaultCreature , _crMvDir = pi/2 , _crID = 0 , _crPict = basicCrPict black - , _crUpdate = stateUpdate' yourControl' + , _crUpdate = stateUpdate' yourControl , _crRad = 10 , _crMass = 10 , _crHP = 1000 diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 04ca7f498..588de8241 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -1,6 +1,5 @@ module Dodge.Creature.YourControl - (-- yourControl - yourControl' + ( yourControl ) where import Dodge.Data import Dodge.Creature.Impulse.Movement @@ -11,50 +10,36 @@ import Geometry import Control.Lens import qualified SDL import qualified Data.Set as S -import qualified Data.IntMap.Strict as IM +--import qualified Data.IntMap.Strict as IM import Data.Maybe {- | The AI equivalent for your control. -} -yourControl - :: Creature - -> World - -> (World -> World, Creature) -yourControl cr w = - ( updateUsingInput - , mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr - ) - where - speed = _mvSpeed $ _crMvType cr -yourControl' :: Creature -> World -> World -yourControl' cr w = w +yourControl :: Creature -> World -> World +yourControl cr w = w & updateUsingInput - & creatures . ix (_crID cr) %~ (mouseActionsCr (_mouseButtons w) . wasdWithAiming w speed 0) + & creatures . ix (_crID cr) %~ (mouseActionsCr (_mouseButtons w) . wasdWithAiming w speed) where speed = _mvSpeed $ _crMvType cr {- | Turn key presses into creature movement. -} wasdWithAiming - :: World + :: World -> Float -- ^ Base speed - -> Int -- ^ Creature id -> Creature -> Creature -wasdWithAiming w speed i cr - | isAiming - = addAnyTwist $ set crDir mouseDir $ theMovement cr +wasdWithAiming w speed cr + | isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr | isReloading && SDL.ButtonRight `S.member` _mouseButtons w - = addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr + = addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr | otherwise = theMovement $ theTurn $ removeTwist cr where twistamount = 1.6 - removeTwist cr' = case _crTwist cr' of - t -> cr' & crDir +~ t & crTwist .~ 0 - anytwist = case cr ^? crInv . ix (_crInvSel (_creatures w IM.! i)) . itUse . useAim . aimStance of - Just TwoHandTwist -> twistamount * pi - _ -> 0 - addAnyTwist cr' - = case cr' ^? crInv . ix (_crInvSel (_creatures w IM.! i)) . itUse . useAim . aimStance of - Just TwoHandTwist -> cr' & crTwist .~ twistamount * pi - _ -> cr' + removeTwist cr' = cr' + & crDir +~ _crTwist cr' + & crTwist .~ 0 + anytwist = case cr ^? crInv . ix (_crInvSel cr) . itUse . useAim . aimStance of + Just TwoHandTwist -> twistamount * pi + _ -> 0 + addAnyTwist = crTwist .~ anytwist theMovement | movDir == V2 0 0 = id | otherwise = crMvAbsolute (speed *.* movAbs) . set crMvDir dir @@ -64,8 +49,7 @@ wasdWithAiming w speed i cr movAbs = rotateV (_cameraRot w) $ normalizeV movDir isAiming = _posture (_crStance cr) == Aiming isReloading = _posture (_crStance cr) == Reloading - mouseDir = case w ^? creatures . ix i . crInv . ix (_crInvSel (_creatures w IM.! i)) - . itScope . scopePos of + mouseDir = case cr ^? crInv . ix (_crInvSel cr) . itScope . scopePos of Just p -> normalizeAngle $ argV $ p +.+ 2 / _cameraZoom w *.* rotateV (_cameraRot w) (_mousePos w) @@ -77,10 +61,10 @@ wasdM scancode = case scancode of SDL.ScancodeS -> V2 0 (-1) SDL.ScancodeD -> V2 1 0 SDL.ScancodeA -> V2 (-1) 0 - _ -> V2 0 0 + _ -> V2 0 0 wasdDir :: World -> Point2 -wasdDir w = foldr ((+.+) . wasdM) (V2 0 0) $ _keys w +wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys {- | Set posture according to mouse presses. -} mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index c3eef6822..7bca3b163 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -13,39 +13,38 @@ import Control.Lens updateUsingInput :: World -> World updateUsingInput w = case _hudElement $ _hud w of - DisplayInventory {} -> updatePressedButtons (_mouseButtons w) w - DisplayCarte -> updatePressedButtonsCarte (_mouseButtons w) w + DisplayInventory {} -> updatePressedButtons (_mouseButtons w) w + DisplayCarte -> updatePressedButtonsCarte (_mouseButtons w) w updatePressedButtons :: S.Set MouseButton -> World -> World updatePressedButtons pkeys w - | lbPressed && rbPressed && inTopInv = useItem (you w) w - | lbPressed && - (inTopInv || _timeFlow w == RewindingLastFrame) + | isDown ButtonLeft && isDown ButtonRight && inTopInv + = useItem (you w) w + | isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame) = useLeftItem (_yourID w) w - | mbPressed = w & clickMousePos .~ _mousePos w - & cameraRot -~ rotation + | isDown ButtonMiddle + = w & cameraRot -~ rotation + & clickMousePos .~ _mousePos w | otherwise = w where - inTopInv = case _hudElement (_hud w) of + inTopInv = case _hudElement (_hud w) of DisplayInventory NoSubInventory -> True _ -> False - lbPressed = ButtonLeft `S.member` pkeys - rbPressed = ButtonRight `S.member` pkeys - mbPressed = ButtonMiddle `S.member` pkeys - rotation = angleBetween (_mousePos w) (_clickMousePos w) + isDown but = but `S.member` pkeys + rotation = angleBetween (_mousePos w) (_clickMousePos w) updatePressedButtonsCarte :: S.Set MouseButton -> World -> World updatePressedButtonsCarte pkeys w - | rbPressed = w & clickMousePos .~ _mousePos w - & hud . carteCenter %~ (-.- trans) - | lbPressed = w & clickMousePos .~ _mousePos w - & hud . carteRot -~ rot - & hud . carteZoom *~ czoom + | isDown ButtonRight = w + & clickMousePos .~ _mousePos w + & hud . carteCenter %~ (-.- trans) + | isDown ButtonLeft = w + & clickMousePos .~ _mousePos w + & hud . carteRot -~ rot + & hud . carteZoom *~ czoom | otherwise = w where - lbPressed = ButtonLeft `S.member` pkeys - rbPressed = ButtonRight `S.member` pkeys - --mbPressed = ButtonMiddle `S.member` pkeys - rot = angleBetween (_mousePos w) (_clickMousePos w) - czoom = magV (_mousePos w) / magV (_clickMousePos w) - trans = rotateV (_carteRot (_hud w)) $ (1 / _carteZoom (_hud w)) *.* (_mousePos w -.- _clickMousePos w) + isDown but = but `S.member` pkeys + rot = angleBetween (_mousePos w) (_clickMousePos w) + czoom = magV (_mousePos w) / magV (_clickMousePos w) + trans = rotateV (_carteRot (_hud w)) $ 1 / _carteZoom (_hud w) *.* (_mousePos w -.- _clickMousePos w)