Merge branch 'testing', resolved conflicts

This commit is contained in:
2021-03-27 20:45:36 +01:00
9 changed files with 3230 additions and 55 deletions
+15 -25
View File
@@ -24,17 +24,16 @@ yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,
yourControl w (f,g) cr = ( (updateUsingInput . f, g)
, Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr
)
where strafeSpeed = 8 * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed)
speed = 3 * equipFactor
where strafeSpeed = _varMovementSpeedModifier w * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed)
speed = _varMovementSpeedModifier w * equipFactor
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0
wasdWithAiming :: World -> Float -> Float -> Int -> Creature -> Creature
wasdWithAiming w speed aimSpeed i cr
| (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving && isAiming
&& diffAngles mouseDir (argV mov) < pi/3
&& diffAngles mouseDir (argV mov) < pi/3
= over crPos (+.+ (0.2 *.* mov))
-- $ set ( creatures . ix i . crDir) (argV mov)
$ set crDir mouseDir
. set crDir mouseDir
$ set (crState . stance . carriage) (Boosting mov)
cr
| (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving && isAiming
@@ -43,9 +42,7 @@ wasdWithAiming w speed aimSpeed i cr
cr
| (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving
= over crPos (+.+ (0.2 *.* mov))
-- $ set ( creatures . ix i . crDir) (argV mov)
-- $ set ( creatures . ix i . crDir) mouseDir
$ over crDir (flip fromMaybe dir)
. over crDir (flip fromMaybe dir)
$ set (crState . stance . carriage) (Boosting mov)
cr
| (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isAiming
@@ -56,20 +53,17 @@ wasdWithAiming w speed aimSpeed i cr
= set (crState . stance . carriage) Floating
cr
| isAiming
= -- stopSoundFrom (CrSound i) $
stepForward' aimSpeed
$ over crPos (+.+ (aimSpeed *.* mov))
$ set crDir mouseDir
cr
= stepForward' aimSpeed
$ over crPos (+.+ (aimSpeed *.* mov))
$ set crDir mouseDir
cr
| isMoving
= -- continueOrLoopFrom (CrSound i) twoStepSound $
stepForward' speed
$ over ( crPos) (+.+ (speed *.* mov))
$ over ( crDir) (flip fromMaybe dir)
cr
= stepForward' speed
$ over ( crPos) (+.+ (speed *.* mov))
$ over ( crDir) (flip fromMaybe dir)
cr
| otherwise
= -- stopSoundFrom (CrSound i) $
over ( crDir) (flip fromMaybe dir)
= over ( crDir) (flip fromMaybe dir)
cr
where (mov',dir') = wasdComp (view keys w) w
(mov,dir) = (rotateV (_cameraRot w) mov',fmap (_cameraRot w +) dir')
@@ -90,13 +84,9 @@ wasdM w scancode
| scancode == moveRightKey (_keyConfig w) = (1,0)
| scancode == moveLeftKey (_keyConfig w) = (-1,0)
wasdM _ _ = (0,0)
--wasdM SDL.ScancodeW = (0,1)
--wasdM SDL.ScancodeS = (0,-1)
--wasdM SDL.ScancodeD = (1,0)
--wasdM SDL.ScancodeA = (-1,0)
--wasdM _ = (0,0)
wasdComp :: S.Set SDL.Scancode -> World -> (Point2,Maybe Float)
wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (0,0) ks
where f (0,0) = ((0,0), Nothing)
f p = (errorNormalizeV 46 p, Just $ argV p)