{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.SEltMethods where

import           Relude

import           Potato.Flow.Math
import           Potato.Flow.Methods.LineDrawer
import           Potato.Flow.Methods.TextCommon
import           Potato.Flow.Methods.Types
import           Potato.Flow.Owl
import Potato.Flow.RenderCache
import           Potato.Flow.OwlItem
import           Potato.Flow.SElts
import           Potato.Flow.Types

import           Data.Dependent.Sum             (DSum ((:=>)))
import qualified Data.Map                       as Map
import           Data.Maybe                     (fromJust)
import qualified Data.Text                      as T
import qualified Potato.Data.Text.Zipper        as TZ
import Control.Exception (assert)


-- DisplayLines tag is Int, 0 for no cursor 1 for cursor
noTrailngCursorDisplayLines :: Int -> TextAlign -> T.Text -> TZ.DisplayLines Int
noTrailngCursorDisplayLines :: Int -> TextAlign -> Text -> DisplayLines Int
noTrailngCursorDisplayLines Int
width TextAlign
alignment Text
text = DisplayLines Int
r where
  -- force TZ to top so that displayLinesWithAlignment doesn't create trailing space for cursor
  tz :: TextZipper
tz = TextZipper -> TextZipper
TZ.top (Text -> TextZipper
TZ.fromText Text
text)

  -- hack to get rid of trailing cursor if text is ""
  r :: DisplayLines Int
r = if Text -> Bool
T.null Text
text
    then TZ.DisplayLines {
        _displayLines_spans :: [[Span Int]]
_displayLines_spans = []
        , _displayLines_offsetMap :: OffsetMapWithAlignment
_displayLines_offsetMap = forall k a. Map k a
Map.empty
        , _displayLines_cursorPos :: (Int, Int)
_displayLines_cursorPos   = (Int
0,Int
0)
      }
    else forall tag.
TextAlignment
-> Int -> tag -> tag -> TextZipper -> DisplayLines tag
TZ.displayLinesWithAlignment (TextAlign -> TextAlignment
convertTextAlignToTextZipperTextAlignment TextAlign
alignment) Int
width Int
0 Int
1 TextZipper
tz

makeDisplayLinesFromSBox :: SBox -> TZ.DisplayLines Int
makeDisplayLinesFromSBox :: SBox -> DisplayLines Int
makeDisplayLinesFromSBox SBox
sbox = DisplayLines Int
r where
  alignment :: TextAlign
alignment = TextStyle -> TextAlign
_textStyle_alignment forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBoxText -> TextStyle
_sBoxText_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxText
_sBox_text forall a b. (a -> b) -> a -> b
$ SBox
sbox
  text :: Text
text = SBoxText -> Text
_sBoxText_text forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxText
_sBox_text forall a b. (a -> b) -> a -> b
$ SBox
sbox
  LBox XY
_ (V2 Int
width' Int
_) = SBox -> LBox
_sBox_box SBox
sbox
  width :: Int
width = case SBox -> SBoxType
_sBox_boxType SBox
sbox of
    SBoxType
SBoxType_BoxText   -> forall a. Ord a => a -> a -> a
max Int
0 (Int
width'forall a. Num a => a -> a -> a
-Int
2)
    SBoxType
SBoxType_NoBoxText -> Int
width'
    SBoxType
_                  -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"wrong type"
  r :: DisplayLines Int
r = Int -> TextAlign -> Text -> DisplayLines Int
noTrailngCursorDisplayLines Int
width TextAlign
alignment Text
text



-- TODO DELETE use doesOwlSubItemIntersectBox instead
doesSEltIntersectBox_DEPRECATED :: LBox -> SElt -> Bool
doesSEltIntersectBox_DEPRECATED :: LBox -> SElt -> Bool
doesSEltIntersectBox_DEPRECATED LBox
lbox SElt
selt = case SElt
selt of
  SElt
SEltNone                     -> Bool
False
  SElt
SEltFolderStart              -> Bool
False
  SElt
SEltFolderEnd                -> Bool
False
  SEltBox SBox
x                    -> LBox -> LBox -> Bool
does_lBox_intersect_include_zero_area LBox
lbox (SBox -> LBox
_sBox_box SBox
x)
  SEltTextArea STextArea
x                   -> LBox -> LBox -> Bool
does_lBox_intersect_include_zero_area LBox
lbox (STextArea -> LBox
_sTextArea_box STextArea
x)
  -- TODO this is wrong, do it correctly...
  -- we use does_lBox_intersect since it's impossible for a SAutoLine to have zero sized box
  SEltLine sline :: SAutoLine
sline@SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
..} -> LBox -> LBox -> Bool
does_lBox_intersect LBox
lbox (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ SElt -> Maybe LBox
getSEltBox_naive (SAutoLine -> SElt
SEltLine SAutoLine
sline))

doesSEltIntersectPoint :: XY -> SElt -> Bool
doesSEltIntersectPoint :: XY -> SElt -> Bool
doesSEltIntersectPoint XY
pos SElt
selt = LBox -> SElt -> Bool
doesSEltIntersectBox_DEPRECATED (XY -> XY -> LBox
LBox XY
pos (forall a. a -> a -> V2 a
V2 Int
1 Int
1)) SElt
selt

