add support for projectiles

currently you can only shoot yourself and the orbiting asteroid

4 files changed, 70 insertions, 30 deletions

diff --git a/README.md b/README.md
index 4cf2265..de4a5a9 100644
--- a/README.md
+++ b/README.md
@@ -11,6 +11,7 @@ the most realistic asteroids-like game in existence.
 * `c`: toggle centered view
 * `+`/`-`: zoom in/out
 * `,`/`.`: slow time down / speed it up
+* `space`: fire a projectile
 
 ## roadmap
 
@@ -22,9 +23,10 @@ the most realistic asteroids-like game in existence.
 - [ ] Free viewport (mouse moved)
 - [x] time scaling / fast forward
 - [x] rework HUD, log additional info to console
-- [ ] Add speed to HUD
-- [ ] projectiles
-- [ ] multi player support (?)
+  - [ ] Add speed to HUD
+- [x] projectiles
+  - [ ] Limit firerate, make projectiles self-destruct
+- [ ] multi player support
 - [ ] cosmetics (improved models, stars, …)
 - [ ] switch rendering engine
 - [ ] orbit visualization / prediction
diff --git a/lib/Grav2ty/Control.hs b/lib/Grav2ty/Control.hs
index 5eeeeaf..a1c27ac 100644
--- a/lib/Grav2ty/Control.hs
+++ b/lib/Grav2ty/Control.hs
@@ -3,11 +3,11 @@ module Grav2ty.Control
   ( State (..)
   , control, graphics, world
   , ControlState (..)
-  , ctrlInputs, ctrlTimeScale
+  , ctrlInputs, ctrlTimeScale, ctrlTick
   , applyControls
   , Modification (..)
   , zeroModification
-  , modAcc, modRot
+  , modAcc, modRot, modFire
   , ExtractFunction (..)
   , updateState
   ) where
@@ -15,20 +15,22 @@ module Grav2ty.Control
 import Grav2ty.Simulation
 
 import Control.Lens
+import Data.Maybe
 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
+  { _modRot :: a        -- ^ Rotation (angle in radiant) set by the modification
+  , _modAcc :: a        -- ^ Acceleration set by the modification
+  , _modFire :: Integer -- ^ Set to tick a projectile should be fired at
   } deriving (Show, Eq, Ord)
 
 makeLenses ''Modification
 
 zeroModification :: Num a => Modification a
-zeroModification = Modification 0 0
+zeroModification = Modification 0 0 (-1)
 
 data ControlState a
   = ControlState
@@ -38,6 +40,9 @@ data ControlState a
   -- of the ship.
   , _ctrlTimeScale :: a
   -- ^ Scaling of time allowing for the simulation to be sped up or slowed down
+  , _ctrlTick :: Integer
+  -- ^ Current tick. Ticks are not of constant length, but depend on time scale
+  --   and the simulation steps per second.
   } deriving (Show, Eq)
 
 makeLenses ''ControlState
@@ -51,31 +56,49 @@ data State a g
 
 makeLenses ''State
 
-applyControls :: Floating a => ControlState a -> Object a -> Object a
-applyControls _ obj@Static {} = obj
+projectile :: RealFloat a => (V2 a, V2 a) -> Object a -> Object a
+projectile (pos,speed) ship =
+  Dynamic (centeredCircle 1) 0 1000 pPos pSpeed 0 NoMod Nothing
+  where pPos = objectLoc ship + rotateV2 (objectRot ship) pos
+        pSpeed = (15 * rotateV2 (objectRot ship) speed) + objectSpeed ship
+
+applyControls :: RealFloat a => ControlState a -> Object a -> [Object a]
+applyControls _ obj@Static {} = [obj]
 applyControls cs obj@Dynamic {} =
   case objectMod obj of
