{-|
This widget renders a Cartesian coordinate system and plots function
graphs by connecting provided points. Coordinate system can be
dragged and scaled. It is possible to render single points too.

This widget can receive 'GraphMsg' messages:

- 'GraphSetTranslation' 'Point'
- 'GraphSetScale' 'Point'
- 'GraphReset'
- 'GraphStopAnimations'
- 'GraphFinished' 'Int' 'Millisecond'

The last message is used internally.

@
graph [[(1,2), (1,3)], [(0,0), (1,1)]]
graphWithColors [(red, [(1,2), (1,3)]), (blue, [(0,0), (1,1)])]
graphWithData [[graphPoint (0, 0), graphColor red]]
@
-}

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}

module Monomer.Graph
    ( -- * Re-exported modules
      module Monomer.Graph.GraphCfg
    , module Monomer.Graph.GraphData
    , module Monomer.Graph.GraphMsg
      -- * Constructors
    , graph
    , graph_
    , graphWithColors
    , graphWithColors_
    , graphWithData
    , graphWithData_
    ) where

import Control.Applicative ((<|>))
import Control.Lens
import Control.Monad
import Data.Default
import Data.Fixed
import Data.Maybe
import Data.Text (pack)
import Data.Typeable
import Monomer.Graphics.ColorTable
import Monomer.Widgets.Single
import Numeric
import qualified Monomer.Lens as L

import Monomer.Graph.GraphCfg
import Monomer.Graph.GraphData
import Monomer.Graph.GraphMsg
import Monomer.Graph.GraphState

{-|
Creates a graph plotter using the list with points.
-}
graph
    :: (WidgetModel s, WidgetEvent e)
    => [[(Double, Double)]]  -- ^ The list with points.
    -> WidgetNode s e        -- ^ The created graph plotter.
graph :: forall s e.
(WidgetModel s, WidgetEvent e) =>
[[(Double, Double)]] -> WidgetNode s e
graph [[(Double, Double)]]
points = forall s e.
(WidgetModel s, WidgetEvent e) =>
[[(Double, Double)]] -> [GraphCfg s e] -> WidgetNode s e
graph_ [[(Double, Double)]]
points forall a. Default a => a
def

{-|
Creates a graph plotter using the list with points. Accepts config.
-}
graph_
    :: (WidgetModel s, WidgetEvent e)
    => [[(Double, Double)]]  -- ^ The list with points.
    -> [GraphCfg s e]        -- ^ The config options.
    -> WidgetNode s e        -- ^ The created graph plotter.
graph_ :: forall s e.
(WidgetModel s, WidgetEvent e) =>
[[(Double, Double)]] -> [GraphCfg s e] -> WidgetNode s e
graph_ [[(Double, Double)]]
points [GraphCfg s e]
configs = forall s e.
(WidgetModel s, WidgetEvent e) =>
[(Color, [(Double, Double)])] -> [GraphCfg s e] -> WidgetNode s e
graphWithColors_ [(Color, [(Double, Double)])]
colorPoints [GraphCfg s e]
configs where
    colorPoints :: [(Color, [(Double, Double)])]
colorPoints = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [a]
cycle [Color]
colors') [[(Double, Double)]]
points
    colors' :: [Color]
colors' = forall a. a -> Maybe a -> a
fromMaybe [Color]
colors Maybe [Color]
_gcGraphColors
    colors :: [Color]
colors = [Color
red, Color
green, Color
blue, Color
violet, Color
yellow]
    GraphCfg{[(Double, Double) -> WidgetRequest s e]
Maybe Bool
Maybe Double
Maybe [Color]
_gcOnRightClickReq :: forall s e. GraphCfg s e -> [(Double, Double) -> WidgetRequest s e]
_gcGraphColors :: forall s e. GraphCfg s e -> Maybe [Color]
_gcHideGrid :: forall s e. GraphCfg s e -> Maybe Bool
_gcHideNumbers :: forall s e. GraphCfg s e -> Maybe Bool
_gcHideMinor :: forall s e. GraphCfg s e -> Maybe Bool
_gcLockY :: forall s e. GraphCfg s e -> Maybe Bool
_gcLockX :: forall s e. GraphCfg s e -> Maybe Bool
_gcMaxScaleY :: forall s e. GraphCfg s e -> Maybe Double
_gcMinScaleY :: forall s e. GraphCfg s e -> Maybe Double
_gcMaxScaleX :: forall s e. GraphCfg s e -> Maybe Double
_gcMinScaleX :: forall s e. GraphCfg s e -> Maybe Double
_gcMaxY :: forall s e. GraphCfg s e -> Maybe Double
_gcMinY :: forall s e. GraphCfg s e -> Maybe Double
_gcMaxX :: forall s e. GraphCfg s e -> Maybe Double
_gcMinX :: forall s e. GraphCfg s e -> Maybe Double
_gcWheelRate :: forall s e. GraphCfg s e -> Maybe Double
_gcOnRightClickReq :: [(Double, Double) -> WidgetRequest s e]
_gcHideGrid :: Maybe Bool
_gcHideNumbers :: Maybe Bool
_gcHideMinor :: Maybe Bool
_gcLockY :: Maybe Bool
_gcLockX :: Maybe Bool
_gcMaxScaleY :: Maybe Double
_gcMinScaleY :: Maybe Double
_gcMaxScaleX :: Maybe Double
_gcMinScaleX :: Maybe Double
_gcMaxY :: Maybe Double
_gcMinY :: Maybe Double
_gcMaxX :: Maybe Double
_gcMinX :: Maybe Double
_gcWheelRate :: Maybe Double
_gcGraphColors :: Maybe [Color]
..} = forall a. Monoid a => [a] -> a
mconcat [GraphCfg s e]
configs

{-|
Creates a graph plotter using the list with colors and points.
-}
graphWithColors
    :: (WidgetModel s, WidgetEvent e)
    => [(Color, [(Double, Double)])]
    -- ^ The list with colors and points.
    -> WidgetNode s e
    -- ^ The created graph plotter.
graphWithColors :: forall s e.
(WidgetModel s, WidgetEvent e) =>
[(Color, [(Double, Double)])] -> WidgetNode s e
graphWithColors [(Color, [(Double, Double)])]
colorPoints = forall s e.
(WidgetModel s, WidgetEvent e) =>
[(Color, [(Double, Double)])] -> [GraphCfg s e] -> WidgetNode s e
graphWithColors_ [(Color, [(Double, Double)])]
colorPoints forall a. Default a => a
def

{-|
Creates a graph plotter using the list with colors and points.
Accepts config.
-}
graphWithColors_
    :: (WidgetModel s, WidgetEvent e)
    => [(Color, [(Double, Double)])]
    -- ^ The list with colors and points.
    -> [GraphCfg s e]
    -- ^ The config options.
    -> WidgetNode s e
    -- ^ The created graph plotter.
graphWithColors_ :: forall s e.
(WidgetModel s, WidgetEvent e) =>
[(Color, [(Double, Double)])] -> [GraphCfg s e] -> WidgetNode s e
graphWithColors_ [(Color, [(Double, Double)])]
colorPoints [GraphCfg s e]
configs = WidgetNode s e
node where
    node :: WidgetNode s e
node = forall s e.
(WidgetModel s, WidgetEvent e) =>
[[GraphData s e]] -> [GraphCfg s e] -> WidgetNode s e
graphWithData_ (forall {s} {e}. (Color, [(Double, Double)]) -> [GraphData s e]
makeData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Color, [(Double, Double)])]
colorPoints) [GraphCfg s e]
configs
    makeData :: (Color, [(Double, Double)]) -> [GraphData s e]
makeData (Color
color, [(Double, Double)]
points) =
        [ forall s e. [(Double, Double)] -> GraphData s e
graphPoints [(Double, Double)]
points
        , forall s e. Color -> GraphData s e
graphColor Color
color
        ]

{-|
Creates a graph plotter using the list with 'GraphData'.
-}
graphWithData
    :: (WidgetModel s, WidgetEvent e)
    => [[GraphData s e]]  -- ^ The list with 'GraphData'.
    -> WidgetNode s e     -- ^ The created graph plotter.
graphWithData :: forall s e.
(WidgetModel s, WidgetEvent e) =>
[[GraphData s e]] -> WidgetNode s e
graphWithData [[GraphData s e]]
dataList = forall s e.
(WidgetModel s, WidgetEvent e) =>
[[GraphData s e]] -> [GraphCfg s e] -> WidgetNode s e
graphWithData_ [[GraphData s e]]
dataList forall a. Default a => a
def

{-|
Creates a graph plotter using the list with 'GraphData'. Accepts
config.
-}
graphWithData_
    :: (WidgetModel s, WidgetEvent e)
    => [[GraphData s e]]  -- ^ The list with 'GraphData'.
    -> [GraphCfg s e]     -- ^ The config options.
    -> WidgetNode s e     -- ^ The created graph plotter.
graphWithData_ :: forall s e.
(WidgetModel s, WidgetEvent e) =>
[[GraphData s e]] -> [GraphCfg s e] -> WidgetNode s e
graphWithData_ [[GraphData s e]]
dataList [GraphCfg s e]
configs = WidgetNode s e
node where
    node :: WidgetNode s e
node = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode (Text -> WidgetType
WidgetType Text
"graph") Widget s e
widget
    widget :: Widget s e
widget = forall s e.
(WidgetModel s, WidgetEvent e) =>
[GraphData s e] -> GraphCfg s e -> GraphState s e -> Widget s e
makeGraph (forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[GraphData s e]]
dataList) GraphCfg s e
config forall a. Default a => a
def
    config :: GraphCfg s e
config = forall a. Monoid a => [a] -> a
mconcat [GraphCfg s e]
configs

makeGraph
    :: (WidgetModel s, WidgetEvent e)
    => [GraphData s e]
    -> GraphCfg s e
    -> GraphState s e
    -> Widget s e
