{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Controller.Types (
  UnicodeWidthFn(..)
  , Tool(..)
  , tool_isCreate
  , PotatoDefaultParameters(..)
  , SetPotatoDefaultParameters(..)
  , potatoDefaultParameters_set
  , Selection
  , defaultFolderCollapseState
  , LayerMeta(..)
  , LayerMetaMap
  , layerMetaMap_isCollapsed
  , ControllerMeta(..)
  , emptyControllerMeta
  , EverythingLoadState
) where

import           Relude

import           Potato.Flow.Math
import           Potato.Flow.SElts
import           Potato.Flow.Types
import           Potato.Flow.OwlItem
import Potato.Flow.Owl

import           Data.Aeson
import           Data.Default
import qualified Data.IntMap            as IM
import qualified Text.Show
import           Data.Binary



-- someday it would be nice to support graphene clusters and RTL 😭
data UnicodeWidthFn = UnicodeWidthFn {
    UnicodeWidthFn -> PChar -> Int
unicodeWidth_wcwidth :: PChar -> Int
  }


-- TOOL
data Tool = Tool_Select | Tool_Pan | Tool_Box | Tool_Line | Tool_Text | Tool_TextArea | Tool_CartLine deriving (Tool -> Tool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tool -> Tool -> Bool
$c/= :: Tool -> Tool -> Bool
== :: Tool -> Tool -> Bool
$c== :: Tool -> Tool -> Bool
Eq, Int -> Tool -> ShowS
[Tool] -> ShowS
Tool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tool] -> ShowS
$cshowList :: [Tool] -> ShowS
show :: Tool -> String
$cshow :: Tool -> String
showsPrec :: Int -> Tool -> ShowS
$cshowsPrec :: Int -> Tool -> ShowS
Show, Int -> Tool
Tool -> Int
Tool -> [Tool]
Tool -> Tool
Tool -> Tool -> [Tool]
Tool -> Tool -> Tool -> [Tool]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Tool -> Tool -> Tool -> [Tool]
$cenumFromThenTo :: Tool -> Tool -> Tool -> [Tool]
enumFromTo :: Tool -> Tool -> [Tool]
$cenumFromTo :: Tool -> Tool -> [Tool]
enumFromThen :: Tool -> Tool -> [Tool]
$cenumFromThen :: Tool -> Tool -> [Tool]
enumFrom :: Tool -> [Tool]
$cenumFrom :: Tool -> [Tool]
fromEnum :: Tool -> Int
$cfromEnum :: Tool -> Int
toEnum :: Int -> Tool
$ctoEnum :: Int -> Tool
pred :: Tool -> Tool
$cpred :: Tool -> Tool
succ :: Tool -> Tool
$csucc :: Tool -> Tool
Enum)

tool_isCreate :: Tool -> Bool
tool_isCreate :: Tool -> Bool
tool_isCreate = \case
  Tool
Tool_Select -> Bool
False
  Tool
Tool_Pan -> Bool
False
  Tool
_ -> Bool
True

data PotatoDefaultParameters = PotatoDefaultParameters {
  PotatoDefaultParameters -> SBoxType
_potatoDefaultParameters_sBoxType :: SBoxType -- currently not used as we have Tool_TextArea, consider using this instead
  , PotatoDefaultParameters -> SuperStyle
_potatoDefaultParameters_superStyle :: SuperStyle
  , PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_lineStyle :: LineStyle
  , PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_lineStyleEnd :: LineStyle
  , PotatoDefaultParameters -> TextAlign
_potatoDefaultParameters_box_label_textAlign :: TextAlign
  , PotatoDefaultParameters -> TextAlign
_potatoDefaultParameters_box_text_textAlign :: TextAlign
} deriving (PotatoDefaultParameters -> PotatoDefaultParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PotatoDefaultParameters -> PotatoDefaultParameters -> Bool
$c/= :: PotatoDefaultParameters -> PotatoDefaultParameters -> Bool
== :: PotatoDefaultParameters -> PotatoDefaultParameters -> Bool
$c== :: PotatoDefaultParameters -> PotatoDefaultParameters -> Bool
Eq, Int -> PotatoDefaultParameters -> ShowS
[PotatoDefaultParameters] -> ShowS
PotatoDefaultParameters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PotatoDefaultParameters] -> ShowS
$cshowList :: [PotatoDefaultParameters] -> ShowS
show :: PotatoDefaultParameters -> String
$cshow :: PotatoDefaultParameters -> String
showsPrec :: Int -> PotatoDefaultParameters -> ShowS
$cshowsPrec :: Int -> PotatoDefaultParameters -> ShowS
Show)


