module Stack (emptyStack, combineStacks, makeStack, modifyStack, cmdStackState) where import TypesAndConstants import PrettyPrinting import Control.Monad.State emptyStack :: [CompCom] emptyStack = [] {-| Setea newStack como el stack del estado del programa -} modifyStack :: [CompCom] -> State ProgramState () modifyStack newStack = setStack newStack {-| A partir de 2 stacks genera un único stack e indica si se debe seguir esperando comandos o ya se puede dibujar. Esta función toma - Stack actual del programa - Stack generado a partir del último comando ingresado por el usuario y genera un nuevo stack e indica si se puede dibujar o hay que seguir pidiendo comandos para completar los anteriores incompletos -} combineStacks :: [CompCom] -> [CompCom] -> Either String ([CompCom], Bool) combineStacks stack oldStack = genNewStack stack oldStack False genNewStack :: [CompCom] -> [CompCom] -> Bool -> Either String ([CompCom], Bool) genNewStack stack@(_:css) oldStack b = case cmdStackState css of Complete -> genNewStack' stack oldStack False _ -> genNewStack' stack oldStack True genNewStack stack oldStack b = genNewStack' stack oldStack b {-| genNewStack' stack oldStack okToAdd: - okToAdd: Es útil en la función unifyStackCmds, ver comentario de dicha función -} genNewStack' :: [CompCom] -> [CompCom] -> Bool -> Either String ([CompCom], Bool) genNewStack' stack [] b = let revStack = reverse stack in case cmdStackState stack of IncompleteComm -> Right (removeIncCompCom revStack, False) IncompleteRep -> Right (revStack, False) Complete -> case stack of [x] -> Right (stack, True) (_:_:_) -> Right (joinCompleteCmds revStack,True) _ -> Left "Queriendo completar un comando inexistente o cerrando mas repeticiones de las debidas." genNewStack' [] oldStack _ = case cmdStackState oldStack of Complete -> Right (oldStack, True) _ -> Right (oldStack, False) genNewStack' stack@(cc:ccs) oldStack@(cc':ccs') okToAdd = let cState = cmdState cc eitherMiddleCmd = case cState of IncompleteRep -> Right cc' -- En este caso se devuelve cc' ya que si se trata de una repetición incompleta -- todos comandos que se escribieron son parte de la misma _ -> unifyStackCmds cc' cc cState okToAdd in case eitherMiddleCmd of Right middleCmd -> case cState of IncompleteRep -> Right (reverse stack ++ oldStack, False) IncompleteComm -> Right (middleCmd:ccs', False) -- Si el comando que agregué terminaba en ';' entonces -- a la derecha no podía haber ningún comando más Complete -> genNewStack' ccs (middleCmd:ccs') False IncompleteFin -> genNewStack' (middleCmd:ccs) ccs' True -- Cuando cc tiene estado IncompleteFin y unifyStackCmds no -- devuelve error, el comando lo genera el proceso, por eso -- la llamada recursiva se hace con True Completing -> case cmdState middleCmd of Complete -> case ccs of [] -> case ccs' of -- No hay más comandos ingresados [] -> Right $ ([middleCmd], True) x:_ -> if cmdState x == Complete then Right $ ([joinCmds x middleCmd], True) -- Llegado este caso solo va a quedar -- un comando en el stack a completar else Left "Intentando finalizar comando cuando aún quedan comandos para completar." _ -> if null ccs' then genNewStack' ccs [middleCmd] False else genNewStack' (middleCmd:ccs) ccs' True _ -> genNewStack' (middleCmd:ccs) ccs' True Left err -> Left err {-| Une los comandos de un stack. Cuando todos los comandos de un stack son completos, se llama a esta función para generar uno único -} joinCompleteCmds :: [CompCom] -> [CompCom] joinCompleteCmds [x] = [x] joinCompleteCmds (x:y:xs) = joinCompleteCmds ((joinCmds y x) : xs) {-| Esta función se usa para combinar un comando del stack anterior y un comando que se genera a partir de la siguiente línea ingresada por el usuario. unifyStackCmds cmdToComplete cmdToAdd cmdState okToAdd - cmdToComplete: Comando a completar (tomado del tope del stack anterior) - cmdToAdd: Comando a agregar a cmdToComplete (último elemento del nuevo stack) - cmdState: Indica el estado de cmdToAdd - Repetición incompleta - Incompleto sin repetición incompleta - Comando para completar uno previo - okToAdd: Con True indica que el comando fue generado por una iteración del proceso. En el caso de ser un comando completo, es correcto agregarlo al comando a completar. No permite que se ingrese un comando como el siguiente: cmd1; rep n ( cmd2; cmd3 ya que este caso no es correcto porque las repeticiones deben continuarse con comandos incompletos o cerrarse. ------------------------------------------------------------------------------------ Stack generado a partir del último comando ingresado Stack actual | OldCmd5 | | OldCmd4 | | NewCmd3 | | OldCmd3 | | NewCmd2 | | OldCmd2 | | NewCmd1 | | OldCmd1 | Por como se generan los stacks, el comando menos anidado se ubica en la parte inferior y el más anidado en la parte superior. Por lo tanto, en la siguiente iteración los 2 comandos a combinar serán OldCmd5 y NewCmd1 ya que OldCmd5 es el último comando que se ingresó antes de presionar enter y NewCmd1 es el primer comando (ó secuencia) que se escribió en la siguiente línea -} unifyStackCmds :: CompCom -> CompCom -> CmdState -> Bool -> Either String CompCom unifyStackCmds (IncRep n ccs') (IncCompCom cc) IncompleteComm _ = Right $ IncRep n (ccs'++[cc]) unifyStackCmds (CCSeq ccs') (IncCompCom cc) IncompleteComm _ = Right $ CCSeq (ccs'++[cc]) unifyStackCmds (Cmd cc') (IncCompCom cc) IncompleteComm _ = Right $ CCSeq [Cmd cc',cc] unifyStackCmds rep@(Rep n seq) (IncCompCom cc) IncompleteComm _ = Right $ CCSeq [rep,cc] unifyStackCmds (IncCompCom cc) (IncCompCom cc') IncompleteComm _ = Right $ CCSeq [cc,cc'] unifyStackCmds (IncRep n ccs') (CCSeq ccs) IncompleteComm _ = Right $ IncRep n (ccs'++(removeIncCompCom ccs)) unifyStackCmds (CCSeq ccs') (CCSeq ccs) IncompleteComm _ = Right $ CCSeq (ccs'++(removeIncCompCom ccs)) unifyStackCmds (Cmd cc) (CCSeq ccs) IncompleteComm _ = Right $ CCSeq (Cmd cc:(removeIncCompCom ccs)) unifyStackCmds rep@(Rep n seq) (CCSeq ccs) IncompleteComm _ = Right $ CCSeq (rep:(removeIncCompCom ccs)) unifyStackCmds (IncCompCom cc) (CCSeq ccs) IncompleteComm _ = Right $ CCSeq (cc:(removeIncCompCom ccs)) unifyStackCmds _ _ IncompleteComm _ = error "Solo puede haber secuencias o repeticiones incompletas para completar." unifyStackCmds (IncRep n ccs) cls@(IncCompCom fcc) IncompleteFin _ = Right $ replaceCmd cls (Rep n (CCSeq (ccs++[getCmd fcc]))) unifyStackCmds (IncRep n ccs') (CCSeq ccs) IncompleteFin _ = let s = init ccs cc = last ccs in Right $ replaceCmd cc (Rep n (CCSeq (ccs'++s++[getCmd cc]))) unifyStackCmds _ icc IncompleteFin _ = Left $ (showCompComm icc) ++ " intenta completar una repetición incompleta inexistente." unifyStackCmds (IncRep n ccs') cls@(FinalCompCom cc) Completing _ = Right $ replaceCmd cls (Rep n (CCSeq (ccs'++[getCmd cc]))) unifyStackCmds (IncRep n ccs') (CCSeq ccs) Completing _ = let s = init ccs cc = last ccs in Right $ replaceCmd cc (Rep n (CCSeq (ccs'++s++[getCmd cc]))) unifyStackCmds _ cc Completing _ = Left $ (showCompComm cc) ++ " intenta completar una repetición incompleta inexistente." unifyStackCmds (Cmd cc) cc' Complete _ = Right $ CCSeq [Cmd cc, cc'] unifyStackCmds (CCSeq ccs') cc Complete _ = Right $ CCSeq (ccs'++[cc]) unifyStackCmds (Rep n seq) cc Complete _ = Right $ CCSeq [Rep n seq, cc] unifyStackCmds (IncRep n ccs') cc Complete True = Right $ IncRep n (ccs'++[cc]) unifyStackCmds (IncRep n ccs') cc Complete False = Left $ "Se ingreso el comando\n" ++ showCompComm cc ++ "\npero debe continuar con comandos incompletos o completar la repetición." unifyStackCmds _ _ Complete _ = error "Solo puede haber secuencias o repeticiones incompletas en el stack." unifyStackCmds _ _ _ _ = error "Intentando completar comandos con comandos o secuencias de comandos incorrectas." {-| Obtiene el comando mas anidado correspondiente al constructor FinalCompCom o IncCompCom. Por ejemplo: - getCmd (FinalCompCom (FinalCompCom (FinalCompCom (Cmd (Fw 10))))) -----> Cmd (Fw 10) - getCmd (IncCompCom (FinalCompCom (FinalCompCom (Cmd (Rot 30))))) -----> Cmd (Rot 30) -} getCmd :: CompCom -> CompCom getCmd (FinalCompCom (Cmd c)) = Cmd c getCmd (FinalCompCom cc) = getCmd cc getCmd (IncCompCom cc) = getCmd cc getCmd cc = cc {-| Reemplaza el FinalCompCom cmd mas anidado de un comando FinalCompCom o IncCompCom FinalCompCom. Por ejemplo: - replaceCmd (FinalCompCom (FinalCompCom (FinalCompCom (Cmd (Fw 10))))) c -----> FinalCompCom (FinalCompCom c) - replaceCmd (IncCompCom (FinalCompCom (FinalCompCom (Cmd (Rot 30))))) c -----> IncCompCom (FinalCompCom c) -} replaceCmd :: CompCom -> CompCom -> CompCom replaceCmd (FinalCompCom (FinalCompCom cc')) cc = FinalCompCom (replaceCmd (FinalCompCom cc') cc) replaceCmd (FinalCompCom cc') cc = cc replaceCmd (IncCompCom cc') cc = IncCompCom (replaceCmd cc' cc) replaceCmd cc cc' = error "replaceCmd solo debería ejecutarse con constructores FinalCompCom o IncCompCom FinalCompCom" {-| Quita los contructores IncCompCom de una lista de comandos. Por ejemplo: removeIncCompCom [Cmd (Fw 10), IncCompCom (Cmd (Rot 50))] -----> [Cmd (Fw 10), Cmd (Rot 50)] -} removeIncCompCom :: [CompCom] -> [CompCom] removeIncCompCom [] = [] removeIncCompCom ((IncCompCom cc):xs) = cc:(removeIncCompCom xs) removeIncCompCom ((CCSeq ccs):xs) = let ccs' = removeIncCompCom ccs in (CCSeq ccs'):(removeIncCompCom xs) removeIncCompCom (cc:xs) = cc:(removeIncCompCom xs) {-| Devuelve el estado de un stack de comandos -} cmdStackState :: [CompCom] -> CmdState cmdStackState [] = Complete cmdStackState (cc:ccs) = case cmdState cc of Complete -> cmdStackState ccs otherwise -> otherwise {-| Devuelve el estado de un comando -} cmdState :: CompCom -> CmdState cmdState (IncRep _ _) = IncompleteRep cmdState (IncCompCom (FinalCompCom _)) = IncompleteFin cmdState (IncCompCom _) = IncompleteComm cmdState (FinalCompCom _) = Completing cmdState (CCSeq (x:xs)) = case cmdState x of Complete -> cmdState (CCSeq xs) otherwise -> otherwise cmdState _ = Complete joinCmds :: CompCom -> CompCom -> CompCom joinCmds (CCSeq xs) (CCSeq ys) = CCSeq (xs++ys) joinCmds comm (CCSeq ys) = CCSeq (comm:ys) joinCmds (CCSeq xs) comm = CCSeq (xs++[comm]) joinCmds comm comm' = CCSeq [comm,comm'] {-| Genera un stack de comandos. Sí el argumento es un comando incompleto, entonces: - En el caso inicial será el stack de comandos incompletos que se guarda en el estado - En otro caso será el que se utilizará para completar el stack almacenado en el estado del juego Ejemplos: parseTest parseCompCommand "fw 100)); fw 10; fw 30;" = CCSeq [FinalCompCom (FinalCompCom (Cmd (Fw 100.0))),Cmd (Fw 10.0),IncCompCom (Cmd (Fw 30.0))] makeStack (CCSeq [FinalCompCom (FinalCompCom (Cmd (Fw 100.0))),Cmd (Fw 10.0),IncCompCom (Cmd (Fw 30.0))]) = [ CCSeq [Cmd (Fw 10.0),IncCompCom (Cmd (Fw 30.0))], FinalCompCom (FinalCompCom (Cmd (Fw 100.0))) ] parseTest parseCompCommand "rep 3 (fw 10; rep 4 ( fw 4; rep 5 ( rot 10; fw 5; rep 6 ( rep 7 (rot 10; fw 100;" = IncRep 3 [Cmd (Fw 10.0),IncRep 4 [Cmd (Fw 4.0),IncRep 5 [Cmd (Rot 10.0),Cmd (Fw 5.0),IncRep 6 [IncRep 7 [Cmd (Rot 10.0),Cmd (Fw 100.0)]]]]] makeStack (IncRep 3 [Cmd (Fw 10.0),IncRep 4 [Cmd (Fw 4.0),IncRep 5 [Cmd (Rot 10.0),Cmd (Fw 5.0),IncRep 6 [IncRep 7 [Cmd (Rot 10.0),Cmd (Fw 100.0)]]]]]) = [ IncRep 7 [Cmd (Rot 10.0),Cmd (Fw 100.0)], IncRep 6 [], IncRep 5 [Cmd (Rot 10.0),Cmd (Fw 5.0)], IncRep 4 [Cmd (Fw 4.0)], IncRep 3 [Cmd (Fw 10.0)] ] Notar que los comandos del stack generado quedan en el orden inverso a como se ingresaron, por lo tanto el último comando ingresado es el que está mas a la izquierda -} makeStack :: CompCom -> [CompCom] makeStack cc = makeStack' cc [] False 0 {-| makeStack' cmd resultStack isRep n: - cmd: Comando a procesar - resultList: Stack que se está armando - isRep: Indica si lo que se está procesando es parte de una repetición - n: El entero de la repetición -} makeStack' :: CompCom -> [CompCom] -> Bool -> Int -> [CompCom] makeStack' (CCSeq []) rs _ _ = rs makeStack' (CCSeq xs) rs b n = let (ys, rest) = splitList xs in makeStack'' ys rest rs b n makeStack' (IncRep m [IncRep m' ccs]) rs b n = (makeStack' (IncRep m' ccs) ((IncRep m []):rs) b n) makeStack' (IncRep m ccs) rs b n = makeStack' (CCSeq ccs) rs True m makeStack' cc _ _ _ = [cc] makeStack'' :: [CompCom] -> [CompCom] -> [CompCom] -> Bool -> Int -> [CompCom] makeStack'' (r@(IncCompCom (FinalCompCom _)):_) ((IncRep m ccs):_) rs False n = makeStack' (IncRep m ccs) (r:rs) False n makeStack'' (r@(IncCompCom (FinalCompCom _)):_) ys@(_:_) rs False n = makeStack' (CCSeq ys) (r:rs) False n makeStack'' (r@(IncCompCom (FinalCompCom _)):_) [] rs False _ = r:rs makeStack'' ((IncCompCom (FinalCompCom _)):_) _ _ True _ = error "Se debería parsear como repetición de una sola línea" makeStack'' (r@(FinalCompCom _):_) ((IncRep m ccs):_) rs False n = makeStack' (IncRep m ccs) (r:rs) False n makeStack'' (r@(FinalCompCom _):_) ys@(_:_) rs False n = makeStack' (CCSeq ys) (r:rs) False n makeStack'' (r@(FinalCompCom _):_) [] rs False _ = r:rs makeStack'' ((FinalCompCom cc):_) _ _ True _ = error "Se debería parsear como repetición de una sola línea" makeStack'' xs@(_:_) ((IncRep m ccs):_) rs False n = makeStack' (IncRep m ccs) ((CCSeq xs):rs) False n makeStack'' xs@(_:_) ys@(_:_) rs False n = makeStack' (CCSeq ys) ((CCSeq xs):rs) False n makeStack'' xs@(_:_) [] rs False _ = (CCSeq xs):rs makeStack'' xs@(_:_) ((IncRep m ccs):_) rs True n = makeStack' (IncRep m ccs) ((IncRep n xs):rs) False 0 makeStack'' xs@(_:_) ys@(_:_) rs True n = makeStack' (CCSeq ys) ((IncRep n xs):rs) False 0 makeStack'' xs@(_:_) [] rs True n = (IncRep n xs):rs makeStack'' [] ((IncRep m ccs):_) rs b n = makeStack' (IncRep m ccs) rs b n makeStack'' [] ys@(_:_) rs b n = makeStack' (CCSeq ys) rs b n makeStack'' [] [] _ _ _ = error "No debería llegar makeStack''" {-| Divide la lista cuando encuentra alguno de los siguientes comandos: 1- IncCompCom 2- FinalCompCom 3- IncRep - En el caso de encontrar 1 o 2 los devuelve en la primer lista y en la segunda los comandos de la derecha. - En el caso que ecuentre 3, como todos los comandos que haya a la derecha serán parte de la misma, se devuelve la repetición en la segunda lista y en la primera todos los de la izquierda. Ejemplos: splitList [CCSeq [Cmd (Rot 30.0), Cmd (Fw 100.0)], IncRep 5 [Cmd (Rot 10.0),Cmd (Fw 100.0)]] = ( [CCSeq [Cmd (Rot 30.0),Cmd (Fw 100.0)]], [IncRep 5 [Cmd (Rot 10.0),Cmd (Fw 100.0)]] ) splitList [Cmd (Rot 30.0), FinalCompCom (Cmd (Chg Rojo)), Cmd (Fw 100.0), IncRep 5 [Cmd (Rot 10.0),Cmd (Fw 100.0)]] = ( [Cmd (Rot 30.0),FinalCompCom (Cmd (Chg Rojo))], [Cmd (Fw 100.0),IncRep 5 [Cmd (Rot 10.0),Cmd (Fw 100.0)]] ) -} splitList :: [CompCom] -> ([CompCom], [CompCom]) splitList [] = ([], []) splitList ((IncRep n ys):xs) = ([], [IncRep n ys]) splitList (x:xs) = let (rs, rest) = splitList xs in case x of IncCompCom cc -> ([IncCompCom cc], xs) FinalCompCom cc -> ([FinalCompCom cc], xs) cc -> (cc:rs, rest)