-- |
-- Module      : FULE.Layout
-- Description : Low-level layout functionality.
-- Copyright   : (c) Paul Schnapp, 2023
-- License     : BSD3
-- Maintainer  : Paul Schnapp <paul.schnapp@gmail.com>
--
-- This is the basic, low-level layout functionality.
--
-- You'll start by creating a 'FULE.Layout.LayoutDesign' and then make a usable
-- 'FULE.Layout.Layout' from it by 'FULE.Layout.build'ing it.
module FULE.Layout
 ( LayoutDesign
 , emptyLayoutDesign
 --
 , GuideID
 , PlasticDependencyType(..)
 , GuideSpecification(..)
 , addGuide
 --
 , GuideConstraint(..)
 , addGuideConstraint
 --
 , Layout
 , build
 , design
 , getGuide
 , getGuides
 , reactToChange
 , reactToChanges
 ) where

import Control.DeepSeq

import FULE.Internal.Sparse as Matrix


--------------------------------
-- LayoutDesign
--------------------------------

-- | A 'Layout' that is still under construction.
--   Use the 'build' function to turn a @LayoutDesign@ into an elivened @Layout@.
data LayoutDesign
  = LayoutDesign
    { LayoutDesign -> Matrix Double
designPlasticityOf :: Matrix Double
    , LayoutDesign -> Matrix Double
designElasticityOf :: Matrix Double
    , LayoutDesign -> Matrix Double
designLTEConstraintsOf :: Matrix Double
    , LayoutDesign -> Matrix Double
designGTEConstraintsOf :: Matrix Double
    , LayoutDesign -> Matrix Double
designGuidesOf :: Matrix Double
    }

instance NFData LayoutDesign where
  rnf :: LayoutDesign -> ()
rnf (LayoutDesign Matrix Double
p Matrix Double
e Matrix Double
lte Matrix Double
gte Matrix Double
g) =
    Matrix Double -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq Matrix Double