-    NoMod -> obj
-    LocalMod -> case Map.lookup LocalMod (cs ^. ctrlInputs) of
-               Nothing -> obj
-               Just (Modification rot acc) -> obj
-                 { objectRot = rot
-                 , objectAcc = angle rot ^* acc
-                 }
+    NoMod -> [obj]
+    LocalMod -> case Map.lookup (objectMod obj) (cs^.ctrlInputs) of
+               Nothing -> [obj]
+               Just (Modification rot acc fire) ->
+                 let newObj = obj
+                      { objectRot = rot
+                      , objectAcc = angle rot ^* acc
+                      }
+                     -- Note: we are relying on laziness here: if objectCannon
+                     -- is Nothing the pObj never gets evaluated.
+                     pObj = projectile (fromJust . objectCannon $ obj) newObj
+                     pList = if cs^.ctrlTick /= fire || isNothing (objectCannon obj)
+                                then []
+                                else [pObj]
+                  in newObj : pList
 
 type ExtractFunction a b = Object a -> (State a b -> State a b)
 
 updateState :: (RealFloat a, Ord a) => a -> ExtractFunction a b
                 -> State a b -> State a b
-updateState t extract state = set world newWorld . updateState $ state
+updateState t extract state =
+  over (control.ctrlTick) (+ 1)
+  . set world newWorld
+  . updateState' $ state
   where oldWorld = state^.world
