module Drasil.Projectile.Lesson.Analysis where

import qualified Drasil.DocLang.Notebook as NB (coorSyst, kinematic, hormotion, vermotion)

import Data.Drasil.Concepts.Documentation (coordinate)
import Data.Drasil.Concepts.Math (component, direction, equation)
import Data.Drasil.Concepts.Physics (acceleration, gravity, velocity, position, motion)

import qualified Data.Drasil.Quantities.Physics as QP (yVel)

import Drasil.Projectile.Concepts (projectile)
import Language.Drasil
import Language.Drasil.ShortHands

import qualified Language.Drasil.Sentence.Combinators as S

import Drasil.Projectile.Derivations (horMotionEqn1, horMotionEqn2)

coorSyst, kinematicEq, horMotionAna, verMotionAna :: Section
coorSyst :: Section
coorSyst = [Contents] -> [Section] -> Section
NB.coorSyst [Contents
coorSystContext] []
kinematicEq :: Section
kinematicEq = [Contents] -> [Section] -> Section
NB.kinematic [Contents
kinematicContext] []
horMotionAna :: Section
horMotionAna = [Contents] -> [Section] -> Section
NB.hormotion [Contents
horMotionContext] []
verMotionAna :: Section
verMotionAna = [Contents] -> [Section] -> Section
NB.vermotion [Contents
verMotionContext] []

coorSystContext, kinematicContext, horMotionContext, verMotionContext :: Contents
coorSystContext :: Contents
coorSystContext = [Sentence] -> Contents
enumBulletU ([Sentence] -> Contents) -> [Sentence] -> Contents
forall a b. (a -> b) -> a -> b
$ ([Sentence] -> Sentence) -> [[Sentence]] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent 
  [[String -> Sentence
S "Establish the fixed", Symbol -> Sentence
P Symbol
lX Sentence -> Sentence -> Sentence
`sC` Symbol -> Sentence
P Symbol
lY, NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
coordinate Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S "axes and sketch the trajectory of the particle",
    String -> Sentence
S "Between any *two points* on the path specify the given problem data and the *three unknowns*.",
    String -> Sentence
S "In all cases the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
acceleration Sentence -> Sentence -> Sentence
`S.of_` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
gravity Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S "acts downward",
    String -> Sentence
S "The particle's initial and final", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
velocity Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "should be represented in terms of their",
    Symbol -> Sentence
P Symbol
lX Sentence -> Sentence -> Sentence
`S.and_` Symbol -> Sentence
P Symbol
lY, ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
component],
  [String -> Sentence
S "Remember that positive and negative", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
position Sentence -> Sentence -> Sentence
`sC` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
velocity, String -> Sentence
S "," Sentence -> Sentence -> Sentence
`S.and_`
    ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
acceleration, ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
component Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "always act in accordance with their associated",
    NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
coordinate Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
direction],
  [String -> Sentence
S "The two points that are selected should be significant points where something about the",
    ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
motion Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S "particle is known. Potential significant points include the initial point",
    String -> Sentence
S "of launching the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
projectile Sentence -> Sentence -> Sentence
`S.andThe` String -> Sentence
S "final point where it lands." Sentence -> Sentence -> Sentence
+:+ 
    String -> Sentence
S "The landing point often has a known", Symbol -> Sentence
P Symbol
lY Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "value"]]

kinematicContext :: Contents
kinematicContext = [Sentence] -> Contents
enumBulletU ([Sentence] -> Contents) -> [Sentence] -> Contents
forall a b. (a -> b) -> a -> b
$ ([Sentence] -> Sentence) -> [[Sentence]] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent 
  [[String -> Sentence
S "Depending upon the known data and what is to be determined, a choice should be made",
    String -> Sentence
S "as to which three of the following four", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
equation, String -> Sentence
S "should be applied between",
    String -> Sentence
S "the two points on the path to obtain the most direct solution to the problem"]]

horMotionContext :: Contents
horMotionContext = [Sentence] -> Contents
enumBulletU ([Sentence] -> Contents) -> [Sentence] -> Contents
forall a b. (a -> b) -> a -> b
$ ([Sentence] -> Sentence) -> [[Sentence]] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent 
  [[String -> Sentence
S "The *velocity* in the horizontal" Sentence -> Sentence -> Sentence
`S.or_` Symbol -> Sentence
P Symbol
lX, ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
direction, String -> Sentence
S "is *constant*, i.e.,", 
    ModelExpr -> Sentence
eS ModelExpr
horMotionEqn1 Sentence -> Sentence -> Sentence
`S.and_` ModelExpr -> Sentence
eS ModelExpr
horMotionEqn2]]

verMotionContext :: Contents
verMotionContext = [Sentence] -> Contents
enumBulletU ([Sentence] -> Contents) -> [Sentence] -> Contents
forall a b. (a -> b) -> a -> b
$ ([Sentence] -> Sentence) -> [[Sentence]] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent
  [[String -> Sentence
S "In the vertical" Sentence -> Sentence -> Sentence
`S.or_` Symbol -> Sentence
P Symbol
lY, ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
direction, 
    String -> Sentence
S "*only two* of the following three equations can be used for solution"],
   [String -> Sentence
S "For example, if the particle's final", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
velocity Sentence -> Sentence -> Sentence
+:+ ModelExpr -> Sentence
eS (UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.yVel),
    String -> Sentence
S "is not needed, then the first and third of these questions", Sentence -> Sentence
sParen (String -> Sentence
S "for" Sentence -> Sentence -> Sentence
+:+ Symbol -> Sentence
P Symbol
lY),
    String -> Sentence
S "will not be useful"]]