{-# LANGUAGE OverloadedStrings          #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Miso.Svg.StaticCanvas
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- A Static canvas to be usedi nMiso applications
--
--------------------------------------------------------------------------------
module HGeometry.Miso.Svg.StaticCanvas
  ( StaticCanvas
  , staticCanvas
  , HasDimensions(..)
  -- , center, dimensions, zoomLevel
  , staticCanvas_
  -- , textAt
  -- , realWorldCoordinates
  , ToSvgCoordinate


  , matrixToMisoString
  ) where

import           Control.Lens hiding (elements)
import           HGeometry.Matrix
import           HGeometry.Transformation
import           HGeometry.Vector
import           HGeometry.Viewport
import           Miso (Attribute, View)
import           Miso.String (MisoString, ToMisoString, ms)
import qualified Miso.String.Util as MisoString
import           Miso.Svg (svg_, g_)
import           Miso.Svg.Property (transform_)
import           Miso.Html.Property (width_,height_) -- not sure if this is correct (namespace)!

--------------------------------------------------------------------------------
-- *A Canvas

-- | Static Canvas that has a "proper" Coordinate system whose origin is in the bottom left.
data StaticCanvas r =
  Canvas { forall r. StaticCanvas r -> Viewport r
_theViewport :: !(Viewport r)
         -- ^ the viewport
         , forall r. StaticCanvas r -> Vector 2 Int
_dimensions  :: !(Vector 2 Int)
         -- ^ dimensions (width,height) in pixels, of the canvas
         }
  deriving stock (StaticCanvas r -> StaticCanvas r -> Bool
(StaticCanvas r -> StaticCanvas r -> Bool)
-> (StaticCanvas r -> StaticCanvas r -> Bool)
-> Eq (StaticCanvas r)
forall r. Eq r => StaticCanvas r -> StaticCanvas r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall r. Eq r => StaticCanvas r -> StaticCanvas r -> Bool
== :: StaticCanvas r -> StaticCanvas r -> Bool
$c/= :: forall r. Eq r => StaticCanvas r -> StaticCanvas r -> Bool
/= :: StaticCanvas r -> StaticCanvas r -> Bool
Eq)

-- | Lens to access the viewport of a Canvas
theViewport :: Lens (StaticCanvas r) (StaticCanvas s) (Viewport r) (Viewport s)
theViewport :: forall r s (f :: * -> *).
Functor f =>
(Viewport r -> f (Viewport s))
-> StaticCanvas r -> f (StaticCanvas s)
theViewport = (StaticCanvas r -> Viewport r)
-> (StaticCanvas r -> Viewport s -> StaticCanvas s)
-> Lens (StaticCanvas r) (StaticCanvas s) (Viewport r) (Viewport s)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens StaticCanvas r -> Viewport r
forall r. StaticCanvas r -> Viewport r
_theViewport (\StaticCanvas r
c Viewport s
vp -> StaticCanvas r
c { _theViewport = vp })

-- | Class for types that have a 'dimensions' field
class HasDimensions s a | s -> a where
  -- | Lens to access the Dimensions field
  dimensions :: Lens' s a

instance HasDimensions (StaticCanvas r) (Vector 2 Int) where
  dimensions :: Lens' (StaticCanvas r) (Vector 2 Int)
dimensions = (StaticCanvas r -> Vector 2 Int)
-> (StaticCanvas r -> Vector 2 Int -> StaticCanvas r)
-> Lens' (StaticCanvas r) (Vector 2 Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens StaticCanvas r -> Vector 2 Int
forall r. StaticCanvas r -> Vector 2 Int
_dimensions (\StaticCanvas r
c Vector 2 Int
d -> StaticCanvas r
c { _dimensions = d})
  {-# INLINE dimensions #-}


-- class HasTheViewport s a | s -> a where
--   theViewport :: Lens' s a

-- instance HasTheViewport (Canvas r) (Viewport r) where
--   {-# INLINE theViewport #-}
--   theViewport f (Canvas vp d) = fmap (\ vp' -> Canvas vp' d) (f vp)

-- center     :: Lens' (Canvas r) (Point 2 r)
-- center     = lens _center     (\cv c -> cv { _center     = c } )

-- dimensions :: Lens' (Canvas r) (Vector 2 Int)
-- dimensions = lens _dimensions (\cv c -> cv { _dimensions = c } )

-- zoomLevel  :: Lens' (Canvas r) r
-- zoomLevel  = lens _zoomLevel      (\cv c -> cv { _zoomLevel      = c } )

--------------------------------------------------------------------------------
-- | Create a canvas
staticCanvas     :: Num r
                 => Int -> Int -> StaticCanvas r
staticCanvas :: forall r. Num r => Int -> Int -> StaticCanvas r
staticCanvas Int
w Int
h = let v :: Vector 2 Int
v = Int -> Int -> Vector 2 Int
forall r. r -> r -> Vector 2 r
Vector2 Int
w Int
h
                   in Viewport r -> Vector 2 Int -> StaticCanvas r
forall r. Viewport r -> Vector 2 Int -> StaticCanvas r
Canvas (Vector 2 r -> Viewport r
forall r vector.
(Num r, Vector_ vector 2 r) =>
vector -> Viewport r
flipY (Int -> r
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> r) -> Vector 2 Int -> Vector 2 r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector 2 Int
v)) Vector 2 Int
v

--------------------------------------------------------------------------------
-- * The Controller


--------------------------------------------------------------------------------
-- * The View

-- | Types for which we can convert into a Svg coordinate.
type ToSvgCoordinate = ToMisoString


-- | Draws the actual canvas
staticCanvas_               :: (RealFrac r, ToSvgCoordinate r)
                            => StaticCanvas r
                            -> [Attribute action] -> [View model action] -> View model action
staticCanvas_ :: forall r action model.
(RealFrac r, ToSvgCoordinate r) =>
StaticCanvas r
-> [Attribute action] -> [View model action] -> View model action
staticCanvas_ StaticCanvas r
canvas [Attribute action]
ats [View model action]
vs =
    [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
svg_ ([ MisoString -> Attribute action
forall action. MisoString -> Attribute action
width_   (MisoString -> Attribute action)
-> (Int -> MisoString) -> Int -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Int -> Attribute action) -> Int -> Attribute action
forall a b. (a -> b) -> a -> b
$ Int
w
          , MisoString -> Attribute action
forall action. MisoString -> Attribute action
height_  (MisoString -> Attribute action)
-> (Int -> MisoString) -> Int -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Int -> Attribute action) -> Int -> Attribute action
forall a b. (a -> b) -> a -> b
$ Int
h
            -- , viewBox_      $ outerVB
          ] [Attribute action] -> [Attribute action] -> [Attribute action]
forall a. Semigroup a => a -> a -> a
<> [Attribute action]
ats)
         [ [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
g_ [ MisoString -> Attribute action
forall action. MisoString -> Attribute action
transform_ MisoString
ts ] [View model action]
vs
         ]
  where
    (Vector2 Int
w Int
h) = StaticCanvas r
canvasStaticCanvas r
-> Getting (Vector 2 Int) (StaticCanvas r) (Vector 2 Int)
-> Vector 2 Int
forall s a. s -> Getting a s a -> a
^.Getting (Vector 2 Int) (StaticCanvas r) (Vector 2 Int)
forall s a. HasDimensions s a => Lens' s a
Lens' (StaticCanvas r) (Vector 2 Int)
dimensions
    ts :: MisoString
ts = Matrix 3 3 r -> MisoString
forall r. ToSvgCoordinate r => Matrix 3 3 r -> MisoString
matrixToMisoString (Matrix 3 3 r -> MisoString) -> Matrix 3 3 r -> MisoString
forall a b. (a -> b) -> a -> b
$ StaticCanvas r
canvasStaticCanvas r
-> Getting (Matrix 3 3 r) (StaticCanvas r) (Matrix 3 3 r)
-> Matrix 3 3 r
forall s a. s -> Getting a s a -> a
^.(Viewport r -> Const (Matrix 3 3 r) (Viewport r))
-> StaticCanvas r -> Const (Matrix 3 3 r) (StaticCanvas r)
forall r s (f :: * -> *).
Functor f =>
(Viewport r -> f (Viewport s))
-> StaticCanvas r -> f (StaticCanvas s)
theViewport((Viewport r -> Const (Matrix 3 3 r) (Viewport r))
 -> StaticCanvas r -> Const (Matrix 3 3 r) (StaticCanvas r))
-> ((Matrix 3 3 r -> Const (Matrix 3 3 r) (Matrix 3 3 r))
    -> Viewport r -> Const (Matrix 3 3 r) (Viewport r))
-> Getting (Matrix 3 3 r) (StaticCanvas r) (Matrix 3 3 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Transformation 2 r -> Const (Matrix 3 3 r) (Transformation 2 r))
-> Viewport r -> Const (Matrix 3 3 r) (Viewport r)
forall r (f :: * -> *).
Functor f =>
(Transformation 2 r -> f (Transformation 2 r))
-> Viewport r -> f (Viewport r)
worldToHost((Transformation 2 r -> Const (Matrix 3 3 r) (Transformation 2 r))
 -> Viewport r -> Const (Matrix 3 3 r) (Viewport r))
-> ((Matrix 3 3 r -> Const (Matrix 3 3 r) (Matrix 3 3 r))
    -> Transformation 2 r -> Const (Matrix 3 3 r) (Transformation 2 r))
-> (Matrix 3 3 r -> Const (Matrix 3 3 r) (Matrix 3 3 r))
-> Viewport r
-> Const (Matrix 3 3 r) (Viewport r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Matrix 3 3 r -> Const (Matrix 3 3 r) (Matrix 3 3 r))
-> Transformation 2 r -> Const (Matrix 3 3 r) (Transformation 2 r)
(Matrix (2 + 1) (2 + 1) r
 -> Const (Matrix 3 3 r) (Matrix (2 + 1) (2 + 1) r))
-> Transformation 2 r -> Const (Matrix 3 3 r) (Transformation 2 r)
forall (d :: Nat) r s (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Matrix (d + 1) (d + 1) r) (f (Matrix (d + 1) (d + 1) s))
-> p (Transformation d r) (f (Transformation d s))
transformationMatrix

-- | Renders a matrix as a MisoString
matrixToMisoString   :: ToSvgCoordinate r => Matrix 3 3 r -> MisoString
matrixToMisoString :: forall r. ToSvgCoordinate r => Matrix 3 3 r -> MisoString
matrixToMisoString Matrix 3 3 r
m = MisoString
"matrix(" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> [MisoString] -> MisoString
MisoString.unwords [MisoString
a,MisoString
b,MisoString
c,MisoString
e,MisoString
d,MisoString
f] MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
")"
  where
    (Vector3 (Vector3 MisoString
a MisoString
b MisoString
c)
             (Vector3 MisoString
d MisoString
e MisoString
f)
             Vector 3 MisoString
_              ) = (Matrix 3 3 r
mMatrix 3 3 r
-> (Matrix 3 3 r -> Matrix 3 3 MisoString) -> Matrix 3 3 MisoString
forall a b. a -> (a -> b) -> b
&(r -> Identity MisoString)
-> Matrix 3 3 r -> Identity (Matrix 3 3 MisoString)
(NumType (Matrix 3 3 r)
 -> Identity (NumType (Matrix 3 3 MisoString)))
-> Matrix 3 3 r -> Identity (Matrix 3 3 MisoString)
forall matrix matrix'.
HasElements matrix matrix' =>
IndexedTraversal1
  (Int, Int) matrix matrix' (NumType matrix) (NumType matrix')
IndexedTraversal1
  (Int, Int)
  (Matrix 3 3 r)
  (Matrix 3 3 MisoString)
  (NumType (Matrix 3 3 r))
  (NumType (Matrix 3 3 MisoString))
elements ((r -> Identity MisoString)
 -> Matrix 3 3 r -> Identity (Matrix 3 3 MisoString))
-> (r -> MisoString) -> Matrix 3 3 r -> Matrix 3 3 MisoString
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms :: Matrix 3 3 MisoString)Matrix 3 3 MisoString
-> Getting
     (Vector 3 (Vector 3 MisoString))
     (Matrix 3 3 MisoString)
     (Vector 3 (Vector 3 MisoString))
-> Vector 3 (Vector 3 MisoString)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector 3 (Vector 3 MisoString))
  (Matrix 3 3 MisoString)
  (Vector 3 (Vector 3 MisoString))