makeGraph :: forall s e.
(WidgetModel s, WidgetEvent e) =>
[GraphData s e] -> GraphCfg s e -> GraphState s e -> Widget s e
makeGraph [GraphData s e]
graphDatas config :: GraphCfg s e
config@(GraphCfg{[(Double, Double) -> WidgetRequest s e]
Maybe Bool
Maybe Double
Maybe [Color]
_gcOnRightClickReq :: [(Double, Double) -> WidgetRequest s e]
_gcGraphColors :: Maybe [Color]
_gcHideGrid :: Maybe Bool
_gcHideNumbers :: Maybe Bool
_gcHideMinor :: Maybe Bool
_gcLockY :: Maybe Bool
_gcLockX :: Maybe Bool
_gcMaxScaleY :: Maybe Double
_gcMinScaleY :: Maybe Double
_gcMaxScaleX :: Maybe Double
_gcMinScaleX :: Maybe Double
_gcMaxY :: Maybe Double
_gcMinY :: Maybe Double
_gcMaxX :: Maybe Double
_gcMinX :: Maybe Double
_gcWheelRate :: Maybe Double
_gcOnRightClickReq :: forall s e. GraphCfg s e -> [(Double, Double) -> WidgetRequest s e]
_gcGraphColors :: forall s e. GraphCfg s e -> Maybe [Color]
_gcHideGrid :: forall s e. GraphCfg s e -> Maybe Bool
_gcHideNumbers :: forall s e. GraphCfg s e -> Maybe Bool
_gcHideMinor :: forall s e. GraphCfg s e -> Maybe Bool
_gcLockY :: forall s e. GraphCfg s e -> Maybe Bool
_gcLockX :: forall s e. GraphCfg s e -> Maybe Bool
_gcMaxScaleY :: forall s e. GraphCfg s e -> Maybe Double
_gcMinScaleY :: forall s e. GraphCfg s e -> Maybe Double
_gcMaxScaleX :: forall s e. GraphCfg s e -> Maybe Double
_gcMinScaleX :: forall s e. GraphCfg s e -> Maybe Double
_gcMaxY :: forall s e. GraphCfg s e -> Maybe Double
_gcMinY :: forall s e. GraphCfg s e -> Maybe Double
_gcMaxX :: forall s e. GraphCfg s e -> Maybe Double
_gcMinX :: forall s e. GraphCfg s e -> Maybe Double
_gcWheelRate :: forall s e. GraphCfg s e -> Maybe Double
..}) GraphState s e
orState = Widget s e
widget where
    widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle GraphState s e
state forall a. Default a => a
def
        { singleGetCurrentStyle :: SingleGetCurrentStyle s e
singleGetCurrentStyle = forall {s} {e}. WidgetEnv s e -> WidgetNode s e -> StyleState
getCurrentStyle
        , singleInit :: SingleInitHandler s e
singleInit = SingleInitHandler s e
init'
        , singleMerge :: SingleMergeHandler s e (GraphState s e)
singleMerge = forall {p} {p}.
HasTimestamp p Millisecond =>
p -> WidgetNode s e -> p -> GraphState s e -> WidgetResult s e
merge
        , singleHandleEvent :: SingleEventHandler s e
singleHandleEvent = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent
        , singleHandleMessage :: SingleMessageHandler s e
singleHandleMessage = forall {p} {p} {p}.
Typeable p =>
p -> WidgetNode s e -> p -> p -> Maybe (WidgetResult s e)
handleMessage
        , singleGetSizeReq :: SingleGetSizeReqHandler s e
singleGetSizeReq = forall {p} {p}. p -> p -> (SizeReq, SizeReq)
getSizeReq
        , singleResize :: SingleResizeHandler s e
singleResize = forall {p}. p -> WidgetNode s e -> Rect -> WidgetResult s e
resize
        , singleRender :: SingleRenderHandler s e
singleRender = forall {s} {e}.
WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render
        }

    getCurrentStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
getCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node = StyleState
style where
        style :: StyleState
style = forall {s} {e}. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node forall a b. a -> (a -> b) -> b
& forall s a. HasCursorIcon s a => Lens' s a
L.cursorIcon forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe CursorIcon
cursor
        cursor :: Maybe CursorIcon
cursor = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall s e. GraphState s e -> Maybe (Int, Int)
_gsHoverPoint GraphState s e
state)
            then forall a. Maybe a
Nothing
            else forall a. a -> Maybe a
Just CursorIcon
CursorHand

    init' :: SingleInitHandler s e
init' WidgetEnv s e
wenv WidgetNode s e
node = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
resNode forall {s} {e}. [WidgetRequest s e]
req where
        resNode :: WidgetNode s e
resNode = forall {t}. HasWidget t (Widget s e) => GraphState s e -> t -> t
makeNodeWithState GraphState s e
newState WidgetNode s e
node
        newState :: GraphState s e
newState = GraphState s e
orState
            { _gsViewport :: Rect
_gsViewport = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
            , _gsGraphDatas :: [GraphData s e]
_gsGraphDatas = [GraphData s e]
graphDatas
            , _gsPrevGraphDatas :: [GraphData s e]
_gsPrevGraphDatas = [GraphData s e]
graphDatas
            , _gsAnimationStates :: [(Bool, Millisecond)]
_gsAnimationStates = [GraphData s e]
graphDatas forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Bool
False, Millisecond
0)]
            }
        style :: StyleState
style = forall {s} {e}. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
        req :: [WidgetRequest s e]
req = [forall s e.
WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
RenderEvery (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId) Millisecond
10 forall a. Maybe a
Nothing]

    merge :: p -> WidgetNode s e -> p -> GraphState s e -> WidgetResult s e
merge p
wenv WidgetNode s e
newNode p
_ GraphState s e
oldState = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
resNode [WidgetRequest s e]
req where
        resNode :: WidgetNode s e
resNode = forall {t}. HasWidget t (Widget s e) => GraphState s e -> t -> t
makeNodeWithState GraphState s e
newState WidgetNode s e
newNode
        newState :: GraphState s e
newState = GraphState s e
oldState
            { _gsGraphDatas :: [GraphData s e]
_gsGraphDatas = [GraphData s e]
graphDatas
            , _gsPrevGraphDatas :: [GraphData s e]
_gsPrevGraphDatas = [GraphData s e]
prev
            , _gsAnimationStates :: [(Bool, Millisecond)]
_gsAnimationStates = [(Bool, Millisecond)]
newStates
            }
        prev :: [GraphData s e]
prev = forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 forall {p}. p -> p -> Bool -> p
choosePrev [GraphData s e]
prevNew [GraphData s e]
prevOld [Bool]
comparisons
        choosePrev :: p -> p -> Bool -> p
choosePrev p
new p
old Bool
same = if Bool
same then p
old else p
new
        prevNew :: [GraphData s e]
prevNew = forall {s} {e}. Millisecond -> GraphState s e -> [GraphData s e]
makeProgDatas Millisecond
ts GraphState s e
oldState forall a. Semigroup a => a -> a -> a
<> [GraphData s e]
tailDatas
        prevOld :: [GraphData s e]
prevOld = forall s e. GraphState s e -> [GraphData s e]
_gsPrevGraphDatas GraphState s e
oldState forall a. Semigroup a => a -> a -> a
<> [GraphData s e]
tailDatas
        req :: [WidgetRequest s e]
req = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ [forall s e.
WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
RenderEvery WidgetId
widgetId Millisecond
10 forall a. Maybe a
Nothing]forall a. a -> [a] -> [a]
:[[WidgetRequest s e]]
reqs
        ([(Bool, Millisecond)]
newStates, [[WidgetRequest s e]]
reqs, [Bool]
comparisons) = forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [((Bool, Millisecond), [WidgetRequest s e], Bool)]
stateReqs
        stateReqs :: [((Bool, Millisecond), [WidgetRequest s e], Bool)]
stateReqs = forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 forall {s} {e} {s} {e}.
Int
-> GraphData s e
-> GraphData s e
-> ((Bool, Millisecond), [WidgetRequest s e], Bool)
f [Int
0..] [GraphData s e]
graphDatas [GraphData s e]
oldDatas
        f :: Int
-> GraphData s e
-> GraphData s e
-> ((Bool, Millisecond), [WidgetRequest s e], Bool)
f Int
i GraphData s e
graphData GraphData s e
oldData = ((Bool, Millisecond), [WidgetRequest s e], Bool)
stateReq where
            stateReq :: ((Bool, Millisecond), [WidgetRequest s e], Bool)
stateReq = if forall {s} {e} {s} {e}. GraphData s e -> GraphData s e -> Bool
isSame GraphData s e
graphData GraphData s e
oldData
                then ([(Bool, Millisecond)]
statesforall a. [a] -> Int -> a
!!Int
i, [], Bool
True)
                else ((Millisecond
dur forall a. Ord a => a -> a -> Bool
> Millisecond
0, Millisecond
ts), [WidgetRequest s e
finReq], Bool
False)
            finReq :: WidgetRequest s e
finReq = forall i s e.
Typeable i =>
WidgetNode s e -> i -> Millisecond -> WidgetRequest s e
delayedMessage WidgetNode s e
newNode (Int -> Millisecond -> GraphMsg
GraphFinished Int
i Millisecond
ts) Millisecond
dur
            dur :: Millisecond
dur = forall a. a -> Maybe a -> a
fromMaybe Millisecond
0 forall a b. (a -> b) -> a -> b
$ forall s e. GraphData s e -> Maybe Millisecond
_gdDuration GraphData s e
graphData
        isSame :: GraphData s e -> GraphData s e -> Bool
isSame GraphData s e
a1 GraphData s e
a2 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. a -> a
id
            [ forall s e. GraphData s e -> [(Double, Double)]
_gdPoints GraphData s e
a1 forall a. Eq a => a -> a -> Bool
== forall s e. GraphData s e -> [(Double, Double)]
_gdPoints GraphData s e
a2
            , forall s e. GraphData s e -> Maybe Color
_gdColor GraphData s e
a1 forall a. Eq a => a -> a -> Bool
== forall s e. GraphData s e -> Maybe Color
_gdColor GraphData s e
a2
            , forall s e. GraphData s e -> Maybe Color
_gdBorderColor GraphData s e
a1 forall a. Eq a => a -> a -> Bool
== forall s e. GraphData s e -> Maybe Color
_gdBorderColor GraphData s e
a2
            , forall s e. GraphData s e -> Maybe Double
_gdWidth GraphData s e
a1 forall a. Eq a => a -> a -> Bool
== forall s e. GraphData s e -> Maybe Double
_gdWidth GraphData s e
a2
            , forall s e. GraphData s e -> Maybe Double
_gdRadius GraphData s e
a1 forall a. Eq a => a -> a -> Bool
== forall s e. GraphData s e -> Maybe Double
_gdRadius GraphData s e
a2
            , forall s e. GraphData s e -> Maybe Double
_gdFillAlpha GraphData s e
a1 forall a. Eq a => a -> a -> Bool
== forall s e. GraphData s e -> Maybe Double
_gdFillAlpha GraphData s e
a2
            ]
        oldDatas :: [GraphData s e]
