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")