--{-# LANGUAGE BangPatterns #-}
--{-# LANGUAGE Strict #-}
module Picture
    ( module Picture.Data
    , polygon
    , arc
    , arcSolid
    , thickArc
    , thickCircle
    , circleSolid
    , circle
    , line
    , text
    , pictures
    , translate
    , rotate
    , rotateRad
    , scale
    , color
    , withAlpha
    , greyN
    , red       
    , green     
    , blue      
    , yellow    
    , cyan      
    , magenta   
    , rose      
    , violet    
    , azure     
    , aquamarine
    , chartreuse
    , orange    
    , white     
    , black
    , dim
    , light
    , dark
    , bright
    , mixColors
    , zeroZ
    , setDepth
    )
    where
import Geometry
import Geometry.Data

import Picture.Data

import Data.Bifunctor
import qualified Data.DList as DL

import Graphics.Rendering.OpenGL (lineWidth, ($=))

import Control.Lens

black :: RGBA
black = (0,0,0,1)

--polygonD :: Float -> [Point2] -> Picture
--{-# INLINE polygonD #-}
--polygonD d (a:b:c:ps) = blank
--    { _scPosTri = mapVC (\(x,y) -> (x,y,d)) tris
--    , _scColTri = mapVC (const black) tris
--    }
--    where twoPs = zip (b:c:ps) (c:ps)
--          tris = toVC $ concatMap (\(x,y)-> [a,x,y]) twoPs
--polygonD _ _ = blank

polygon :: [Point2] -> Picture
{-# INLINE polygon #-}
polygon = Polygon

--polygon :: [Point2] -> Picture
--{-# INLINE polygon #-}
--polygon (a:b:c:ps) = NLeaf $ emptyScene
--    { _scPosTri = fmap zeroZ tris
--    , _scColTri = fmap (const black) tris
--    }
--    where twoPs = zip (b:c:ps) (c:ps)
--          tris = toVC $ concatMap (\(x,y)-> [a,x,y]) twoPs
--polygon _ = blank

color' :: RGBA -> Scene -> Scene
{-# INLINE color' #-}
color' c pic@(Scene {_scColTri = colTri,_scColChar= colChar}) =
    pic {_scColTri  = mapVC (const c) colTri
        ,_scColChar = mapVC (const c) colChar
        }
color :: RGBA -> Picture -> Picture
{-# INLINE color #-}
color c pic = Color c pic

overPos :: (Point3 -> Point3) -> Scene -> Scene
{-# INLINE overPos #-}
overPos f pic@(Scene {_scPosTri = posTri,_scPosChar= posChar}) =
    pic {_scPosTri  = mapVC f posTri
        ,_scPosChar = mapVC f posChar
        }

translate3 :: Float -> Float -> Point3 -> Point3
{-# INLINE translate3 #-}
translate3 a b (x,y,z) = (x+a,y+b,z)

translate' :: Float -> Float -> Scene -> Scene
{-# INLINE translate' #-}
--translate x y = over scPosTri (mapVC $ translate3 x y) . over scPosChar (mapVC $ translate3 x y)
translate' x y = overPos $ translate3 x y

translate :: Float -> Float -> Picture -> Picture
{-# INLINE translate #-}
translate x y pic = Translate x y pic

setDepth' :: Float -> Scene -> Scene
{-# INLINE setDepth' #-}
setDepth' d = overPos $ \(x,y,z) -> (x,y,d)

setDepth :: Float -> Picture -> Picture
{-# INLINE setDepth #-}
setDepth d pic = SetDepth d pic

scale3 :: Float -> Float -> Point3 -> Point3
{-# INLINE scale3 #-}
scale3 a b (x,y,z) = (x*a,y*b,z)

scale' :: Float -> Float -> Scene -> Scene
{-# INLINE scale' #-}
--scale x y = over scPosTri (mapVC $ scale3 x y) . over scPosChar (mapVC $ scale3 x y)
scale' x y pic = overPos (scale3 x y) $ over scTexChar (fmap (second (*x))) pic

scale :: Float -> Float -> Picture -> Picture
{-# INLINE scale #-}
scale x y pic = Scale x y pic

rotate3 :: Float -> Point3 -> Point3
{-# INLINE rotate3 #-}
rotate3 a (x,y,z) = (x',y',z)
    where (x',y') = rotateV a (x,y)

rotate' :: Float -> Scene -> Scene
{-# INLINE rotate' #-}
rotate' a = overPos $ rotate3 $ 0 - degToRad a

--rotate :: Float -> Picture -> Picture
--{-# INLINE rotate #-}
--rotate a pic = NBranch (rotate' a) pic
--
----  -- this rotation uses radians, and is anticlockwise
--rotateRad' :: Float -> Scene -> Scene
--{-# INLINE rotateRad' #-}
--rotateRad' a = overPos $ rotate3 a
--
--rotateRad :: Float -> Picture -> Picture
--{-# INLINE rotateRad #-}
--rotateRad a pic = NBranch (rotateRad' a) pic

rotate a = rotateRad (0 - degToRad a)
{-# INLINE rotate #-}

rotateRad a = Rotate a
{-# INLINE rotateRad #-}

pictures :: [Picture] -> Picture
{-# INLINE pictures #-}
pictures = Pictures


makeArc :: Float -> (Float,Float) -> [Point2]
{-# INLINE makeArc #-}
makeArc rad (a,b) = zipWith rotateV as $ repeat (0,rad)
    where as = [a,a+step.. b]
          step = pi * 0.2

--circleSolidD :: Float -> Float -> Picture
--circleSolidD d r = polygonD d $ makeArc r (0,2*pi)

circleSolid :: Float -> Picture
{-# INLINE circleSolid #-}
circleSolid rad = polygon $ makeArc rad (0,2*pi)

circle :: Float -> Picture
{-# INLINE circle #-}
circle rad = line $ makeArc rad (0,2*pi)

--text :: String -> Picture
--text s = zipWith (\x -> overVs $ first $ translate3 x 0) 
--                 [0,0.25..]
--                 $ map charToShape s

text :: String -> Picture
{-# INLINE text #-}
text = Text

----text :: String -> Picture
----{-# INLINE text #-}
----text s = pictures $  zipWith (\x -> translate x (0-dimText)) 
----                           [0,0.9*dimText..] 
----                           (map charToScene s)
----
----charToScene :: Char -> Picture
----charToScene c = NLeaf $ Scene
----    {_scPosTri = mempty
----    ,_scColTri = mempty
----    ,_scPosChar = toVC [(0.0,0.0,0)]
----    ,_scColChar = toVC [white]
----    ,_scTexChar = toVC [(offset,100)]
----    }
----    where x = 1/128
----          s = offset * x
----          offset = fromIntegral (fromEnum c) - 32
--charToScene :: Char -> Picture
--charToScene c = Scene
--    {_scPosTri = mempty
--    ,_scColTri = mempty
--    ,_scPosChar = toVC [(0.0    ,0.0      ,0)        
--                  ,(dimText,0.0      ,0)    
--                  ,(dimText,dimText*2,0)
--                  ,(0.0    ,0.0      ,0)        
--                  ,(dimText,dimText*2,0)
--                  ,(0.0    ,dimText*2,0)    
--                  ]
--    ,_scColChar = toVC $ take 6 $ repeat white
--    ,_scTexChar = toVC $ [(s,1) ,(e,1) ,(e,0) ,(s,1) ,(e,0) ,(s,0)]
--    }
--    where x = 1/128
--          s = offset * x
--          e = s + x
--          offset = fromIntegral (fromEnum c) - 32
    

dimText = 100

line :: [Point2] -> Picture
{-# INLINE line #-}
line ps = thickLine ps 1

thickLine :: [Point2] -> Float -> Picture
{-# INLINE thickLine #-}
thickLine ps x = blank

thickCircle :: Float -> Float -> Picture
{-# INLINE thickCircle #-}
thickCircle rad wdth = thickLine (makeArc rad (0,2*pi)) wdth

arcSolid :: Float -> Float -> Float -> Picture
{-# INLINE arcSolid #-}
arcSolid startA endA rad
    = polygon $ (0,0) : makeArc rad (startA,endA)

arc startA endA rad = thickArc startA endA rad 1
{-# INLINE arc #-}

thickArc :: Float -> Float -> Float -> Float -> Picture
{-# INLINE thickArc #-}
thickArc startA endA rad wdth
    = thickLine (makeArc rad (startA,endA)) wdth

withAlpha :: Float -> RGBA -> RGBA
{-# INLINE withAlpha #-}
withAlpha a (x,y,z,a') = (x,y,z,a*a')

red,green,blue,yellow,cyan,magenta,rose,violet,azure,aquamarine,chartreuse,orange,white::Color
red       = (1,0,0,1) 
green     = (0,1,0,1) 
blue      = (0,0,1,1) 
yellow    = (1,1,0,1)  
cyan      = (0,1,1,1) 
magenta   = (1,0,1,1)  
rose      = (1,0,0.5,1) 
violet    = (0.5,0,1,1)  
azure     = (0,0.5,1,1) 
aquamarine= (0,1,0.5,1) 
chartreuse= (0.5,1,0,1)
orange    = (1,0.5,0,1)  
white     = (1,1,1,1) 

mixColors :: Float -> Float -> Color -> Color -> Color
mixColors rata ratb (r0,g0,b0,a0) (r2,g2,b2,a2) = 
    let fullrat = rata + ratb
        normrata = rata / fullrat
        normratb = ratb / fullrat
        f x y = sqrt $ normrata * x^2 + normratb * y^2
    in  (f r0 r2 , f g0 g2 , f b0 b2 , normrata * a0 + normratb * a2)

light :: Color -> Color
light (r,g,b,a) = (r+0.2,g+0.2,b+0.2,a)

dark :: Color -> Color
dark (r,g,b,a) = (r-0.2,g-0.2,b-0.2,a)
        
dim :: Color -> Color
dim (r,g,b,a) = (r/1.2,g/1.2,b/1.2,a)

bright :: Color -> Color
bright (r,g,b,a) = (r*1.2,g*1.2,b*1.2,a)

greyN :: Float -> Color
greyN x = (x,x,x,1)


--zeroZ :: Point2 -> Point3
--{-# INLINE zeroZ #-}
--zeroZ (x,y) = (x,y,0)