{-# 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 Linear
    ( V3(..)
    )
import Vis
    ( VisObject(..)
    , Color
    , Euler(..)
    )
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 :: Vec -> V3 Double
v3FromVec Vec
v = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
x Double
y Double
z
    where
      x :: Double
x = Vec -> Double
xComp Vec
v
      y :: Double
y = Vec -> Double
yComp Vec
v
      z :: Double
z = Vec -> Double
zComp Vec
v

-- | Make a 'V3' object from a 'Position'.
v3FromPos :: Position -> V3 Double
v3FromPos :: Position -> V3 Double
v3FromPos Position
r = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
x Double
y Double
z
    where
      (Double
x,Double
y,Double
z) = Position -> (Double, Double, Double)
cartesianCoordinates Position
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 :: Color -> Double -> [Position] -> VectorField -> VisObject Double
displayVectorField Color
col Double
unitsPerMeter [Position]
samplePts VectorField
field
    = [VisObject Double] -> VisObject Double
forall a. [VisObject a] -> VisObject a
VisObjects [V3 Double -> VisObject Double -> VisObject Double
forall a. V3 a -> VisObject a -> VisObject a
Trans (Position -> V3 Double
v3FromPos Position
r) (VisObject Double -> VisObject Double)
-> VisObject Double -> VisObject Double
forall a b. (a -> b) -> a -> b
$ Color -> Vec -> VisObject Double
visVec Color
col (Vec
e Vec -> Double -> Vec
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ Double
unitsPerMeter) | Position
r <- [Position]
samplePts, let e :: Vec
e = VectorField
field Position
r]

-- | A displayable VisObject for a curve.
curveObject :: Color -> Curve -> VisObject Double
curveObject :: Color -> Curve -> VisObject Double
curveObject Color
color (Curve Double -> Position
f Double
a Double
b)
    = Maybe Double -> [(V3 Double, Color)] -> VisObject Double
forall a. Maybe a -> [(V3 a, Color)] -> VisObject a
Line' Maybe Double
forall a. Maybe a
Nothing [(Position -> V3 Double
v3FromPos (Double -> Position
f Double
t), Color
color) | Double
t <- [Double
a,Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
+(Double
bDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
a)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1000..Double
b]]

-- | Place a vector at a particular position.
oneVector :: Color -> Position -> Vec -> VisObject Double
oneVector :: Color -> Position -> Vec -> VisObject Double
oneVector Color
c Position
r Vec
v = V3 Double -> VisObject Double -> VisObject Double
forall a. V3 a -> VisObject a -> VisObject a
Trans (Position -> V3 Double
v3FromPos Position
r) (VisObject Double -> VisObject Double)
-> VisObject Double -> VisObject Double
forall a b. (a -> b) -> a -> b
$ Color -> Vec -> VisObject Double
visVec Color
c Vec
v

data Cart = Cart Double Double Double
            deriving (Int -> Cart -> ShowS
[Cart] -> ShowS
Cart -> String
(Int -> Cart -> ShowS)
-> (Cart -> String) -> ([Cart] -> ShowS) -> Show Cart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cart -> ShowS
showsPrec :: Int -> Cart -> ShowS
$cshow :: Cart -> String
show :: Cart -> String
$cshowList :: [Cart] -> ShowS
showList :: [Cart] -> ShowS
Show)

data Sph = Sph Double Double Double
           deriving (Int -> Sph -> ShowS
[Sph] -> ShowS
Sph -> String
(Int -> Sph -> ShowS)
-> (Sph -> String) -> ([Sph] -> ShowS) -> Show Sph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sph -> ShowS
showsPrec :: Int -> Sph -> ShowS
$cshow :: Sph -> String
show :: Sph -> String
$cshowList :: [Sph] -> ShowS
showList :: [Sph] -> ShowS
Show)

sphericalCoords :: Cart -> Sph
sphericalCoords :: Cart -> Sph
sphericalCoords (Cart Double
x Double
y Double
z) = Double -> Double -> Double -> Sph
Sph Double
r Double
theta Double
phi
    where
      r :: Double
r     = Double -> Double
forall a. Floating a => a -> a
sqrt (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
zDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
z)
      s :: Double
s     = Double -> Double
forall a. Floating a => a -> a
sqrt (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y)
      theta :: Double
theta = Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 Double
s Double
z
      phi :: Double
phi   = Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 Double
y Double
x

-- | A VisObject arrow from a vector
visVec :: Color -> Vec -> VisObject Double
visVec :: Color -> Vec -> VisObject Double
visVec Color
c Vec
v = Double -> VisObject Double -> VisObject Double
rotZ Double
phi (VisObject Double -> VisObject Double)
-> VisObject Double -> VisObject Double
forall a b. (a -> b) -> a -> b
$ Double -> VisObject Double -> VisObject Double
rotY Double
theta (VisObject Double -> VisObject Double)
-> VisObject Double -> VisObject Double
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> V3 Double -> Color -> VisObject Double
forall a. (a, a) -> V3 a -> Color -> VisObject a
Arrow (Double
r,Double
20Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
r) (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
0 Double
0 Double
1) Color
c
    where
      x :: Double
x = Vec -> Double
xComp Vec
v
      y :: Double
y = Vec -> Double
yComp Vec
v
      z :: Double
z = Vec -> Double
zComp Vec
v
      Sph Double
r Double
theta Double
phi = Cart -> Sph
sphericalCoords (Double -> Double -> Double -> Cart
Cart Double
x Double
y Double
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 :: Double -> VisObject Double -> VisObject Double
rotY Double
alpha = Euler Double -> VisObject Double -> VisObject Double
forall a. Euler a -> VisObject a -> VisObject a
RotEulerRad (Double -> Double -> Double -> Euler Double
forall a. a -> a -> a -> Euler a
Euler Double
0 Double
alpha Double
0)

rotZ :: Double  -- ^ in radians
     -> VisObject Double
     -> VisObject Double
rotZ :: Double -> VisObject Double -> VisObject Double
rotZ Double
alpha = Euler Double -> VisObject Double -> VisObject Double
forall a. Euler a -> VisObject a -> VisObject a
RotEulerRad (Double -> Double -> Double -> Euler Double
forall a. a -> a -> a -> Euler a
Euler Double
alpha Double
0 Double
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
-}