module TypesAndConstants where

import Control.Monad
import Control.Monad.State
import System.IO (FilePath)
import Graphics.UI.Gtk (DrawWindow)
import Graphics.Rendering.Cairo (Render)

----------------------------------
----------- Constantes -----------
----------------------------------

windowWidth :: Int
windowWidth = 700

windowHeight :: Int
windowHeight = 700

help :: String
help = "Comandos gráficos:\n" ++
       "-----------------\n\n" ++
       "  - fw n                     Avanza una cantidad n de pixeles en el ángulo actual\n" ++
       "  - rot d                    Rota dº el ángulo en el sentido de las agujas del reloj. Esto afecta a futuros trazos\n" ++
       "  - chg c                    Cambia el color de futuros trazos a c\n" ++
       "  - rep n ( cmd )            Repite n veces el comando cmd. Los paréntesis son necesarios\n" ++
       "  - clear                    Borra el dibujo actual\n" ++
       "  - reset                    · Borra el dibujo actual\n" ++
       "                             · Setea el centro del área de dibujo como el origen del trazo \n" ++ 
       "                             · Setea el ángulo a 0º\n" ++
       "                             · Setea el color a negro\n\n" ++
       "  Secuencias de comandos:\n" ++
       "  ----------------------\n\n" ++
       "    Se pueden escribir secuencias de comandos con utilizando \';\'. Por ejemplo \n" ++
       "      fw 100; rot 30; chg verde; fw 50\n\n" ++
       
       "  Comando en varias líneas:\n" ++
       "  ------------------------\n\n" ++
       "    Se puede escribir un comando en varias líneas como se muestra a continuación:\n\n" ++
       "      Ejemplo 1:\n\n" ++
       "        fw 30; rot 10; fw 50;\n" ++
       "        rot -90; chg rojo; fw 100\n\n" ++
       "      Ejemplo 2:\n\n" ++
       "        rep 5 (rot 45; fw 60;\n"++
       "        rot 45)\n\n\n" ++

       "Comandos de control:\n" ++
       "-------------------\n\n" ++       
       "  - :save filePath           Guarda el dibujo actual en el archivo filePath con formato png\n" ++
       "  - :load filePath           Dibuja los comandos que toma del archivo filePath\n" ++
       "  - :help                    Muestra la ayuda\n" ++
       "  - :exit                    Sale del programa"


defaultColor :: RGBColor
defaultColor = toRGBColor Negro   


----------------------------------
--------- Tipos de datos ---------
----------------------------------

type Degree = Double


type Point = (Double,Double)


data Color = Rojo
           | Verde
           | Azul
           | Amarillo
           | Negro
           deriving (Show, Eq)


type RGBColor = (Double,Double,Double)


data Sector = S1
            | S2
            | S3
            | S4
            | S5
            | S6
            | S7
            | S8
            | S9
  deriving Show


data Axis = XBottom
          | XTop
          | YBottom
          | YTop
          | Neutral
  deriving Show


{-|
  - Complete si es un comando completo
  - IncompleteRep si es una reptición incompleta
  - IncompleteFin si es un comando seguido de ')' y un ';' para continuar 
  - IncompleteComm si es una secuencia de comandos incompleta
  - Completing si tiene algún ')' una repetición que comenzó en alguna línea anterior
-}
data CmdState = Complete
              | IncompleteRep
              | IncompleteFin
              | IncompleteComm
              | Completing
              deriving (Show, Eq)


data ProgramState = ProgramState { lastPoint :: Point
                                 , color :: RGBColor
                                 , angle :: Degree
                                 , incCommStack :: [CompCom]
                                 , drawWindow :: DrawWindow
                                 , drawing :: Render ()
                                 }

instance Show ProgramState where
  show ProgramState {lastPoint = l, color = c, angle = a, incCommStack = s, drawWindow = d, drawing = _} =
       "Punto actual: " ++ show l ++ "\n"
    ++ "Color       : " ++ show c ++ "\n"
    ++ "Ángulo      : " ++ show a ++ "\n"
    ++ "Stack       : " ++ show s ++ "\n"


{-|
  Este representa tanto a los comandos de control
  como los que permiten realizar movimientos.
-}
data GeneralCommand = CtrlCmd ControlCommand
                    | GraphicCmd CompCom


data ControlCommand = Help
                    | Save FilePath
                    | Load FilePath
                    | Exit


{-|
Comandos simples
-}
data Command = Fw Double
             | Rot Degree
             | Chg Color
             | Clear
             | Reset
             deriving Show

instance Eq Command where
  Fw n     == Fw m     = n == m
  Rot d1   == Rot d2   = d1 == d2
  Chg c1   == Chg c2   = c1 == c2
  Clear    == Clear    = True
  Reset    == Reset    = True
  _        == _        = False 


{-|
  Comandos compuestos
-}
data CompCom = Rep Int CompCom
             | Cmd Command
             | CCSeq [CompCom]
             | IncRep Int [CompCom]
             | IncCompCom CompCom
             | FinalCompCom CompCom
             deriving Show

instance Eq CompCom where
  Rep n c1        == Rep m c2        = n == m && c1 == c2
  Cmd c1          == Cmd c2          = c1 == c2
  CCSeq xs        == CCSeq ys        = if length xs == length ys
                                       then
                                         let pairs = zip xs ys
                                             zs = map (\(x,y) -> x == y) pairs
                                         in and zs
                                       else False
  IncRep n xs     == IncRep m ys     = n == m && (CCSeq xs == CCSeq ys)
  IncCompCom c1   == IncCompCom c2   = c1 == c2
  FinalCompCom c1 == FinalCompCom c2 = c1 == c2
  _               == _               = False


{-|
  Bloques gráficos básicos.
-}
data GraphicBlock = Line Point Point RGBColor
                  | ClearScreen
                  deriving Show


----------------------------------
------------ Funciones -----------
----------------------------------

toRGBColor :: Color -> RGBColor
toRGBColor Rojo      = (255,0,0)
toRGBColor Verde     = (0,255,0)
toRGBColor Azul      = (0,0,255)
toRGBColor Amarillo  = (255,255,0)
toRGBColor Negro     = (0,0,0)

{-|
  State getters
-}
getStatePoint   :: State ProgramState Point
getStatePoint   = state (\s -> (lastPoint s,s))

getStateColor   :: State ProgramState RGBColor
getStateColor   = state (\s -> (color s,s))

getStateAngle   :: State ProgramState Degree
getStateAngle   = state (\s -> (angle s,s))

getStack        :: State ProgramState [CompCom]
getStack        = state (\s -> (incCommStack s,s))

getDrawing      :: State ProgramState (Render ())
getDrawing      = state (\s -> (drawing s,s))

{-|
  State setters
-}
setStatePoint         :: Point -> State ProgramState ()
setStatePoint p       = state (\s -> ((),s {lastPoint = p}))

setStateColor         :: RGBColor -> State ProgramState ()
setStateColor c       = state (\s -> ((),s {color = c}))

setStateAngle         :: Degree -> State ProgramState ()
setStateAngle a       = state (\s -> ((),s {angle = a}))

setStack              :: [CompCom] -> State ProgramState ()
setStack xs           = state (\s -> ((),s {incCommStack = xs}))

setDrawing            :: Render () -> State ProgramState ()
setDrawing newDrawing = state (\s -> ((),s {drawing = return ()}))

addDrawing            :: Render () -> State ProgramState ()
addDrawing newDrawing = do actualDrawing <- getDrawing
                           s <- get
                           put (s {drawing = actualDrawing >> newDrawing})