{-# LANGUAGE PostfixOperators #-}
module Drasil.Projectile.Assumptions (accelYGravity, accelXZero, cartSyst,
  assumptions, constAccel, gravAccelValue, launchOrigin, pointMass, 
  posXDirection, targetXAxis, timeStartZero, twoDMotion, yAxisGravity) where

import Language.Drasil
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.NounPhrase.Combinators as NP
import qualified Language.Drasil.Sentence.Combinators as S

import qualified Drasil.DocLang.SRS as SRS (valsOfAuxCons)

import Data.Drasil.Concepts.Documentation (assumpDom, value, consVals)
import Data.Drasil.Concepts.Math (cartesian, xAxis, xDir, yAxis, yDir, direction, positive)
import Data.Drasil.Concepts.PhysicalProperties (mass)
import Data.Drasil.Concepts.Physics (acceleration, collision, distance, gravity, time, twoD)

import Drasil.Projectile.Concepts (launcher, projectile, target, projMotion)

assumptions :: [ConceptInstance]
assumptions :: [ConceptInstance]
assumptions = [ConceptInstance
twoDMotion, ConceptInstance
cartSyst, ConceptInstance
yAxisGravity, ConceptInstance
launchOrigin, ConceptInstance
targetXAxis, 
  ConceptInstance
posXDirection, ConceptInstance
constAccel, ConceptInstance
accelXZero, ConceptInstance
accelYGravity, ConceptInstance
neglectDrag, ConceptInstance
pointMass, 
  ConceptInstance
freeFlight, ConceptInstance
neglectCurv, ConceptInstance
timeStartZero, ConceptInstance
gravAccelValue]

twoDMotion, cartSyst, yAxisGravity, launchOrigin, targetXAxis,
  posXDirection, constAccel, accelXZero, accelYGravity, neglectDrag,
  pointMass, freeFlight, neglectCurv, timeStartZero, 
  gravAccelValue :: ConceptInstance
twoDMotion :: ConceptInstance
twoDMotion      = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "twoDMotion"      Sentence
twoDMotionDesc      "twoDMotion"      ConceptChunk
assumpDom
cartSyst :: ConceptInstance
cartSyst        = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "cartSyst"        Sentence
cartSystDesc        "cartSyst"        ConceptChunk
assumpDom
yAxisGravity :: ConceptInstance
yAxisGravity    = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "yAxisGravity"    Sentence
yAxisGravityDesc    "yAxisGravity"    ConceptChunk
assumpDom
launchOrigin :: ConceptInstance
launchOrigin    = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "launchOrigin"    Sentence
launchOriginDesc    "launchOrigin"    ConceptChunk
assumpDom
targetXAxis :: ConceptInstance
targetXAxis     = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "targetXAxis"     Sentence
targetXAxisDesc     "targetXAxis"     ConceptChunk
assumpDom
posXDirection :: ConceptInstance
posXDirection   = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "posXDirection"   Sentence
posXDirectionDesc   "posXDirection"   ConceptChunk
assumpDom
constAccel :: ConceptInstance
constAccel      = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "constAccel"      Sentence
constAccelDesc      "constAccel"      ConceptChunk
assumpDom
accelXZero :: ConceptInstance
accelXZero      = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "accelXZero"      Sentence
accelXZeroDesc      "accelXZero"      ConceptChunk
assumpDom
accelYGravity :: ConceptInstance
accelYGravity   = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "accelYGravity"   Sentence
accelYGravityDesc   "accelYGravity"   ConceptChunk
assumpDom
neglectDrag :: ConceptInstance
neglectDrag     = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "neglectDrag"     Sentence
neglectDragDesc     "neglectDrag"     ConceptChunk
assumpDom
pointMass :: ConceptInstance
pointMass       = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "pointMass"       Sentence
pointMassDesc       "pointMass"       ConceptChunk
assumpDom
freeFlight :: ConceptInstance
freeFlight      = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "freeFlight"      Sentence
freeFlightDesc      "freeFlight"      ConceptChunk
assumpDom
neglectCurv :: ConceptInstance
neglectCurv     = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "neglectCurv"     Sentence
neglectCurvDesc     "neglectCurv"     ConceptChunk
assumpDom
timeStartZero :: ConceptInstance
timeStartZero   = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "timeStartZero"   Sentence
timeStartZeroDesc   "timeStartZero"   ConceptChunk
assumpDom
gravAccelValue :: ConceptInstance
gravAccelValue  = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "gravAccelValue"  Sentence
gravAccelValueDesc  "gravAccelValue"  ConceptChunk
assumpDom

twoDMotionDesc :: Sentence
twoDMotionDesc :: Sentence
twoDMotionDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (NamedChunk
projMotion NamedChunk -> CI -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`is` CI
twoD)) Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
sParen (CI -> Sentence
getAcc CI
twoD)

