module Data.Object.Dynamic.Examples.PointParticle
(Vec(..),
Mass(..), Velocity(..), Momentum(..), KineticEnergy(..),
mass, velocity, momentum, kineticEnergy,
fromMassVelocity, fromMassMomentum,
laserBeam,
duck, lens, banana, envelope, ghost
)
where
import Control.Applicative hiding (empty)
import Control.Lens hiding (lens)
import Data.Dynamic
import Data.String
import Test.QuickCheck
import Data.Object.Dynamic
import Data.Object.Dynamic.Types
data Vec a = Vec a a deriving (Eq, Show, Ord, Typeable)
instance (Arbitrary a) => Arbitrary (Vec a) where
arbitrary = Vec <$> arbitrary <*> arbitrary
shrink (Vec x y) = Vec <$> shrink x <*> shrink y
data Mass = Mass deriving (Typeable)
instance (Objective o, UseReal o) => Member o Mass where
type ValType o Mass = UnderlyingReal o
data Velocity = Velocity deriving (Typeable)
instance (Objective o, UseReal o) => Member o Velocity where
type ValType o Velocity = Vec (UnderlyingReal o)
data Momentum = Momentum deriving (Typeable)
instance (Objective o, UseReal o) => Member o Momentum where
type ValType o Momentum = Vec (UnderlyingReal o)
data KineticEnergy = KineticEnergy deriving (Typeable)
instance (Objective o, UseReal o) => Member o KineticEnergy where
type ValType o KineticEnergy = UnderlyingReal o
mass :: MemberLens o Mass
mass = memberLens Mass
velocity :: (UseReal o, Fractional (UnderlyingReal o)) => MemberLens o Velocity
velocity = memberLensDef Velocity $ \this -> do
m <- this ^? mass
Vec mx my <- this ^? momentum
return $ Vec (mx/m) (my/m)
momentum :: (UseReal o, Fractional (UnderlyingReal o)) => MemberLens o Momentum
momentum = memberLensDef Momentum $ \this -> do
m <- this ^? mass
Vec vx vy <- this ^? velocity
return $ Vec (m * vx) (m * vy)
kineticEnergy :: (UseReal o, Fractional (UnderlyingReal o)) => MemberLens o KineticEnergy
kineticEnergy = memberLensDef KineticEnergy $ \this -> do
m <- this ^? mass
Vec vx vy <- this ^? velocity
return $ ((m * vx * vx) + (m * vy * vy)) / 2
fromMassVelocity :: (Objective o, UseReal o, Fractional real, real ~ (UnderlyingReal o))
=> real -> Vec real -> o
fromMassVelocity m v =
empty & insert Mass m
& insert Velocity v
fromMassMomentum :: (Objective o, UseReal o, Fractional real, real ~ (UnderlyingReal o))
=> real -> Vec real -> o
fromMassMomentum m v =
empty & insert Mass m
& insert Momentum v
laserBeam :: (Objective o, UseReal o, Fractional real, real ~ (UnderlyingReal o)) => o
laserBeam = fromMassVelocity 0.145 (Vec 150 0)
duck, lens, banana :: (Objective o, UseReal o, Fractional real, real ~ (UnderlyingReal o)) => o
duck = empty & insert Mass 5.2
lens = empty & insert Mass 0.56
banana = empty & insert Mass 0.187
envelope :: (Objective o, UseReal o, UseString o, Fractional (UnderlyingReal o),
IsString (UnderlyingString o)) => o
envelope = empty & insert Mass 0.025
& insert Autograph (fromString "Edward Kmett")
ghost :: (Objective o) => o
ghost = empty
data Autograph = Autograph deriving Typeable
instance (Objective o, UseString o) => Member o Autograph where
type ValType o Autograph = UnderlyingString o