-- Assemble all of the mathematical expressions here, to promote re-use
--
-- This is supposed to always be imported qualified, since we're purposefully
-- overloading the names.
module Drasil.Projectile.Expressions where

import Prelude hiding (cos, sin)

import Language.Drasil
import qualified Data.Drasil.Quantities.Physics as QP (iSpeed,
  constAccel, xConstAccel, yConstAccel, ixPos, iyPos)
import Data.Drasil.Quantities.Physics (gravitationalAccelConst,
  ixVel, iyVel, xPos, yPos, time, iPos, scalarPos, xVel, yVel, xAccel, yAccel, position, 
  velocity, acceleration, constAccelV, speed)
import Drasil.Projectile.Unitals (launAngle, launSpeed, targPos, tol, landPos, offset)

flightDur', iyPos, yConstAccel, iSpeed :: PExpr
flightDur' :: r
flightDur' = Integer -> r
forall r. LiteralC r => Integer -> r
exactDbl 2 r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` ConstrConcept -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
launSpeed r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` r -> r
forall r. ExprC r => r -> r
sin (ConstrConcept -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
launAngle) r -> r -> r
forall r. ExprC r => r -> r -> r
$/ ConstQDef -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
gravitationalAccelConst
iyPos :: r
iyPos = Integer -> r
forall r. LiteralC r => Integer -> r
exactDbl 0                              -- launchOrigin
yConstAccel :: r
yConstAccel = r -> r
forall r. ExprC r => r -> r
neg (r -> r) -> r -> r
forall a b. (a -> b) -> a -> b
$ ConstQDef -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
gravitationalAccelConst  -- accelYGravity
iSpeed :: r
iSpeed = ConstrConcept -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
launSpeed

offset' :: PExpr
offset' :: r
offset' = ConstrConcept -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
landPos r -> r -> r
forall r. ExprC r => r -> r -> r
$- ConstrConcept -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
targPos

message :: PExpr
message :: r
message = [(r, r)] -> r
forall r. ExprC r => [(r, r)] -> r
completeCase [(r, r)
case1, (r, r)
case2, (r, r)
case3]
  where case1 :: (r, r)
case1 = (String -> r
forall r. LiteralC r => String -> r
str "The target was hit.",        r -> r
forall r. ExprC r => r -> r
abs_ (ConstrConcept -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
offset r -> r -> r
forall r. ExprC r => r -> r -> r
$/ ConstrConcept -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
targPos) r -> r -> r
forall r. ExprC r => r -> r -> r
$< ConstQDef -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
tol)
        case2 :: (r, r)
case2 = (String -> r
forall r. LiteralC r => String -> r
str "The projectile fell short.", ConstrConcept -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
offset r -> r -> r
forall r. ExprC r => r -> r -> r
$< Integer -> r
forall r. LiteralC r => Integer -> r
exactDbl 0)
        case3 :: (r, r)
case3 = (String -> r
forall r. LiteralC r => String -> r
str "The projectile went long.",  ConstrConcept -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
offset r -> r -> r
forall r. ExprC r => r -> r -> r
$> Integer -> r
forall r. LiteralC r => Integer -> r
exactDbl 0)

--
speed' :: PExpr
speed' :: r
speed' = UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.iSpeed r -> r -> r
forall r. ExprC r => r -> r -> r
`addRe` (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.constAccel r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time)

