module Draw(
  Point(..),
  smult, pt, fromPolar,
  Draw,
  initEnv,
  Draw.line, Draw.slice, Draw.rect, Draw.polygon,
  Draw.translate, Draw.rotate, Draw.scale,
  getColour, setColour, nextColour,
  draw
) where

import qualified Control.Monad.Trans.State.Lazy as S
import TinySVG as T

--
-- 1. The Draw monad
--

data Env  = Env { strkWdth :: Double
                , colour   :: (Int, Int, Int)
                , graphics ::[Graphics]
                }

-- The Draw monad: a state monad with the environment
type Draw  = S.State Env 

-- Accessing the environment+
set :: (Env-> Env)-> Draw ()
set f = S.state $ \e-> ((), f e)

get :: (Env-> a)-> Draw a
get f = S.state $ \e-> (f e, e)


--
-- 2. Primitive Drawing commands
--
line    :: Point-> Point-> Draw ()
line p1 p2 =
  set $ \e-> e{ graphics= attrs e (T.line p1 p2): graphics e }

slice   :: Point-> Double-> Double-> Double-> Draw ()
slice m r from to =
  set $ \e-> e{graphics= attrs e (T.slice m r from to): graphics e} 

rect :: Point-> Point-> Draw ()
rect (Pt x1 y1) (Pt x2 y2) =
  Draw.polygon [Pt x1 y1, Pt x2 y1, Pt x2 y2, Pt x1 y2]

polygon :: [Point]-> Draw ()
polygon ps =
  set $ \e-> e{ graphics= attrs e (T.polygon ps): graphics e }


--
-- 3. Transformations
--

xform :: (Graphics-> Graphics)-> Draw()-> Draw()
xform f d = set $ \e-> 
  let s = S.execState d (e{graphics= []})
  in  e {graphics= f (group (graphics s)): graphics e}
  
rotate :: Point-> Double-> Draw ()-> Draw ()
rotate p phi = xform (T.rotateAt p phi)

scale :: Double-> Draw()-> Draw ()
scale r = xform (T.scale r)

translate :: Point -> Draw () -> Draw ()
translate p = xform (T.translate p)

--
-- 4. SVG Attributes -- colours and such<
-- 

attrs :: Env-> Graphics-> Graphics
attrs e =
  T.strokeWidth (strkWdth e). strokeColor (RGB r g b). fillColor (RGB r g b)  
  where (r, g, b)= colour e

-- Colours
setColour :: Int-> Int-> Int-> Draw ()
setColour r g b =
  set $ \e-> e{ colour= (adj r, adj g, adj b) } where adj c = c `mod` 256

getColour :: Draw (Int, Int, Int)
getColour = get colour


nextCol :: (Int, Int, Int)-> (Int, Int, Int)
nextCol (r, g, b) = (r+ 7, g+ 17, b+ 23)

nextColour :: Draw ()
nextColour = do (r, g, b)<- getColour >>= return . nextCol
                setColour r g b

-- Stroke width
strokeWidth :: Double-> Draw ()
strokeWidth d = set $ \e-> e {strkWdth = d }

--
-- 5. Execution--- running a drawing computation
--

initEnv :: Double-> Double-> Env
initEnv w h = Env { strkWdth = 1
                  , colour= (0, 0, 0)
                  , graphics = []
                  }

render :: Double-> Double-> Draw String
render w h = do
     gs<- get graphics
     return $ toXML (2*w) (2*h) (T.translate (Pt w h) (group (reverse gs)))
   
draw :: Double-> Double-> String-> Draw ()-> IO ()
draw w h fnm d = writeFile fnm $ S.evalState (d >> render w h) (initEnv w h)

