{-# LANGUAGE PostfixOperators #-}
module Drasil.GamePhysics.Changes (likelyChgs, unlikelyChgs) where

--A list of likely and unlikely changes for GamePhysics

import Language.Drasil
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.Concepts.Documentation as Doc (library, likeChgDom, unlikeChgDom)
import qualified Data.Drasil.Concepts.Math as CM (ode, constraint)
import Data.Drasil.Concepts.Computation (algorithm)
import qualified Data.Drasil.Concepts.Physics as CP (collision, damping, joint)

import Drasil.GamePhysics.Assumptions (assumpCT, assumpDI, assumpCAJI)

---------------------
--  LIKELY CHANGES --
---------------------

likelyChangesStmt1, likelyChangesStmt2, likelyChangesStmt3,
  likelyChangesStmt4 :: Sentence

--these statements look like they could be parametrized
likelyChangesStmt1 :: Sentence
likelyChangesStmt1 = (String -> Sentence
S "internal" Sentence -> Sentence -> Sentence
+:+ CI -> Sentence
getAcc CI
CM.ode Sentence -> Sentence -> Sentence
:+:
  String -> Sentence
S "-solving" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
algorithm Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "used by the" Sentence -> Sentence -> Sentence
+:+
  NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
library) Sentence -> Sentence -> Sentence
`maybeChanged` String -> Sentence
S "in the future"

likelyChangesStmt2 :: Sentence
likelyChangesStmt2 = ConceptInstance -> Sentence -> Sentence
forall x.
(HasShortName x, Referable x) =>
x -> Sentence -> Sentence
chgsStart ConceptInstance
assumpCT (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
library Sentence -> Sentence -> Sentence
`maybeExpanded`
  (String -> Sentence
S "to deal with edge-to-edge and vertex-to-vertex" Sentence -> Sentence -> Sentence
+:+
  ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
CP.collision)

likelyChangesStmt3 :: Sentence
likelyChangesStmt3 = ConceptInstance -> Sentence -> Sentence
forall x.
(HasShortName x, Referable x) =>
x -> Sentence -> Sentence
chgsStart ConceptInstance
assumpDI (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
library Sentence -> Sentence -> Sentence
`maybeExpanded` (
  String -> Sentence
S "to include motion with" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CP.damping)

likelyChangesStmt4 :: Sentence
likelyChangesStmt4 = ConceptInstance -> Sentence -> Sentence
forall x.
(HasShortName x, Referable x) =>
x -> Sentence -> Sentence
chgsStart ConceptInstance
assumpCAJI (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
library Sentence -> Sentence -> Sentence
`maybeExpanded` (
  String -> Sentence
S "to include" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
CP.joint Sentence -> Sentence -> Sentence
`S.and_` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
CM.constraint)

lcVODES, lcEC, lcID, lcIJC :: ConceptInstance

lcVODES :: ConceptInstance
lcVODES = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "lcVODES" Sentence
likelyChangesStmt1 "Variable-ODE-Solver" ConceptChunk
likeChgDom
lcEC :: ConceptInstance
lcEC = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "lcEC" Sentence
likelyChangesStmt2 "Expanded-Collisions" ConceptChunk
likeChgDom
lcID :: ConceptInstance
lcID = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "lcID" Sentence
likelyChangesStmt3 "Include-Dampening" ConceptChunk
likeChgDom
lcIJC :: ConceptInstance
lcIJC = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "lcIJC" Sentence
likelyChangesStmt4 "Include-Joints-Constraints" ConceptChunk
likeChgDom

likelyChgs :: [ConceptInstance]
likelyChgs :: [ConceptInstance]
likelyChgs = [ConceptInstance
lcVODES, ConceptInstance
lcEC, ConceptInstance
lcID, ConceptInstance
lcIJC]

--------------------------------
--UNLIKELY CHANGES --
--------------------------------

unlikelyChangesStmt1, unlikelyChangesStmt2, unlikelyChangesStmt3, unlikelyChangesStmt4 :: Sentence

unlikelyChangesStmt1 :: Sentence
unlikelyChangesStmt1 = (String -> Sentence
S "The goal of the system is to simulate the interactions of rigid bodies" Sentence -> Sentence
!.)
unlikelyChangesStmt2 :: Sentence
unlikelyChangesStmt2 = (String -> Sentence
S "There will always be a source of input data external to the software" Sentence -> Sentence
!.)
unlikelyChangesStmt3 :: Sentence
unlikelyChangesStmt3 = (String -> Sentence
S "A Cartesian Coordinate system is used" Sentence -> Sentence
!.)
unlikelyChangesStmt4 :: Sentence
unlikelyChangesStmt4 = (String -> Sentence
S "All objects are rigid bodies" Sentence -> Sentence
!.)

ucSRB, ucEI, ucCCS, ucORB :: ConceptInstance

ucSRB :: ConceptInstance
ucSRB = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "ucSRB" Sentence
unlikelyChangesStmt1 "Simulate-Rigid-Bodies" ConceptChunk
unlikeChgDom
ucEI :: ConceptInstance
ucEI = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "ucEI" Sentence
unlikelyChangesStmt2 "External-Input" ConceptChunk
unlikeChgDom
ucCCS :: ConceptInstance
ucCCS = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "ucCCS" Sentence
unlikelyChangesStmt3 "Cartesian-Coordinate-System" ConceptChunk
unlikeChgDom
ucORB :: ConceptInstance
ucORB = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic "ucORB" Sentence
unlikelyChangesStmt4 "Objects-Rigid-Bodies" ConceptChunk
unlikeChgDom
  
unlikelyChgs :: [ConceptInstance]
unlikelyChgs :: [ConceptInstance]
unlikelyChgs = [ConceptInstance
ucSRB, ConceptInstance
ucEI, ConceptInstance
ucCCS, ConceptInstance
ucORB]