dynamic-plot 0.2.0.0 → 0.2.1.0
raw patch · 3 files changed
+208/−66 lines, 3 filesdep +JuicyPixelsdep +manifold-randomdep +random-fudep −MonadRandomdep ~manifoldsPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: JuicyPixels, manifold-random, random-fu
Dependencies removed: MonadRandom
Dependency ranges changed: manifolds
API changes (from Hackage documentation)
- Graphics.Dynamic.Plot.R2: data DynamicPlottable
- Graphics.Dynamic.Plot.R2: instance Graphics.Dynamic.Plot.R2.Plottable (Data.Manifold.TreeCover.Shaded Data.Manifold.Types.Primitive.ℝ Data.Manifold.Types.Primitive.ℝ)
- Graphics.Dynamic.Plot.R2: instance Graphics.Dynamic.Plot.R2.Plottable (Data.Manifold.Web.PointsWeb Data.Manifold.Types.Primitive.ℝ (Data.Manifold.TreeCover.Shade' Data.Manifold.Types.Primitive.ℝ))
- Graphics.Dynamic.Plot.R2: instance Graphics.Dynamic.Plot.R2.Plottable (Data.Manifold.Web.PointsWeb Data.Manifold.Types.Primitive.ℝ² (Data.Colour.Internal.Colour Data.Manifold.Types.Primitive.ℝ))
+ Graphics.Dynamic.Plot.R2: instance Graphics.Dynamic.Plot.R2.Plottable (Data.Manifold.TreeCover.Shaded Math.Manifold.Core.Types.ℝ Math.Manifold.Core.Types.ℝ)
+ Graphics.Dynamic.Plot.R2: instance Graphics.Dynamic.Plot.R2.Plottable (Data.Manifold.Web.ConvexSet Data.Manifold.Types.Primitive.ℝ²)
+ Graphics.Dynamic.Plot.R2: instance Graphics.Dynamic.Plot.R2.Plottable (Data.Manifold.Web.PointsWeb (Math.Manifold.Core.Types.ℝ, Math.Manifold.Core.Types.ℝ) (Data.Colour.Internal.Colour Math.Manifold.Core.Types.ℝ))
+ Graphics.Dynamic.Plot.R2: instance Graphics.Dynamic.Plot.R2.Plottable (Data.Manifold.Web.PointsWeb (Math.Manifold.Core.Types.ℝ, Math.Manifold.Core.Types.ℝ) (Data.Manifold.TreeCover.Shade (Data.Colour.Internal.Colour Math.Manifold.Core.Types.ℝ)))
+ Graphics.Dynamic.Plot.R2: instance Graphics.Dynamic.Plot.R2.Plottable (Data.Manifold.Web.PointsWeb Data.Manifold.Types.Primitive.ℝ² (Data.Colour.Internal.Colour Math.Manifold.Core.Types.ℝ))
+ Graphics.Dynamic.Plot.R2: instance Graphics.Dynamic.Plot.R2.Plottable (Data.Manifold.Web.PointsWeb Data.Manifold.Types.Primitive.ℝ² (Data.Manifold.TreeCover.Shade (Data.Colour.Internal.Colour Math.Manifold.Core.Types.ℝ)))
+ Graphics.Dynamic.Plot.R2: instance Graphics.Dynamic.Plot.R2.Plottable (Data.Manifold.Web.PointsWeb Math.Manifold.Core.Types.ℝ (Data.Manifold.TreeCover.Shade' Math.Manifold.Core.Types.ℝ))
+ Graphics.Dynamic.Plot.R2: instance Graphics.Dynamic.Plot.R2.Plottable p => Graphics.Dynamic.Plot.R2.Plottable (Data.Semigroup.Option p)
+ Graphics.Dynamic.Plot.R2: instance Graphics.Dynamic.Plot.R2.Plottable p => Graphics.Dynamic.Plot.R2.Plottable (GHC.Base.Maybe p)
+ Graphics.Dynamic.Plot.R2: plotDelay :: NominalDiffTime -> DynamicPlottable -> DynamicPlottable
+ Graphics.Dynamic.Plot.R2: type DynamicPlottable = DynamicPlottable' RVar
- Graphics.Dynamic.Plot.R2: paramPlot :: (forall m. (WithField ℝ PseudoAffine m, LSpace (Needle (Interior m))) => AgentVal (-->) m ℝ -> (AgentVal (-->) m ℝ, AgentVal (-->) m ℝ)) -> DynamicPlottable
+ Graphics.Dynamic.Plot.R2: paramPlot :: (forall m. (WithField ℝ PseudoAffine m, SimpleSpace (Needle m)) => AgentVal (-->) m ℝ -> (AgentVal (-->) m ℝ, AgentVal (-->) m ℝ)) -> DynamicPlottable
Files
- Graphics/Dynamic/Plot/Internal/Types.hs +19/−0
- Graphics/Dynamic/Plot/R2.hs +184/−62
- dynamic-plot.cabal +5/−4
Graphics/Dynamic/Plot/Internal/Types.hs view
@@ -365,6 +365,25 @@ \xResolution="++show xResolution++", \ \yResolution="++show yResolution++"}" +windowCenter :: Lens' GraphWindowSpecR2 (R,R)+windowCenter = lens+ (\(GraphWindowSpecR2 l r b t _ _ _) -> ((l+r)/2, (b+t)/2))+ (\(GraphWindowSpecR2 l r b t xRes yRes colSch) (cx, cy)+ -> let rx = (r-l)/2; ry = (t-b)/2+ in GraphWindowSpecR2 (cx - rx) (cx + rx) (cy - ry) (cy + ry)+ xRes yRes colSch+ )+windowDiameter :: Lens' GraphWindowSpecR2 R+windowDiameter = lens+ (\(GraphWindowSpecR2 l r b t _ _ _) -> sqrt $ (r-l)^2 + (t-b)^2)+ (\(GraphWindowSpecR2 l r b t xRes yRes colSch) dNew+ -> let cx = (l+r)/2; rx = (r-l)/2+ cy = (b+t)/2; ry = (t-b)/2+ dOld = 2 * sqrt (rx^2 + ry^2)+ η = dNew / dOld+ in GraphWindowSpecR2 (cx - η*rx) (cx + η*rx) (cy - η*ry) (cy + η*ry)+ xRes yRes colSch+ )
Graphics/Dynamic/Plot/R2.hs view
@@ -50,6 +50,8 @@ , tint, autoTint -- ** Legend captions , legendName+ -- ** Animation+ , plotDelay -- * Viewport -- ** View selection , xInterval, yInterval, forceXRange, forceYRange@@ -81,6 +83,9 @@ import qualified Diagrams.Backend.Cairo.Text as CairoTxt import qualified Data.Colour as DCol+import qualified Data.Colour.Names as DCol+import qualified Codec.Picture as JPix+import qualified Codec.Picture.Types as JPix import qualified Diagrams.Backend.Gtk as BGTK import qualified Graphics.UI.Gtk as GTK@@ -88,7 +93,9 @@ import qualified Graphics.UI.Gtk.Gdk.EventM as Event import qualified System.Glib.Signals (on) -import Control.Monad.Trans (liftIO)+import Control.Monad.Trans (liftIO, lift)+import Control.Monad.ST+import Data.STRef import qualified Control.Category.Hask as Hask import Control.Category.Constrained.Prelude hiding ((^))@@ -126,13 +133,14 @@ import Data.Manifold.Types import Data.Manifold.TreeCover import Data.Manifold.Web+import Data.Manifold.Riemannian (Geodesic) import qualified Data.Map.Lazy as Map import qualified Data.Colour.Manifold as CSp -import Data.Tagged--import Text.Printf+import qualified Data.Random as Random+import qualified System.Random as Random+import qualified Data.Random.Manifold import Data.IORef @@ -151,12 +159,12 @@ data RangeRequest r - = OtherDimDependantRange (Option (Interval r) -> Option (Interval r))+ = OtherDimDependantRange (Maybe (Interval r) -> Maybe (Interval r)) | MustBeThisRange (Interval r) type GraphWindowSpec = GraphWindowSpecR2 -data DynamicPlottable = DynamicPlottable { +data DynamicPlottable' m = DynamicPlottable { _relevantRange_x, _relevantRange_y :: RangeRequest R , _inherentColours :: [DCol.Colour ℝ] , _occlusiveness :: Double@@ -165,16 +173,20 @@ -- other objects, negative values for sparse/small point plots. -- The z-order will be chosen accordingly. , _axesNecessity :: Necessity+ , _frameDelay :: NominalDiffTime , _legendEntries :: [LegendEntry]- , _futurePlots :: Maybe DynamicPlottable- , _dynamicPlot :: GraphWindowSpec -> Plot+ , _futurePlots :: Maybe (DynamicPlottable' m)+ , _dynamicPlot :: GraphWindowSpec -> m Plot }-makeLenses ''DynamicPlottable+makeLenses ''DynamicPlottable' +type DynamicPlottable = DynamicPlottable' Random.RVar +type AnnotPlot = (Plot, [LegendEntry])+ data ObjInPlot = ObjInPlot {- _lastStableView :: IORef (Maybe (GraphWindowSpec, Plot))- , _newPlotView :: MVar (GraphWindowSpec, Plot)+ _lastStableView :: IORef (Maybe (GraphWindowSpec, AnnotPlot))+ , _newPlotView :: MVar (GraphWindowSpec, AnnotPlot) , _plotObjColour :: Maybe AColour , _originalPlotObject :: DynamicPlottable }@@ -205,13 +217,18 @@ instance (Plottable p) => Plottable [p] where plot = foldMap plot+instance (Plottable p) => Plottable (Option p) where+ plot = foldMap plot+instance (Plottable p) => Plottable (Maybe p) where+ plot = foldMap plot instance Plottable PlainGraphics where plot (PlainGraphics d) = def & relevantRange_x .~ atLeastInterval rlx & relevantRange_y .~ atLeastInterval rly+ & inherentColours .~ [DCol.grey] & axesNecessity .~ -1- & dynamicPlot .~ plot+ & dynamicPlot .~ pure.plot where bb = DiaBB.boundingBox d (rlx,rly) = case DiaBB.getCorners bb of Just (c1, c2)@@ -235,21 +252,22 @@ diagramPlot d = plot $ PlainGraphics d -metricFromLength :: RealFrac' s => s -> Norm s -metricFromLength l | l>0 = spanNorm [1 / l]+metricFromLength :: ∀ s . RealFrac' s => s -> Norm s +metricFromLength l | l>0 = case closedScalarWitness :: ClosedScalarWitness s of+ ClosedScalarWitness -> spanNorm [1 / l] instance Plottable (R-->R) where plot f = def & relevantRange_y .~ OtherDimDependantRange yRangef & autoTint & axesNecessity .~ 1- & dynamicPlot .~ plot- where yRangef (Option Nothing) = Option Nothing- yRangef (Option (Just (Interval l r)))+ & dynamicPlot .~ pure.plot+ where yRangef Nothing = Nothing+ yRangef (Just (Interval l r)) = case intervalImages 100 ( const . metricFromLength $ (r-l)/16 , const $ metricFromLength 0.0001 ) ( alg (\x -> ( point l?<x?<point r ?-> (f$~x) ))) of - ([],[]) -> Option Nothing+ ([],[]) -> Nothing (liv,riv) -> pure . foldr1 (<>) . map (uncurry Interval . snd) $ take 4 liv ++ take 4 riv @@ -275,7 +293,7 @@ plot f = def & relevantRange_y .~ mempty & autoTint & axesNecessity .~ 1- & dynamicPlot .~ plot+ & dynamicPlot .~ pure.plot where plot gs@(GraphWindowSpecR2{..}) = curves `deepseq` mkPlot (foldMap trace curves) where curves :: [[P2]]@@ -320,7 +338,8 @@ & dynamicPlot .~ plot where xr = wsp * fromIntegral gSplN- plot (GraphWindowSpecR2{..}) = mkPlot . trace $ flattenPCM_resoCut bb δx rPCM+ plot (GraphWindowSpecR2{..}) = pure . mkPlot . trace+ $ flattenPCM_resoCut bb δx rPCM where trace dPath = fold [ trMBound [ p & _y +~ s*δ | (p, DevBoxes _ δ) <- dPath ]@@ -357,7 +376,7 @@ & autoTint & axesNecessity .~ 1 & dynamicPlot .~ plot- where plot (GraphWindowSpecR2{..}) = mkPlot+ where plot (GraphWindowSpecR2{..}) = pure . mkPlot . foldMap trStRange $ flattenPCM_P2_resoCut bbView [(1/δxl)^&0, 0^&(1/δyl)] rPCM where trStRange (Left appr) = trSR $ map calcNormDev appr@@ -415,12 +434,12 @@ | null ps = mempty & autoTint | otherwise = def & relevantRange_x .~ atLeastInterval'- ( foldMap (pure . spInterval . fst) (concat ps) )+ ( getOption $ foldMap (pure . spInterval . fst) (concat ps) ) & relevantRange_y .~ atLeastInterval'- ( foldMap (pure . spInterval . snd) (concat ps) )+ ( getOption $ foldMap (pure . spInterval . snd) (concat ps) ) & autoTint & axesNecessity .~ 1- & dynamicPlot .~ plot+ & dynamicPlot .~ pure . 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@@ -493,7 +512,7 @@ & autoTint & axesNecessity .~ 1 & dynamicPlot .~ plot- where plot _ = mkPlot $ foldMap axLine eigVs + where plot _ = pure . mkPlot $ foldMap axLine eigVs where axLine eigV = simpleLine (ctr .-~^ eigV) (ctr .+~^ eigV) (xRange,yRange) = shadeExtends shade ctr = shade^.shadeCtr@@ -510,17 +529,27 @@ & autoTint & axesNecessity .~ 1 & dynamicPlot .~ plot- where plot _ = mkPlot $ Dia.circle 1+ where plot wSpec = pure . mkPlot $ Dia.circle 1 & Dia.scaleX w₁ & Dia.scaleY w₂ & Dia.rotate ϑ & Dia.opacity 0.2 & Dia.moveTo ctr+ where [w₁,w₂] = recip . sqrt+ . max (recip $ 100 * max ((wSpec^.windowDiameter)^2) ctrDistance)+ . fst <$> [ev₁, ev₂]+ ctrDistance = distanceSq (shade^.shadeCtr) (wSpec^.windowCenter) ctr = Dia.p2 $ shade^.shadeCtr Norm expanr = shade^.shadeNarrowness- [ev₁@(_,(e₁x,e₁y)),ev₂] = eigen $ arr expanr+ [ev₁@(_,(e₁x,e₁y)),ev₂] = case eigen $ arr expanr of+ (e₁:e₂:_) -> [e₁,e₂]+ [e@(_,(vx,vy))] -> [e, (0,(-vx,vy))]+ [] -> [(0,(1,0)), (0,(0,1))] ϑ = atan2 e₁y e₁x Dia.@@ Dia.rad- [w₁,w₂] = recip . sqrt . fst <$> [ev₁, ev₂] +instance Plottable (ConvexSet ℝ²) where+ plot EmptyConvex = mempty+ plot (ConvexSet hull intersects)+ = plot (ConvexSet (coerceShade hull) (coerceShade<$>intersects) :: ConvexSet (ℝ,ℝ)) instance Plottable (ConvexSet (R,R)) where plot EmptyConvex = mempty plot (ConvexSet hull intersects)@@ -546,7 +575,7 @@ & autoTint & axesNecessity .~ 1 & dynamicPlot .~ plot- where plot grWS@(GraphWindowSpecR2{..}) = mkPlot $+ where plot grWS@(GraphWindowSpecR2{..}) = pure . mkPlot $ foldMap parallelogram trivs <> (foldMap (singlePointFor grWS) leafPoints -- & Dia.dashingO [2,3] 0@@ -581,7 +610,7 @@ & relevantRange_y .~ atLeastInterval (Interval ymin ymax) & autoTint & axesNecessity .~ 1- & dynamicPlot .~ plot+ & dynamicPlot .~ pure . plot where plot grWS@(GraphWindowSpecR2{..}) = mkPlot $ foldMap parallelogram trivs <> foldMap vbar divis@@ -636,8 +665,75 @@ plot _ = def instance Plottable (PointsWeb ℝ² (CSp.Colour ℝ)) where+ plot web = plot (coerceWebDomain web :: PointsWeb (ℝ,ℝ) (CSp.Colour ℝ)) +instance Plottable (PointsWeb (ℝ,ℝ) (CSp.Colour ℝ)) where+ plot = webbedSurfPlot $ pure . toRGBA+ where toRGBA (Just c)+ = JPix.promotePixel (CSp.quantiseColour c :: JPix.PixelRGB8)+ toRGBA _ = JPix.PixelRGBA8 0 0 0 0 +instance Plottable (PointsWeb ℝ² (Shade (CSp.Colour ℝ))) where+ plot web = plot (coerceWebDomain web :: PointsWeb (ℝ,ℝ) (Shade (CSp.Colour ℝ)))++instance Plottable (PointsWeb (ℝ,ℝ) (Shade (CSp.Colour ℝ))) where+ plot = webbedSurfPlot $ toRGBA+ where toRGBA (Just c)+ = JPix.promotePixel . (CSp.quantiseColour :: CSp.Colour ℝ -> JPix.PixelRGB8)+ <$> Random.rvar c+ toRGBA _ = return $ JPix.PixelRGBA8 0 0 0 0++webbedSurfPlot :: Geodesic a+ => (Maybe a -> Random.RVar JPix.PixelRGBA8)+ -> PointsWeb (ℝ,ℝ) a -> DynamicPlottable+webbedSurfPlot toRGBA web = def & dynamicPlot .~ plotWeb+ & relevantRange_x .~ atLeastInterval (x₀...x₁)+ & relevantRange_y .~ atLeastInterval (y₀...y₁)+ & occlusiveness .~ 4+ where plotWeb graSpec = do+ pixRendered <- pixRender+ pure . mkPlot $ + (Dia.image $ Dia.DImage+ (Dia.ImageRaster $ JPix.ImageRGBA8 pixRendered)+ renderWidth renderHeight+ placement)+ cartesianed = sampleEntireWeb_2Dcartesian_lin web renderWidth renderHeight+ renderWidth = 120 -- xResolution graSpec+ renderHeight = 90 -- yResolution graSpec+ x₀ = minimum (fst<$>pts)+ x₁ = maximum (fst<$>pts)+ y₀ = minimum (snd<$>pts)+ y₁ = maximum (snd<$>pts)+ pts = fst . fst <$> Hask.toList (localFocusWeb web)+ xc = (x₀+x₁)/2+ yc = (y₀+y₁)/2+ wPix = (x₁ - x₀)/renderWidth+ hPix = (y₁ - y₀)/renderHeight+ placement = Dia.translation (xc^&yc) <> Dia.scalingX wPix <> Dia.scalingY hPix+ pixRender = do+ seed <- Random.mkStdGen <$> Random.stdUniform+ return $ runST (do+ randomGen <- newSTRef seed+ cursorState <- newSTRef (0, reverse cartesianed)+ JPix.withImage renderWidth renderHeight $ \_ix iy -> do+ (iyPrev, (y, xvs) : yvs) <- readSTRef cursorState+ vc <- if iy > iyPrev+ then case yvs of+ ((y',(_x,vc):xvs') : yvs') -> do+ writeSTRef cursorState (iy, (y', xvs') : yvs')+ return vc+ else case xvs of+ ((_x,vc) : xvs') -> do+ writeSTRef cursorState (iy, (y, xvs') : yvs)+ return vc+ rg <- readSTRef randomGen+ let (c, rg') = Random.sampleState (toRGBA vc) rg+ writeSTRef randomGen rg'+ return c+ )+ ++ instance (Plottable x) => Plottable (Latest x) where plot (Latest (ev₀ :| [])) = plot ev₀ plot (Latest (ev₀ :| ev₁:evs))@@ -658,7 +754,7 @@ & autoTint & axesNecessity .~ 1 & dynamicPlot .~ plot- where plot _ = mkPlot $ go 4 ctr (treeBranches root)+ where plot _ = pure . mkPlot $ go 4 ctr (treeBranches root) where go w bctr = foldMap (\(c,GenericTree b) -> autoDashLine w bctr c <> go (w*0.6) c b )@@ -728,13 +824,22 @@ mkAnnotatedPlot ans = Plot ans instance Semigroup DynamicPlottable where- DynamicPlottable rx₁ ry₁ tm₁ oc₁ ax₁ le₁ fu₁ dp₁- <> DynamicPlottable rx₂ ry₂ tm₂ oc₂ ax₂ le₂ fu₂ dp₂+ DynamicPlottable rx₁ ry₁ tm₁ oc₁ ax₁ dl₁ le₁ fu₁ dp₁+ <> DynamicPlottable rx₂ ry₂ tm₂ oc₂ ax₂ dl₂ le₂ fu₂ dp₂ = DynamicPlottable- (rx₁<>rx₂) (ry₁<>ry₂) (tm₁++tm₂) (oc₁+oc₂) (ax₁+ax₂)- (le₁++le₂) ((<>)<$>fu₁<*>fu₂) (dp₁<>dp₂) + (rx₁<>rx₂) (ry₁<>ry₂) (tm₁++tm₂) (oc₁+oc₂) (ax₁+ax₂) (max dl₁ dl₂)+ (le₁++le₂) ((<>)<$>fu₁<*>fu₂) (liftA2(<>)<$>dp₁<*>dp₂) instance Monoid DynamicPlottable where- mempty = DynamicPlottable mempty mempty [] 0 0 [] mempty mempty+ mempty = DynamicPlottable+ mempty -- don't request any range+ mempty+ [] -- no colours+ 0 -- neither obscures anything nor has details that could be obscured+ 0 -- don't need axis (but don't mind them either)+ (1/20) -- 20 fps is at the moment the fastest enabled refresh rate anyway+ [] -- no legend entries+ mempty -- no time-evolution+ (const $ pure mempty) mappend = (<>) instance Default DynamicPlottable where def = mempty @@ -744,11 +849,12 @@ -- plot legend. legendName :: String -> DynamicPlottable -> DynamicPlottable legendName n = legendEntries %~ (LegendEntry (PlainText n) mempty :)+ >>> futurePlots %~ fmap (legendName n) -- | 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)+ >>> dynamicPlot %~ fmap (fmap $ getPlot %~ Dia.lc col . Dia.fc col) -- | Allow the object to be automatically assigned a colour that's otherwise -- unused in the plot. (This is the default for most plot objects.)@@ -761,7 +867,7 @@ _ <> MustBeThisRange r = MustBeThisRange r OtherDimDependantRange r1 <> OtherDimDependantRange r2 = OtherDimDependantRange $ r1<>r2 instance (Ord r) => Monoid (RangeRequest r) where- mempty = OtherDimDependantRange $ const mempty+ mempty = OtherDimDependantRange $ const Nothing mappend = (<>) otherDimDependence :: (Interval r->Interval r) -> RangeRequest r@@ -770,7 +876,7 @@ atLeastInterval :: Interval r -> RangeRequest r atLeastInterval = atLeastInterval' . pure -atLeastInterval' :: Option (Interval r) -> RangeRequest r+atLeastInterval' :: Maybe (Interval r) -> RangeRequest r atLeastInterval' = OtherDimDependantRange . const @@ -954,7 +1060,7 @@ return $ snd <$> newDia case plt of Nothing -> return mempty- Just Plot{..} -> let + Just (Plot{..}, objLegend) -> let antTK = DiagramTK { viewScope = currentView , textTools = textTK txtSize aspect } txtSize = h * fontPts / fromIntegral yResolution@@ -968,13 +1074,14 @@ | otherwise = id in do renderedAnnot <- mapM (prerenderAnnotation antTK) _plotAnnotations- return . transform $ fold renderedAnnot <> _getPlot+ return (transform $ fold renderedAnnot <> _getPlot, objLegend) - thePlot <- (mconcat . reverse) <$> mapM renderComp (reverse plotObjs)+ (thisPlots, thisLegends)+ <- unzip . reverse <$> mapM renderComp (reverse plotObjs)+ let thePlot = mconcat thisPlots theLegend <- prerenderLegend (textTK 10 1) colourScheme- $ (\g -> (,) <$> g^.originalPlotObject.legendEntries- <*> [g^.plotObjColour]- ) =<< plotObjs+ $ (\(g,l) -> (,) <$> l <*> [g^.plotObjColour]+ ) =<< zip plotObjs thisLegends writeIORef dgStore $ ( theLegend & Dia.scaleX (0.1 / sqrt (fromIntegral xResolution)) & Dia.scaleY (0.1 / sqrt (fromIntegral yResolution)) @@ -1006,7 +1113,7 @@ GTK.mainQuit - GTK.timeoutAdd mainLoop 100+ GTK.timeoutAdd mainLoop 50 GTK.mainGUI@@ -1018,14 +1125,15 @@ objectPlotterThread :: DynamicPlottable -> MVar GraphWindowSpec- -> MVar (GraphWindowSpec, Plot)+ -> MVar (GraphWindowSpec, (Plot, [LegendEntry])) -> IO () objectPlotterThread pl₀ viewVar diaVar = loop pl₀ where loop pl = do- threadDelay $ 50 * milliseconds+ tPrev <- getCurrentTime view <- readMVar viewVar- diagram <- evaluate $ pl^.dynamicPlot $ view- putMVar diaVar (view, diagram)+ diagram <- evaluate =<< Random.runRVar (pl^.dynamicPlot $ view) Random.StdRandom+ putMVar diaVar (view, (diagram, pl^.legendEntries))+ waitTill $ addUTCTime (pl^.frameDelay) tPrev case pl^.futurePlots of Just pl' -> loop pl' Nothing -> loop pl@@ -1044,9 +1152,9 @@ OtherDimDependantRange ξ `dependentOn` MustBeThisRange i = addMargin . defRng . ξ $ pure i OtherDimDependantRange ξ `dependentOn` OtherDimDependantRange υ- = addMargin . defRng . ξ . pure . defRng $ υ mempty+ = addMargin . defRng . ξ . pure . defRng $ υ Nothing - defRng (Option (Just (Interval a b))) | b>a + defRng (Just (Interval a b)) | b>a = Interval a b defRng _ = Interval (-1) 1 -- ad-hoc hack to catch NaNs etc.. addMargin (Interval a b) = (a - q, b + q)@@ -1094,7 +1202,7 @@ & relevantRange_y .~ otherDimDependence yRangef & autoTint & axesNecessity .~ 1- & dynamicPlot .~ plot+ & dynamicPlot .~ pure . 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)@@ -1136,14 +1244,14 @@ fd = alg f -- | Plot a continuous, “parametric function”, i.e. mapping the real line to a path in ℝ².-paramPlot :: (∀ m . ( WithField ℝ PseudoAffine m- , LSpace (Needle (Interior m)) )+paramPlot :: (∀ m . ( WithField ℝ PseudoAffine m, SimpleSpace (Needle m) ) => AgentVal (-->) m ℝ -> (AgentVal (-->) m ℝ, AgentVal (-->) m ℝ) ) -> DynamicPlottable paramPlot f = plot fd where fd :: ℝ --> (ℝ,ℝ) fd = alg1to2 f + scrutiniseDiffability :: (∀ m . ( WithField ℝ PseudoAffine m , SimpleSpace (Needle m) ) => AgentVal (-->) m ℝ -> AgentVal (-->) m ℝ )@@ -1154,10 +1262,10 @@ fscrut = analyseLocalBehaviour fd dframe rfh = def & autoTint- & dynamicPlot .~ mkFrame+ & dynamicPlot .~ pure . mkFrame where mkFrame (GraphWindowSpecR2{..}) = case fscrut xm of- Option (Just ((ym,y'm), δOδx²))- | Option (Just δx) <- δOδx² δy+ Just ((ym,y'm), δOδx²)+ | Just δx <- δOδx² δy -> δx `seq` let frame = mconcat [ simpleLine ((xm-δx)^&(ym+yo-δx*y'm)) ((xm+δx)^&(ym+yo+δx*y'm))@@ -1179,7 +1287,7 @@ & axesNecessity .~ 1 & occlusiveness .~ 4 & dynamicPlot .~ plot- where plot (GraphWindowSpecR2{..}) = mkPlot+ where plot (GraphWindowSpecR2{..}) = pure . mkPlot $ Dia.place ( Dia.rasterDia cf (xResolution`div`4) (yResolution`div`4) & Dia.scaleX wPix & Dia.scaleY hPix@@ -1225,7 +1333,7 @@ dynamicAxes = def & axesNecessity .~ superfluent & occlusiveness .~ 1- & dynamicPlot .~ plot+ & dynamicPlot .~ pure . 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)@@ -1267,7 +1375,7 @@ tweakPrerendered :: (PlainGraphicsR2->PlainGraphicsR2) -> DynamicPlottable->DynamicPlottable-tweakPrerendered f = dynamicPlot %~ (tweak .)+tweakPrerendered f = dynamicPlot %~ (fmap tweak .) where tweak = getPlot %~ f opacityFactor :: Double -> DynamicPlottable -> DynamicPlottable@@ -1381,4 +1489,18 @@ -milliseconds = 1000 :: Int+waitTill :: UTCTime -> IO ()+waitTill t = do+ tnow <- getCurrentTime+ threadDelay . max 1000 . round $ diffUTCTime t tnow+ * 1e+6 -- threadDelay ticks in microseconds++-- | Limit the refresh / frame rate for this plot object. Useful to slowly+-- study some sequence of plots with 'plotLatest', or to just reduce processor load.+-- +-- Note: the argument will probably change to+-- <http://hackage.haskell.org/package/thyme-0.3.5.5/docs/Data-Thyme-Clock.html#t:NominalDiffTime NominalDiffTime> from the <http://hackage.haskell.org/package/thyme thyme>+-- library soon.+plotDelay :: NominalDiffTime -> DynamicPlottable -> DynamicPlottable+plotDelay dly = frameDelay .~ dly+ >>> futurePlots %~ fmap (plotDelay dly)
dynamic-plot.cabal view
@@ -1,5 +1,5 @@ Name: dynamic-plot-Version: 0.2.0.0+Version: 0.2.1.0 Category: graphics Synopsis: Interactive diagram windows Description: Haskell excels at handling data like continuous functions@@ -46,8 +46,7 @@ , containers , semigroups , data-default- , random- , MonadRandom+ , random, random-fu , time , deepseq , process@@ -61,8 +60,10 @@ , gtk > 0.10 && < 0.15 , glib , colour >= 2 && < 3- , manifolds >= 0.3 && < 0.4+ , manifolds >= 0.3.1 && < 0.4+ , manifold-random , colour-space+ , JuicyPixels > 3 && < 4 , lens < 4.15 Other-Extensions: FlexibleInstances , TypeFamilies