module Drasil.Projectile.Lesson.Example where

import Data.Drasil.Concepts.Physics (velocity, height, time, acceleration, gravity, horizontalMotion)
import qualified Data.Drasil.Quantities.Physics as QP (height, gravitationalAccel)
import Data.Drasil.Units.Physics (velU)
import Drasil.Document.Contents (unlbldCode, foldlSP_)
import Language.Drasil.ShortHands (cR, lG)
import Language.Drasil
import qualified Language.Drasil.Sentence.Combinators as S

exampleContent :: [Contents]
exampleContent :: [Contents]
exampleContent = [Contents
exampleContextP1, Contents
codeC1, Contents
exampleContextP2, Contents
codeC2, Contents
exampleContextP3, Contents
codeC3]

exampleContextP1, exampleContextP2, exampleContextP3 :: Contents
exampleContextP1 :: Contents
exampleContextP1 = [Sentence] -> Contents
foldlSP_ [String -> Sentence
S String
"A sack slides off the ramp" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"shown in Figure.",
    String -> Sentence
S String
"We can ignore the physics" Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"sack sliding down the ramp and just focus on its exit", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
velocity Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"from the ramp",
    String -> Sentence
S String
"There is initially no vertical component" Sentence -> Sentence -> Sentence
`S.of_` ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
velocity Sentence -> Sentence -> Sentence
`S.andThe` String -> Sentence
S String
"horizontal", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
velocity, String -> Sentence
S String
"is:"]
exampleContextP2 :: Contents
exampleContextP2 = [Sentence] -> Contents
foldlSP_ [String -> Sentence
S String
"The", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
height Sentence -> Sentence -> Sentence
`S.ofThe` String -> Sentence
S String
"ramp from the floor is"]
exampleContextP3 :: Contents
exampleContextP3 = [Sentence] -> Contents
foldlSP_ [String -> Sentence
S String
"Task: Determine the", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
time, String -> Sentence
S String
"needed for the sack to strike the floor and the range",
    Symbol -> Sentence
P Symbol
cR Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"where sacks begin to pile up",
    String -> Sentence
S String
"The", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
acceleration, String -> Sentence
S String
"due to", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
gravity, Symbol -> Sentence
P Symbol
lG Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"is assumed to have the following value"]

codeC1, codeC2, codeC3 :: Contents
codeC1 :: Contents
codeC1 = Expr -> Contents
unlbldCode (UnitalChunk -> Expr
forall c. (HasUID c, HasSymbol c) => c -> Expr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
horiz_velo Expr -> Expr -> Expr
forall r. ExprC r => r -> r -> r
$= Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
17)
codeC2 :: Contents
codeC2 = Expr -> Contents
unlbldCode (UnitalChunk -> Expr
forall c. (HasUID c, HasSymbol c) => c -> Expr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.height Expr -> Expr -> Expr
forall r. ExprC r => r -> r -> r
$= Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
6)
codeC3 :: Contents
codeC3 = Expr -> Contents
unlbldCode (UnitalChunk -> Expr
forall c. (HasUID c, HasSymbol c) => c -> Expr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
QP.gravitationalAccel Expr -> Expr -> Expr
forall r. ExprC r => r -> r -> r
$= Double -> Expr
forall r. LiteralC r => Double -> r
dbl Double
9.81)

horiz_velo :: UnitalChunk
horiz_velo :: UnitalChunk
horiz_velo = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc ConceptChunk
horizontalMotion (String -> Symbol
variable String
"horiz_velo") Space
Real UnitDefn
velU