{-# OPTIONS_GHC -Wall #-}

-- | Some tools related to the gloss 2D graphics and animation library.

module Physics.Learn.Visual.GlossTools
    ( polarToCart
    , cartToPolar
    , arrow
    , thickArrow
    )
    where

import Graphics.Gloss
import Graphics.Gloss.Geometry.Angle

-- positive x is to the right in Translate
-- positive y is up           in Translate (this is good)

basicArrow100 :: Picture
basicArrow100 :: Picture
basicArrow100 = [Picture] -> Picture
Pictures [Path -> Picture
Line [(Float
0,Float
0),(Float
100,Float
0)],Path -> Picture
Polygon [(Float
75,Float
5),(Float
100,Float
0),(Float
75,-Float
5)]]

-- | assumes radians coming in
polarToCart :: (Float,Float) -> (Float,Float)
polarToCart :: (Float, Float) -> (Float, Float)
polarToCart (Float
r,Float
theta) = (Float
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Float
theta,Float
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Float
theta)

-- | theta=0 is positive x axis,
--   output angle in radians
cartToPolar :: (Float,Float) -> (Float,Float)
cartToPolar :: (Float, Float) -> (Float, Float)
cartToPolar (Float
x,Float
y) = (forall a. Floating a => a -> a
sqrt (Float
xforall a. Floating a => a -> a -> a
**Float
2forall a. Num a => a -> a -> a
+Float
yforall a. Floating a => a -> a -> a
**Float
2),forall a. RealFloat a => a -> a -> a
atan2 Float
y Float
x)

-- | An arrow
arrow :: Point -- ^ location of base of arrow
      -> Point -- ^ displacement vector
      -> Picture
arrow :: (Float, Float) -> (Float, Float) -> Picture
arrow (Float
x,Float
y) (Float, Float)
val = Float -> Float -> Picture -> Picture
Translate Float
x Float
y forall a b. (a -> b) -> a -> b
$ (Float, Float) -> Picture
originArrow (Float, Float)
val

-- | Rotate takes its angle in degrees, and rotates clockwise.
originArrow :: Point  -- ^ displacement vector
            -> Picture
originArrow :: (Float, Float) -> Picture
originArrow (Float
x,Float
y)
    = Float -> Picture -> Picture
Rotate (-Float -> Float
radToDeg Float
theta) forall a b. (a -> b) -> a -> b
$ Float -> Float -> Picture -> Picture
Scale (Float
rforall a. Fractional a => a -> a -> a
/Float
100) (Float
rforall a. Fractional a => a -> a -> a
/Float
100) Picture
basicArrow100
      where
        (Float
r,Float
theta) = (Float, Float) -> (Float, Float)
cartToPolar (Float
x,Float
y)

basicThickArrow :: Float -> Float -> Float -> Float -> Picture
basicThickArrow :: Float -> Float -> Float -> Float -> Picture
basicThickArrow Float
l Float
w Float
headLength Float
headWidth
    = [Picture] -> Picture
Pictures [Path -> Picture
Polygon [(Float
0,Float
wforall a. Fractional a => a -> a -> a
/Float
2),(Float
lforall a. Num a => a -> a -> a
-Float
hl,Float
wforall a. Fractional a => a -> a -> a
/Float
2),(Float
lforall a. Num a => a -> a -> a
-Float
hl,-Float
wforall a. Fractional a => a -> a -> a
/Float
2),(Float
0,-Float
wforall a. Fractional a => a -> a -> a
/Float
2)]
               ,Path -> Picture
Polygon [(Float
lforall a. Num a => a -> a -> a
-Float
hl,Float
hwforall a. Fractional a => a -> a -> a
/Float
2),(Float
l,Float
0),(Float
lforall a. Num a => a -> a -> a
-Float
hl,-Float
hwforall a. Fractional a => a -> a -> a
/Float
2)]
               ]
    where
      hl :: Float
hl = forall a. Ord a => a -> a -> a
min Float
l Float
headLength
      hw :: Float
hw = forall a. Ord a => a -> a -> a
max Float
w Float
headWidth

-- | A think arrow
thickArrow :: Float -- ^ arrow thickness
           -> Point -- ^ location of base of arrow
           -> Point -- ^ displacement vector
           -> Picture
thickArrow :: Float -> (Float, Float) -> (Float, Float) -> Picture
thickArrow Float
t (Float
x,Float
y) (Float, Float)
disp
    = Float -> Float -> Picture -> Picture
Translate Float
x Float
y forall a b. (a -> b) -> a -> b
$ Float -> Picture -> Picture
Rotate (-Float -> Float
radToDeg Float
theta) forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Picture
basicThickArrow Float
r Float
t (Float
rforall a. Fractional a => a -> a -> a
/Float
4) (Float
2forall a. Num a => a -> a -> a
*Float
t)
      where
        (Float
r,Float
theta) = (Float, Float) -> (Float, Float)
cartToPolar (Float, Float)
disp