Skip to content
Browse files

add {trim,clamp}{Before,After} and <||>

  • Loading branch information...
1 parent dcdb18f commit 0150f23e92842b8cddc68a5a916234645e7f2dc4 Brent Yorgey committed
Showing with 106 additions and 9 deletions.
  1. +1 −1 diagrams/Makefile
  2. +30 −4 diagrams/ui.hs
  3. +75 −4 src/Data/Active.hs
View
2 diagrams/Makefile
@@ -1,4 +1,4 @@
-all : ui.png clamp.png trim.png backwards.png
+all : ui.png clamp.png clampBefore.png clampAfter.png trim.png trimBefore.png trimAfter.png backwards.png
.SECONDARY :
View
34 diagrams/ui.hs
@@ -4,7 +4,7 @@ import Diagrams.Prelude
import Diagrams.Backend.Cairo.CmdLine
d fun = (square 4 <> ends <> fun # lc red) # lw 0.03 # lineCap LineCapRound # lineJoin LineJoinRound
- where ends = vert <> vert # translateX 1
+ where ends = vert <> vert # translateX 1
<> rect 1 4 # translateX (0.5) # opacity 0.2 # fc grey
vert = vrule 4 # lw 0.02 # dashing [0.1,0.1] 0 # lc grey
@@ -14,8 +14,34 @@ backwardsFun = (P (2,-1) ~~ P (-1,2))
clampFun = fromOffsets [(2,0), (1,1), (1,0)] # centerX
-trimFun = origin ~~ P (1,1)
+clampBeforeFun = fromOffsets [(2,0), (2,2)] # centerX
+
+clampAfterFun = fromOffsets [(3,3), (1,0)] # centerX # translateY (-2)
-ds = map (pad 1.1 . d) [uiFun, clampFun, trimFun, backwardsFun]
+trimFun = origin ~~ P (1,1)
-main = multiMain (zip ["ui", "clamp", "trim", "backwards"] ds)
+trimBeforeFun = origin ~~ P (2,2)
+
+trimAfterFun = P (-2,-2) ~~ P(1,1)
+
+ds = map (pad 1.1 . d) [ uiFun
+ , clampFun
+ , clampBeforeFun
+ , clampAfterFun
+ , trimFun
+ , trimBeforeFun
+ , trimAfterFun
+ , backwardsFun
+ ]
+
+main = multiMain (zip [ "ui"
+ , "clamp"
+ , "clampBefore"
+ , "clampAfter"
+ , "trim"
+ , "trimBefore"
+ , "trimAfter"
+ , "backwards"
+ ]
+ ds
+ )
View
79 src/Data/Active.hs
@@ -72,13 +72,17 @@ module Data.Active
, stretch, stretchTo, during
, shift, backwards
- , clamp, trim
- -- ** Composing active values
+ -- ** Working with values outside the era
+ , clamp, clampBefore, clampAfter
+ , trim, trimBefore, trimAfter
+ -- ** Composing active values
, after
, (->>), progression
+ , (<||>)
+
-- * Discretization
, discrete
@@ -91,9 +95,11 @@ import Control.Arrow ((&&&))
import Control.Newtype
import Data.Array
+import Data.Maybe
import Data.Functor.Apply
-import Data.Semigroup
+import Data.Semigroup hiding (First(..))
+import Data.Monoid (First(..))
import Data.VectorSpace hiding ((<.>))
import Data.AffineSpace
@@ -397,6 +403,8 @@ backwards =
--
-- <<http://www.cis.upenn.edu/~byorgey/hosted/clamp.png>>
--
+-- See also 'clampBefore' and 'clampAfter', which clamp only before
+-- or after the era, respectively.
clamp :: Active a -> Active a
clamp =
modActive id . onDynamic $ \s e d ->
@@ -406,7 +414,26 @@ clamp =
| otherwise -> d t
)
+-- | \"Clamp\" an active value so that it is constant before the start
+-- of its era. For example, @clampBefore 'ui'@ can be visualized as
+--
+-- <<http://www.cis.upenn.edu/~byorgey/hosted/clampBefore.png>>
+--
+-- See the documentation of 'clamp' for more information.
+clampBefore :: Active a -> Active a
+clampBefore = undefined
+
+-- | \"Clamp\" an active value so that it is constant after the end
+-- of its era. For example, @clampBefore 'ui'@ can be visualized as
+--
+-- <<http://www.cis.upenn.edu/~byorgey/hosted/clampAfter.png>>
+--
+-- See the documentation of 'clamp' for more information.
+clampAfter :: Active a -> Active a
+clampAfter = undefined
+
-- | \"Trim\" an active value so that it is empty outside its era.
+-- @trim@ has no effect on constant values.
--
-- For example, @trim 'ui'@ can be visualized as
--
@@ -415,7 +442,11 @@ clamp =
-- Actually, @trim ui@ is not well-typed, since it is not guaranteed
-- that @ui@'s values will be monoidal (and usually they won't be)!
-- But the above image still provides a good intuitive idea of what
--- @trim@ is doing.
+-- @trim@ is doing. To make this precise we could consider something
+-- like @trim (First . Just <$> ui)@.
+--
+-- See also 'trimBefore' and 'trimActive', which trim only before or
+-- after the era, respectively.
trim :: Monoid a => Active a -> Active a
trim =
modActive id . onDynamic $ \s e d ->
@@ -425,6 +456,35 @@ trim =
| otherwise -> d t
)
+-- | \"Trim\" an active value so that it is empty /before/ the start
+-- of its era. For example, @trimBefore 'ui'@ can be visualized as
+--
+-- <<http://www.cis.upenn.edu/~byorgey/hosted/trimBefore.png>>
+--
+-- See the documentation of 'trim' for more details.
+trimBefore :: Monoid a => Active a -> Active a
+trimBefore =
+ modActive id . onDynamic $ \s e d ->
+ mkDynamic s e
+ (\t -> case () of _ | t < s -> mempty
+ | otherwise -> d t
+ )
+
+-- | \"Trim\" an active value so that it is empty /after/ the end
+-- of its era. For example, @trimAfter 'ui'@ can be visualized as
+--
+-- <<http://www.cis.upenn.edu/~byorgey/hosted/trimAfter.png>>
+--
+-- See the documentation of 'trim' for more details.
+trimAfter :: Monoid a => Active a -> Active a
+trimAfter =
+ modActive id . onDynamic $ \s e d ->
+ mkDynamic s e
+ (\t -> case () of _ | t > e -> mempty
+ | otherwise -> d t
+ )
+
+
-- | Set the era of an 'Active' value. Note that this will change a
-- constant 'Active' into a dynamic one which happens to be
-- constant.
@@ -463,6 +523,17 @@ progression = foldr (->>) (pure mempty)
-- XXX do above with a balanced fold?
+-- XXX illustrate below
+
+-- | \"Splice\" two 'Active' values together: shift the second to
+-- start immediately after the first (using 'after'), and produce
+-- the value which acts like the first up to the common end/start
+-- point, then like the second after that. If both are constant,
+-- return the first.
+(<||>) :: Active a -> Active a -> Active a
+a1 <||> a2 = (fromJust . getFirst) <$>
+ (trimAfter (First . Just <$> a1) ->> trimBefore (First . Just <$> a2))
+
------------------------------------------------------------
-- Discretization
------------------------------------------------------------

0 comments on commit 0150f23

Please sign in to comment.
Something went wrong with that request. Please try again.