{-# 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 -}