oldDatas = forall s e. GraphState s e -> [GraphData s e]
_gsGraphDatas GraphState s e
oldState forall a. Semigroup a => a -> a -> a
<> [GraphData s e]
tailDatas
        tailDatas :: [GraphData s e]
tailDatas = forall a. Int -> [a] -> [a]
drop Int
lo [GraphData s e]
graphDatas
        lo :: Int
lo = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall s e. GraphState s e -> [GraphData s e]
_gsGraphDatas GraphState s e
oldState
        states :: [(Bool, Millisecond)]
states = (forall s e. GraphState s e -> [(Bool, Millisecond)]
_gsAnimationStates GraphState s e
oldState) forall a. Semigroup a => a -> a -> a
<> forall a. a -> [a]
repeat (Bool
False, Millisecond
0)
        widgetId :: WidgetId
widgetId = WidgetNode s e
newNode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
        ts :: Millisecond
ts = p
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasTimestamp s a => Lens' s a
L.timestamp

    handleEvent :: WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent WidgetEnv s e
wenv WidgetNode s e
node p
_ SystemEvent
event = Maybe (WidgetResult s e)
result where
        result :: Maybe (WidgetResult s e)
result = case SystemEvent
event of
            ButtonAction Point
p Button
_ ButtonState
BtnPressed Int
_ -> Point -> Maybe (WidgetResult s e)
resultPressed Point
p
            ButtonAction Point
p Button
BtnRight ButtonState
BtnReleased Int
_ -> Point -> Maybe (WidgetResult s e)
resultRight Point
p
            ButtonAction Point
_ Button
_ ButtonState
BtnReleased Int
_ -> WidgetNode s e -> Maybe (WidgetResult s e)
handleReleased WidgetNode s e
node
            Move Point
p -> WidgetEnv s e
-> WidgetNode s e -> Point -> Maybe (WidgetResult s e)
handleMove WidgetEnv s e
wenv WidgetNode s e
node Point
p
            WheelScroll Point
p (Point Double
_ Double
wy) WheelDirection
_ -> Point -> Double -> Maybe (WidgetResult s e)
resultScroll Point
p Double
wy
            SystemEvent
_ -> forall a. Maybe a
Nothing
        resultRight :: Point -> Maybe (WidgetResult s e)
resultRight (Point Double
x Double
y) = forall a. a -> Maybe a
Just WidgetResult s e
res where
            res :: WidgetResult s e
res = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node forall a b. (a -> b) -> a -> b
$ (forall a b. (a -> b) -> a -> b
$ (Double, Double)
p') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Double, Double) -> WidgetRequest s e]
_gcOnRightClickReq
            p' :: (Double, Double)
p' = ((Double
xforall a. Num a => a -> a -> a
-Double
ox)forall a. Fractional a => a -> a -> a
/Double
64forall a. Fractional a => a -> a -> a
/Double
cx, (Double
oyforall a. Num a => a -> a -> a
-Double
y)forall a. Fractional a => a -> a -> a
/Double
64forall a. Fractional a => a -> a -> a
/Double
cy)
        resultPressed :: Point -> Maybe (WidgetResult s e)
resultPressed Point
p = forall {s} {e}. WidgetNode s e -> Maybe (WidgetResult s e)
resultRender forall a b. (a -> b) -> a -> b
$ GraphState s e -> WidgetNode s e
newNode forall a b. (a -> b) -> a -> b
$ GraphState s e
state
            { _gsMousePosition :: Maybe Point
_gsMousePosition = forall a. a -> Maybe a
Just Point
p
            , _gsActivePoint :: Maybe (Int, Int)
_gsActivePoint = forall s e. GraphState s e -> Maybe (Int, Int)
_gsHoverPoint GraphState s e
state
            }
        resultScroll :: Point -> Double -> Maybe (WidgetResult s e)
resultScroll Point
p = forall {s} {e}. WidgetNode s e -> Maybe (WidgetResult s e)
resultRender forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Double -> WidgetNode s e
newScroll Point
p
        newScroll :: Point -> Double -> WidgetNode s e
newScroll (Point Double
mx Double
my) Double
wy = GraphState s e -> WidgetNode s e
newNode forall a b. (a -> b) -> a -> b
$ GraphState s e
state
            { _gsTranslation :: Point
_gsTranslation = Double -> Double -> Point
Point Double
tx' Double
ty'
            , _gsScale :: Point
_gsScale = Double -> Double -> Point
Point Double
cx' Double
cy'
            , _gsUnit :: Point
_gsUnit = Double -> Double -> Point
Point Double
ux Double
uy
            , _gsSections :: Point
_gsSections = Double -> Double -> Point
Point (forall {a} {a}. (Num a, Floating a, Real a) => a -> a
getSec Double
cx') (forall {a} {a}. (Num a, Floating a, Real a) => a -> a
getSec Double
cy')
            } where
                tx' :: Double
tx' = Double
mx'forall a. Num a => a -> a -> a
-(Double
mx'forall a. Num a => a -> a -> a
-Double
tx)forall a. Num a => a -> a -> a
*Double
cx'forall a. Fractional a => a -> a -> a
/Double
cx
                ty' :: Double
ty' = Double
my'forall a. Num a => a -> a -> a
-(Double
my'forall a. Num a => a -> a -> a
-Double
ty)forall a. Num a => a -> a -> a
*Double
cy'forall a. Fractional a => a -> a -> a
/Double
cy
                (Double
mx', Double
my') = (Double
mxforall a. Num a => a -> a -> a
-Double
gxforall a. Num a => a -> a -> a
-Double
gwforall a. Fractional a => a -> a -> a
/Double
2, Double
myforall a. Num a => a -> a -> a
-Double
gyforall a. Num a => a -> a -> a
-Double
ghforall a. Fractional a => a -> a -> a
/Double
2)
                (Double
ux, Double
uy) = (Double -> Double
getUnit Double
cx', Double -> Double
getUnit Double
cy')
                (Double
cx', Double
cy') = Double -> Double -> (Double, Double) -> (Double, Double)
clampScale Double
gw Double
gh (Double, Double)
newScale
                newScale :: (Double, Double)
newScale = (Double
cxforall a. Num a => a -> a -> a
*Double
rateXforall a. Floating a => a -> a -> a
**Double
wy, Double
cyforall a. Num a => a -> a -> a
*Double
rateYforall a. Floating a => a -> a -> a
**Double
wy)
                rateX :: Double
rateX = if Maybe Bool
_gcLockX forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
                    then Double
1
                    else Double
1.05forall a. Floating a => a -> a -> a
**Double
wr
                rateY :: Double
rateY = if Maybe Bool
_gcLockY forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
                    then Double
1
                    else Double
1.05forall a. Floating a => a -> a -> a
**Double
wr
                wr :: Double
wr = forall a. a -> Maybe a -> a
fromMaybe Double
1 Maybe Double
_gcWheelRate
        (Double
ox, Double
oy) = (Double
gxforall a. Num a => a -> a -> a
+Double
gwforall a. Fractional a => a -> a -> a
/Double
2forall a. Num a => a -> a -> a
+Double
tx, Double
gyforall a. Num a => a -> a -> a
+Double
ghforall a. Fractional a => a -> a -> a
/Double
2forall a. Num a => a -> a -> a
+Double
ty)
        Rect Double
gx Double
gy Double
gw Double
gh = forall s e. GraphState s e -> Rect
_gsViewport GraphState s e
state
        getSec :: a -> a
getSec a
x = let l :: a
l = a
10forall a. Floating a => a -> a -> a
**(forall a. Real a => a -> a -> a
mod' (forall a. Floating a => a -> a -> a
logBase a
10 a
x) a
1) in
            if a
l forall a. Ord a => a -> a -> Bool
>= a
5 then a
4 else a
5
        getUnit :: Double -> Double
getUnit Double
x
            | Double
l forall a. Ord a => a -> a -> Bool
>= Double
5 = Double
2forall a. Num a => a -> a -> a
*Double
d
            | Double
l forall a. Ord a => a -> a -> Bool
>= Double
2 = Double
5forall a. Num a => a -> a -> a
*Double
d
            | Bool
otherwise = Double
10forall a. Num a => a -> a -> a
*Double
d
            where
                l :: Double
l = Double
10forall a. Floating a => a -> a -> a
**(forall a. Real a => a -> a -> a
mod' (forall a. Floating a => a -> a -> a
logBase Double
10 Double
x) Double
1)
                d :: Double
d = Double
10forall a. Floating a => a -> a -> a
**(-Double
1forall a. Num a => a -> a -> a
-(Double -> Double
floor' forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a -> a -> a
logBase Double
10 Double
x))
        Point Double
tx Double
ty = forall s e. GraphState s e -> Point
_gsTranslation GraphState s e
state
        Point Double
cx Double
cy = forall s e. GraphState s e -> Point
_gsScale GraphState s e
state
        newNode :: GraphState s e -> WidgetNode s e
newNode GraphState s e
s = forall {t}. HasWidget t (Widget s e) => GraphState s e -> t -> t
makeNodeWithState GraphState s e
s WidgetNode s e
node

    handleReleased :: WidgetNode s e -> Maybe (WidgetResult s e)
handleReleased WidgetNode s e
node = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
reqs where
        newNode :: WidgetNode s e
newNode = forall {t}. HasWidget t (Widget s e) => GraphState s e -> t -> t
makeNodeWithState GraphState s e
newState WidgetNode s e
node
        newState :: GraphState s e
newState = GraphState s e
state
            { _gsMousePosition :: Maybe Point
_gsMousePosition = forall a. Maybe a
Nothing
            , _gsActivePoint :: Maybe (Int, Int)
_gsActivePoint = forall a. Maybe a
Nothing
            }
        reqs :: [WidgetRequest s e]
reqs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall s e. GraphState s e -> Maybe (Int, Int)
_gsActivePoint GraphState s e
state)
            then []
            else (forall a b. (a -> b) -> a -> b
$ Int
j) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s e. GraphData s e -> [Int -> WidgetRequest s e]
_gdClickReq forall a b. (a -> b) -> a -> b
$ [GraphData s e]
graphDatasforall a. [a] -> Int -> a
!!Int
i)
        (Int
i, Int
j) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall s e. GraphState s e -> Maybe (Int, Int)
_gsActivePoint GraphState s e
state

    handleMove :: WidgetEnv s e
