1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
{-# LANGUAGE TemplateHaskell #-}
module Grav2ty.Core
( -- * Basic Types
Id (..)
, World (..)
-- ** Object
, Object (..)
, isDynamic
, Cannon (..)
, Modifier (..)
-- *** Hitboxes
, Hitbox (..)
, shipHitbox
, centeredCircle
-- ** Modification handling
, Modification (..)
, modAcc, modRot, modFire
, ModMap (..)
, zeroModification
-- * The Grav2ty Monad
, Grav2ty (..)
, setObject
, getObject
, addObject
, delObject
-- ** State
, Grav2tyState (..)
, tick, timePerTick, inputs, graphics, world, highestId
, Tick (..)
) where
import Control.Lens
import Control.Monad.Trans.State.Strict
import Data.Map.Strict (Map (..))
import qualified Data.Map.Strict as M
import Linear.V2
type Id = Integer
type Tick = Integer
type World a = Map Id (Object a)
data Modifier
= NoMod -- ^ Not modified, purely physics based.
| LocalMod -- ^ Object is modified by local client / player.
| 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
-- (V2 0 0) will always be at the center of
-- the object
, objectRot :: a -- ^ Radial angle
, objectMass :: a -- ^ mass of the object in kg
, objectLoc :: V2 a -- ^ Current location of the object.
, objectSpeed :: V2 a -- ^ Current speed of the Object. Used for
-- simulation approximation
, objectAcc :: V2 a -- ^ Current static Acceleration of the object.
-- 0 unless controlled by the player or
-- 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.
, objectLife :: Maybe Integer -- ^ Tick the Object will be destroyed at.
}
| Static
{ objectHitbox :: Hitbox a -- ^ See above.
, objectRot :: a -- ^ See above.
, objectMass :: a -- ^ See above.
, objectLoc :: V2 a -- ^ See above.
} deriving (Show, Eq, Ord)
-- | Wether the 'Object' is Dynamic, i. e. affected by physics
isDynamic :: Object a -> Bool
isDynamic Dynamic {} = True
isDynamic _ = False
data Hitbox a
= HCombined [Hitbox a]
| HLine
{ lineStart :: V2 a
, lineEnd :: V2 a
}
| HCircle
{ circleLoc :: V2 a
, circleRadius :: a
} deriving (Eq, Show, Ord)
-- | Example 'Hitbox' for a triangular, asteroids-like spaceship
shipHitbox :: Num a => Hitbox a
shipHitbox = HCombined
[ HLine (V2 (-10) (-5)) (V2 (-10) 5)
, HLine (V2 (-10) (-5)) (V2 10 0)
, HLine (V2 (-10) 5) (V2 10 0)
]
-- | Generates a 'Hitbox' with a given radius centered around (0,0).
centeredCircle :: Num a => a -> Hitbox a
centeredCircle = HCircle (V2 0 0)
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
} deriving (Show, Eq, Ord)
makeLenses ''Modification
zeroModification :: Num a => Modification a
zeroModification = Modification 0 0 (-1)
type ModMap a = Map Modifier (Modification a)
data Grav2tyState a g = Grav2tyState
{ _tick :: Tick -- ^ The 'Tick' the game is at currently.
, _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
} deriving (Show, Eq)
makeLenses ''Grav2tyState
-- | The 'Grav2ty' Monad is a renamed 'StateT' holding a 'Grav2tyState'.
type Grav2ty p g m a = StateT (Grav2tyState p g) m a
addObject :: Monad m => Object a -> Grav2ty a g m ()
addObject = setObject Nothing
setObject :: Monad m => Maybe Id -> Object a -> Grav2ty a g m ()
setObject id obj = do
id <- case id of
Just id -> pure id
Nothing -> do
highestId += 1
use highestId
world %= M.insert id obj
getObject :: Monad m => Id -> Grav2ty a g m (Maybe (Object a))
getObject id = use (world.at id)
delObject :: Monad m => Id -> Grav2ty a g m ()
delObject id = world %= M.delete id
|