instance Default PotatoDefaultParameters where
  def :: PotatoDefaultParameters
def = PotatoDefaultParameters {
      _potatoDefaultParameters_sBoxType :: SBoxType
_potatoDefaultParameters_sBoxType = forall a. Default a => a
def
      , _potatoDefaultParameters_lineStyle :: LineStyle
_potatoDefaultParameters_lineStyle = forall a. Default a => a
def
      , _potatoDefaultParameters_lineStyleEnd :: LineStyle
_potatoDefaultParameters_lineStyleEnd = forall a. Default a => a
def
      , _potatoDefaultParameters_superStyle :: SuperStyle
_potatoDefaultParameters_superStyle = forall a. Default a => a
def
      , _potatoDefaultParameters_box_label_textAlign :: TextAlign
_potatoDefaultParameters_box_label_textAlign = forall a. Default a => a
def
      , _potatoDefaultParameters_box_text_textAlign :: TextAlign
_potatoDefaultParameters_box_text_textAlign = forall a. Default a => a
def
    }

data SetPotatoDefaultParameters = SetPotatoDefaultParameters {
  SetPotatoDefaultParameters -> Maybe SBoxType
_setPotatoDefaultParameters_sBoxType :: Maybe SBoxType
  , SetPotatoDefaultParameters -> Maybe LineStyle
_setPotatoDefaultParameters_lineStyle :: Maybe LineStyle
  , SetPotatoDefaultParameters -> Maybe LineStyle
_setPotatoDefaultParameters_lineStyleEnd :: Maybe LineStyle
  , SetPotatoDefaultParameters -> Maybe SuperStyle
_setPotatoDefaultParameters_superStyle :: Maybe SuperStyle
  , SetPotatoDefaultParameters -> Maybe TextAlign
_setPotatoDefaultParameters_box_label_textAlign :: Maybe TextAlign
  , SetPotatoDefaultParameters -> Maybe TextAlign
_setPotatoDefaultParameters_box_text_textAlign :: Maybe TextAlign
} deriving (SetPotatoDefaultParameters -> SetPotatoDefaultParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetPotatoDefaultParameters -> SetPotatoDefaultParameters -> Bool
$c/= :: SetPotatoDefaultParameters -> SetPotatoDefaultParameters -> Bool
== :: SetPotatoDefaultParameters -> SetPotatoDefaultParameters -> Bool
$c== :: SetPotatoDefaultParameters -> SetPotatoDefaultParameters -> Bool
Eq, Int -> SetPotatoDefaultParameters -> ShowS
[SetPotatoDefaultParameters] -> ShowS
SetPotatoDefaultParameters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetPotatoDefaultParameters] -> ShowS
$cshowList :: [SetPotatoDefaultParameters] -> ShowS
show :: SetPotatoDefaultParameters -> String
$cshow :: SetPotatoDefaultParameters -> String
showsPrec :: Int -> SetPotatoDefaultParameters -> ShowS
$cshowsPrec :: Int -> SetPotatoDefaultParameters -> ShowS
Show)

instance Default SetPotatoDefaultParameters where
  def :: SetPotatoDefaultParameters
def = SetPotatoDefaultParameters {
      _setPotatoDefaultParameters_sBoxType :: Maybe SBoxType
_setPotatoDefaultParameters_sBoxType = forall a. Maybe a
Nothing
      , _setPotatoDefaultParameters_lineStyle :: Maybe LineStyle
_setPotatoDefaultParameters_lineStyle = forall a. Maybe a
Nothing
      , _setPotatoDefaultParameters_lineStyleEnd :: Maybe LineStyle
_setPotatoDefaultParameters_lineStyleEnd = forall a. Maybe a
Nothing
      , _setPotatoDefaultParameters_superStyle :: Maybe SuperStyle
_setPotatoDefaultParameters_superStyle = forall a. Maybe a
Nothing
      , _setPotatoDefaultParameters_box_label_textAlign :: Maybe TextAlign
_setPotatoDefaultParameters_box_label_textAlign = forall a. Maybe a
Nothing
      , _setPotatoDefaultParameters_box_text_textAlign :: Maybe TextAlign
_setPotatoDefaultParameters_box_text_textAlign = forall a. Maybe a
Nothing
    }