-> WidgetNode s e -> Point -> Maybe (WidgetResult s e)
handleMove WidgetEnv s e
wenv WidgetNode s e
node moveP :: Point
moveP@(Point Double
x Double
y) = Maybe (WidgetResult s e)
result where
        result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
reqs
        newNode :: WidgetNode s e
newNode = forall {t}. HasWidget t (Widget s e) => GraphState s e -> t -> t
makeNodeWithState GraphState s e
newState WidgetNode s e
node
        newState :: GraphState s e
newState
            | forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node Bool -> Bool -> Bool
&& Bool
dragPoint = GraphState s e
state
            | forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node Bool -> Bool -> Bool
&& (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe Point
mp) = GraphState s e
state
                { _gsTranslation :: Point
_gsTranslation = Double -> Double -> Point
Point (Double
txforall a. Num a => a -> a -> a
+Double
xforall a. Num a => a -> a -> a
-Double
mx0) (Double
tyforall a. Num a => a -> a -> a
+Double
yforall a. Num a => a -> a -> a
-Double
my0)
                , _gsMousePosition :: Maybe Point
_gsMousePosition = forall a. a -> Maybe a
Just Point
moveP
                }
            | Bool
otherwise = GraphState s e
state
                { _gsHoverPoint :: Maybe (Int, Int)
_gsHoverPoint = Maybe (Int, Int)
hp
                }
        reqs :: [WidgetRequest s e]
reqs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ if Bool
dragPoint
                then (\Int -> (Double, Double) -> WidgetRequest s e
f -> Int -> (Double, Double) -> WidgetRequest s e
f Int
dj (Double
dx, Double
dy)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int -> (Double, Double) -> WidgetRequest s e]
reportC
                else []
            , if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (Int, Int)
hps Bool -> Bool -> Bool
|| Maybe (Int, Int)
hp forall a. Eq a => a -> a -> Bool
== Maybe (Int, Int)
hps
                then []
                else (forall a b. (a -> b) -> a -> b
$ Int
lj) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int -> WidgetRequest s e]
reportL
            , if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (Int, Int)
hp Bool -> Bool -> Bool
|| Maybe (Int, Int)
hp forall a. Eq a => a -> a -> Bool
== Maybe (Int, Int)
hps
                then []
                else (forall a b. (a -> b) -> a -> b
$ Int
hj) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int -> WidgetRequest s e]
reportE
            , [forall s e. WidgetRequest s e
RenderOnce]
            ]
        dragPoint :: Bool
dragPoint = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (Int, Int)
dp Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int -> (Double, Double) -> WidgetRequest s e]
reportC)
        Point Double
tx Double
ty = forall s e. GraphState s e -> Point
_gsTranslation GraphState s e
state
        Point Double
cx Double
cy = forall s e. GraphState s e -> Point
_gsScale GraphState s e
state
        Point Double
mx0 Double
my0 = forall a. HasCallStack => Maybe a -> a
fromJust Maybe Point
mp
        mp :: Maybe Point
mp = forall s e. GraphState s e -> Maybe Point
_gsMousePosition GraphState s e
state
        (Int
di, Int
dj) = forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, Int)
dp
        dp :: Maybe (Int, Int)
dp = forall s e. GraphState s e -> Maybe (Int, Int)
_gsActivePoint GraphState s e
state
        reportC :: [Int -> (Double, Double) -> WidgetRequest s e]
reportC = forall s e.
GraphData s e -> [Int -> (Double, Double) -> WidgetRequest s e]
_gdChangeReq forall a b. (a -> b) -> a -> b
$ [GraphData s e]
graphDatasforall a. [a] -> Int -> a
!!Int
di
        reportE :: [Int -> WidgetRequest s e]
reportE = forall s e. GraphData s e -> [Int -> WidgetRequest s e]
_gdEnterReq forall a b. (a -> b) -> a -> b
$ [GraphData s e]
graphDatasforall a. [a] -> Int -> a
!!Int
hi
        reportL :: [Int -> WidgetRequest s e]
reportL = forall s e. GraphData s e -> [Int -> WidgetRequest s e]
_gdLeaveReq forall a b. (a -> b) -> a -> b
$ [GraphData s e]
graphDatasforall a. [a] -> Int -> a
!!Int
li
        (Int
li, Int
lj) = forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, Int)
hps
        (Int
hi, Int
hj) = forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, Int)
hp
        hps :: Maybe (Int, Int)
hps = forall s e. GraphState s e -> Maybe (Int, Int)
_gsHoverPoint GraphState s e
state
        hp :: Maybe (Int, Int)
hp = forall {a} {a} {s} {e}.
(Num a, Enum a) =>
[(a, GraphData s e)] -> Maybe (a, a)
hoverPointData forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [GraphData s e]
graphDatas
        hoverPointData :: [(a, GraphData s e)] -> Maybe (a, a)
hoverPointData [] = forall a. Maybe a
Nothing
        hoverPointData ((a
i, GraphData s e
graphData):[(a, GraphData s e)]
xs)
            | forall s e. GraphData s e -> Maybe Bool
_gdSeparate GraphData s e
graphData forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Bool
True = [(a, GraphData s e)] -> Maybe (a, a)
hoverPointData [(a, GraphData s e)]
xs
            | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe a
hp' = [(a, GraphData s e)] -> Maybe (a, a)
hoverPointData [(a, GraphData s e)]
xs
            | Bool
otherwise = (,) a
i forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
hp'
            where
                hp' :: Maybe a
hp' = forall {a}. (Double, Double) -> [(a, (Double, Double))] -> Maybe a
getHP (Double, Double)
rs forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [a
0..] forall a b. (a -> b) -> a -> b
$ forall s e. GraphData s e -> [(Double, Double)]
_gdPoints GraphData s e
graphData
                rs :: (Double, Double)
rs = (Double
rx, Double
ry)
                rx :: Double
rx = forall a. a -> Maybe a -> a
fromMaybe (Double
rforall a. Fractional a => a -> a -> a
/Double
64forall a. Fractional a => a -> a -> a
/Double
cx) forall a b. (a -> b) -> a -> b
$ forall s e. GraphData s e -> Maybe Double
_gdRadius GraphData s e
graphData
                ry :: Double
ry = forall a. a -> Maybe a -> a
fromMaybe (Double
rforall a. Fractional a => a -> a -> a
/Double
64forall a. Fractional a => a -> a -> a
/Double
cy) forall a b. (a -> b) -> a -> b
$ forall s e. GraphData s e -> Maybe Double
_gdRadius GraphData s e
graphData
                r :: Double
r = Double
2forall a. Num a => a -> a -> a
*(forall a. a -> Maybe a -> a
fromMaybe Double
2 forall a b. (a -> b) -> a -> b
$ forall s e. GraphData s e -> Maybe Double
_gdWidth GraphData s e
graphData)
        getHP :: (Double, Double) -> [(a, (Double, Double))] -> Maybe a
getHP (Double, Double)
_ [] = forall a. Maybe a
Nothing
        getHP (Double, Double)
rs ((a
j, (Double, Double)
pp):[(a, (Double, Double))]
xs) = if (Double, Double) -> (Double, Double) -> Bool
checkHover (Double, Double)
pp (Double, Double)
rs
            then forall a. a -> Maybe a
Just a
j
            else (Double, Double) -> [(a, (Double, Double))] -> Maybe a
getHP (Double, Double)
rs [(a, (Double, Double))]
xs
        checkHover :: (Double, Double) -> (Double, Double) -> Bool
checkHover (Double
px, Double
py) (Double
rx, Double
ry) = Point -> Rect -> Bool
pointInEllipse Point
p Rect
rect where
            p :: Point
p = Double -> Double -> Point
Point Double
dx Double
dy
            rect :: Rect
rect = Double -> Double -> Double -> Double -> Rect
Rect (Double
pxforall a. Num a => a -> a -> a
-Double
rx) (Double
pyforall a. Num a => a -> a -> a
-Double
ry) (Double
rxforall a. Num a => a -> a -> a
*Double
2) (Double
ryforall a. Num a => a -> a -> a
*Double
2)
        (Double
dx, Double
dy) = ((Double
xforall a. Num a => a -> a -> a
-Double
ox)forall a. Fractional a => a -> a -> a
/Double
64forall a. Fractional a => a -> a -> a
/Double
cx, (Double
oyforall a. Num a => a -> a -> a
-Double
y)forall a. Fractional a => a -> a -> a
/Double
64forall a. Fractional a => a -> a -> a
/Double
cy)
        (Double
ox, Double
oy) = (Double
gxforall a. Num a => a -> a -> a
+Double
gwforall a. Fractional a => a -> a -> a
/Double
2forall a. Num a => a -> a -> a
+Double
tx, Double
gyforall a. Num a => a -> a -> a
+Double
ghforall a. Fractional a => a -> a -> a
/Double
2forall a. Num a => a -> a -> a
+Double
ty)
        Rect Double
gx Double
gy Double
gw Double
gh = forall s e. GraphState s e -> Rect
_gsViewport GraphState s e
state

    resultRender :: WidgetNode s e -> Maybe (WidgetResult s e)
resultRender WidgetNode s e
node = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetRequest s e
RenderOnce]

    handleMessage :: p -> WidgetNode s e -> p -> p -> Maybe (WidgetResult s e)
handleMessage p
_ WidgetNode s e
node p
_ p
message = do
        let casted :: Maybe GraphMsg
casted = forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast p
message
        GraphState s e
s <- GraphMsg -> GraphState s e
getNewState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GraphMsg
casted
        [WidgetRequest s e]