p (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq Matrix Double
e (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq Matrix Double
lte (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq Matrix Double
gte (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq Matrix Double
g (() -> ()) -> () -> ()
forall a b. (a -> b) -> a -> b
$ ()

-- | Create a new 'LayoutDesign'.
emptyLayoutDesign :: LayoutDesign
emptyLayoutDesign :: LayoutDesign
emptyLayoutDesign = Matrix Double
-> Matrix Double
-> Matrix Double
-> Matrix Double
-> Matrix Double
-> LayoutDesign
LayoutDesign Matrix Double
forall a. Matrix a
empty Matrix Double
forall a. Matrix a
empty Matrix Double
forall a. Matrix a
empty Matrix Double
forall a. Matrix a
empty Matrix Double
forall a. Matrix a
empty


-- | An identifier for a Guide in a 'Layout' or 'LayoutDesign'.
newtype GuideID = G Int
  deriving (GuideID -> GuideID -> Bool
(GuideID -> GuideID -> Bool)
-> (GuideID -> GuideID -> Bool) -> Eq GuideID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuideID -> GuideID -> Bool
== :: GuideID -> GuideID -> Bool
$c/= :: GuideID -> GuideID -> Bool
/= :: GuideID -> GuideID -> Bool
Eq, Eq GuideID
Eq GuideID =>
(GuideID -> GuideID -> Ordering)
-> (GuideID -> GuideID -> Bool)
-> (GuideID -> GuideID -> Bool)
-> (GuideID -> GuideID -> Bool)
-> (GuideID -> GuideID -> Bool)
-> (GuideID -> GuideID -> GuideID)
-> (GuideID -> GuideID -> GuideID)
-> Ord GuideID
GuideID -> GuideID -> Bool
GuideID -> GuideID -> Ordering
GuideID -> GuideID -> GuideID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GuideID -> GuideID -> Ordering
compare :: GuideID -> GuideID -> Ordering
$c< :: GuideID -> GuideID -> Bool
< :: GuideID -> GuideID -> Bool
$c<= :: GuideID -> GuideID -> Bool
<= :: GuideID -> GuideID -> Bool
$c> :: GuideID -> GuideID -> Bool
> :: GuideID -> GuideID -> Bool
$c>= :: GuideID -> GuideID -> Bool
>= :: GuideID -> GuideID -> Bool
$cmax :: GuideID -> GuideID -> GuideID
max :: GuideID -> GuideID -> GuideID
$cmin :: GuideID -> GuideID -> GuideID
min :: GuideID -> GuideID -> GuideID
Ord, ReadPrec [GuideID]
ReadPrec GuideID
Int -> ReadS GuideID
ReadS [GuideID]
(Int -> ReadS GuideID)
-> ReadS [GuideID]
-> ReadPrec GuideID
-> ReadPrec [GuideID]
-> Read GuideID
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GuideID
readsPrec :: Int -> ReadS GuideID
$creadList :: ReadS [GuideID]
readList :: ReadS [GuideID]
$creadPrec :: ReadPrec GuideID
readPrec :: ReadPrec GuideID
$creadListPrec :: ReadPrec [GuideID]
readListPrec :: ReadPrec [GuideID]
Read, Int -> GuideID -> ShowS
[GuideID] -> ShowS
GuideID -> String
(Int -> GuideID -> ShowS)
-> (GuideID -> String) -> ([GuideID] -> ShowS) -> Show GuideID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuideID -> ShowS
showsPrec :: Int -> GuideID -> ShowS
$cshow :: GuideID -> String
show :: GuideID -> String
$cshowList :: [GuideID] -> ShowS
showList :: [GuideID] -> ShowS
Show)

instance NFData GuideID where
  rnf :: GuideID -> ()
rnf g :: GuideID
g@(G Int
i) = GuideID -> () -> ()
forall a b. a -> b -> b
seq GuideID
g (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq Int
i (() -> ()) -> () -> ()
forall a b. (a -> b) -> a -> b
$ ()


-- | The type of a plastic dependency between two Guides.
data PlasticDependencyType
  = Asymmetric
  -- ^ Specifies that changes to the dependent Guide do not affect the reference
  --   Guide, but changes to the reference propagate to the dependent Guide.
  | Symmetric
  -- ^ Specifies that changes to either Guide are applied to the other as well.
  deriving (PlasticDependencyType -> PlasticDependencyType -> Bool
(PlasticDependencyType -> PlasticDependencyType -> Bool)
-> (PlasticDependencyType -> PlasticDependencyType -> Bool)
-> Eq PlasticDependencyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlasticDependencyType -> PlasticDependencyType -> Bool
== :: PlasticDependencyType -> PlasticDependencyType -> Bool
$c/= :: PlasticDependencyType -> PlasticDependencyType -> Bool
/= :: PlasticDependencyType -> PlasticDependencyType -> Bool
Eq, Int -> PlasticDependencyType -> ShowS
[PlasticDependencyType] -> ShowS
PlasticDependencyType -> String
(Int -> PlasticDependencyType -> ShowS)
-> (PlasticDependencyType -> String)
-> ([PlasticDependencyType] -> ShowS)
-> Show PlasticDependencyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlasticDependencyType -> ShowS
showsPrec :: Int -> PlasticDependencyType -> ShowS
$cshow :: PlasticDependencyType -> String
show :: PlasticDependencyType -> String
$cshowList :: [PlasticDependencyType] -> ShowS
showList :: [PlasticDependencyType] -> ShowS
Show)

-- | The specification of a Guide to be added to a 'LayoutDesign'.
--   A Guide may be added:
--
--   * at an absolute position within the design
--   * relative to a reference Guide within the design with a plastic
--     dependencey upon the reference
--   * relative to two reference Guides within the design with an elastic
--     dependency upon both
--
--   See each constructor and its fields for more information.
data GuideSpecification
  = Absolute -- ^ Add a new Guide at an absolute position within the @Layout@.
    { GuideSpecification -> Int
positionOf :: Int
    -- ^ The position the new Guide should have in the @Layout@.
    --   Note this could be either an @x@ or @y@ position, the axis doesn't
    --   matter for the specification.
    }
  | Relative -- ^ Add a new Guide with a plastic dependence on a reference Guide.
    { GuideSpecification -> Int
offsetOf :: Int
    -- ^ The offset from the reference Guide the new dependent Guide should have.
    , GuideSpecification -> GuideID
dependencyOf :: GuideID
    -- ^ The ID of the reference Guide.
    , GuideSpecification -> PlasticDependencyType
dependencyTypeOf :: PlasticDependencyType
    -- ^ The type of dependency the dependent Guide should have on the reference
    --   Guide.
    }
  | Between
    -- ^ Add a new Guide between two other Guides with an elastic dependency on them:
    --   Whenever one of the reference Guides moves the dependent Guide will be moved
    --   to remain positioned relatively between them.
    --
    --   The @Double@ arguments of the pairs below should sum to equal @1.0@;
    --   this will not be checked.
      (GuideID, Double)
      -- ^ A reference Guide and how close the dependent Guide should be to it
      --   relative to the other reference, as a percentage.
      (GuideID, Double)
      -- ^ Another reference Guide and how close the dependent Guide should be
      --   to it relative to the first reference, as a percentage.


-- | Add a new Guide to a 'LayoutDesign' according to the given 'GuideSpecification'.
--
--   Returns an ID for the new Guide along with an updated 'LayoutDesign'.
addGuide :: GuideSpecification -> LayoutDesign -> (GuideID, LayoutDesign)
addGuide :: GuideSpecification -> LayoutDesign -> (GuideID, LayoutDesign)
addGuide (Absolute Int
pos) = Int -> LayoutDesign -> (GuideID, LayoutDesign)
addAbsolute Int
pos
addGuide (Relative Int
offset GuideID
gid PlasticDependencyType
dep) = Int
-> GuideID
-> PlasticDependencyType
-> LayoutDesign
-> (GuideID, LayoutDesign)
addRelative Int
offset GuideID
gid PlasticDependencyType
dep 
addGuide (Between (GuideID, Double)
r1 (GuideID, Double)
r2) = (GuideID, Double)
-> (GuideID, Double) -> LayoutDesign -> (GuideID, LayoutDesign)
addBetween (GuideID, Double)
r1 (GuideID, Double)
r2

type LayoutDesignOp = LayoutDesign -> (GuideID, LayoutDesign)

addAbsolute :: Int -> LayoutDesignOp
addAbsolute :: Int -> LayoutDesign -> (GuideID, LayoutDesign)
addAbsolute Int
position LayoutDesign
design =
  ( Int -> GuideID
G Int
gid
  , LayoutDesign
    { designPlasticityOf :: Matrix Double
designPlasticityOf = Pos -> Double -> Matrix Double -> Matrix Double
forall a. (Eq a, Num a) => Pos -> a -> Matrix a -> Matrix a
set (Int
gid, Int
gid) Double
1 (LayoutDesign -> Matrix Double
designPlasticityOf LayoutDesign
design)
    , designElasticityOf :: Matrix Double
designElasticityOf = Pos -> Matrix Double -> Matrix Double
forall a. Pos -> Matrix a -> Matrix a
expandTo (Int
gid, Int
gid) (LayoutDesign -> Matrix Double
designElasticityOf LayoutDesign
design)
    , designLTEConstraintsOf :: Matrix Double
designLTEConstraintsOf = Pos -> Matrix Double -> Matrix Double
forall a. Pos -> Matrix a -> Matrix a
expandTo (Int
gid, Int
gid) (LayoutDesign -> Matrix Double
designLTEConstraintsOf LayoutDesign
design)
    , designGTEConstraintsOf :: Matrix Double
designGTEConstraintsOf = Pos -> Matrix Double -> Matrix Double
forall a. Pos -> Matrix a -> Matrix a
expandTo (Int
gid, Int
gid) (LayoutDesign -> Matrix Double
designGTEConstraintsOf LayoutDesign
design)
    , designGuidesOf :: Matrix Double
designGuidesOf = Pos -> Double -> Matrix Double -> Matrix Double
forall a. (Eq a, Num a) => Pos -> a -> Matrix a -> Matrix a
set (Int
gid, Int
1) (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
position) (LayoutDesign -> Matrix Double
designGuidesOf LayoutDesign
design)
    }
  )
  where
    gid :: Int
gid = LayoutDesign -> Int
nextGuideNumberFor LayoutDesign
design

addRelative :: Int -> GuideID -> PlasticDependencyType -> LayoutDesignOp
addRelative :: Int
-> GuideID
-> PlasticDependencyType
-> LayoutDesign
-> (GuideID, LayoutDesign)
addRelative Int
offset (G Int
ref) PlasticDependencyType
dep design :: LayoutDesign
design@(LayoutDesign { designGuidesOf :: LayoutDesign -> Matrix Double
designGuidesOf = Matrix Double
guides }) =
  ( Int -> GuideID
G Int
gid
  , LayoutDesign
    { designPlasticityOf :: Matrix Double
designPlasticityOf =
        Pos -> Double -> Matrix Double -> Matrix Double
forall a. (Eq a, Num a) => Pos -> a -> Matrix a -> Matrix a
set (Int
gid, Int
gid) Double
1 (Matrix Double -> Matrix Double)
-> (Matrix Double -> Matrix Double)
-> Matrix Double
-> Matrix Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Double -> Matrix Double -> Matrix Double
forall a. (Eq a, Num a) => Pos -> a -> Matrix a -> Matrix a
set (Int
gid, Int
ref) Double
1 (Matrix Double -> Matrix Double)
-> (Matrix Double -> Matrix Double)
-> Matrix Double
-> Matrix Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double -> Matrix Double
symRelat (Matrix Double -> Matrix Double) -> Matrix Double -> Matrix Double
forall a b. (a -> b) -> a -> b
$ LayoutDesign -> Matrix Double
designPlasticityOf LayoutDesign
design
    , designElasticityOf :: Matrix Double
designElasticityOf = Pos -> Matrix Double -> Matrix Double
forall a. Pos -> Matrix a -> Matrix a
expandTo (Int
gid, Int
gid) (LayoutDesign -> Matrix Double
designElasticityOf LayoutDesign
design)
    , designLTEConstraintsOf :: Matrix Double
designLTEConstraintsOf = Pos -> Matrix Double -> Matrix Double
forall a. Pos -> Matrix a -> Matrix a
expandTo (Int
gid, Int
gid) (LayoutDesign -> Matrix Double
designLTEConstraintsOf LayoutDesign
design)
    , designGTEConstraintsOf :: Matrix Double
designGTEConstraintsOf = Pos -> Matrix Double -> Matrix Double
forall a. Pos -> Matrix a -> Matrix a
expandTo (Int
gid, Int
gid) (LayoutDesign -> Matrix Double
designGTEConstraintsOf LayoutDesign
design)
    , designGuidesOf :: Matrix Double
designGuidesOf = Pos -> Double -> Matrix Double -> Matrix Double
forall a. (Eq a, Num a) => Pos -> a -> Matrix a -> Matrix a
set (Int
gid, Int
1) Double
pos Matrix Double
guides
    }
  )
  where
    gid :: Int
gid = LayoutDesign -> Int
nextGuideNumberFor LayoutDesign
design
    symRelat :: Matrix Double -> Matrix Double
symRelat = case PlasticDependencyType
dep of
      PlasticDependencyType
Asymmetric -> Matrix Double -> Matrix Double
forall a. a -> a
id
      PlasticDependencyType
Symmetric  -> Pos -> Double -> Matrix Double -> Matrix Double
forall a. (Eq a, Num a) => Pos -> a -> Matrix a -> Matrix a
set (Int
ref, Int
gid) Double
1
    pos :: Double
pos = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Pos -> Matrix Double -> Double
forall a. Num a => Pos -> Matrix a -> a
get (Int
ref, Int
1) Matrix Double
guides

addBetween :: (GuideID, Double) -> (GuideID, Double) -> LayoutDesignOp
addBetween :: (GuideID, Double)
-> (GuideID, Double) -> LayoutDesign -> (GuideID, LayoutDesign)
addBetween (G Int
ref1, Double
pct1) (G Int
ref2, Double
pct2) design :: LayoutDesign
design@(LayoutDesign { designGuidesOf :: LayoutDesign -> Matrix Double
designGuidesOf = Matrix Double
guides }) =
  ( Int -> GuideID
G Int
gid
  , LayoutDesign
    { designPlasticityOf :: Matrix Double
designPlasticityOf = Pos -> Double -> Matrix Double -> Matrix Double
forall a. (Eq a, Num a) => Pos -> a -> Matrix a -> Matrix a
set (Int
gid, Int
gid) Double
1 (LayoutDesign -> Matrix Double
designPlasticityOf LayoutDesign
design)
    , designElasticityOf :: Matrix Double
designElasticityOf =
        -- yes the indicies are supposed to mismatch in this
        Pos -> Double -> Matrix Double -> Matrix Double
forall a. (Eq a, Num a) => Pos -> a -> Matrix a -> Matrix a
set (Int
gid, Int
ref1) Double
pct2 (Matrix Double -> Matrix Double)
-> (Matrix Double -> Matrix Double)
-> Matrix Double
-> Matrix Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Double -> Matrix Double -> Matrix Double
forall a. (Eq a, Num a) => Pos -> a -> Matrix a -> Matrix a
set (Int
gid, Int
ref2) Double
pct1 (Matrix Double -> Matrix Double) -> Matrix Double -> Matrix Double
forall a b. (a -> b) -> a -> b
$
        Pos -> Matrix Double -> Matrix Double
forall a. Pos -> Matrix a -> Matrix a
expandTo (Int
gid, Int
gid) (LayoutDesign -> Matrix Double
designElasticityOf LayoutDesign
design)
    , designLTEConstraintsOf :: Matrix Double
designLTEConstraintsOf = Pos -> Matrix Double -> Matrix Double
forall a. Pos -> Matrix a -> Matrix a
expandTo (Int
gid, Int
gid) (LayoutDesign -> Matrix Double
designLTEConstraintsOf LayoutDesign
design)
    , designGTEConstraintsOf :: Matrix Double
designGTEConstraintsOf = Pos -> Matrix Double -> Matrix Double
forall a. Pos -> Matrix a -> Matrix a
expandTo (Int
gid, Int
gid) (LayoutDesign -> Matrix Double
designGTEConstraintsOf LayoutDesign
design)
    , designGuidesOf :: Matrix Double
designGuidesOf = Pos -> Double -> Matrix Double -> Matrix Double
forall a. (Eq a, Num a) => Pos -> a -> Matrix a -> Matrix a
set (Int
gid, Int
1) Double
pos Matrix Double
guides
    }
  )
  where
    gid :: Int
gid = LayoutDesign -> Int
nextGuideNumberFor LayoutDesign
design
    -- yes the indicies are supposed to mismatch in this
    pos :: Double
pos = Double
pct2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Pos -> Matrix Double -> Double
forall a. Num a => Pos -> Matrix a -> a
get (Int
ref1, Int
1) Matrix Double
guides Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
pct1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Pos -> Matrix Double -> Double
forall a. Num a => Pos -> Matrix a -> a
get (Int
ref2, Int
1) Matrix Double
guides

nextGuideNumberFor :: LayoutDesign -> Int
nextGuideNumberFor :: LayoutDesign -> Int
nextGuideNumberFor (LayoutDesign { designGuidesOf :: LayoutDesign -> Matrix Double
designGuidesOf = Matrix Double
guides }) =
  (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int) -> (Pos -> Int) -> Pos -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
forall a b. (a, b) -> a
fst (Pos -> Int) -> Pos -> Int
forall a b. (a -> b) -> a -> b
$ Matrix Double -> Pos
forall a. Matrix a -> Pos
dims Matrix Double
guides


--------------------------------
-- Guide Constraints
--------------------------------

-- | The type of constraint one Guide should have relative to another.
data GuideConstraint
  = LTE
    -- ^ Constrain a Guide to be always less-than or equal-to another.
    { GuideConstraint -> GuideID
constrainedOf :: GuideID
    -- ^ The Guide to constrain the movement of.
    , GuideConstraint -> GuideID
referenceOf :: GuideID
    -- ^ The reference Guide to constrain movement relative to.
    }
  | GTE
    -- ^ Constrain a Guide to be always greater-than or equal-to another.
    { constrainedOf :: GuideID
    -- ^ The Guide to constrain the movement of.
    , referenceOf :: GuideID
    -- ^ The reference Guide to constrain movement relative to.
    }
  deriving (GuideConstraint -> GuideConstraint -> Bool
(GuideConstraint -> GuideConstraint -> Bool)
-> (GuideConstraint -> GuideConstraint -> Bool)
-> Eq GuideConstraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuideConstraint -> GuideConstraint -> Bool
== :: GuideConstraint -> GuideConstraint -> Bool
$c/= :: GuideConstraint -> GuideConstraint -> Bool
/= :: GuideConstraint -> GuideConstraint -> Bool
Eq, Int -> GuideConstraint -> ShowS
[GuideConstraint] -> ShowS
GuideConstraint -> String
(Int -> GuideConstraint -> ShowS)
-> (GuideConstraint -> String)
-> ([GuideConstraint] -> ShowS)
-> Show GuideConstraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuideConstraint -> ShowS
showsPrec :: Int -> GuideConstraint -> ShowS
$cshow :: GuideConstraint -> String
show :: GuideConstraint -> String
$cshowList :: [GuideConstraint] -> ShowS
showList :: [GuideConstraint] -> ShowS
Show)

-- | Constrain the movement of one Guide relative to another. (Still slightly
--    experimental.)
--
--   __Important Notes:__
--
--   * Never constrain a Guide against itself
--   * A Guide should be used /only once/ as the constrainee (first argument)
--     for a given constraint-type
--   * The above conditions will not be checked!
--   * If a guide depends on multiple other guides that are simultaneously
--     affected by constraints, things may go a bit wonky, just sayin'.
addGuideConstraint :: GuideConstraint -> LayoutDesign -> LayoutDesign
addGuideConstraint :: GuideConstraint -> LayoutDesign -> LayoutDesign
addGuideConstraint GuideConstraint
constraint LayoutDesign
design =
  case GuideConstraint
constraint of
    LTE (G Int
forGuide) (G Int
ofGuide) ->
      LayoutDesign
design
      { designLTEConstraintsOf =
          set (forGuide, forGuide) 1
          . set (forGuide, ofGuide) (-1)
          $ designLTEConstraintsOf design
      }
    GTE (G Int
forGuide) (G Int
ofGuide) ->
      LayoutDesign
design
      { designGTEConstraintsOf =
          set (forGuide, forGuide) 1
          . set (forGuide, ofGuide) (-1)
          $ designGTEConstraintsOf design
      }


--------------------------------
-- Layout
--------------------------------

-- | A 'LayoutDesign' that has been enlivened and can have its Guides queried or
--   moved.
data Layout
  = Layout
    { Layout -> LayoutDesign
layoutDesignOf :: LayoutDesign
    , Layout -> Matrix Double
layoutLTEConstraintsOf :: Matrix Double
    , Layout -> Matrix Double
layoutGTEConstraintsOf :: Matrix Double
    , Layout -> Matrix Double
layoutTransformationOf :: Matrix Double
    , Layout -> Matrix Double
layoutGuidesOf :: Matrix Double
    }

instance NFData Layout where
  rnf :: Layout -> ()
rnf (Layout LayoutDesign
d Matrix Double
lte Matrix Double
gte Matrix Double
tx Matrix Double
g) =
    LayoutDesign -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq LayoutDesign
d (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq Matrix Double
lte (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq Matrix Double
gte (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq Matrix Double
tx (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq Matrix Double
g (() -> ()) -> () -> ()
forall a b. (a -> b) -> a -> b
$ ()

instance Show Layout where
  show :: Layout -> String
show Layout
l = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"\n"
    , Matrix Double -> String
forall a. Show a => a -> String
show (Layout -> Matrix Double
layoutTransformationOf Layout
l)
    , String
"\n\n"
    , Matrix Double -> String
forall a. Show a => a -> String
show (Layout -> Matrix Double
layoutGuidesOf Layout
l)
    , String
"\n"
    ]

propPlas :: (Num a) => Matrix a -> Matrix a
propPlas :: forall a. Num a => Matrix a -> Matrix a
propPlas Matrix a
m =
  let m' :: Matrix a
m' = Matrix a
m Matrix a -> Matrix a -> Matrix a
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`star` Matrix a
m
  -- Note: could possibly encounter a cycle and not know it, but this matrix
  -- should be idempotent so this condition should be ok.
  in if Matrix a -> Int
forall a. Matrix a -> Int
count Matrix a
m' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Matrix a -> Int
forall a. Matrix a -> Int
count Matrix a
m
  then Matrix a
m'
  else Matrix a -> Matrix a
forall a. Num a => Matrix a -> Matrix a
propPlas Matrix a
m'


propElas :: (Num a) => Matrix a -> Matrix a
propElas :: forall a. Num a => Matrix a -> Matrix a
propElas Matrix a
m = Matrix a -> Matrix a -> Matrix a
go Matrix a
m Matrix a
m
  where
    go :: Matrix a -> Matrix a -> Matrix a
go Matrix a
s Matrix a
p =
      let p' :: Matrix a
p' = Matrix a
m Matrix a -> Matrix a -> Matrix a
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`mul` Matrix a
p
      in if Matrix a -> Int
forall a. Matrix a -> Int
count Matrix a
p' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then Matrix a
s
      else Matrix a -> Matrix a -> Matrix a
go (Matrix a
s Matrix a -> Matrix a -> Matrix a
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`add` Matrix a
p') Matrix a
p'

-- | Create an enlivened 'Layout' from a 'LayoutDesign'.
build :: LayoutDesign -> Layout
build :: LayoutDesign -> Layout
build LayoutDesign
design =
  Layout
  { layoutDesignOf :: LayoutDesign
layoutDesignOf = LayoutDesign
design
  , layoutLTEConstraintsOf :: Matrix Double
layoutLTEConstraintsOf = Matrix Double
lte
  , layoutGTEConstraintsOf :: Matrix Double
layoutGTEConstraintsOf = Matrix Double
gte
  , layoutTransformationOf :: Matrix Double
layoutTransformationOf = Matrix Double
transform
  , layoutGuidesOf :: Matrix Double
layoutGuidesOf = Matrix Double
dg
  }
  where
    LayoutDesign
      { designPlasticityOf :: LayoutDesign -> Matrix Double
designPlasticityOf = Matrix Double
plas
      , designElasticityOf :: LayoutDesign -> Matrix Double
designElasticityOf = Matrix Double
elas
      , designLTEConstraintsOf :: LayoutDesign -> Matrix Double
designLTEConstraintsOf = Matrix Double
lte
      , designGTEConstraintsOf :: LayoutDesign -> Matrix Double
designGTEConstraintsOf = Matrix Double
gte
      , designGuidesOf :: LayoutDesign -> Matrix Double
designGuidesOf = Matrix Double
dg
      } = LayoutDesign
design
    pp :: Matrix Double
pp = Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a
propPlas Matrix Double
plas
    pe :: Matrix Double
pe = Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a
propElas Matrix Double
elas
    ph :: Matrix Double
ph = Matrix Double
pp Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`sub` (Int -> Matrix Double
forall a. Num a => Int -> Matrix a
eye (Int -> Matrix Double)
-> (Matrix Double -> Int) -> Matrix Double -> Matrix Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
forall a b. (a, b) -> a
fst (Pos -> Int) -> (Matrix Double -> Pos) -> Matrix Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double -> Pos
forall a. Matrix a -> Pos
dims (Matrix Double -> Matrix Double) -> Matrix Double -> Matrix Double
forall a b. (a -> b) -> a -> b
$ Matrix Double
plas)
    transform :: Matrix Double
transform = Matrix Double
pp Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`add` Matrix Double
pe
      Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`add` (Matrix Double
ph Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`mul` Matrix Double
pe)
      Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`add` (Matrix Double
pe Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`mul` Matrix Double
ph)
      Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`add` (Matrix Double
ph Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`mul` Matrix Double
pe Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`mul` Matrix Double
ph)

-- | Transform a 'Layout' back into a 'LayoutDesign'.
design :: Layout -> LayoutDesign
design :: Layout -> LayoutDesign
design Layout
layout =
  (Layout -> LayoutDesign
layoutDesignOf Layout
layout) { designGuidesOf = layoutGuidesOf layout }

-- | Get the position of a Guide within a 'Layout'.
getGuide :: GuideID -> Layout -> Int
getGuide :: GuideID -> Layout -> Int
getGuide (G Int
gid) = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> (Layout -> Double) -> Layout -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Matrix Double -> Double
forall a. Num a => Pos -> Matrix a -> a
get (Int
gid, Int
1) (Matrix Double -> Double)
-> (Layout -> Matrix Double) -> Layout -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Matrix Double
layoutGuidesOf

-- | Get the position of multiple Guides within a 'Layout'.
getGuides :: [GuideID] -> Layout -> [Int]
getGuides :: [GuideID] -> Layout -> [Int]
getGuides [GuideID]
gs Layout
layout = (GuideID -> Int) -> [GuideID] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (GuideID -> Layout -> Int
`getGuide` Layout
layout) [GuideID]
gs

-- | Move a Guide within a 'Layout'.
reactToChange
  :: GuideID -- ^ The Guide to move.
  -> Int -- ^ The movement to apply to the Guide -- a delta.
  -> Layout -> Layout
reactToChange :: GuideID -> Int -> Layout -> Layout
reactToChange (G Int
gid) Int
amt =
  [(Pos, Double)] -> Layout -> Layout
doReactToChanges [((Int
gid, Int
1), Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
amt)]

-- | Move multiple Guides within a 'Layout'.
reactToChanges
  :: [(GuideID, Int)]
  -- ^ A list of Guides with movements (deltas) to apply to them.
  -> Layout -> Layout
reactToChanges :: [(GuideID, Int)] -> Layout -> Layout
reactToChanges [(GuideID, Int)]
pairs =
  let convert :: (GuideID, a) -> ((Int, b), b)
convert (G Int
gid, a
amt) = ((Int
gid, b
1), a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
amt)
  in [(Pos, Double)] -> Layout -> Layout
doReactToChanges (((GuideID, Int) -> (Pos, Double))
-> [(GuideID, Int)] -> [(Pos, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (GuideID, Int) -> (Pos, Double)
forall {a} {b} {b}.
(Integral a, Num b, Num b) =>
(GuideID, a) -> ((Int, b), b)
convert [(GuideID, Int)]
pairs)

doReactToChanges :: [(Pos, Double)] -> Layout -> Layout
doReactToChanges :: [(Pos, Double)] -> Layout -> Layout
doReactToChanges [(Pos, Double)]
entries Layout
layout =
  Layout
layout { layoutGuidesOf = adjusted }
  where
    Layout
      { layoutLTEConstraintsOf :: Layout -> Matrix Double
layoutLTEConstraintsOf = Matrix Double
lte
      , layoutGTEConstraintsOf :: Layout -> Matrix Double
layoutGTEConstraintsOf = Matrix Double
gte
      , layoutTransformationOf :: Layout -> Matrix Double
layoutTransformationOf = Matrix Double
t
      , layoutGuidesOf :: Layout -> Matrix Double
layoutGuidesOf = Matrix Double
g
      } = Layout
layout
    changes :: Matrix Double
changes = Pos -> [(Pos, Double)] -> Matrix Double
forall a. Pos -> [(Pos, a)] -> Matrix a
matrix (Matrix Double -> Pos
forall a. Matrix a -> Pos
dims Matrix Double
g) [(Pos, Double)]
entries
    changed :: Matrix Double
changed = Matrix Double
t Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`mul` Matrix Double
changes Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`add` Matrix Double
g
    adjusted :: Matrix Double
adjusted = Matrix Double
changed
      Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`sub` (Matrix Double
t Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`mul` (Double -> Bool) -> Matrix Double -> Matrix Double
forall a. (a -> Bool) -> Matrix a -> Matrix a
Matrix.filter (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0) (Matrix Double
lte Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`mul` Matrix Double
changed))
      Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`sub` (Matrix Double
t Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`mul` (Double -> Bool) -> Matrix Double -> Matrix Double
forall a. (a -> Bool) -> Matrix a -> Matrix a
Matrix.filter (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0) (Matrix Double
gte Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => Matrix a -> Matrix a -> Matrix a
`mul` Matrix Double
changed))