{-# 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 = Pictures [Line [(0,0),(100,0)],Polygon [(75,5),(100,0),(75,-5)]]

-- | assumes radians coming in
polarToCart :: (Float,Float) -> (Float,Float)
polarToCart (r,theta) = (r * cos theta,r * sin theta)

-- | theta=0 is positive x axis,
--   output angle in radians
cartToPolar :: (Float,Float) -> (Float,Float)
cartToPolar (x,y) = (sqrt (x**2+y**2),atan2 y x)

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

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

basicThickArrow :: Float -> Float -> Float -> Float -> Picture
basicThickArrow l w headLength headWidth
    = Pictures [Polygon [(0,w/2),(l-hl,w/2),(l-hl,-w/2),(0,-w/2)]
               ,Polygon [(l-hl,hw/2),(l,0),(l-hl,-hw/2)]
               ]
    where
      hl = min l headLength
      hw = max w headWidth

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