getSEltSuperStyle :: SElt -> Maybe SuperStyle
getSEltSuperStyle :: SElt -> Maybe SuperStyle
getSEltSuperStyle SElt
selt = case SElt
selt of
  SEltBox SBox {LBox
SBoxType
SBoxText
SBoxTitle
SuperStyle
_sBox_title :: SBox -> SBoxTitle
_sBox_superStyle :: SBox -> SuperStyle
_sBox_boxType :: SBoxType
_sBox_text :: SBoxText
_sBox_title :: SBoxTitle
_sBox_superStyle :: SuperStyle
_sBox_box :: LBox
_sBox_boxType :: SBox -> SBoxType
_sBox_box :: SBox -> LBox
_sBox_text :: SBox -> SBoxText
..}       -> forall a. a -> Maybe a
Just SuperStyle
_sBox_superStyle
  SEltLine SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} -> forall a. a -> Maybe a
Just SuperStyle
_sAutoLine_superStyle
  SElt
_                       -> forall a. Maybe a
Nothing

getSEltLabelSuperStyle :: SEltLabel -> Maybe SuperStyle
getSEltLabelSuperStyle :: SEltLabel -> Maybe SuperStyle
getSEltLabelSuperStyle (SEltLabel Text
_ SElt
x) = SElt -> Maybe SuperStyle
getSEltSuperStyle SElt
x

getSEltLineStyle :: SElt -> Maybe LineStyle
getSEltLineStyle :: SElt -> Maybe LineStyle
getSEltLineStyle SElt
selt = case SElt
selt of
  SEltLine SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} -> forall a. a -> Maybe a
Just LineStyle
_sAutoLine_lineStyle
  SElt
_                       -> forall a. Maybe a
Nothing

getSEltLineStyleEnd :: SElt -> Maybe LineStyle
getSEltLineStyleEnd :: SElt -> Maybe LineStyle
getSEltLineStyleEnd SElt
selt = case SElt
selt of
  SEltLine SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} -> forall a. a -> Maybe a
Just LineStyle
_sAutoLine_lineStyleEnd
  SElt
_                       -> forall a. Maybe a
Nothing

getSEltLabelLineStyle :: SEltLabel -> Maybe LineStyle
getSEltLabelLineStyle :: SEltLabel -> Maybe LineStyle
getSEltLabelLineStyle (SEltLabel Text
_ SElt
x) = SElt -> Maybe LineStyle
getSEltLineStyle SElt
x

getSEltLabelLineStyleEnd :: SEltLabel -> Maybe LineStyle
getSEltLabelLineStyleEnd :: SEltLabel -> Maybe LineStyle
getSEltLabelLineStyleEnd (SEltLabel Text
_ SElt
x) = SElt -> Maybe LineStyle
getSEltLineStyleEnd SElt
x


getSEltBoxTextStyle :: SElt -> Maybe TextStyle
getSEltBoxTextStyle :: SElt -> Maybe TextStyle
getSEltBoxTextStyle = \case
  SEltBox SBox {LBox
SBoxType
SBoxText
SBoxTitle
SuperStyle
_sBox_boxType :: SBoxType
_sBox_text :: SBoxText
_sBox_title :: SBoxTitle
_sBox_superStyle :: SuperStyle
_sBox_box :: LBox
_sBox_title :: SBox -> SBoxTitle
_sBox_superStyle :: SBox -> SuperStyle
_sBox_boxType :: SBox -> SBoxType
_sBox_box :: SBox -> LBox
_sBox_text :: SBox -> SBoxText
..}         -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBoxText -> TextStyle
_sBoxText_style forall a b. (a -> b) -> a -> b
$ SBoxText
_sBox_text
  SElt
_ -> forall a. Maybe a
Nothing

getSEltLabelBoxTextStyle :: SEltLabel -> Maybe TextStyle
getSEltLabelBoxTextStyle :: SEltLabel -> Maybe TextStyle
getSEltLabelBoxTextStyle (SEltLabel Text
_ SElt
x) = SElt -> Maybe TextStyle
getSEltBoxTextStyle SElt
x

getSEltBoxType :: SElt -> Maybe SBoxType
getSEltBoxType :: SElt -> Maybe SBoxType
getSEltBoxType = \case
  SEltBox SBox {LBox
SBoxType
SBoxText
SBoxTitle
SuperStyle
_sBox_boxType :: SBoxType
_sBox_text :: SBoxText
_sBox_title :: SBoxTitle
_sBox_superStyle :: SuperStyle
_sBox_box :: LBox
_sBox_title :: SBox -> SBoxTitle
_sBox_superStyle :: SBox -> SuperStyle
_sBox_boxType :: SBox -> SBoxType
_sBox_box :: SBox -> LBox
_sBox_text :: SBox -> SBoxText
..} -> forall a. a -> Maybe a
Just SBoxType
_sBox_boxType
  SElt
_ -> forall a. Maybe a
Nothing

getSEltLabelBoxType :: SEltLabel -> Maybe SBoxType
getSEltLabelBoxType :: SEltLabel -> Maybe SBoxType
getSEltLabelBoxType (SEltLabel Text
_ SElt
x) = SElt -> Maybe SBoxType
getSEltBoxType SElt
x