req <- forall {p} {a}.
(HasInfo p a, HasWidgetId a WidgetId) =>
p -> GraphMsg -> [WidgetRequest s e]
getMessageReq WidgetNode s e
node forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GraphMsg
casted
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs (forall {t}. HasWidget t (Widget s e) => GraphState s e -> t -> t
makeNodeWithState GraphState s e
s WidgetNode s e
node) [WidgetRequest s e]
req

    getNewState :: GraphMsg -> GraphState s e
getNewState (GraphSetTranslation Point
p) = GraphState s e
state {_gsTranslation :: Point
_gsTranslation = Point
p}
    getNewState (GraphSetScale Point
p) = GraphState s e
state {_gsScale :: Point
_gsScale = Point
p}
    getNewState GraphMsg
GraphReset = GraphState s e
state
        { _gsTranslation :: Point
_gsTranslation = forall s e. GraphState s e -> Point
_gsTranslation forall a. Default a => a
def
        , _gsScale :: Point
_gsScale = forall s e. GraphState s e -> Point
_gsScale forall a. Default a => a
def
        , _gsUnit :: Point
_gsUnit = forall s e. GraphState s e -> Point
_gsUnit forall a. Default a => a
def
        , _gsSections :: Point
_gsSections = forall s e. GraphState s e -> Point
_gsSections forall a. Default a => a
def
        , _gsMousePosition :: Maybe Point
_gsMousePosition = forall s e. GraphState s e -> Maybe Point
_gsMousePosition forall a. Default a => a
def
        , _gsHoverPoint :: Maybe (Int, Int)
_gsHoverPoint = forall s e. GraphState s e -> Maybe (Int, Int)
_gsHoverPoint forall a. Default a => a
def
        , _gsActivePoint :: Maybe (Int, Int)
_gsActivePoint = forall s e. GraphState s e -> Maybe (Int, Int)
_gsActivePoint forall a. Default a => a
def
        }
    getNewState GraphMsg
GraphStopAnimations = GraphState s e
state
        { _gsAnimationStates :: [(Bool, Millisecond)]
_gsAnimationStates = [GraphData s e]
graphDatas forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Bool
False, Millisecond
0)]
        }
    getNewState GraphMsg
_ = GraphState s e
state

    getMessageReq :: p -> GraphMsg -> [WidgetRequest s e]
getMessageReq p
node GraphMsg
GraphStopAnimations = [forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
i] where
        i :: WidgetId
i = p
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
    getMessageReq p
_ (GraphFinished Int
i Millisecond
t) = [WidgetRequest s e]
req where
        req :: [WidgetRequest s e]
req = if Int
i forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [GraphData s e]
graphDatas Bool -> Bool -> Bool
&& Bool
running Bool -> Bool -> Bool
&& Bool
sameTs
            then forall s e. GraphData s e -> [WidgetRequest s e]
_gdFinishedReq forall a b. (a -> b) -> a -> b
$ [GraphData s e]
graphDatasforall a. [a] -> Int -> a
!!Int
i
            else []
        running :: Bool
running = forall a b. (a, b) -> a
fst (Bool, Millisecond)
animationState
        sameTs :: Bool
sameTs = forall a b. (a, b) -> b
snd (Bool, Millisecond)
animationState forall a. Eq a => a -> a -> Bool
== Millisecond
t
        animationState :: (Bool, Millisecond)
animationState = (forall s e. GraphState s e -> [(Bool, Millisecond)]
_gsAnimationStates GraphState s e
state)forall a. [a] -> Int -> a
!!Int
i
    getMessageReq p
_ GraphMsg
_ = [forall s e. WidgetRequest s e
RenderOnce]

    getSizeReq :: p -> p -> (SizeReq, SizeReq)
getSizeReq p
_ p
_ = (Double -> Double -> Double -> SizeReq
rangeSize Double
100 Double
2000 Double
1, Double -> Double -> Double -> SizeReq
rangeSize Double
100 Double
2000 Double
1)

    resize :: p -> WidgetNode s e -> Rect -> WidgetResult s e
resize p
_ WidgetNode s e
node Rect
vp = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
resNode where
        resNode :: WidgetNode s e
resNode = forall {t}. HasWidget t (Widget s e) => GraphState s e -> t -> t
makeNodeWithState GraphState s e
newState WidgetNode s e
node
        newState :: GraphState s e
newState = GraphState s e
state {_gsViewport :: Rect
_gsViewport = Rect
vp}

    render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
        let style :: StyleState
style = forall {s} {e}. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
            rect :: Rect
rect@(Rect Double
gx Double
gy Double
gw Double
gh) = forall s e. GraphState s e -> Rect
_gsViewport GraphState s e
state
            Point Double
tx Double
ty = forall s e. GraphState s e -> Point
_gsTranslation GraphState s e
state
            Point Double
cx Double
cy = forall s e. GraphState s e -> Point
_gsScale GraphState s e
state
            Point Double
ux Double
uy = forall s e. GraphState s e -> Point
_gsUnit GraphState s e
state
            Point Double
vs Double
hs = forall s e. GraphState s e -> Point
_gsSections GraphState s e
state
            (Double
ox, Double
oy) = (Double
gxforall a. Num a => a -> a -> a
+Double
gwforall a. Fractional a => a -> a -> a
/Double
2forall a. Num a => a -> a -> a
+Double
tx, Double
gyforall a. Num a => a -> a -> a
+Double
ghforall a. Fractional a => a -> a -> a
/Double
2forall a. Num a => a -> a -> a
+Double
ty)
            (Point
p1, Point
p2) = (Double -> Double -> Point
Point Double
ox Double
gy, Double -> Double -> Point
Point Double
ox (Double
gyforall a. Num a => a -> a -> a
+Double
gh))
            (Point
p3, Point
p4) = (Double -> Double -> Point
Point Double
gx Double
oy, Double -> Double -> Point
Point (Double
gxforall a. Num a => a -> a -> a
+Double
gw) Double
oy)
            line :: Point -> Point -> Double -> Color -> IO ()
line Point
a Point
b Double
w Color
c = Renderer -> Point -> Point -> Double -> Maybe Color -> IO ()
drawLine Renderer
renderer Point
a Point
b Double
w forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Color
c
            font :: Font
font = StyleState -> Font
styleFont StyleState
style
            fsize :: FontSize
fsize = Double -> FontSize
FontSize Double
16
            printText :: Point -> Text -> IO ()
printText Point
p Text
t = Renderer -> Point -> Font -> FontSize -> FontSpace -> Text -> IO ()
renderText Renderer
renderer Point
p Font
font FontSize
fsize forall a. Default a => a
def Text
t
            show' :: Double -> String
show' Double
n = String
s where
                s :: String
s = if Double -> Double
round' Double
n forall a. Eq a => a -> a -> Bool
== Double
n
                    then forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ (forall a b. (RealFrac a, Integral b) => a -> b
round Double
n :: Int)
                    else forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat forall a. Maybe a
Nothing Double
r String
""
                r :: Double
r = (Double -> Double
round' forall a b. (a -> b) -> a -> b
$ Double
nforall a. Num a => a -> a -> a
*Double
bn)forall a. Fractional a => a -> a -> a
/Double
bn
                bn :: Double
bn = Double
1000000000
            printN :: Point -> Double -> IO ()
printN Point
p = Point -> Text -> IO ()
printText Point
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
show'
            background :: Maybe Color
background = StyleState
style forall s a. s -> Getting a s a -> a
^. forall s a. HasBgColor s a => Lens' s a
L.bgColor forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just Color
white
            fore :: Color
fore = forall a. a -> Maybe a -> a
fromMaybe Color
black forall a b. (a -> b) -> a -> b
$ StyleState
style forall s a. s -> Getting a s a -> a
^. forall s a. HasFgColor s a => Lens' s a
L.fgColor
            foreN :: Color
foreN = forall a. a -> Maybe a -> a
fromMaybe Color
black forall a b. (a -> b) -> a -> b
$ StyleState
style forall s a. s -> Getting a s a -> a
^. forall s a. HasSndColor s a => Lens' s a
L.sndColor
        Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
rect Maybe Color
background forall a. Maybe a
Nothing
        Renderer -> IO ()
saveContext Renderer
renderer
        Renderer -> Rect -> IO ()
intersectScissor Renderer
renderer Rect
rect
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Bool
_gcHideGrid forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Bool
True) forall a b. (a -> b) -> a -> b
$ do
            Point -> Point -> Double -> Color -> IO ()
line Point
p1 Point
p2 Double
2 Color
fore
            Point -> Point -> Double -> Color -> IO ()
line Point
p3 Point
p4 Double
2 Color
fore
        let (Double
sx, Double
sy) = (Double
64forall a. Num a => a -> a -> a
*Double
cxforall a. Num a => a -> a -> a
*Double
ux, Double
64forall a. Num a => a -> a -> a
*Double
cyforall a. Num a => a -> a -> a
*Double
uy)
            verLine :: Double -> IO ()
verLine Double
x = Point -> Point -> Double -> Color -> IO ()
line (Double -> Double -> Point
Point Double
x Double
gy) (Double -> Double -> Point
Point Double
x (Double
gyforall a. Num a => a -> a -> a
+Double
gh)) Double
1 Color
fore
            horLine :: Double -> IO ()
horLine Double
y = Point -> Point -> Double -> Color -> IO ()
line (Double -> Double -> Point
Point Double
gx Double
y) (Double -> Double -> Point
Point (Double
gxforall a. Num a => a -> a -> a
+Double
gw) Double
y) Double
1 Color
fore
            uxl :: Double -> b
uxl Double
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Double -> String
show' forall a b. (a -> b) -> a -> b
$ Double
uyforall a. Num a => a -> a -> a
*Double
x
            clampX :: Double -> Double
clampX Double
x = forall a. Ord a => a -> a -> a
max (Double
gxforall a. Num a => a -> a -> a
+Double
8) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min (Double
gxforall a. Num a => a -> a -> a
+Double
gwforall a. Num a => a -> a -> a
-Double
8forall a. Num a => a -> a -> a
*(forall {b}. Num b => Double -> b
uxl Double
x)forall a. Num a => a -> a -> a
-Double
4) forall a b. (a -> b) -> a -> b
$ Double
oxforall a. Num a => a -> a -> a
+Double
8
            clampY :: Double
