learn-physics-examples-0.3: src/learn-physics-PlaneWave.hs

{-# OPTIONS_GHC -Wall #-}

module Main where

import SpatialMath
    ( Xyz(..)
    )
import Vis
    ( animate
    , VisObject(..)
    , Color
    , red
    , blue
    )
import Physics.Learn.CarrotVec
    ( Vec
    , xComp
    , yComp
    , zComp
    , vec
    , magnitude
    , (<.>)
    )

pointList :: [Double]
pointList = [-2,0,2]

-- samplePoints :: [Vec]
-- samplePoints = [vec x y z | x <- [0], y <- [0], z <- [-4,-3.6..4]]

samplePoints :: [Vec]
samplePoints = [vec x y z | x <- [-2,0,2], y <- [-2,0,2], z <- [-4,-3.6..4]]

xyzFromVec :: Vec -> Xyz Double
xyzFromVec v = Xyz x y z
    where
      x = xComp v
      y = yComp v
      z = zComp v

thinArrow :: Double -> (Xyz Double) -> Color -> VisObject Double
thinArrow l = Arrow (l,10*l)

metersPerVPM :: Double
metersPerVPM = 1

eArrows :: Double -> [VisObject Double]
eArrows t = [Trans (xyzFromVec r) $ thinArrow (metersPerVPM * magnitude e) (xyzFromVec e) blue | (r,e) <- eFields t]

eFields :: Double -> [(Vec,Vec)]
eFields t = [(r,eField r t) | r <- samplePoints]

bArrows :: Double -> [VisObject Double]
bArrows t = [Trans (xyzFromVec r) $ thinArrow (metersPerVPM * magnitude b) (xyzFromVec b) red  | (r,b) <- bFields t]

bFields :: Double -> [(Vec,Vec)]
bFields t = [(r,bField r t) | r <- samplePoints]

drawFun :: Float -> VisObject Double
drawFun time = VisObjects $ eArrows t ++ bArrows t
    where
      t = realToFrac time

c :: Double
c = 1

k :: Vec
k = vec 0 0 1

e0 :: Double
e0 = 1

eField :: Vec -> Double -> Vec
eField r t = vec (e0 * cos (k <.> r - c * magnitude k * t)) 0 0

bField :: Vec -> Double -> Vec
bField r t = vec 0 (e0 / c * cos (k <.> r - c * magnitude k * t)) 0

main :: IO ()
main = animate Nothing "Plane Wave" drawFun