-        (newWorld, updateState) = tailCall oldWorld ([], id)
+        (newWorld, updateState') = tailCall oldWorld ([], id)
         tailCall [] acc = acc
         tailCall (x:xs) (nw, f) = tailCall xs $
           if coll x
              then (nw, f)
-             else (updateObject' x : nw, extract x . f)
+             else (updateObject' x ++ nw, extract x . f)
         coll obj = isDynamic obj && collisionWithWorld oldWorld obj
         scaledT = state^.control^.ctrlTimeScale * t
-        updateObject' obj = updateObject scaledT (gravitationForces oldWorld obj)
+        updateObject' obj =
+          map (updateObject scaledT (gravitationForces oldWorld obj))
           . applyControls (state^.control) $ obj
diff --git a/lib/Grav2ty/Simulation.hs b/lib/Grav2ty/Simulation.hs
index bba3169..1e63352 100644
--- a/lib/Grav2ty/Simulation.hs
+++ b/lib/Grav2ty/Simulation.hs
@@ -16,6 +16,8 @@ module Grav2ty.Simulation
   , rotateHitbox
   , collision
   , collisionWithWorld
+  -- * Exposed Utilities
+  , rotateV2
   ) where
 
 import Control.Lens
@@ -54,16 +56,19 @@ translateHitbox t (HCombined hs) = HCombined . map (translateHitbox t) $ hs
 complexV2 :: Iso' (Complex a) (V2 a)
 complexV2 = iso (\(x :+ y) -> V2 x y) (\(V2 x y) -> x :+ y)
 
+-- | Rotate a point by an radial angle around @V2 0 0@
+rotateV2 :: RealFloat a => a -> V2 a -> V2 a
+rotateV2 angle p = (^. complexV2) . (* rotator) . (^. from complexV2) $ p
+  where rotator = cos angle :+ sin angle
+
 -- TODO address inaccuracies of 'Float' and 'Double'?
 -- | Rotate a 'Hitbox' by a radial angle.
 rotateHitbox :: RealFloat a => a -> Hitbox a -> Hitbox a
 rotateHitbox angle box =
   case box of
-    HLine a b -> HLine (rotate a) (rotate b)
-    HCircle c r -> HCircle (rotate c) r
+    HLine a b -> HLine (rotateV2 angle a) (rotateV2 angle b)
+    HCircle c r -> HCircle (rotateV2 angle c) r
     HCombined l -> HCombined . map (rotateHitbox angle) $ l
-  where rotator = cos angle :+ sin angle
-        rotate = (^. complexV2) . (* rotator) . (^. from complexV2)
 
 -- | Returns the 'Hitbox' for an 'Object', but rotated and translated
 --   to the location it is *actually* at.
@@ -148,6 +153,12 @@ data Modifier
   | External Integer -- ^ Object is modified by an external source / other players.
   deriving(Eq, Ord, Show)
 
+-- | @Just (<cannon position>, <cannon direction>)@ describes origin and
+--   trajectory of projectiles of this object. Note that both position and
+--   direction are rotated by 'objectRot'. @Nothing@ means that projectiles
+--   are disabled for the particular 'Object'.
+type Cannon a = Maybe (V2 a, V2 a)
+
 data Object a
   = Dynamic
   { objectHitbox :: Hitbox a  -- ^  hitbox of the object. Hitbox points at
@@ -163,6 +174,8 @@ data Object a
                               --   projectile.
   , objectMod    :: Modifier  -- ^ If and how the Object can be modified during
                               --   the simulation.
+  , objectCannon :: Cannon a  -- ^ Point and Direction projectiles can or can not
+                              --   be fired from.
   }
   | Static
   { objectHitbox :: Hitbox a -- ^ See above.
diff --git a/src/Main.hs b/src/Main.hs
index 264b330..075ced3 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -48,9 +48,10 @@ renderUi :: (PrintfArg a, Num a) => State a GlossState -> Picture
 renderUi state = (uncurry translate) (homBimap ((+ 50) . (* (-1)) . (/ 2) . fromIntegral)
   . view (graphics . glossViewPort) $ state)
   . scale 0.2 0.2 . Color green . Text $ uiText
-  where uiText = printf "Acceleration: %.0f TimeScale: %.1f" acc timeScale
+  where uiText = printf "Acceleration: %.0f TimeScale: %.1f Tick: %d" acc timeScale tick
         acc = fromMaybe 0 $ state^?control.ctrlInputs.at LocalMod ._Just.modAcc
         timeScale = state^.control.ctrlTimeScale
+        tick = state^.control^.ctrlTick
 
 renderStars :: (Float, Float) -> Picture
 renderStars center = undefined
@@ -77,7 +78,7 @@ boundAdd max a x = if res > max then max else res
 eventHandler :: (Show a, Ord a, Real a, Floating a) => Event
              -> State a GlossState -> State a GlossState
 eventHandler (EventKey key Down _ _) state = action state
-  where updateLocalMod :: Lens' (Modification a) a -> (a -> a)
+  where updateLocalMod :: Lens' (Modification a) b -> (b -> b)
                        -> State a GlossState -> State a GlossState
         updateLocalMod l f = over (control.ctrlInputs.at LocalMod ._Just.l) f
         accStep = 1
@@ -91,6 +92,7 @@ eventHandler (EventKey key Down _ _) state = action state
             SpecialKey KeyDown -> updateLocalMod modAcc (boundSub 0 accStep)
             SpecialKey KeyLeft -> updateLocalMod modRot (mod2pi . (+ rotStep))
             SpecialKey KeyRight -> updateLocalMod modRot (mod2pi . (subtract rotStep))
+            SpecialKey KeySpace -> updateLocalMod modFire (const $ state^.control.ctrlTick + 10)
             Char 'c' -> over (graphics.glossCenterView) not
             Char '+' -> over (graphics.glossViewPortScale) (+ scaleStep)
             Char '-' -> over (graphics.glossViewPortScale) (subtract scaleStep)
@@ -109,10 +111,10 @@ updateWorld ts state = updateState ts extract state
 
 initialWorld :: Fractional a => State a GlossState
 initialWorld = State
-  (ControlState (Map.fromList [(LocalMod, zeroModification)]) 1)
+  (ControlState (Map.fromList [(LocalMod, zeroModification)]) 1 0)
   (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
+  [ Dynamic shipHitbox 0 10000 (V2 200 0) (V2 0 0) (V2 0 0) LocalMod (Just (V2 15 0, V2 1 0))
+  , Dynamic (centeredCircle 10) 0 5000 (V2 0 200) (V2 15 0) (V2 0 0) NoMod Nothing
   , Static (centeredCircle 80) 0 moonMass (V2 0 0)
 --  , Static (centeredCircle 40) 0 (0.5 * moonMass) (V2 250 250)
   ]