{-# OPTIONS_GHC -Wall #-}
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
, (^/)
)
import Physics.Learn.Position
( Position
, cartesianCoordinates
, VectorField
)
import Physics.Learn.Curve
( Curve(..)
)
v3FromVec :: Vec -> V3 Double
v3FromVec :: Vec -> V3 Double
v3FromVec Vec
v = 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
v3FromPos :: Position -> V3 Double
v3FromPos :: Position -> V3 Double
v3FromPos Position
r = 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
displayVectorField :: Color
-> Double
-> [Position]
-> VectorField
-> VisObject Double
displayVectorField :: Color -> Double -> [Position] -> VectorField -> VisObject Double
displayVectorField Color
col Double
unitsPerMeter [Position]
samplePts VectorField
field
= forall a. [VisObject a] -> VisObject a
VisObjects [forall a. V3 a -> VisObject a -> VisObject a
Trans (Position -> V3 Double
v3FromPos Position
r) forall a b. (a -> b) -> a -> b
$ Color -> Vec -> VisObject Double
visVec Color
col (Vec
e 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]
curveObject :: Color -> Curve -> VisObject Double
curveObject :: Color -> Curve -> VisObject Double
curveObject Color
color (Curve Double -> Position
f Double
a Double
b)
= forall a. Maybe a -> [(V3 a, Color)] -> VisObject a
Line' forall a. Maybe a
Nothing [(Position -> V3 Double
v3FromPos (Double -> Position
f Double
t), Color
color) | Double
t <- [Double
a,Double
aforall a. Num a => a -> a -> a
+(Double
bforall a. Num a => a -> a -> a
-Double
a)forall a. Fractional a => a -> a -> a
/Double
1000..Double
b]]
oneVector :: Color -> Position -> Vec -> VisObject Double
oneVector :: Color -> Position -> Vec -> VisObject Double
oneVector Color
c Position
r Vec
v = forall a. V3 a -> VisObject a -> VisObject a
Trans (Position -> V3 Double
v3FromPos Position
r) 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cart] -> ShowS
$cshowList :: [Cart] -> ShowS
show :: Cart -> String
$cshow :: Cart -> String
showsPrec :: Int -> Cart -> ShowS
$cshowsPrec :: Int -> Cart -> ShowS
Show)
data Sph = Sph Double Double Double
deriving (Int -> Sph -> ShowS
[Sph] -> ShowS
Sph -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sph] -> ShowS
$cshowList :: [Sph] -> ShowS
show :: Sph -> String
$cshow :: Sph -> String
showsPrec :: Int -> Sph -> ShowS
$cshowsPrec :: Int -> 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 = forall a. Floating a => a -> a
sqrt (Double
xforall a. Num a => a -> a -> a
*Double
x forall a. Num a => a -> a -> a
+ Double
yforall a. Num a => a -> a -> a
*Double
y forall a. Num a => a -> a -> a
+ Double
zforall a. Num a => a -> a -> a
*Double
z)
s :: Double
s = forall a. Floating a => a -> a
sqrt (Double
xforall a. Num a => a -> a -> a
*Double
x forall a. Num a => a -> a -> a
+ Double
yforall a. Num a => a -> a -> a
*Double
y)
theta :: Double
theta = forall a. RealFloat a => a -> a -> a
atan2 Double
s Double
z
phi :: Double
phi = forall a. RealFloat a => a -> a -> a
atan2 Double
y Double
x
visVec :: Color -> Vec -> VisObject Double
visVec :: Color -> Vec -> VisObject Double
visVec Color
c Vec
v = Double -> VisObject Double -> VisObject Double
rotZ Double
phi forall a b. (a -> b) -> a -> b
$ Double -> VisObject Double -> VisObject Double
rotY Double
theta forall a b. (a -> b) -> a -> b
$ forall a. (a, a) -> V3 a -> Color -> VisObject a
Arrow (Double
r,Double
20forall a. Num a => a -> a -> a
*Double
r) (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)
rotY :: Double
-> VisObject Double
-> VisObject Double
rotY :: Double -> VisObject Double -> VisObject Double
rotY Double
alpha = forall a. Euler a -> VisObject a -> VisObject a
RotEulerRad (forall a. a -> a -> a -> Euler a
Euler Double
0 Double
alpha Double
0)
rotZ :: Double
-> VisObject Double
-> VisObject Double
rotZ :: Double -> VisObject Double -> VisObject Double
rotZ Double
alpha = forall a. Euler a -> VisObject a -> VisObject a
RotEulerRad (forall a. a -> a -> a -> Euler a
Euler Double
alpha Double
0 Double
0)