clampY = forall a. Ord a => a -> a -> a
max (Double
gyforall a. Num a => a -> a -> a
+Double
16) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min (Double
gyforall a. Num a => a -> a -> a
+Double
ghforall a. Num a => a -> a -> a
-Double
16) forall a b. (a -> b) -> a -> b
$ Double
oyforall a. Num a => a -> a -> a
+Double
16
            verN :: Double -> IO ()
verN Double
x = Point -> Double -> IO ()
printN (Double -> Double -> Point
Point (Double
oxforall a. Num a => a -> a -> a
+Double
sxforall a. Num a => a -> a -> a
*Double
xforall a. Num a => a -> a -> a
+Double
4) Double
clampY) forall a b. (a -> b) -> a -> b
$ Double
uxforall a. Num a => a -> a -> a
*Double
x
            horN :: Double -> IO ()
horN Double
x = Point -> Double -> IO ()
printN (Double -> Double -> Point
Point (Double -> Double
clampX Double
x) (Double
oyforall a. Num a => a -> a -> a
-Double
syforall a. Num a => a -> a -> a
*Double
x)) forall a b. (a -> b) -> a -> b
$ Double
uyforall a. Num a => a -> a -> a
*Double
x
            horN' :: Double -> IO ()
horN' Double
x = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
x forall a. Eq a => a -> a -> Bool
/= Double
0) forall a b. (a -> b) -> a -> b
$ Double -> IO ()
horN Double
x
            (Double
fox, Double
foy) = (-(Double -> Double
round' forall a b. (a -> b) -> a -> b
$ Double
txforall a. Fractional a => a -> a -> a
/Double
sx), Double -> Double
round' forall a b. (a -> b) -> a -> b
$ Double
tyforall a. Fractional a => a -> a -> a
/Double
sy)
            ovx :: Double
ovx = Double
oxforall a. Num a => a -> a -> a
-(Double -> Double
round' forall a b. (a -> b) -> a -> b
$ Double
txforall a. Num a => a -> a -> a
*Double
vsforall a. Fractional a => a -> a -> a
/Double
sx)forall a. Num a => a -> a -> a
*Double
sxforall a. Fractional a => a -> a -> a
/Double
vs
            ovy :: Double
ovy = Double
oyforall a. Num a => a -> a -> a
-(Double -> Double
round' forall a b. (a -> b) -> a -> b
$ Double
tyforall a. Num a => a -> a -> a
*Double
hsforall a. Fractional a => a -> a -> a
/Double
sy)forall a. Num a => a -> a -> a
*Double
syforall a. Fractional a => a -> a -> a
/Double
hs
            ovx1 :: Double
ovx1 = Double
oxforall a. Num a => a -> a -> a
+Double
foxforall a. Num a => a -> a -> a
*Double
sx
            ovy1 :: Double
ovy1 = Double
oyforall a. Num a => a -> a -> a
-Double
foyforall a. Num a => a -> a -> a
*Double
sy
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. a -> Maybe a
Just Bool
True forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Bool
_gcHideMinor, Maybe Bool
_gcHideGrid]) forall a b. (a -> b) -> a -> b
$
            Renderer -> Double -> IO () -> IO ()
drawInAlpha Renderer
renderer Double
0.2 forall a b. (a -> b) -> a -> b
$ do
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Double
ovx, Double
ovxforall a. Num a => a -> a -> a
-Double
sxforall a. Fractional a => a -> a -> a
/Double
vs..Double
gx] Double -> IO ()
verLine
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Double
ovx, Double
ovxforall a. Num a => a -> a -> a
+Double
sxforall a. Fractional a => a -> a -> a
/Double
vs..(Double
gxforall a. Num a => a -> a -> a
+Double
gw)] Double -> IO ()
verLine
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Double
ovy, Double
ovyforall a. Num a => a -> a -> a
-Double
syforall a. Fractional a => a -> a -> a
/Double
hs..Double
gy] Double -> IO ()
horLine
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Double
ovy, Double
ovyforall a. Num a => a -> a -> a
+Double
syforall a. Fractional a => a -> a -> a
/Double
hs..(Double
gyforall a. Num a => a -> a -> a
+Double
gh)] Double -> IO ()
horLine
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Bool
_gcHideGrid forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Bool
True) forall a b. (a -> b) -> a -> b
$
            Renderer -> Double -> IO () -> IO ()
drawInAlpha Renderer
renderer Double
0.5 forall a b. (a -> b) -> a -> b
$ do
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Double
ovx1, Double
ovx1forall a. Num a => a -> a -> a
-Double
sx..Double
gx] Double -> IO ()
verLine
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Double
ovx1, Double
ovx1forall a. Num a => a -> a -> a
+Double
sx..(Double
gxforall a. Num a => a -> a -> a
+Double
gw)] Double -> IO ()
verLine
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Double
ovy1, Double
ovy1forall a. Num a => a -> a -> a
-Double
sy..Double
gy] Double -> IO ()
horLine
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Double
ovy1, Double
ovy1forall a. Num a => a -> a -> a
+Double
sy..(Double
gyforall a. Num a => a -> a -> a
+Double
gh)] Double -> IO ()
horLine
        let p :: (Double, Double) -> (Double, Double)
p (Double
x, Double
y) = (Double
64forall a. Num a => a -> a -> a
*Double
cxforall a. Num a => a -> a -> a
*Double
xforall a. Num a => a -> a -> a
+Double
ox, Double
64forall a. Num a => a -> a -> a
*Double
cyforall a. Num a => a -> a -> a
*(-Double
y)forall a. Num a => a -> a -> a
+Double
oy)
            ts :: Millisecond
ts = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasTimestamp s a => Lens' s a
L.timestamp
            progDatas :: [GraphData s e]
progDatas = forall {s} {e}. Millisecond -> GraphState s e -> [GraphData s e]
makeProgDatas Millisecond
ts GraphState s e
state
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [GraphData s e]
progDatas) forall a b. (a -> b) -> a -> b
$ \(Int
i, GraphData s e
graphData) -> do
            let GraphData{[(Double, Double)]
[WidgetRequest s e]
[Int -> WidgetRequest s e]
[Int -> (Double, Double) -> WidgetRequest s e]
Maybe Bool
Maybe Double
Maybe Color
Maybe Millisecond
_gdFill :: forall s e. GraphData s e -> Maybe Bool
_gdActiveColor :: forall s e. GraphData s e -> Maybe Color
_gdHoverColor :: forall s e. GraphData s e -> Maybe Color
_gdClickReq :: [Int -> WidgetRequest s e]
_gdLeaveReq :: [Int -> WidgetRequest s e]
_gdEnterReq :: [Int -> WidgetRequest s e]
_gdChangeReq :: [Int -> (Double, Double) -> WidgetRequest s e]
_gdFinishedReq :: [WidgetRequest s e]
_gdDuration :: Maybe Millisecond
_gdFillAlpha :: Maybe Double
_gdFill :: Maybe Bool
_gdSeparate :: Maybe Bool
_gdRadius :: Maybe Double
_gdWidth :: Maybe Double
_gdBorderColor :: Maybe Color
_gdActiveColor :: Maybe Color
_gdHoverColor :: Maybe Color
_gdColor :: Maybe Color
_gdPoints :: [(Double, Double)]
_gdFinishedReq :: forall s e. GraphData s e -> [WidgetRequest s e]
_gdSeparate :: forall s e. GraphData s e -> Maybe Bool
_gdLeaveReq :: forall s e. GraphData s e -> [Int -> WidgetRequest s e]
_gdEnterReq :: forall s e. GraphData s e -> [Int -> WidgetRequest s e]
_gdChangeReq :: forall s e.
GraphData s e -> [Int -> (Double, Double) -> WidgetRequest s e]
_gdClickReq :: forall s e. GraphData s e -> [Int -> WidgetRequest s e]
_gdFillAlpha :: forall s e. GraphData s e -> Maybe Double
_gdRadius :: forall s e. GraphData s e -> Maybe Double
_gdWidth :: forall s e. GraphData s e -> Maybe Double
_gdBorderColor :: forall s e. GraphData s e -> Maybe Color
_gdColor :: forall s e. GraphData s e -> Maybe Color
_gdPoints :: forall s e. GraphData s e -> [(Double, Double)]
_gdDuration :: forall s e. GraphData s e -> Maybe Millisecond
..} = GraphData s e
graphData
                ps :: [(Double, Double)]
ps = (Double, Double) -> (Double, Double)
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Double, Double)]
_gdPoints
                newGraphData :: GraphData s e
newGraphData = GraphData s e
graphData {_gdPoints :: [(Double, Double)]
_gdPoints = [(Double, Double)]
ps}
            forall {s} {e}. Renderer -> GraphData s e -> Int -> IO ()
renderGraphData Renderer
renderer GraphData s e
newGraphData Int
i
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. a -> Maybe a
Just Bool
True forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Bool
_gcHideNumbers, Maybe Bool
_gcHideGrid]) forall a b. (a -> b) -> a -> b
$ do
            Renderer -> Color -> IO ()
setFillColor Renderer
renderer Color
foreN
            Renderer -> Double -> IO () -> IO ()
drawInAlpha Renderer
renderer Double
0.62 forall a b. (a -> b) -> a -> b
$ do
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Double
fox..(Double
foxforall a. Num a => a -> a -> a
+Double
20)] Double -> IO ()
verN
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Double
foxforall a. Num a => a -> a -> a
-Double
1),(Double
foxforall a. Num a => a -> a -> a
-Double
2)..(Double
foxforall a. Num a => a -> a -> a
-Double
20)] Double -> IO ()
verN
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Double
foy..(Double
foyforall a. Num a => a -> a -> a
+Double
20)] Double -> IO ()
horN'
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Double
foyforall a. Num a => a -> a -> a
-Double
1),(Double
foyforall a. Num a => a -> a -> a
-Double
2)..(Double
foyforall a. Num a => a -> a -> a
-Double
20)] Double -> IO ()
horN'
        Renderer -> IO ()
restoreContext Renderer
renderer

    renderGraphData :: Renderer -> GraphData s e -> Int -> IO ()