potatoDefaultParameters_set :: PotatoDefaultParameters -> SetPotatoDefaultParameters -> PotatoDefaultParameters
potatoDefaultParameters_set :: PotatoDefaultParameters
-> SetPotatoDefaultParameters -> PotatoDefaultParameters
potatoDefaultParameters_set PotatoDefaultParameters {LineStyle
SBoxType
TextAlign
SuperStyle
_potatoDefaultParameters_box_text_textAlign :: TextAlign
_potatoDefaultParameters_box_label_textAlign :: TextAlign
_potatoDefaultParameters_lineStyleEnd :: LineStyle
_potatoDefaultParameters_lineStyle :: LineStyle
_potatoDefaultParameters_superStyle :: SuperStyle
_potatoDefaultParameters_sBoxType :: SBoxType
_potatoDefaultParameters_box_text_textAlign :: PotatoDefaultParameters -> TextAlign
_potatoDefaultParameters_box_label_textAlign :: PotatoDefaultParameters -> TextAlign
_potatoDefaultParameters_lineStyleEnd :: PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_lineStyle :: PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_superStyle :: PotatoDefaultParameters -> SuperStyle
_potatoDefaultParameters_sBoxType :: PotatoDefaultParameters -> SBoxType
..} SetPotatoDefaultParameters {Maybe LineStyle
Maybe SBoxType
Maybe TextAlign
Maybe SuperStyle
_setPotatoDefaultParameters_box_text_textAlign :: Maybe TextAlign
_setPotatoDefaultParameters_box_label_textAlign :: Maybe TextAlign
_setPotatoDefaultParameters_superStyle :: Maybe SuperStyle
_setPotatoDefaultParameters_lineStyleEnd :: Maybe LineStyle
_setPotatoDefaultParameters_lineStyle :: Maybe LineStyle
_setPotatoDefaultParameters_sBoxType :: Maybe SBoxType
_setPotatoDefaultParameters_box_text_textAlign :: SetPotatoDefaultParameters -> Maybe TextAlign
_setPotatoDefaultParameters_box_label_textAlign :: SetPotatoDefaultParameters -> Maybe TextAlign
_setPotatoDefaultParameters_superStyle :: SetPotatoDefaultParameters -> Maybe SuperStyle
_setPotatoDefaultParameters_lineStyleEnd :: SetPotatoDefaultParameters -> Maybe LineStyle
_setPotatoDefaultParameters_lineStyle :: SetPotatoDefaultParameters -> Maybe LineStyle
_setPotatoDefaultParameters_sBoxType :: SetPotatoDefaultParameters -> Maybe SBoxType
..} = PotatoDefaultParameters {
    _potatoDefaultParameters_sBoxType :: SBoxType
_potatoDefaultParameters_sBoxType = forall a. a -> Maybe a -> a
fromMaybe SBoxType
_potatoDefaultParameters_sBoxType Maybe SBoxType
_setPotatoDefaultParameters_sBoxType
    , _potatoDefaultParameters_lineStyle :: LineStyle
_potatoDefaultParameters_lineStyle = forall a. a -> Maybe a -> a
fromMaybe LineStyle
_potatoDefaultParameters_lineStyle Maybe LineStyle
_setPotatoDefaultParameters_lineStyle
    , _potatoDefaultParameters_lineStyleEnd :: LineStyle
_potatoDefaultParameters_lineStyleEnd = forall a. a -> Maybe a -> a
fromMaybe LineStyle
_potatoDefaultParameters_lineStyleEnd Maybe LineStyle
_setPotatoDefaultParameters_lineStyleEnd
    , _potatoDefaultParameters_superStyle :: SuperStyle
_potatoDefaultParameters_superStyle = forall a. a -> Maybe a -> a
fromMaybe SuperStyle
_potatoDefaultParameters_superStyle Maybe SuperStyle
_setPotatoDefaultParameters_superStyle
    , _potatoDefaultParameters_box_label_textAlign :: TextAlign
_potatoDefaultParameters_box_label_textAlign = forall a. a -> Maybe a -> a
fromMaybe TextAlign
_potatoDefaultParameters_box_label_textAlign Maybe TextAlign
_setPotatoDefaultParameters_box_label_textAlign
    , _potatoDefaultParameters_box_text_textAlign :: TextAlign
_potatoDefaultParameters_box_text_textAlign = forall a. a -> Maybe a -> a
fromMaybe TextAlign
_potatoDefaultParameters_box_text_textAlign Maybe TextAlign
_setPotatoDefaultParameters_box_text_textAlign

  }

type Selection = SuperOwlParliament

data LayerMeta = LayerMeta {
  -- if False, these will inherit from parent
  LayerMeta -> Bool
_layerMeta_isLocked      :: Bool
  , LayerMeta -> Bool
_layerMeta_isHidden    :: Bool
  , LayerMeta -> Bool
_layerMeta_isCollapsed :: Bool

} deriving (LayerMeta -> LayerMeta -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerMeta -> LayerMeta -> Bool
$c/= :: LayerMeta -> LayerMeta -> Bool
== :: LayerMeta -> LayerMeta -> Bool
$c== :: LayerMeta -> LayerMeta -> Bool
Eq, forall x. Rep LayerMeta x -> LayerMeta
forall x. LayerMeta -> Rep LayerMeta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LayerMeta x -> LayerMeta
$cfrom :: forall x. LayerMeta -> Rep LayerMeta x
Generic)