scalarPos' :: PExpr
scalarPos' :: r
scalarPos' = UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
iPos r -> r -> r
forall r. ExprC r => r -> r -> r
`addRe` (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.iSpeed r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time r -> r -> r
forall r. ExprC r => r -> r -> r
`addRe` r -> r
forall r. (ExprC r, LiteralC r) => r -> r
half (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.constAccel r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` r -> r
forall r. (ExprC r, LiteralC r) => r -> r
square (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time)))

rectNoTime :: PExpr
rectNoTime :: r
rectNoTime = r -> r
forall r. (ExprC r, LiteralC r) => r -> r
square (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
speed) r -> r -> r
forall r. ExprC r => r -> r -> r
$= r -> r
forall r. (ExprC r, LiteralC r) => r -> r
square (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.iSpeed) r -> r -> r
forall r. ExprC r => r -> r -> r
`addRe` (Integer -> r
forall r. LiteralC r => Integer -> r
exactDbl 2 r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.constAccel r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
scalarPos r -> r -> r
forall r. ExprC r => r -> r -> r
$- UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
iPos))

--
velVecExpr :: PExpr
velVecExpr :: r
velVecExpr = r -> r -> r
forall r. ExprC r => r -> r -> r
vec2D (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
ixVel r -> r -> r
forall r. ExprC r => r -> r -> r
`addRe` (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.xConstAccel r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time)) (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
iyVel r -> r -> r
forall r. ExprC r => r -> r -> r
`addRe` (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.yConstAccel r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time))

--
posVecExpr :: PExpr
posVecExpr :: r
posVecExpr = r -> r -> r
forall r. ExprC r => r -> r -> r
vec2D
              (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.ixPos r -> r -> r
forall r. ExprC r => r -> r -> r
`addRe` (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
ixVel r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time) r -> r -> r
forall r. ExprC r => r -> r -> r
`addRe` r -> r
forall r. (ExprC r, LiteralC r) => r -> r
half (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.xConstAccel r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` r -> r
forall r. (ExprC r, LiteralC r) => r -> r
square (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time)))
              (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.iyPos r -> r -> r
forall r. ExprC r => r -> r -> r
`addRe` (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
iyVel r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time) r -> r -> r
forall r. ExprC r => r -> r -> r
`addRe` r -> r
forall r. (ExprC r, LiteralC r) => r -> r
half (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.yConstAccel r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` r -> r
forall r. (ExprC r, LiteralC r) => r -> r
square (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
time)))

--
landPosExpr :: PExpr
landPosExpr :: r
landPosExpr = Integer -> r
forall r. LiteralC r => Integer -> r
exactDbl 2 r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` r -> r
forall r. (ExprC r, LiteralC r) => r -> r
square (ConstrConcept -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
launSpeed) r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` r -> r
forall r. ExprC r => r -> r
sin (ConstrConcept -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
launAngle) r -> r -> r
forall r. ExprC r => r -> r -> r
`mulRe` r -> r
forall r. ExprC r => r -> r
cos (ConstrConcept -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstrConcept
launAngle) r -> r -> r
forall r. ExprC r => r -> r -> r
$/ ConstQDef -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ConstQDef
gravitationalAccelConst

-- Helper expressions that represent the vectors of quantities as components
positionXY, velocityXY, accelerationXY, constAccelXY :: PExpr
positionXY :: r
positionXY     = UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
position     r -> r -> r
forall r. ExprC r => r -> r -> r
$= r -> r -> r
forall r. ExprC r => r -> r -> r
vec2D (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
xPos)           (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
yPos)
velocityXY :: r
velocityXY     = UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
velocity     r -> r -> r
forall r. ExprC r => r -> r -> r
$= r -> r -> r
forall r. ExprC r => r -> r -> r
vec2D (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
xVel)           (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
yVel)
accelerationXY :: r
accelerationXY = UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
acceleration r -> r -> r
forall r. ExprC r => r -> r -> r
$= r -> r -> r
forall r. ExprC r => r -> r -> r
vec2D (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
xAccel)         (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
yAccel)
constAccelXY :: r
constAccelXY   = UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
constAccelV  r -> r -> r
forall r. ExprC r => r -> r -> r
$= r -> r -> r
forall r. ExprC r => r -> r -> r
vec2D (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.xConstAccel) (UnitalChunk -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.yConstAccel)

-- Expressions for Lesson
lcrectVel, lcrectPos, lcrectNoTime :: LabelledContent
lcrectVel :: LabelledContent
lcrectVel = ModelExpr -> Reference -> LabelledContent
lbldExpr (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
speed ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$= ModelExpr
PExpr
speed') (String -> Reference
makeEqnRef "rectVel")
lcrectPos :: LabelledContent
lcrectPos = ModelExpr -> Reference -> LabelledContent
lbldExpr (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
scalarPos ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$= ModelExpr
PExpr
scalarPos') (String -> Reference
makeEqnRef "rectPos")
lcrectNoTime :: LabelledContent
lcrectNoTime = ModelExpr -> Reference -> LabelledContent
lbldExpr ModelExpr
PExpr
rectNoTime (String -> Reference
makeEqnRef "rectNoTime")

-- References --
eqnRefs :: [Reference]
eqnRefs :: [Reference]
eqnRefs = (LabelledContent -> Reference) -> [LabelledContent] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map LabelledContent -> Reference
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Reference
ref [LabelledContent
lcrectVel, LabelledContent
lcrectPos, LabelledContent
lcrectNoTime]