module Diagrams.TwoD.Model
(
showOrigin
, showOrigin'
, OriginOpts(..)
, showLabels
) where
import Diagrams.Core
import Diagrams.Core.Names
import Diagrams.Path
import Diagrams.Attributes
import Diagrams.TwoD.Ellipse
import Diagrams.TwoD.Path
import Diagrams.TwoD.Size (size2D)
import Diagrams.TwoD.Text
import Diagrams.TwoD.Types
import Diagrams.Util
import Control.Arrow (second)
import Data.AffineSpace ((.-.))
import Data.Default.Class
import Data.Semigroup
import Data.VectorSpace ((^*))
import qualified Data.Map as M
import Data.Colour (Colour)
import Data.Colour.Names
showOrigin :: (Renderable (Path R2) b, Backend b R2, Monoid' m)
=> QDiagram b R2 m -> QDiagram b R2 m
showOrigin = showOrigin' def
showOrigin' :: (Renderable (Path R2) b, Backend b R2, Monoid' m)
=> OriginOpts -> QDiagram b R2 m -> QDiagram b R2 m
showOrigin' oo d = o <> d
where o = stroke (circle sz)
# fc (oColor oo)
# lw 0
# fmap (const mempty)
(w,h) = size2D d ^* oScale oo
sz = maximum [w, h, oMinSize oo]
data OriginOpts = OriginOpts { oColor :: Colour Double
, oScale :: Double
, oMinSize :: Double
}
instance Default OriginOpts where
def = OriginOpts red (1/50) 0.001
showLabels :: (Renderable Text b, Backend b R2)
=> QDiagram b R2 m -> QDiagram b R2 Any
showLabels d =
( mconcat
. map (\(n,p) -> text (show n) # translate (p .-. origin))
. concatMap (\(n,ps) -> zip (repeat n) ps)
. (map . second . map) location
. M.assocs
$ m
) <>
fmap (const (Any False)) d
where
SubMap m = subMap d