instance Show LayerMeta where
  show :: LayerMeta -> String
show LayerMeta {Bool
_layerMeta_isCollapsed :: Bool
_layerMeta_isHidden :: Bool
_layerMeta_isLocked :: Bool
_layerMeta_isCollapsed :: LayerMeta -> Bool
_layerMeta_isHidden :: LayerMeta -> Bool
_layerMeta_isLocked :: LayerMeta -> Bool
..} = String
"LayerMeta (l,h,c): " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Bool
_layerMeta_isLocked forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Bool
_layerMeta_isHidden forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Bool
_layerMeta_isCollapsed

instance FromJSON LayerMeta
instance ToJSON LayerMeta
instance NFData LayerMeta
instance Binary LayerMeta


-- Not sure which way I want to do it, so make it configurable for now.
defaultFolderCollapseState :: Bool
defaultFolderCollapseState :: Bool
defaultFolderCollapseState = Bool
False

instance Default LayerMeta where
  def :: LayerMeta
def = LayerMeta {
      _layerMeta_isLocked :: Bool
_layerMeta_isLocked = Bool
False
      , _layerMeta_isHidden :: Bool
_layerMeta_isHidden = Bool
False
      , _layerMeta_isCollapsed :: Bool
_layerMeta_isCollapsed = Bool
defaultFolderCollapseState
    }

type LayerMetaMap = REltIdMap LayerMeta

layerMetaMap_isCollapsed :: REltId -> LayerMetaMap -> Bool
layerMetaMap_isCollapsed :: Int -> LayerMetaMap -> Bool
layerMetaMap_isCollapsed Int
rid LayerMetaMap
lmm = case forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
rid LayerMetaMap
lmm of
  Maybe LayerMeta
Nothing -> Bool
True
  Just LayerMeta
lm -> LayerMeta -> Bool
_layerMeta_isCollapsed LayerMeta
lm

{-
-- these aren't very useful because they won't tell you if it has inherited lock/hidden state
layerMetaMap_isHidden :: REltId -> LayerMetaMap -> Bool
layerMetaMap_isHidden rid lmm = case IM.lookup rid lmm of
  Nothing -> False
  Just lm -> _layerMeta_isHidden lm
layerMetaMap_isHiddenOrLocked :: REltId -> LayerMetaMap -> Bool
layerMetaMap_isHiddenOrLocked rid lmm = case IM.lookup rid lmm of
  Nothing -> False
  Just lm -> _layerMeta_isLocked lm || _layerMeta_isHidden lm
-}

data ControllerMeta = ControllerMeta {
  ControllerMeta -> XY
_controllerMeta_pan      :: XY -- do we really want this?
  , ControllerMeta -> LayerMetaMap
_controllerMeta_layers :: LayerMetaMap
} deriving (Int -> ControllerMeta -> ShowS
[ControllerMeta] -> ShowS
ControllerMeta -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControllerMeta] -> ShowS
$cshowList :: [ControllerMeta] -> ShowS
show :: ControllerMeta -> String
$cshow :: ControllerMeta -> String
showsPrec :: Int -> ControllerMeta -> ShowS
$cshowsPrec :: Int -> ControllerMeta -> ShowS
Show, ControllerMeta -> ControllerMeta -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControllerMeta -> ControllerMeta -> Bool
$c/= :: ControllerMeta -> ControllerMeta -> Bool
== :: ControllerMeta -> ControllerMeta -> Bool
$c== :: ControllerMeta -> ControllerMeta -> Bool
Eq, forall x. Rep ControllerMeta x -> ControllerMeta
forall x. ControllerMeta -> Rep ControllerMeta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ControllerMeta x -> ControllerMeta
$cfrom :: forall x. ControllerMeta -> Rep ControllerMeta x
Generic)

instance FromJSON ControllerMeta
instance ToJSON ControllerMeta
instance NFData ControllerMeta
instance Binary ControllerMeta

emptyControllerMeta :: ControllerMeta
emptyControllerMeta :: ControllerMeta
emptyControllerMeta = XY -> LayerMetaMap -> ControllerMeta
ControllerMeta XY
0 forall a. IntMap a
IM.empty

instance Default ControllerMeta where
  def :: ControllerMeta
def = ControllerMeta
emptyControllerMeta

type EverythingLoadState = (SPotatoFlow, ControllerMeta)