{-# LANGUAGE BangPatterns #-}
{-|
Module      : Graphics.WorldTurtle.Shapes
Description : WorldTurtle
Copyright   : (c) Archibald Neil MacDonald, 2020
License     : BSD3
Maintainer  : FortOyer@hotmail.co.uk
Stability   : experimental
Portability : POSIX

This module exposes shapes not found in gloss but may be found to be worthwhile.

-}
module Graphics.WorldTurtle.Shapes
  ( turtleArrow
  , thickLine
  ) where

import Graphics.Gloss.Data.Color
import Graphics.Gloss.Data.Picture

import qualified Graphics.WorldTurtle.Internal.Coords as P

-- | Creates the default turtle polygon arrow with a given outline color and 

--   fill color.

turtleArrow :: Color -- ^ Outline color

            -> Color -- ^ Fill color

            -> Picture -- ^ Arrow shape.

turtleArrow :: Color -> Color -> Picture
turtleArrow !Color
o !Color
f = Float -> Picture -> Picture
rotate Float
90 (Picture -> Picture) -> Picture -> Picture
forall a b. (a -> b) -> a -> b
$! [Picture] -> Picture
pictures [Color -> Picture
outline_ Color
o, Color -> Picture
fill_ Color
f]

-- | Draws a line from a start-point to an end-point with a given thickness.

thickLine :: Point -- ^ Starting point.

          -> Point  -- ^ Ending point.

          -> Float -- ^ Line thickness.

          -> Picture -- ^ Produced line.

thickLine :: Point -> Point -> Float -> Picture
thickLine Point
a Point
b Float
t = Path -> Picture
polygon (Path -> Picture) -> Path -> Picture
forall a b. (a -> b) -> a -> b
$ [Point
a1, Point
a2, Point
b2, Point
b1]
  where !v :: Point
v = Point
b Point -> Point -> Point
P.- Point
a
        !angle :: Float
angle = Point -> Float
P.argV Point
v
        !perpAngle :: Float
perpAngle = Float
angle Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
forall a. Floating a => a
piFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
2)
        !t2 :: Float
t2 = Float
t Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
        !t' :: Point
t' = Float -> Point -> Point
P.rotateV Float
angle (Float
t2, Float
0)
        !t'' :: Point
t'' = Float -> Point -> Point
P.rotateV Float
perpAngle (Float
t2, Float
0)
        !a1 :: Point
a1 = Point
a Point -> Point -> Point
P.- Point
t'' Point -> Point -> Point
P.- Point
t'
        !a2 :: Point
a2 = Point
a Point -> Point -> Point
P.+ Point
t'' Point -> Point -> Point
P.- Point
t'
        !b1 :: Point
b1 = Point
b Point -> Point -> Point
P.- Point
t'' Point -> Point -> Point
P.+ Point
t'
        !b2 :: Point
b2 = Point
b Point -> Point -> Point
P.+ Point
t'' Point -> Point -> Point
P.+ Point
t'

outline_ :: Color -> Picture
outline_ :: Color -> Picture
outline_ !Color
c = Color -> Picture -> Picture
color Color
c (Picture -> Picture) -> Picture -> Picture
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Picture -> Picture
translate (Float
0) (-Float
1) (Picture -> Picture) -> Picture -> Picture
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Picture -> Picture
scale Float
1.4 Float
1.4 (Picture -> Picture) -> Picture -> Picture
forall a b. (a -> b) -> a -> b
$ Color -> Picture
fill_ Color
c

fill_ :: Color -> Picture
fill_ :: Color -> Picture
fill_ !Color
c = Color -> Picture -> Picture
color Color
c (Picture -> Picture) -> Picture -> Picture
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Picture -> Picture
translate (-Float
4) (-Float
2) 
                  (Picture -> Picture) -> Picture -> Picture
forall a b. (a -> b) -> a -> b
$ [Picture] -> Picture
pictures 
                  [ Path -> Picture
polygon [(Float
0, Float
0), (Float
4, Float
2), (Float
1, Float
2)] -- left tail

                  , Path -> Picture
polygon [(Float
4, Float
2), (Float
8, Float
0), (Float
7, Float
2)] -- right tail

                  , Path -> Picture
polygon [(Float
1, Float
2), (Float
7, Float
2), (Float
4, Float
8)] -- main triangle

                  ]