module Drasil.Projectile.Concepts where

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

import Data.Drasil.Concepts.Documentation (constant)
import Data.Drasil.Concepts.Math (angle)
import Data.Drasil.Concepts.Physics (position, speed, motion, distance, iSpeed, time,
  rectilinear, velocity, acceleration)

concepts :: [IdeaDict]
concepts :: [IdeaDict]
concepts = NamedChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw NamedChunk
projMotion IdeaDict -> [IdeaDict] -> [IdeaDict]
forall a. a -> [a] -> [a]
: (NamedChunk -> IdeaDict) -> [NamedChunk] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map NamedChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [NamedChunk
landingPosNC, NamedChunk
launchNC, NamedChunk
launchAngleNC, NamedChunk
launchSpeedNC, NamedChunk
offsetNC, NamedChunk
targetPosNC,
  NamedChunk
rectVel] [IdeaDict] -> [IdeaDict] -> [IdeaDict]
forall a. [a] -> [a] -> [a]
++ (ConceptChunk -> IdeaDict) -> [ConceptChunk] -> [IdeaDict]
forall a b. (a -> b) -> [a] -> [b]
map ConceptChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw [ConceptChunk]
defs

durationNC, flightDurNC, landingPosNC, launchNC, launchAngleNC, launchSpeedNC, offsetNC, targetPosNC,
  rectVel :: NamedChunk
durationNC :: NamedChunk
durationNC   = String -> NP -> NamedChunk
nc "duration" (String -> NP
nounPhraseSP "duration")
launchNC :: NamedChunk
launchNC     = String -> NP -> NamedChunk
nc "launch"   (String -> NP
nounPhraseSP "launch")
offsetNC :: NamedChunk
offsetNC     = String -> NP -> NamedChunk
nc "offset"   (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S "distance between the" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
targetPosNC NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`andThe` NamedChunk
landingPosNC))

flightDurNC :: NamedChunk
flightDurNC   = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC (String -> NP -> NamedChunk
nc "flight"  (String -> NP
nounPhraseSP "flight" )) NamedChunk
durationNC
landingPosNC :: NamedChunk
landingPosNC  = NamedChunk -> ConceptChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC (String -> NP -> NamedChunk
nc "landing" (String -> NP
nounPhraseSP "landing")) ConceptChunk
position
launchAngleNC :: NamedChunk
launchAngleNC = NamedChunk -> ConceptChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
launchNC ConceptChunk
angle
launchSpeedNC :: NamedChunk
launchSpeedNC = NamedChunk -> ConceptChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
launchNC ConceptChunk
speed
targetPosNC :: NamedChunk
targetPosNC   = ConceptChunk -> ConceptChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC ConceptChunk
target ConceptChunk
position
rectVel :: NamedChunk
rectVel       = ConceptChunk -> ConceptChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC ConceptChunk
rectilinear ConceptChunk
velocity

projMotion :: NamedChunk
projMotion :: NamedChunk
projMotion = ConceptChunk -> ConceptChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC ConceptChunk
projectile ConceptChunk
motion
---

defs :: [ConceptChunk]
defs :: [ConceptChunk]
defs = [ConceptChunk
launcher, ConceptChunk
projectile, ConceptChunk
target, ConceptChunk
projSpeed]

launcher, projectile, target, projSpeed :: ConceptChunk
launcher :: ConceptChunk
launcher   = String -> NP -> String -> ConceptChunk
dcc "launcher"   (String -> NP
nounPhraseSP "launcher")  ("where the projectile is launched from " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                          "and the device that does the launching")
projectile :: ConceptChunk
projectile = String -> NP -> String -> ConceptChunk
dcc "projectile" (String -> NP
nounPhraseSP "projectile") "the object to be launched at the target"
target :: ConceptChunk
target     = String -> NP -> String -> ConceptChunk
dcc "target"     (String -> NP
nounPhraseSP "target")     "where the projectile should be launched to"

projSpeed :: ConceptChunk
projSpeed  = String -> NP -> Sentence -> ConceptChunk
dccWDS "projSpeed" (String -> NP
nounPhraseSP "1D speed") (String -> Sentence
S "1D speed under" Sentence -> Sentence -> Sentence
+:+ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
constant Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
acceleration)

landPos, launAngle, launSpeed, offset, targPos, flightDur :: ConceptChunk
landPos :: ConceptChunk
landPos = NamedChunk -> Sentence -> ConceptChunk
forall c. Idea c => c -> Sentence -> ConceptChunk
cc' NamedChunk
landingPosNC
  ([Sentence] -> Sentence
foldlSent_ [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
distance) Sentence -> Sentence -> Sentence
`S.fromThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
launcher Sentence -> Sentence -> Sentence
`S.toThe`
            String -> Sentence
S "final", NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
position ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` ConceptChunk
projectile)])

launAngle :: ConceptChunk
launAngle = NamedChunk -> Sentence -> ConceptChunk
forall c. Idea c => c -> Sentence -> ConceptChunk
cc' NamedChunk
launchAngleNC
  ([Sentence] -> Sentence
foldlSent_ [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
angle), String -> Sentence
S "between the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
launcher Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S "a straight line"
             Sentence -> Sentence -> Sentence
`S.fromThe` NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
launcher ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`toThe` ConceptChunk
target)])

launSpeed :: ConceptChunk
launSpeed = NamedChunk -> Sentence -> ConceptChunk
forall c. Idea c => c -> Sentence -> ConceptChunk
cc' NamedChunk
launchSpeedNC (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
iSpeed ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` ConceptChunk
projectile) Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "when launched")
offset :: ConceptChunk
offset = NamedChunk -> Sentence -> ConceptChunk
forall c. Idea c => c -> Sentence -> ConceptChunk
cc' NamedChunk
offsetNC (String -> Sentence
S "the offset between the" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
targetPosNC NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`andThe` NamedChunk
landingPosNC))
targPos :: ConceptChunk
targPos = NamedChunk -> Sentence -> ConceptChunk
forall c. Idea c => c -> Sentence -> ConceptChunk
cc' NamedChunk
targetPosNC (NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
distance) Sentence -> Sentence -> Sentence
`S.fromThe` NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
launcher ConceptChunk -> ConceptChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`toThe` ConceptChunk
target))
flightDur :: ConceptChunk
flightDur = NamedChunk -> Sentence -> ConceptChunk
forall c. Idea c => c -> Sentence -> ConceptChunk
cc' NamedChunk
flightDurNC ([Sentence] -> Sentence
foldlSent_ [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk -> NP
forall t. NamedIdea t => t -> NP
the ConceptChunk
time), String -> Sentence
S "when the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
projectile, String -> Sentence
S "lands"])