sBox_drawer :: SBox -> SEltDrawer
sBox_drawer :: SBox -> SEltDrawer
sBox_drawer sbox :: SBox
sbox@SBox {LBox
SBoxType
SBoxText
SBoxTitle
SuperStyle
_sBox_boxType :: SBoxType
_sBox_text :: SBoxText
_sBox_title :: SBoxTitle
_sBox_superStyle :: SuperStyle
_sBox_box :: LBox
_sBox_title :: SBox -> SBoxTitle
_sBox_superStyle :: SBox -> SuperStyle
_sBox_boxType :: SBox -> SBoxType
_sBox_box :: SBox -> LBox
_sBox_text :: SBox -> SBoxText
..} = SEltDrawer
r where
  CanonicalLBox Bool
_ Bool
_ lbox :: LBox
lbox@(LBox (V2 Int
x Int
y) (V2 Int
w Int
h)) = LBox -> CanonicalLBox
canonicalLBox_from_lBox LBox
_sBox_box

  titlewidth :: Int
titlewidth = forall a. Ord a => a -> a -> a
max Int
0 (Int
wforall a. Num a => a -> a -> a
-Int
2)

  fillfn :: XY -> Maybe PChar
fillfn XY
_ = case SuperStyle -> FillStyle
_superStyle_fill SuperStyle
_sBox_superStyle of
    FillStyle_Simple PChar
c -> forall a. a -> Maybe a
Just PChar
c
    FillStyle
FillStyle_Blank    -> forall a. Maybe a
Nothing

  rfntext :: XY -> Maybe (Maybe PChar)
