dynamic-plot 0.1.4.0 → 0.2.0.0

raw patch · 4 files changed

+333/−319 lines, 4 filesdep +colour-spacedep +linearmap-categorydep −asyncdep ~manifoldsPVP ok

version bump matches the API change (PVP)

Dependencies added: colour-space, linearmap-category

Dependencies removed: async

Dependency ranges changed: manifolds

API changes (from Hackage documentation)

Files

• Graphics/Dynamic/Plot/Internal/Types.hs +17/−49
• Graphics/Dynamic/Plot/R2.hs +312/−266
• Graphics/Text/Annotation.hs +0/−1
• dynamic-plot.cabal +4/−3

@@ -52,12 +52,13 @@  import qualified Data.Vector as Arr import Data.List (sort)+import Data.List.NonEmpty (NonEmpty(..))  import Data.VectorSpace import Data.Basis+import Math.LinearMap.Category import Data.AffineSpace import Data.VectorSpace.Free ()-import Data.LinearMap.HerMetric import Data.Manifold.PseudoAffine import Data.Manifold.TreeCover import Data.Semigroup@@ -68,46 +69,8 @@ type R2 = Dia.V2 Double type P2 = Dia.P2 Double -instance FiniteDimensional R2 where-  dimension = Tagged 2-  basisIndex = Tagged bi where bi b = if (basisValue b::R2)^._x > 0.5 then 0 else 1-  indexBasis = Tagged ib-   where ib 0 = bx; ib 1 = by-         [(bx,_), (by,_)] = decompose (1^&1 :: R2)-  completeBasis = Tagged . fmap fst $ decompose (1^&1 :: R2)-instance HasMetric' R2 where-  type DualSpace R2 = R2-  (<.>^) = (<.>)-  functional f = f(1^&0) ^& f(0^&1)-  doubleDual = id; doubleDual' = id-instance Semimanifold R2 where-  type Needle R2 = R2-  fromInterior = id-  toInterior = pure-  translateP = Tagged (^+^)-  (.+~^) = (^+^)-instance PseudoAffine R2 where-  p.-~.q = pure(p^-^q)-instance LocallyCoercible R2 (R,R) where-  locallyTrivialDiffeomorphism v = (v^._x, v^._y)-instance LocallyCoercible (R,R) R2 where-  locallyTrivialDiffeomorphism = DiaTypes.r2 -instance Semimanifold P2 where-  type Needle P2 = R2-  fromInterior = id-  toInterior = pure-  translateP = Tagged (.+^)-  (.+~^) = (.+^)-instance PseudoAffine P2 where-  p.-~.q = pure(p.-.q)-instance LocallyCoercible P2 (R,R) where-  locallyTrivialDiffeomorphism v = (v^._x, v^._y)-instance LocallyCoercible (R,R) P2 where-  locallyTrivialDiffeomorphism = DiaTypes.p2 -- (^) :: Num n => n -> Int -> n (^) = (Prelude.^) @@ -181,7 +144,7 @@   -data DevBoxes y = DevBoxes { deviations :: HerMetric' (Diff y)+data DevBoxes y = DevBoxes { deviations :: Metric' y                            , maxDeviation :: Scalar (Diff y)   }                  @@ -215,7 +178,7 @@  recursiveSamples' :: forall x y v t .           ( VectorSpace x, Real (Scalar x)-          , AffineSpace y, v~Diff y, InnerSpace v, HasMetric v, RealFloat (Scalar v) )+          , AffineManifold y, v~Needle y, HilbertSpace v, RealFloat (Scalar v) )                      => PCMRange x -> [(y,t)] -> RecursiveSamples x y t recursiveSamples' xrng_g ys = calcDeviations . go xrng_g $ presplitList ys     where go :: PCMRange x -> SplitList (y,t) -> RecursiveSamples' (Arr.Vector y) x y t@@ -247,8 +210,8 @@            where cdvs lPFits rPFits                          rPCM@( RecursivePCM pFit dtls _ sSpc@(PCMRange xl wsp) slLn pts )                     = RecursivePCM pFit dtls' (DevBoxes stdDev maxDev) sSpc slLn ()-                   where stdDev = (^/ fromIntegral slLn) . sumV $ projector' <$> msqs-                         maxDev =     sqrt           . maximum $ magnitudeSq <$> msqs+                   where stdDev = scaleNorm (1/ fromIntegral slLn) $ spanNorm msqs+                         maxDev =     sqrt        . maximum $ magnitudeSq <$> msqs                          msqs = [ (y .-. ff x)                                 | (x,y) <- normlsdIdd $ SplitList pts ]                          ff = l₀splineRep (Pair lPFits rPFits) rPCM@@ -267,12 +230,12 @@                            recursiveSamples :: -          ( AffineSpace y, v~Diff y, InnerSpace v, HasMetric v, RealFloat (Scalar v) )+          ( AffineManifold y, v~Needle y, HilbertSpace v, RealFloat (Scalar v) )                      => [(y,t)] -> RecursiveSamples Int y t recursiveSamples = recursiveSamples' (PCMRange 0 1)  recursivePCM :: ( VectorSpace x, Real (Scalar x)-                , AffineSpace y, v~Diff y, InnerSpace v, HasMetric v, RealFloat (Scalar v) )+                , AffineManifold y, v~Needle y, HilbertSpace v, RealFloat (Scalar v) )                      => PCMRange x -> [y] -> x-.^>y recursivePCM xrng_g = recursiveSamples' xrng_g . fmap (,()) @@ -321,7 +284,7 @@   -rPCMSample :: (AffineSpace y, v~Diff y, InnerSpace v, HasMetric v, RealFloat (Scalar v))+rPCMSample :: (AffineManifold y, v~Needle y, HilbertSpace v, RealFloat (Scalar v))        => Interval R -> R -> (R->y) -> R-.^>y rPCMSample (Interval l r) δx f = recursivePCM (PCMRange l δx) [f x | x<-[l, l+δx .. r]]                     @@ -334,7 +297,7 @@            -*| Interval (yb - uy*2) (yt + uy*2)  where pm = constCoeff pFit        p₀ = pm .-^ linCoeff pFit; pe = pm .+^ linCoeff pFit-       ux = metric' dev $ 1^&0; uy = metric' dev $ 0^&1+       ux = dev |$| 1^&0; uy = dev |$| 0^&1        [xl,xr] = sort[p₀^._x, pe^._x]; [yb,yt] = sort[p₀^._y, pe^._y]  @@ -456,8 +419,8 @@  shadeExtends :: Shade P2 -> (Interval R, Interval R) shadeExtends shade-      = ( (ctr^._x) ± sqrt (metric' expa $ 1^&0)-        , (ctr^._y) ± sqrt (metric' expa $ 0^&1) )+      = ( (ctr^._x) ± (expa |$| 1^&0)+        , (ctr^._y) ± (expa |$| 0^&1) )  where ctr = shade^.shadeCtr; expa = shade^.shadeExpanse  @@ -488,5 +451,10 @@ fromInt = fromIntegral  ++++newtype Latest a = Latest { getLatestOf :: NonEmpty a }+ deriving (Hask.Functor)  

@@ -27,6 +27,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TemplateHaskell            #-}  module Graphics.Dynamic.Plot.R2 (         -- * Interactive display@@ -42,19 +43,24 @@         , PlainGraphicsR2         , shapePlot         , diagramPlot+        -- ** Computation in progress+        , plotLatest+        -- * Plot-object attributes+        -- ** Colour+        , tint, autoTint         -- ** Legend captions         , legendName+        -- * Viewport         -- ** View selection         , xInterval, yInterval, forceXRange, forceYRange-        -- ** View dependance+        -- ** View dependence         , ViewXCenter(..), ViewYCenter(..), ViewWidth(..), ViewHeight(..)         , ViewXResolution(..), ViewYResolution(..)-        -- ** Auxiliary plot objects+        -- * Auxiliary plot objects         , dynamicAxes, noDynamicAxes-        -- ** Plot type+        -- * The plot type         , DynamicPlottable-        -- ** Legacy-        , PlainGraphics(..)+        , tweakPrerendered         ) where  import Graphics.Dynamic.Plot.Colour@@ -90,14 +96,18 @@ import Control.Monad.Constrained  import Control.Lens hiding ((...), (<.>))+import Control.Lens.TH(makeLenses)    -import Control.Concurrent.Async+import Control.Concurrent (runInBoundThread, threadDelay, ThreadId, forkIO, killThread)+import Control.Concurrent.MVar import Control.DeepSeq+import Control.Exception (evaluate)   import Data.List (foldl', sort, sortBy, partition, zip4) import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Vector as Arr import Data.Maybe import Data.Semigroup@@ -108,9 +118,9 @@ import Data.Ord (comparing)  import Data.VectorSpace+import Math.LinearMap.Category import Data.Basis import Data.AffineSpace-import Data.LinearMap.HerMetric import Data.Manifold.PseudoAffine import Data.Function.Differentiable import Data.Manifold.Types@@ -118,6 +128,8 @@ import Data.Manifold.Web import qualified Data.Map.Lazy as Map +import qualified Data.Colour.Manifold as CSp+ import Data.Tagged  import Text.Printf@@ -131,8 +143,44 @@   +data Plot = Plot {+       _plotAnnotations :: [Annotation]+     , _getPlot :: PlainGraphicsR2+  }+makeLenses ''Plot  +data RangeRequest r +       = OtherDimDependantRange (Option (Interval r) -> Option (Interval r))+       | MustBeThisRange (Interval r)++type GraphWindowSpec = GraphWindowSpecR2++data DynamicPlottable = DynamicPlottable { +        _relevantRange_x, _relevantRange_y :: RangeRequest R+      , _inherentColours :: [DCol.Colour ℝ]+      , _occlusiveness :: Double+         -- ^ How surface-occupying the plot is.+         --   Use positive values for opaque 2D plots that would tend to obscure+         --   other objects, negative values for sparse/small point plots.+         --   The z-order will be chosen accordingly.+      , _axesNecessity :: Necessity+      , _legendEntries :: [LegendEntry]+      , _futurePlots :: Maybe DynamicPlottable+      , _dynamicPlot :: GraphWindowSpec -> Plot+  }+makeLenses ''DynamicPlottable+++data ObjInPlot = ObjInPlot {+        _lastStableView :: IORef (Maybe (GraphWindowSpec, Plot))+      , _newPlotView :: MVar (GraphWindowSpec, Plot)+      , _plotObjColour :: Maybe AColour+      , _originalPlotObject :: DynamicPlottable+   }+makeLenses ''ObjInPlot++ newtype PlainGraphics = PlainGraphics { getPlainGraphics :: PlainGraphicsR2 }     deriving (Semigroup, Monoid) @@ -159,12 +207,11 @@   plot = foldMap plot  instance Plottable PlainGraphics where-  plot (PlainGraphics d) = def {-             relevantRange_x = atLeastInterval rlx-           , relevantRange_y = atLeastInterval rly-           , axesNecessity = -1-           , dynamicPlot = plot-           }+  plot (PlainGraphics d) = def+           & relevantRange_x .~ atLeastInterval rlx+           & relevantRange_y .~ atLeastInterval rly+           & axesNecessity .~ -1+           & dynamicPlot .~ plot    where bb = DiaBB.boundingBox d          (rlx,rly) = case DiaBB.getCorners bb of                        Just (c1, c2)@@ -179,19 +226,23 @@ --   tinted to be distinguishable from other plot objects in the same window. --   Use 'diagramPlot' instead, if you want to view the diagram as-is. shapePlot :: PlainGraphicsR2 -> DynamicPlottable-shapePlot d = (diagramPlot d) { isTintableMonochromic = True, axesNecessity = 0 }+shapePlot d = diagramPlot d+               & inherentColours .~ []+               & axesNecessity .~ 0  -- | Plot a generic 'Dia.Diagram'. diagramPlot :: PlainGraphicsR2 -> DynamicPlottable diagramPlot d = plot $ PlainGraphics d  +metricFromLength :: RealFrac' s => s -> Norm s +metricFromLength l | l>0   = spanNorm [1 / l]    instance Plottable (R-->R) where-  plot f = def { relevantRange_y = OtherDimDependantRange yRangef-               , isTintableMonochromic = True-               , axesNecessity = 1-               , dynamicPlot = plot }+  plot f = def & relevantRange_y .~ OtherDimDependantRange yRangef+               & autoTint+               & axesNecessity .~ 1+               & dynamicPlot .~ plot    where yRangef (Option Nothing) = Option Nothing          yRangef (Option (Just (Interval l r)))              = case intervalImages@@ -207,10 +258,10 @@           where curves :: [[P2]]                 curves = map (map $ convℝ² . snd) . gatherSides                         $ discretisePathSegs-                              1000+                              10000                               ( const . metricFromLength                                                $ (rBound-lBound)/fromIntegral xResolution-                              , resolutionFunction gs )+                              , coerceMetric $ resolutionFunction gs )                               ((id&&&f)                                . alg (\x -> ( point lBound?<x?<point rBound ?-> x )))                 trace (p:q:ps) = simpleLine p q <> trace (q:ps)@@ -221,10 +272,10 @@          c = realToFrac  instance Plottable (R-->(R,R)) where-  plot f = def { relevantRange_y = mempty-               , isTintableMonochromic = True-               , axesNecessity = 1-               , dynamicPlot = plot }+  plot f = def & relevantRange_y .~ mempty+               & autoTint+               & axesNecessity .~ 1+               & dynamicPlot .~ plot    where plot gs@(GraphWindowSpecR2{..}) = curves `deepseq`                                           mkPlot (foldMap trace curves)           where curves :: [[P2]]@@ -232,7 +283,7 @@                         $ discretisePathSegs                               1000                               ( const . metricFromLength $ 1/100-                              , resolutionFunction gs )+                              , coerceMetric $ resolutionFunction gs )                               f                 trace (p:q:ps) = simpleLine p q <> trace (q:ps)                 trace _ = mempty@@ -245,12 +296,12 @@ resolutionFunction :: GraphWindowSpecR2 -> RieMetric ℝ² resolutionFunction GraphWindowSpecR2{..} = resoFunc  where w = rBound - lBound; h = tBound - bBound-       ε = projector (recip δx, 0) ^+^ projector (0, recip δy)+       ε = spanNorm [(recip δx^&0), (0^&recip δy)]        δx = w / fromIntegral xResolution        δy = h / fromIntegral yResolution-       resoFunc (x,y)+       resoFunc (DiaTypes.V2 x y)          | x >= lBound, x <= rBound, y >= bBound, y <= tBound  = ε-         | otherwise = projector (recip qx,0) ^+^ projector (0,recip qy)+         | otherwise = spanNorm [(recip qx^&0), (0^&recip qy)]         where qx | x < lBound  = lBound - x                  | x > rBound  = x - rBound                  | otherwise   = δx * qy/δy@@ -261,13 +312,12 @@  instance Plottable (R-.^>R) where   plot rPCM@(RecursivePCM gPFit gDetails gFitDevs (PCMRange x₀ wsp) gSplN ())-            = def {-                relevantRange_x = atLeastInterval $ Interval x₀ xr-              , relevantRange_y = otherDimDependence $ rPCMLinFitRange rPCM-              , isTintableMonochromic = True-              , axesNecessity = 1-              , dynamicPlot = plot-              }+            = def+              & relevantRange_x .~ atLeastInterval (Interval x₀ xr)+              & relevantRange_y .~ otherDimDependence (rPCMLinFitRange rPCM)+              & autoTint+              & axesNecessity .~ 1+              & dynamicPlot .~ plot    where           xr = wsp * fromIntegral gSplN          plot (GraphWindowSpecR2{..}) = mkPlot . trace $ flattenPCM_resoCut bb δx rPCM@@ -287,7 +337,7 @@                              [_y+~δq $ q, _y+~δp $ p, _y-~δp $ p, _y-~δq $ q                              ,_y+~δq $ q ]))                        ) <> trStRange (qd:ps)-                 where [σp,σq] = map (`metric'`1) [σp', σq']+                 where [σp,σq] = map (|$|1) [σp', σq']                 trStRange _ = mempty                 trMBound l = Dia.fromVertices l & Dia.dashingO [2,2] 0                 @@ -301,13 +351,12 @@  instance Plottable (RecursiveSamples Int P2 (DevBoxes P2)) where   plot rPCM@(RecursivePCM gPFit gDetails gFitDevs (PCMRange t₀ τsp) gSplN ())-            = def {-                relevantRange_x = atLeastInterval xRange-              , relevantRange_y = atLeastInterval yRange-              , isTintableMonochromic = True-              , axesNecessity = 1-              , dynamicPlot = plot-              }+            = def+              & relevantRange_x .~ atLeastInterval xRange+              & relevantRange_y .~ atLeastInterval yRange+              & autoTint+              & axesNecessity .~ 1+              & dynamicPlot .~ plot    where plot (GraphWindowSpecR2{..}) = mkPlot                         . foldMap trStRange                         $ flattenPCM_P2_resoCut bbView [(1/δxl)^&0, 0^&(1/δyl)] rPCM@@ -319,11 +368,11 @@                           )) <> trSR (qd:ps)                        trSR _ = mempty                        calcNormDev ((p,v), DevBoxes σ _) = (p .+^ d, p .-^ d)-                        where d = metriScale' σ $ turnLeft v+                        where d = let v' = turnLeft v in v' ^* (σ|$|v')                 trStRange (Right pts) = (`foldMap`pts)                    $ \(p, DevBoxes dv _)-                              -> let δxm = metric' dv $ 1^&0-                                     δym = metric' dv $ 0^&1+                              -> let δxm = dv |$| 1^&0+                                     δym = dv |$| 0^&1                                  in if δxm > δx && δym > δy                                       then simpleLine (_x +~ δxm $ p) (_x -~ δxm $ p)                                             <> simpleLine (_y +~ δym $ p) (_y -~ δym $ p)@@ -340,7 +389,7 @@   instance Plottable (Int -.^> P2) where-  plot = plot . fmap (\() -> DevBoxes zeroV zeroV :: DevBoxes P2)+  plot = plot . fmap (\() -> DevBoxes mempty zeroV :: DevBoxes P2)   @@ -363,13 +412,15 @@ --   there is no &#201c;statistic optimisation&#201d; as in 'tracePlot'. lineSegPlot :: [(Double, Double)] -> DynamicPlottable lineSegPlot ps'-    | null ps        = mempty { isTintableMonochromic = True }-    | otherwise      = def {-               relevantRange_x = atLeastInterval' $ foldMap (pure . spInterval . fst) (concat ps)-             , relevantRange_y = atLeastInterval' $ foldMap (pure . spInterval . snd) (concat ps)-             , isTintableMonochromic = True-             , axesNecessity = 1-             , dynamicPlot = plot }+    | null ps        = mempty & autoTint+    | otherwise      = def+             & relevantRange_x .~ atLeastInterval'+                                   ( foldMap (pure . spInterval . fst) (concat ps) )+             & relevantRange_y .~ atLeastInterval'+                                   ( foldMap (pure . spInterval . snd) (concat ps) )+             & autoTint+             & axesNecessity .~ 1+             & dynamicPlot .~ plot  where plot (GraphWindowSpecR2{..}) = mkPlot (foldMap trace ps)         where trace (p:q:ps) = simpleLine (Dia.p2 p) (Dia.p2 q) <> trace (q:ps)               trace _ = mempty@@ -402,7 +453,7 @@                xRange_norm'd = max (-1) ((lCorn^._x - xm)/w)                            ... min   1  ((rCorn^._x - xm)/w) -flattenPCM_P2_resoCut :: R2Box -> [DualSpace R2]+flattenPCM_P2_resoCut :: R2Box -> [DualVector R2]                               -> (RecursiveSamples x P2 t)                               -> [ Either [((P2, R2), DevBoxes P2)]                                           [(P2, t)]                 ]@@ -414,7 +465,7 @@           | DiaBB.isEmptyBox $ DiaBB.intersection bb (rPCM_R2_boundingBox rPCM)                 = \case l@(Left [] : _) -> l                         l -> Left [] : l-          | metrics' dev δs > 0.5 || (sum $ ((^2).(pa<.>^)) <$> δs) > 3+          | sum (normSq dev<$>δs) > 1/4 || (sum $ ((^2).(pa<.>^)) <$> δs) > 3           , Left (Pair s1 s2) <- details                 = go s1 . go s2           | Right pts <- details = (Right (Arr.toList pts) :)@@ -436,61 +487,65 @@   instance Plottable (Shade P2) where-  plot shade = def {-                relevantRange_x = atLeastInterval xRange-              , relevantRange_y = atLeastInterval yRange-              , isTintableMonochromic = True-              , axesNecessity = 1-              , dynamicPlot = plot-              }+  plot shade = def+              & relevantRange_x .~ atLeastInterval xRange+              & relevantRange_y .~ atLeastInterval yRange+              & autoTint+              & axesNecessity .~ 1+              & dynamicPlot .~ plot    where plot _ = mkPlot $ foldMap axLine eigVs            where axLine eigV = simpleLine (ctr .-~^ eigV) (ctr .+~^ eigV)          (xRange,yRange) = shadeExtends shade          ctr = shade^.shadeCtr-         eigVs = eigenSpan $ shade^.shadeExpanse+         eigVs = normSpanningSystem $ shade^.shadeExpanse +instance Plottable (Shade ℝ²) where+  plot (Shade v e) = plot (Shade (Dia.P v) e :: Shade P2)+ instance Plottable (Shade (R,R)) where-  plot sh = plot (coerceShade sh :: Shade P2)+  plot sh = plot (coerceShade sh :: Shade R2)  instance Plottable (Shade' (R,R)) where-  plot shade = def {-                isTintableMonochromic = True-              , axesNecessity = 1-              , dynamicPlot = plot-              }+  plot shade = def+              & autoTint+              & axesNecessity .~ 1+              & dynamicPlot .~ plot    where plot _ = mkPlot $ Dia.circle 1                             & Dia.scaleX w₁ & Dia.scaleY w₂                             & Dia.rotate ϑ                             & Dia.opacity 0.2                             & Dia.moveTo ctr          ctr = Dia.p2 $ shade^.shadeCtr-         [ev₁@(e₁x,e₁y),ev₂] = eigenSpan' $ shade^.shadeNarrowness+         Norm expanr = shade^.shadeNarrowness+         [ev₁@(_,(e₁x,e₁y)),ev₂] = eigen $ arr expanr          ϑ = atan2 e₁y e₁x  Dia.@@ Dia.rad-         w₁ = recip $ magnitude ev₁; w₂ = recip $ magnitude ev₂+         [w₁,w₂] = recip . sqrt . fst <$> [ev₁, ev₂]  instance Plottable (ConvexSet (R,R)) where   plot EmptyConvex = mempty   plot (ConvexSet hull intersects)       = plot [ plot intersects-                 & tweakDiagram (Dia.opacity+                 & tweakPrerendered (Dia.opacity                                      (1 / fromIntegral (length intersects)) )              , plot hull-                 & tweakDiagram ( Dia.lwO 3+                 & tweakPrerendered ( Dia.lwO 3                               >>> Dia.opacity 1                               >>> Dia.fcA (Dia.withOpacity Dia.grey 0.01) ) ]          +instance Plottable (Shade' ℝ²) where+  plot sh = plot (coerceShade sh :: Shade' (ℝ,ℝ))+          instance Plottable (Shade' P2) where-  plot sh = plot (coerceShade sh :: Shade' (R,R))+  plot (Shade' (Dia.P v) e) = plot (Shade' v e :: Shade' ℝ²)   instance Plottable (Shaded ℝ ℝ) where   plot tr | length trivs' >= 2-          = def { relevantRange_x = atLeastInterval $ Interval xmin xmax-                , relevantRange_y = atLeastInterval $ Interval ymin ymax-                , isTintableMonochromic = True-                , axesNecessity = 1-                , dynamicPlot = plot-                }+          = def & relevantRange_x .~ atLeastInterval (Interval xmin xmax)+                & relevantRange_y .~ atLeastInterval (Interval ymin ymax)+                & autoTint+                & axesNecessity .~ 1+                & dynamicPlot .~ plot    where plot grWS@(GraphWindowSpecR2{..}) = mkPlot $                             foldMap parallelogram trivs                          <> (foldMap (singlePointFor grWS) leafPoints@@ -522,12 +577,11 @@  instance Plottable (PointsWeb ℝ (Shade' ℝ)) where   plot web | length locals >= 2-          = def { relevantRange_x = atLeastInterval $ Interval xmin xmax-                , relevantRange_y = atLeastInterval $ Interval ymin ymax-                , isTintableMonochromic = True-                , axesNecessity = 1-                , dynamicPlot = plot-                }+          = def & relevantRange_x .~ atLeastInterval (Interval xmin xmax)+                & relevantRange_y .~ atLeastInterval (Interval ymin ymax)+                & autoTint+                & axesNecessity .~ 1+                & dynamicPlot .~ plot    where plot grWS@(GraphWindowSpecR2{..}) = mkPlot $                             foldMap parallelogram trivs                          <> foldMap vbar divis@@ -545,21 +599,24 @@          trivs :: [((ℝ, (Diff ℝ,Diff ℝ)), ((ℝ, Diff ℝ), LocalLinear ℝ ℝ))]          divis :: [(ℝ, (Diff ℝ,Diff ℝ))]          (trivs,divis) = concat***concat $ unzip (map mkTriv locals)-          where mkTriv ((xc,Shade' yc yce), [(δxo, Shade' yo _)])-                       = case tryMetricAsLength yce of-                           Option (Just ry) ->+          where mkTriv :: ((ℝ, Shade' ℝ), [(ℝ, Shade' ℝ)])+                     -> ( [((ℝ, (Diff ℝ,Diff ℝ)), ((ℝ, Diff ℝ), LocalLinear ℝ ℝ))]+                        , [(ℝ, (Diff ℝ,Diff ℝ))] )+                mkTriv ((xc,Shade' yc yce), [(δxo, Shade' yo _)])+                       = case findNormalLength yce of+                           Just ry ->                               ( [ ( (xc, dirSort 0 δxo)                                   , ( (yc, ry)-                                    , denseLinear $ \δx -> δx * (yo-yc)/δxo ) ) ], [] )-                           Option Nothing ->+                                    , id ^* ((yo-yc)/δxo) ) ) ], [] )+                           Nothing ->                               ( [], [(xc, dirSort 0 δxo)] )                 mkTriv ((xc,Shade' yc yce), [(δxl, Shade' yl _), (δxr, Shade' yr _)])-                       = case tryMetricAsLength yce of-                           Option (Just ry) ->+                       = case findNormalLength yce of+                           Just ry ->                               ( [ ( (xc, dirSort δxl δxr)                                   , ( (yc, ry)-                                    , denseLinear $ \δx -> δx * η ) ) ], [] )-                           Option Nothing ->+                                    , id ^* η ) ) ], [] )+                           Nothing ->                               ( [], [(xc, dirSort δxl δxr)] )                  where δxg = (δxr - δxl)/2                        η = (yr - yl)/(2*δxg)@@ -578,16 +635,29 @@          locals = Hask.toList $ localFocusWeb web   plot _ = def +instance Plottable (PointsWeb ℝ² (CSp.Colour ℝ)) where+++instance (Plottable x) => Plottable (Latest x) where+  plot (Latest (ev₀ :| [])) = plot ev₀+  plot (Latest (ev₀ :| ev₁:evs))+     = plot ev₀ & futurePlots .~ (Just . plot . Latest $ ev₁:|evs)+++plotLatest :: Plottable x => [x] -> DynamicPlottable+plotLatest (x:xs) = plot $ Latest (x:|xs)+plotLatest l = plot l++ instance Plottable (SimpleTree P2) where   plot (GenericTree Nothing) = plot ([] :: [SimpleTree P2])   plot (GenericTree (Just (ctr, root)))-           = def{-                relevantRange_x = atLeastInterval xRange-              , relevantRange_y = atLeastInterval yRange-              , isTintableMonochromic = True-              , axesNecessity = 1-              , dynamicPlot = plot-              }+           = def+              & relevantRange_x .~ atLeastInterval xRange+              & relevantRange_y .~ atLeastInterval yRange+              & autoTint+              & axesNecessity .~ 1+              & dynamicPlot .~ plot    where plot _ = mkPlot $ go 4 ctr (treeBranches root)           where go w bctr = foldMap (\(c,GenericTree b)                                        -> autoDashLine w bctr c@@ -600,6 +670,8 @@          tree = GenericTree [(ctr,root)] instance Plottable (Trees P2) where   plot (GenericTree ts) = plot $ (GenericTree . Just) <$> ts+instance Plottable (Trees R2) where+  plot = plot . fmap Dia.P  instance Plottable (SimpleTree (R,R)) where   plot = plot . fmap (\(x,y) -> DiaTypes.p2 (x,y))@@ -621,8 +693,6 @@        circ = Dia.circle 1 & Dia.scaleX pxw & Dia.scaleY pxh  -type GraphWindowSpec = GraphWindowSpecR2- moveStepRel :: (R, R)  -- ^ Relative translation @(Δx/w, Δy/h)@.             -> (R, R)  -- ^ Relative zoom.             -> GraphWindowSpec -> GraphWindowSpec@@ -645,10 +715,6 @@   -data Plot = Plot {-       plotAnnotations :: [Annotation]-     , getPlot :: PlainGraphicsR2-  } instance Semigroup Plot where   Plot a1 d1 <> Plot a2 d2 = Plot (a1<>a2) (d1<>d2) instance Monoid Plot where@@ -661,45 +727,35 @@ mkAnnotatedPlot :: [Annotation] -> PlainGraphicsR2 -> Plot mkAnnotatedPlot ans = Plot ans -data DynamicPlottable = DynamicPlottable { -        relevantRange_x, relevantRange_y :: RangeRequest R-      , isTintableMonochromic :: Bool-      , occlusiveness :: Double-         -- ^ How surface-occupying the plot is.-         --   Use positive values for opaque 2D plots that would tend to obscure-         --   other objects, negative values for sparse/small point plots.-         --   The z-order will be chosen accordingly.-      , axesNecessity :: Necessity-      , legendEntries :: [LegendEntry]-      , dynamicPlot :: GraphWindowSpec -> Plot-  }- instance Semigroup DynamicPlottable where-  DynamicPlottable rx₁ ry₁ tm₁ oc₁ ax₁ le₁ dp₁-    <> DynamicPlottable rx₂ ry₂ tm₂ oc₂ ax₂ le₂ dp₂+  DynamicPlottable rx₁ ry₁ tm₁ oc₁ ax₁ le₁ fu₁ dp₁+    <> DynamicPlottable rx₂ ry₂ tm₂ oc₂ ax₂ le₂ fu₂ dp₂         = DynamicPlottable-   (rx₁<>rx₂) (ry₁<>ry₂) (tm₁||tm₂) (oc₁+oc₂) (ax₁+ax₂) (le₁++le₂) (dp₁<>dp₂) +   (rx₁<>rx₂) (ry₁<>ry₂) (tm₁++tm₂) (oc₁+oc₂) (ax₁+ax₂)+                             (le₁++le₂) ((<>)<$>fu₁<*>fu₂) (dp₁<>dp₂)  instance Monoid DynamicPlottable where-  mempty = DynamicPlottable mempty mempty False 0 0 [] mempty+  mempty = DynamicPlottable mempty mempty [] 0 0 [] mempty mempty   mappend = (<>) instance Default DynamicPlottable where def = mempty -data GraphViewState = GraphViewState {-        lastStableView :: Maybe (GraphWindowSpec, Plot)-      , realtimeView, nextTgtView :: Async Plot-      , graphColor :: Maybe AColour-   }  -+-- | Set the caption for this plot object that should appear in the+--   plot legend. legendName :: String -> DynamicPlottable -> DynamicPlottable-legendName n d = d { legendEntries = LegendEntry (PlainText n) mempty : legendEntries d }+legendName n = legendEntries %~ (LegendEntry (PlainText n) mempty :) +-- | Colour this plot object in a fixed shade.+tint :: DCol.Colour ℝ -> DynamicPlottable -> DynamicPlottable+tint col = inherentColours .~ [col]+       >>> dynamicPlot %~ fmap (getPlot %~ Dia.lc col . Dia.fc col) -data RangeRequest r -       = OtherDimDependantRange (Option (Interval r) -> Option (Interval r))-       | MustBeThisRange (Interval r)+-- | Allow the object to be automatically assigned a colour that's otherwise+--   unused in the plot. (This is the default for most plot objects.)+autoTint :: DynamicPlottable -> DynamicPlottable+autoTint = inherentColours .~ [] + instance (Ord r) => Semigroup (RangeRequest r) where   MustBeThisRange r <> _ = MustBeThisRange r   _ <> MustBeThisRange r = MustBeThisRange r@@ -750,42 +806,41 @@ --   ATTENTION: the window may sometimes freeze, especially when displaying  --   complicated functions with 'fnPlot` from ghci. This is apparently --   a kind of deadlock problem with one of the C libraries that are invoked,---   in particular, 'fnPlot' makes heavy use of <http://hackage.haskell.org/package/hmatrix hmatrix>---   and thus <http://www.gnu.org/software/gsl/ GSL>. --   At the moment, we can recommend no better solution than to abort and restart ghci --   (or what else you use – iHaskell kernel, process, ...) if this occurs. plotWindow :: [DynamicPlottable] -> IO GraphWindowSpec plotWindow [] = plotWindow [dynamicAxes]-plotWindow graphs' = do-   -   dgStore <- newIORef $ mempty-   +plotWindow givenPlotObjs = runInBoundThread $ do        let defColourScheme = defaultColourScheme    +   viewState <- newIORef $ autoDefaultView givenPlotObjs+   viewTgt <- newIORef =<< readIORef viewState+   viewTgtGlobal <- newMVar =<< readIORef viewState+   screenResolution <- newIORef (640, 480)    -   ([viewTgt, viewState], graphs) <- do-           let window₀ = autoDefaultView graphs'-               assignGrViews :: [DynamicPlottable] -> [Colour] -> Double-                               -> IO [(DynamicPlottable, GraphViewState)]-               assignGrViews (g@DynamicPlottable{..}:gs) (c:cs) axn = do -                   v <- async $ return $! dynamicPlot window₀-                   fmap ((g, GraphViewState { lastStableView = Nothing-                                            , realtimeView = v, nextTgtView = v -                                            , graphColor = cl }-                        ) : ) $ assignGrViews gs cs' (axn + axesNecessity)-                where (cl, cs')-                        | isTintableMonochromic  = (Just $ defColourScheme c, cs)-                        | otherwise              = (Nothing, c:cs)-               assignGrViews [] _ axesNeed -                 | axesNeed > 0  = assignGrViews [dynamicAxes] [grey] (-1)-                 | otherwise     = return []-               graphs'' = sortBy (comparing occlusiveness) graphs'-           w <- mapM newIORef $ replicate 2 window₀-           gs <- newIORef =<< assignGrViews graphs'' defaultColourSeq 0-           return (w,gs)+   dgStore <- newIORef mempty    +   (plotObjs, cancelWorkers) :: ([ObjInPlot], IO ()) <- do+       let assignPlObjPropties :: [DynamicPlottable] -> [Colour] -> Necessity+                                    -> IO [(ObjInPlot, ThreadId)]+           assignPlObjPropties [] _ axesNeed+              | axesNeed > 0  = assignPlObjPropties [dynamicAxes] [grey] (-1)+              | otherwise     = return []+           assignPlObjPropties (o:os) (c:cs) axn = do+              newDia <- newEmptyMVar+              workerId <- forkIO $ objectPlotterThread o viewTgtGlobal newDia+              stableView <- newIORef Nothing+              ((ObjInPlot stableView newDia cl o, workerId) :)+                     <$> assignPlObjPropties os cs' (axn + o^.axesNecessity)+            where (cl, cs')+                    | null (o^.inherentColours)  = (Just $ defColourScheme c, cs)+                    | otherwise                  = (Nothing, c:cs)+       (pObs, workerId) <- unzip <$> assignPlObjPropties givenPlotObjs defaultColourSeq 0+       return ( sortBy (comparing $ _occlusiveness . _originalPlotObject) pObs+              , forM_ workerId killThread )    +       GTK.initGUI    window <- GTK.windowNew    @@ -797,9 +852,10 @@                 (canvasX,canvasY) <- GTK.widgetGetSize drawA                 modifyIORef viewTgt $ \view -> view{ xResolution = fromIntegral canvasX                                                    , yResolution = fromIntegral canvasY }+                 dia <- readIORef dgStore-                let oldSize = Dia.size dia-                    scaledDia = Dia.bg Dia.black+                    +                let scaledDia = Dia.bg Dia.black                                 . Dia.scaleX (fromInt canvasX / 2)                                 . Dia.scaleY (-fromInt canvasY / 2)                                 . Dia.translate (1 ^& (-1))@@ -876,35 +932,6 @@        return $ GTK.widgetQueueDraw drawA            -   let updateRTView, updateTgtView :: (GraphWindowSpec -> GraphWindowSpec) -> IO ()-       updateRTView updRealView = do-          vstOld <- readIORef viewState-          let newRealView = updRealView vstOld-          grViewsOld <- readIORef graphs-          writeIORef graphs <=< forM grViewsOld $ -               \(o@DynamicPlottable{..}, gv) -> do-                  newRt <- async $ return $! dynamicPlot newRealView-                  poll (realtimeView gv) >>= \case-                    Just(Right vw) -> return (o-                      , gv{ realtimeView = newRt, lastStableView = Just (vstOld, vw) })-                    _ -> do -                       cancel $ realtimeView gv-                       poll (nextTgtView gv) >>= \case-                         Just(Right vw) -> do-                           ttvn <- readIORef viewTgt -                           return (o, gv{ realtimeView = newRt, lastStableView = Just (ttvn, vw) })-                         _ -> return (o, gv{ realtimeView = newRt })-          writeIORef viewState newRealView-       updateTgtView updTgtView = do-          newTgtView <- updTgtView <$> readIORef viewTgt-          grViewsOld <- readIORef graphs-          writeIORef graphs <=< forM grViewsOld $ -               \(o@DynamicPlottable{..}, gv) -> do-                  newTt <- async $ return $! dynamicPlot newTgtView-                  cancel $ nextTgtView gv-                  return (o, gv{ nextTgtView = newTt })-          writeIORef viewTgt newTgtView-       t₀ <- getCurrentTime    lastFrameTime <- newIORef t₀    @@ -919,12 +946,12 @@                w = (rBound - lBound)/2; h = (tBound - bBound)/2                x₀ = lBound + w; y₀ = bBound + h                textTK txSiz asp = TextTK defaultTxtStyle txSiz asp 0.2 0.2-               renderComp (DynamicPlottable{..}, GraphViewState{..}) = do-                   plt <- poll realtimeView >>= \case-                                  Just (Right pl) -> return $ Just pl-                                  _ -> case lastStableView of-                                   Just (_, vw) -> return $ Just vw-                                   _ -> poll nextTgtView >> return Nothing+               renderComp plotObj = do+                   plt <- tryTakeMVar (plotObj^.newPlotView) >>= \case+                       Nothing -> fmap snd <$> readIORef (plotObj^.lastStableView)+                       newDia -> do+                           writeIORef (plotObj^.lastStableView) newDia+                           return $ snd <$> newDia                    case plt of                     Nothing -> return mempty                     Just Plot{..} -> let @@ -936,18 +963,18 @@                        fontPts = 12                        transform :: PlainGraphicsR2 -> PlainGraphicsR2                        transform = normaliseView . clr-                         where clr | Just c <- graphColor  = Dia.lcA c . Dia.fcA c-                                   | otherwise             = id+                         where clr | Just c <- plotObj^.plotObjColour+                                                = Dia.lcA c . Dia.fcA c+                                   | otherwise  = id                      in do-                       renderedAnnot <- mapM (prerenderAnnotation antTK) plotAnnotations-                       return . transform $ fold renderedAnnot <> getPlot+                       renderedAnnot <- mapM (prerenderAnnotation antTK) _plotAnnotations+                       return . transform $ fold renderedAnnot <> _getPlot -           gvStates <- readIORef graphs-           waitAny $ map (realtimeView . snd) gvStates-           -           thePlot <- (mconcat . reverse) <$> mapM renderComp (reverse gvStates)+           thePlot <- (mconcat . reverse) <$> mapM renderComp (reverse plotObjs)            theLegend <- prerenderLegend (textTK 10 1) colourScheme-                $ (\(p,g) -> (,) <$> legendEntries p <*> [graphColor g]) =<< gvStates+                $ (\g -> (,) <$> g^.originalPlotObject.legendEntries+                             <*> [g^.plotObjColour]+                  ) =<< plotObjs                                writeIORef dgStore $ ( theLegend & Dia.scaleX (0.1 / sqrt (fromIntegral xResolution))                                             & Dia.scaleY (0.1 / sqrt (fromIntegral yResolution)) @@ -962,7 +989,8 @@            writeIORef lastFrameTime t                do vt <- readIORef viewTgt-              updateRTView $ \vo -> +              modifyMVar_ viewTgtGlobal . const $ return vt+              modifyIORef viewState $ \vo ->                     let a%b = let η = min 1 $ 2 * realToFrac δt in η*a + (1-η)*b                     in GraphWindowSpecR2 (lBound vt % lBound vo) (rBound vt % rBound vo)                                         (bBound vt % bBound vo) (tBound vt % tBound vo)@@ -974,8 +1002,7 @@            return True        GTK.onDestroy window $ do-        (readIORef graphs >>=) . mapM_  -- cancel remaining threads-           $ \(_, GraphViewState{..}) -> cancel realtimeView >> cancel nextTgtView+        cancelWorkers         GTK.mainQuit                      @@ -987,9 +1014,28 @@    readIORef viewState  +++objectPlotterThread :: DynamicPlottable+                       -> MVar GraphWindowSpec+                       -> MVar (GraphWindowSpec, Plot)+                       -> IO ()+objectPlotterThread pl₀ viewVar diaVar = loop pl₀ where+ loop pl = do+    threadDelay $ 50 * milliseconds+    view <- readMVar viewVar+    diagram <- evaluate $ pl^.dynamicPlot $ view+    putMVar diaVar (view, diagram)+    case pl^.futurePlots of+       Just pl' -> loop pl'+       Nothing  -> loop pl+    +++ autoDefaultView :: [DynamicPlottable] -> GraphWindowSpec autoDefaultView graphs = GraphWindowSpecR2 l r b t defResX defResY defaultColourScheme-  where (xRange, yRange) = foldMap (relevantRange_x &&& relevantRange_y) graphs+  where (xRange, yRange) = foldMap (_relevantRange_x &&& _relevantRange_y) graphs         ((l,r), (b,t)) = ( xRange `dependentOn` yRange                          , yRange `dependentOn` xRange )         @@ -1028,7 +1074,6 @@   - -- | Plot an (assumed continuous) function in the usual way. --   Since this uses functions of actual 'Double' values, you have more liberty --   of defining functions with range-pattern-matching etc., which is at the moment@@ -1045,11 +1090,11 @@ --   the resolution so the plot is guaranteed accurate (but it's not usable yet for --   a lot of real applications). continFnPlot :: (Double -> Double) -> DynamicPlottable-continFnPlot f = def{-               relevantRange_y = otherDimDependence yRangef-             , isTintableMonochromic = True-             , axesNecessity = 1-             , dynamicPlot = plot }+continFnPlot f = def+             & relevantRange_y .~ otherDimDependence yRangef+             & autoTint+             & axesNecessity .~ 1+             & dynamicPlot .~ plot  where yRangef = onInterval $ \(l, r) -> ((!%0.1) &&& (!%0.9)) . sort . pruneOutlyers                                                $ map f [l, l + (r-l)/80 .. r]        plot (GraphWindowSpecR2{..}) = curve `deepseq` mkPlot (trace curve)@@ -1083,7 +1128,7 @@ --  --   This function is equivalent to using 'plot' on an 'RWDiffable' arrow. fnPlot :: (∀ m . ( WithField ℝ PseudoAffine m-                         , HasMetric (Needle (Interior m)) )+                 , SimpleSpace (Needle m) )                          => AgentVal (-->) m ℝ -> AgentVal (-->) m ℝ )                      -> DynamicPlottable fnPlot f = plot fd@@ -1092,7 +1137,7 @@  -- | Plot a continuous, “parametric function”, i.e. mapping the real line to a path in ℝ². paramPlot :: (∀ m . ( WithField ℝ PseudoAffine m-                         , HasMetric (Needle (Interior m)) )+                         , LSpace (Needle (Interior m)) )                        => AgentVal (-->) m ℝ -> (AgentVal (-->) m ℝ, AgentVal (-->) m ℝ) )                      -> DynamicPlottable paramPlot f = plot fd@@ -1100,17 +1145,16 @@        fd = alg1to2 f  scrutiniseDiffability :: (∀ m . ( WithField ℝ PseudoAffine m-                                , HasMetric (Needle (Interior m)) )+                                , SimpleSpace (Needle m) )                          => AgentVal (-->) m ℝ -> AgentVal (-->) m ℝ )                      -> DynamicPlottable scrutiniseDiffability f = plot [{-plot fd, -}dframe 0.2, dframe 0.02]  where fd :: ℝ --> ℝ        fd = alg f        fscrut = analyseLocalBehaviour fd-       dframe rfh = def{-                   isTintableMonochromic = True-                 , dynamicPlot = mkFrame-                 }+       dframe rfh = def+                 & autoTint+                 & dynamicPlot .~ mkFrame         where mkFrame (GraphWindowSpecR2{..}) = case fscrut xm of                       Option (Just ((ym,y'm), δOδx²))                         | Option (Just δx) <- δOδx² δy@@ -1131,10 +1175,10 @@                                    continColourSurfaceFnPlot :: ((Double,Double) -> DCol.Colour Double) -> DynamicPlottable-continColourSurfaceFnPlot f = def {-               axesNecessity = 1-             , occlusiveness = 4-             , dynamicPlot = plot }+continColourSurfaceFnPlot f = def+             & axesNecessity .~ 1+             & occlusiveness .~ 4+             & dynamicPlot .~ plot  where plot (GraphWindowSpecR2{..}) = mkPlot               $ Dia.place                 ( Dia.rasterDia cf (xResolution`div`4) (yResolution`div`4)@@ -1178,10 +1222,10 @@ -- | Coordinate axes with labels. For many plottable objects, these will be added --   automatically, by default (unless inhibited with 'noDynamicAxes'). dynamicAxes :: DynamicPlottable-dynamicAxes = def { -               axesNecessity = superfluent-             , occlusiveness = 1-             , dynamicPlot = plot }+dynamicAxes = def+             & axesNecessity .~ superfluent+             & occlusiveness .~ 1+             & dynamicPlot .~ plot  where plot gwSpec@(GraphWindowSpecR2{..}) = Plot labels lines         where (DynamicAxes yAxCls xAxCls) = crtDynamicAxes gwSpec               lines = zeroLine (lBound^&0) (rBound^&0)  `provided`(bBound<0 && tBound>0)@@ -1207,7 +1251,7 @@   noDynamicAxes :: DynamicPlottable-noDynamicAxes = def { axesNecessity = superfluent }+noDynamicAxes = def & axesNecessity .~ superfluent   @@ -1222,12 +1266,12 @@        & if w < 1 then Dia.dashingO [w*6, 3] 0 else id  -tweakDiagram :: (PlainGraphicsR2->PlainGraphicsR2) -> DynamicPlottable->DynamicPlottable-tweakDiagram f fig = fig { dynamicPlot = tweak . dynamicPlot fig }- where tweak pl = pl { getPlot = f $ getPlot pl }+tweakPrerendered :: (PlainGraphicsR2->PlainGraphicsR2) -> DynamicPlottable->DynamicPlottable+tweakPrerendered f = dynamicPlot %~ (tweak .)+ where tweak = getPlot %~ f  opacityFactor :: Double -> DynamicPlottable -> DynamicPlottable-opacityFactor = tweakDiagram . Dia.opacity+opacityFactor = tweakPrerendered . Dia.opacity   -- | When you &#x201c;plot&#x201d; 'xInterval' / 'yInterval', it is ensured that the (initial) view encompasses @@ -1245,10 +1289,10 @@  yInterval, forceYRange :: (Double, Double) -> DynamicPlottable -xInterval (l,r) = mempty { relevantRange_x = atLeastInterval $ Interval l r }-forceXRange (l,r) = mempty { relevantRange_x = MustBeThisRange $ Interval l r }-yInterval (b,t) = mempty { relevantRange_y = atLeastInterval $ Interval b t }-forceYRange (b,t) = mempty { relevantRange_y = MustBeThisRange $ Interval b t }+xInterval (l,r) = mempty & relevantRange_x .~ atLeastInterval (Interval l r)+forceXRange (l,r) = mempty & relevantRange_x .~ MustBeThisRange (Interval l r)+yInterval (b,t) = mempty & relevantRange_y .~ atLeastInterval (Interval b t)+forceYRange (b,t) = mempty & relevantRange_y .~ MustBeThisRange (Interval b t)    @@ -1268,54 +1312,54 @@ --   <<images/examples/sin-ctrd-tangents.gif>> newtype ViewXCenter = ViewXCenter { getViewXCenter :: Double } instance (Plottable p) => Plottable (ViewXCenter -> p) where-  plot f = def { relevantRange_y = OtherDimDependantRange $-                     \g -> deescalate relevantRange_y g . plot . f . cxI =<< g-               , isTintableMonochromic = isTintableMonochromic fcxVoid-               , axesNecessity = axesNecessity fcxVoid-               , dynamicPlot = \g -> dynamicPlot (plot . f $ cx g) g }+  plot f = def & relevantRange_y .~ OtherDimDependantRange+                     (\g -> deescalate relevantRange_y g . plot . f . cxI =<< g)+               & inherentColours .~ fcxVoid^.inherentColours+               & axesNecessity .~ fcxVoid^.axesNecessity+               & dynamicPlot .~ \g -> _dynamicPlot (plot . f $ cx g) g     where cx (GraphWindowSpecR2{..}) = ViewXCenter $ (lBound+rBound)/2           cxI (Interval l r) = ViewXCenter $ (l+r)/2           fcxVoid = plot . f $ ViewXCenter 0.23421  -- Yup, it's magic.-          deescalate rfind otherdim p = case rfind p of+          deescalate rfind otherdim p = case p^.rfind of              MustBeThisRange i -> pure i              OtherDimDependantRange ifr -> ifr otherdim newtype ViewYCenter = ViewYCenter { getViewYCenter :: Double } instance (Plottable p) => Plottable (ViewYCenter -> p) where-  plot f = def { relevantRange_x = OtherDimDependantRange $-                     \g -> deescalate relevantRange_x g . plot . f . cyI =<< g-               , isTintableMonochromic = isTintableMonochromic fcyVoid-               , axesNecessity = axesNecessity fcyVoid-               , dynamicPlot = \g -> dynamicPlot (plot . f $ cy g) g }+  plot f = def & relevantRange_x .~ OtherDimDependantRange+                     (\g -> deescalate relevantRange_x g . plot . f . cyI =<< g)+               & inherentColours .~ fcyVoid^.inherentColours+               & axesNecessity .~ fcyVoid^.axesNecessity+               & dynamicPlot .~ \g -> _dynamicPlot (plot . f $ cy g) g     where cy (GraphWindowSpecR2{..}) = ViewYCenter $ (bBound+tBound)/2           cyI (Interval b t) = ViewYCenter $ (b+t)/2           fcyVoid = plot . f $ ViewYCenter 0.319421  -- Alright, alright... the idea is to avoid exact equality with zero or any other number that might come up in some plot object, since such an equality can lead to div-by-zero problems.-          deescalate rfind otherdim p = case rfind p of+          deescalate rfind otherdim p = case p^.rfind of              MustBeThisRange i -> pure i              OtherDimDependantRange ifr -> ifr otherdim newtype ViewWidth = ViewWidth { getViewWidth :: Double } instance (Plottable p) => Plottable (ViewWidth -> p) where-  plot f = def { relevantRange_y = OtherDimDependantRange $-                     \g -> deescalate relevantRange_y g . plot . f . wI =<< g-               , isTintableMonochromic = isTintableMonochromic fwVoid-               , axesNecessity = axesNecessity fwVoid-               , dynamicPlot = \g -> dynamicPlot (plot . f $ w g) g }+  plot f = def & relevantRange_y .~ OtherDimDependantRange+                     (\g -> deescalate relevantRange_y g . plot . f . wI =<< g)+               & inherentColours .~ fwVoid^.inherentColours+               & axesNecessity .~ fwVoid^.axesNecessity+               & dynamicPlot .~ \g -> _dynamicPlot (plot . f $ w g) g     where w (GraphWindowSpecR2{..}) = ViewWidth $ rBound - lBound           wI (Interval l r) = ViewWidth $ r - l           fwVoid = plot . f $ ViewWidth 2.142349-          deescalate rfind otherdim p = case rfind p of+          deescalate rfind otherdim p = case p^.rfind of              MustBeThisRange i -> pure i              OtherDimDependantRange ifr -> ifr otherdim newtype ViewHeight = ViewHeight { getViewHeight :: Double } instance (Plottable p) => Plottable (ViewHeight -> p) where-  plot f = def { relevantRange_x = OtherDimDependantRange $-                     \g -> deescalate relevantRange_x g . plot . f . hI =<< g-               , isTintableMonochromic = isTintableMonochromic fhVoid-               , axesNecessity = axesNecessity fhVoid-               , dynamicPlot = \g -> dynamicPlot (plot . f $ h g) g }+  plot f = def & relevantRange_x .~ OtherDimDependantRange+                     (\g -> deescalate relevantRange_x g . plot . f . hI =<< g)+               & inherentColours .~ fhVoid^.inherentColours+               & axesNecessity .~ fhVoid^.axesNecessity+               & dynamicPlot .~ \g -> _dynamicPlot (plot . f $ h g) g     where h (GraphWindowSpecR2{..}) = ViewHeight $ tBound - bBound           hI (Interval b t) = ViewHeight $ t - b           fhVoid = plot . f $ ViewHeight 1.494213-          deescalate rfind otherdim p = case rfind p of+          deescalate rfind otherdim p = case p^.rfind of              MustBeThisRange i -> pure i              OtherDimDependantRange ifr -> ifr otherdim newtype ViewXResolution = ViewXResolution { getViewXResolution :: Int }@@ -1336,3 +1380,5 @@        (Just (llx,lux)) = Dia.extentX d₂; (Just (lly,luy)) = Dia.extentY d₂  ++milliseconds = 1000 :: Int

@@ -64,7 +64,6 @@ import Data.VectorSpace import Data.Basis import Data.AffineSpace-import Data.LinearMap.HerMetric import Data.Manifold.PseudoAffine import Data.Manifold.TreeCover import qualified Data.Map.Lazy as Map

@@ -1,5 +1,5 @@ Name:                dynamic-plot-Version:             0.1.4.0+Version:             0.2.0.0 Category:            graphics Synopsis:            Interactive diagram windows Description:         Haskell excels at handling data like continuous functions@@ -49,11 +49,11 @@                      , random                      , MonadRandom                      , time-                     , async                      , deepseq                      , process                      , constrained-categories >= 0.2                      , free-vector-spaces >= 0.1 && < 0.2+                     , linearmap-category                      , diagrams-core                      , diagrams-lib >= 1.3 && < 1.4                      , diagrams-cairo > 1.3.0.5 && < 1.4@@ -61,7 +61,8 @@                      , gtk > 0.10 && < 0.15                      , glib                      , colour >= 2 && < 3-                     , manifolds >= 0.2.3 && < 0.2.4+                     , manifolds >= 0.3 && < 0.4+                     , colour-space                      , lens < 4.15   Other-Extensions:  FlexibleInstances                      , TypeFamilies