-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Flow.Utils.Toolbar
-- License     :  BSD3-style (see the file LICENSE)
--
-- Pure port of @utils\/node-toolbar.ts@ and @utils\/edge-toolbar.ts@
-- from @\@xyflow\/system@: CSS transforms for toolbars rendered next to
-- nodes and edges.
----------------------------------------------------------------------------
module Miso.Flow.Utils.Toolbar
  ( AlignX (..)
  , AlignY (..)
  , getEdgeToolbarTransform
  , getNodeToolbarTransform
  ) where
-----------------------------------------------------------------------------
import           Prelude
-----------------------------------------------------------------------------
import           Miso.String (MisoString)
-----------------------------------------------------------------------------
import           Miso.Flow.Internal.JSNum (jsShow)
import           Miso.Flow.Types
-----------------------------------------------------------------------------
data AlignX = AlignXLeft | AlignXCenter | AlignXRight
  deriving (Int -> AlignX -> ShowS
[AlignX] -> ShowS
AlignX -> String
(Int -> AlignX -> ShowS)
-> (AlignX -> String) -> ([AlignX] -> ShowS) -> Show AlignX
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AlignX -> ShowS
showsPrec :: Int -> AlignX -> ShowS
$cshow :: AlignX -> String
show :: AlignX -> String
$cshowList :: [AlignX] -> ShowS
showList :: [AlignX] -> ShowS
Show, AlignX -> AlignX -> Bool
(AlignX -> AlignX -> Bool)
-> (AlignX -> AlignX -> Bool) -> Eq AlignX
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AlignX -> AlignX -> Bool
== :: AlignX -> AlignX -> Bool
$c/= :: AlignX -> AlignX -> Bool
/= :: AlignX -> AlignX -> Bool
Eq)
-----------------------------------------------------------------------------
data AlignY = AlignYTop | AlignYCenter | AlignYBottom
  deriving (Int -> AlignY -> ShowS
[AlignY] -> ShowS
AlignY -> String
(Int -> AlignY -> ShowS)
-> (AlignY -> String) -> ([AlignY] -> ShowS) -> Show AlignY
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AlignY -> ShowS
showsPrec :: Int -> AlignY -> ShowS
$cshow :: AlignY -> String
show :: AlignY -> String
$cshowList :: [AlignY] -> ShowS
showList :: [AlignY] -> ShowS
Show, AlignY -> AlignY -> Bool
(AlignY -> AlignY -> Bool)
-> (AlignY -> AlignY -> Bool) -> Eq AlignY
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AlignY -> AlignY -> Bool
== :: AlignY -> AlignY -> Bool
$c/= :: AlignY -> AlignY -> Bool
/= :: AlignY -> AlignY -> Bool
Eq)
-----------------------------------------------------------------------------
alignXToPercent :: AlignX -> Double
alignXToPercent :: AlignX -> Double
alignXToPercent = \case
  AlignX
AlignXLeft -> Double
0
  AlignX
AlignXCenter -> Double
50
  AlignX
AlignXRight -> Double
100
-----------------------------------------------------------------------------
alignYToPercent :: AlignY -> Double
alignYToPercent :: AlignY -> Double
alignYToPercent = \case
  AlignY
AlignYTop -> Double
0
  AlignY
AlignYCenter -> Double
50
  AlignY
AlignYBottom -> Double
100
-----------------------------------------------------------------------------
-- | CSS transform for an edge toolbar at flow position @(x, y)@; port of
-- @getEdgeToolbarTransform@.
getEdgeToolbarTransform
  :: Double -- ^ x
  -> Double -- ^ y
  -> Double -- ^ zoom
  -> AlignX -- ^ default 'AlignXCenter'
  -> AlignY -- ^ default 'AlignYCenter'
  -> MisoString
