diff options
author | sternenseemann <git@lukasepple.de> | 2019-05-21 23:31:11 +0200 |
---|---|---|
committer | sternenseemann <git@lukasepple.de> | 2019-05-21 23:31:11 +0200 |
commit | 055c9cc844144d86b1a4f5a83df339da90ff43a9 (patch) | |
tree | 8182162f6a2e1f24663e038874d3ca3189d47c5f | |
parent | ea0d9f50ce09b866d92301778c182d3b3c464fa4 (diff) |
introduce Modification type
-rw-r--r-- | lib/Grav2ty/Control.hs | 31 | ||||
-rw-r--r-- | src/Main.hs | 15 |
2 files changed, 29 insertions, 17 deletions
diff --git a/lib/Grav2ty/Control.hs b/lib/Grav2ty/Control.hs index 5c84c6a..776c3ac 100644 --- a/lib/Grav2ty/Control.hs +++ b/lib/Grav2ty/Control.hs @@ -5,6 +5,9 @@ module Grav2ty.Control , ControlState (..) , ctrlInputs, ctrlTimeScale , applyControls + , Modification (..) + , zeroModification + , modAcc, modRot ) where import Grav2ty.Simulation @@ -14,17 +17,25 @@ import Linear.V2 import Linear.Vector import qualified Data.Map as Map +data Modification a + = Modification + { _modRot :: a -- ^ Rotation (angle in radiant) set by the modification + , _modAcc :: a -- ^ Acceleration set by the modification + } deriving (Show, Eq, Ord) + +makeLenses ''Modification + +zeroModification :: Num a => Modification a +zeroModification = Modification 0 0 + data ControlState a = ControlState - { _ctrlInputs :: Map.Map Modifier (a, a) -- ^ Map containing the Modifier - -- and the modified values, - -- mainly the Radial angle the - -- object is rotated at and - -- the current acceleration - -- of the ship. - , _ctrlTimeScale :: a -- ^ Scaling of time allowing - -- for the simulation to be - -- sped up or slowed down + { _ctrlInputs :: Map.Map Modifier (Modification a) + -- ^ Map containing the Modifier and the modified values, mainly the + -- Radial angle the object is rotated at and the current acceleration + -- of the ship. + , _ctrlTimeScale :: a + -- ^ Scaling of time allowing for the simulation to be sped up or slowed down } deriving (Show, Eq) makeLenses ''ControlState @@ -45,7 +56,7 @@ applyControls cs obj@Dynamic {} = NoMod -> obj LocalMod -> case Map.lookup LocalMod (cs ^. ctrlInputs) of Nothing -> obj - Just (rot, acc) -> obj + Just (Modification rot acc) -> obj { objectRot = rot , objectAcc = angle rot ^* acc } diff --git a/src/Main.hs b/src/Main.hs index 1337ff4..88fec7e 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -46,7 +46,7 @@ renderUi :: (Show a, Num a) => State a GlossState -> Picture renderUi state = (uncurry translate) (tupleMap ((+ 50) . (* (-1)) . (/ 2) . fromIntegral) . view (graphics . glossViewPort) $ state) . scale 0.3 0.3 . Color green . Text . show - . fromMaybe 0 . fmap snd . Map.lookup LocalMod . view (control . ctrlInputs) $ state + . fromMaybe 0 $ state^?control.ctrlInputs.at LocalMod ._Just.modAcc renderStars :: (Float, Float) -> Picture renderStars center = undefined @@ -65,16 +65,17 @@ renderGame state = Pictures [ renderUi state eventHandler :: (Show a, Floating a) => Event -> State a GlossState -> State a GlossState eventHandler (EventKey key Down _ _) state = action state - where updateLocalMod :: Lens' (a, a) a -> (a -> a) -> State a GlossState -> State a GlossState + where updateLocalMod :: Lens' (Modification a) a -> (a -> a) + -> State a GlossState -> State a GlossState updateLocalMod l f = over (control.ctrlInputs.at LocalMod ._Just.l) f accStep = 1 rotStep = pi / 10 scaleStep = 0.05 action = case key of - SpecialKey KeyUp -> updateLocalMod _2 (+ accStep) - SpecialKey KeyDown -> updateLocalMod _2 (subtract accStep) - SpecialKey KeyLeft -> updateLocalMod _1 (+ rotStep) - SpecialKey KeyRight -> updateLocalMod _1 (subtract rotStep) + SpecialKey KeyUp -> updateLocalMod modAcc (+ accStep) + SpecialKey KeyDown -> updateLocalMod modAcc (subtract accStep) + SpecialKey KeyLeft -> updateLocalMod modRot (+ rotStep) + SpecialKey KeyRight -> updateLocalMod modRot (subtract rotStep) Char 'c' -> over (graphics.glossCenterView) not Char '+' -> over (graphics.glossViewPortScale) (+ scaleStep) Char '-' -> over (graphics.glossViewPortScale) (subtract scaleStep) @@ -108,7 +109,7 @@ updateWorld timeStep (State ctrl g world) = State ctrl initialWorld :: Fractional a => State a GlossState initialWorld = State - (ControlState (Map.fromList [(LocalMod, (0,0))]) 1) + (ControlState (Map.fromList [(LocalMod, zeroModification)]) 1) (GlossState (800, 800) (0, 0) 1 True) [ Dynamic shipHitbox 0 10000 (V2 200 0) (V2 0 0) (V2 0 0) LocalMod , Dynamic (centeredCircle 10) 0 5000 (V2 0 200) (V2 15 0) (V2 0 0) NoMod |