module Drasil.PDController.IntroSection where

import Data.Drasil.Citations (smithLai2005)

import Drasil.PDController.Concepts
import Language.Drasil
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S

introPara, introPurposeOfDoc, introscopeOfReq :: Sentence
introPara :: Sentence
introPara
  = [Sentence] -> Sentence
foldlSent
      [String -> Sentence
S "Automatic process control with a controller (P/PI/PD/PID) is used",
         String -> Sentence
S "in a variety of applications such as thermostats, automobile",
         String -> Sentence
S "cruise-control, etc. The gains of a controller in an application" Sentence -> Sentence -> Sentence
+:+. 
         String -> Sentence
S "must be tuned before the controller is ready for production",
       String -> Sentence
S "Therefore a simulation of the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
pidC, String -> Sentence
S "with a",
         ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
secondOrderSystem,
         String -> Sentence
S "is created in this project that can be",
         String -> Sentence
S "used to tune the gain constants"]

introscopeOfReq :: Sentence
introscopeOfReq
  = [Sentence] -> Sentence
foldlSent_
      [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk -> NP
forall c. NamedIdea c => c -> NP
a_ ConceptChunk
pidCL),
       String -> Sentence
S "with three subsystems, namely:" Sentence -> Sentence -> Sentence
+:+.
          SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List ((ConceptChunk -> Sentence) -> [ConceptChunk] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP(NP -> Sentence)
-> (ConceptChunk -> NP) -> ConceptChunk -> Sentence
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ConceptChunk -> NP
forall c. NamedIdea c => c -> NP
a_)
           [ConceptChunk
pidC, ConceptChunk
summingPt, ConceptChunk
powerPlant]),
       String -> Sentence
S "Only the Proportional and Derivative controllers are used in this software;" Sentence -> Sentence -> Sentence
+:+.
         String -> Sentence
S "the Integral controller is beyond the scope of this project",
       String -> Sentence
S "Additionally, this software is intended to aid with the manual",
         String -> Sentence
S "tuning of the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
pidC]

introPurposeOfDoc :: Sentence
introPurposeOfDoc
  = [Sentence] -> Sentence
foldlSent
      [String -> Sentence
S "The purpose of this document is to capture all the necessary",
         String -> Sentence
S "information including assumptions, data definitions, constraints,",
         String -> Sentence
S "models, and requirements to facilitate an unambiguous development"
         Sentence -> Sentence -> Sentence
`S.ofThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
pidC, String -> Sentence
S "software and test procedures"]

introUserChar1, introUserChar2 :: [Sentence]
introUserChar1 :: [Sentence]
introUserChar1
  = [String -> Sentence
S "control systems (control theory and controllers) at the fourth-year undergraduate level"]
introUserChar2 :: [Sentence]
introUserChar2
  = [String -> Sentence
S "engineering mathematics at a second-year undergraduate level"]

introDocOrg :: Sentence
introDocOrg :: Sentence
introDocOrg
  = [Sentence] -> Sentence
foldlSent
      [String -> Sentence
S "The sections in this document are based on",
         Citation -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Citation
smithLai2005]