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 = "../../../../datafiles/glassbr/"

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

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

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

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

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

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

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

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