{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}

module Shape.Description where

import Control.Lens
import Data.Colour
import qualified Data.Text as T
import Linear
import Linear.Affine

data WindowOptions a = WindowOptions
  { _windowSize :: V2 a
  , _windowBackground :: Colour Double
  , _windowName :: T.Text
  } deriving (Eq, Show)

makeLenses ''WindowOptions

data Shape a
  = ManyShape [Shape a]
  | Circle (Point V2 a)
           a
  | Rectangle (Point V2 a)
              (V2 a)
  | Image (Point V2 a)
          (V2 a)
          FilePath
  | Text (Point V2 a)
         FilePath
         Int
         T.Text
  | WithFillColour (Colour Double)
                   (Shape a)
  | WithStrokeColour (Colour Double)
                     (Shape a)
  deriving (Eq, Show, Functor)

shapeCenter :: Traversal' (Shape a) (Point V2 a)
shapeCenter f (ManyShape ss) =
  ManyShape <$> traverse (shapeCenter f) ss
shapeCenter f (Circle p r) = (\p' -> Circle p' r) <$> f p
shapeCenter f (Rectangle p sz) = (\p' -> Rectangle p' sz) <$> f p
shapeCenter f (Image p sz fp) = (\p' -> Image p' sz fp) <$> f p
shapeCenter f (Text p fp sz txt) =
  (\p' -> Text p' fp sz txt) <$> f p
shapeCenter f (WithFillColour c s) =
  WithFillColour c <$> shapeCenter f s
shapeCenter f (WithStrokeColour c s) =
  WithStrokeColour c <$> shapeCenter f s

instance Monoid (Shape a) where
  mempty = ManyShape []
  ManyShape [] `mappend` a = a
  a `mappend` ManyShape [] = a
  ManyShape a `mappend` ManyShape b = ManyShape $ a ++ b
  a `mappend` ManyShape xs = ManyShape (a : xs)
  ManyShape xs `mappend` a = ManyShape (xs ++ [a])
  a `mappend` b = ManyShape [a, b]

class MonadRender c m | m -> c where
  type Texture m :: *
  type FontPointer m :: *
  requestTexture :: FilePath -> m (Texture m)
  requestFont :: FilePath -> Int -> m (FontPointer m)
  renderShape :: Shape c -> m ()
  shapeSize :: Shape c -> m (V2 c)
