{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Ipe.Draw
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Class and setup for rendering/drawing
--
--------------------------------------------------------------------------------
module Ipe.Draw
  ( Rendered
  , Attr
  , IsDrawable(..)
  ) where

import Data.Default
import Data.Text (Text)
import HGeometry.Ext
import HGeometry.Point
import Control.Lens
import Data.Kind (Type)
import Ipe.Types
import Ipe.Attributes

--------------------------------------------------------------------------------

-- | The type of objects a backend renders
type family Rendered backend :: Type


-- | An Attribute Assignment
type Attr backend geom = AttrOf backend geom -> AttrOf backend geom

-- | A class that expresses that something is drawable using a particular backend
class ( Monoid (Rendered backend)
      ) => IsDrawable backend geom where

  -- | A GADT that expresses possible attributes for a particular object
  type AttrOf backend geom :: Type

  -- | Draw some objects
  draw :: [Attr backend geom] -> geom -> Rendered backend


--------------------------------------------------------------------------------

type data Ipe (r :: Type)

type instance Rendered (Ipe r) = [IpeObject r]


instance IsDrawable (Ipe r) (IpeObject r) where
  type AttrOf (Ipe r) (IpeObject r) = CommonAttributes r Maybe
  draw :: [Attr (Ipe r) (IpeObject r)] -> IpeObject r -> Rendered (Ipe r)
draw [Attr (Ipe r) (IpeObject r)]
ats IpeObject r
o = [ (IpeObject r
 -> (CommonAttributes r Maybe -> CommonAttributes r Maybe)
 -> IpeObject r)
-> IpeObject r
-> [CommonAttributes r Maybe -> CommonAttributes r Maybe]
-> IpeObject r
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IpeObject r
o' CommonAttributes r Maybe -> CommonAttributes r Maybe
f -> IpeObject r
o'IpeObject r -> (IpeObject r -> IpeObject r) -> IpeObject r
forall a b. a -> (a -> b) -> b
&(CommonAttributes r Maybe -> Identity (CommonAttributes r Maybe))
-> IpeObject r -> Identity (IpeObject r)
forall c r (f :: * -> *).
HasCommonAttributes c r f =>
Lens' c (CommonAttributes r f)
Lens' (IpeObject r) (CommonAttributes r Maybe)
commonAttributes ((CommonAttributes r Maybe -> Identity (CommonAttributes r Maybe))
 -> IpeObject r -> Identity (IpeObject r))
-> (CommonAttributes r Maybe -> CommonAttributes r Maybe)
-> IpeObject r
-> IpeObject r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ CommonAttributes r Maybe -> CommonAttributes r Maybe
f) IpeObject r
o [CommonAttributes r Maybe -> CommonAttributes r Maybe]
[Attr (Ipe r) (IpeObject r)]
ats ]

instance IsDrawable (Ipe r) (Path r) where
  type AttrOf (Ipe r) (Path r) = PathAttributes r
  draw :: [Attr (Ipe r) (Path r)] -> Path r -> Rendered (Ipe r)
draw [Attr (Ipe r) (Path r)]
ats Path r
p = [ IpeObject' Path r -> IpeObject r
forall r. IpeObject' Path r -> IpeObject r
IpePath (Path r
p Path r -> PathAttributes r -> Path r :+ PathAttributes r
forall core extra. core -> extra -> core :+ extra
:+ [PathAttributes r -> PathAttributes r] -> PathAttributes r
forall at. Default at => [at -> at] -> at
mkAttrs [PathAttributes r -> PathAttributes r]
[Attr (Ipe r) (Path r)]
ats) ]

instance IsDrawable (Ipe r) (IpeSymbol r) where
  type AttrOf (Ipe r) (IpeSymbol r) = SymbolAttributes r
  draw :: [Attr (Ipe r) (IpeSymbol r)] -> IpeSymbol r -> Rendered (Ipe r)
