dynamic-plot 0.1.1.0 → 0.1.1.1
raw patch · 3 files changed
+240/−107 lines, 3 filesdep +data-defaultdep ~lensdep ~manifolds
Dependencies added: data-default
Dependency ranges changed: lens, manifolds
Files
- Graphics/Dynamic/Plot/R2.hs +187/−97
- Graphics/Text/Annotation.hs +49/−7
- dynamic-plot.cabal +4/−3
Graphics/Dynamic/Plot/R2.hs view
@@ -15,6 +15,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnicodeSyntax #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LiberalTypeSynonyms #-} {-# LANGUAGE FlexibleContexts #-}@@ -41,6 +42,8 @@ , PlainGraphicsR2 , shapePlot , diagramPlot+ -- ** Legend captions+ , legendName -- ** View selection , xInterval, yInterval, forceXRange, forceYRange -- ** View dependance@@ -93,18 +96,21 @@ import Control.DeepSeq -import Data.List (foldl', sort, intercalate, isPrefixOf, isInfixOf, find, zip4)+import Data.List (foldl', sort, sortBy, intercalate, isPrefixOf, isInfixOf, find, zip4) import qualified Data.Vector as Arr import Data.Maybe import Data.Semigroup+import Data.Default import Data.Foldable (fold, foldMap) import Data.Function (on)+import Data.Ord (comparing) import Data.VectorSpace import Data.Basis import Data.AffineSpace import Data.LinearMap.HerMetric import Data.Manifold.PseudoAffine+import Data.Manifold.Types import Data.Manifold.TreeCover import qualified Data.Map.Lazy as Map @@ -147,12 +153,10 @@ -- {-# RULES "plot/R->R" plot = fnPlot #-} instance Plottable (Double :--> Double) where- plot f = DynamicPlottable{- relevantRange_x = mempty- , relevantRange_y = otherDimDependence yRangef- , isTintableMonochromic = True- , axesNecessity = 1- , dynamicPlot = plot }+ plot f = def { relevantRange_y = otherDimDependence yRangef+ , isTintableMonochromic = True+ , axesNecessity = 1+ , dynamicPlot = plot } where yRangef (Interval l r) = uncurry Interval . (minimum &&& maximum) . map snd $ 𝓒⁰.finiteGraphContinℝtoℝ (𝓒⁰.GraphWindowSpec l r fgb fgt 9 9) f@@ -171,12 +175,9 @@ c = realToFrac instance Plottable (Double :--> (Double, Double)) where- plot f = DynamicPlottable{- relevantRange_x = mempty- , relevantRange_y = mempty- , isTintableMonochromic = True- , axesNecessity = 1- , dynamicPlot = plot }+ plot f = def { isTintableMonochromic = True+ , axesNecessity = 1+ , dynamicPlot = plot } where plot (GraphWindowSpecR2{..}) = curves `deepseq` mkPlot (foldMap trace curves) where curves :: [[P2]] curves = map (map convℝ²) $ 𝓒⁰.finiteGraphContinℝtoℝ² mWindow f@@ -190,20 +191,12 @@ instance (Plottable p) => Plottable [p] where- plot l0 = DynamicPlottable{- relevantRange_x = foldMap relevantRange_x l- , relevantRange_y = foldMap relevantRange_y l- , isTintableMonochromic = or $ isTintableMonochromic <$> l- , axesNecessity = sum $ axesNecessity <$> l- , dynamicPlot = foldMap dynamicPlot l- }- where l = map plot l0+ plot = foldMap plot instance Plottable PlainGraphics where- plot (PlainGraphics d) = DynamicPlottable{+ plot (PlainGraphics d) = def { relevantRange_x = atLeastInterval rlx , relevantRange_y = atLeastInterval rly- , isTintableMonochromic = False , axesNecessity = -1 , dynamicPlot = plot }@@ -229,11 +222,46 @@ +instance Plottable (R-->R) where+ plot f = def { relevantRange_y = mempty -- otherDimDependence yRangef+ , isTintableMonochromic = True+ , axesNecessity = 1+ , dynamicPlot = plot }+ where yRangef (Interval l r) = undefined+ plot gs@(GraphWindowSpecR2{..}) = curves `deepseq`+ mkPlot (foldMap trace curves)+ where curves :: [[P2]]+ curves = map (map $ convℝ² . snd)+ $ discretisePathSegs xResolution (resolutionFunction gs)+ (id&&&f <<< alg(+point x₀))+ x₀ = (lBound + rBound)/2+ trace (p:q:ps) = simpleLine p q <> trace (q:ps)+ trace _ = mempty+ + convℝ² = Dia.p2+ c = realToFrac +resolutionFunction :: GraphWindowSpecR2 -> RieMetric ℝ²+resolutionFunction GraphWindowSpecR2{..} = resoFunc+ where x₀ = (lBound + rBound)/2+ w = rBound - lBound; h = tBound - bBound+ ε = projector (recip δx, 0) + projector (0, recip δy)+ δx = w / fromIntegral xResolution+ δy = h / fromIntegral yResolution+ resoFunc (x,y)+ | x > lBound, x < rBound, y > bBound, y < tBound = ε+ | otherwise = projector (qx,0) + projector (0,qy)+ where qx | x < lBound = lBound - x+ | x > rBound = x - rBound+ | otherwise = δx * qy/δy+ qy | y < bBound = bBound - y+ | y > tBound = y - tBound+ | otherwise = δy * qx/δx + instance Plottable (R-.^>R) where plot rPCM@(RecursivePCM gPFit gDetails gFitDevs (PCMRange x₀ wsp) gSplN ())- = DynamicPlottable{+ = def { relevantRange_x = atLeastInterval $ Interval x₀ xr , relevantRange_y = otherDimDependence $ rPCMLinFitRange rPCM , isTintableMonochromic = True@@ -273,7 +301,7 @@ instance Plottable (RecursiveSamples Int P2 (DevBoxes P2)) where plot rPCM@(RecursivePCM gPFit gDetails gFitDevs (PCMRange t₀ τsp) gSplN ())- = DynamicPlottable{+ = def { relevantRange_x = atLeastInterval xRange , relevantRange_y = atLeastInterval yRange , isTintableMonochromic = True@@ -334,7 +362,7 @@ -- Beware that this will always slow down the performance when the list is large; -- there is no Éc;statistic optimisationÉd; as in 'tracePlot'. lineSegPlot :: [(Double, Double)] -> DynamicPlottable-lineSegPlot ps = DynamicPlottable{+lineSegPlot ps = def { relevantRange_x = atLeastInterval' $ foldMap (pure . spInterval . fst) ps , relevantRange_y = atLeastInterval' $ foldMap (pure . spInterval . snd) ps , isTintableMonochromic = True@@ -402,7 +430,7 @@ instance Plottable (Shade P2) where- plot shade = DynamicPlottable{+ plot shade = def { relevantRange_x = atLeastInterval xRange , relevantRange_y = atLeastInterval yRange , isTintableMonochromic = True@@ -419,7 +447,7 @@ instance Plottable (SimpleTree P2) where plot (GenericTree Nothing) = plot ([] :: [SimpleTree P2]) plot (GenericTree (Just (ctr, root)))- = DynamicPlottable{+ = def{ relevantRange_x = atLeastInterval xRange , relevantRange_y = atLeastInterval yRange , isTintableMonochromic = True@@ -489,10 +517,26 @@ 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₁<>rx₂) (ry₁<>ry₂) (tm₁||tm₂) (oc₁+oc₂) (ax₁+ax₂) (le₁++le₂) (dp₁<>dp₂) +instance Monoid DynamicPlottable where+ mempty = DynamicPlottable mempty mempty False 0 0 [] mempty+ mappend = (<>)+instance Default DynamicPlottable where def = mempty+ data GraphViewState = GraphViewState { lastStableView :: Maybe (GraphWindowSpec, Plot) , realtimeView, nextTgtView :: Async Plot@@ -501,6 +545,10 @@ +legendName :: String -> DynamicPlottable -> DynamicPlottable+legendName n d = d { legendEntries = LegendEntry (PlainText n) mempty : legendEntries d }++ data RangeRequest r = OtherDimDependantRange (Option (Interval r) -> Option (Interval r)) | MustBeThisRange (Interval r)@@ -522,6 +570,9 @@ atLeastInterval' :: Option (Interval r) -> RangeRequest r atLeastInterval' = OtherDimDependantRange . const +++ -- | Plot some plot objects to a new interactive GTK window. Useful for a quick@@ -574,8 +625,9 @@ 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+ gs <- newIORef =<< assignGrViews graphs'' defaultColourSeq 0 return (w,gs) @@ -685,6 +737,7 @@ where xUnZ = 1/w; yUnZ = 1/h 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@@ -695,8 +748,7 @@ Nothing -> return mempty Just Plot{..} -> let antTK = DiagramTK { viewScope = currentView - , textTools = TextTK defaultTxtStyle- txtSize aspect 0.2 0.2 }+ , textTools = textTK txtSize aspect } txtSize = h * fontPts / fromIntegral yResolution aspect = w * fromIntegral yResolution / (h * fromIntegral xResolution)@@ -711,9 +763,15 @@ gvStates <- readIORef graphs waitAny $ map (realtimeView . snd) gvStates+ + thePlot <- (mconcat . reverse) <$> mapM renderComp (reverse gvStates)+ theLegend <- prerenderLegend (textTK 10 1) colourScheme+ $ (\(p,g) -> (,) <$> legendEntries p <*> [graphColor g]) =<< gvStates - writeIORef dgStore- . mconcat . reverse =<< mapM renderComp (reverse gvStates)+ writeIORef dgStore $ ( theLegend & Dia.scaleX (0.1 / sqrt (fromIntegral xResolution))+ & Dia.scaleY (0.1 / sqrt (fromIntegral yResolution)) + & (`Dia.place`(0.75^&0.75)) )+ <> thePlot refreshDraw @@ -833,9 +891,8 @@ -- 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 = DynamicPlottable{- relevantRange_x = mempty- , relevantRange_y = otherDimDependence yRangef+continFnPlot f = def{+ relevantRange_y = otherDimDependence yRangef , isTintableMonochromic = True , axesNecessity = 1 , dynamicPlot = plot }@@ -850,6 +907,44 @@ l!n | (x:_)<-drop n l = x | otherwise = error "Function appears to yield NaN most of the time. Cannot be plotted." +type (-->) = RWDiffable ℝ++diffableFnPlot :: (∀ m . ( WithField ℝ PseudoAffine m+ , HasMetric (Needle (Interior m)) )+ => AgentVal (-->) m ℝ -> AgentVal (-->) m ℝ )+ -> DynamicPlottable+diffableFnPlot f = plot fd+ where fd :: ℝ --> ℝ+ fd = alg f++scrutiniseDiffability :: (∀ m . ( WithField ℝ PseudoAffine m+ , HasMetric (Needle (Interior 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+ }+ where mkFrame (GraphWindowSpecR2{..}) = case fscrut xm of+ Option (Just ((ym,y'm), δOδx²))+ | Option (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))+ | yo <- [-δy, δy] ]+ in mkPlot frame+ | otherwise+ -> y'm `seq` mkPlot+ ( simpleLine ((xm-δxdef)^&(ym-δxdef*y'm))+ ((xm+δxdef)^&(ym+δxdef*y'm)) )+ where xm = (rBound + lBound) / 2+ δxdef = (rBound - lBound) / 10+ δy = rfh * (tBound - bBound)+ -- | Plot a continuous function in the usual way, taking arguments from the -- x-Coordinate and results to the y one.@@ -858,7 +953,7 @@ -- @'fnPlot' (\\x -> sin x / exp (x^2))@ will work (but the view must not contain -- singularities). -- --- Under the hood this uses the category of continuous functions, ':-->', to proove+-- Under the hood this uses the category of continuous functions, ':-->', to prove -- that no details are omitted (like small high-frequency bumps). The flip side is that -- this does not always work very efficiently, in fact it can easily become exponentially -- slow for some parameters.@@ -888,7 +983,21 @@ fc = alg1to2 f -+continColourSurfaceFnPlot :: ((Double,Double) -> DCol.Colour Double) -> DynamicPlottable+continColourSurfaceFnPlot f = def {+ axesNecessity = 1+ , occlusiveness = 4+ , dynamicPlot = plot }+ where plot (GraphWindowSpecR2{..}) = mkPlot+ $ Dia.place+ ( Dia.rasterDia cf (xResolution`div`4) (yResolution`div`4)+ & Dia.scaleX wPix & Dia.scaleY hPix+ ) ( ((lBound+rBound-wPix)/2) ^& ((tBound+bBound+hPix)/2) )+ where cf i j = f ( lBound + wPix * fromIntegral i, tBound - hPix * fromIntegral j )+ `Dia.withOpacity` 0.2+ w = rBound - lBound; h = tBound - bBound+ wPix = w*4 / fromIntegral xResolution+ hPix = h*4 / fromIntegral yResolution data AxesStyle = DynamicAxesStyle data DynamicAxes = DynamicAxes { yAxisClasses, xAxisClasses :: [AxisClass] }@@ -922,11 +1031,9 @@ -- | Coordinate axes with labels. For many plottable objects, these will be added -- automatically, by default (unless inhibited with 'noDynamicAxes'). dynamicAxes :: DynamicPlottable-dynamicAxes = DynamicPlottable { - relevantRange_x = mempty- , relevantRange_y = mempty - , isTintableMonochromic = False- , axesNecessity = superfluent+dynamicAxes = def { + axesNecessity = superfluent+ , occlusiveness = 1 , dynamicPlot = plot } where plot gwSpec@(GraphWindowSpecR2{..}) = Plot labels lines where (DynamicAxes yAxCls xAxCls) = crtDynamicAxes gwSpec@@ -953,12 +1060,7 @@ noDynamicAxes :: DynamicPlottable-noDynamicAxes = DynamicPlottable { - relevantRange_x = mempty- , relevantRange_y = mempty - , isTintableMonochromic = False- , axesNecessity = superfluent- , dynamicPlot = const mempty }+noDynamicAxes = def { axesNecessity = superfluent } @@ -989,26 +1091,10 @@ yInterval, forceYRange :: (Double, Double) -> DynamicPlottable -xInterval (l,r) = DynamicPlottable { - relevantRange_x = atLeastInterval $ Interval l r- , relevantRange_y = mempty- , isTintableMonochromic = False, axesNecessity = 0, dynamicPlot = plot }- where plot _ = Plot mempty mempty-forceXRange (l,r) = DynamicPlottable { - relevantRange_x = MustBeThisRange $ Interval l r- , relevantRange_y = mempty- , isTintableMonochromic = False, axesNecessity = 0, dynamicPlot = plot }- where plot _ = Plot mempty mempty-yInterval (b,t) = DynamicPlottable { - relevantRange_x = mempty- , relevantRange_y = atLeastInterval $ Interval b t- , isTintableMonochromic = False, axesNecessity = 0, dynamicPlot = plot }- where plot _ = Plot mempty mempty-forceYRange (b,t) = DynamicPlottable { - relevantRange_x = mempty- , relevantRange_y = MustBeThisRange $ Interval b t- , isTintableMonochromic = False, axesNecessity = 0, dynamicPlot = plot }- where plot _ = Plot mempty mempty+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 } @@ -1028,13 +1114,11 @@ -- <<images/examples/sin-ctrd-tangents.gif>> newtype ViewXCenter = ViewXCenter { getViewXCenter :: Double } instance (Plottable p) => Plottable (ViewXCenter -> p) where- plot f = DynamicPlottable {- relevantRange_x = mempty- , 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+ , isTintableMonochromic = isTintableMonochromic fcxVoid+ , axesNecessity = axesNecessity fcxVoid+ , 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.@@ -1043,13 +1127,11 @@ OtherDimDependantRange ifr -> ifr otherdim newtype ViewYCenter = ViewYCenter { getViewYCenter :: Double } instance (Plottable p) => Plottable (ViewYCenter -> p) where- plot f = DynamicPlottable {- relevantRange_x = OtherDimDependantRange $- \g -> deescalate relevantRange_x g . plot . f . cyI =<< g- , relevantRange_y = mempty- , 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+ , isTintableMonochromic = isTintableMonochromic fcyVoid+ , axesNecessity = axesNecessity fcyVoid+ , 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.@@ -1058,13 +1140,11 @@ OtherDimDependantRange ifr -> ifr otherdim newtype ViewWidth = ViewWidth { getViewWidth :: Double } instance (Plottable p) => Plottable (ViewWidth -> p) where- plot f = DynamicPlottable {- relevantRange_x = mempty- , 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+ , isTintableMonochromic = isTintableMonochromic fwVoid+ , axesNecessity = axesNecessity fwVoid+ , 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@@ -1073,13 +1153,11 @@ OtherDimDependantRange ifr -> ifr otherdim newtype ViewHeight = ViewHeight { getViewHeight :: Double } instance (Plottable p) => Plottable (ViewHeight -> p) where- plot f = DynamicPlottable {- relevantRange_x = OtherDimDependantRange $- \g -> deescalate relevantRange_x g . plot . f . hI =<< g- , relevantRange_y = mempty- , 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+ , isTintableMonochromic = isTintableMonochromic fhVoid+ , axesNecessity = axesNecessity fhVoid+ , 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@@ -1090,5 +1168,17 @@ newtype ViewYResolution = ViewYResolution { getViewYResolution :: Int } +++atExtendOf :: PlainGraphicsR2 -> PlainGraphicsR2 -> PlainGraphicsR2+atExtendOf d₁ = atExtendOf' d₁ 1++atExtendOf' :: PlainGraphicsR2 -> Double -> PlainGraphicsR2 -> PlainGraphicsR2+atExtendOf' d₁ q d₂ = d₂+ & Dia.translate ((pux+plx-lux-llx)/2 ^& (puy+ply-luy-lly)/2)+ & Dia.scaleX (q*(pux-plx)/(lux-llx))+ & Dia.scaleY (q*(puy-ply)/(luy-lly))+ where (Just (plx,pux)) = Dia.extentX d₁; (Just (ply,puy)) = Dia.extentY d₁+ (Just (llx,lux)) = Dia.extentX d₂; (Just (lly,luy)) = Dia.extentY d₂
Graphics/Text/Annotation.hs view
@@ -34,7 +34,7 @@ import qualified Prelude -import Diagrams.Prelude ((^&), (&), _x, _y)+import Diagrams.Prelude ((^&), (&), _x, _y, (|||), (===)) import qualified Diagrams.Prelude as Dia import qualified Diagrams.TwoD.Size as Dia import qualified Diagrams.TwoD.Types as DiaTypes@@ -48,7 +48,7 @@ import qualified Control.Category.Hask as Hask import Control.Category.Constrained.Prelude hiding ((^))-import Control.Arrow.Constrained+import Control.Arrow.Constrained hiding ((|||)) import Control.Monad.Constrained import Control.Lens hiding ((...), (<.>))@@ -82,12 +82,22 @@ | preci >= 0, preci < 4 = show $ round x | preci < 0, preci > -2 = printf "%.1f" x | otherwise = case ceiling (0.01 + lg (abs x/10^^(preci+1))) + preci of- 0 | preci < 0 -> printf ("%."++show(-preci)++"f") x- expn | expn>preci -> printf ("%."++show(expn-preci)++"f*10^%i")- (x/10^^expn) expn- | otherwise -> printf ("%i*10^%i")- (round $ x/10^^expn :: Int) expn+ 0 | preci < 0 -> printf "%.*f"+ (-preci)+ x+ expn | expn>preci -> printf "%.*f×₁₀%s"+ (expn-preci)+ (x/10^^expn)+ (showExponentAsSuperscript expn)+ | otherwise -> printf "%i×₁₀%s"+ (round $ x/10^^expn :: Int)+ (showExponentAsSuperscript expn) +showExponentAsSuperscript :: Int -> String+showExponentAsSuperscript = map sup . show+ where sup ch = case lookup ch $ zip "0123456789-"+ "⁰¹²³⁴⁵⁶⁷⁸⁹⁻" of+ Just ch -> ch maybeRead :: Read a => String -> Maybe a maybeRead = fmap fst . listToMaybe . reads@@ -173,3 +183,35 @@ lg :: Floating a => a -> a lg = logBase 10+++++data LegendEntry = LegendEntry {+ plotObjectTitle :: TextObj+ , customLegendObject :: Option ()+ }+++prerenderLegend :: TextTK -> ColourScheme+ -> [(LegendEntry, Maybe AColour)] -> IO PlainGraphicsR2+prerenderLegend _ _ [] = return mempty+prerenderLegend TextTK{..} cscm l = do+ let bgColour = cscm neutral+ defColour = cscm (paler contrast)+ lRends <- fmap Dia.vcat $ forM l `id`+ \( LegendEntry{ plotObjectTitle = PlainText str+ , customLegendObject = Option Nothing }, c ) -> do+ txtR <- CairoTxt.textVisualBoundedIO txtCairoStyle+ $ DiaTxt.Text mempty (DiaTxt.BoxAlignedText 0 0.5) str+ let h = Dia.height txtR+ return $ Dia.hsep 5 [ Dia.rect h h & Dia.fcA (maybe defColour id c)+ , txtR+ ] & Dia.centerXY+ & Dia.frame 2+ & Dia.alignL+ let w = Dia.width lRends+ h = Dia.height lRends+ return $ ( lRends & Dia.centerXY & Dia.translate (3^&3) )+ <> ( Dia.rect (w+1) (h+1) & Dia.fcA (cscm $ paler grey) )+
dynamic-plot.cabal view
@@ -1,5 +1,5 @@ Name: dynamic-plot-Version: 0.1.1.0+Version: 0.1.1.1 Category: graphics Synopsis: Interactive diagram windows Description: Haskell excels at handling data like continuous functions@@ -45,6 +45,7 @@ , tagged , containers , semigroups+ , data-default , random , MonadRandom , time@@ -59,8 +60,8 @@ , gtk > 0.10 && < 0.15 , glib , colour >= 2 && < 3- , manifolds >= 0.1.5 && < 0.1.6- , lens < 4.12.3+ , manifolds > 0.1.5.0 && < 0.1.6+ , lens < 4.12.4 Other-Extensions: FlexibleInstances , TypeFamilies , FlexibleContexts