module Lseed.Geometry.Generator
( GeometryGenerator
, translated
, rotated
, runGeometryGenerator
, addLine
)
where
import Control.Monad.Reader
import Control.Monad.Writer
type Point = (Double, Double)
type Line = (Point, Point)
newtype GeometryGenerator x a = GeometryGenerator (ReaderT (Point, Double) (Writer [(Line, x)]) a)
deriving (Monad)
transformed :: Point -> GeometryGenerator x Point
transformed (x,y) = GeometryGenerator $ do
((bx,by),r) <- ask
let (x', y') = (cos r * x + sin r *y, sin r * x + cos r *y)
return (bx + x', by + y')
translated :: Point -> GeometryGenerator x a -> GeometryGenerator x a
translated p (GeometryGenerator act) = do
(x',y') <- transformed p
GeometryGenerator $
local (\(_,r) -> ((x',y'),r)) act
rotated :: Double -> GeometryGenerator x a -> GeometryGenerator x a
rotated r (GeometryGenerator act) =
GeometryGenerator $ local (\(p,r') -> (p, r' r)) act
addLine :: x -> Line -> GeometryGenerator x ()
addLine x (p1,p2) = do
p1' <- transformed p1
p2' <- transformed p2
GeometryGenerator $ tell [((p1', p2'),x)]
runGeometryGenerator :: Point -> Double -> GeometryGenerator x () -> [(Line, x)]
runGeometryGenerator p r (GeometryGenerator gen) =
execWriter (runReaderT gen (p,r))