module Draw
(addToDrawing,
 drawGraphicBlocks,
 saveToFile)
where

import TypesAndConstants
import Control.Monad.State
import Graphics.Rendering.Cairo (Render, setSourceRGB,
                                 setLineWidth, moveTo, lineTo,
                                 stroke, getSource, mask,
                                 withImageSurface, Format (FormatARGB32), renderWith,
                                 paint, surfaceWriteToPNG)


{-|
  Agrega el gráfico del argumento al gráfico que se guarda en el estado
-}
addToDrawing :: Render () -> State ProgramState ()
addToDrawing newDrawing = addDrawing newDrawing


{-|
  saveToFile file d: Guarda d en file
-}
saveToFile :: FilePath -> Render () -> IO ()
saveToFile filePath drawing =
  withImageSurface FormatARGB32 windowWidth windowHeight (\srf -> do renderWith srf (do setSourceRGB 1 1 1
                                                                                        paint
                                                                                        drawing)
                                                                     surfaceWriteToPNG srf filePath)


{-|
  Genera un dibujo con los comandos gráficos de la lista
-}
drawGraphicBlocks :: [GraphicBlock] -> Render ()
drawGraphicBlocks [] = return ()
drawGraphicBlocks ((Line (x1,y1) (x2,y2) (r,g,b)):xs) =
  do setSourceRGB r g b
     setLineWidth 1
     moveTo x1 y1
     lineTo x2 y2
     moveTo x2 y2
     stroke
     drawGraphicBlocks xs

drawGraphicBlocks (ClearScreen:xs) =
  do setSourceRGB 255 255 255
     p <- getSource
     mask p
     drawGraphicBlocks xs