getEdgeToolbarTransform :: Double -> Double -> Double -> AlignX -> AlignY -> MisoString
getEdgeToolbarTransform Double
x Double
y Double
zoom AlignX
alignX AlignY
alignY = [MisoString] -> MisoString
forall a. Monoid a => [a] -> a
mconcat
  [ MisoString
"translate(", Double -> MisoString
jsShow Double
x, MisoString
"px, ", Double -> MisoString
jsShow Double
y, MisoString
"px) scale("
  , Double -> MisoString
jsShow (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
zoom), MisoString
") translate("
  , Double -> MisoString
jsShow (Double -> Double
forall a. Num a => a -> a
negate (AlignX -> Double
alignXToPercent AlignX
alignX)), MisoString
"%, "
  , Double -> MisoString
jsShow (Double -> Double
forall a. Num a => a -> a
negate (AlignY -> Double
alignYToPercent AlignY
alignY)), MisoString
"%)"
  ]
-----------------------------------------------------------------------------
-- | CSS transform for a node toolbar; port of @getNodeToolbarTransform@.
getNodeToolbarTransform
  :: Rect      -- ^ node rect (flow coordinates)
  -> Viewport
  -> Position  -- ^ side of the node
  -> Double    -- ^ offset
  -> Align
  -> MisoString
getNodeToolbarTransform :: Rect -> Viewport -> Position -> Double -> Align -> MisoString
getNodeToolbarTransform Rect
nodeRect Viewport
vp Position
position Double
offset Align
align = [MisoString] -> MisoString
forall a. Monoid a => [a] -> a
mconcat
  [ MisoString
"translate(", Double -> MisoString
jsShow Double
posX, MisoString
"px, ", Double -> MisoString
jsShow Double
posY, MisoString
"px) translate("
  , Double -> MisoString
jsShow Double
shiftX, MisoString
"%, ", Double -> MisoString
jsShow Double
shiftY, MisoString
"%)"
  ]
  where
    alignmentOffset :: Double
    alignmentOffset :: Double
alignmentOffset = case Align
align of
      Align
AlignStart -> Double
0
      Align
AlignEnd -> Double
1
      Align
AlignCenter -> Double
0.5
    zoom :: Double
zoom = Viewport -> Double
viewportZoom Viewport
vp
    -- defaults are the Position.Top case
    topX :: Double
topX = (Rect -> Double
rectX Rect
nodeRect Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Rect -> Double
rectWidth Rect
nodeRect Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
alignmentOffset) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
zoom Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Viewport -> Double
viewportX Viewport
vp
    topY :: Double
topY = Rect -> Double
rectY Rect
nodeRect Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
zoom Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Viewport -> Double
viewportY Viewport
vp Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
offset
    (Double
posX, Double
posY, Double
shiftX, Double
shiftY) =
      case Position
position of
        Position
PositionTop ->
          (Double
topX, Double
topY, -Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
alignmentOffset, -Double
100)
        Position
PositionRight ->
          ( (Rect -> Double
rectX Rect
nodeRect Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Rect -> Double
rectWidth Rect
nodeRect) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
zoom Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Viewport -> Double
viewportX Viewport
vp Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
offset
          , (Rect -> Double
rectY Rect
nodeRect Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Rect -> Double
rectHeight Rect
nodeRect Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
alignmentOffset) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
zoom Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Viewport -> Double
viewportY Viewport
vp
          , Double
0
          , -Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
alignmentOffset )
        Position
PositionBottom ->
          ( Double
topX
          , (Rect -> Double
rectY Rect
nodeRect Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Rect -> Double
rectHeight Rect
nodeRect) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
zoom Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Viewport -> Double
viewportY Viewport
vp Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
offset
          , -Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
alignmentOffset
          , Double
0 )
        Position
PositionLeft ->
          ( Rect -> Double
rectX Rect
nodeRect Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
zoom Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Viewport -> Double
viewportX Viewport
vp Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
offset
          , (Rect -> Double
rectY Rect
nodeRect Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Rect -> Double
rectHeight Rect
nodeRect Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
alignmentOffset) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
zoom Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Viewport -> Double
viewportY Viewport
vp
          , -Double
100
          , -Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
alignmentOffset )
-----------------------------------------------------------------------------