chart-unit-0.7.0.0: Native haskell charts.

Safe HaskellNone
LanguageHaskell2010

Chart.Rect

Description

rectangular chart elements

Synopsis

Documentation

data RectOptions Source #

Just about everything on a chart is a rectangle.

blob :: UColor Double -> RectOptions Source #

solid rectangle, no border

box :: UColor Double -> RectOptions Source #

clear rect, with border

clear :: RectOptions Source #

clear and utrans rect

bound :: RectOptions -> Double -> Chart b -> Chart b Source #

place a rect around an Chart, with a size equal to the chart range

rect_ :: (N b ~ Double, V b ~ V2, Transformable b, HasOrigin b, TrailLike b, HasStyle b) => RectOptions -> Rect Double -> b Source #

A single rectangle specified using a Rect x z y w where (x,y) is location of lower left corner (z,w) is location of upper right corner

rect_Example :: Double -> Chart b
rect_Example n =
  labelled (opts (Pair n 1)) "z,w" $
  labelled (opts (Pair n -1)) "z,y" $
  labelled (opts (Pair (-n) 1)) "x,w" $
  labelled (opts (Pair (-n) -1)) "x,y" $
  rect_ def (Ranges (n *. one) one)
  where
    opts :: Pair Double -> LabelOptions
    opts o =
      #text %~
        ( (#color .~ black `withOpacity` 0.8) .
          (#size .~ 0.3)) $
      #orientation .~ o $
      def

rects :: (V a ~ V2, N a ~ Double, Functor t, HasStyle a, TrailLike a, HasOrigin a, Transformable a, Foldable t, Monoid a) => RectOptions -> t (Rect Double) -> a Source #

Create rectangles (with the same configuration).

rects def (rectBars 0 [1, 2, 3, 5, 8, 0, -2, 11, 2, 1])

rectChart :: Traversable f => [RectOptions] -> Rect Double -> Rect Double -> [f (Rect Double)] -> Chart b Source #

A chart of rects

rectChart_ :: Traversable f => [RectOptions] -> Rect Double -> [f (Rect Double)] -> Chart b Source #

A chart of rectangles scaled to its own range

ropts :: [RectOptions]
ropts =
  [ #borderSize .~ 0 $ def
  , #borderSize .~ 0 $ #color .~ ucolor 0.3 0.3 0.3 0.2 $ def
  ]

rss :: [[Rect Double]]
rss =
  [ rectXY (\x -> exp (-(x ** 2) / 2)) (Range -5 5) 50
  , rectXY (\x -> 0.5 * exp (-(x ** 2) / 8)) (Range -5 5) 50
  ]

rectChart_Example :: Chart b
rectChart_Example = rectChart_ ropts widescreen rss

data Pixel Source #

At some point, a color of a rect becomes more about data than stylistic option, hence the pixel. Echewing rect border leaves a Pixel with no stylistic options to choose.

Constructors

Pixel 

Instances

Show Pixel Source # 

Methods

showsPrec :: Int -> Pixel -> ShowS #

show :: Pixel -> String #

showList :: [Pixel] -> ShowS #

Generic Pixel Source # 

Associated Types

type Rep Pixel :: * -> * #

Methods

from :: Pixel -> Rep Pixel x #

to :: Rep Pixel x -> Pixel #

type Rep Pixel Source # 
type Rep Pixel = D1 * (MetaData "Pixel" "Chart.Rect" "chart-unit-0.7.0.0-BXvSbD7oeutD6IKgXEsdT" False) (C1 * (MetaCons "Pixel" PrefixI True) ((:*:) * (S1 * (MetaSel (Just Symbol "pixelRect") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Rect Double))) (S1 * (MetaSel (Just Symbol "pixelColor") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (UColor Double)))))

pixel_ :: Pixel -> Chart b Source #

A pixel is a rectangle with a color.

pixel_Example :: Chart b
pixel_Example = text_ opt "I'm a pixel!" <> pixel_ (Pixel one ublue)
  where
    opt =
      #color .~ withOpacity black 0.8 $
      #size .~ 0.2 $
      def

pixels :: Traversable f => f Pixel -> Chart b Source #

Render multiple pixels

pixelsExample :: Chart b
pixelsExample =
  pixels
    [ Pixel
      (Rect (5 * x) (5 * x + 0.1) (sin (10 * x)) (sin (10 * x) + 0.1))
      (dissolve (2 * x) ublue)
    | x <- grid OuterPos (Range 0 1) 100
    ]

pixelChart :: Traversable f => Rect Double -> Rect Double -> [f Pixel] -> Chart b Source #

A chart of pixels

pixelChart_ :: Traversable f => Rect Double -> [f Pixel] -> Chart b Source #

A chart of pixels scaled to its own range

pixelChart_Example :: Chart b
pixelChart_Example =
  pixelChart_ asquare
  [(\(r,c) ->
      Pixel r
      (blend c
       (ucolor 0.47 0.73 0.86 1)
       (ucolor 0.01 0.06 0.22 1)
      )) <$>
   rectF (\(Pair x y) -> (x+y)*(x+y))
   one (Pair 40 40)]

data PixelationOptions Source #

Options to pixelate a Rect using a function

pixelate :: PixelationOptions -> Rect Double -> (Pair Double -> Double) -> [Pixel] Source #

Transform a Rect into Pixels using a function over a Pair

pixelateChart :: PixelationOptions -> Rect Double -> Rect Double -> (Pair Double -> Double) -> Chart b Source #

Chart pixels using a function This is a convenience function, and the example below is equivalent to the pixelChart_ example

pixelateChart def asquare one (\(Pair x y) -> (x+y)*(x+y))