draw [Attr (Ipe r) (IpeSymbol r)]
ats IpeSymbol r
p = [ IpeObject' IpeSymbol r -> IpeObject r
forall r. IpeObject' IpeSymbol r -> IpeObject r
IpeUse (IpeSymbol r
p IpeSymbol r
-> SymbolAttributes r -> IpeSymbol r :+ SymbolAttributes r
forall core extra. core -> extra -> core :+ extra
:+ [SymbolAttributes r -> SymbolAttributes r] -> SymbolAttributes r
forall at. Default at => [at -> at] -> at
mkAttrs [SymbolAttributes r -> SymbolAttributes r]
[Attr (Ipe r) (IpeSymbol r)]
ats) ]


--------------------------------------------------------------------------------

instance IsDrawable (Ipe r) (Point 2 r) where
  type AttrOf (Ipe r) (Point 2 r) = SymbolAttributes r
  draw :: [Attr (Ipe r) (Point 2 r)] -> Point 2 r -> Rendered (Ipe r)
draw [Attr (Ipe r) (Point 2 r)]
ats Point 2 r
p = [ IpeObject' IpeSymbol r -> IpeObject r
forall r. IpeObject' IpeSymbol r -> IpeObject r
IpeUse (IpeObject' IpeSymbol r -> IpeObject r)
-> IpeObject' IpeSymbol r -> IpeObject r
forall a b. (a -> b) -> a -> b
$ Point 2 r -> IpeSymbol r :+ SymbolAttributes r
forall r. Point 2 r -> IpeSymbol r :+ SymbolAttributes r
ipeDiskMark Point 2 r
p (IpeSymbol r :+ SymbolAttributes r)
-> ((IpeSymbol r :+ SymbolAttributes r) -> IpeObject' IpeSymbol r)
-> IpeObject' IpeSymbol r
forall a b. a -> (a -> b) -> b
& (SymbolAttributes r -> Identity (SymbolAttributes r))
-> (IpeSymbol r :+ SymbolAttributes r)
-> Identity (IpeSymbol r :+ SymbolAttributes r)
(IpeAttributes IpeSymbol r -> Identity (IpeAttributes IpeSymbol r))
-> IpeObject' IpeSymbol r -> Identity (IpeObject' IpeSymbol r)
forall (i :: * -> *) r (f :: * -> *).
Functor f =>
(IpeAttributes i r -> f (IpeAttributes i r))
-> IpeObject' i r -> f (IpeObject' i r)
attributes ((SymbolAttributes r -> Identity (SymbolAttributes r))
 -> (IpeSymbol r :+ SymbolAttributes r)
 -> Identity (IpeSymbol r :+ SymbolAttributes r))
-> (SymbolAttributes r -> SymbolAttributes r)
-> (IpeSymbol r :+ SymbolAttributes r)
-> IpeSymbol r :+ SymbolAttributes r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [SymbolAttributes r -> SymbolAttributes r]
-> SymbolAttributes r -> SymbolAttributes r
forall at. [at -> at] -> at -> at
applyAttrs [SymbolAttributes r -> SymbolAttributes r]
[Attr (Ipe r) (Point 2 r)]
ats ]

-- | Create an ipe mark
ipeMark     :: Text -> Point 2 r -> IpeSymbol r :+ SymbolAttributes r
ipeMark :: forall r. Text -> Point 2 r -> IpeSymbol r :+ SymbolAttributes r
ipeMark Text
n Point 2 r
p = Point 2 r -> Text -> IpeSymbol r
forall r. Point 2 r -> Text -> IpeSymbol r
Symbol Point 2 r
p Text
n IpeSymbol r
-> SymbolAttributes r -> IpeSymbol r :+ SymbolAttributes r
forall core extra. core -> extra -> core :+ extra
:+ SymbolAttributes r
forall a. Default a => a
def

-- | Creates a disk ipe mark
ipeDiskMark :: Point 2 r -> IpeSymbol r :+ SymbolAttributes r
ipeDiskMark :: forall r. Point 2 r -> IpeSymbol r :+ SymbolAttributes r
ipeDiskMark = Text -> Point 2 r -> IpeSymbol r :+ SymbolAttributes r
forall r. Text -> Point 2 r -> IpeSymbol r :+ SymbolAttributes r
ipeMark Text
"mark/disk(sx)"