module FRP.UISF.Graphics.Graphic (
Graphic(..),
nullGraphic,
overGraphic,
withColor, withColor',
text, textLines,
ellipse, shearEllipse, line, polygon, polyline, polybezier, arc,
circleFilled, circleOutline, rectangleFilled, rectangleOutline,
translateGraphic, rotateGraphic, scaleGraphic,
boundGraphic
) where
import FRP.UISF.Graphics.Color
import FRP.UISF.Graphics.Text
import FRP.UISF.Graphics.Types
import Control.DeepSeq
data Graphic =
NoGraphic
| GText Point UIText
| GPolyLine [Point]
| GPolygon [Point]
| GArc Rect Angle Angle
| GEllipse Rect
| GBezier [Point]
| GTranslate Point Graphic
| GRotate Point Angle Graphic
| GScale Double Double Graphic
| GColor RGB Graphic
| GBounded Rect Graphic
| OverGraphic Graphic Graphic
deriving (Eq, Show)
instance NFData Graphic where
rnf NoGraphic = ()
rnf (GText (!_,!_) str) = rnf str
rnf (GPolyLine !pts) = ()
rnf (GPolygon !pts) = ()
rnf (GArc ((!_,!_),(!_,!_)) !_ !_) = ()
rnf (GEllipse ((!_,!_),(!_,!_))) = ()
rnf (GBezier !pts) = ()
rnf (GTranslate (!_,!_) g) = rnf g
rnf (GRotate (!_,!_) !_ g) = rnf g
rnf (GScale !_ !_ g) = rnf g
rnf (GColor !_ g) = rnf g
rnf (GBounded ((!_,!_),(!_,!_)) g) = rnf g
rnf (OverGraphic g1 g2) = rnf g1 `seq` rnf g2
nullGraphic :: Graphic
nullGraphic = NoGraphic
overGraphic :: Graphic -> Graphic -> Graphic
overGraphic g1 NoGraphic = g1
overGraphic NoGraphic g2 = g2
overGraphic g1 g2 = OverGraphic g1 g2
text :: UITexty s => Point -> s -> Graphic
text p = GText p . toUIText
textLines :: UITexty s => [(Point, s)] -> Graphic
textLines = foldl (\g (p,s) -> overGraphic (text p s) g) nullGraphic
withColor :: Color -> Graphic -> Graphic
withColor = withColor' . colorToRGB
withColor' :: RGB -> Graphic -> Graphic
withColor' _ NoGraphic = NoGraphic
withColor' c g = GColor c g
ellipse :: Rect -> Graphic
ellipse = GEllipse
shearEllipse :: Point -> Rect -> Graphic
shearEllipse (x0,y0) r =
let ((x1,y1), (w, h)) = normaliseRect r
(x2,y2) = (x1 + w, y1 + h)
x = (x1 + x2) / 2
y = (y1 + y2) / 2
dx1 = (x1 fromIntegral x0) / 2
dy1 = (y1 fromIntegral y0) / 2
dx2 = (x2 fromIntegral x0) / 2
dy2 = (y2 fromIntegral y0) / 2
pts = [ (round $ x + c*dx1 + s*dx2, round $ y + c*dy1 + s*dy2)
| (c,s) <- cos'n'sins ]
cos'n'sins = [ (cos a, sin a) | a <- segment 0 (2 * pi) (40 / (w + h))]
in GPolygon pts
line :: Point -> Point -> Graphic
line p q = GPolyLine [p,q]
polygon :: [Point] -> Graphic
polygon = GPolygon
polyline :: [Point] -> Graphic
polyline = GPolyLine
polybezier :: [Point] -> Graphic
polybezier = GBezier
arc :: Rect -> Angle -> Angle -> Graphic
arc = GArc
circleFilled :: Point -> Int -> Graphic
circleFilled (x,y) r = GEllipse ((xr,yr),(2*r,2*r))
circleOutline :: Point -> Int -> Graphic
circleOutline (x,y) r = GArc ((xr,yr),(2*r,2*r)) 0 360
rectangleFilled :: Rect -> Graphic
rectangleFilled ((x,y), (w, h)) = GPolygon [(x, y), (x + w, y), (x + w, y + h), (x, y + h)]
rectangleOutline :: Rect -> Graphic
rectangleOutline ((x,y), (w, h)) = GPolyLine [(x, y), (x + w, y), (x + w, y + h), (x, y + h)]
translateGraphic :: Point -> Graphic -> Graphic
translateGraphic _ NoGraphic = NoGraphic
translateGraphic p g = GTranslate p g
rotateGraphic :: Point -> Angle -> Graphic -> Graphic
rotateGraphic _ _ NoGraphic = NoGraphic
rotateGraphic p a g = GRotate p a g
scaleGraphic :: Double -> Double -> Graphic -> Graphic
scaleGraphic _ _ NoGraphic = NoGraphic
scaleGraphic x y g = GScale x y g
boundGraphic :: Rect -> Graphic -> Graphic
boundGraphic _ NoGraphic = NoGraphic
boundGraphic r g = GBounded r g
normaliseRect :: Rect -> ((Double, Double),(Double, Double))
normaliseRect ((x, y), (w, h)) = ((fromIntegral x', fromIntegral y'), (fromIntegral w', fromIntegral h'))
where (x',w') = if w < 0 then (x+w, 0w) else (x, w)
(y',h') = if h < 0 then (y+h, 0h) else (y, h)
segment :: (Num t, Ord t) => t -> t -> t -> [t]
segment start stop step = ts start
where ts i = if i >= stop then [stop] else i : ts (i + step)