module Drasil.DblPend.DataDefs where

import Control.Lens ((^.))

import Prelude hiding (sin, cos, sqrt)
import Language.Drasil
import qualified Language.Drasil.Sentence.Combinators as S
import Theory.Drasil (DataDefinition, ddENoRefs, ddMENoRefs)
import Drasil.DblPend.Figures (figMotion)
import Drasil.DblPend.Unitals (pendDisAngle_1, pendDisAngle_2, lenRod_1, lenRod_2, xPos_1, yPos_1, xPos_2, yPos_2)
import Drasil.DblPend.Concepts (horizontalPos, verticalPos)
import Data.Drasil.Quantities.Physics (velocity, position, time, acceleration, force)
import Data.Drasil.Quantities.PhysicalProperties (mass)

dataDefs :: [DataDefinition]
dataDefs :: [DataDefinition]
dataDefs = [DataDefinition
positionGDD, DataDefinition
positionXDD_1, DataDefinition
positionYDD_1, DataDefinition
positionXDD_2, DataDefinition
positionYDD_2, DataDefinition
accelGDD, DataDefinition
forceGDD]

------------------------
-- Position in General--
------------------------
positionGDD :: DataDefinition
positionGDD :: DataDefinition
positionGDD = ModelQDef
-> Maybe Derivation -> String -> [Sentence] -> DataDefinition
ddMENoRefs ModelQDef
positionGQD forall a. Maybe a
Nothing String
"positionGDD" []

positionGQD :: ModelQDef
positionGQD :: ModelQDef
positionGQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
velocity ModelExpr
positionGEqn

positionGEqn :: ModelExpr
positionGEqn :: ModelExpr
positionGEqn = forall r c. (ModelExprC r, HasUID c, HasSymbol c) => r -> c -> r
deriv (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
position) UnitalChunk
time

-------------------------------------------------
-- Position in X Direction in the First Object --
-------------------------------------------------
positionXDD_1 :: DataDefinition
positionXDD_1 :: DataDefinition
positionXDD_1 = SimpleQDef
-> Maybe Derivation -> String -> [Sentence] -> DataDefinition
ddENoRefs SimpleQDef
positionXQD_1 forall a. Maybe a
Nothing String
"positionXDD1" [Sentence
positionXRef_1, Sentence
positionXFigRef_1]

positionXQD_1 :: SimpleQDef
positionXQD_1 :: SimpleQDef
positionXQD_1 = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
xPos_1 PExpr
positionXEqn_1

positionXEqn_1 :: PExpr
positionXEqn_1 :: PExpr
positionXEqn_1 = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
lenRod_1 forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
sin (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pendDisAngle_1)

positionXFigRef_1 :: Sentence
positionXFigRef_1 :: Sentence
positionXFigRef_1 = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
xPos_1 Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"shown in" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figMotion

positionXRef_1 :: Sentence
positionXRef_1 :: Sentence
positionXRef_1 = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
xPos_1 Sentence -> Sentence -> Sentence
`S.isThe` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
horizontalPos

------------------------------------------------
-- Position in Y Dirction in the First Object --
------------------------------------------------
positionYDD_1 :: DataDefinition
positionYDD_1 :: DataDefinition
positionYDD_1 = SimpleQDef
-> Maybe Derivation -> String -> [Sentence] -> DataDefinition
ddENoRefs SimpleQDef
positionYQD_1 forall a. Maybe a
Nothing String
"positionYDD1" [Sentence
positionYRef_1, Sentence
positionYFigRef_1]

positionYQD_1 :: SimpleQDef
positionYQD_1 :: SimpleQDef
positionYQD_1 = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
yPos_1 PExpr
positionYEqn_1

positionYEqn_1 :: PExpr
positionYEqn_1 :: PExpr
positionYEqn_1 = forall r. ExprC r => r -> r
neg (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
lenRod_1 forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
cos (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pendDisAngle_1))

positionYFigRef_1 :: Sentence
positionYFigRef_1 :: Sentence
positionYFigRef_1 = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
yPos_1 Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"shown in" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figMotion

positionYRef_1 :: Sentence
positionYRef_1 :: Sentence
positionYRef_1 = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
yPos_1 Sentence -> Sentence -> Sentence
`S.isThe` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
verticalPos

