module Drasil.GlassBR.Figures where

import Control.Lens((^.))

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

import Data.Drasil.Concepts.Documentation (assumption, item, physicalSystem,
  requirement, section_, sysCont, traceyMatrix)

import Drasil.GlassBR.Concepts (aR, stdOffDist)
import Drasil.GlassBR.Unitals (aspectRatio, charWeight, demand, demandq,
  dimlessLoad, lateralLoad, sD, stressDistFac)

resourcePath :: String
resourcePath :: String
resourcePath = String
"../../../../datafiles/glassbr/"

sysCtxFig, physSystFig, traceItemSecsFig, traceReqsItemsFig, traceAssumpsOthersFig, demandVsSDFig, dimlessloadVsARFig :: LabelledContent

sysCtxFig :: LabelledContent
sysCtxFig = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeFigRef String
"sysCtxDiag") forall a b. (a -> b) -> a -> b
$ 
  Sentence -> String -> RawContent
fig (forall n. NamedIdea n => n -> Sentence
titleize IdeaDict
sysCont) (String
resourcePath forall a. [a] -> [a] -> [a]
++ String
"SystemContextFigure.png") 

physSystFig :: LabelledContent
physSystFig = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeFigRef String
"physSystImage") forall a b. (a -> b) -> a -> b
$ Sentence -> String -> MaxWidthPercent -> RawContent
figWithWidth 
  (forall n. NounPhrase n => n -> Sentence
atStartNP forall a b. (a -> b) -> a -> b
$ forall t. NamedIdea t => t -> NP
the IdeaDict
physicalSystem) (String
resourcePath forall a. [a] -> [a] -> [a]
++ String
"physicalsystimage.png") MaxWidthPercent
30

traceItemSecsFig :: LabelledContent
traceItemSecsFig = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeFigRef String
"TraceyItemSecs") forall a b. (a -> b) -> a -> b
$ Sentence -> String -> RawContent
fig (forall c. NamedIdea c => c -> Sentence -> Sentence
showingCxnBw IdeaDict
traceyMatrix forall a b. (a -> b) -> a -> b
$
  forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
item Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"of Different" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
section_)
  (String
resourcePath forall a. [a] -> [a] -> [a]
++ String
"Trace.png")

traceReqsItemsFig :: LabelledContent
traceReqsItemsFig = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeFigRef String
"TraceyReqsItems") forall a b. (a -> b) -> a -> b
$ Sentence -> String -> RawContent
fig (forall c. NamedIdea c => c -> Sentence -> Sentence
showingCxnBw IdeaDict
traceyMatrix forall a b. (a -> b) -> a -> b
$
  forall n. NamedIdea n => n -> Sentence
titleize' CI
requirement Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"Other" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
item)
  (String
resourcePath forall a. [a] -> [a] -> [a]
++ String
"RTrace.png")

traceAssumpsOthersFig :: LabelledContent
traceAssumpsOthersFig = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeFigRef String
"TraceyAssumpsOthers") forall a b. (a -> b) -> a -> b
$ Sentence -> String -> RawContent
fig (forall c. NamedIdea c => c -> Sentence -> Sentence
showingCxnBw IdeaDict
traceyMatrix forall a b. (a -> b) -> a -> b
$
  forall n. NamedIdea n => n -> Sentence
titleize' CI
assumption Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"Other" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
item)
  (String
resourcePath forall a. [a] -> [a] -> [a]
++ String
"ATrace.png")

demandVsSDFig :: LabelledContent
demandVsSDFig = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeFigRef String
"demandVSsod") forall a b. (a -> b) -> a -> b
$ Sentence -> String -> RawContent
fig ((ConceptChunk
demandq forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn) Sentence -> Sentence -> Sentence
+:+
  Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
demand) Sentence -> Sentence -> Sentence
`S.versus` forall n. NamedIdea n => n -> Sentence
atStart ConceptChunk
sD Sentence -> Sentence -> Sentence
+:+ Sentence -> Sentence
sParen (CI -> Sentence
getAcc CI
stdOffDist)
  Sentence -> Sentence -> Sentence
`S.versus` forall n. NamedIdea n => n -> Sentence
atStart UncertQ
charWeight Sentence -> Sentence -> Sentence
+:+ Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UncertQ
charWeight))
  (String
resourcePath forall a. [a] -> [a] -> [a]
++ String
"ASTM_F2248-09.png")

dimlessloadVsARFig :: LabelledContent
dimlessloadVsARFig = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeFigRef String
"dimlessloadVSaspect") forall a b. (a -> b) -> a -> b
$ Sentence -> String -> RawContent
fig (String -> Sentence
S String
"Non dimensional" Sentence -> Sentence -> Sentence
+:+
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
lateralLoad Sentence -> Sentence -> Sentence
+:+ Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch QuantityDict
dimlessLoad)
  Sentence -> Sentence -> Sentence
`S.versus` forall n. NamedIdea n => n -> Sentence
titleize UncertQ
aspectRatio Sentence -> Sentence -> Sentence
+:+ Sentence -> Sentence
sParen (CI -> Sentence
getAcc CI
aR)
  Sentence -> Sentence -> Sentence
`S.versus` forall n. NamedIdea n => n -> Sentence
atStart ConstrainedChunk
stressDistFac Sentence -> Sentence -> Sentence
+:+ Sentence -> Sentence
sParen (forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch ConstrainedChunk
stressDistFac))
  (String
resourcePath forall a. [a] -> [a] -> [a]
++ String
"ASTM_F2248-09_BeasonEtAl.png")