Skip to content
Browse files

First Commit

  • Loading branch information...
0 parents commit f3dde18e667d331b4d6c9205c5a5696b958aad4e @whispernight committed
Sorry, we could not display the entire diff because it was too big.
22 .gitattributes
@@ -0,0 +1,22 @@
+# Auto detect text files and perform LF normalization
+* text=auto
+
+# Custom for Visual Studio
+*.cs diff=csharp
+*.sln merge=union
+*.csproj merge=union
+*.vbproj merge=union
+*.fsproj merge=union
+*.dbproj merge=union
+
+# Standard to msysgit
+*.doc diff=astextplain
+*.DOC diff=astextplain
+*.docx diff=astextplain
+*.DOCX diff=astextplain
+*.dot diff=astextplain
+*.DOT diff=astextplain
+*.pdf diff=astextplain
+*.PDF diff=astextplain
+*.rtf diff=astextplain
+*.RTF diff=astextplain
163 .gitignore
@@ -0,0 +1,163 @@
+#################
+## Eclipse
+#################
+
+*.pydevproject
+.project
+.metadata
+bin/
+tmp/
+*.tmp
+*.bak
+*.swp
+*~.nib
+local.properties
+.classpath
+.settings/
+.loadpath
+
+# External tool builders
+.externalToolBuilders/
+
+# Locally stored "Eclipse launch configurations"
+*.launch
+
+# CDT-specific
+.cproject
+
+# PDT-specific
+.buildpath
+
+
+#################
+## Visual Studio
+#################
+
+## Ignore Visual Studio temporary files, build results, and
+## files generated by popular Visual Studio add-ons.
+
+# User-specific files
+*.suo
+*.user
+*.sln.docstates
+
+# Build results
+[Dd]ebug/
+[Rr]elease/
+*_i.c
+*_p.c
+*.ilk
+*.meta
+*.obj
+*.pch
+*.pdb
+*.pgc
+*.pgd
+*.rsp
+*.sbr
+*.tlb
+*.tli
+*.tlh
+*.tmp
+*.vspscc
+.builds
+*.dotCover
+
+## TODO: If you have NuGet Package Restore enabled, uncomment this
+#packages/
+
+# Visual C++ cache files
+ipch/
+*.aps
+*.ncb
+*.opensdf
+*.sdf
+
+# Visual Studio profiler
+*.psess
+*.vsp
+
+# ReSharper is a .NET coding add-in
+_ReSharper*
+
+# Installshield output folder
+[Ee]xpress
+
+# DocProject is a documentation generator add-in
+DocProject/buildhelp/
+DocProject/Help/*.HxT
+DocProject/Help/*.HxC
+DocProject/Help/*.hhc
+DocProject/Help/*.hhk
+DocProject/Help/*.hhp
+DocProject/Help/Html2
+DocProject/Help/html
+
+# Click-Once directory
+publish
+
+# Others
+[Bb]in
+[Oo]bj
+sql
+TestResults
+*.Cache
+ClientBin
+stylecop.*
+~$*
+*.dbmdl
+Generated_Code #added for RIA/Silverlight projects
+
+# Backup & report files from converting an old project file to a newer
+# Visual Studio version. Backup files are not needed, because we have git ;-)
+_UpgradeReport_Files/
+Backup*/
+UpgradeLog*.XML
+
+
+
+############
+## Windows
+############
+
+# Windows image file caches
+Thumbs.db
+
+# Folder config file
+Desktop.ini
+
+
+#############
+## Python
+#############
+
+*.py[co]
+
+# Packages
+*.egg
+*.egg-info
+dist
+build
+eggs
+parts
+bin
+var
+sdist
+develop-eggs
+.installed.cfg
+
+# Installer logs
+pip-log.txt
+
+# Unit test / coverage reports
+.coverage
+.tox
+
+#Translations
+*.mo
+
+#Mr Developer
+.mr.developer.cfg
+
+# Mac crap
+.DS_Store
59 Codigo/Visualps.adb
@@ -0,0 +1,59 @@
+-------------------------------------------------------------------------
+-- Visualizador de Ficheros PostScript --
+-------------------------------------------------------------------------
+-- 010248; Roberto López Masiá; roberto.lopez.masia@hotmail.com --
+-- 040289; Andres Gómez Fasbender; fass_centauri@hotmail.com --
+-- 050007; Ángel Alférez Aroca; alferez.aroca@gmail.com --
+-------------------------------------------------------------------------
+-- Este programa coge de la entrada estándar el nombre del fichero
+-- postscript que se desea ejecutar. Oculta la visualización del fichero
+-- postscript y cierra esta en caso de error, la visualización se mostrará
+-- más adelante si el archivo es correcto y aparece la sentencia "showpage"
+-- en el fichero postscript
+-- -------------------------------------------------------------------------
+with bloque_principal;
+USE bloque_principal;
+with bloque_errores;
+use bloque_errores;
+with Ada.Command_Line;
+use Ada.Command_Line;
+with Ada.Text_IO;
+USE Ada.Text_IO;
+with Ada.Integer_Text_IO;
+use Ada.Integer_Text_IO;
+
+-- PRE: Cierto
+-- POST: Oculta la visualización del fichero postscript.
+-- Si recibe un argumento correspondiente a un archivo postscript
+-- procede a leer este fichero. Si no recibe ningún argumento
+-- cierra la ventana destinada a visualizar el fichero postscript.
+PROCEDURE Visualps IS
+ Error:Integer:=0;
+ Entrada : File_Type;
+begin
+
+ if Argument_Count = 0 then
+ Error := 6;
+ ELSIF (Argument(1)="-h" OR Argument(1)="-help") THEN
+ Put_line ("Visualizador de archivos PostScript");
+ Put ("practica de EDII:: alumnos Andres Gomez, Angel Alferez y Roberto Lopez");
+ New_Line;
+ New_Line;
+ Put("Forma de utilización:");
+ New_Line;
+ put("visualps archivo_postscript.ps");
+ New_Line;
+ cerrar;
+ ELSif Argument_Count = 1 then
+ Ocultar;
+ Leer_Postscript (Argument (1), Entrada, Error);
+ put("Estado de salida: ");
+ put(error);
+ cerrar;
+ end if;
+ IF Error/=0 THEN
+ Procesa_Error(Error);
+ Cerrar;
+ END IF;
+end Visualps;
+
60 Codigo/bloque_errores.adb
@@ -0,0 +1,60 @@
+-------------------------------------------------------------------------
+-- Visualizador de Ficheros PostScript --
+-------------------------------------------------------------------------
+-- 010248; Roberto López Masiá; roberto.lopez.masia@hotmail.com --
+-- 040289; Andres Gómez Fasbender; fass_centauri@hotmail.com --
+-- 050007; Ángel Alférez Aroca; alferez.aroca@gmail.com --
+-------------------------------------------------------------------------
+
+
+WITH Bloque_Grafico;
+USE Bloque_Grafico;
+
+PACKAGE BODY Bloque_Errores IS
+
+ PROCEDURE Procesa_Error (
+ Error : IN Integer ) IS
+ BEGIN
+ IF Error = 1 THEN
+ Mensaje_Error
+ (
+ "Fallo del Sistema: contenido del archivo postscript no válido");
+ Pclose;
+ ELSIF Error = 2 THEN
+ Mensaje_Error
+ (
+ "Fallo del Sistema: Intento de acceso a Pila_Vacia. Faltan argumentos en la pila");
+ Pclose;
+ ELSIF Error = 3 THEN
+ Mensaje_Error
+ (
+ "Fallo del Sistema: en la pila se ha encontrado un tipo no esperado");
+ Pclose;
+ ELSIF Error = 4 THEN
+ Mensaje_Error
+ (
+ "Fallo del Sistema: se ha intentado trazar un camino nuevo sin origen definido");
+ Pclose;
+ ELSIF Error = 5 THEN
+ Mensaje_Error ("Fallo del Sistema: no es un archivo PostScript");
+ Pclose;
+ ELSIF Error = 6 THEN
+ Mensaje_Error (
+ "Fallo del Sistema: debe especificar que archivo desea abrir");
+ Pclose;
+ ELSIF Error = 7 THEN
+ Mensaje_Error (
+ "Fallo del Sistema: el archivo especificado no existe!");
+ Pclose;
+ ELSIF Error = 8 THEN
+ Mensaje_Error (
+ "Fin del fichero Postscript!");
+ Pclose;
+ ELSE
+ Mensaje_Error
+ ("Faltan argumentos en la pila de estados gráficos");
+ Pclose;
+ END IF;
+ END Procesa_Error;
+
+END Bloque_Errores;
13 Codigo/bloque_errores.ads
@@ -0,0 +1,13 @@
+-------------------------------------------------------------------------
+-- Visualizador de Ficheros PostScript --
+-------------------------------------------------------------------------
+-- 010248; Roberto López Masiá; roberto.lopez.masia@hotmail.com --
+-- 040289; Andres Gómez Fasbender; fass_centauri@hotmail.com --
+-- 050007; Ángel Alférez Aroca; alferez.aroca@gmail.com --
+-------------------------------------------------------------------------
+
+
+PACKAGE bloque_errores IS
+ PROCEDURE Procesa_Error(Error: IN Integer);
+END bloque_errores;
+
692 Codigo/bloque_grafico.adb
@@ -0,0 +1,692 @@
+-------------------------------------------------------------------------
+-- Visualizador de Ficheros PostScript --
+-------------------------------------------------------------------------
+-- 010248; Roberto López Masiá; roberto.lopez.masia@hotmail.com --
+-- 040289; Andres Gómez Fasbender; fass_centauri@hotmail.com --
+-- 050007; Ángel Alférez Aroca; alferez.aroca@gmail.com --
+-------------------------------------------------------------------------
+--
+--
+-- Descripción:
+-- Bloque que contiene las operaciones gráficas del proyecto (librería gráfica JEWL)
+-- Crea la interfaz de usuario y visualiza el dibujo postscript.
+-- Traduce las operaciones del fichero postscript.
+-- Contiene todas las operaciones del sistema de coordenadas.
+--
+-- -------------------------------------------------------------------------
+with Pilas;
+with Ada.Text_Io;
+use Ada.Text_Io;
+
+WITH JEWL.Simple_Windows;
+USE JEWL.Simple_Windows;
+WITH Ada.Numerics.Elementary_Functions;
+USE Ada.Numerics.Elementary_Functions;
+
+PACKAGE BODY Bloque_Grafico IS
+
+ -------------
+ -- TIPOS ------------------------------------------------------
+ -------------
+ Pi : CONSTANT Float := 3.141592654;
+ TYPE Coordenadas IS
+ RECORD
+ X,
+ Y : Float;
+ END RECORD;
+
+ -- x e y son la magnitud de la escala
+ -- ang es lo rotado que estaba el sistema
+ -- cuando se realizó la escala
+ TYPE Escalado IS
+ RECORD
+ X,
+ Y,
+ Ang : Float;
+ END RECORD;
+
+ -- matriz de 2x2
+ -- (a b)
+ -- (c d)
+ TYPE Matrizm IS
+ RECORD
+ A,
+ B,
+ C,
+ D : Float;
+ END RECORD;
+
+ TYPE Estado IS
+ RECORD
+ Origen,
+ Actual : Coordenadas := (0.0, 0.0);
+ Escala : Matrizm := (1.0, 0.0, 0.0, 1.0);
+ Angulo : Float := 0.0;
+ Grosor : Integer := 1;
+ Color : Float := 0.0;
+ END RECORD;
+ --
+ -- origen : origen del sistema
+ -- actual : punto actual
+ -- angulo : radianes que está rotado el sistema
+ -- grosor : grosor de línea
+ -- color : tono de gris
+
+
+ -- pila auxiliar para salvar y recuperar estados gráficos
+ -- necesaria para gsave y grestore
+ PACKAGE Pila_Estado IS NEW Pilas (Tipo_Elemento => Estado);
+
+
+ Ventana : Coordenadas := (800.0, 600.0);
+ Pagina : Coordenadas := (595.0, 895.0);
+ -- Dimensiones del frame y del dibujo respectivamente.
+ F : Frame_Type := Frame (Integer (Ventana.X), Integer (Ventana.Y), "Proyecto Visualizador de Postscript",
+ 'X');
+ -- Título que aparece en la ventana.
+ ------------------------------------------------------------------------
+ -- Frame (Origin, -- create a frame at the specified position
+ -- Width, -- with the specified width
+ -- Height, -- and height in pixels,
+ -- Title, -- with the specified title in the title bar,
+ -- Command, -- generating this command when it is closed,
+ -- Font) -- using this font (default: Default_Font).
+ ------------------------------------------------------------------------
+ Dibujo : Canvas_Type;
+ -- Declaración del frame y del dibujo
+ -- Se asocian a frame todos sus valores iniciales.
+ Status : Estado;
+ -- Estado gráfico del sistema.
+ Showp : Boolean := False;
+ -- Booleano asociado a showpage (si es falso no se muestra la página).
+ Valido : Boolean := True;
+ -- Booleano asociado a la validez del origen para newpath
+ -- sino se declara un origen para empezar un camino newpath
+ -- tendría un origen no valido y se daría el correspondiente error.
+ Path : Coordenadas;
+ -- Coordenadas para empezar un camino con newpath.
+ Pila : Pila_Estado.Pila;
+ Pila_Ini : Boolean := False;
+ Count_Pila : Integer := 0;
+ -- Pila de estados gráficos,
+ -- un booleano que indica si se ha asignado algún valor a la pila o no
+ -- y un contador de los elementos que hay en la pila.
+
+
+ -----------------
+ -- INTERFAZ -----------------------------------------------------------
+ -----------------
+ -----------------------
+ -- Ventanas Error ------------------------------------------------------------
+ -----------------------
+ -- PRE: Cierto
+ -- POST: ventanas de mensaje de error.
+ PROCEDURE Mensaje_Error (
+ S : IN String ) IS
+ BEGIN
+ Show_Error (S, "Visualps: ERROR");
+ END Mensaje_Error;
+
+
+ -- PRE: Cierto,
+ -- POST: Devuelve el punto de origen dentro de Frame donde debería
+ -- aparecer Dibujo para estar centrado.
+ FUNCTION Ajustar_Pagina (
+ F,
+ D : Coordenadas )
+ RETURN Point_Type;
+ FUNCTION Ajustar_Pagina (
+ F,
+ D : Coordenadas )
+ RETURN Point_Type IS
+ P : Point_Type;
+ -- f y d son las dimensiones del Frame y del Dibujo respectivamente.
+ BEGIN
+ IF D.X > F.X THEN
+ P.X := 0;
+ ELSE
+ P.X := Integer ((F.X - D.X) / 2.0);
+ END IF;
+ IF D.Y > F.Y THEN
+ P.Y := 0;
+ ELSE
+ P.Y := Integer ((F.Y - D.Y) / 2.0);
+ END IF;
+ RETURN P;
+ END Ajustar_Pagina;
+
+
+
+ -- PRE: Cierto
+ -- POST: nicia el dibujo en blanco,
+ -- salva este estado y deja de mostrar el dibujo en pantalla.
+ PROCEDURE Iniciar IS
+ -- Opciones del menu raiz
+ M : Menu_Type := Menu (F, "&Archivo");
+ M2 : Menu_Type := Menu (F, "&Mover");
+ M3 : Menu_Type := Menu (F, "&Autores");
+ --------------------------------------------------------------------
+ -- Menu_Type : a menu which can contain menu items and submenus.
+ -- (ver. jewl-windows.ads)
+ ---------------------------------------------------------------------
+ -- submenus encadenados
+ X : Menuitem_Type := Menuitem (M, "&Cerrar", 'X');
+ U : Menuitem_Type := Menuitem (M2, "&Avanzar", 'U');
+ W : Menuitem_Type := Menuitem (M2, "&Cabeza de pagina", 'W');
+ V : Menuitem_Type := Menuitem (M2, "&Retroceder", 'V');
+ Y : Menuitem_Type := Menuitem (M2, "&Avanzar Pagina", 'Y');
+
+ T : Menuitem_Type := Menuitem (M3, "&Roberto López Masiá", 'T');
+ S : Menuitem_Type := Menuitem (M3, "&Andres Gómez Fasbender", 'S');
+
+ R : Menuitem_Type := Menuitem (M3, "&Angel Alferez Aroca", 'R');
+ BEGIN
+ Show (F, True);
+ Dibujo := Canvas (F,
+ Ajustar_Pagina (Ventana, Pagina),
+ Integer (Pagina.X),
+ Integer (Pagina.Y),
+ 'R');
+ Save (Dibujo);
+ Show (Dibujo, False);
+ END Iniciar;
+
+ procedure Limpiar is
+ begin
+ Erase(Dibujo);
+ end Limpiar;
+
+
+ -- PRE: Cierto
+ -- POST: Termina con el frame.
+ PROCEDURE Pclose IS
+ BEGIN
+ Close (F);
+ END Pclose;
+
+ -- PRE: Cierto
+ -- POST: El frame deja de verse en pantalla.
+ -------------------------------------------------------------
+ -- Hide (Window) -- make the window invisible.
+ -- (ver. jewl-windows.ads)
+ -------------------------------------------------------------
+ PROCEDURE Phide IS
+ BEGIN
+ Hide (F);
+ END Phide;
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -- PRE: Se han terminado todas las operaciones en el dibujo
+ -- POST: Se activan el menu del frame y las opciones de desplazar
+ -- el dibujo dentro de frame.
+ PROCEDURE Terminar IS
+ P,
+ Q,
+ O : Point_Type;
+ BEGIN
+ O := (0, 0);
+ Restore (Dibujo);
+ IF NOT Showp THEN
+ Erase (Dibujo);
+ END IF;
+ Show (Dibujo, True);
+ loop
+put_line("bloque grafico");
+ if (Avanzar_Pagina /= 0) then
+ exit;
+ end if;
+ CASE Next_Command IS
+ when 'X' =>
+ terminar_todo := 1;
+ Close (F);
+ EXIT;
+ WHEN 'V' =>
+ P := Start_Point (Dibujo);
+ Q := End_Point (Dibujo);
+ P.Y := Q.Y - 5;
+ O.Y := O.Y + 5;
+ Set_Origin (Dibujo, O);
+ WHEN 'W' =>
+ --p := Start_Point (dibujo);
+ Q := End_Point (Dibujo);
+ --p.X := (400);
+ --p.Y := (400);
+ O.X := (100);
+ O.Y := (0);
+ Set_Origin (Dibujo, O);
+ WHEN 'U' =>
+ P := Start_Point (Dibujo);
+ Q := End_Point (Dibujo);
+ P.Y := Q.Y + 5;
+ O.Y := O.Y - 5;
+ Set_Origin (Dibujo, O);
+ when 'Y' =>
+ --Leer_Postscript_Aux (Entrada, pila, I, Error);
+ Avanzar_Pagina :=1;
+ Erase(Dibujo);
+ delay 0.1;
+ exit;
+
+ WHEN OTHERS =>
+ NULL;
+ END CASE;
+ -- Mover el dibujo con el raton.
+ -- hacemos una traslación del sistema, del punto de origen
+ -- al que se pincha.
+ IF Mouse_Down (Dibujo) THEN
+ P := Start_Point (Dibujo);
+ WHILE Mouse_Down (Dibujo) LOOP
+ NULL;
+ END LOOP;
+ Q := End_Point (Dibujo);
+ P.X := Q.X - P.X;
+ P.Y := Q.Y - P.Y;
+ O.X := O.X + P.X;
+ O.Y := O.Y + P.Y;
+ Set_Origin (Dibujo, O);
+ END IF;
+ end loop;
+ --avanzar_pagina := 0;
+ END Terminar;
+
+
+
+
+ -------------------------------
+ -- Sistema de coordenadas --------------------------------------------------
+ -- A mano (Algebra lineal) --
+ -------------------------------
+
+ -- PRE: Cierto
+ -- POST: Devuelve la matriz que "distorsiona" el espacio según
+ -- en que ángulo y con que escala se haya realizado.
+ FUNCTION Calcularm (
+ E : Escalado )
+ RETURN Matrizm;
+ FUNCTION Calcularm (
+ E : Escalado )
+ RETURN Matrizm IS
+ BEGIN
+ RETURN ((E.X * ((Cos (E.Ang)) ** 2) +
+ E.Y * ((Sin (E.Ang)) ** 2)),
+ ((E.X - E.Y) * Cos (E.Ang) * Sin (E.Ang)),
+ ((E.X - E.Y) * Cos (E.Ang) * Sin (E.Ang)),
+ (E.X * ((Sin (E.Ang)) ** 2) +
+ E.Y * ((Cos (E.Ang)) ** 2)));
+ END Calcularm;
+
+ -- PRE: Cierto
+ -- POST: Devuelve la matriz resultado de multiplicar
+ -- A por B.
+ FUNCTION Multiplicarm (
+ A,
+ B : Matrizm ) RETURN Matrizm;
+ FUNCTION Multiplicarm (
+ A,
+ B : Matrizm ) RETURN Matrizm IS
+ BEGIN
+ RETURN ((A.A * B.A + A.B * B.C),
+ (A.A * B.B + A.B * B.D),
+ (A.C * B.A + A.D * B.C),
+ (A.C * B.B + A.D * B.D));
+ END Multiplicarm;
+
+ -- PRE: Cierto
+ -- POST: Devuelve las coordenadas del punto p si rotamos
+ -- el sistema (status.angulo) radianes.
+ FUNCTION Pos (
+ P : Coordenadas )
+ RETURN Coordenadas;
+ FUNCTION Pos (
+ P : Coordenadas )
+ RETURN Coordenadas IS
+ BEGIN
+ RETURN ((P.X * Cos (Status.Angulo) - P.Y * Sin (Status.Angulo)),
+ (P.X * Sin (Status.Angulo) + P.Y * Cos (Status.Angulo)));
+ END Pos;
+
+ -- PRE: Cierto
+ -- POST: Aplica la matriz status.escala al punto p para obtener
+ -- las coordenadas de ese punto en el sistema actual.
+ FUNCTION Mover (
+ P : Coordenadas )
+ RETURN Coordenadas;
+
+ FUNCTION Mover (
+ P : Coordenadas )
+ RETURN Coordenadas IS
+ BEGIN
+ RETURN ((Status.Escala.A * P.X + Status.Escala.B * P.Y),
+ (Status.Escala.C * P.X + Status.Escala.D * P.Y));
+ END Mover;
+
+ -- PRE: Cierto
+ -- POST: Devuelve las coordenadas del punto una vez que se le han aplicado
+ -- todas las translaciones, movimientos y cambios de escala asociados
+ -- al sistema de coordenadas actual.
+ FUNCTION Ajustar (
+ P : Coordenadas )
+ RETURN Coordenadas;
+ FUNCTION Ajustar (
+ P : Coordenadas )
+ RETURN Coordenadas IS
+ Q : Coordenadas;
+ BEGIN
+ Q := Pos (P);
+ Q := Mover (Q);
+ Q.X := Q.X + Status.Origen.X;
+ Q.Y := Pagina.Y - (Q.Y + Status.Origen.Y);
+ RETURN Q;
+ END Ajustar;
+
+ -- PRE: Cierto
+ -- POST: Devuelve el punto p en formato (Int, Int).
+ FUNCTION Fint (
+ P : Coordenadas )
+ RETURN Point_Type;
+ FUNCTION Fint (
+ P : Coordenadas )
+ RETURN Point_Type IS
+ BEGIN
+ RETURN (Integer (P.X), Integer (P.Y));
+ END Fint;
+
+ -- PRE: Cierto
+ -- POST: Devuelve la suma de las coordenadas de dos puntos.
+ FUNCTION Sumar (
+ A,
+ B : Coordenadas )
+ RETURN Coordenadas;
+ FUNCTION Sumar (
+ A,
+ B : Coordenadas )
+ RETURN Coordenadas IS
+ BEGIN
+ RETURN (A.X + B.X, A.Y + B.Y);
+ END Sumar;
+
+ -- PRE: Cierto
+ -- POST: Devuelve el tono de gris asociado a n.
+ FUNCTION Colorear (
+ N : Float )
+ RETURN Colour_Type;
+ FUNCTION Colorear (
+ N : Float )
+ RETURN Colour_Type IS
+ Aux : Float;
+ BEGIN
+ Aux := N;
+ IF N >= 1.0 THEN
+ Aux := 1.0;
+ END IF;
+ IF N <= 0.0 THEN
+ Aux := 0.0;
+ END IF;
+ RETURN (Integer (255.0 * Aux),
+ Integer (255.0 * Aux),
+ Integer (255.0 * Aux));
+ END Colorear;
+
+
+ -----------------------------
+ -- Construcción de caminos --------------------
+ ------------------------------
+
+ -- PRE: Cierto
+ -- POST: Valido pasa a ser falso.
+ -- Esta condición se estudiará para poner origen a newpath.
+ -- Restaura el dibujo a su estado anterior, si el anterior camino
+ -- no tenía un stroke no se mostrará en dibujo
+ PROCEDURE New_Path IS
+ BEGIN
+ Restore (Dibujo);
+ Valido := False;
+ END New_Path;
+
+ -- PRE: Cierto
+ -- POST: Pone actual en (a,b)
+ -- Si valido es falso, inicia el camino (path) en (a,b).
+ PROCEDURE Moveto (
+ A,
+ B : IN Float ) IS
+ BEGIN
+ IF Valido = False THEN
+ Path := (A, B);
+ Valido := True;
+ END IF;
+ Status.Actual := (A, B);
+ END Moveto;
+
+ -- PRE: Cierto
+ -- POST: Pone actual en actual + (a,b).
+ PROCEDURE Rmoveto (
+ A,
+ B : IN Float;
+ Error : OUT Boolean ) IS
+ BEGIN
+ IF Valido = False THEN
+ Error := True;
+ ELSE
+ Status.Actual := Sumar (Status.Actual, (A, B));
+ Error := False;
+ END IF;
+ END Rmoveto;
+
+ -- PRE: Cierto
+ -- POST: Da un error si se ha iniciado un nuevo camino
+ -- pero este todavía no tiene origen.
+ -- Si el origen es valido pinta una linea en dibujo
+ -- desde actual hasta (a,b).
+ PROCEDURE Lineto (
+ A,
+ B : IN Float;
+ Error : OUT Boolean ) IS
+ BEGIN
+ Set_Pen (Dibujo, Colorear (Status.Color), Status.Grosor);
+ IF Valido = False THEN
+ Error := True;
+ ELSE
+ Draw_Line (Dibujo, Fint (Ajustar (Status.Actual)),
+ Fint (Ajustar ((A, B))));
+ Status.Actual := (A, B);
+ Error := False;
+ END IF;
+ END Lineto;
+
+ -- PRE: Cierto
+ -- POST: Da un error si se ha iniciado un nuevo camino
+ -- pero este todavía no tiene origen.
+ -- Si el origen es valido pinta una linea en dibujo
+ -- desde actual hasta actual + (a,b).
+ PROCEDURE Rlineto (
+ A,
+ B : IN Float;
+ Error : OUT Boolean ) IS
+ BEGIN
+ Set_Pen (Dibujo, Colorear (Status.Color), Status.Grosor);
+ IF Valido = False THEN
+ Error := True;
+ ELSE
+ Draw_Line (Dibujo, Fint (Ajustar (Status.Actual)),
+ Fint (Ajustar (Sumar (Status.Actual, (A, B)))));
+ Status.Actual := Sumar (Status.Actual, (A, B));
+ Error := False;
+ END IF;
+ END Rlineto;
+
+ -- PRE: Cierto
+ -- POST: Si hay un origen valido de un camino iniciado por newpath
+ -- traza una linea desde actual hasta path en dibujo.
+ -- Si no hay un origen valido pone valido a True para
+ -- poder iniciar otros caminos más adelante.
+ PROCEDURE Close_Path IS
+ BEGIN
+ IF Valido = False THEN
+ Valido := True;
+ ELSE
+ Draw_Line (Dibujo, Fint (Ajustar (Status.Actual)),
+ Fint (Ajustar (Path)));
+ Status.Actual := Path;
+ END IF;
+ END Close_Path;
+
+ -----------------------------
+ -- Operadores de pintado --------------------
+ ----------------------------
+ -- PRE: Cierto
+ -- POST: Pone status.color con el tono de gris correspondiente
+ PROCEDURE Set_Gray (
+ A : IN Float ) IS
+ BEGIN
+ Status.Color := A;
+ END Set_Gray;
+
+ -- PRE: Cierto
+ -- POST: Pone status.grosor con el grosor correspondiente.
+ PROCEDURE Set_Width (
+ A : IN Float ) IS
+ BEGIN
+ Status.Grosor := Integer (A);
+ END Set_Width;
+
+ -- PRE: Cierto
+ -- POST: Se salva el dibujo actual
+ PROCEDURE Stroke IS
+ BEGIN
+ Save (Dibujo);
+ END Stroke;
+
+ ----------------------
+ -- Mostrar imagen -------------------------
+ -----------------------
+ -- PRE: Cierto
+ -- POST: El booleano showp pasa a ser True, la página se imprimirá
+ -- en pantalla
+ PROCEDURE Showpage IS
+ begin
+ --limpiar;-----------------------------------------------------------------------------------------------------------------------NUEVO EN PRUEBAS
+ Showp := True;
+ END Showpage;
+
+ -- PRE: Cierto
+ -- POST: El booleano showp pasa a ser True, la página se imprimirá
+ -- en pantalla
+ -- texto
+ PROCEDURE Chow (
+ S : IN String ) IS
+ begin
+
+ Restore (Dibujo);
+ Draw_Text (Dibujo,
+ Fint (Ajustar (Status.Actual)),
+ S);
+ Save (Dibujo);
+ END Chow;
+ -------------------
+ -- Movimientos --------------------------------------------------
+ --------------------
+ -- PRE: Cierto
+ -- POST: Pone el origen del sistema en (a,b)
+ -- actual también se mueve a esa posición.
+ PROCEDURE Translate (
+ A,
+ B : IN Float ) IS
+ BEGIN
+ Status.Origen := (A, B);
+ Status.Actual := (0.0, 0.0);
+ END Translate;
+
+ -- PRE: Cierto
+ -- POST: Rota el sistema a radianes segun el dato a
+ PROCEDURE Rotate (
+ A : IN Float ) IS
+ BEGIN
+ Status.Angulo := Status.Angulo + ((A / 180.0) * Pi);
+ IF Status.Angulo > (2.0 * Pi) THEN
+ Status.Angulo := Status.Angulo - (2.0 * Pi);
+ END IF;
+ END Rotate;
+
+ -- PRE: Cierto
+ -- POST: Realiza un escalado sobre el sistema
+ -- Calcula la nueva matriz (status.escala)
+ -- que distorsiona el espacio
+ PROCEDURE Scale (
+ A,
+ B : IN Float ) IS
+ BEGIN
+ Status.Escala := Multiplicarm (Status.Escala,
+ Calcularm ((A, B, Status.Angulo)));
+ END Scale;
+ ---------------------------------------
+ -- Manejo de la pila Estados Gráficos -------------------
+ ---------------------------------------
+ -- PRE: Cierto
+ -- POST: Salva el estado gráfico en la pila de estados gráficos.
+ PROCEDURE Gsave IS
+ BEGIN
+ IF NOT Pila_Ini THEN
+ Pila_Estado.Crear_Vacia (Pila);
+ Pila_Ini := True;
+ END IF;
+ Pila_Estado.Apilar (Pila, Status);
+ Count_Pila := Count_Pila + 1;
+ END Gsave;
+
+ -- PRE: Cierto
+ -- POST: Restaura el último estado gráfico guardado
+ -- Si la pila de estados gráficos esta vacía
+ -- se genera el error correspondiente.
+ PROCEDURE Grestore (
+ Error : OUT Boolean ) IS
+ BEGIN
+ IF Count_Pila = 0 THEN
+ Error := True;
+ ELSE
+ Pila_Estado.Cima (Pila, Status);
+ Pila_Estado.Desapilar (Pila);
+ Count_Pila := Count_Pila - 1;
+ Error := False;
+ END IF;
+ END Grestore;
+
+ -- PRE: Se ha terminado de dibujar el archivo postscript
+ -- POST: Destruye la pila de estados gráficos
+ PROCEDURE Destruir_St IS
+ BEGIN
+ Pila_Estado.Destruir (Pila);
+ END Destruir_St;
+
+END Bloque_Grafico;
104 Codigo/bloque_grafico.ads
@@ -0,0 +1,104 @@
+-------------------------------------------------------------------------
+-- Visualizador de Ficheros PostScript --
+-------------------------------------------------------------------------
+-- 010248; Roberto López Masiá; roberto.lopez.masia@hotmail.com --
+-- 040289; Andres Gómez Fasbender; fass_centauri@hotmail.com --
+-- 050007; Ángel Alférez Aroca; alferez.aroca@gmail.com --
+-------------------------------------------------------------------------
+--
+--
+-- Descripción:
+-- Bloque que contiene las operaciones gráficas del proyecto (librería gráfica JEWL)
+-- Crea la interfaz de usuario y visualiza el dibujo postscript.
+-- Traduce las operaciones del fichero postscript.
+-- Contiene todas las operaciones del sistema de coordenadas.
+--
+-- -------------------------------------------------------------------------
+package bloque_grafico is
+ Avanzar_Pagina : Natural :=0;
+ Terminar_Todo : Natural := 0;
+
+ procedure iniciar;
+-- Muestra el interfaz gráfico en pantalla, inicia la visualización del
+-- fichero postscript en blanco, salva este estado y deja de mostrarlo en
+-- pantalla.
+
+ procedure limpiar;
+
+ procedure pclose;
+-- Cierra el interfaz gráfico
+
+ procedure phide;
+-- Oculta el interfaz gráfico
+--procedure terminar_aux;
+ procedure terminar;
+-- PRE: Se han terminado todas las operaciones en el dibujo
+-- POST: Se activan el menu del interfaz gráfico y las opciones de
+-- desplazar la página visualizada.
+
+ procedure Mensaje_Error (S : in String);
+-- Muestra un mensaje de error en pantalla.
+
+ procedure new_path;
+-- Inicia un nuevo camino y se espera que se establezca un origen
+-- para dicho camino
+
+ procedure moveto (a, b : in Float);
+-- Mueve sin trazar hasta (a,b) si no había un origen definido
+-- para newpath se establece uno.
+
+ procedure rmoveto (a, b : in Float; error : out Boolean);
+-- Mueve sin trazar hasta actual + (a,b). Si aparece dentro de un
+-- newpath sin origen definido la salida error será True.
+
+ procedure lineto (a, b : in Float; error : out Boolean);
+-- Mueve trazando una linea desde actual hasta (a,b)
+-- Si aparece dentro de un newpath sin origen definido
+-- la salida error será True.
+
+ procedure rlineto (a, b : in Float; error : out Boolean);
+-- Mueve trazando una linea desde actual hasta actual + (a,b)
+-- Si aparece dentro de un newpath sin origen definido
+-- la salida error será True.
+
+ procedure close_path;
+-- Cierra el último newpath trazando una línea
+
+ procedure set_gray (a : in Float);
+-- Establece el tono de gris con el que se pintarán las
+-- siguientes líneas.
+
+ procedure set_width (a : in Float);
+-- Establece el grosor con el que se pintarán las
+-- siguientes líneas.
+
+ procedure stroke;
+-- Salva el último camino pintado en el dibujo
+
+ procedure showpage;
+-- La visualización del archivo postscript se mostrará en pantalla
+
+ procedure chow (S : in String);
+-- Muestra la cadena String en el punto actual
+
+ procedure translate (a, b : in Float);
+-- Pone el origen del sistema en (a,b)
+-- actual también se mueve a esa posición.
+
+ procedure rotate (a : in Float);
+-- Rota el sistema a radianes
+
+ procedure scale (a, b : in Float);
+-- Cambia la escala actual del sistema
+
+ procedure gsave;
+-- Salva el estado gráfico en la pila de estados gráficos.
+
+ procedure grestore (error : out Boolean);
+-- Restaura el último estado gráfico guardado
+-- Si la pila de estados gráficos esta vacía error = True
+
+ procedure destruir_st;
+-- Destruye la pila de estados gráficos
+
+end bloque_grafico;
211 Codigo/bloque_preparar_operador.adb
@@ -0,0 +1,211 @@
+-------------------------------------------------------------------------
+-- Visualizador de Ficheros PostScript --
+-------------------------------------------------------------------------
+-- 010248; Roberto López Masiá; roberto.lopez.masia@hotmail.com --
+-- 040289; Andres Gómez Fasbender; fass_centauri@hotmail.com --
+-- 050007; Ángel Alférez Aroca; alferez.aroca@gmail.com --
+-------------------------------------------------------------------------
+--
+-- Descripción:
+--
+-- Este módulo exporta el tipo iterador_elementos y todos los tipos
+-- necesarios para su especificación. Contiene operaciones auxiliares
+-- para el módulo de procesado: reconocimiento de datos extraidos del
+-- fichero postscript y construcción de iteradores. Es el encargado de
+-- la tabla de definiciones y exporta las operaciones necesarias para
+-- guardar información en esta tabla.
+----------------------------------------------------------------------------
+
+WITH Tablas;
+-- Cargamos las tablas vistas en clase (tablas hush)
+
+PACKAGE BODY Bloque_Preparar_Operador IS
+
+ -- PRE: Cierto
+ -- POST: devuelve cierto si a y b contienen la misma información
+ FUNCTION Iguales (A,B : IN Dato ) RETURN Boolean;
+ FUNCTION Iguales (A,B : IN Dato ) RETURN Boolean IS
+ BEGIN
+ RETURN A.Pal (1 .. A.Long) = B.Pal (1 .. B.Long) AND
+ A.Long = B.Long;
+ END Iguales;
+
+ -- Tamaño de la tabla
+ Tamano_Tabla : Integer := 30;
+
+ -- Instanciación de la tabla
+ PACKAGE Tabla_Elementos IS NEW Tablas (
+ Tipo_Clave => Dato,
+ Tipo_Informacion => Iterador_Elementos.Iterador,
+ Igualdad => Iguales,
+ Destruir => Iterador_Elementos.Destruir,
+ Asignacion => Iterador_Elementos.Asignar,
+ Tamano => Tamano_Tabla);
+
+ -- Se crea la tabla de definiciones como variable global
+ Tabla : Tabla_Elementos.Tabla;
+
+ -- PRE: Cierto
+ -- POST: Da un valor inicial a la tabla de definiciones
+ PROCEDURE Iniciar_Tabla IS
+ BEGIN
+ Tabla_Elementos.Crear_Vacia (Tabla);
+ END Iniciar_Tabla;
+
+ -- PRE: Cierto
+ -- POST: Destruye la tabla de definiciones
+ PROCEDURE Borrar_Tabla IS
+ BEGIN
+ Tabla_Elementos.Destruir_Tabla (Tabla);
+ END Borrar_Tabla;
+
+ -- PRE: Cierto
+ -- POST: Guarda la información i con la clave name (1..n)
+ -- en la tabla de definiciones
+ PROCEDURE Guardar (
+ I : IN Iterador_Elementos.Iterador;
+ Name : IN String;
+ N : IN Integer ) IS
+ D : Dato;
+ BEGIN
+ D.Pal (1 .. N) := Name (1 .. N);
+ D.Long := N;
+ Tabla_Elementos.Almacenar (Tabla, D, I);
+ END Guardar;
+
+ -- PRE: la clave name, se encuentra en la tabla
+ -- POST: Devuelve la información asociada a la clave name
+ FUNCTION Consultar (
+ Name : Dato )
+ RETURN Iterador_Elementos.Iterador IS
+ BEGIN
+ RETURN Tabla_Elementos.Consulta (Tabla, Name);
+ END Consultar;
+
+ -- PRE: Cierto
+ -- POST: La clave d se encuentra en la tabla
+
+ -- para buscar las posibles definiciones ya alamcenadas
+ FUNCTION Es_Def (
+ D : Dato )
+ RETURN Boolean IS
+ BEGIN
+ RETURN Tabla_Elementos.Esta (Tabla, D);
+ END Es_Def;
+
+ -- PRE: Cierto
+ -- POST: Devuelve cierto si el string contenido en d
+ -- es un número
+ FUNCTION Es_Numero (
+ D : Dato )
+ RETURN Boolean IS
+ Y : Boolean := True;
+ BEGIN
+ IF D.Long = 0 THEN
+ Y := False;
+ END IF;
+ FOR I IN 1 .. D.Long LOOP
+ IF D.Pal (I) = '.' OR D.Pal (I) = '-' THEN
+ NULL;
+ ELSE
+ IF NOT (D.Pal (I) >= '0' AND D.Pal (I) <= '9') THEN
+ Y := False;
+ EXIT;
+ END IF;
+ END IF;
+ END LOOP;
+ RETURN Y;
+ END Es_Numero;
+
+ -- PRE: es_numero (d)
+ -- POST: Devuelve el valor en coma flotante que representa d
+ -- Nos toca transformas el dato en coma flotante para operar
+ -- con al procesarlo posteriormente.
+ FUNCTION Valor (
+ D : Dato )
+ RETURN Float IS
+ Neg,
+ Decimal : Boolean := False;
+ Cifras : Integer := 0;
+ K : Integer := 1;
+ Aux : Integer;
+ Tmp : Float := 0.0;
+ BEGIN
+ FOR Z IN 1 .. D.Long LOOP
+ IF D.Pal (Z) = '-' THEN
+ Neg := True;
+ ELSE
+ IF D.Pal (Z) = '.' THEN
+ EXIT;
+ ELSE
+ Cifras := Cifras + 1;
+ END IF;
+ END IF;
+ END LOOP;
+ IF Neg = True THEN
+ K := 2;
+ END IF;
+ FOR Z IN K .. D.Long LOOP
+ IF D.Pal (Z) = '.' THEN
+ Decimal := True;
+ Cifras := 1;
+ END IF;
+ IF Decimal = False THEN
+ Aux := Character'Pos (D.Pal (Z)) - Character'Pos ('0');
+ Tmp := Tmp + Float (Aux * (10 ** (Cifras - 1)));
+ Cifras := Cifras - 1;
+ END IF;
+ IF Decimal = True AND D.Pal (Z) /= '.' THEN
+ Aux := Character'Pos (D.Pal (Z)) - Character'Pos ('0');
+ Tmp := Tmp + (Float (Aux) / Float (10 ** Cifras));
+ Cifras := Cifras + 1;
+ END IF;
+ END LOOP;
+ IF Neg = True THEN
+ Tmp := Tmp * (-1.0);
+ END IF;
+ RETURN Tmp;
+ END Valor;
+
+ -- PRE: Cierto
+ -- POST: Devuelve cierto si la información contenida en d
+ -- corresponde al string s
+ FUNCTION Match (
+ D : Dato;
+ S : String )
+ RETURN Boolean IS
+ Z : Boolean := True;
+ BEGIN
+ IF D.Long = 0 OR (D.Long /= S'Length) THEN
+ RETURN False;
+ END IF;
+ FOR I IN 1 .. D.Long LOOP
+ IF D.Pal (I) /= S (I) THEN
+ Z := False;
+ EXIT;
+ END IF;
+ END LOOP;
+ RETURN Z;
+ END Match;
+
+ -- PRE: Cierto
+ -- POST: Introduce el elemento correspondiente a data en el iterador
+ -- segun el tipo que sea (case)
+ PROCEDURE Introducir (
+ Data : IN Dato;
+ I : IN OUT Iterador_Elementos.Iterador ) IS
+ BEGIN
+
+ IF Es_Numero (Data) THEN
+ Iterador_Elementos.Insertar_Dato ((Operando, Valor (Data)), I);
+
+ ELSIF Es_Def (Data) THEN
+ Iterador_Elementos.Insertar_Dato ((Definicion, Data), I);
+
+ ELSE
+ Iterador_Elementos.Insertar_Dato ((Operador, Data), I);
+ END IF;
+
+ END Introducir;
+
+END Bloque_Preparar_Operador;
129 Codigo/bloque_preparar_operador.ads
@@ -0,0 +1,129 @@
+-------------------------------------------------------------------------
+-- Visualizador de Ficheros PostScript --
+-------------------------------------------------------------------------
+-- 010248; Roberto López Masiá; roberto.lopez.masia@hotmail.com --
+-- 040289; Andres Gómez Fasbender; fass_centauri@hotmail.com --
+-- 050007; Ángel Alférez Aroca; alferez.aroca@gmail.com --
+-------------------------------------------------------------------------
+--
+-- Descripción:
+--
+-- Este módulo exporta el tipo iterador_elementos y todos los tipos
+-- necesarios para su especificación. Contiene operaciones auxiliares
+-- para el módulo de procesado: reconocimiento de datos extraidos del
+-- fichero postscript y construcción de iteradores. Es el encargado de
+-- la tabla de definiciones y exporta las operaciones necesarias para
+-- guardar información en esta tabla.
+----------------------------------------------------------------------------
+
+WITH Iteradores;
+PACKAGE Bloque_Preparar_Operador IS
+
+ -------------------------------
+ -- Tipos para el Iterador ----------------------------------------------
+ -------------------------------
+
+ -- Dato que se recogerá del fichero, long es el número de caracteres
+ -- que tiene.
+ TYPE Dato IS
+ RECORD
+ Pal : String (1 .. 20);
+ Long : Integer := 0;
+ END RECORD;
+
+ -- Texto que se recogerá del fichero
+ TYPE Texto IS
+ RECORD
+ Txt : String (1 .. 90);
+ Long : Integer:= 0;
+ END RECORD;
+
+ -- tipos posibles dentro de nuestro operador (iteradores)
+ TYPE Objeto IS (Operador, Operando, Definicion, Text, Ninguno);
+
+ -- Hacemos un registro variable con los operadores y
+ -- lo que sería sus traducción palabra, numero, nada ...
+ -- Con todo esta información podemos almacenar las definiciones
+ -- del fichero postscript para luego poder almacenarlo en la tabla
+ TYPE Elemento
+ (Tipo : Objeto := Ninguno) IS
+ RECORD
+ CASE Tipo IS
+ WHEN Operador =>
+ Dat : Dato;
+ WHEN Operando =>
+ Num : Float;
+ WHEN Definicion =>
+ Def : Dato;
+ WHEN Text =>
+ Tx : Texto;
+ WHEN Ninguno =>
+ NULL;
+ END CASE;
+ END RECORD;
+
+ PACKAGE Iterador_Elementos IS NEW Iteradores (Tipo_Elemento => Elemento);
+ -- Creamos nuestros iteradores de registros variables (elementos)
+ -- pudiendo almacenar cualquier informacion en nuestros iteradores
+
+ ----------------------------------
+ -- Operaciones sobre la tabla ----------------------------------------------
+ ----------------------------------
+
+ PROCEDURE Iniciar_Tabla;
+ -- PRE:Cierto
+ -- POST: Inicializar tabla vacía
+ PROCEDURE Borrar_Tabla;
+ -- Destruye todos los elementos de la tabla
+ FUNCTION Consultar (
+ Name : Dato )
+ RETURN Iterador_Elementos.Iterador;
+ -- PRE: El dato debe estar en la tabla.
+ -- POST: Devuelve la información asociada a la clave que se consulta
+
+ PROCEDURE Guardar (
+ I : IN Iterador_Elementos.Iterador;
+ Name : IN String;
+ N : IN Integer
+ );
+
+ -- PRE:Cierto (depende del TAD tablas que usemos)
+ -- POST: Inicializar tabla vacía
+ -- Almacena en la tabla la clave (name, n) y la información asociada
+ -- (el iterador i)
+
+
+
+ FUNCTION Es_Def (
+ D : Dato )
+ RETURN Boolean;
+ -- Devuelve cierto si d es una clave almacenada en la tabla
+
+ FUNCTION Es_Numero (
+ D : Dato )
+ RETURN Boolean;
+ -- Devuelve cierto si el string que contiene d
+ -- contiene información numérica
+ -- Por ejemplo sería True si d fuera ("-300.27....", 7)
+
+ FUNCTION Valor (
+ D : Dato )
+ RETURN Float;
+ -- PRE: es_numero (d)
+ -- POST: Devuelve el valor de d como un Float
+
+ FUNCTION Match (
+ D : Dato;
+ S : String )
+ RETURN Boolean;
+ -- Devuelve cierto si la información que contiene d
+ -- coincide con el string s
+ -- (palabras clave )Por ejemplo sería True si d fuera ("rotate....", 16)
+
+ PROCEDURE Introducir (
+ Data : IN Dato;
+ I : IN OUT Iterador_Elementos.Iterador );
+ -- Introduce el elemento correspondiente a data en el iterador i
+
+
+END Bloque_Preparar_Operador;
1,334 Codigo/bloque_principal.adb
@@ -0,0 +1,1334 @@
+-------------------------------------------------------------------------
+-- Visualizador de Ficheros PostScript --
+-------------------------------------------------------------------------
+-- 010248; Roberto López Masiá; roberto.lopez.masia@hotmail.com --
+-- 040289; Andres Gómez Fasbender; fass_centauri@hotmail.com --
+-- 050007; Ángel Alférez Aroca; alferez.aroca@gmail.com --
+-------------------------------------------------------------------------
+-- Este módulo exporta dos procedimientos que sirven para ocultar o cerrar
+-- la ventana destinada a la visualización del archivo postscript.
+--
+-- Su principal función es leer el fichero postscript cogiendo elemento
+-- a elemento evaluando cada uno y llevando a cabo la acción correspondiente.
+-- -------------------------------------------------------------------------
+
+with Bloque_Grafico;
+use Bloque_Grafico;
+--WITH JEWL.Simple_Windows;
+--USE JEWL.Simple_Windows;
+with Bloque_Preparar_Operador;
+use Bloque_Preparar_Operador;
+with Ada.Text_Io;
+use Ada.Text_Io;
+with Pilas;
+with Ada.Unchecked_Deallocation;
+
+package body Bloque_Principal is
+
+
+ -- ***********************************************************************
+ -- ----------------- Declaración de tipos para la pila -------------------
+ -- ***********************************************************************
+
+ type Puntero_Codigo is access Iterador_Elementos.Iterador;
+ -- Puntero a Iterador
+
+ procedure Libera_Puntero is
+ new Ada.Unchecked_Deallocation (
+ Object => Iterador_Elementos.Iterador,
+ Name => Puntero_Codigo);
+ -- Procedimiento para liberar Puntero_Iterador
+
+ type Objeto_Pila is
+ (Operando_Pila,
+ Codigo,
+ Bool_Pila,
+ Palabra_Pila,
+ Ninguno);
+
+
+ -- Tipos que se podrán encontrar en la pila
+ -- Definicion de la pila y de los tipos que se almacenan en ella (de forma similar a ITERADOR)
+
+ type Elemento_Pila
+ (Tipo : Objeto_Pila := Ninguno) is
+ record
+ case Tipo is
+ when Operando_Pila =>
+ Num : Float;
+ when Codigo =>
+ Cod : Puntero_Codigo := null;
+ when Bool_Pila =>
+ Bool : Boolean;
+ when Palabra_Pila =>
+ Pal : Texto;
+ when Ninguno =>
+ null;
+ end case;
+ end record;
+ -- Elemento_Pila es un registro variante, según que tipo tendremos
+ -- un campo distinto
+
+ package Pila_Elementos is new Pilas (Tipo_Elemento => Elemento_Pila);
+
+ -- PRE: Cierto z es el último caracter de la palabra cogida anteriormente
+ -- POST: Coge del fichero el siguiente elemento significativo del archivo
+ -- postscript. Omite los comentarios
+ --
+ -- DATO => Pal:string X long:Natural
+
+ procedure Coger (
+ Fichero : in out File_Type;
+ A : in out Dato;
+ Z : in out Character );
+ procedure Coger (
+ Fichero : in out File_Type;
+ A : in out Dato;
+ Z : in out Character ) is
+
+ C : Character := ' ';
+ Termina : Boolean := False;
+
+ begin
+ A.Long := 0;
+
+ -- Evaluamos el caracter "z" de entrada si "z"= { or} then a=["{",1] or a=["}", 1]
+ if Z = '}' or Z = '{' then
+ Termina := True;
+ A.Long := 1;
+ A.Pal (1) := Z;
+ C := '?';
+ Z := '?';
+ end if;
+
+ -- Saltamos los espacios en blanco
+ while not End_Of_File (Fichero) and C = ' ' loop
+ Get (Fichero, C);
+ end loop;
+ loop
+ -- Si encontramos un comentario, eliminamos toda la linea
+ if C = '%' then
+ while not End_Of_File (Fichero) and
+ not End_Of_Line (Fichero) loop
+ Get (Fichero, C);
+ end loop;
+ if End_Of_File (Fichero) then
+ Termina := True;
+ exit;
+ else
+ Get (Fichero, C);
+ end if;
+ else
+ exit;
+ end if;
+ end loop;
+ -- Sino es un comentario sera un elemento util
+ while (C /= ' ') and (Termina = False) loop
+ A.Long := A.Long + 1;
+ A.Pal (A.Long) := C;
+ if End_Of_Line (Fichero) or End_Of_File (Fichero) or C = '{'
+ or C = '/' or C = '}' or C = '(' then
+ Termina := True;
+ else
+ Get (Fichero, C);
+ Z := C;
+ end if;
+ if C = '}' or C = '{' then
+ Termina := True;
+ end if;
+ end loop;
+
+ end Coger;
+
+
+ -- PRE: Nos hemos encontrado un '(' en el fichero
+ -- POST: Coge una cadena de caracteres del fichero
+ -- hasta encontrarse un ')'
+
+ --recordatorio: TEXTO=[Tx:String, Long:Natural]
+
+ procedure Coger_Txt (
+ Fichero : in out File_Type;
+ A : in out Texto );
+ procedure Coger_Txt (
+ Fichero : in out File_Type;
+ A : in out Texto ) is
+ C : Character := '?';
+ begin
+ A.Long := 0;
+ loop
+ Get (Fichero, C);
+ if C = ')' then
+ exit;
+ else
+ A.Long := A.Long + 1;
+ A.Txt (A.Long) := C;
+ end if;
+ end loop;
+ end Coger_Txt;
+
+ -- PRE: Cierto
+ -- POST: Cierra el frame iniciado en el modulo de pintado
+ procedure Cerrar is
+ begin
+ Pclose;
+ end Cerrar;
+
+ -- PRE: Cierto
+ -- POST: Oculta el frame iniciado en el modulo de pintado
+ procedure Ocultar is
+ begin
+ Phide;
+ end Ocultar;
+
+ -- PRE: Data no es ni un operador de control ni una definición
+ -- POST: Procesa la información de data, si es un operando lo introduce
+ -- en la pila, si es un operador este se evalua y se toman
+ -- (y se dejan) los argumentos necesarios de la pila.
+ -- Si ha existido algún error durante el proceso se da un valor
+ -- a numerror distinto de cero.
+ -- Los posibles valores son :
+ --
+ -- 0 No hay error.
+ -- 1 Se ha encontrado un dato inválido
+ -- no es un operando ni un operador postscript.
+ -- 2 Intento de acceder a una pila vacía.
+ -- 3 Se encontraron operandos de tipo inesperado.
+ -- 4 Se intenta trazar un camino nuevo sin haber establecido origen.
+ -- 5 Se intenta acceder a la pila de estados gráficos cuando esta vacía.
+ procedure Procesar (
+ Data : in Dato;
+ Pila : in out Pila_Elementos.Pila;
+ Numerror : out Integer );
+ procedure Procesar (
+ Data : in Dato;
+ Pila : in out Pila_Elementos.Pila;
+ Numerror : out Integer ) is
+ Elem1,
+ Elem2 : Elemento_Pila;
+ Errorp : Boolean;
+ Count : Integer;
+ begin
+ --Sacamos el numero de elementos que tiene la pila
+ Count := Pila_Elementos.Num_Elementos (Pila);
+ --inicializamos numerror como 0 (sin errores)
+ Numerror := 0;
+ if Data.Long = 0 then
+ null;
+ --si DATA es un numero, lo apilamos
+ elsif Es_Numero (Data) then
+ Elem1 := (Operando_Pila, Valor (Data));
+ Pila_Elementos.Apilar (Pila, Elem1);
+ --si el texto contenido en DATA es "newpath" salto a la funcion newpath
+ elsif Match (Data, "newpath") then
+ New_Path;
+ --moveto necesita 2 paramtros, por lo que en la pila debe haber camo minimo 2 elementos
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien procesamos moveto
+ elsif Match (Data, "moveto") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Moveto (Elem2.Num, Elem1.Num);
+ end if;
+ end if;
+ -- rmoveto necesita 2 paramtros, por lo que en la pila debe haber camo minimo 2 elementos
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien procesamos rmoveto (que puede dar error), si rmoveto a generado
+ --error---> "errorp=TRUE", tendremos un error 4
+ elsif Match (Data, "rmoveto") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Rmoveto (Elem2.Num, Elem1.Num, Errorp);
+ if Errorp then
+ Numerror := 4;
+ end if;
+ end if;
+ end if;
+ --lineto necesita 2 paramtros, por lo que en la pila debe haber camo minimo 2 elementos
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien procesamos lineto (que puede dar error), si lineto a generado
+ --error---> "errorp=TRUE", tendremos un error 4
+ elsif Match (Data, "lineto") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Lineto (Elem2.Num, Elem1.Num, Errorp);
+ if Errorp then
+ Numerror := 4;
+ end if;
+ end if;
+ end if;
+ --rlineto necesita 2 paramtros, por lo que en la pila debe haber camo minimo 2 elementos
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien procesamos rlineto (que puede dar error), si rlineto a generado
+ --error---> "errorp=TRUE", tendremos un error 4
+ elsif Match (Data, "rlineto") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Rlineto (Elem2.Num, Elem1.Num, Errorp);
+ if Errorp then
+ Numerror := 4;
+ end if;
+ end if;
+ end if;
+ --si el texto contenido de DATA coincide con "closepath" procesamos closepath
+ elsif Match (Data, "closepath") then
+ Close_Path;
+ --si el texto contenido de DATA coincide con "stroke" procesamos stroke
+ elsif Match (Data, "stroke") then
+ Stroke;
+ --rotate necesita 1 paramtro, por lo que en la pila debe haber camo minimo 1 elemento
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien procesamos rotate
+ elsif Match (Data, "rotate") then
+ if Count < 1 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Rotate (Elem1.Num);
+ end if;
+ end if;
+ --scale necesita 2 paramtros, por lo que en la pila debe haber camo minimo 2 elementos
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien procesamos scale
+ elsif Match (Data, "scale") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Scale (Elem2.Num, Elem1.Num);
+ end if;
+ end if;
+ --show necesita 1 paramtro, por lo que en la pila debe haber camo minimo 1 elemento
+ --sino error 2; teniendo que ser éstos de tipo "palabra_pila", sino Error 3, en caso
+ --de que todo vaya bien procesamos chow (lo llamamos asi, porque "show" es palablra
+ --reservada del lenguaje ADA)
+ elsif Match (Data, "show") then
+ if Count < 1 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Palabra_Pila then
+ Numerror := 3;
+ else
+ Chow (Elem1.Pal.Txt (1 .. Elem1.Pal.Long));
+ end if;
+ end if;
+ --setlinewidth necesita 1 paramtro, por lo que en la pila debe haber camo minimo 1 elemento
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien procesamos setlinewidth
+ elsif Match (Data, "setlinewidth") then
+ if Count < 1 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Set_Width (Elem1.Num);
+ end if;
+ end if;
+ --setgray necesita 1 paramtro, por lo que en la pila debe haber camo minimo 1 elemento
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien procesamos setgray
+ elsif Match (Data, "setgray") then
+ if Count < 1 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Set_Gray (Elem1.Num);
+ end if;
+ end if;
+ --translate necesita 2 paramtros, por lo que en la pila debe haber camo minimo 2 elementos
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien procesamos translate
+ elsif Match (Data, "translate") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Translate (Elem2.Num, Elem1.Num);
+ end if;
+ end if;
+ --si el texto contenido de DATA coincide con "gsave" procesamos gsave
+ elsif Match (Data, "gsave") then
+ Gsave;
+ --si el texto contenido de DATA coincide con "grestore" procesamos grestore
+ elsif Match (Data, "grestore") then
+ Grestore (Errorp);
+ if Errorp then
+ Numerror := 5;
+ end if;
+ --def necesita 2 paramtros, por lo que en la pila debe haber camo minimo 2 elementos
+ --sino error 2; teniendo que ser éstos de tipo==>Elem1="codigo",Elem2="Palabra_Pila",
+ --sino Error 3, en caso de que todo vaya bien procesamos def
+ elsif Match (Data, "def") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1); -- Iterador
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2); -- Nombre def
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Codigo or
+ Elem2.Tipo /= Palabra_Pila then
+ Numerror := 3;
+ else
+ Guardar (Elem1.Cod.All, Elem2.Pal.Txt, Elem2.Pal.Long);
+ end if;
+ end if;
+ --si el texto contenido de DATA coincide con "showpage" procesamos showpage
+ elsif Match (Data, "showpage") then
+ Showpage;
+ --add necesita 2 paramtros, por lo que en la pila debe haber camo minimo 2 elementos
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien apilamos [operando_pila, Elem1+Elem2]
+ elsif Match (Data, "add") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Pila_Elementos.Apilar (Pila,
+ (Operando_Pila, Elem2.Num + Elem1.Num));
+ end if;
+ end if;
+ --sub necesita 2 paramtros, por lo que en la pila debe haber camo minimo 2 elementos
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien apilamos [operando_pila, Elem2-Elem1]
+ elsif Match (Data, "sub") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Pila_Elementos.Apilar (Pila,
+ (Operando_Pila, Elem2.Num - Elem1.Num));
+ end if;
+ end if;
+ --mul necesita 2 paramtros, por lo que en la pila debe haber camo minimo 2 elementos
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien apilamos [operando_pila, Elem2·Elem1]
+ elsif Match (Data, "mul") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Pila_Elementos.Apilar (Pila,
+ (Operando_Pila, Elem2.Num * Elem1.Num));
+ end if;
+ end if;
+ --div necesita 2 paramtros, por lo que en la pila debe haber camo minimo 2 elementos
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien apilamos [operando_pila, Elem2/Elem1]
+ elsif Match (Data, "div") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Pila_Elementos.Apilar (Pila,
+ (Operando_Pila, Elem2.Num / Elem1.Num));
+ end if;
+ end if;
+ --idiv necesita 2 paramtros, por lo que en la pila debe haber camo minimo 2 elementos
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien apilamos [operando_pila, Integer(Elem2)/Elem1] (con casting)
+ elsif Match (Data, "idiv") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Pila_Elementos.Apilar (Pila,
+ (Operando_Pila,
+ Float (Integer (Elem2.Num) / Integer (Elem1.Num))));
+ end if;
+ end if;
+ --mod necesita 2 paramtros, por lo que en la pila debe haber camo minimo 2 elementos
+ --sino error 2; teniendo que ser éstos de tipo "operando_pila", sino Error 3, en caso
+ --de que todo vaya bien apilamos [operando_pila, Integer(Elem2) mod Elem1]
+ elsif Match (Data, "mod") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ Pila_Elementos.Apilar (Pila,
+ (Operando_Pila,
+ Float (Integer (Elem2.Num) MOD Integer (Elem1.Num))));
+ end if;
+ end if;
+ --Vaciamos la pila, si la cima de la pila es de tipo codigo se elimina ése elemento tambien
+ --de la tabla de iteradores
+ elsif Match (Data, "clear") then
+ while not (Pila_Elementos.Es_Vacia (Pila)) loop
+ Pila_Elementos.Cima (Pila, Elem1);
+ if Elem1.Tipo = Codigo then
+ Iterador_Elementos.Destruir (Elem1.Cod.All);
+ Libera_Puntero (Elem1.Cod);
+ end if;
+ Pila_Elementos.Desapilar (Pila);
+ end loop;
+ --dup necesita 1 parametro en la pila sino error 2, copiamos ese elemento (en elem1) y lo
+ --volvemos a meter en la pila de modo que queda dupicado en la pila
+ elsif Match (Data, "dup") then
+ if Count < 1 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Apilar (Pila, Elem1);
+ end if;
+ --exch necesita 2 parametros en la pila sino error 2, los desapilamos (en elem1 y elem2)
+ --y los volvemos a apilar en orden inverso
+ elsif Match (Data, "exch") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Apilar (Pila, Elem1);
+ Pila_Elementos.Apilar (Pila, Elem2);
+ end if;
+ --pop necesita 1 parametro en la pila sino error 2, miramos la cima de la pila (elem1)
+ --lo desapilamos y en caso de que sea de tipo codigo, tambien lo eliminamos de la tabla
+ --de iteradores
+ elsif Match (Data, "pop") then
+ if Count < 1 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ if Elem1.Tipo = Codigo then
+ Iterador_Elementos.Destruir (Elem1.Cod.All);
+ Libera_Puntero (Elem1.Cod);
+ end if;
+ Pila_Elementos.Desapilar (Pila);
+ end if;
+ --roll necesita 2 parametros en la pila sino error 2, desapilamos las parametros en elem1
+ --y elem2 debiendo ser éstos de tipo "operando_pila" sino error 3
+ --si el numero de elementos que quedan en la pila es menor a (2+Elem2.num) error 2,
+ --si todo va bien rotamos la pila en funcion de elem1 y elem2 (con casting a integer)
+ elsif Match (Data, "roll") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1); -- j
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2); -- n
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ if Count < (2 + Integer (Elem2.Num)) then
+ Numerror := 2;
+ else
+ Pila_Elementos.Rotar (Pila,
+ Integer (Elem2.Num),
+ Integer (Elem1.Num));
+ end if;
+ end if;
+ end if;
+ --eq necesita 2 parametros en la pila sino error 2, desapilamos en elem1 y elem2 y miramos
+ --si son del mismo tipo apilando en pila [bool_pila, TRUE] si lo son y tienen el mismo
+ --valor y [bool_pila, FALSE] si no lo son o no tiene el mismo valor
+ elsif Match (Data, "eq") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Elem2.Tipo then
+ Pila_Elementos.Apilar (Pila, (Bool_Pila, False));
+ else
+ case Elem1.Tipo is
+ when Bool_Pila =>
+ Pila_Elementos.Apilar (Pila,
+ (Bool_Pila, (Elem1.Bool = Elem2.Bool)));
+ when Operando_Pila =>
+ Pila_Elementos.Apilar (Pila,
+ (Bool_Pila, (Elem1.Num = Elem2.Num)));
+ when Codigo =>
+ Pila_Elementos.Apilar (Pila,
+ (Bool_Pila, (Elem1.Cod = Elem2.Cod)));
+ when Palabra_Pila =>
+ Pila_Elementos.Apilar (Pila,
+ (Bool_Pila, (Elem1.Pal = Elem2.Pal)));
+ when Ninguno =>
+ null;
+ end case;
+ end if;
+ end if;
+ --ne necesita 2 parametros en la pila sino error 2, desapilamos en elem1 y elem2 y miramos
+ --si NO son del mismo tipo apilando en pila [bool_pila, TRUE] si son de tipo distinto
+ --en caso de ser del mismo tipo, miramos si su valor es distinto, en tal caso apilamos
+ --[bool_pila, TRUE], si su valor es igual [bool_pila, FALSE]
+ elsif Match (Data, "ne") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Elem2.Tipo then
+ Pila_Elementos.Apilar (Pila, (Bool_Pila, True));
+ else
+ case Elem1.Tipo is
+ when Bool_Pila =>
+ Pila_Elementos.Apilar (Pila,
+ (Bool_Pila, (not (Elem1.Bool = Elem2.Bool))));
+ when Operando_Pila =>
+ Pila_Elementos.Apilar (Pila,
+ (Bool_Pila, (not (Elem1.Num = Elem2.Num))));
+ when Codigo =>
+ Pila_Elementos.Apilar (Pila,
+ (Bool_Pila, (not (Elem1.Cod = Elem2.Cod))));
+ when Palabra_Pila =>
+ Pila_Elementos.Apilar (Pila,
+ (Bool_Pila, (not (Elem1.Pal = Elem2.Pal))));
+ when Ninguno =>
+ null;
+ end case;
+ end if;
+ end if;
+ --gt necesita 2 parametros en la pila sino error 2, desapilamos en elem1 y elem2 y miramos
+ --si son del tipo "operando_pila" sino error 3
+ --en caso de ser del mismo tipo, miramos si elem2.num > elem1.num si es asi apilamos
+ --[bool_pila, TRUE], en caso cantrario [bool_pila, FALSE]
+ elsif Match (Data, "gt") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ if Elem2.Num > Elem1.Num then
+ Pila_Elementos.Apilar (Pila, (Bool_Pila, True));
+ else
+ Pila_Elementos.Apilar (Pila, (Bool_Pila, False));
+ end if;
+ end if;
+ end if;
+ --ge necesita 2 parametros en la pila sino error 2, desapilamos en elem1 y elem2 y miramos
+ --si son del tipo "operando_pila" sino error 3
+ --en caso de ser del mismo tipo, miramos si elem2.num >= elem1.num si es asi apilamos
+ --[bool_pila, TRUE], en caso cantrario [bool_pila, FALSE]
+ elsif Match (Data, "ge") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ if Elem2.Num >= Elem1.Num then
+ Pila_Elementos.Apilar (Pila, (Bool_Pila, True));
+ else
+ Pila_Elementos.Apilar (Pila, (Bool_Pila, False));
+ end if;
+ end if;
+ end if;
+ --lt necesita 2 parametros en la pila sino error 2, desapilamos en elem1 y elem2 y miramos
+ --si son del tipo "operando_pila" sino error 3
+ --en caso de ser del mismo tipo, miramos si elem2.num < elem1.num si es asi apilamos
+ --[bool_pila, TRUE], en caso cantrario [bool_pila, FALSE]
+ elsif Match (Data, "lt") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ if Elem2.Num < Elem1.Num then
+ Pila_Elementos.Apilar (Pila, (Bool_Pila, True));
+ else
+ Pila_Elementos.Apilar (Pila, (Bool_Pila, False));
+ end if;
+ end if;
+ end if;
+ --le necesita 2 parametros en la pila sino error 2, desapilamos en elem1 y elem2 y miramos
+ --si son del tipo "operando_pila" sino error 3
+ --en caso de ser del mismo tipo, miramos si elem2.num <= elem1.num si es asi apilamos
+ --[bool_pila, TRUE], en caso cantrario [bool_pila, FALSE]
+ elsif Match (Data, "le") then
+ if Count < 2 then
+ Numerror := 2;
+ else
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Cima (Pila, Elem2);
+ Pila_Elementos.Desapilar (Pila);
+ if Elem1.Tipo /= Operando_Pila or
+ Elem2.Tipo /= Operando_Pila then
+ Numerror := 3;
+ else
+ if Elem2.Num <= Elem1.Num then
+ Pila_Elementos.Apilar (Pila, (Bool_Pila, True));
+ else
+ Pila_Elementos.Apilar (Pila, (Bool_Pila, False));
+ end if;
+ end if;
+ end if;
+ --sino ha sido ninguna de las operaciones anteriores error 1
+ else
+ Numerror := 1;
+ end if;
+
+ end Procesar;
+
+
+ -- PRE: Cierto
+ -- POST: Procesa un trozo de código postscript contenido en un iterador
+ -- Si se trata de un bucle stop pasa a ser cierto cuando encontramos
+ -- la sentencia "exit"
+ -- error devuelve el número de error encontrado. Si no hubo ninguno
+ -- entonces error 0
+ procedure Leer_Iterador (
+ I : in out Iterador_Elementos.Iterador;
+ Pila : in out Pila_Elementos.Pila;
+ Stop : in out Boolean;
+ Error : out Integer );
+ procedure Leer_Iterador (
+ I : in out Iterador_Elementos.Iterador;
+ Pila : in out Pila_Elementos.Pila;
+ Stop : in out Boolean;
+ Error : out Integer ) is
+
+ Elem : Elemento;
+ Auxi : Iterador_Elementos.Iterador;
+ Puntero : Puntero_Codigo := null;
+ C : Integer := 0;
+ Contador : Integer;
+ Elem1,
+ Elem2,
+ Elem3 : Elemento_Pila;
+
+ begin
+ --ponemos el campo del interdor ACTUAL = Primero
+ Iterador_Elementos.Iniciar (I);
+ --creamos una tabla de iteradores auxiliar
+ Iterador_Elementos.Crear_Iterador (Auxi);
+ --condicion de parada
+ Stop := False;
+ --error de salida (inicializado a correcto)
+ Error := 0;
+ loop
+ --OPERANDO
+ --hacemos una copia del primer elemento de la tabla para trabajar con él (elem)
+ Elem := Iterador_Elementos.Dato_Actual (I);
+ --si Elem es de tipo "operando" apilamos en pila como [Operando_pila, Elem.num]
+ if Elem.Tipo = Operando then
+ Pila_Elementos.Apilar (Pila, (Operando_Pila, Elem.Num));
+
+ --DEFINICION
+ --si Elem es de tipo "Definicion" asignamos a AUXI el iterador de la definicion
+ --y llamamos a Leer_iterador para procesar el iterador AUXI
+ elsif Elem.Tipo = Definicion then
+ Iterador_Elementos.Asignar (Auxi, Consultar (Elem.Def));
+ Leer_Iterador (Auxi, Pila, Stop, Error);
+
+ --TEXT
+ --si Elem es de tipo "text" lo apilamos como [palabra_pila, elem.tx]
+ elsif Elem.Tipo = Text then
+ Pila_Elementos.Apilar (Pila, (Palabra_Pila, Elem.Tx));
+
+ --sino es ninguna de las anteriores es un OPERADOR
+ else
+ --si Elem es "{" entonces tendremos que construir un iterador (auxi) con todo lo
+ --almacenado dentro de las llaves, llevando la cuenta del valanceo de las llaves (c)
+ if Elem.Dat.Pal (1) = '{' then
+ C := 1;
+ Iterador_Elementos.Crear_Iterador (Auxi);
+ loop
+ Iterador_Elementos.Siguiente (I);
+ Elem := Iterador_Elementos.Dato_Actual (I);
+ if Elem.Tipo = Operador then
+ if Elem.Dat.Pal (1) = '{' then
+ C := C + 1;
+ elsif Elem.Dat.Pal (1) = '}' then
+ C := C - 1;
+ end if;
+ if C = 0 then
+ exit;
+ else
+ Iterador_Elementos.Insertar_Dato (Elem, Auxi);
+ end if;
+ else
+ Iterador_Elementos.Insertar_Dato (Elem, Auxi);
+ end if;
+ end loop;
+ --hacemos una copia del iterador Auxi que contiene todo lo que se encuentra entre
+ --llaves en "puntero", liberamos Auxi y apilamos [codigo, puntero] y una vez
+ --apilado el codigo puntero=NULL
+ Puntero := new Iterador_Elementos.Iterador;
+ Iterador_Elementos.Asignar (Puntero.All, Auxi);
+ Iterador_Elementos.Crear_Iterador (Auxi);
+ Pila_Elementos.Apilar (Pila, (Codigo, Puntero));
+ Puntero := null;
+ else
+
+ --EXIT
+ --en el caso de que elem.dat sea "exit" terminamos
+ if Match (Elem.Dat, "exit") then
+ Stop := True;
+ exit;
+
+ --LOOP
+ --si elem.dat es "loop", tendremos que construir un iterador (auxi) con todo lo
+ --que contiene el bucle, para ello simplemente asignamos a auxi el siguiente
+ --elemento almacenado en la pila, llamando a Leer_iterador con Auxi hasta
+ --encontrar que stop=TRUE
+ elsif Match (Elem.Dat, "loop") then
+ Pila_Elementos.Cima (Pila, Elem1);
+ Iterador_Elementos.Asignar (Auxi, Elem1.Cod.All);
+ loop
+ Leer_Iterador (Auxi, Pila, Stop, Error);
+ if Stop then
+ exit;
+ end if;
+ end loop;
+ Iterador_Elementos.Destruir (Auxi);
+ Libera_Puntero (Elem1.Cod);
+ Pila_Elementos.Desapilar (Pila);
+
+ --REPEAT
+ --cogemos el primer y segundo elemento de la pila (elem1 y elem2), siendo el
+ --numero de repeticiones elem2.num, y elem1 sera un puntero que señale al
+ --codigo que debemos repetir (se lo asignaremos a AUXI), llamando tantas veces
+ --como se selicite a Leer_iterador, destruiremos auxi, liberamos el puntero y
+ --deasapilamos 2 veces
+ elsif Match (Elem.Dat, "repeat") then
+ Pila_Elementos.Cima (Pila, Elem1);
+ Pila_Elementos.Segundo (Pila, Elem2);
+ Contador := Integer (Elem2.Num);
+ Iterador_Elementos.Asignar (Auxi, Elem1.Cod.All);
+ while Contador /= 0 loop
+ Leer_Iterador (Auxi, Pila, Stop, Error);
+ Contador := Contador - 1;
+ if Stop then
+ Contador := 0;
+ end if;
+ end loop;
+ Iterador_Elementos.Destruir (Auxi);
+ Libera_Puntero (Elem1.Cod);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Desapilar (Pila);
+
+ --IF
+ --cogemos el primer y segundo elemento de la pila (elem1 y elem2), elem1 sera
+ --un puntero que señale al codigo que debemos procesar (se lo asignaremos a AUXI)
+ --elem2 sera la condicion booleana, en caso de que se cumpla, procesaremos el
+ --codigo señalado por Auxi llamando a Leer_iterador,destruiremos auxi,
+ --liberamos el puntero y deasapilamos 2 veces
+ elsif Match (Elem.Dat, "if") then
+ Pila_Elementos.Cima (Pila, Elem1); -- iterador
+ Pila_Elementos.Segundo (Pila, Elem2); -- booleano
+ Iterador_Elementos.Asignar (Auxi, Elem1.Cod.All);
+ if Elem2.Bool then
+ Leer_Iterador (Auxi, Pila, Stop, Error);
+ end if;
+ Iterador_Elementos.Destruir (Auxi);
+ Libera_Puntero (Elem1.Cod);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Desapilar (Pila);
+
+ --IFELSE
+ --cogemos el primer y segundo y el tercer elemento de la pila (elem1, elem2 y elem3)
+ --elem3 sera la condicion booleana, elem2 señala al codigo del "IF" y elem1 al codigo
+ --del "ELSE", de forma que si se cumple la condicion booleana procesimamos elem2 y
+ --sino el codigo de elem1, asignadoselo a Auxi y llamando a Leer_iterador
+ --destruimos iteradores, liberamos punteros y deasapilamos 3 veces
+ elsif Match (Elem.Dat, "ifelse") then
+ Pila_Elementos.Cima (Pila, Elem1); -- iteradorF
+ Pila_Elementos.Segundo (Pila, Elem2); -- iteradorT
+ Pila_Elementos.Tercero (Pila, Elem3); -- booleano
+ if Elem3.Bool then
+ Iterador_Elementos.Asignar (Auxi, Elem2.Cod.All);
+ Leer_Iterador (Auxi, Pila, Stop, Error);
+ else
+ Iterador_Elementos.Asignar (Auxi, Elem1.Cod.All);
+ Leer_Iterador (Auxi, Pila, Stop, Error);
+ end if;
+ Iterador_Elementos.Destruir (Elem1.Cod.All);
+ Libera_Puntero (Elem1.Cod);
+ Iterador_Elementos.Destruir (Elem2.Cod.All);
+ Libera_Puntero (Elem2.Cod);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Desapilar (Pila);
+ Pila_Elementos.Desapilar (Pila);
+
+ --si no es ninguna de las anteriores procesamos
+
+ else
+ Procesar (Elem.Dat, Pila, Error);
+ end if;
+ end if;
+ end if;
+ --si hay mas elementos en la tabla de iteradores avanzamos al siguiente elemento
+ if Iterador_Elementos.Hay_Siguiente (I) then-----------------------------------------------------------------
+ Iterador_Elementos.Siguiente (I);
+ --si no hay mas elementos en la tabla de iteradores, hemos terminado
+ else
+ exit;
+ end if;
+ --si error es distinto a 0 se produjo un error, por tanto salimos
+ if Error /= 0 then
+ exit;
+ end if;
+ end loop;
+ --cuando hemos terminado de Leer el iterador Actual=Primero
+ Iterador_Elementos.Iniciar (I);
+ end Leer_Iterador;
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ procedure Leer_Postscript_Aux (
+ Entrada : in out File_Type;
+ I : in out Iterador_Elementos.Iterador;
+ Error : in out Integer ) is
+
+ Pal1 : Dato;
+ B : Character;
+ A : Integer := 0;
+ Contador : Integer;
+ Stop : Boolean := False;
+ Puntero : Puntero_Codigo := null;
+ Elem1,
+ Elem2,
+ Elem3 : Elemento_Pila;
+ T : Texto;
+ Pila : Pila_Elementos.Pila;
+
+ begin
+
+ Pila_Elementos.Crear_Vacia (Pila);
+
+put_line("Entramos en Leer_postscript_aux!!!!");
+ B := '?';
+ A := 0;
+
+ --limpiar;
+ --construiremos el iterador en funcion del texto almacenado en el fichero
+ while not End_Of_File (Entrada) and not Match (Pal1, "showpage") loop
+ --put_line("Entra!");
+pal1.pal (1..20):= " ";
+ --cogemos una palabra
+ Coger (Entrada, Pal1, B);
+Put_Line(Pal1.Pal);
+--put_line("bucle ps_aux");
+
+
+ --si empieza por "/" sera el comienzo de una funcion propia
+ if Pal1.Pal (1) = '/' then
+ --cogemos la siguiente, la guardamos en t y la apilamos como [Palabra_Pila, t]
+ --sera el nombre de la funcion
+--put_line("Entra /");
+ Coger (Entrada, Pal1, B);
+ T.Txt (1 .. Pal1.Long) := Pal1.Pal (1 .. Pal1.Long);
+ T.Long := Pal1.Long;
+ Pila_Elementos.Apilar (Pila, (Palabra_Pila, T));