forall matrix (n :: Nat) (m :: Nat) r.
Matrix_ matrix n m r =>
Lens' matrix (Vector n (Vector m r))
Lens' (Matrix 3 3 MisoString) (Vector 3 (Vector 3 MisoString))
rows
                              -- this last vector has to be 0 0 1




-- | To be used instead of the text_ combinator in Miso
-- textAt                     :: ToSvgCoordinate r
--                            => Point 2 r -- ^ position where to draw (in world coordinates)
--                            -> [Attribute action]
--                            -> MisoString -> View model action
-- textAt (Point2 x y) ats t = g_ [ transform_ $ mconcat [ "translate("
--                                                        , ms x
--                                                        , ", "
--                                                        , ms y
--                                                        , ")scale(1,-1)"
--                                                        ]
--                                 ] [ Miso.text_ ats [text t] ]



-- class RenderWebSvg t where
--   renderWith :: t -> [Attribute action] -> [View model action] -> View model action

-- render       :: RenderWebSvg t => t -> [Attribute action] -> View model action
-- render x ats = renderWith x ats []

-- instance ToSvgCoordinate r => RenderWebSvg (Point 2 r) where
--   renderWith (Point2 x y) ats = ellipse_ $ [ cx_ $ ms x, cy_ $ ms y
--                                            , rx_ "5", ry_ "5"
--                                            , fill_ "black"
--                                            ] <> ats