renderGraphData Renderer
renderer GraphData{[(Double, Double)]
[WidgetRequest s e]
[Int -> WidgetRequest s e]
[Int -> (Double, Double) -> WidgetRequest s e]
Maybe Bool
Maybe Double
Maybe Color
Maybe Millisecond
_gdClickReq :: [Int -> WidgetRequest s e]
_gdLeaveReq :: [Int -> WidgetRequest s e]
_gdEnterReq :: [Int -> WidgetRequest s e]
_gdChangeReq :: [Int -> (Double, Double) -> WidgetRequest s e]
_gdFinishedReq :: [WidgetRequest s e]
_gdDuration :: Maybe Millisecond
_gdFillAlpha :: Maybe Double
_gdFill :: Maybe Bool
_gdSeparate :: Maybe Bool
_gdRadius :: Maybe Double
_gdWidth :: Maybe Double
_gdBorderColor :: Maybe Color
_gdActiveColor :: Maybe Color
_gdHoverColor :: Maybe Color
_gdColor :: Maybe Color
_gdPoints :: [(Double, Double)]
_gdFill :: forall s e. GraphData s e -> Maybe Bool
_gdActiveColor :: forall s e. GraphData s e -> Maybe Color
_gdHoverColor :: forall s e. GraphData s e -> Maybe Color
_gdFinishedReq :: forall s e. GraphData s e -> [WidgetRequest s e]
_gdSeparate :: forall s e. GraphData s e -> Maybe Bool
_gdLeaveReq :: forall s e. GraphData s e -> [Int -> WidgetRequest s e]
_gdEnterReq :: forall s e. GraphData s e -> [Int -> WidgetRequest s e]
_gdChangeReq :: forall s e.
GraphData s e -> [Int -> (Double, Double) -> WidgetRequest s e]
_gdClickReq :: forall s e. GraphData s e -> [Int -> WidgetRequest s e]
_gdFillAlpha :: forall s e. GraphData s e -> Maybe Double
_gdRadius :: forall s e. GraphData s e -> Maybe Double
_gdWidth :: forall s e. GraphData s e -> Maybe Double
_gdBorderColor :: forall s e. GraphData s e -> Maybe Color
_gdColor :: forall s e. GraphData s e -> Maybe Color
_gdPoints :: forall s e. GraphData s e -> [(Double, Double)]
_gdDuration :: forall s e. GraphData s e -> Maybe Millisecond
..} Int
i = do
        let GraphState{[(Bool, Millisecond)]
[GraphData s e]
Maybe (Int, Int)
Maybe Point
Rect
Point
_gsAnimationStates :: [(Bool, Millisecond)]
_gsPrevGraphDatas :: [GraphData s e]
_gsGraphDatas :: [GraphData s e]
_gsViewport :: Rect
_gsActivePoint :: Maybe (Int, Int)
_gsHoverPoint :: Maybe (Int, Int)
_gsMousePosition :: Maybe Point
_gsSections :: Point
_gsUnit :: Point
_gsScale :: Point
_gsTranslation :: Point
_gsSections :: forall s e. GraphState s e -> Point
_gsUnit :: forall s e. GraphState s e -> Point
_gsScale :: forall s e. GraphState s e -> Point
_gsTranslation :: forall s e. GraphState s e -> Point
_gsActivePoint :: forall s e. GraphState s e -> Maybe (Int, Int)
_gsMousePosition :: forall s e. GraphState s e -> Maybe Point
_gsAnimationStates :: forall s e. GraphState s e -> [(Bool, Millisecond)]
_gsPrevGraphDatas :: forall s e. GraphState s e -> [GraphData s e]
_gsGraphDatas :: forall s e. GraphState s e -> [GraphData s e]
_gsViewport :: forall s e. GraphState s e -> Rect
_gsHoverPoint :: forall s e. GraphState s e -> Maybe (Int, Int)
..} = GraphState s e
state
            Point Double
cx Double
cy = Point
_gsScale
            ps :: [(Double, Double)]
ps = [(Double, Double)]
_gdPoints
            c :: Maybe Color
c = Maybe Color
_gdColor
            bc :: Maybe Color
bc = Maybe Color
_gdBorderColor
            w :: Double
w = forall a. HasCallStack => Maybe a -> a
fromJust Maybe Double
_gdWidth
            rx :: Double
rx = forall a. a -> Maybe a -> a
fromMaybe (Double
wforall a. Num a => a -> a -> a
*Double
2) forall a b. (a -> b) -> a -> b
$ (Double
64forall a. Num a => a -> a -> a
*Double
cxforall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
_gdRadius
            ry :: Double
ry = forall a. a -> Maybe a -> a
fromMaybe (Double
wforall a. Num a => a -> a -> a
*Double
2) forall a b. (a -> b) -> a -> b
$ (Double
64forall a. Num a => a -> a -> a
*Double
cyforall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
_gdRadius
            alpha :: Double
alpha = forall a. HasCallStack => Maybe a -> a
fromJust Maybe Double
_gdFillAlpha
            p :: (Double, Double) -> Point
p (Double
x, Double
y) = Double -> Double -> Point
Point Double
x Double
y
            connect :: ((Double, Double), (Double, Double)) -> IO ()
connect ((Double, Double)
a, (Double, Double)
b) = Renderer -> Point -> Point -> Double -> Maybe Color -> IO ()
drawLine Renderer
renderer ((Double, Double) -> Point
p (Double, Double)
a) ((Double, Double) -> Point
p (Double, Double)
b) Double
w Maybe Color
c
            drawDot :: Maybe Color -> Point -> IO ()
drawDot Maybe Color
cs (Point Double
x Double
y) = do
                let r :: Rect
r = Double -> Double -> Double -> Double -> Rect
Rect (Double
xforall a. Num a => a -> a -> a
-Double
rx) (Double
yforall a. Num a => a -> a -> a
-Double
ry) (Double
rxforall a. Num a => a -> a -> a
*Double
2) (Double
ryforall a. Num a => a -> a -> a
*Double
2)
                Renderer -> Rect -> Maybe Color -> IO ()
drawEllipse Renderer
renderer Rect
r Maybe Color
cs
                Renderer -> Rect -> Maybe Color -> Double -> IO ()
drawEllipseBorder Renderer
renderer Rect
r Maybe Color
bc forall a b. (a -> b) -> a -> b
$ Double
wforall a. Fractional a => a -> a -> a
/Double
2
            getSeparateColor :: Int -> Maybe Color
getSeparateColor Int
j
                | Maybe (Int, Int)
_gsActivePoint forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (Int
i, Int
j) = Maybe Color
_gdActiveColor
                | Maybe (Int, Int)
_gsHoverPoint forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (Int
i, Int
j) = Maybe Color
_gdHoverColor
                | Bool
otherwise = forall a. Maybe a
Nothing
            l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Double, Double)]
ps
        if Maybe Bool
_gdSeparate forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
            then forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(Double, Double)]
ps) forall a b. (a -> b) -> a -> b
$ \(Int
j, (Double, Double)
q) ->
                Maybe Color -> Point -> IO ()
drawDot (Int -> Maybe Color
getSeparateColor Int
j forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Color
c) forall a b. (a -> b) -> a -> b
$ (Double, Double) -> Point
p (Double, Double)
q
            else do
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l forall a. Ord a => a -> a -> Bool
> Int
1) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [(Double, Double)]
ps (forall a. [a] -> [a]
tail [(Double, Double)]
ps)) ((Double, Double), (Double, Double)) -> IO ()
connect
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l forall a. Eq a => a -> a -> Bool
== Int
1) forall a b. (a -> b) -> a -> b
$ Maybe Color -> Point -> IO ()
drawDot Maybe Color
c forall a b. (a -> b) -> a -> b
$ (Double, Double) -> Point
p forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Double, Double)]
ps
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Bool
_gdFill forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True Bool -> Bool -> Bool
&& Int
l forall a. Ord a => a -> a -> Bool
> Int
2) forall a b. (a -> b) -> a -> b
$ do
            Renderer -> IO ()
beginPath Renderer
renderer
            Renderer -> Point -> IO ()
moveTo Renderer
renderer forall a b. (a -> b) -> a -> b
$ (Double, Double) -> Point
p forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Double, Double)]
ps
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. [a] -> [a]
tail [(Double, Double)]
ps) forall a b. (a -> b) -> a -> b
$ Renderer -> Point -> IO ()
renderLineTo Renderer
renderer forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> Point
p
            Renderer -> IO ()
saveContext Renderer
renderer
            Renderer -> Double -> IO ()
setGlobalAlpha Renderer
renderer Double
alpha
            Renderer -> Color -> IO ()
setFillColor Renderer
renderer forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe Color
c
            Renderer -> IO ()
fill Renderer
renderer
            Renderer -> IO ()
restoreContext Renderer
renderer

    makeProgDatas :: Millisecond -> GraphState s e -> [GraphData s e]
makeProgDatas Millisecond
ts GraphState s e
state' = [GraphData s e]
result where
        result :: [GraphData s e]
result = forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 forall {s} {e} {s} {e}.
GraphData s e
-> GraphData s e -> (Bool, Millisecond) -> GraphData s e
f [GraphData s e]
newDatas [GraphData s e]
oldDatas [(Bool, Millisecond)]
animationStates
        f :: GraphData s e
-> GraphData s e -> (Bool, Millisecond) -> GraphData s e
f GraphData s e
graphData GraphData s e
oldData (Bool
running, Millisecond
start) = GraphData s e
progData where
            progData :: GraphData s e
progData = GraphData s e
graphData
                { _gdPoints :: [(Double, Double)]
_gdPoints = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Double, Double) -> (Double, Double) -> (Double, Double)
progP [(Double, Double)]
ps' [(Double, Double)]
ps'''
                , _gdColor :: Maybe Color
_gdColor = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Color -> Color -> Color
progC Color
c' Color
c''
                , _gdBorderColor :: Maybe Color
_gdBorderColor = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Color -> Color -> Color
progC Color
bc' Color
bc''
                , _gdWidth :: Maybe Double
_gdWidth = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
prog Double
w' Double
w''
                , _gdRadius :: Maybe Double
_gdRadius = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe Double
rs', Maybe Double
rs'']
                    then Maybe Double
rs'
                    else Double -> Double -> Double
prog forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
rs' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Double
rs''
                , _gdFillAlpha :: Maybe Double
_gdFillAlpha = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
prog Double
alpha' Double
alpha''
                }
            ps' :: [(Double, Double)]
ps' = forall s e. GraphData s e -> [(Double, Double)]
_gdPoints GraphData s e
graphData
            ps'' :: [(Double, Double)]
ps'' = forall s e. GraphData s e -> [(Double, Double)]
_gdPoints GraphData s e
oldData
            ps''' :: [(Double, Double)]
