diff --git a/Graphics/Dynamic/Plot/Internal/Types.hs b/Graphics/Dynamic/Plot/Internal/Types.hs --- a/Graphics/Dynamic/Plot/Internal/Types.hs +++ b/Graphics/Dynamic/Plot/Internal/Types.hs @@ -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 + ) diff --git a/Graphics/Dynamic/Plot/R2.hs b/Graphics/Dynamic/Plot/R2.hs --- a/Graphics/Dynamic/Plot/R2.hs +++ b/Graphics/Dynamic/Plot/R2.hs @@ -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? (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 +-- from the +-- library soon. +plotDelay :: NominalDiffTime -> DynamicPlottable -> DynamicPlottable +plotDelay dly = frameDelay .~ dly + >>> futurePlots %~ fmap (plotDelay dly) diff --git a/dynamic-plot.cabal b/dynamic-plot.cabal --- a/dynamic-plot.cabal +++ b/dynamic-plot.cabal @@ -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