{-# LANGUAGE PostfixOperators #-}
module Drasil.DblPend.Assumptions (twoDMotion, cartSys, cartSysR,
  yAxisDir, assumpBasic, assumpDouble) where
    
import Language.Drasil
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.Concepts.Documentation (assumpDom) 
import Data.Drasil.Concepts.Math (cartesian, xAxis, yAxis, direction, positive)
import Data.Drasil.Concepts.Physics (gravity, twoD)
import Drasil.DblPend.Concepts (pendMotion)

assumpBasic :: [ConceptInstance]
assumpBasic :: [ConceptInstance]
assumpBasic = [ConceptInstance
twoDMotion, ConceptInstance
cartSys, ConceptInstance
cartSysR, ConceptInstance
yAxisDir]

assumpDouble :: [ConceptInstance]
assumpDouble :: [ConceptInstance]
assumpDouble = [ConceptInstance]
assumpBasic

twoDMotion, cartSys, cartSysR, yAxisDir :: ConceptInstance 

twoDMotion :: ConceptInstance
twoDMotion        = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"twoDMotion"    Sentence
twoDMotionDesc          String
"twoDMotion"    ConceptChunk
assumpDom
cartSys :: ConceptInstance
cartSys           = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"cartSys"       Sentence
cartSysDesc             String
"cartSys"       ConceptChunk
assumpDom
cartSysR :: ConceptInstance
cartSysR          = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"cartSysR"      Sentence
cartSysRDesc            String
"cartSysR"      ConceptChunk
assumpDom
yAxisDir :: ConceptInstance
yAxisDir          = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"yAxisDir"      Sentence
yAxisDirDesc            String
"yAxisDir"      ConceptChunk
assumpDom

twoDMotionDesc :: Sentence
twoDMotionDesc :: Sentence
twoDMotionDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
pendMotion) Sentence -> Sentence -> Sentence
`S.is` CI -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase CI
twoD Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
sParen (CI -> Sentence
forall c. Idea c => c -> Sentence
short CI
twoD)

cartSysDesc :: Sentence
cartSysDesc :: Sentence
cartSysDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
a_ ConceptChunk
cartesian) Sentence -> Sentence -> Sentence
`S.is` (String -> Sentence
S String
"used" !.)

cartSysRDesc :: Sentence
cartSysRDesc :: Sentence
cartSysRDesc = NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
cartesian) Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S String
"right-handed where" Sentence -> Sentence -> Sentence
+:+ 
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk -> NP -> NP
forall c. NamedIdea c => c -> NP -> NP
combineNINP ConceptChunk
positive (ConceptChunk
xAxis ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` ConceptChunk
yAxis)) Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"point right up"

yAxisDirDesc :: Sentence
yAxisDirDesc :: Sentence
yAxisDirDesc = 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 String
"directed opposite to" Sentence -> Sentence -> Sentence
+:+. ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
gravity