module Graphics.Rendering.Plot.Light.Internal (FigureData(..), Point(..), LabeledPoint(..), Axis(..), mkFigureData, svgHeader, rectCentered, line, tick, ticks, axis, text, polyline, V2(..), Mat2(..), DiagMat2(..), diagMat2, AdditiveGroup(..), VectorSpace(..), Hermitian(..), LinearMap(..), MultiplicativeSemigroup(..), MatrixGroup(..), norm2, normalize2, mkV2fromEndpoints, v2fromPoint, origin, movePoint, moveLabeledPointV2, fromUnitSquare, toUnitSquare, e1, e2) where
import Data.Monoid ((<>))
import Control.Arrow ((&&&), (***))
import Control.Monad (forM, forM_)
import Data.Semigroup (Min(..), Max(..))
import Data.Scientific (Scientific, toRealFloat)
import qualified Data.Text as T
import Text.Blaze.Svg
import Text.Blaze.Svg11 ((!))
import qualified Text.Blaze.Svg11 as S hiding (style)
import qualified Text.Blaze.Svg11.Attributes as SA hiding (rotate)
import Text.Blaze.Svg.Renderer.String (renderSvg)
import qualified Data.Colour as C
import qualified Data.Colour.Names as C
import qualified Data.Colour.SRGB as C
import GHC.Real
import Graphics.Rendering.Plot.Light.Internal.Types
import Graphics.Rendering.Plot.Light.Internal.Geometry
mkFigureData :: Num a =>
Point a
-> a
-> a
-> FigureData a
mkFigureData (Point xmi ymi) xlen ylen =
FigData xlen ylen xmi (xmi + xlen) ymi (ymi + ylen)
svgHeader :: FigureData Int -> Svg -> Svg
svgHeader fd =
S.docTypeSvg
! SA.version "1.1"
! SA.width (vi $ _width fd)
! SA.height (vi $ _height fd)
! SA.viewbox (vis [_xmin fd, _ymin fd, _xmax fd, _ymax fd])
rectCentered
:: Point Double
-> Double
-> Double
-> C.Colour Double
-> Svg
rectCentered (Point x0 y0) wid hei col = S.g ! SA.transform (S.translate x0c y0c) $
S.rect ! SA.width (vd wid) ! SA.height (vd hei) ! SA.fill (colourAttr col) where
x0c = x0 (wid / 2)
y0c = y0 (hei / 2)
line ::
Point Double
-> Point Double
-> Double
-> C.Colour Double
-> Svg
line (Point x1 y1) (Point x2 y2) sw col = S.line ! SA.x1 (vd x1) ! SA.y1 (vd y1) ! SA.x2 (vd x2) ! SA.y2 (vd y2) ! SA.stroke (colourAttr col )! SA.strokeWidth (vd sw)
tick :: Axis -> Double -> Double -> C.Colour Double -> Point Double -> Svg
tick ax len sw col (Point x y) = line (Point x1 y1) (Point x2 y2) sw col where
lh = len / 2
(x1, y1, x2, y2)
| ax == Y = (x, ylh, x, y+lh)
| otherwise = (xlh, y, x+lh, y)
tickX, tickY ::
Double
-> Double
-> C.Colour Double
-> Point Double
-> Svg
tickX = tick X
tickY = tick Y
ticks :: Foldable t =>
Axis
-> Double
-> Double
-> C.Colour Double
-> t (Point Double)
-> Svg
ticks ax len sw col ps = forM_ ps (tick ax len sw col)
axis :: (Functor t, Foldable t) =>
Axis
-> Double
-> Double
-> C.Colour Double
-> Double
-> Point Double
-> t (Point Double)
-> Svg
axis ax len sw col tickLenFrac p@(Point x y) ps = do
tick ax len sw col p
ticks (otherAxis ax) (tickLenFrac * len) sw col (f <$> ps)
where
f | ax == X = setPointY y
| otherwise = setPointX x
text :: (Show a, Show a1, S.ToValue a2) =>
a1
-> C.Colour Double
-> T.Text
-> V2 a2
-> Point a
-> Svg
text rot col te (V2 x y) (Point dx dy) =
S.text_ (S.toMarkup te) ! SA.x (S.toValue x) ! SA.y (S.toValue y) ! SA.transform (S.translate dx dy <> S.rotate rot) ! SA.fill (colourAttr col)
polyline :: (Show a1, Show a) =>
[(a1, a)]
-> Double
-> C.Colour Double
-> Svg
polyline lis sw col = S.polyline ! SA.points (S.toValue $ unwords $ map showP2 lis) ! SA.fill none ! SA.stroke (colourAttr col )! SA.strokeWidth (vd sw) ! SA.strokeLinejoin (S.toValue ("round" :: String))
showP2 :: (Show a, Show a1) => (a1, a) -> String
showP2 (x, y) = show x ++ "," ++ show y
none :: S.AttributeValue
none = S.toValue ("none" :: String)
colourAttr :: C.Colour Double -> S.AttributeValue
colourAttr = S.toValue . C.sRGB24show
vi :: Int -> S.AttributeValue
vi = S.toValue
vis :: [Int] -> S.AttributeValue
vis = S.toValue . unwords . map show
vd :: Double -> S.AttributeValue
vd = S.toValue
vds :: [Double] -> S.AttributeValue
vds = S.toValue . unwords . map show
vf :: Float -> S.AttributeValue
vf = S.toValue
vfs :: [Float] -> S.AttributeValue
vfs = S.toValue . unwords . map show