-----------------------------------------------
-- Position in X Dirction in the Second Object--
-----------------------------------------------
positionXDD_2 :: DataDefinition
positionXDD_2 :: DataDefinition
positionXDD_2 = SimpleQDef
-> Maybe Derivation -> String -> [Sentence] -> DataDefinition
ddENoRefs SimpleQDef
positionXQD_2 forall a. Maybe a
Nothing String
"positionXDD2" [Sentence
positionXRef_2, Sentence
positionXFigRef_2]

positionXQD_2 :: SimpleQDef
positionXQD_2 :: SimpleQDef
positionXQD_2 = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
xPos_2 PExpr
positionXEqn_2

positionXEqn_2 :: PExpr
positionXEqn_2 :: PExpr
positionXEqn_2 = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy (DataDefinition
positionXDD_1 forall s a. s -> Getting a s a -> a
^. forall d. DefinesQuantity d => Getter d QuantityDict
defLhs) forall r. ExprC r => r -> r -> r
`addRe` (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
lenRod_2 forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
sin (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pendDisAngle_2))

positionXFigRef_2 :: Sentence
positionXFigRef_2 :: Sentence
positionXFigRef_2 = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
xPos_2 Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"shown in" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figMotion

positionXRef_2 :: Sentence
positionXRef_2 :: Sentence
positionXRef_2 = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
xPos_2 Sentence -> Sentence -> Sentence
`S.isThe` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
horizontalPos

-----------------------------------------------
-- Position in Y Dirction in the Second Object--
-----------------------------------------------
positionYDD_2 :: DataDefinition
positionYDD_2 :: DataDefinition
positionYDD_2 = SimpleQDef
-> Maybe Derivation -> String -> [Sentence] -> DataDefinition
ddENoRefs SimpleQDef
positionYQD_2 forall a. Maybe a
Nothing String
"positionYDD2" [Sentence
positionYRef_2, Sentence
positionYFigRef_2]

positionYQD_2 :: SimpleQDef
positionYQD_2 :: SimpleQDef
positionYQD_2 = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
yPos_2 PExpr
positionYEqn_2

positionYEqn_2 :: PExpr
positionYEqn_2 :: PExpr
positionYEqn_2 = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy (DataDefinition
positionYDD_1 forall s a. s -> Getting a s a -> a
^. forall d. DefinesQuantity d => Getter d QuantityDict
defLhs) forall r. ExprC r => r -> r -> r
`addRe` forall r. ExprC r => r -> r
neg (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
lenRod_2 forall r. ExprC r => r -> r -> r
`mulRe` forall r. ExprC r => r -> r
cos (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
pendDisAngle_2))

positionYFigRef_2 :: Sentence
positionYFigRef_2 :: Sentence
positionYFigRef_2 = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
yPos_2 Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"shown in" Sentence -> Sentence -> Sentence
+:+. forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS LabelledContent
figMotion

positionYRef_2 :: Sentence
positionYRef_2 :: Sentence
positionYRef_2 = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
yPos_2 Sentence -> Sentence -> Sentence
`S.isThe` forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
verticalPos

---------------------------
-- Accleartion in General--
---------------------------
accelGDD :: DataDefinition
accelGDD :: DataDefinition
accelGDD = ModelQDef
-> Maybe Derivation -> String -> [Sentence] -> DataDefinition
ddMENoRefs ModelQDef
accelGQD forall a. Maybe a
Nothing String
"accelerationGDD" []

accelGQD :: ModelQDef
accelGQD :: ModelQDef
accelGQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
acceleration ModelExpr
accelGEqn

accelGEqn :: ModelExpr
accelGEqn :: ModelExpr
accelGEqn = forall r c. (ModelExprC r, HasUID c, HasSymbol c) => r -> c -> r
deriv (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
velocity) UnitalChunk
time 

---------------------------
-- Force in General--
---------------------------
forceGDD :: DataDefinition
forceGDD :: DataDefinition
forceGDD = SimpleQDef
-> Maybe Derivation -> String -> [Sentence] -> DataDefinition
ddENoRefs SimpleQDef
forceGQD forall a. Maybe a
Nothing String
"forceGDD" []

forceGQD :: SimpleQDef
forceGQD :: SimpleQDef
forceGQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
force PExpr
forceGEqn

forceGEqn :: PExpr
forceGEqn :: PExpr
forceGEqn = forall r. ExprC r => r -> r -> r
vScale (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
mass) (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
acceleration)