{-# LANGUAGE NoMonomorphismRestriction #-}
-- | Here I describe and define the class Visual and some example instances
--   for the basic data structures in the GHC standard library, including
--   Data.Map, Data.IntMap, Data.Set, and Lists.  This gives a rich library
--   of data structures that are Visual as a direct transformation from
--   forall a, Visual b : a -> Visual b
module Graphics.Rendering.Hieroglyph.Visual where

import Data.Monoid
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
-- import Data.Foldable
import Data.List
import Graphics.Rendering.Hieroglyph.Primitives

type BaseVisual = S.Set Primitive

-- | A Visual is an unstructured collection of primitives.  Conceptually, the
--   only requirement of a Visual is that it is Enumerable (or Foldable) in
--   terms of Primitives.  I initially wanted to implement this in terms of
--   the Foldable typeclass from Data.Foldable, but very few things provide
--   instances of Foldable that are conceptually so.  A list is Foldable,
--   and I have certain guarantees of efficiency by operating on lists, so
--   this is the instance of Foldable that I choose to have people implement.
class Visual t where
    primitives :: t -> BaseVisual

-- | A Primitive by itself is a Visual.  That is, a single piece of geometry
--   standing alone is in fact Visual.
instance Visual Primitive where
	primitives a = S.singleton a
	
-- | A any list of Visuals can be flattenend into a list of Primitives by
--   a right fold, therefore a List of Visuals is a Visual
instance Visual a => Visual [a]	where
    primitives x = mconcat $ primitives `map` x

-- | A map to Visuals is Foldable over the elements in terms of Visuals, which
--   are in turn Foldable in terms of Primitives, therefore a map of
instance Visual b => Visual (M.Map a b) where
    primitives = primitives . M.elems

-- | An intmap is merely a map, so once again if the elements are Visuals, the
--   whole structure is a Visual.
instance Visual b => Visual (IM.IntMap b) where
	primitives = primitives . IM.elems

-- | A set of Visuals also comprises a Visual.
instance Visual t => Visual (S.Set t) where
	primitives = primitives . S.toList
	
-- | Declare that a Visual possibly occludes another Visual
occludes :: (Visual t, Visual u) => t -> u -> BaseVisual
occludes this that = ((\p -> p{ layer = maxlev+1 }) <%> primitives this) `mappend` (primitives that)
    where maxlev = maximum . map (layer . attribs) . S.toList . primitives $ that

beside :: (Visual t, Visual u) => t -> u -> BaseVisual
beside this that = ((\p -> p{ layer = maxlev }) <%> primitives this) `mappend` (primitives that)
    where maxlev = maximum . map (layer . attribs) . S.toList . primitives $ that

pure x = S.singleton x

f <%> x = S.map (\a -> a{ attribs = (f . attribs $ a)})  x
(#+#) = beside
(#/#) = occludes
(#\#) = flip occludes

infixr 9 `occludes`
infixl 4 <%>
infixr 8 #+#
infixr 9 #/#
infixr 9 #\#

fillrule x os = (\o -> o{ afillrule = x }) <%> primitives os
fillcolour x os = (\o -> o{ afillRGBA = x }) <%> primitives os
dash x os = (\o -> o{adash = x}) <%> primitives os
strokecolour x os = (\o -> o{ astrokeRGBA = x }) <%> primitives os
linecap x os = (\o -> o{alinecap = x}) <%> primitives os
miterlimit x os = (\o -> o{amiterlimit = x}) <%> primitives os
tolerance x os = (\o -> o{atolerance = x}) <%> primitives os
scalex x os = (\o -> o{ascalex = x}) <%> primitives os
scaley x os = (\o -> o{ascaley = x}) <%> primitives os
scale x y os = (\o -> o{ascalex = x * ascalex o, ascaley = y * ascaley o})<%> primitives os
settranslatex x os = (\o -> o{atranslatex = x })<%> primitives os
settranslatey y os = (\o -> o{atranslatey = y })<%> primitives os
translate x y os = (\o -> o{atranslatex = x + atranslatex o, atranslatey = y + atranslatey o})<%> primitives os
rotation x os = (\o -> o{arotation = x}) <%> primitives os
filled x os = (\o -> o{afilled = x}) <%> primitives os
outlined x os = (\o -> o{aoutlined = x}) <%> primitives os
clipped x os = (\o -> o{aclipped = x}) <%> primitives os
name x os = (\o -> o{aname = Just x}) <%> primitives os