content: {-# OPTIONS_GHC -Wall #-}
  
  -- | Some tools related to the not-gloss 3D graphics and animation library.
  
  module Physics.Learn.Visual.VisTools
      ( v3FromVec
      , v3FromPos
      , visVec
      , oneVector
      , displayVectorField
      , curveObject
      )
      where
  
  import SpatialMath
      ( V3(..)
      , Euler(..)
      )
  import Vis
      ( VisObject(..)
      , Color
      )
  import Physics.Learn.CarrotVec
      ( Vec
      , xComp
      , yComp
      , zComp
  --    , magnitude
      , (^/)
      )
  import Physics.Learn.Position
      ( Position
      , cartesianCoordinates
      , VectorField
      )
  import Physics.Learn.Curve
      ( Curve(..)
      )
  
  -- | Make a 'V3' object from a 'Vec'.
  v3FromVec :: Vec -> V3 Double
  v3FromVec v = V3 x y z
      where
        x = xComp v
        y = yComp v
        z = zComp v
  
  -- | Make a 'V3' object from a 'Position'.
  v3FromPos :: Position -> V3 Double
  v3FromPos r = V3 x y z
      where
        (x,y,z) = cartesianCoordinates r
  
  -- | Display a vector field.
  displayVectorField :: Color             -- ^ color for the vector field
                     -> Double            -- ^ scale factor
                     -> [Position]        -- ^ list of positions to show the field
                     -> VectorField       -- ^ vector field to display
                     -> VisObject Double  -- ^ the displayable object
  displayVectorField col unitsPerMeter samplePts field
      = VisObjects [Trans (v3FromPos r) $ visVec col (e ^/ unitsPerMeter) | r <- samplePts, let e = field r]
  
  -- | A displayable VisObject for a curve.
  curveObject :: Color -> Curve -> VisObject Double
  curveObject color (Curve f a b)
      = Line' Nothing [(v3FromPos (f t), color) | t <- [a,a+(b-a)/1000..b]]
  
  -- | Place a vector at a particular position.
  oneVector :: Color -> Position -> Vec -> VisObject Double
  oneVector c r v = Trans (v3FromPos r) $ visVec c v
  
  data Cart = Cart Double Double Double
              deriving (Show)
  
  data Sph = Sph Double Double Double
             deriving (Show)
  
  sphericalCoords :: Cart -> Sph
  sphericalCoords (Cart x y z) = Sph r theta phi
      where
        r     = sqrt (x*x + y*y + z*z)
        s     = sqrt (x*x + y*y)
        theta = atan2 s z
        phi   = atan2 y x
  
  -- | A VisObject arrow from a vector
  visVec :: Color -> Vec -> VisObject Double
  visVec c v = rotZ phi $ rotY theta $ Arrow (r,20*r) (V3 0 0 1) c
      where
        x = xComp v
        y = yComp v
        z = zComp v
        Sph r theta phi = sphericalCoords (Cart x y z)
  
  {-
  rotX :: Double  -- ^ in radians
       -> VisObject Double
       -> VisObject Double
  rotX alpha = RotEulerRad (Euler 0 0 alpha)
  -}
  
  rotY :: Double  -- ^ in radians
       -> VisObject Double
       -> VisObject Double
  rotY alpha = RotEulerRad (Euler 0 alpha 0)
  
  rotZ :: Double  -- ^ in radians
       -> VisObject Double
       -> VisObject Double
  rotZ alpha = RotEulerRad (Euler alpha 0 0)
  
  
  {-
  adjacentDistance :: [Position] -> Double
  adjacentDistance []         = 0
  adjacentDistance rs'@(_:rs) = minimum (map magnitude $ zipWith displacement rs' rs)
  
  visVectorField :: Color -> [Position] -> VectorField -> VisObject Double
  visVectorField c rs vf = let prs = [(r,vf r) | r <- rs]
                               bigV = maximum [magnitude (snd pr) | pr <- prs]
                               disp = adjacentDistance rs
                               scaleFactor = disp / bigV
                               newPrs = [(r, scaleFactor *^ v) | (r,v) <- prs]
                               vecs = [oneVector c r v' | (r,v') <- newPrs]
                           in VisObjects vecs
  -}
  