From 1cd68644e8a7136a3a257553d0a896dff24a2f74 Mon Sep 17 00:00:00 2001 From: sternenseemann Date: Sun, 27 Oct 2019 23:10:14 +0100 Subject: expand documentation --- lib/Grav2ty/Control.hs | 5 +++++ lib/Grav2ty/Core.hs | 52 +++++++++++++++++++++++++++++++++++++++-------- lib/Grav2ty/Simulation.hs | 27 +++++++++++++++++++++--- 3 files changed, 73 insertions(+), 11 deletions(-) diff --git a/lib/Grav2ty/Control.hs b/lib/Grav2ty/Control.hs index c497d9d..3139687 100644 --- a/lib/Grav2ty/Control.hs +++ b/lib/Grav2ty/Control.hs @@ -66,6 +66,11 @@ processObject old rels hook id obj = setObject (Just id) newObj hook newObj +-- | If called advances the simulation by one 'Tick' relying on the 'Grav2tyState'. +-- +-- It also calls the provided hook-Action once for every remaining 'Object'. This +-- action can be used to update the '_graphics' state @g@ or modify the behaviour +-- of @processTick@ altogether. processTick :: (Monad m, RealFloat a) => (Object a -> Grav2ty a g m ()) -> Grav2ty a g m () diff --git a/lib/Grav2ty/Core.hs b/lib/Grav2ty/Core.hs index f4b872c..e4bd9b6 100644 --- a/lib/Grav2ty/Core.hs +++ b/lib/Grav2ty/Core.hs @@ -2,6 +2,7 @@ module Grav2ty.Core ( -- * Basic Types Id (..) + , Tick (..) , World (..) -- ** Object , Object (..) @@ -19,14 +20,14 @@ module Grav2ty.Core , zeroModification -- * The Grav2ty Monad , Grav2ty (..) + -- ** State + , Grav2tyState (..) + , tick, timePerTick, inputs, graphics, world, highestId + -- ** Operations , setObject , getObject , addObject , delObject - -- ** State - , Grav2tyState (..) - , tick, timePerTick, inputs, graphics, world, highestId - , Tick (..) ) where import Control.Lens @@ -35,9 +36,15 @@ import Data.Map.Strict (Map (..)) import qualified Data.Map.Strict as M import Linear.V2 +-- | Identifier used for 'Object's in 'World'. type Id = Integer + +-- | A tick is a simulation step. This type represents the ascending number of simulation steps. type Tick = Integer +-- | The 'Object's are stored in a strict 'Map'. We need to access all Objects relatively frequently +-- and also add 'Object's from time to time as well as access 'Object's by their 'Id'. 'Map' +-- seems to provide a good compromise in terms of performance for these operations. type World a = Map Id (Object a) data Modifier @@ -52,10 +59,16 @@ data Modifier -- are disabled for the particular 'Object'. type Cannon a = Maybe (V2 a, V2 a) +-- | Objects come in two flavors: 'Static' Objects don't change in the course +-- of the simulation, but will influence other Objects either by collision +-- or gravity. They also can never be destroyed. +-- +-- 'Dynamic' objects are affected by physics and are destroyed on collision. +-- They also may be controlled by a player depending on their 'Modifier'. data Object a = Dynamic { objectHitbox :: Hitbox a -- ^ hitbox of the object. Hitbox points at - -- (V2 0 0) will always be at the center of + -- @(V2 0 0)@ will always be at the center of -- the object , objectRot :: a -- ^ Radial angle , objectMass :: a -- ^ mass of the object in kg @@ -83,6 +96,15 @@ isDynamic :: Object a -> Bool isDynamic Dynamic {} = True isDynamic _ = False +-- | Hitboxes are the basis for collision detection and also may be +-- used as a basis for the graphical representation of 'Object's, +-- although they probably should be replaced by a more appealing +-- alternative. +-- +-- They can be combined from lines and circles and are always +-- centered around position of the corresponding 'Object', +-- i. e. @V2 0 0@ of the Hitbox is always at the center of +-- the object. Also they naturally rotate with the object. data Hitbox a = HCombined [Hitbox a] | HLine @@ -106,18 +128,24 @@ shipHitbox = HCombined centeredCircle :: Num a => a -> Hitbox a centeredCircle = HCircle (V2 0 0) +-- | A Modification contains the attributes of an Object that can +-- be controlled by a player: Rotation, acceleration and firing +-- of projectiles. data Modification a = 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 + , _modFire :: Integer -- ^ Tick a projectile should be fired at } deriving (Show, Eq, Ord) makeLenses ''Modification +-- | 'Modification' that represents the default state of an 'Object'. zeroModification :: Num a => Modification a zeroModification = Modification 0 0 (-1) +-- | Used to store the 'Modification's for every controllable 'Object' +-- that is being simulated. type ModMap a = Map Modifier (Modification a) data Grav2tyState a g = Grav2tyState @@ -125,8 +153,9 @@ data Grav2tyState a g = Grav2tyState , _timePerTick :: a -- ^ The time between two 'Tick's. , _inputs :: ModMap a -- ^ 'Modification's that have to be processed in the next tick. , _graphics :: g -- ^ Graphics state. Use @()@ if non-graphical. - , _world :: World a - , _highestId :: Id + , _world :: World a -- ^ All objects. + , _highestId :: Id -- ^ Highest 'Id' used in 'World'. This is updated by 'addObject' + -- in Order to prevent accidental overwrites. } deriving (Show, Eq) makeLenses ''Grav2tyState @@ -134,9 +163,13 @@ makeLenses ''Grav2tyState -- | The 'Grav2ty' Monad is a renamed 'StateT' holding a 'Grav2tyState'. type Grav2ty p g m a = StateT (Grav2tyState p g) m a +-- | Shortcut for @'setObject' Nothing@. addObject :: Monad m => Object a -> Grav2ty a g m () addObject = setObject Nothing +-- | setObject overwrites or sets the 'Object' at the given 'Id'. +-- If no 'Id' is given it picks a new 'Id' using '_highestId' +-- that is guaranteed to be unused (if nothing messed with the 'World'). setObject :: Monad m => Maybe Id -> Object a -> Grav2ty a g m () setObject id obj = do id <- case id of @@ -146,8 +179,11 @@ setObject id obj = do use highestId world %= M.insert id obj +-- | Returns the 'Object' at 'Id'. getObject :: Monad m => Id -> Grav2ty a g m (Maybe (Object a)) getObject id = use (world.at id) +-- | Deletes the 'Object' at 'Id'. Note: This doesn't influence '_highestId' +-- which only ever increases. delObject :: Monad m => Id -> Grav2ty a g m () delObject id = world %= M.delete id diff --git a/lib/Grav2ty/Simulation.hs b/lib/Grav2ty/Simulation.hs index 6214a99..86fcd4f 100644 --- a/lib/Grav2ty/Simulation.hs +++ b/lib/Grav2ty/Simulation.hs @@ -31,6 +31,7 @@ import Linear.Metric (norm, distance) import Linear.V2 import Linear.Vector +-- | @translateHitbox (V2 x y)@ translates a 'Hitbox' by (x, y) in a 2d plane. translateHitbox :: Num a => V2 a -> Hitbox a -> Hitbox a translateHitbox t (HLine a b) = HLine (a + t) (b + t) translateHitbox t (HCircle c r) = HCircle (c + t) r @@ -39,13 +40,17 @@ 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@ +-- | Rotate a point by an radial angle around @V2 0 0@ using 'Complex' multiplication. +-- When using this rotation make sure to rotate before translating. rotateV2 :: RealFloat a => a -> V2 a -> V2 a rotateV2 angle = (^. complexV2) . (* rotator) . (^. from complexV2) where rotator = cos angle :+ sin angle -- TODO address inaccuracies of 'Float' and 'Double'? --- | Rotate a 'Hitbox' by a radial angle. +-- | @rotateHitbox@ rotates a 'Hitbox' by the given angle +-- which must be radial. As it uses 'Complex' multiplication +-- the center of the rotation is always @V2 0 0@, so make +-- sure to rotate before translating a 'Hitbox'. rotateHitbox :: RealFloat a => a -> Hitbox a -> Hitbox a rotateHitbox angle box = case box of @@ -53,7 +58,7 @@ rotateHitbox angle box = HCircle c r -> HCircle (rotateV2 angle c) r HCombined l -> HCombined . map (rotateHitbox angle) $ l --- | Returns the 'Hitbox' for an 'Object', but rotated and translated +-- | Returns the 'Hitbox' for an 'Object' — rotated and translated -- to the location it is *actually* at. realHitbox :: RealFloat a => Object a -> Hitbox a realHitbox obj = translateHitbox (objectLoc obj) . rotateHitbox (objectRot obj) @@ -70,6 +75,7 @@ cramer2 coeff res = if detA == 0 a1 = set (column _x) res coeff a2 = set (column _y) res coeff +-- | Wether a value is between two other values. inRange :: Ord a => (a, a) -> a -> Bool inRange (l, u) x = x >= l && x <= u @@ -125,14 +131,19 @@ collision (HLine a1 b1) (HLine a2 b2) = collision (HCombined as) b = any (collision b) as collision a b@(HCombined _) = collision b a +-- | Wether two given 'Object's collide. objectCollision :: RealFloat a => Object a -> Object a -> Bool objectCollision a b = a /= b && ((objectLoc a == objectLoc b) || collision (realHitbox a) (realHitbox b)) +-- | Wether two 'Object's have a certain distance. Used to +-- prevent extreme spikes in gravitational force while simulating +-- two objects that are close together. separated :: (Floating a, Ord a) => Object a -> Object a -> Bool separated a b = distance (objectLoc a) (objectLoc b) > 3 +-- | Directional Gravitational Force between two Objects as two-dimensional vector. gravitationForce :: Floating a => Object a -> Object a -> V2 a gravitationForce a b = (gravityConst * ((objectMass a * objectMass b) / (absDistance ** 2))) @@ -141,6 +152,7 @@ gravitationForce a b = (gravityConst * distance = objectLoc b - objectLoc a absDistance = norm distance +-- | The sum of gravitational force the 'World' imposes on an 'Object'. gravitationForces :: (Ord a, Floating a) => World a -> Object a -> V2 a gravitationForces world obj = foldl' calcSum (pure 0) world where calcSum force x = if separated obj x @@ -154,8 +166,13 @@ data ObjRel a = ObjRel makeLenses 'ObjRel +-- | The Object Relation Graph is used to store collisions +-- and the forces between 'Object's. This prevents that +-- these values are computed more than once and allows +-- to reuse computations for the inverse relation. type ObjRelGraph a = RelGraph Id (ObjRel a) +-- | Calculates all 'ObjRel's for a 'World'. objectRelGraph :: (RealFloat a, Ord a) => World a -> ObjRelGraph a objectRelGraph = insertMapKey rel emptyRel where rel a b = let res = ObjRel (objectCollision a b) (gravity a b) @@ -164,6 +181,10 @@ objectRelGraph = insertMapKey rel emptyRel then gravitationForce a b else pure 0 +-- | @updateObject timeStep gravitionForce@ calculates the state of +-- an 'Object' after a certain @timeStep@ of being exposed to +-- a certain @gravitationForce@. It also factors in the current +-- acceleration and speed of the 'Object'. updateObject :: Fractional a => a -> V2 a -> Object a -> Object a updateObject _ _ obj@Static {} = obj updateObject timeStep force obj@Dynamic {} = obj -- cgit 1.4.1