module ProgramLogic (programLoop) where import TypesAndConstants import Parsers import Stack import Draw import Graphics.Rendering.Cairo import Graphics.UI.Gtk (DrawingArea, mainQuit, renderWithDrawable) import System.IO import System.Console.Haskeline import System.Directory (doesFileExist, doesPathExist) import System.FilePath.Posix (splitFileName) import Control.Monad import Control.Monad.State import Control.Concurrent (myThreadId, killThread) import Text.Megaparsec.Error as E (parseErrorPretty, parseErrorPretty') import Data.Either import Data.Char (isSpace) programLoop :: StateT ProgramState (InputT IO) () programLoop = do state <- get let stack = incCommStack state isNull = null stack if isNull then lift $ outputStrLn "=) Ingrese una expresión" else return () mbInput <- lift $ getInputLine "=) " case mbInput of Just input -> if all isSpace input then programLoop else do state <- get let result = parseFromCmdLine input isNull case result of Left err -> do lift $ outputStr $ "=) " ++ E.parseErrorPretty' input err programLoop Right cmd -> case cmd of CtrlCmd ctrlCmd -> handleCtrlCmd ctrlCmd GraphicCmd ast -> do handleGraphicCmd ast stack programLoop Nothing -> lift $ outputStrLn "=) Hubo un error en la entrada." {-| Handler de comandos compuestos En primer instancia se genera un nuevo stack a partir del stack actual y el que se construye con el comando ingresado en la última línea por el usuario: - En caso que sea posible graficar (cuando la segunda componente que devuelve genNewStack es True): - Se genera lo que hay que graficar (genGraphicBlockList) - Se actualiza el estado del programa (modifyStack) - Se genera el nuevo dibujo (drawGraphicBlocks) - Se agrega el nuevo dibujo al que se almacena en el estado (addToDrawing) - Se grafica en pantalla (renderWithDrawable) - Si es False: Se actualiza el estado -} handleGraphicCmd :: CompCom -> [CompCom] -> StateT ProgramState (InputT IO) () handleGraphicCmd ast stack = do case combineStacks (reverse (makeStack ast)) stack of Right (newStack, finished) -> if finished then do s <- get let cc = head newStack -- combineStacks siempre va a terminar con un solo elemento si finished es True (bc_list, s') = runState (genGraphicBlockList cc) s (_, s'') = runState (modifyStack emptyStack) s' newDrawing = drawGraphicBlocks bc_list (_, newState) = runState (addToDrawing newDrawing) s'' dw = drawWindow newState lift $ liftIO $ renderWithDrawable dw newDrawing put newState else do s <- get let (_, newState) = runState (modifyStack newStack) s put newState Left err -> lift $ outputStrLn $ "=) " ++ err handleGraphicCmdList :: [CompCom] -> [CompCom] -> StateT ProgramState (InputT IO) () handleGraphicCmdList [] stack = return () handleGraphicCmdList (cc:ccs) stack = do handleGraphicCmd cc stack state <- get handleGraphicCmdList ccs (incCommStack state) {-| Handler de comandos de control -} handleCtrlCmd :: ControlCommand -> StateT ProgramState (InputT IO) () handleCtrlCmd Help = do lift $ outputStrLn help programLoop handleCtrlCmd (Save filePath) = let (directory,_) = splitFileName filePath in do state <- get exist <- lift $ liftIO $ doesPathExist directory if exist then do lift $ liftIO $ saveToFile filePath (drawing state) lift $ outputStrLn $ "Su dibujo se guardo en " ++ filePath else lift $ outputStrLn $ "La carpeta donde quiere guardar el archivo no existe" programLoop handleCtrlCmd (Load filePath) = let finalPath = filter (\c-> c /= '\\') filePath in do exist <- lift $ liftIO $ doesFileExist finalPath if exist then do strCmd <- lift $ liftIO $ readFile finalPath res <- lift $ liftIO $ parseFromFile filePath case res of Left err -> lift $ outputStrLn $ E.parseErrorPretty' strCmd err Right xs -> case cmdStackState xs of Complete -> do state <- get handleGraphicCmdList xs (incCommStack state) _ -> lift $ outputStrLn $ "El archivo " ++ finalPath ++ " debe contener comandos completos." else lift $ outputStrLn $ finalPath ++ " no es un archivo existente." programLoop handleCtrlCmd Exit = do lift $ liftIO $ mainQuit id <- lift $ liftIO myThreadId lift $ liftIO $ killThread id {-| En base a un comando: - Genera una lista de bloques gráficos para luego dibujarlos. - Modifica el estado -} genGraphicBlockList :: CompCom -> State ProgramState [GraphicBlock] genGraphicBlockList (Rep 0 cc) = return [] genGraphicBlockList (Rep n cc) = do l1 <- genGraphicBlockList cc l2 <- genGraphicBlockList (Rep (n-1) cc) return $ l1 ++ l2 genGraphicBlockList (Cmd c) = genGraphicBlockList' c genGraphicBlockList (CCSeq []) = return [] genGraphicBlockList (CCSeq (c:cs)) = do l1 <- genGraphicBlockList c l2 <- genGraphicBlockList (CCSeq cs) return $ l1 ++ l2 genGraphicBlockList' :: Command -> State ProgramState [GraphicBlock] genGraphicBlockList' (Fw distance) = do stateAngle <- getStateAngle statePoint <- getStatePoint stateColor <- getStateColor let newPoint = nextPoint stateAngle distance statePoint sector = getSector newPoint (newDist,restDist) = calculateNewDistances statePoint newPoint distance (x,y) = nextPoint stateAngle newDist statePoint opositePoint = case (getAxis statePoint newPoint sector) of XBottom -> (700,y) YBottom -> (x,700) XTop -> (0,y) YTop -> (x,0) Neutral -> (x,y) -- No debería llegar a este caso y tener que seguir dibiujando if restDist == 0 then do setStatePoint (x,y) return [Line statePoint (x,y) stateColor] else do setStatePoint opositePoint cmd_list <- genGraphicBlockList' (Fw restDist) return $ (Line statePoint (x,y) stateColor) : cmd_list genGraphicBlockList' (Rot rotation) = do stateAngle <- getStateAngle let intA = (floor stateAngle) :: Int intR = (floor rotation) :: Int newAngle = mod (intA + intR) 360 newAngleD = (fromIntegral newAngle) :: Double setStateAngle newAngleD return [] genGraphicBlockList' (Chg newColor) = do setStateColor (toRGBColor newColor) return [] genGraphicBlockList' Clear = do setDrawing (return ()) return [ClearScreen] genGraphicBlockList' Reset = do setStatePoint (350,350) setStateAngle 0 setStateColor defaultColor setDrawing (return ()) return [ClearScreen] {-| calculateNewDistances p1 p2 dist calcula la distancia desde p1 hasta p2. Se pueden dar 2 casos: - p2 se encuentra dentro del área de dibujo, con lo cual se obtiene (dist, 0) ya que la distancia entre ambos puntos es la misma que la que se pasa por argumento - p2 cae fuera del área de dibujo, en este caso se calcula la distancia desde p1 hasta el punto correspondiente al borde del área con el cual la recta intersecará, junto con la distancia restante -} calculateNewDistances :: Point -> Point -> Double -> (Double,Double) calculateNewDistances p1 p2 distance = let sector = getSector p2 minProportion = getMinProportion p1 p2 sector newDistance = distance * minProportion in (newDistance, distance - newDistance) {-| - Calcula la proporción mínima según el sector en que se encuentre. - Esta proporción se útiliza para el cálculo de la distancia entre el último punto dibujado y el punto donde interseca el borde del area de dibujo. -} getMinProportion :: Point -> Point -> Sector -> Double getMinProportion (x,y) (u,v) S1 = let xProportion = x / (abs (u) + x) yProportion = y / (abs (v) + y) in if xProportion <= yProportion then xProportion else yProportion getMinProportion (x,y) (u,v) S2 = x / (abs (u) + x) getMinProportion (x,y) (u,v) S3 = let xProportion = x / (abs (u) + x) yLengthToTop = 700 - y yLengthToV = v - y yProportion = yLengthToTop / yLengthToV in if xProportion <= yProportion then xProportion else yProportion getMinProportion (x,y) (u,v) S4 = let yLengthToTop = 700 - y yLengthToV = v - y in yLengthToTop / yLengthToV getMinProportion (x,y) (u,v) S5 = 1 getMinProportion (x,y) (u,v) S6 = y / (abs (v) + y) getMinProportion (x,y) (u,v) S7 = let xLengthToRight = 700 - x xLengthToU = u - x xProportion = xLengthToRight / xLengthToU yProportion = y / (abs (v) + y) in if xProportion <= yProportion then xProportion else yProportion getMinProportion (x,y) (u,v) S8 = let xLengthToRight = 700 - x xLengthToU = u - x in xLengthToRight / xLengthToU getMinProportion (x,y) (u,v) S9 = let xLengthToRight = 700 - x xLengthToU = u - x xProportion = xLengthToRight / xLengthToU yLengthToBottom = 700 - y yLengthToV = v - y yProportion = yLengthToBottom / yLengthToV in if xProportion <= yProportion then xProportion else yProportion {-| Calcula el eje del área de dibujo que será intersecado por la línea según el sector en que se encuentre. -} getAxis :: Point -> Point -> Sector -> Axis getAxis (x,y) (u,v) S1 = let xProportion = x / (abs (u) + x) yProportion = y / (abs (v) + y) in if xProportion <= yProportion then XBottom else YBottom getAxis (x,y) (u,v) S2 = XBottom getAxis (x,y) (u,v) S3 = let xProportion = x / (abs (u) + x) yLengthToBottom = 700 - y yLengthToV = v - y yProportion = yLengthToBottom / yLengthToV in if xProportion <= yProportion then XBottom else YTop getAxis (x,y) (u,v) S4 = YTop getAxis (x,y) (u,v) S5 = Neutral getAxis (x,y) (u,v) S6 = YBottom getAxis (x,y) (u,v) S7 = let xLengthToRight = 700 - x xLengthToU = u - x xProportion = xLengthToRight / xLengthToU yProportion = y / (abs (v) + y) in if xProportion <= yProportion then XTop else YBottom getAxis (x,y) (u,v) S8 = XTop getAxis (x,y) (u,v) S9 = let xLengthToRight = 700 - x xLengthToU = u - x xProportion = xLengthToRight / xLengthToU yLengthToBottom = 700 - y yLengthToV = v - y yProportion = yLengthToBottom / yLengthToV in if xProportion <= yProportion then XTop else YTop {-| Calcula el sector en que está ubicado el punto final de la línea a trazar | | | | S1 | S6 | S7 | | | YBottom | ------------------------------------------------------------------ | | | | | | | | Casos: X | | S1) u < 0 && v < 0: En este caso se utilizan lo lados YBottom y XBottom B | | S2) u < 0 && 0 <= v <= 700: En este caso se utiliza el lado XBottom o | | X S3) u < 0 && 700 < v: En este caso se utilizan lo lados XBottom y YTop t | | T S4) 0 <= u <= 700 && 700 < v: En este caso se utiliza el lado YTop S2 t | S5 | o S8 S5) 0 <= u <= 700 && 0 <= v <= 700: En este caso estoy dentro del área de dibujo o | | p S6) 0 <= u <= 700 && v < 0: En este caso se utiliza el lado YBottom m | | S7) 700 < u && v < 0: En este caso se utilizan lo lados YBottom y XTop | | S8) 700 < u && 0 <= v <= 700: En este caso se utiliza el lado XTop | | S9) 700 < u && 700 < v: En este caso se utilizan lo lados YTop y XTop | | | | | | | | ------------------------------------------------------------------- | YTop | | | S3 | S4 | S9 | | | | -} getSector :: Point -> Sector getSector (u,v) | u < 0 && v < 0 = S1 | u < 0 && 0 <= v && v <= toDouble(windowHeight) = S2 | u < 0 && toDouble(windowHeight) < v = S3 | 0 <= u && u <= toDouble(windowWidth) && toDouble(windowHeight) < v = S4 | 0 <= u && u <= toDouble(windowWidth) && 0 <= v && v <= toDouble(windowHeight) = S5 | 0 <= u && u <= toDouble(windowWidth) && v < 0 = S6 | toDouble(windowWidth) < u && v < 0 = S7 | toDouble(windowWidth) < u && 0 <= v && v <= toDouble(windowHeight) = S8 | toDouble(windowWidth) < u && toDouble(windowHeight) < v = S9 {-| e /| c / | o n / | p a / | u t / | e s / | s i / | t d /_ a | o /__)_____| adjacente cos(a) = adjacente / distance => adjacente = cos(a) * distance sen(a) = opuesto / distance => opuesto = sen(a) * distance Como se calcula desde (lastX,lastY) los valores son: - nextX = lastX + cos (toRadians angle) * distance - nextY = lastY + sin (toRadians angle) * distance -} nextPoint :: Degree -> Double -> Point -> Point nextPoint angle distance (lastX,lastY) = let nextX = lastX + cos (toRadians angle) * distance nextY = lastY + sin (toRadians angle) * distance in (nextX, nextY) toRadians :: Degree -> Double toRadians degrees = (degrees * pi)/180 toDouble :: Int -> Double toDouble n = (fromIntegral n) :: Double