cartSystDesc :: Sentence
cartSystDesc :: Sentence
cartSystDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall c. NamedIdea c => c -> NP
a_ ConceptChunk
cartesian) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "used" Sentence -> Sentence -> Sentence
+:+. ConceptInstance -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource ConceptInstance
neglectCurv

yAxisGravityDesc :: Sentence
yAxisGravityDesc :: Sentence
yAxisGravityDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk
direction ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
yAxis) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "directed opposite to" Sentence -> Sentence -> Sentence
+:+. ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
gravity

launchOriginDesc :: Sentence
launchOriginDesc :: Sentence
launchOriginDesc = (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall c. NamedIdea c => c -> NP
the ConceptChunk
launcher) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "coincident with the origin" Sentence -> Sentence
!.)

targetXAxisDesc :: Sentence
targetXAxisDesc :: Sentence
targetXAxisDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall c. NamedIdea c => c -> NP
the ConceptChunk
target) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "lies on the" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
xAxis Sentence -> Sentence -> Sentence
+:+. ConceptInstance -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource ConceptInstance
neglectCurv

posXDirectionDesc :: Sentence
posXDirectionDesc :: Sentence
posXDirectionDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI ConceptChunk
positive ConceptChunk
xDir)) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "from the" Sentence -> Sentence -> Sentence
+:+. NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
launcher ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`toThe` ConceptChunk
target)

constAccelDesc :: Sentence
constAccelDesc :: Sentence
constAccelDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall c. NamedIdea c => c -> NP
the ConceptChunk
acceleration) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "constant" Sentence -> Sentence -> Sentence
+:+.
                 [ConceptInstance] -> Sentence
forall r. (Referable r, HasShortName r) => [r] -> Sentence
fromSources [ConceptInstance
accelXZero, ConceptInstance
accelYGravity, ConceptInstance
neglectDrag, ConceptInstance
freeFlight]

accelXZeroDesc :: Sentence
accelXZeroDesc :: Sentence
accelXZeroDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (ConceptChunk
acceleration ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThe` ConceptChunk
xDir)) Sentence -> Sentence -> Sentence
`S.is` (String -> Sentence
S "zero" Sentence -> Sentence
!.)

accelYGravityDesc :: Sentence
accelYGravityDesc :: Sentence
accelYGravityDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (NP -> NP
NP.the (ConceptChunk
acceleration ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThe` ConceptChunk
yDir)) Sentence -> Sentence -> Sentence
`S.isThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
acceleration Sentence -> Sentence -> Sentence
+:+
                    String -> Sentence
S "due to" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
gravity Sentence -> Sentence -> Sentence
+:+. ConceptInstance -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource ConceptInstance
yAxisGravity

neglectDragDesc :: Sentence
neglectDragDesc :: Sentence
neglectDragDesc = (String -> Sentence
S "Air drag" Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "neglected" Sentence -> Sentence
!.)

pointMassDesc :: Sentence
pointMassDesc :: Sentence
pointMassDesc = (String -> Sentence
S "size" Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S "shape") Sentence -> Sentence -> Sentence
`S.the_ofTheC` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
projectile Sentence -> Sentence -> Sentence
`S.are`
                String -> Sentence
S "negligible" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "so that it can be modelled as a point" Sentence -> Sentence -> Sentence
+:+. ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
mass

freeFlightDesc :: Sentence
freeFlightDesc :: Sentence
freeFlightDesc = String -> Sentence
S "The flight" Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "free; there" Sentence -> Sentence -> Sentence
`S.are` String -> Sentence
S "no" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
collision Sentence -> Sentence -> Sentence
+:+
                 String -> Sentence
S "during" Sentence -> Sentence -> Sentence
+:+. (String -> Sentence
S "trajectory" Sentence -> Sentence -> Sentence
`S.the_ofThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
projectile)

neglectCurvDesc :: Sentence
neglectCurvDesc :: Sentence
neglectCurvDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall c. NamedIdea c => c -> NP
the ConceptChunk
distance) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "small enough that" Sentence -> Sentence -> Sentence
+:+.
                  (String -> Sentence
S "curvature" Sentence -> Sentence -> Sentence
`S.the_ofThe` String -> Sentence
S "Earth can be neglected")

timeStartZeroDesc :: Sentence
timeStartZeroDesc :: Sentence
timeStartZeroDesc = ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart ConceptChunk
time Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S "starts at zero"

gravAccelValueDesc :: Sentence
gravAccelValueDesc :: Sentence
gravAccelValueDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall c. NamedIdea c => c -> NP
the ConceptChunk
acceleration) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "due to" Sentence -> Sentence -> Sentence
+:+
  ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
gravity Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "is assumed to have the" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
value Sentence -> Sentence -> Sentence
+:+ 
  String -> Sentence
S "provided in the section for" Sentence -> Sentence -> Sentence
+:+. Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
SRS.valsOfAuxCons [] []) (NamedChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize NamedChunk
consVals)