Calculate and render light polygons
[L-seed.git] / src / Lseed / Geometry / Generator.hs
1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
2
3 -- | Helper module providing a monad that collects lines
4 module Lseed.Geometry.Generator
5         ( GeometryGenerator
6         , translated
7         , rotated
8         , runGeometryGenerator
9         , addLine
10         )
11         where
12
13 import Control.Monad.Reader
14 import Control.Monad.Writer
15
16 type Point = (Double, Double)
17 type Line  = (Point, Point)
18
19
20 newtype GeometryGenerator a = GeometryGenerator (ReaderT (Point, Double) (Writer [Line]) a)
21  deriving (Monad)
22
23 transformed :: Point -> GeometryGenerator Point
24 transformed (x,y) = GeometryGenerator $ do
25         ((bx,by),r) <- ask
26         let (x', y') = (cos r * x + sin r *y, -sin r * x + cos r *y)
27         return (bx + x', by + y')
28
29 translated :: Point -> GeometryGenerator a -> GeometryGenerator a
30 translated p (GeometryGenerator act) = do
31         (x',y') <- transformed p
32         GeometryGenerator $
33                 local (\(_,r) -> ((x',y'),r)) act
34
35 rotated :: Double -> GeometryGenerator a -> GeometryGenerator a
36 rotated r (GeometryGenerator act) = 
37         GeometryGenerator $ local (\(p,r') -> (p, r' - r)) act
38
39 addLine :: Line -> GeometryGenerator ()
40 addLine (p1,p2) = do
41         p1' <- transformed p1
42         p2' <- transformed p2
43         GeometryGenerator $ tell [(p1', p2')]
44
45         
46 runGeometryGenerator :: Point -> Double -> GeometryGenerator () -> [Line]
47 runGeometryGenerator p r (GeometryGenerator gen) = 
48         execWriter (runReaderT gen (p,r))