ps''' = [(Double, Double)]
ps'' forall a. Semigroup a => a -> a -> a
<> forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Double, Double)]
ps'') [(Double, Double)]
ps'
            c' :: Color
c' = forall a. a -> Maybe a -> a
fromMaybe Color
transparent forall a b. (a -> b) -> a -> b
$ forall s e. GraphData s e -> Maybe Color
_gdColor GraphData s e
graphData
            c'' :: Color
c'' = forall a. a -> Maybe a -> a
fromMaybe Color
transparent forall a b. (a -> b) -> a -> b
$ forall s e. GraphData s e -> Maybe Color
_gdColor GraphData s e
oldData
            bc' :: Color
bc' = forall a. a -> Maybe a -> a
fromMaybe Color
transparent forall a b. (a -> b) -> a -> b
$ forall s e. GraphData s e -> Maybe Color
_gdBorderColor GraphData s e
graphData
            bc'' :: Color
bc'' = forall a. a -> Maybe a -> a
fromMaybe Color
transparent forall a b. (a -> b) -> a -> b
$ forall s e. GraphData s e -> Maybe Color
_gdBorderColor GraphData s e
oldData
            w' :: Double
w' = forall a. a -> Maybe a -> a
fromMaybe Double
2 forall a b. (a -> b) -> a -> b
$ forall s e. GraphData s e -> Maybe Double
_gdWidth GraphData s e
graphData
            w'' :: Double
w'' = forall a. a -> Maybe a -> a
fromMaybe Double
2 forall a b. (a -> b) -> a -> b
$ forall s e. GraphData s e -> Maybe Double
_gdWidth GraphData s e
oldData
            rs' :: Maybe Double
rs' = forall s e. GraphData s e -> Maybe Double
_gdRadius GraphData s e
graphData
            rs'' :: Maybe Double
rs'' = forall s e. GraphData s e -> Maybe Double
_gdRadius GraphData s e
oldData
            alpha' :: Double
alpha' = forall a. a -> Maybe a -> a
fromMaybe Double
0.32 forall a b. (a -> b) -> a -> b
$ forall s e. GraphData s e -> Maybe Double
_gdFillAlpha GraphData s e
graphData
            alpha'' :: Double
alpha'' = forall a. a -> Maybe a -> a
fromMaybe Double
0.32 forall a b. (a -> b) -> a -> b
$ forall s e. GraphData s e -> Maybe Double
_gdFillAlpha GraphData s e
oldData
            progP :: (Double, Double) -> (Double, Double) -> (Double, Double)
progP (Double
a', Double
b') (Double
a, Double
b) = (Double -> Double -> Double
prog Double
a Double
a', Double -> Double -> Double
prog Double
b Double
b')
            progC :: Color -> Color -> Color
progC (Color Int
r' Int
g' Int
b' Double
a') (Color Int
r Int
g Int
b Double
a) = Color
                { _colorR :: Int
_colorR = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (Integral a, Integral a) => a -> a -> Double
prog' Int
r Int
r'
                , _colorG :: Int
_colorG = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (Integral a, Integral a) => a -> a -> Double
prog' Int
g Int
g'
                , _colorB :: Int
_colorB = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (Integral a, Integral a) => a -> a -> Double
prog' Int
b Int
b'
                , _colorA :: Double
_colorA = Double -> Double -> Double
prog Double
a Double
a'
                }
            prog' :: a -> a -> Double
prog' a
a a
b = Double -> Double -> Double
prog (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a) (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b)
            prog :: Double -> Double -> Double
prog Double
a Double
b = Double
aforall a. Num a => a -> a -> a
+(Double
bforall a. Num a => a -> a -> a
-Double
a)forall a. Num a => a -> a -> a
*Double
progress
            progress :: Double
progress = if Bool
running
                then forall a. Ord a => a -> a -> a
max Double
0 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min Double
1 forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Millisecond
tsforall a. Num a => a -> a -> a
-Millisecond
start)forall a. Fractional a => a -> a -> a
/Double
dur
                else Double
1
            dur :: Double
dur = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Millisecond
0 forall a b. (a -> b) -> a -> b
$ forall s e. GraphData s e -> Maybe Millisecond
_gdDuration GraphData s e
graphData
        newDatas :: [GraphData s e]
newDatas = forall s e. GraphState s e -> [GraphData s e]
_gsGraphDatas GraphState s e
state'
        oldDatas :: [GraphData s e]
oldDatas = forall s e. GraphState s e -> [GraphData s e]
_gsPrevGraphDatas GraphState s e
state'
        animationStates :: [(Bool, Millisecond)]
animationStates = forall s e. GraphState s e -> [(Bool, Millisecond)]
_gsAnimationStates GraphState s e
state'

    floor' :: Double -> Double
    floor' :: Double -> Double
floor' Double
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x :: Int)

    round' :: Double -> Double
    round' :: Double -> Double
round' Double
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (forall a b. (RealFrac a, Integral b) => a -> b
round Double
x :: Int)

    makeNodeWithState :: GraphState s e -> t -> t
makeNodeWithState GraphState s e
newState = forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ Widget s e
newWidget where
        newWidget :: Widget s e
newWidget = forall s e.
(WidgetModel s, WidgetEvent e) =>
[GraphData s e] -> GraphCfg s e -> GraphState s e -> Widget s e
makeGraph [GraphData s e]
graphDatas GraphCfg s e
config GraphState s e
newState

    state :: GraphState s e
state = GraphState s e
newState where
        newState :: GraphState s e
newState = GraphState s e
orState
            { _gsTranslation :: Point
_gsTranslation = Double -> Double -> Point
Point Double
tx' Double
ty'
            , _gsScale :: Point
_gsScale = Double -> Double -> Point
Point Double
cx' Double
cy'
            }
        tx' :: Double
tx' = forall a. Ord a => a -> a -> a
max (Double
wforall a. Fractional a => a -> a -> a
/Double
2forall a. Num a => a -> a -> a
-Double
maxXforall a. Num a => a -> a -> a
*Double
64forall a. Num a => a -> a -> a
*Double
cx') forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min (-Double
wforall a. Fractional a => a -> a -> a
/Double
2forall a. Num a => a -> a -> a
-Double
minXforall a. Num a => a -> a -> a
*Double
64forall a. Num a => a -> a -> a
*Double
cx') Double
tx
        ty' :: Double
ty' = forall a. Ord a => a -> a -> a
max (Double
minYforall a. Num a => a -> a -> a
*Double
64forall a. Num a => a -> a -> a
*Double
cy'forall a. Num a => a -> a -> a
+Double
hforall a. Fractional a => a -> a -> a
/Double
2) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min (Double
maxYforall a. Num a => a -> a -> a
*Double
64forall a. Num a => a -> a -> a
*Double
cy'forall a. Num a => a -> a -> a
-Double
hforall a. Fractional a => a -> a -> a
/Double
2) Double
ty
        (Double
cx', Double
cy') = Double -> Double -> (Double, Double) -> (Double, Double)
clampScale Double
w Double
h (Double
cx, Double
cy)
        Point Double
tx Double
ty = forall s e. GraphState s e -> Point
_gsTranslation GraphState s e
orState
        Point Double
cx Double
cy = forall s e. GraphState s e -> Point
_gsScale GraphState s e
orState
        Rect Double
_ Double
_ Double
w Double
h = forall s e. GraphState s e -> Rect
_gsViewport GraphState s e
orState

    clampScale :: Double -> Double -> (Double, Double) -> (Double, Double)
clampScale Double
w Double
h (Double
cx, Double
cy) = (Double
cx', Double
cy') where
        cx' :: Double
cx' = forall a. Ord a => a -> a -> a
max Double
minCx forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min Double
maxCx Double
cx
        cy' :: Double
cy' = forall a. Ord a => a -> a -> a
max Double
minCy forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min Double
maxCy Double
cy
        minCx :: Double
minCx = forall a. Ord a => a -> a -> a
max Double
minC forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Double
0 Maybe Double
_gcMinScaleX
        maxCx :: Double
maxCx = forall a. a -> Maybe a -> a
fromMaybe Double
cx Maybe Double
_gcMaxScaleX
        minCy :: Double
minCy = forall a. Ord a => a -> a -> a
max Double
minC forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Double
0 Maybe Double
_gcMinScaleY
        maxCy :: Double
maxCy = forall a. a -> Maybe a -> a
fromMaybe Double
cy Maybe Double
_gcMaxScaleY
        minC :: Double
minC = forall a. Ord a => a -> a -> a
max (Double
wforall a. Fractional a => a -> a -> a
/Double
64forall a. Fractional a => a -> a -> a
/(Double
maxXforall a. Num a => a -> a -> a
-Double
minX)) (Double
hforall a. Fractional a => a -> a -> a
/Double
64forall a. Fractional a => a -> a -> a
/(Double
maxYforall a. Num a => a -> a -> a
-Double
minY))

    minX :: Double
minX = forall a. a -> Maybe a -> a
fromMaybe (-Double
10forall a. Floating a => a -> a -> a
**Double
999) Maybe Double
_gcMinX
    maxX :: Double
maxX = forall a. a -> Maybe a -> a
fromMaybe (Double
10forall a. Floating a => a -> a -> a
**Double
999) Maybe Double
_gcMaxX
    minY :: Double
minY = forall a. a -> Maybe a -> a
fromMaybe (-Double
10forall a. Floating a => a -> a -> a
**Double
999) Maybe Double
_gcMinY
    maxY :: Double
maxY = forall a. a -> Maybe a -> a
fromMaybe (Double
10forall a. Floating a => a -> a -> a
**Double
999) Maybe Double
_gcMaxY