rfntext (V2 Int
x' Int
y') = case SBoxType
_sBox_boxType of
    SBoxType
SBoxType_Box -> forall a. Maybe a
Nothing
    SBoxType
SBoxType_NoBox -> forall a. Maybe a
Nothing
    SBoxType
_ -> Maybe (Maybe PChar)
outputChar where

      -- 😰😰😰 for now we just do the below for every cell
      dl :: DisplayLines Int
dl = SBox -> DisplayLines Int
makeDisplayLinesFromSBox SBox
sbox

      offs :: (Int, Int)
offs = case SBoxType
_sBox_boxType of
        SBoxType
SBoxType_NoBoxText -> (Int
0,Int
0)
        SBoxType
_                  -> (Int
1,Int
1)

      outputChar :: Maybe (Maybe PChar)
outputChar = (Int, Int)
-> DisplayLines Int
-> (Int, Int)
-> (Int, Int)
-> Maybe (Maybe PChar)
displayLinesToChar (Int
x, Int
y) DisplayLines Int
dl (Int
x', Int
y') (Int, Int)
offs

  -- TODO test
  rfnlabel :: XY -> Maybe (Maybe PChar)
rfnlabel (V2 Int
x' Int
y') = case SBoxTitle -> Maybe Text
_sBoxTitle_title SBoxTitle
_sBox_title of
    Maybe Text
Nothing -> forall a. Maybe a
Nothing
    Just Text
title -> Maybe (Maybe PChar)
outputChar where
      -- TODO we want to crop instead of wrap here
      -- however using infinite width trick will break AlignRight :(
      dl :: DisplayLines Int
dl = Int -> TextAlign -> Text -> DisplayLines Int
noTrailngCursorDisplayLines Int
titlewidth (SBoxTitle -> TextAlign
_sBoxTitle_align SBoxTitle
_sBox_title) Text
title
      -- note that y' will ultimately resolve to a yindex of 0 inside of displayLinesToChar
      outputChar :: Maybe (Maybe PChar)
outputChar = (Int, Int)
-> DisplayLines Int
-> (Int, Int)
-> (Int, Int)
-> Maybe (Maybe PChar)
displayLinesToChar (Int
x, Int
y) DisplayLines Int
dl (Int
x', Int
y') (Int
1,Int
0)

  rfnnoborder :: XY -> Maybe PChar
rfnnoborder XY
pt
    | Bool -> Bool
not (LBox -> XY -> Bool
does_lBox_contains_XY LBox
lbox XY
pt) = forall a. Maybe a
Nothing
    | Bool
otherwise = case XY -> Maybe (Maybe PChar)
rfntext XY
pt of
      -- 'Just Nothing' means don't use fill char (this happens when there are wide chars)
      Just Maybe PChar
mx -> Maybe PChar
mx
      Maybe (Maybe PChar)
Nothing -> XY -> Maybe PChar
fillfn XY
pt

  rfnborder :: XY -> Maybe PChar
rfnborder pt :: XY
pt@(V2 Int
x' Int
y')
    | Bool -> Bool
not (LBox -> XY -> Bool
does_lBox_contains_XY LBox
lbox XY
pt) = forall a. Maybe a
Nothing
    | Int
w forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
h forall a. Eq a => a -> a -> Bool
== Int
1 = SuperStyle -> Maybe PChar
_superStyle_point SuperStyle
_sBox_superStyle
    | Int
w forall a. Eq a => a -> a -> Bool
== Int
1 = SuperStyle -> Maybe PChar
_superStyle_vertical SuperStyle
_sBox_superStyle
    | Int
h forall a. Eq a => a -> a -> Bool
== Int
1 = SuperStyle -> Maybe PChar
_superStyle_horizontal SuperStyle
_sBox_superStyle
    | Int
x' forall a. Eq a => a -> a -> Bool
== Int
x Bool -> Bool -> Bool
&& Int
y' forall a. Eq a => a -> a -> Bool
== Int
y = SuperStyle -> Maybe PChar
_superStyle_tl SuperStyle
_sBox_superStyle
    | Int
x' forall a. Eq a => a -> a -> Bool
== Int
x Bool -> Bool -> Bool
&& Int
y' forall a. Eq a => a -> a -> Bool
== Int
yforall a. Num a => a -> a -> a
+Int
hforall a. Num a => a -> a -> a
-Int
1 = SuperStyle -> Maybe PChar
_superStyle_bl SuperStyle
_sBox_superStyle
    | Int
x' forall a. Eq a => a -> a -> Bool
== Int
xforall a. Num a => a -> a -> a
+Int
wforall a. Num a => a -> a -> a
-Int
1 Bool -> Bool -> Bool
&& Int
y' forall a. Eq a => a -> a -> Bool
== Int
y = SuperStyle -> Maybe PChar
_superStyle_tr SuperStyle
_sBox_superStyle
    | Int
x' forall a. Eq a => a -> a -> Bool
== Int
xforall a. Num a => a -> a -> a
+Int
wforall a. Num a => a -> a -> a
-Int
1 Bool -> Bool -> Bool
&& Int
y' forall a. Eq a => a -> a -> Bool
== Int
yforall a. Num a => a -> a -> a
+Int
hforall a. Num a => a -> a -> a
-Int
1 = SuperStyle -> Maybe PChar
_superStyle_br SuperStyle
_sBox_superStyle
    | Int
x' forall a. Eq a => a -> a -> Bool
== Int
x Bool -> Bool -> Bool
|| Int
x' forall a. Eq a => a -> a -> Bool
== Int
xforall a. Num a => a -> a -> a
+Int
wforall a. Num a => a -> a -> a
-Int
1 = SuperStyle -> Maybe PChar
_superStyle_vertical SuperStyle
_sBox_superStyle
    -- label shows up at top horizontal portion
    | Int
y' forall a. Eq a => a -> a -> Bool
== Int
y = case XY -> Maybe (Maybe PChar)
rfnlabel XY
pt of
      Maybe (Maybe PChar)
Nothing    -> SuperStyle -> Maybe PChar
_superStyle_horizontal SuperStyle
_sBox_superStyle
      Just Maybe PChar
pchar -> Maybe PChar
pchar
    | Int
y' forall a. Eq a => a -> a -> Bool
== Int
yforall a. Num a => a -> a -> a
+Int
hforall a. Num a => a -> a -> a
-Int
1 = SuperStyle -> Maybe PChar
_superStyle_horizontal SuperStyle
_sBox_superStyle
    | Bool
otherwise = XY -> Maybe PChar
rfnnoborder XY
pt

  r :: SEltDrawer
r = SEltDrawer {
      _sEltDrawer_box :: SEltDrawerBoxFn
_sEltDrawer_box = forall a b. a -> b -> a
const LBox
lbox
      , _sEltDrawer_renderFn :: SEltDrawerRenderFn
_sEltDrawer_renderFn = \a
_ -> case SBoxType
_sBox_boxType of
        SBoxType
SBoxType_NoBoxText -> XY -> Maybe PChar
rfnnoborder
        SBoxType
SBoxType_NoBox     -> XY -> Maybe PChar
rfnnoborder
        SBoxType
_                  -> XY -> Maybe PChar
rfnborder
      
      -- TODO 
      , _sEltDrawer_maxCharWidth :: Int
_sEltDrawer_maxCharWidth = Int
1
    }

sTextArea_drawer :: STextArea -> SEltDrawer
sTextArea_drawer :: STextArea -> SEltDrawer
sTextArea_drawer STextArea {Bool
TextAreaMapping
LBox
_sTextArea_transparent :: STextArea -> Bool
_sTextArea_text :: STextArea -> TextAreaMapping
_sTextArea_transparent :: Bool
_sTextArea_text :: TextAreaMapping
_sTextArea_box :: LBox
_sTextArea_box :: STextArea -> LBox
..} = SEltDrawer
r where

  lbox :: LBox
lbox@(LBox XY
p XY
_) = LBox
_sTextArea_box

  renderfn :: XY -> Maybe PChar
renderfn XY
p' = Maybe PChar
outputChar where
    inbounds :: Bool
inbounds = LBox -> XY -> Bool
does_lBox_contains_XY LBox
lbox XY
p'
    outputChar :: Maybe PChar
outputChar = if Bool
inbounds
      then case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (XY
p' forall a. Num a => a -> a -> a
- XY
p) TextAreaMapping
_sTextArea_text of
        Maybe PChar
Nothing -> if Bool
_sTextArea_transparent
          then forall a. Maybe a
Nothing
          else forall a. a -> Maybe a
Just PChar
' '
        Just PChar
c -> forall a. a -> Maybe a
Just PChar
c
      else forall a. Maybe a
Nothing

  r :: SEltDrawer
r = SEltDrawer {
      _sEltDrawer_box :: SEltDrawerBoxFn
_sEltDrawer_box = forall a b. a -> b -> a
const LBox
lbox
      , _sEltDrawer_renderFn :: SEltDrawerRenderFn
_sEltDrawer_renderFn = \a
_ -> XY -> Maybe PChar
renderfn

      -- TODO
      , _sEltDrawer_maxCharWidth :: Int
_sEltDrawer_maxCharWidth = Int
1
    }

-- NOTE that there is not a 1-1 mapping between `OwlSubItem` and `OwlItemCache` as the `OwlItemCache` is dependent on the OwlTree
-- this function assumes that you are requesting the drawer with the intent of passing in an OwlTree
-- TODO it would have been better for SEltDrawer to be created based on an OwlTree rather than return a function that takes an OwlTree
getDrawerWithCache :: OwlSubItem -> Maybe OwlItemCache -> SEltDrawer
getDrawerWithCache :: OwlSubItem -> Maybe OwlItemCache -> SEltDrawer
getDrawerWithCache OwlSubItem
osubitem Maybe OwlItemCache
mcache = case OwlSubItem
osubitem of 
  OwlSubItem
OwlSubItemNone        -> SEltDrawer
nilDrawer
  OwlSubItemFolder Seq Int
_ -> SEltDrawer
nilDrawer
  OwlSubItemBox SBox
sbox    -> SBox -> SEltDrawer
sBox_drawer SBox
sbox
  OwlSubItemLine SAutoLine
sline -> case Maybe OwlItemCache
mcache of 
    Just (OwlItemCache_Line LineAnchorsForRender
lars PreRender
_) -> SAutoLine -> Maybe LineAnchorsForRender -> SEltDrawer
sSimpleLineNewRenderFn SAutoLine
sline (forall a. a -> Maybe a
Just LineAnchorsForRender
lars)
    Maybe OwlItemCache
Nothing -> SAutoLine -> Maybe LineAnchorsForRender -> SEltDrawer
sSimpleLineNewRenderFn SAutoLine
sline forall a. Maybe a
Nothing
    Maybe OwlItemCache
_ -> forall a. HasCallStack => Bool -> a -> a
assert Bool
False (SAutoLine -> Maybe LineAnchorsForRender -> SEltDrawer
sSimpleLineNewRenderFn SAutoLine
sline forall a. Maybe a
Nothing)
  OwlSubItemTextArea STextArea
stextarea  -> STextArea -> SEltDrawer
sTextArea_drawer STextArea
stextarea

-- TODO pass in cache here
getDrawer :: OwlSubItem -> SEltDrawer
getDrawer :: OwlSubItem -> SEltDrawer
getDrawer = \case
  OwlSubItem
OwlSubItemNone        -> SEltDrawer
nilDrawer
  OwlSubItemFolder Seq Int
_ -> SEltDrawer
nilDrawer
  OwlSubItemBox SBox
sbox    -> SBox -> SEltDrawer
sBox_drawer SBox
sbox
  OwlSubItemLine SAutoLine
sline -> SAutoLine -> Maybe LineAnchorsForRender -> SEltDrawer
sSimpleLineNewRenderFn SAutoLine
sline forall a. Maybe a
Nothing
  OwlSubItemTextArea STextArea
stextarea  -> STextArea -> SEltDrawer
sTextArea_drawer STextArea
stextarea
  {-
  where
    potatoDrawer = SEltDrawer {
        _sEltDrawer_box = const $ fromJust (getSEltBox_naive selt)
        , _sEltDrawer_renderFn =  makePotatoRenderer $ fromJust (getSEltBox_naive selt)
      }
  -}

getDrawerFromSEltForTest :: SElt -> SEltDrawer
getDrawerFromSEltForTest :: SElt -> SEltDrawer
getDrawerFromSEltForTest = OwlSubItem -> SEltDrawer
getDrawer forall b c a. (b -> c) -> (a -> b) -> a -> c
. SElt -> OwlSubItem
sElt_to_owlSubItem

updateOwlSubItemCache :: (HasOwlTree a) => a -> OwlSubItem -> Maybe OwlItemCache
updateOwlSubItemCache :: forall a. HasOwlTree a => a -> OwlSubItem -> Maybe OwlItemCache
updateOwlSubItemCache a
ot OwlSubItem
x = Maybe OwlItemCache
r where
  r :: Maybe OwlItemCache
r = case OwlSubItem
x of
    -- TODO use sAutoLine_to_lineAnchorsForRenderList here instead
    (OwlSubItemLine SAutoLine
sline) -> Maybe OwlItemCache
cache where
      cache :: Maybe OwlItemCache
cache = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender -> PreRender -> OwlItemCache
OwlItemCache_Line (forall a. HasOwlTree a => a -> SAutoLine -> LineAnchorsForRender
sSimpleLineNewRenderFnComputeCache a
ot SAutoLine
sline) PreRender
prerender
      seltdrawer :: SEltDrawer
seltdrawer = OwlSubItem -> Maybe OwlItemCache -> SEltDrawer
getDrawerWithCache OwlSubItem
x Maybe OwlItemCache
cache
      prerender :: PreRender
prerender = forall a. HasOwlTree a => a -> SEltDrawer -> PreRender
makePreRender a
ot SEltDrawer
seltdrawer 
    OwlSubItem
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PreRender -> OwlItemCache
OwlItemCache_Generic PreRender
prerender where
      seltdrawer :: SEltDrawer
seltdrawer = OwlSubItem -> Maybe OwlItemCache -> SEltDrawer
getDrawerWithCache OwlSubItem
x forall a. Maybe a
Nothing
      prerender :: PreRender
prerender = forall a. HasOwlTree a => a -> SEltDrawer -> PreRender
makePreRender a
ot SEltDrawer
seltdrawer 


-- TODO move modify methods to another file

modify_sAutoLineConstraint_with_cBoundingBox :: Bool -> SAutoLineConstraint -> CBoundingBox -> SAutoLineConstraint
modify_sAutoLineConstraint_with_cBoundingBox :: Bool -> SAutoLineConstraint -> CBoundingBox -> SAutoLineConstraint
modify_sAutoLineConstraint_with_cBoundingBox Bool
isDo SAutoLineConstraint
constraint CBoundingBox {DeltaLBox
_cBoundingBox_deltaBox :: CBoundingBox -> DeltaLBox
_cBoundingBox_deltaBox :: DeltaLBox
..} = case SAutoLineConstraint
constraint of
  SAutoLineConstraintFixed XY
xy -> XY -> SAutoLineConstraint
SAutoLineConstraintFixed forall a b. (a -> b) -> a -> b
$ forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo XY
xy (DeltaLBox -> XY
_deltaLBox_translate DeltaLBox
_cBoundingBox_deltaBox)

modify_sElt_with_cBoundingBox :: Bool -> SElt -> CBoundingBox -> SElt
modify_sElt_with_cBoundingBox :: Bool -> SElt -> CBoundingBox -> SElt
modify_sElt_with_cBoundingBox Bool
isDo SElt
selt cbb :: CBoundingBox
cbb@CBoundingBox {DeltaLBox
_cBoundingBox_deltaBox :: DeltaLBox
_cBoundingBox_deltaBox :: CBoundingBox -> DeltaLBox
..} = case SElt
selt of
  SEltBox SBox
sbox  -> SBox -> SElt
SEltBox forall a b. (a -> b) -> a -> b
$ SBox
sbox {
      _sBox_box :: LBox
_sBox_box = forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo (SBox -> LBox
_sBox_box SBox
sbox) DeltaLBox
_cBoundingBox_deltaBox
    }
  -- TODO handle resize parameter
  SEltLine sline :: SAutoLine
sline@SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} -> SAutoLine -> SElt
SEltLine forall a b. (a -> b) -> a -> b
$ SAutoLine
sline {
      _sAutoLine_start :: XY
_sAutoLine_start = forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo XY
_sAutoLine_start
        (DeltaLBox -> XY
_deltaLBox_translate DeltaLBox
_cBoundingBox_deltaBox)
      , _sAutoLine_end :: XY
_sAutoLine_end = forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo XY
_sAutoLine_end
        (DeltaLBox -> XY
_deltaLBox_translate DeltaLBox
_cBoundingBox_deltaBox)
      , _sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_midpoints = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SAutoLineConstraint
slc -> Bool -> SAutoLineConstraint -> CBoundingBox -> SAutoLineConstraint
modify_sAutoLineConstraint_with_cBoundingBox Bool
isDo SAutoLineConstraint
slc CBoundingBox
cbb) [SAutoLineConstraint]
_sAutoLine_midpoints
    }
  SEltTextArea STextArea
stext -> STextArea -> SElt
SEltTextArea forall a b. (a -> b) -> a -> b
$ STextArea
stext {
      _sTextArea_box :: LBox
_sTextArea_box     = forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo (STextArea -> LBox
_sTextArea_box STextArea
stext) DeltaLBox
_cBoundingBox_deltaBox
    }
  SElt
x          -> SElt
x

modify_sElt_with_cSuperStyle :: Bool -> SElt -> CSuperStyle -> SElt
modify_sElt_with_cSuperStyle :: Bool -> SElt -> CSuperStyle -> SElt
modify_sElt_with_cSuperStyle Bool
isDo SElt
selt (CSuperStyle DeltaSuperStyle
style) = case SElt
selt of
  SEltBox SBox
sbox -> SBox -> SElt
SEltBox forall a b. (a -> b) -> a -> b
$ SBox
sbox {
      _sBox_superStyle :: SuperStyle
_sBox_superStyle = forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo (SBox -> SuperStyle
_sBox_superStyle SBox
sbox) DeltaSuperStyle
style
    }
  -- TODO handle resize parameter
  SEltLine SAutoLine
sline -> SAutoLine -> SElt
SEltLine forall a b. (a -> b) -> a -> b
$ SAutoLine
sline {
      _sAutoLine_superStyle :: SuperStyle
_sAutoLine_superStyle = forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo (SAutoLine -> SuperStyle
_sAutoLine_superStyle SAutoLine
sline) DeltaSuperStyle
style
    }
  SElt
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"Controller - SElt type mismatch: CTagSuperStyle - " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SElt
selt
  -- maybe we want silent failure case in the future, so you can easily restyle a big selection in bulk
  --x -> x

-- TODO DELETE use llama instead
modify_sElt_with_cLineStyle :: Bool -> SElt -> CLineStyle -> SElt
modify_sElt_with_cLineStyle :: Bool -> SElt -> CLineStyle -> SElt
modify_sElt_with_cLineStyle Bool
isDo SElt
selt (CLineStyle DeltaLineStyle
style) = case SElt
selt of
  SEltLine SAutoLine
sline -> SAutoLine -> SElt
SEltLine forall a b. (a -> b) -> a -> b
$ SAutoLine
sline {
      _sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyle = forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo (SAutoLine -> LineStyle
_sAutoLine_lineStyle SAutoLine
sline) DeltaLineStyle
style
    }
  SElt
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"Controller - SElt type mismatch: CTagLineStyle - " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SElt
selt
  -- maybe we want silent failure case in the future, so you can easily restyle a big selection in bulk
  --x -> x

modify_sElt_with_cTextStyle :: Bool -> SElt -> CTextStyle -> SElt
modify_sElt_with_cTextStyle :: Bool -> SElt -> CTextStyle -> SElt
modify_sElt_with_cTextStyle Bool
isDo SElt
selt (CTextStyle DeltaTextStyle
style) = case SElt
selt of
  SEltBox SBox
sbox -> SBox -> SElt
SEltBox forall a b. (a -> b) -> a -> b
$ SBox
sbox {
      _sBox_text :: SBoxText
_sBox_text = (SBox -> SBoxText
_sBox_text SBox
sbox) {
          _sBoxText_style :: TextStyle
_sBoxText_style = forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo (SBoxText -> TextStyle
_sBoxText_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBox -> SBoxText
_sBox_text forall a b. (a -> b) -> a -> b
$ SBox
sbox) DeltaTextStyle
style
        }
    }
  SElt
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"Controller - SElt type mismatch: CTagBoxTextStyle - " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SElt
selt
  -- maybe we want silent failure case in the future, so you can easily restyle a big selection in bulk
  --x -> x

modify_sEltBox_label_with_cTextAlign :: Bool -> SElt -> CTextAlign -> SElt
modify_sEltBox_label_with_cTextAlign :: Bool -> SElt -> CTextAlign -> SElt
modify_sEltBox_label_with_cTextAlign Bool
isDo SElt
selt (CTextAlign DeltaTextAlign
align) = case SElt
selt of
  SEltBox SBox
sbox -> SBox -> SElt
SEltBox forall a b. (a -> b) -> a -> b
$ SBox
sbox {
      _sBox_title :: SBoxTitle
_sBox_title = SBoxTitle
sboxtitle {
          _sBoxTitle_align :: TextAlign
_sBoxTitle_align = forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo (SBoxTitle -> TextAlign
_sBoxTitle_align SBoxTitle
sboxtitle) DeltaTextAlign
align
        }
    } where
      sboxtitle :: SBoxTitle
sboxtitle = SBox -> SBoxTitle
_sBox_title SBox
sbox
  SElt
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"Controller - SElt type mismatch: CTagBoxLabelAlignment - " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SElt
selt
  -- maybe we want silent failure case in the future, so you can easily restyle a big selection in bulk
  --x -> x

modify_sEltBox_label_with_cMaybeText :: Bool -> SElt -> CMaybeText -> SElt
modify_sEltBox_label_with_cMaybeText :: Bool -> SElt -> CMaybeText -> SElt
modify_sEltBox_label_with_cMaybeText Bool
isDo SElt
selt (CMaybeText DeltaMaybeText
text) = case SElt
selt of
  SEltBox SBox
sbox -> SBox -> SElt
SEltBox forall a b. (a -> b) -> a -> b
$ SBox
sbox {
      _sBox_title :: SBoxTitle
_sBox_title = SBoxTitle
sboxtitle {
          _sBoxTitle_title :: Maybe Text
_sBoxTitle_title = forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo (SBoxTitle -> Maybe Text
_sBoxTitle_title SBoxTitle
sboxtitle) DeltaMaybeText
text
        }
    } where
      sboxtitle :: SBoxTitle
sboxtitle = SBox -> SBoxTitle
_sBox_title SBox
sbox
  SElt
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"Controller - SElt type mismatch: CTagBoxLabelAlignment - " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SElt
selt

modify_sEltTextArea_with_cTextArea :: Bool -> SElt -> CTextArea -> SElt
modify_sEltTextArea_with_cTextArea :: Bool -> SElt -> CTextArea -> SElt
modify_sEltTextArea_with_cTextArea Bool
isDo SElt
selt (CTextArea DeltaTextArea
dt) = case SElt
selt of
  SEltTextArea STextArea
stextarea -> STextArea -> SElt
SEltTextArea forall a b. (a -> b) -> a -> b
$ STextArea
stextarea {
      _sTextArea_text :: TextAreaMapping
_sTextArea_text = forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo (STextArea -> TextAreaMapping
_sTextArea_text STextArea
stextarea) DeltaTextArea
dt
    }
  SElt
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"Controller - SElt type mismatch: CTagTextArea - " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SElt
selt

modify_sEltTextArea_with_cTextAreaToggle :: Bool -> SElt -> CTextAreaToggle -> SElt
modify_sEltTextArea_with_cTextAreaToggle :: Bool -> SElt -> CTextAreaToggle -> SElt
modify_sEltTextArea_with_cTextAreaToggle Bool
isDo SElt
selt (CTextAreaToggle DeltaTextAreaToggle
toggle) = case SElt
selt of
  -- double toggle is idempotent but we disallow it for now
  SEltTextArea STextArea
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"Controller - SElt type mismatch: CTagTextAreaToggle - " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SElt
selt
  SElt
x -> forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo SElt
x DeltaTextAreaToggle
toggle


modifyDelta :: (Delta x dx) => Bool -> x ->  dx -> x
modifyDelta :: forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo x
x dx
dx = if Bool
isDo
  then forall x dx. Delta x dx => x -> dx -> x
plusDelta x
x dx
dx
  else forall x dx. Delta x dx => x -> dx -> x
minusDelta x
x dx
dx

updateFnFromController :: Bool -> Controller -> (SEltLabel -> SEltLabel)
updateFnFromController :: Bool -> Controller -> SEltLabel -> SEltLabel
updateFnFromController Bool
isDo = \case
  (CTag a
CTagRename :=> Identity a
d) -> \SEltLabel
seltl -> forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo SEltLabel
seltl a
d
  (CTag a
CTagLine :=> Identity a
d) -> \(SEltLabel Text
sname SElt
selt) -> case SElt
selt of
    SEltLine SAutoLine
s -> Text -> SElt -> SEltLabel
SEltLabel Text
sname (SAutoLine -> SElt
SEltLine forall a b. (a -> b) -> a -> b
$ forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo SAutoLine
s a
d)
    SElt
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"Controller - SElt type mismatch: CTagLine - " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SElt
selt
  (CTag a
CTagBoxText :=> Identity a
d) -> \(SEltLabel Text
sname SElt
selt) -> case SElt
selt of
    SEltBox SBox
s -> Text -> SElt -> SEltLabel
SEltLabel Text
sname (SBox -> SElt
SEltBox forall a b. (a -> b) -> a -> b
$ forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo SBox
s a
d)
    SElt
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"Controller - SElt type mismatch: CTagBoxText - " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SElt
selt
  (CTag a
CTagBoxType :=> Identity a
d) -> \(SEltLabel Text
sname SElt
selt) -> case SElt
selt of
    SEltBox SBox
s -> Text -> SElt -> SEltLabel
SEltLabel Text
sname (SBox -> SElt
SEltBox forall a b. (a -> b) -> a -> b
$ forall x dx. Delta x dx => Bool -> x -> dx -> x
modifyDelta Bool
isDo SBox
s a
d)
    SElt
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"Controller - SElt type mismatch: CTagBoxText - " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SElt
selt
  (CTag a
CTagBoundingBox :=> Identity a
d) -> \(SEltLabel Text
sname SElt
selt) ->
    Text -> SElt -> SEltLabel
SEltLabel Text
sname (Bool -> SElt -> CBoundingBox -> SElt
modify_sElt_with_cBoundingBox Bool
isDo SElt
selt a
d)
  (CTag a
CTagSuperStyle :=> Identity a
d) -> \(SEltLabel Text
sname SElt
selt) ->
    Text -> SElt -> SEltLabel
SEltLabel Text
sname (Bool -> SElt -> CSuperStyle -> SElt
modify_sElt_with_cSuperStyle Bool
isDo SElt
selt a
d)
  (CTag a
CTagLineStyle :=> Identity a
d) -> \(SEltLabel Text
sname SElt
selt) ->
    Text -> SElt -> SEltLabel
SEltLabel Text
sname (Bool -> SElt -> CLineStyle -> SElt
modify_sElt_with_cLineStyle Bool
isDo SElt
selt a
d)
  (CTag a
CTagBoxTextStyle :=> Identity a
d) -> \(SEltLabel Text
sname SElt
selt) ->
    Text -> SElt -> SEltLabel
SEltLabel Text
sname (Bool -> SElt -> CTextStyle -> SElt
modify_sElt_with_cTextStyle Bool
isDo SElt
selt a
d)

  (CTag a
CTagBoxLabelAlignment :=> Identity a
d) -> \(SEltLabel Text
sname SElt
selt) ->
    Text -> SElt -> SEltLabel
SEltLabel Text
sname (Bool -> SElt -> CTextAlign -> SElt
modify_sEltBox_label_with_cTextAlign Bool
isDo SElt
selt a
d)
  (CTag a
CTagBoxLabelText :=> Identity a
d) -> \(SEltLabel Text
sname SElt
selt) ->
    Text -> SElt -> SEltLabel
SEltLabel Text
sname (Bool -> SElt -> CMaybeText -> SElt
modify_sEltBox_label_with_cMaybeText Bool
isDo SElt
selt a
d)

  (CTag a
CTagTextArea :=> Identity a
d) -> \(SEltLabel Text
sname SElt
selt) ->
    Text -> SElt -> SEltLabel
SEltLabel Text
sname (Bool -> SElt -> CTextArea -> SElt
modify_sEltTextArea_with_cTextArea Bool
isDo SElt
selt a
d)
  (CTag a
CTagTextAreaToggle :=> Identity a
d) -> \(SEltLabel Text
sname SElt
selt) ->
    Text -> SElt -> SEltLabel
SEltLabel Text
sname (Bool -> SElt -> CTextAreaToggle -> SElt
modify_sEltTextArea_with_cTextAreaToggle Bool
isDo SElt
selt a
d)


-- | helper method used in copy pasta
offsetSEltTree :: XY -> SEltTree -> SEltTree
offsetSEltTree :: XY -> SEltTree -> SEltTree
offsetSEltTree XY
offset SEltTree
stree = SEltTree
r where
  op :: CBoundingBox
op = DeltaLBox -> CBoundingBox
CBoundingBox (XY -> XY -> DeltaLBox
DeltaLBox XY
offset XY
0)
  offsetfn :: (Int, SEltLabel) -> (Int, SEltLabel)
offsetfn (Int
rid, SEltLabel
seltl) = (Int
rid, Bool -> Controller -> SEltLabel -> SEltLabel
updateFnFromController Bool
True (CTag CBoundingBox
CTagBoundingBox forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> forall a. a -> Identity a
Identity CBoundingBox
op) SEltLabel
seltl)
  r :: SEltTree
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, SEltLabel) -> (Int, SEltLabel)
offsetfn SEltTree
stree