Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/gks/gksma.src

Text File | 1988-05-03 | 815.0 KB | 23,619 lines

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:IMPORT_READ.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: IMPORT_READ
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : IMPORT_READ

with SYSTEM;

package IMPORT_READ  is

-- This package is designed to import the assembly language
-- routine that actually does the majority of the communication
-- from the Lexidata 3700 hardware. The SYSTEM package is used to
-- allow the use of the address type. This is used in passing the
-- location of an array.

   procedure ADA_PHREAD
      (BUFFER : SYSTEM.ADDRESS;
       COUNT  : INTEGER;
       WAIT   : BOOLEAN);
   pragma interface(masm,ADA_PHREAD);
   pragma entry_point(ADA_PHREAD, "PHREAD");

-- The PRAGMA INTERFACE tells the compiler in what language the
-- procedure is written. MASM is a macro assembler and ADA_PHREAD
-- is the name of the procedure, so the front end of the procedure is
-- in Ada and the code is in macro assembly language.
--
-- The PRAGMA ENTRY_POINT defines the symbol at which to begin
-- execution of the foreign program interfaced into the Ada
-- environment.
--
-- The procedure ADA_PHREAD is the interface between Ada and
-- the assembly language.
--
-- BUFFER - This is the starting address in memory to read from.
-- COUNT  - This variable contains the number of elements to read.
-- WAIT   - This tells the assembly language to wait until the
--          read operation is finished. It WAIT is set to false, it
--          is possible that the main program finishs and the assembly
--          language has placed data from the LEXIDATA 3700 into the
--          buffer that the user does not know about.

end IMPORT_READ;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:IMPORT_WRITE.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: IMPORT_WRITE
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : IMPORT_WRITE

with SYSTEM;

package IMPORT_WRITE is

-- This package is designed to import the assembly language
-- routine that actually does the writing of commands to the
-- Lexidata 3700 hardware. The SYSTEM package is used to allow
-- the use of the address type. This is used in passing the
-- location of an array

   procedure ADA_PHWRIT
      (BUFFER : SYSTEM.ADDRESS;
       COUNT  : INTEGER;
       WAIT   : BOOLEAN);
   pragma interface(masm,ADA_PHWRIT);
   pragma entry_point(ADA_PHWRIT, "PHWRIT");

-- The PRAGMA INTERFACE tells the compiler in what language the
-- procedure is written. MASM is a macro assembler and ADA_PHWRIT
-- is the name of the procedure, so the front end of the procedure is
-- in Ada and the code is in macro assembly language.
--
-- The PRAGMA ENTRY_POINT defines the symbol at which to begin
-- execution of the foreign program interfaced into the Ada
-- environment.
--
-- The procedure ADA_PHWRIT is the interface between Ada and
-- the assembly language.
--
-- BUFFER - This is the starting address in memory to read from.
-- COUNT  - This variable contains the number of elements to read.
-- WAIT   - This tells the assembly language to wait until the
--          write operation is finished. If WAIT is set to false and
--          the main program finished before the assembly language
--          has had enough time to send the buffer to the LEXIDATA 3700,
--          it is possible that there will be unsent data remaining in
--          the buffer.

end IMPORT_WRITE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:IMPORT_VARIABLES.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: IMPORT_VARIABLES
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : IMPORT_VARIABLES.ADA

package IMPORT_VARIABLES is

-- This package specification is designed to allow the assembly
-- block of VARIABLES of data to be visible. PHBLK.SR is imported
-- into the Ada environment.

end IMPORT_VARIABLES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:IMPORT_WAIT.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: IMPORT_WAIT
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : IMPORT_WAIT.ADA

package IMPORT_WAIT is

-- This package imports the assembly language routine PHOWT.
-- This is used to pause the software until the hardware has
-- completed the current task and sends an interrupt to the PHOWT.

   procedure ADA_PHOWT;
   pragma interface(masm,ADA_PHOWT);
   pragma entry_point(ADA_PHOWT,"PHOWT");

-- The PRAGMA INTERFACE tells the compiler in what language the
-- procedure is written. MASM is a macro assembler and ADA_PHOWT
-- is the name of the procedure, so the front end of the procedure is
-- in Ada and the code is in macro assembly language.
--
-- The PRAGMA ENTRY_POINT defines the symbol at which to begin
-- execution of the foreign program interfaced into the Ada
-- environment.

end IMPORT_WAIT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:IMPORT_OPEN.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: IMPORT_OPEN
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : IMPORT_OPEN.ADA

package IMPORT_OPEN is

-- This package specification is used to import the assembly
-- language routine PHDOPN.

  procedure ADA_PHDOPN
     (INPUT_DEVICE   : INTEGER;
      OUTPUT_DEVICE  : INTEGER;
      ERROR          : out INTEGER);
  pragma interface (masm,ADA_PHDOPN);
  pragma entry_point (ADA_PHDOPN,"PHDOPN");

-- The PRAGMA INTERFACE tells the compiler in what language the
-- procedure is written. MASM is a macro assembler and ADA_PHDOPN
-- is the name of the procedure, so the front end of the procedure is
-- in Ada and the code is in macro assembly language.
--
-- The PRAGMA ENTRY_POINT defines the symbol at which to begin
-- execution of the foreign program interfaced into the Ada
-- environment.
--
-- This procedure is designed to open the Lexidata 3700 with an input
-- device channel and a output device channel. This procedure will
-- produce an error message. The value of 0 on the DATA GENERAL will
-- be returned if opened successfully.
--
-- INPUT_DEVICE  - contains the physical channel to communicate to
-- the device.
-- OUTPUT_DEVICE - contains the physical channel to communicate from
-- the device.
-- ERROR         - contains the host system defined error number.

end IMPORT_OPEN;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_CONFIGURATION_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME:  GKS_CONFIGURATION
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  gks_configuration_ma.ada
-- level: ma

package GKS_CONFIGURATION is

-- This package is external to GKS and contains implementation-defined
-- constants used by a particular level ma implementation of GKS.  It
-- also contains default declarations used by an application program in
-- its implementation of GKS.

   MAX_MEMORY_UNITS              : constant := 0;

   MAX_NUMBER_OPEN_WS            : constant := 100;

   MAX_NUMBER_ACTIVE_WS          : constant := 100;

   MAX_NORMALIZATION_TRANSFORMATION_NUMBER
                                 : constant := 1;

   MAX_WS_TYPE                   : constant := 100;

   PRECISION                     : constant := 6;

   DEFAULT_ERROR_FILE            : constant STRING :=
                                              "gks_error_file";

   LEXIDATA_3700_OUTPUT_TYPE     : constant := 1;

end GKS_CONFIGURATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_COOR_SYS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_COORDINATE_SYSTEM
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  gks_coor_sys.ada
-- level: ma, 0a, 1a, 2a

with GKS_CONFIGURATION;

generic

   type COORDINATE_COMPONENT_TYPE is digits <>;
   -- Coordinate_component_types in the system are floating point
   -- values.  Values on both axes are of the same type.

package GKS_COORDINATE_SYSTEM is

-- This generic package contains the specification for the coordinate
-- systems template.  It defines a Cartesian coordinate_component_type
-- system for use by GKS.

   type POINT is
      record
         X : COORDINATE_COMPONENT_TYPE;
         Y : COORDINATE_COMPONENT_TYPE;
      end record;
   -- Defines a point in the COORDINATE_COMPONENT_TYPE system.

   type POINT_ARRAY is array (POSITIVE range <>) of POINT;
   -- Defines an array of points.

   subtype SMALL_NATURAL is NATURAL range 0..500;
   -- This is a temporary subtype declaration which allows for
   -- unconstrained POINT_LIST objects without causing the
   -- exception STORAGE_ERROR to be raised.

   type POINT_LIST (LENGTH: SMALL_NATURAL := 0) is
      record
         POINTS : POINT_ARRAY (1..LENGTH);
      end record;
   -- This defines the point list.  The record construct with a
   -- discriminant allows a user to index into a list of points
   -- that is user settable.

   type VECTOR is new POINT;
   -- Defines a vector in the COORDINATE_COMPONENT_TYPE system.

   type RECTANGLE_LIMITS is
      record
         XMIN : COORDINATE_COMPONENT_TYPE;
         XMAX : COORDINATE_COMPONENT_TYPE;
         YMIN : COORDINATE_COMPONENT_TYPE;
         YMAX : COORDINATE_COMPONENT_TYPE;
      end record;
   -- Defines a rectangle in the COORDINATE_COMPONENT_TYPE system.

   type MAGNITUDE_BASE_TYPE is digits GKS_CONFIGURATION.PRECISION;
   -- Defines type used to define subtype MAGNITUDE.

   subtype MAGNITUDE is MAGNITUDE_BASE_TYPE range
      COORDINATE_COMPONENT_TYPE'SAFE_SMALL..
         COORDINATE_COMPONENT_TYPE'SAFE_LARGE;
   -- Defines the length of an object in the COORDINATE_COMPONENT_TYPE
   -- system.


   type SIZE is
      record
         XAXIS : MAGNITUDE;
         YAXIS : MAGNITUDE;
      end record;
   -- Defines the size of an object in the COORDINATE_COMPONENT_TYPE
   -- system as length along the X and Y axes.

   type RANGE_OF_MAGNITUDES is
      record
         MIN : MAGNITUDE;
         MAX : MAGNITUDE;
      end record;
   -- Defines the extent of a rectangle in the COORDINATE_COMPONENT_TYPE
   -- system parallel to the X and Y axes.

end GKS_COORDINATE_SYSTEM;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_MATRIX_UTILITIES.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_MATRIX_UTILITIES
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  gks_matrix_utilities.ada
-- level: ma, 0a, 1a, 2a

generic

   type ELEMENT_TYPE is private;

package GKS_MATRIX_UTILITIES is

-- The generic package declared in this file is the specification of
-- a MATRIX UTILITY package which defines generic matrix types.  This
-- package is instantiated by GKS_TYPES to provide matrices of colour
-- and pixel colour indices for describing Cell Arrays, Pixel Arrays,
-- etc.

   type MATRIX_OF is array (POSITIVE range <>, POSITIVE range <>)
      of ELEMENT_TYPE;
   -- This type specifies an unconstrained array to be used for
   -- the matrix specification in this generic package.

   subtype SMALL_NATURAL is NATURAL range 0..500;
   -- This is a temporary subtype declaration which allows for
   -- unconstrained VARIABLE_MATRIX_OF objects without causing
   -- the exception STORAGE_ERROR to be raised.

   type VARIABLE_MATRIX_OF (DX : SMALL_NATURAL := 0;
                            DY : SMALL_NATURAL := 0)
      is record
         MATRIX : MATRIX_OF (1..DX, 1..DY);
      end record;
   -- This record type specifies a user defineable matrix by
   -- using a record discriminant which establishes the upper
   -- bounds of the matrix of generic types.

end GKS_MATRIX_UTILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_LIST_UTILITIES.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_LIST_UTILITIES
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  gks_list_utilities.ada
-- level: all levels

generic

   type ELEMENT_TYPE is private;

package GKS_LIST_UTILITIES is

-- The generic package declared in this file is the specification of
-- a LIST UTILITY package which defines an unordered list type and its
-- operations to support the GKS list type.  The package defines the
-- LIST_OF type as private so that an implementation is free to choose
-- a list type which is optimal for its strategy.

   type LIST_OF is private;

   NULL_LIST : constant LIST_OF;

   procedure ADD_TO_LIST
      (ELEMENT    : in ELEMENT_TYPE;
       LIST       : in out LIST_OF);

   procedure DELETE_FROM_LIST
      (ELEMENT      : in ELEMENT_TYPE;
       LIST         : in out LIST_OF);

   function SIZE_OF_LIST
      (LIST : in LIST_OF) return NATURAL;

   function IS_IN_LIST
      (ELEMENT : ELEMENT_TYPE;
       LIST    : LIST_OF) return BOOLEAN;

   function LIST_ELEMENT
      (I    : in POSITIVE;
       LIST : in LIST_OF) return ELEMENT_TYPE;

   type LIST_VALUES is array (POSITIVE range <>) of ELEMENT_TYPE;
   -- Definition of an unconstrained array of ELEMENT_TYPE.
   -- Type used by applications to define an array and then
   -- simply calling function LIST to initialize a list.

   function LIST
      (VALUES : in LIST_VALUES) return LIST_OF;

private

   -- Lists are implemented as an access type to an array to hold
   -- the components of the list.  An empty list is a null pointer.

   type LIST_OF is access LIST_VALUES;

   NULL_LIST : constant LIST_OF := null;

end GKS_LIST_UTILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_LIST_UTILITIES_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_LIST_UTILITIES - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  gks_list_utilities_b.ada
-- level: all levels

with UNCHECKED_DEALLOCATION;

package body GKS_LIST_UTILITIES is

   procedure FREE is new UNCHECKED_DEALLOCATION (LIST_VALUES, LIST_OF);

   procedure ADD_TO_LIST
      (ELEMENT : in ELEMENT_TYPE;
       LIST    : in out LIST_OF) is

   -- This procedure adds ELEMENT to the list pointed to by
   -- LIST_OF.
   --
   -- ELEMENT - Item to be added to LIST.
   -- LIST - A list.

      NEW_LIST  : LIST_OF;
      -- Temporary object used to point to a new list.

   begin

      if LIST /= NULL_LIST then
         if not IS_IN_LIST (ELEMENT, LIST) then
            NEW_LIST := new LIST_VALUES'(LIST.all & ELEMENT);
            FREE (LIST);
            LIST := NEW_LIST;
         end if;
      else
         LIST := new LIST_VALUES'(1 => ELEMENT);
     end if;

   end ADD_TO_LIST;

   procedure DELETE_FROM_LIST
       (ELEMENT   : in ELEMENT_TYPE;
       LIST      : in out LIST_OF) is

   -- This procedure deletes ELEMENT from the list pointed
   -- to by LIST.
   --
   -- ELEMENT - Item to be deleted from LIST.
   -- LIST - A list.

      INDEX           : NATURAL;
      -- Object used as an index into LIST.

      ITEM_FOUND      : BOOLEAN;
      -- Object used to as a flag and is set to TRUE if
      -- ELEMENT is found in LIST.

      NEW_LIST        : LIST_OF;
      -- Temporary object used to point to a new list.

   begin

      if LIST /= NULL_LIST then
         INDEX := 1;
         ITEM_FOUND := FALSE;
         while INDEX <= LIST'LENGTH loop
            if LIST(INDEX) = ELEMENT then
               ITEM_FOUND := TRUE;
               exit;
            end if;
            INDEX := INDEX + 1;
         end loop;

         if ITEM_FOUND then
            if LIST'LENGTH = 1 then
               FREE(LIST);
               LIST := NULL_LIST;
            else
               NEW_LIST := new LIST_VALUES(1..LIST'LENGTH - 1);
               NEW_LIST.all := LIST(1..INDEX - 1) &
                                  LIST(INDEX + 1..LIST'LENGTH);
               FREE (LIST);
               LIST := NEW_LIST;
            end if;
         end if;
      end if;

   end DELETE_FROM_LIST;

   function SIZE_OF_LIST
      (LIST  : in LIST_OF) return NATURAL is

   -- This function returns the number of elements in the
   -- list pointed to by LIST.
   --
   -- LIST - A list.

   begin

      if LIST = NULL_LIST then
         return 0;
      else
         return LIST'LENGTH;
      end if;

   end SIZE_OF_LIST;

   function IS_IN_LIST
      (ELEMENT  : ELEMENT_TYPE;
       LIST     : LIST_OF) return BOOLEAN is

   -- This function returns TRUE if ELEMENT is found in the list
   -- pointed to by LIST.
   --
   -- ELEMENT - Item to be found in LIST.
   -- LIST - A list.

   begin

      if LIST /= NULL_LIST then
         for INDEX in 1..LIST'LENGTH loop
            if LIST(INDEX) = ELEMENT then
               return TRUE;
            end if;
         end loop;
      end if;
      return FALSE;

   end IS_IN_LIST;

   function LIST_ELEMENT
      (I        : in POSITIVE;
       LIST     : in LIST_OF) return ELEMENT_TYPE is

   -- This function returns the Ith element in the list pointed
   -- to by LIST.
   --
   -- I - Element's position in LIST that will be returned.
   -- LIST - A list.

      DUMMY_ELEMENT: ELEMENT_TYPE;
      -- In the event an invalid position for the list is input,
      -- garbage is returned.

   begin

      if LIST = NULL_LIST then
         return DUMMY_ELEMENT;
      elsif I <= LIST'LENGTH then
         return LIST(I);
      else
         return DUMMY_ELEMENT;
      end if;

   end LIST_ELEMENT;

   function LIST
      (VALUES : in LIST_VALUES) return LIST_OF is

   -- This function creates a list using the elements from the
   -- array VALUES.  A pointer to the list created is returned.
   --
   -- VALUES - the array to be placed in the specified list.

   begin

      if VALUES'LENGTH = 0 then
         return NULL_LIST;
      else
         return new LIST_VALUES'(VALUES);
      end if;

   end LIST;

end GKS_LIST_UTILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_TYPES_A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_TYPES
--  IDENTIFIER: GIMXXX.2(1)
--  DISCREPANCY REPORTS:
--  DR002  5-2-85  "SEGMENT_DETECTABILITY missing from GKS_TYPES"
------------------------------------------------------------------
-- file:  gks_types_la.ada
-- level: ma, 0a, 1a, 2a

with GKS_LIST_UTILITIES;
with GKS_CONFIGURATION;
with GKS_COORDINATE_SYSTEM;
with GKS_MATRIX_UTILITIES;

use GKS_CONFIGURATION;

package GKS_TYPES is

-- This package contains all the data type definitions used to define
-- the Ada binding to GKS.  Some of the declarations employ constant
-- values in the definition.  These constant declarations are
-- collected into a separate package called GKS_CONFIGURATION.


   package SCALE_FACTOR_TYPE is

   -- This package contains the data type definition for SCALE_FACTOR.


      -- SCALE_FACTOR                            LEVEL ma

      type SCALE_FACTOR is digits PRECISION;

      -- The type used for unitless scaling factors.


   end SCALE_FACTOR_TYPE;

   use SCALE_FACTOR_TYPE;

   subtype SMALL_NATURAL is NATURAL range 0..500;

   -- This is a temporary subtype declaration which allows for
   -- unconstrained record objects for various record types defined
   -- below without causing the exception STORAGE_ERROR to
   -- be raised.


   -- ASF                                        LEVEL 0a

   type ASF is (BUNDLED,
                INDIVIDUAL);

   -- This type defines an aspect source flag whose
   -- value indicates whether individual attributes
   -- are to be used, or attributes as specified in
   -- a bundle table.


   -- ASF_LIST                                   LEVEL 0a

   type ASF_LIST is
      record
         LINETYPE                : ASF;
         LINE_WIDTH              : ASF;
         LINE_COLOUR             : ASF;
         MARKER_TYPE             : ASF;
         MARKER_SIZE             : ASF;
         MARKER_COLOUR           : ASF;
         TEXT_FONT_PRECISION     : ASF;
         CHAR_EXPANSION          : ASF;
         CHAR_SPACING            : ASF;
         TEXT_COLOUR             : ASF;
         INTERIOR_STYLE          : ASF;
         STYLE_INDEX             : ASF;
         FILL_AREA_COLOUR        : ASF;
      end record;

   -- A list containing all of the aspect source flags,
   -- with components indicating the specific flag.


   -- ATTRIBUTES_FLAG                            LEVEL 0a

   type ATTRIBUTES_FLAG is (CURRENT,
                            SPECIFIED);

   -- Indicates whether output attributes used are to
   -- be as currently set, or as explicitly specified.


   -- ATTRIBUTES_USED_TYPE                       LEVEL 0a

   type ATTRIBUTES_USED_TYPE is (POLYLINE_ATTRIBUTES,
                                 POLYMARKER_ATTRIBUTES,
                                 TEXT_ATTRIBUTES,
                                 FILL_AREA_ATTRIBUTES);

   -- The types of attributes which may be used in gen-
   -- erating output.


   -- ATTRIBUTES_USED                            LEVEL 0a

   package ATTRIBUTES_USED is new GKS_LIST_UTILITIES
      (ATTRIBUTES_USED_TYPE);

   -- Provides for a list of the attributes used.

   function "&" (LEFT, RIGHT: ATTRIBUTES_USED.LIST_VALUES) return
      ATTRIBUTES_USED.LIST_VALUES renames ATTRIBUTES_USED."&";


   -- CHAR_EXPANSION                             LEVEL ma

   type CHAR_EXPANSION is new SCALE_FACTOR range
      SCALE_FACTOR'SAFE_SMALL..SCALE_FACTOR'LAST;

   -- Defines a character expansion factor.  Factors are unitless
   -- and must be greater than zero.


   -- CHAR_SPACING                               LEVEL ma

   type CHAR_SPACING is new SCALE_FACTOR;

   -- Defines a character spacing factor.  The factors are
   -- unitless.  A positive value indicates the amount of
   -- space between characters in a text string, and a
   -- negative value indicates the amound of overlap between
   -- characters in a text string.


   -- CLIPPING_INDICATOR                         LEVEL ma

   type CLIPPING_INDICATOR is (CLIP,
                               NOCLIP);

   -- Indicates whether or not clipping is to be performed.


   -- COLOUR_AVAILABLE                           LEVEL ma

   type COLOUR_AVAILABLE is (COLOUR,
                             MONOCHROME);

   -- Indicates whether colour output is available on
   -- a workstation.


   -- PIXEL_COLOUR_INDEX                         LEVEL 0a

   type PIXEL_COLOUR_INDEX is new INTEGER range -1..INTEGER'LAST;

   --  Represents a pixel colour where the value -1 represents an
   --  invalid colour index.


   -- COLOUR_INDEX                               LEVEL ma

   subtype COLOUR_INDEX is PIXEL_COLOUR_INDEX range
      0..PIXEL_COLOUR_INDEX'LAST;

   -- Indices into colour tables are of this type.


   -- COLOUR_INDICES                             LEVEL ma

   package COLOUR_INDICES is new GKS_LIST_UTILITIES (COLOUR_INDEX);

   -- Provides for a list of colour indices which are available
   -- on a particular workstation.

   function "&" (LEFT, RIGHT: COLOUR_INDICES.LIST_VALUES) return
      COLOUR_INDICES.LIST_VALUES renames COLOUR_INDICES."&";


   -- COLOUR_MATRICES                            LEVEL ma

   package COLOUR_MATRICES is new GKS_MATRIX_UTILITIES (COLOUR_INDEX);

   -- Provides for matrices containing colour indices corresponding
   -- to a cell array or a pattern array.


   -- INTENSITY                                  LEVEL ma

   type INTENSITY is digits PRECISION range 0.0..1.0;

   -- Defines the range of possible intensities of a colour.


   -- COLOUR_REPRESENTATION                      LEVEL ma

   type COLOUR_REPRESENTATION is
      record
         RED   : INTENSITY;
         GREEN : INTENSITY;
         BLUE  : INTENSITY;
      end record;

   -- Defines the representation of a colour as a
   -- combination of intensities in an RGB colour system.


   -- CONNECTION_ID                              LEVEL ma

   subtype CONNECTION_ID is string;

   -- Defines the type for a connection identifier.  The
   -- string must correspond to an external device or
   -- file as defined by the GKS implementation.


   -- CONTROL_FLAG                               LEVEL ma

   type CONTROL_FLAG is (CONDITIONALLY,
                         ALWAYS);

   -- The control flag is used to indicate the conditions
   -- under which the display surface should be cleared.


   -- DC_TYPE                                    LEVEL ma

   type DC_TYPE is digits PRECISION;

   -- The type of a coordinate in the Device Coordinate
   -- System.


   -- DC                                         LEVEL ma

   package DC is new GKS_COORDINATE_SYSTEM (DC_TYPE);

   -- Defines the Device Coordinate System.

   function "=" (LEFT, RIGHT: DC.POINT) return BOOLEAN
      renames DC."=";

   function "&" (LEFT, RIGHT: DC.POINT_ARRAY) return
      DC.POINT_ARRAY renames DC."&";

   function "=" (LEFT, RIGHT: DC.VECTOR) return BOOLEAN
      renames DC."=";

   function "=" (LEFT, RIGHT: DC.RECTANGLE_LIMITS) return BOOLEAN
      renames DC."=";

   function "=" (LEFT, RIGHT: DC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames DC."=";

   function "<" (LEFT, RIGHT: DC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames DC."<";

   function "<=" (LEFT, RIGHT: DC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames DC."<=";

   function ">" (LEFT, RIGHT: DC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames DC.">";

   function ">=" (LEFT, RIGHT: DC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames DC.">=";

   function "+" (LEFT, RIGHT: DC.MAGNITUDE_BASE_TYPE) return
      DC.MAGNITUDE_BASE_TYPE renames DC."+";

   function "-" (LEFT, RIGHT: DC.MAGNITUDE_BASE_TYPE) return
      DC.MAGNITUDE_BASE_TYPE renames DC."-";

   function "*" (LEFT, RIGHT: DC.MAGNITUDE_BASE_TYPE) return
      DC.MAGNITUDE_BASE_TYPE renames DC."*";

   function "/" (LEFT, RIGHT: DC.MAGNITUDE_BASE_TYPE) return
      DC.MAGNITUDE_BASE_TYPE renames DC."/";

   function "=" (LEFT, RIGHT: DC.SIZE) return BOOLEAN
      renames DC."=";

   function "=" (LEFT, RIGHT: DC.RANGE_OF_MAGNITUDES) return BOOLEAN
      renames DC."=";


   -- DC_UNITS                                   LEVEL ma

   type DC_UNITS is (METRES,
                     OTHER);

   -- Device coordinate units for a particular workstation
   -- may be in meters, or some other unit (such as inches).


   -- DEFERRAL_MODE                              LEVEL 0a

   type DEFERRAL_MODE is (ASAP,
                          BNIG,
                          BNIL,
                          ASTI);

   -- Defines the GKS deferral modes.


   -- DISPLAY_CLASS                              LEVEL 0a

   type DISPLAY_CLASS is (VECTOR_DISPLAY,
                          RASTER_DISPLAY,
                          OTHER_DISPLAY);

   -- The classification of a workstation of category OUTPUT or OUTIN.


   -- DISPLAY_SURFACE_EMPTY                      LEVEL 0a

   type DISPLAY_SURFACE_EMPTY is (EMPTY,
                                  NOTEMPTY);

   -- Indicates whether the display surface is empty.


   -- DYNAMIC_MODIFICATION                       LEVEL 1a

   type DYNAMIC_MODIFICATION is (IRG,
                                 IMM);

   -- Indicates whether an update to the state list is per-
   -- formed immediately (IMM) or is implicitly regenerated
   -- (IRG).


   -- ERROR_FILE_TYPE                            LEVEL ma

   subtype ERROR_FILE_TYPE is STRING;

   -- Defines the type for error file specification.  The
   -- name used must conform to an external file name as
   -- defined for the host system implementation.


   -- ERROR_INDICATOR                            LEVEL ma

   type ERROR_INDICATOR is new INTEGER;

   -- Defines the type for error indicator values.


   -- FILL_AREA_INDEX                            LEVEL 0a

   type FILL_AREA_INDEX is new POSITIVE;

   -- Defines the type for fill area bundle table indices.


   -- FILL_AREA_INDICES                          LEVEL 0a

   package FILL_AREA_INDICES is new GKS_LIST_UTILITIES
      (FILL_AREA_INDEX);

   -- Provides for list of fill area bundle table indices.

   function "&" (LEFT, RIGHT: FILL_AREA_INDICES.LIST_VALUES) return
      FILL_AREA_INDICES.LIST_VALUES renames FILL_AREA_INDICES."&";


   -- GDP_ID                                     LEVEL 0a

   type GDP_ID is new INTEGER;

   -- Defines a type for selecting a Generalized Drawing Primitive.


   -- GDP_IDS                                    LEVEL 0a

   package GDP_IDS is new GKS_LIST_UTILITIES (GDP_ID);

   -- Provides for lists of Generalized Drawing Primitive ID's.

   function "&" (LEFT, RIGHT: GDP_IDS.LIST_VALUES) return
      GDP_IDS.LIST_VALUES renames GDP_IDS."&";


   -- GKS_LEVEL                                  LEVEL ma

   type GKS_LEVEL is (Lma,
                      Lmb,
                      Lmc,
                      L0a,
                      L0b,
                      L0c,
                      L1a,
                      L1b,
                      L1c,
                      L2a,
                      L2b,
                      L2c);

   -- The valid Levels of GKS.


   -- GKSM_ITEM_TYPE                             LEVEL 0a

   type GKSM_ITEM_TYPE is new NATURAL;

   -- The type of an item contained in a GKSM metafile.


   -- STYLE_INDEX                                LEVEL 0a

   type STYLE_INDEX is new INTEGER;

   -- Defines a fill area style index.


   -- HATCH_STYLE                                LEVEL ma

   subtype HATCH_STYLE is STYLE_INDEX;

   -- Defines the fill area hatch styles type.


   -- HATCH_STYLES                               LEVEL ma

   package HATCH_STYLES is new GKS_LIST_UTILITIES (HATCH_STYLE);

   -- Provides for a list of hatch styles.

   function "&" (LEFT, RIGHT: HATCH_STYLES.LIST_VALUES) return
      HATCH_STYLES.LIST_VALUES renames HATCH_STYLES."&";


   -- HORIZONTAL_ALIGNMENT                       LEVEL ma

   type HORIZONTAL_ALIGNMENT is (NORMAL,
                                 LEFT,
                                 CENTRE,
                                 RIGHT);

   -- The alignment of the text extent rectangle with
   -- respect to the horizontal positioning of the text.


   -- INTERIOR_STYLE                             LEVEL ma

   type INTERIOR_STYLE is (HOLLOW,
                           SOLID,
                           PATTERN,
                           HATCH);

   -- Defines the fill area interior styles.


   -- INTERIOR_STYLES                            LEVEL ma

   package INTERIOR_STYLES is new GKS_LIST_UTILITIES (INTERIOR_STYLE);

   -- Provides for lists of interior styles.

   function "&" (LEFT, RIGHT: INTERIOR_STYLES.LIST_VALUES) return
      INTERIOR_STYLES.LIST_VALUES renames INTERIOR_STYLES."&";


   -- INVALID_VALUES_INDICATOR                   LEVEL 0a

   type INVALID_VALUES_INDICATOR is (ABSENT,
                                     PRESENT);

   -- Indicates whether invalid values are contained
   -- in a pixel array or matrix.


   -- LINETYPE                                   LEVEL ma

   type LINETYPE is new INTEGER;

   -- Defines the types of line styles provided by GKS.


   -- LINE_WIDTH                                 LEVEL ma

   type LINE_WIDTH is new SCALE_FACTOR
      range 0.0..SCALE_FACTOR'LAST;

   -- The width of a line is indicated by a scale factor.


   -- LINETYPES                                  LEVEL ma

   package LINETYPES is new GKS_LIST_UTILITIES (LINETYPE);

   -- Provides for lists of line types.

   function "&" (LEFT, RIGHT: LINETYPES.LIST_VALUES) return
      LINETYPES.LIST_VALUES renames LINETYPES."&";


   -- MARKER_TYPE                                LEVEL ma

   type MARKER_TYPE is new INTEGER;

   -- Defines the type for markers provided by GKS.


   -- MARKER_SIZE                                LEVEL ma

   type MARKER_SIZE is new SCALE_FACTOR
      range 0.0..SCALE_FACTOR'LAST;

   -- The size of a marker is indicated by a scale factor.


   -- MARKER_TYPES                               LEVEL ma

   package MARKER_TYPES is new GKS_LIST_UTILITIES (MARKER_TYPE);

   -- Provides for lists of marker types.

   function "&" (LEFT, RIGHT: MARKER_TYPES.LIST_VALUES) return
      MARKER_TYPES.LIST_VALUES renames MARKER_TYPES."&";


   -- MEMORY_UNITS                               LEVEL ma

   type MEMORY_UNITS is range 0..MAX_MEMORY_UNITS;

   -- Defines the type of the units of memory that may be
   -- allocated for GKS.


   -- NDC_TYPE                                   LEVEL ma

   type NDC_TYPE is digits PRECISION;

   -- Defines the type of a coordinate in the Normalized
   -- Device Coordinate System.


   -- NDC                                        LEVEL ma

   package NDC is new GKS_COORDINATE_SYSTEM (NDC_TYPE);

   -- Defines the Normalized Device Coordinate System.

   function "=" (LEFT, RIGHT: NDC.POINT) return BOOLEAN
      renames NDC."=";

   function "&" (LEFT, RIGHT: NDC.POINT_ARRAY) return
      NDC.POINT_ARRAY renames NDC."&";

   function "=" (LEFT, RIGHT: NDC.VECTOR) return BOOLEAN
      renames NDC."=";

   function "=" (LEFT, RIGHT: NDC.RECTANGLE_LIMITS) return BOOLEAN
      renames NDC."=";

   function "=" (LEFT, RIGHT: NDC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames NDC."=";

   function "<" (LEFT, RIGHT: NDC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames NDC."<";

   function "<=" (LEFT, RIGHT: NDC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames NDC."<=";

   function ">" (LEFT, RIGHT: NDC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames NDC.">";

   function ">=" (LEFT, RIGHT: NDC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames NDC.">=";

   function "+" (LEFT, RIGHT: NDC.MAGNITUDE_BASE_TYPE) return
      NDC.MAGNITUDE_BASE_TYPE renames NDC."+";

   function "-" (LEFT, RIGHT: NDC.MAGNITUDE_BASE_TYPE) return
      NDC.MAGNITUDE_BASE_TYPE renames NDC."-";

   function "*" (LEFT, RIGHT: NDC.MAGNITUDE_BASE_TYPE) return
      NDC.MAGNITUDE_BASE_TYPE renames NDC."*";

   function "/" (LEFT, RIGHT: NDC.MAGNITUDE_BASE_TYPE) return
      NDC.MAGNITUDE_BASE_TYPE renames NDC."/";

   function "=" (LEFT, RIGHT: NDC.SIZE) return BOOLEAN
      renames NDC."=";

   function "=" (LEFT, RIGHT: NDC.RANGE_OF_MAGNITUDES) return BOOLEAN
      renames NDC."=";


   -- NEW_FRAME_NECESSARY                        LEVEL 0a

   type NEW_FRAME_NECESSARY is (NO,
                                YES);

   -- Indicates whether a new frame action is necessary at
   -- update.


   -- OPERATING_STATE                            LEVEL 0a

   type OPERATING_STATE is (GKCL,
                            GKOP,
                            WSOP,
                            WSAC,
                            SGOP);

   -- Defines the five GKS operating states.


   -- PATTERN_INDEX                              LEVEL 0a

   subtype PATTERN_INDEX is STYLE_INDEX range 1..STYLE_INDEX'LAST;

   -- Defines the range of pattern table indices.


   -- PATTERN_INDICES                            LEVEL 0a

   package PATTERN_INDICES is new GKS_LIST_UTILITIES (PATTERN_INDEX);

   -- Provides for lists of pattern table indices.

   function "&" (LEFT, RIGHT: PATTERN_INDICES.LIST_VALUES) return
      PATTERN_INDICES.LIST_VALUES renames PATTERN_INDICES."&";


   -- PIXEL_COLOUR_MATRICES                      LEVEL 0a

   package PIXEL_COLOUR_MATRICES is new GKS_MATRIX_UTILITIES
      (PIXEL_COLOUR_INDEX);

   -- Provides for variable sized matrices of pixel colours.


   -- POLYLINE_INDEX                             LEVEL 0a

   type POLYLINE_INDEX is new POSITIVE;

   -- Defines the range of polyline indices.


   -- POLYLINE_INDICES                           LEVEL 0a

   package POLYLINE_INDICES is new GKS_LIST_UTILITIES (POLYLINE_INDEX);

   -- Provides for lists of polyline indices.

   function "&" (LEFT, RIGHT: POLYLINE_INDICES.LIST_VALUES) return
      POLYLINE_INDICES.LIST_VALUES renames POLYLINE_INDICES."&";


   -- POLYMARKER_INDEX                           LEVEL 0a

   type POLYMARKER_INDEX is new POSITIVE;

   -- Defines the range of polymarker bundle table indices.


   -- POLYMARKER_INDICES                         LEVEL 0a

   package POLYMARKER_INDICES is new GKS_LIST_UTILITIES
      (POLYMARKER_INDEX);

   -- Provides for lists of polymarker indices.

   function "&" (LEFT, RIGHT: POLYMARKER_INDICES.LIST_VALUES) return
      POLYMARKER_INDICES.LIST_VALUES renames POLYMARKER_INDICES."&";


   -- RADIANS                                    LEVEL 1a

   type RADIANS is digits PRECISION;

   -- Values used in performing segment transformations
   -- (rotation angle).  Positive indicates an anticlock-
   -- wise direction.


   -- RANGE_OF_EXPANSIONS                        LEVEL 0a

   type RANGE_OF_EXPANSIONS is
      record
         MIN : CHAR_EXPANSION;
         MAX : CHAR_EXPANSION;
      end record;

   -- Provides a range of character expansion factors.


   -- RASTER_UNITS                               LEVEL ma

   type RASTER_UNITS is new POSITIVE;

   -- Defines the range of raster units.


   -- RASTER_UNIT_SIZE                           LEVEL ma

   type RASTER_UNIT_SIZE is
      record
         X : RASTER_UNITS;
         Y : RASTER_UNITS;
      end record;

   -- Defines the size of an object in raster units on a raster device.


   -- REGENERATION_MODE                          LEVEL 0a

   type REGENERATION_MODE is (SUPPRESSED,
                              ALLOWED);

   -- Indicates whether implicit regeneration of the display is
   -- suppressed or allowed.


   -- RELATIVE_PRIORITY                          LEVEL ma

   type RELATIVE_PRIORITY is (HIGHER,
                              LOWER);

   -- Indicates the relative priority between two normalization
   -- transformations.


   -- RETURN_VALUE_TYPE                          LEVEL ma

   type RETURN_VALUE_TYPE is (SET,
                              REALIZED);

   -- Indicates whether the returned values should be as
   -- they were set by the program or as they were actually
   -- realized on the device.


   -- SEGMENT_DETECTABILITY                      LEVEL 1a

   type SEGMENT_DETECTABILITY is (UNDETECTABLE,
                                  DETECTABLE);

   -- Indicates whether a segment is detectable or not.


   -- SEGMENT_HIGHLIGHTING                       LEVEL 1a

   type SEGMENT_HIGHLIGHTING is (NORMAL,
                                 HIGHLIGHTED);

   -- Indicates whether a segment is highlighted or not.


   -- SEGMENT_NAME                               LEVEL 1a

   type SEGMENT_NAME is new POSITIVE;

   --  Defines the range of segment names.


   -- SEGMENT_NAMES                              LEVEL 1a

   package SEGMENT_NAMES is new GKS_LIST_UTILITIES (SEGMENT_NAME);

   -- Provides for lists of segment names.

   function "&" (LEFT, RIGHT: SEGMENT_NAMES.LIST_VALUES) return
      SEGMENT_NAMES.LIST_VALUES renames SEGMENT_NAMES."&";


   -- SEGMENT_PRIORITY                           LEVEL 1a

   type SEGMENT_PRIORITY is digits PRECISION range 0.0..1.0;

   --  Defines the priority of a segment.


   -- SEGMENT_VISIBILITY                         LEVEL 1a

   type SEGMENT_VISIBILITY is (VISIBLE,
                               INVISIBLE);

   -- Indicates whether a segment is visible or not.


   -- SUBPROGRAM_NAME                            LEVEL ma

   subtype SUBPROGRAM_NAME is STRING;

   -- Defines the name of a GKS function detecting an error.


   -- VERTICAL_ALIGNMENT                         LEVEL ma

   type VERTICAL_ALIGNMENT is (NORMAL,
                               TOP,
                               CAP,
                               HALF,
                               BASE,
                               BOTTOM);

   -- The alignment of the text extent parallelogram with
   -- respect to the vertical positioning of the text.


   -- TEXT_ALIGNMENT                             LEVEL ma

   type TEXT_ALIGNMENT is
      record
         HORIZONTAL : HORIZONTAL_ALIGNMENT;
         VERTICAL   : VERTICAL_ALIGNMENT;
      end record;

   -- The type of the attribute controlling the positioning
   -- of the text extent parallelogram in relation to the text
   -- position, having horizontal and vertical components as
   -- defined above.


   -- WC_TYPE                                    LEVEL ma

   type WC_TYPE is digits PRECISION;

   --  Defines the range of accuracy for World Coordinate types.


   -- WC                                         LEVEL ma

   package WC is new GKS_COORDINATE_SYSTEM (WC_TYPE);

   -- Defines the World Coordinate System.

   function "=" (LEFT, RIGHT: WC.POINT) return BOOLEAN
      renames WC."=";

   function "&" (LEFT, RIGHT: WC.POINT_ARRAY) return
      WC.POINT_ARRAY renames WC."&";

   function "=" (LEFT, RIGHT: WC.VECTOR) return BOOLEAN
      renames WC."=";

   function "=" (LEFT, RIGHT: WC.RECTANGLE_LIMITS) return BOOLEAN
      renames WC."=";

   function "=" (LEFT, RIGHT: WC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames WC."=";

   function "<" (LEFT, RIGHT: WC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames WC."<";

   function "<=" (LEFT, RIGHT: WC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames WC."<=";

   function ">" (LEFT, RIGHT: WC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames WC.">";

   function ">=" (LEFT, RIGHT: WC.MAGNITUDE_BASE_TYPE) return BOOLEAN
      renames WC.">=";

   function "+" (LEFT, RIGHT: WC.MAGNITUDE_BASE_TYPE) return
      WC.MAGNITUDE_BASE_TYPE renames WC."+";

   function "-" (LEFT, RIGHT: WC.MAGNITUDE_BASE_TYPE) return
      WC.MAGNITUDE_BASE_TYPE renames WC."-";

   function "*" (LEFT, RIGHT: WC.MAGNITUDE_BASE_TYPE) return
      WC.MAGNITUDE_BASE_TYPE renames WC."*";

   function "/" (LEFT, RIGHT: WC.MAGNITUDE_BASE_TYPE) return
      WC.MAGNITUDE_BASE_TYPE renames WC."/";

   function "=" (LEFT, RIGHT: WC.SIZE) return BOOLEAN
      renames WC."=";

   function "=" (LEFT, RIGHT: WC.RANGE_OF_MAGNITUDES) return BOOLEAN
      renames WC."=";


   -- TEXT_EXTENT_PARALLELOGRAM                  LEVEL ma

   type TEXT_EXTENT_PARALLELOGRAM is
      record
         LOWER_LEFT  : WC.POINT;
         LOWER_RIGHT : WC.POINT;
         UPPER_LEFT  : WC.POINT;
         UPPER_RIGHT : WC.POINT;
      end record;

   -- Defines the corner points of the text extent parallelogram
   -- with respect to the vertical positioning of the text.


   -- TEXT_FONT                                  LEVEL ma

   type TEXT_FONT is new INTEGER;

   -- Defines the types of fonts provided by the implementation.



   -- TEXT_PRECISION                             LEVEL ma

   type TEXT_PRECISION is (STRING_PRECISION,
                           CHAR_PRECISION,
                           STROKE_PRECISION);

   -- The precision with which text appears.

   -- TEXT_FONT_PRECISION                        LEVEL ma

   type TEXT_FONT_PRECISION is
      record
         FONT      : TEXT_FONT;
         PRECISION : TEXT_PRECISION;
      end record;

   -- This type defines a record describing the text font and
   -- precision aspect.


   -- TEXT_FONT_PRECISIONS                       LEVEL ma

   package TEXT_FONT_PRECISIONS is new GKS_LIST_UTILITIES
      (TEXT_FONT_PRECISION);

   --  Provides for lists of text font and precision pairs.

   function "&" (LEFT, RIGHT: TEXT_FONT_PRECISIONS.LIST_VALUES) return
      TEXT_FONT_PRECISIONS.LIST_VALUES renames
         TEXT_FONT_PRECISIONS."&";


   -- TEXT_INDEX                                 LEVEL 0a

   type TEXT_INDEX is new POSITIVE;

   -- Defines the range of text bundle table indices.


   -- TEXT_INDICES                               LEVEL 0a

   package TEXT_INDICES is new GKS_LIST_UTILITIES (TEXT_INDEX);

   -- Provides for lists of text indices.

   function "&" (LEFT, RIGHT: TEXT_INDICES.LIST_VALUES) return
      TEXT_INDICES.LIST_VALUES renames TEXT_INDICES."&";


   -- TEXT_PATH                                  LEVEL ma

   type TEXT_PATH is (RIGHT,
                      LEFT,
                      UP,
                      DOWN);

   --  The direction taken by a text string.


   -- TRANSFORMATION_FACTOR                      LEVEL 1a

   type TRANSFORMATION_FACTOR is
      record
         X : NDC_TYPE;
         Y : NDC_TYPE;
      end record;

   -- Scale factors used in building transformation
   -- matrices for performing segment transformations.


   -- TRANSFORMATION_MATRIX                      LEVEL 1a

   type TRANSFORMATION_MATRIX is array (1..2, 1..3) of NDC_TYPE;

   -- For segment transformation mapping within NDC space.


   -- TRANSFORMATION_NUMBER                      LEVEL ma

   type TRANSFORMATION_NUMBER is new NATURAL;

   -- A normalization transformation number.


   -- TRANSFORMATION_PRIORITY_ARRAY              LEVEL ma

   type TRANSFORMATION_PRIORITY_ARRAY is array (POSITIVE range <>) of
      TRANSFORMATION_NUMBER;

   -- Defines the type to store transformation numbers.


   -- TRANSFORMATION_PRIORITY_LIST               LEVEL ma

   type TRANSFORMATION_PRIORITY_LIST (LENGTH : SMALL_NATURAL := 0) is
      record
         CONTENTS : TRANSFORMATION_PRIORITY_ARRAY (1..LENGTH);
      end record;

   -- Provides for a prioritized list of transformation numbers.


   -- UPDATE_REGENERATION_FLAG                   LEVEL 0a

   type UPDATE_REGENERATION_FLAG is (PERFORM,
                                     POSTPONE);

   -- Flag indicating regeneration action on display.


   -- UPDATE_STATE                               LEVEL ma

   type UPDATE_STATE is (NOTPENDING,
                         PENDING);

   -- Indicates whether or not a workstation transformation
   -- change has been requested and not yet provided.


   -- VARIABLE_CONNECTION_ID                     LEVEL ma

   type VARIABLE_CONNECTION_ID (LENGTH : SMALL_NATURAL := 0) is
      record
         CONNECT : CONNECTION_ID (1..LENGTH);
      end record;

   -- Defines a variable length connection id for INQ_WS_CONNECTION_
   -- AND_TYPE.


   -- VARIABLE_SUBPROGRAM_NAME                   LEVEL ma

   type VARIABLE_SUBPROGRAM_NAME (LENGTH : SMALL_NATURAL := 0) is
      record
         CONTENTS : SUBPROGRAM_NAME (1..LENGTH);
      end record;

   -- Defines a variable length subprogram name.


   -- WS_CATEGORY                                LEVEL 0a

   type WS_CATEGORY is (OUTPUT,
                        INPUT,
                        OUTIN,
                        WISS,
                        MO,
                        MI);

   -- Type for GKS workstation categories.


   -- WS_ID                                      LEVEL ma

   type WS_ID is new POSITIVE;

   -- Defines the range of workstation identifiers.


   -- WS_IDS                                     LEVEL ma

   package WS_IDS is new GKS_LIST_UTILITIES (WS_ID);

   -- Provides for lists of workstation identifiers.

   function "&" (LEFT, RIGHT: WS_IDS.LIST_VALUES) return
      WS_IDS.LIST_VALUES renames WS_IDS."&";


   -- WS_STATE                                   LEVEL 0a

   type WS_STATE is (INACTIVE,
                     ACTIVE);

   -- The state of a workstation.


   -- WS_TYPE                                    LEVEL ma

   type WS_TYPE is range 1..MAX_WS_TYPE;

   -- Range of values corresponding to valid workstation
   -- types.  Constants specifying names for the various
   -- types of workstations should be provided by an
   -- implementation in the GKS_CONFIGURATION package.


   -- WS_TYPES                                   LEVEL 0a

   package WS_TYPES is new GKS_LIST_UTILITIES (WS_TYPE);

   -- Provides for lists of workstation types.

   function "&" (LEFT, RIGHT: WS_TYPES.LIST_VALUES) return
      WS_TYPES.LIST_VALUES renames WS_TYPES."&";

   -- INDIVIDUAL_ATTRIBUTE_VALUES

   type INDIVIDUAL_ATTRIBUTE_VALUES is
      record
         CURRENT_LINETYPE          :  LINETYPE;
         CURRENT_LINE_WIDTH        :  LINE_WIDTH;
         CURRENT_POLYLINE_COLOUR   :  COLOUR_INDEX;
         CURRENT_MARKER_TYPE       :  MARKER_TYPE;
         CURRENT_POLYMARKER_SIZE   :  MARKER_SIZE;
         CURRENT_POLYMARKER_COLOUR :  COLOUR_INDEX;
         CURRENT_FONT_PRECISION    :  TEXT_FONT_PRECISION;
         CURRENT_CHAR_EXPANSION    :  CHAR_EXPANSION;
         CURRENT_CHAR_SPACING      :  CHAR_SPACING;
         CURRENT_TEXT_COLOUR       :  COLOUR_INDEX;
         CURRENT_INTERIOR_STYLE    :  INTERIOR_STYLE;
         CURRENT_STYLE_INDEX       :  STYLE_INDEX;
         CURRENT_FILL_AREA_COLOUR  :  COLOUR_INDEX;
         CURRENT_ASF_LIST          :  ASF_LIST;
      end record;

   -- A record containing all of the current individual
   -- attributes.


   -- PRIMITIVE_ATTRIBUTE_VALUES

   type PRIMITIVE_ATTRIBUTE_VALUES is
      record
         CURRENT_POLYLINE_INDEX          :  POLYLINE_INDEX;
         CURRENT_POLYMARKER_INDEX        :  POLYMARKER_INDEX;
         CURRENT_TEXT_INDEX              :  TEXT_INDEX;
         CURRENT_CHAR_HEIGHT             :  WC.MAGNITUDE;
         CURRENT_CHAR_UP_VECTOR          :  WC.VECTOR;
         CURRENT_CHAR_WIDTH              :  WC.MAGNITUDE;
         CURRENT_CHAR_BASE_VECTOR        :  WC.VECTOR;
         CURRENT_TEXT_PATH               :  TEXT_PATH;
         CURRENT_TEXT_ALIGNMENT          :  TEXT_ALIGNMENT;
         CURRENT_FILL_AREA_INDEX         :  FILL_AREA_INDEX;
         CURRENT_PATTERN_WIDTH_VECTOR    :  WC.VECTOR;
         CURRENT_PATTERN_HEIGHT_VECTOR   :  WC.VECTOR;
         CURRENT_PATTERN_REFERENCE_POINT :  WC.POINT;
      end record;

   -- A record containing all of the current primitive
   -- attributes.


   -- The following exceptions correspond to the classes of
   -- errors defined by the GKS specification.  Each of these
   -- exceptions cover one or more error numbers.

   ESCAPE_ERROR                   : exception;

   IMPLEMENTATION_DEPENDENT_ERROR : exception;

   INPUT_ERROR                    : exception;

   LANGUAGE_BINDING_ERROR         : exception;

   METAFILE_ERROR                 : exception;

   MISC_ERROR                     : exception;

   OUTPUT_ATTRIBUTE_ERROR         : exception;

   OUTPUT_PRIMITIVE_ERROR         : exception;

   SEGMENT_ERROR                  : exception;

   STATE_ERROR                    : exception;

   SYSTEM_ERROR                   : exception;

   TRANSFORMATION_ERROR           : exception;

   WS_ERROR                       : exception;

end GKS_TYPES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI3700_COMM.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_COMMUNICATION
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : LEXI3700_COMM.ADA
-- LEVEL: ALL

package LEXI3700_COMMUNICATION is

-- This package communicates with the Lexidata Graphics Device.

    type BIT_16 is range 16#0000# .. 16#FFFF#;
    -- The upper range FFFF will allow a 16 bit value to be stored here.
    -- If 7FFF is used for the upper range, the Ada compiler allocates
    -- a 16 bit word instead of the 32 bit word. This will cause the
    -- assembly language routine to work incorrectly.

    type LEXIDATA_ARRAY is array (POSITIVE range <>) of BIT_16;
    -- LEXIDATA_ARRAY is an unconstrained array of a 16 bit value
    -- that is sent to the Lexidata 3700.

    procedure CLOSE_LEXIDATA;

    procedure FLUSH_BUFFER
       (WAIT_TO_FINISH : BOOLEAN := true);

    procedure OPEN_LEXIDATA
       (CHANNEL_IN  : INTEGER;
        CHANNEL_OUT : INTEGER;
        ERROR_CODE  : out INTEGER);

    procedure READ_FROM_BUFFER
       (READ_BUFFER   : in out LEXIDATA_ARRAY);

    procedure WRITE_TO_BUFFER
       (WRITE_BUFFER  : LEXIDATA_ARRAY);

end LEXI3700_COMMUNICATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI3700_COMM_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_COMMUNICATION - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : LEXI3700_COMM_B.ADA
-- LEVEL: ALL

with IMPORT_OPEN;
with IMPORT_VARIABLES;
with IMPORT_WRITE;
with IMPORT_WAIT;
with IMPORT_READ;
with SYS_CALLS;

package body LEXI3700_COMMUNICATION is

-- The body of this package uses the assembly language interface
-- procedures to communicate with the device.

   MAX_BUFFER_SIZE : constant := 256;
   -- The size of one buffer.

   subtype LEXI_BUFFER is LEXIDATA_ARRAY (1 .. MAX_BUFFER_SIZE * 2);
   -- LEXI_BUFFER is the double buffer used to buffer commands to
   -- send to the Lexidata 3700.

   BUF_START    : INTEGER := 1;
   -- Dynamically changing pointer to the first position of the current
   -- buffer.

   BUF_POINTER  : INTEGER := 1;
   -- Dynamically changing pointer to the last word written in the
   -- buffer.

   OUT_BUFFER   : LEXI_BUFFER;
   -- Internally maintained buffer of data going to the Lexidata 3700.

   procedure CLOSE_LEXIDATA is

   -- CLOSE_LEXIDATA is a system dependant procedure which actually
   -- makes a Data General system call to close the channel/device.

        AC0     : INTEGER := 0;
        -- AC0 - System register required for Data General system calls.

        AC1     : INTEGER := 0;
        -- AC1 - System register required for Data General system calls.

        AC2     : INTEGER := 0;
        -- AC2 - System register required for Data General system calls.

        ER      : SYS_CALLS.ERROR_CODE;
        -- ER - Error return parameter not used in this call.

    begin

       IMPORT_WRITE.ADA_PHWRIT (0, 0, true);
       SYS_CALLS.SYS (SYS_CALLS.DDIS, AC0, AC1, AC2, ER);

    end CLOSE_LEXIDATA;

    procedure FLUSH_BUFFER
       (WAIT_TO_FINISH : BOOLEAN := true) is

    -- This procedure flushs the current buffer and waits until
    -- the assembly language routine is finished.
    --
    -- WAIT_TO_FINISH - flag set on buffer contents check.

    begin

       IMPORT_WAIT.ADA_PHOWT;
       -- check to make sure buffer has contents.
       if BUF_POINTER /= BUF_START then
          IMPORT_WRITE.ADA_PHWRIT(OUT_BUFFER(BUF_START)'ADDRESS,
                               BUF_POINTER - BUF_START,
                               WAIT_TO_FINISH);
          -- switch buffers.
          if BUF_START = 1 then
             BUF_START   := MAX_BUFFER_SIZE + 1;
             BUF_POINTER := MAX_BUFFER_SIZE + 1;
          else
             BUF_START   := 1;
             BUF_POINTER := 1;
          end if;
       end if;
    end FLUSH_BUFFER;

   procedure OPEN_LEXIDATA
      (CHANNEL_IN  : INTEGER;
       CHANNEL_OUT : INTEGER;
       ERROR_CODE  : out INTEGER) is

   -- This procedure opens up communication to the device.
   --
   -- CHANNEL_IN  - is the I/O channel used for output from the host.
   -- CHANNEL_OUT - is the I/O channel used for input to the host.
   -- ERROR_CODE  - is an error that is passed back to the caller. This
   --               error number is host dependent.

   begin

      IMPORT_OPEN.ADA_PHDOPN(CHANNEL_IN, CHANNEL_OUT, ERROR_CODE);

   end OPEN_LEXIDATA;

   procedure READ_FROM_BUFFER
       (READ_BUFFER : in out LEXIDATA_ARRAY) is

    -- This procedure reads from the device.
    --
    -- READ_BUFFER - contains the array of data read from the device.

    begin

        -- call the assembly routine

        IMPORT_READ.ADA_PHREAD(READ_BUFFER(1)'address, READ_BUFFER'length,
                           true);

    end READ_FROM_BUFFER;

    procedure WRITE_TO_BUFFER
       (WRITE_BUFFER : LEXIDATA_ARRAY) is

    -- This procedure double buffers data sent to the display processor.
    --
    -- This procedure uses two buffers to send data to the display.
    -- Once one buffer is full, that full buffer is sent to the assembly
    -- language routine to start transmitting. While one buffer is being
    -- transmitted to the display processor, the other buffer can be used.
    -- There is a wait assembly routine that makes sure the transmit
    -- assembly routine is finished with one buffer before receiving
    -- another buffer to transmit.
    --
    -- WRITE_BUFFER - buffer of data to be sent to the LEXIDATA.

    CURRENT_POINTER : INTEGER;
    -- pointer of incoming buffer

    WORD_COUNT : INTEGER;
    -- counts the number of items in the incoming buffer

    REMAINING_SPACE : INTEGER;
    -- contains the amount of REMAINING_SPACE in the output buffer

    begin

     -- Check to see if the incoming buffer fits into the current buffer.
     -- Initialize loop that runs while the word count is greater than
     -- or equal to the REMAINING_SPACE available in the current buffer.
     -- Then copy as many words that will fit in the current buffer and
     -- call FLUSH. FLUSH passes out the current buffer and switch
     -- the buffers to continue packing the incoming buffer.

       WORD_COUNT := WRITE_BUFFER'LENGTH;
       CURRENT_POINTER := WRITE_BUFFER'FIRST;
       REMAINING_SPACE  := BUF_START + MAX_BUFFER_SIZE - BUF_POINTER;
       while (WORD_COUNT >= REMAINING_SPACE) loop
             OUT_BUFFER(BUF_POINTER .. (BUF_POINTER + REMAINING_SPACE - 1)) :=
                   WRITE_BUFFER(CURRENT_POINTER .. (CURRENT_POINTER + REMAINING_
SPACE - 1));
             CURRENT_POINTER := CURRENT_POINTER + REMAINING_SPACE;
             BUF_POINTER := BUF_POINTER + REMAINING_SPACE;
             FLUSH_BUFFER(false);
             WORD_COUNT := WORD_COUNT - REMAINING_SPACE;
             REMAINING_SPACE  := BUF_START + MAX_BUFFER_SIZE - BUF_POINTER;
        end loop;

        -- The remaining words of the incoming buffer will fit into the
        -- current buffer. Therefore the loop is exited and the
        -- rest of the incoming buffer is packed into the current buffer.
        -- If WORD_COUNT is equal to zero, then it was packed in and flushed.

        if WORD_COUNT > 0 then
           OUT_BUFFER(BUF_POINTER .. BUF_POINTER + WORD_COUNT - 1) :=
                WRITE_BUFFER(CURRENT_POINTER .. CURRENT_POINTER + WORD_COUNT - 1
);
           BUF_POINTER := BUF_POINTER + WORD_COUNT;
        end if;

    end WRITE_TO_BUFFER;

end LEXI3700_COMMUNICATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI3700_CONFIG.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_CONFIGURATION
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  DR012  Text character spacing.
------------------------------------------------------------------
-- FILE : LEXI3700_CONFIG.ADA
-- LEVEL: ALL

PACKAGE LEXI3700_CONFIGURATION is

-- This package contains device specific values that control
-- the appearance of output on the display.

   NUM_OF_BITS_USED_FOR_SYSTEM       : constant := 8;
   -- Number of bits used to describe each pixel in the lookup table.
   -- This number of bits provide the possible intensity values available.

   NUM_OF_BITS_USED_FOR_SIZE_OF_CLUT : constant := 8;
   -- This refers to the amount of memory space available in a lookup table.

   LEXI_MAXIMUM_PLANE_VALUE : constant :=
        (2 ** NUM_OF_BITS_USED_FOR_SYSTEM) - 1;
   -- Is used to mask different planes for different operations.

   LEXI_MAXIMUM_COLOUR_INDEX : constant :=
        (2 ** (NUM_OF_BITS_USED_FOR_SIZE_OF_CLUT - 1));
   -- The number of valid colour indices supported, the last plane is
   -- used for edge fill for filling polygons.

   LEXI_MAXIMUM_COLOUR_INTENSITY : constant :=
        (2 ** NUM_OF_BITS_USED_FOR_SYSTEM) - 1;
   -- Is the maximum colour intensity allowed to specified each colour
   -- index.

   LEXI_NUMBER_OF_LINE_TYPES : constant := 4;
   -- Tells how many line types the device offers.

   LEXI_NUMBER_OF_MARKER_TYPES : constant := 5;
   -- Tells how many marker types the device offers.

   LEXI_NOMINAL_LINE_WIDTH : constant := 1;
   LEXI_MINIMUM_LINE_WIDTH : constant := 1;
   LEXI_MAXIMUM_LINE_WIDTH : constant := 50;
   -- Tells the range of line widths the device offers.

   LEXI_NOMINAL_TEXT_SIZE  : constant := 1;
   LEXI_MINIMUM_TEXT_SIZE  : constant := 1;
   LEXI_MAXIMUM_TEXT_SIZE  : constant := 50;
   -- Tells the range of text sizes that the device offers.

   LEXI_FILL_PLANE_VALUE : constant := 2 ** (NUM_OF_BITS_USED_FOR_SYSTEM - 1);
   -- Is the plane used for fill area.

   LEXI_CHARACTER_FONT_HEIGHT : constant := 12;
   LEXI_CHARACTER_FONT_WIDTH  : constant := 9;
   -- This includes a pixel space on both sides.
   LEXI_CHARACTER_FONT        : constant := 9.0 / 12.0;
   LEXI_CHARACTER_FONT_CAP_TOP : constant := 1.0 / 12.0;
   LEXI_CHARACTER_FONT_BASE_BOTTOM : constant := 1.0 / 12.0;
   -- Describes the hardware text font designer.

   LEXI_X_MAXIMUM : constant := 1279;
   LEXI_Y_MAXIMUM : constant := 1023;
   -- Tells the maximum screen size .

end LEXI3700_CONFIGURATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI3700_TYPES.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_TYPES
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  Not listed
------------------------------------------------------------------
-- FILE : LEXI3700_TYPES.ADA
-- LEVEL: ALL

with LEXI3700_CONFIGURATION;

use  LEXI3700_CONFIGURATION;

package LEXI3700_TYPES is

-- The package LEXI3700_CONFIGURATION contains the specific values
-- that control the appearance of output on the display.

   type LEXI_PATTERN_SIZE is new INTEGER;
   -- LEXI_PATTERN_SIZE is used to describe the pattern size for vectors
   -- and arcs. Used with procedure SET_DISPLAY_PARAMETERS.

   type LEXI_RADIUS_TYPE is range 1 .. LEXI_X_MAXIMUM;
   --LEXI_RADIUS_TYPE is used to describe the radius of circles and
   -- arcs.

   type LEXI_PLANE_VALUE is range 0 .. LEXI_MAXIMUM_PLANE_VALUE;
   -- LEXI_PLANE_VALUE describes the display memory planes available.

   type LEXI_COORDINATE is range 0 .. LEXI_X_MAXIMUM;
   -- LEXI_COORDINATE describes the range of coordinates for the Lexidata.

   type LEXI_COUNT_VALUE is new NATURAL;
   -- LEXI_COUNT_VALUE describes the range of arc size and starting
   -- position for the DISPLAY_ARC procedure.

   type LEXI_PLANE_ADDRESS is new INTEGER;
   -- LEXI_PLANE_ADDRESS describes the range of values for the Red,
   -- Green, and Blue plane address.

   type LEXI_POINT is record
        X : LEXI_COORDINATE;
        Y : LEXI_COORDINATE;
   end record;
   -- LEXI_POINT describes a record for the x and y coordinates of a
   -- point.

   type LEXI_POINTS is array (POSITIVE range <>) of LEXI_POINT;
   -- LEXI_POINTS creates a unconstrained array of x and y coordinates.

   type LEXI_COLOUR_INDEX is range 0 .. LEXI_MAXIMUM_COLOUR_INDEX;
   -- LEXI_COLOUR_INDEX is the range of valid colour indices.

   type LEXI_COLOUR_INTENSITY is range 0 .. LEXI_MAXIMUM_COLOUR_INTENSITY;
   -- LEXI_COLOUR_INTENSITY is the range of valid intensity values.

   type LEXI_PIXEL_COLOUR is record
        RED   : LEXI_COLOUR_INTENSITY;
        BLUE  : LEXI_COLOUR_INTENSITY;
        GREEN : LEXI_COLOUR_INTENSITY;
   end record;
   -- LEXI_PIXEL_COLOUR is a record made up of Red, Blue, and Green
   -- intensities.

   type LEXI_PIXEL_ARRAY_INDEX is array (POSITIVE range <>)
        of LEXI_COLOUR_INDEX;
   -- LEXI_PIXEL_ARRAY_INDEX is an unconstrained array of Red, Blue,
   -- and Green intensity values that make up a colour index.

   type LEXI_CHARACTER_PATH is (LEFT_TO_RIGHT,
                                RIGHT_TO_LEFT,
                                BOTTOM_TO_TOP,
                                TOP_TO_BOTTOM);
   -- LEXI_CHARACTER_PATH describes the offered character paths for
   -- the Lexidata 3700.

   type LEXI_ROTATE_CODE is    (NO_ROTATION,
                                ROTATION_90,
                                ROTATION_180,
                                ROTATION_270);
   -- LEXI_ROTATE_CODE describes the offered character rotations
   -- for the Lexidata 3700.

   type LEXI_CURSOR_TYPE is (NON_INTERLACED_CROSSHAIR,
                             NON_INTERLACED_MATRIX,
                             INTERLACED_CROSSHAIR,
                             INTERLACED_MATRIX);
   -- LEXI_CURSOR_TYPE describes the four cursor types offered for the
   -- Lexidata 3700.

   type LEXI_MARKER_TYPE is (PERIOD,
                             PLUS,
                             ASTERISK,
                             ZERO,
                             X_CHAR);
   -- LEXI_MARKER_TYPE defines the list of valid markers.

   type LEXI_TEXT_SIZE is range
        LEXI_MINIMUM_TEXT_SIZE .. LEXI_MAXIMUM_TEXT_SIZE;
   -- LEXI_TEXT_SIZE defines the range of text sizes.

   type LEXI_LINE_TYPE is (SOLID_LINE,
                           DASHED_LINE,
                           DOTTED_LINE,
                           DASHED_DOTTED_LINE);
   -- LEXI_LINE_TYPE is the list of valid line types that the
   -- Lexidata 3700 offers.

   type LEXI_LINE_WIDTH_TYPE is range
        LEXI_MINIMUM_LINE_WIDTH .. LEXI_MAXIMUM_LINE_WIDTH;
   -- LEXI_LINE_WIDTH_TYPE is the range of line widths.

   type LEXI_INTERIOR_STYLE is (HOLLOW, SOLID);
   -- LEXI_INTERIOR_STYLE defines the two interior styles offered.

end LEXI3700_TYPES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI_OUT_DRIVER.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_OUTPUT_DRIVER
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  Not listed
------------------------------------------------------------------
-- FILE : LEXI_OUT_DRIVER.ADA
-- LEVEL: ALL

with LEXI3700_TYPES;
with LEXI3700_CONFIGURATION;

use  LEXI3700_TYPES;

package LEXI3700_OUTPUT_DRIVER is

-- This package defines the procedure interface to the Lexidata 3700
-- graphics display device. This is a subset of the procedures supplied
-- by the Lexidata to support the GKS.
-- The naming convention used here to name the procedures in the
-- LEXI3700_DRIVER is the definition title found in the FUNCTION
-- DESCRIPTIONS Section 3 of the Lexidata manual. The definition title
-- is the definition of each function found on the top of each page
-- that describes a firmware function.
-- An example of this naming convention is the Lexidata library
-- call DSCLR with the definition title of CLEAR DISPLAY. So this is
-- the name that is used for the procedure name.

   LEXI_MARKER             : constant array (LEXI_MARKER_TYPE)
                             of STRING(1 .. 1) :=
                             (PERIOD   => ".",
                              PLUS     => "+",
                              ASTERISK => "*",
                              ZERO     => "o",
                              X_CHAR   => "x");
   -- LEXI_MARKER is an array of valid marker types.

    procedure CLEAR_DISPLAY
       (PLANE : LEXI_PLANE_VALUE := LEXI_PLANE_VALUE'last);

    procedure DEFINE_WRITE_CHANNELS
       (TEXT_CHANNEL  : LEXI_PLANE_VALUE := LEXI_PLANE_VALUE'last;
        GRAPH_CHANNEL : LEXI_PLANE_VALUE := LEXI_PLANE_VALUE'last;
        IMAGE_CHANNEL : LEXI_PLANE_VALUE := LEXI_PLANE_VALUE'last);

    procedure DISPLAY_ARC
       (CENTER      : LEXI_POINT;
        RADIUS      : LEXI_RADIUS_TYPE;
        COLOUR      : LEXI_COLOUR_INDEX;
        START       : LEXI_COUNT_VALUE;
        PIXEL_COUNT : LEXI_COUNT_VALUE);

    procedure DISPLAY_CHAINED_VECTORS
       (COLOUR : LEXI_COLOUR_INDEX;
        POINTS : LEXI_POINTS);

    procedure DISPLAY_CIRCLE
       (CENTER : LEXI_POINT;
        RADIUS : LEXI_RADIUS_TYPE;
        COLOUR : LEXI_COLOUR_INDEX);

    procedure DISPLAY_TEXT
       (TEXT : STRING);

    procedure FLUSH;

    procedure OPEN
       (CHANNEL_IN  : INTEGER;
        CHANNEL_OUT : INTEGER;
        ERROR_CODE  : out INTEGER);

    procedure POLYGON_EDGE_FLAG_FILL
       (FILL_VALUE      : LEXI_COLOUR_INDEX;
        LEXI_PLANE_MASK : LEXI_PLANE_VALUE :=
              LEXI3700_CONFIGURATION.LEXI_FILL_PLANE_VALUE);

    procedure RANDOM_PIXEL_READ
       (POINTS      : LEXI_POINTS;
        PIXEL_ARRAY : out LEXI_PIXEL_ARRAY_INDEX);

    procedure RANDOM_PIXEL_WRITE
       (POINTS  : LEXI_POINTS;
        COLOURS : LEXI_PIXEL_ARRAY_INDEX);

    procedure READ_FROM_LUT
       (COLOUR_INDEX : LEXI_COLOUR_INDEX;
        COLOUR_VALUE : out LEXI_PIXEL_COLOUR);

    procedure SET_DISPLAY_PARAMETERS
       (WIDTH : LEXI_LINE_WIDTH_TYPE;
        LINE  : LEXI_LINE_TYPE;
        FILL  : LEXI_INTERIOR_STYLE;
        SIZE  : LEXI_PATTERN_SIZE := 2);

    procedure SET_HARDWARE_CURSOR
       (CURSOR : LEXI_CURSOR_TYPE := NON_INTERLACED_MATRIX;
        XOFF   : LEXI_COORDINATE := 0;
        YOFF   : LEXI_COORDINATE := 0);

    procedure SET_RECTANGULAR_LIMIT
       (UPPER_LEFT  : LEXI_POINT;
        LOWER_RIGHT : LEXI_POINT);

    procedure SET_TEXT_CHARACTER_ROTATION
       (ROTATION : LEXI_ROTATE_CODE);

    procedure SET_TEXT_PARAMETERS
       (POSITION : LEXI_POINT;
        COLOUR   : LEXI_COLOUR_INDEX;
        PATH     : LEXI_CHARACTER_PATH;
        SIZE     : LEXI_TEXT_SIZE);

    procedure SET_TEXT_WINDOW
       (UPPER_LEFT  : LEXI_POINT;
        LOWER_RIGHT : LEXI_POINT);

    procedure SEQUENTIAL_PIXEL_WRITE
       (PIXEL_ARRAY : LEXI_PIXEL_ARRAY_INDEX);

    procedure WRITE_TO_LUT
       (COLOUR_INDEX : LEXI_COLOUR_INDEX;
        COLOUR_VALUE : LEXI_PIXEL_COLOUR);

end LEXI3700_OUTPUT_DRIVER;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI_OUT_DRIVER_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_OUTPUT_DRIVER - BODY
--  IDENTIFIER: GDMXXX.2(2)
--  DISCREPANCY REPORTS:
--  DR034  Fix pline clip.
------------------------------------------------------------------
-- FILE : LEXI_OUT_DRIVER_B.ADA
-- LEVEL: ALL

with LEXI3700_COMMUNICATION;

use  LEXI3700_COMMUNICATION;

package body LEXI3700_OUTPUT_DRIVER is

-- The LEXI3700_COMMUNICATION package communicates with the Lexidata
-- graphics display.

   CLEAR_DISPLAY_OP               : constant := 3;
   -- Clear the display

   DEFINE_WRITE_CHANNELS_OP       : constant := 2;
   -- Fill area

   DISPLAY_ARC_OP                 : constant := 43;
   -- Arc for clipping circle

   DISPLAY_CHAINED_VECTORS_OP     : constant := 41;
   -- Polyline, Fill area

   DISPLAY_CIRCLE_OP              : constant := 14;
   -- Circle

   DISPLAY_TEXT_OP                : constant := 9;
   -- Polymarker, Text

   POLYGON_EDGE_FLAG_FILL_OP      : constant := 48;
   -- Fill area

   RANDOM_PIXEL_READ_OP           : constant := 16;
   -- Inq_Pixel_Ar, Inq_Pixel

   RANDOM_PIXEL_WRITE_OP          : constant := 17;
   -- Cell_Array

   READ_FROM_LUT_OP               : constant := 21;
   -- Inq_Pixel_Ar, Inq_Pixel

   SET_DISPLAY_PARAMETERS_OP      : constant := 40;
   -- Polyline,Fill area,Circle

   SET_HARDWARE_CURSOR_OP         : constant := 26;
   -- Erases the hardware cursor

   SET_RECTANGULAR_LIMIT_OP       : constant := 1;
   -- Fill area

   SET_TEXT_CHARACTER_ROTATION_OP : constant := 93;
   -- Character up vector

   SET_TEXT_PARAMETERS_OP         : constant := 19;
   -- Polymarker and Text attribute

   SET_TEXT_WINDOW_OP             : constant := 100;
   -- String precision

   SEQUENTIAL_PIXEL_WRITE_OP      : constant := 4;
   -- cell array

   WRITE_TO_LUT_OP                : constant := 20;
   -- Set_Clr_Rep

   RED_PLANE_ADDRESS   : constant LEXI_PLANE_ADDRESS :=
         1* LEXI_PLANE_ADDRESS(LEXI_PLANE_VALUE'last + 1);
   GREEN_PLANE_ADDRESS : constant LEXI_PLANE_ADDRESS :=
         2* LEXI_PLANE_ADDRESS(LEXI_PLANE_VALUE'last + 1);
   BLUE_PLANE_ADDRESS  : constant LEXI_PLANE_ADDRESS :=
         3* LEXI_PLANE_ADDRESS(LEXI_PLANE_VALUE'last + 1);
   -- These constants address the physical memory locations of
   -- the colour planes to write an intensity value.

   LEXI_CHARACTER_ROTATION : constant array (LEXI_ROTATE_CODE)
                             of INTEGER :=
                             (NO_ROTATION  => 0,
                              ROTATION_90  => 1,
                              ROTATION_180 => 2,
                              ROTATION_270 => 3);
   -- LEXI_CHARACTER_ROTATION is an array of valid character rotations.

   LEXI_LINE               : constant array (LEXI_LINE_TYPE)
                             of INTEGER :=
                             (SOLID_LINE         => 8#147777#,
                              DASHED_LINE        => 8#147007#,
                              DOTTED_LINE        => 8#146000#,
                              DASHED_DOTTED_LINE => 8#147431#);
   -- LEXI_LINE is an array of valid line types.

   LEXI_PATH               : constant array (LEXI_CHARACTER_PATH)
                             of INTEGER :=
                             (LEFT_TO_RIGHT => 8#000#,
                              RIGHT_TO_LEFT => 8#200#,
                              BOTTOM_TO_TOP => 8#300#,
                              TOP_TO_BOTTOM => 8#100#);
   -- LEXI_PATH is an array of valid character paths.

   LEXI_FILL_VALUE         : constant array (LEXI_INTERIOR_STYLE)
                             of INTEGER :=
                             (HOLLOW => 8#000000#,
                              SOLID  => 8#130000#);
   -- LEXI_FILL_VALUE is an array of fill values offered.

   HARDWARE_CURSOR         : constant array (LEXI_CURSOR_TYPE)
                             of INTEGER :=
                             (NON_INTERLACED_CROSSHAIR => 0,
                              NON_INTERLACED_MATRIX    => 2,
                              INTERLACED_CROSSHAIR     => 8,
                              INTERLACED_MATRIX        => 10);
   -- HARDWARE_CURSOR is an array of hardware cursors the device supports.

    procedure CLEAR_DISPLAY
       (PLANE : LEXI_PLANE_VALUE := LEXI_PLANE_VALUE'last) is

    -- This procedure clears data from all planes.
    --
    -- PLANE - Mask specifying planes to be erased.
    --
    -- Procedure name: DSCLR

    begin

       LEXI3700_COMMUNICATION.WRITE_TO_BUFFER
            ((BIT_16(CLEAR_DISPLAY_OP),
              BIT_16(PLANE)));

    end CLEAR_DISPLAY;

    procedure DEFINE_WRITE_CHANNELS
       (TEXT_CHANNEL  : LEXI_PLANE_VALUE := LEXI_PLANE_VALUE'last;
        GRAPH_CHANNEL : LEXI_PLANE_VALUE := LEXI_PLANE_VALUE'last;
        IMAGE_CHANNEL : LEXI_PLANE_VALUE := LEXI_PLANE_VALUE'last) is

    -- This procedure defines the display memory planes used by the
    -- text, graphics, and image functions.
    --
    -- TEXT_CHANNEL  - plane enable mask for the text channel.
    -- GRAPH_CHANNEL - plane enable mask for the graphics channel.
    -- IMAGE_CHANNEL - plane enable mask for the image channel.
    --
    -- Procedure name: DSCHAN

    begin

       LEXI3700_COMMUNICATION.WRITE_TO_BUFFER
            ((BIT_16(DEFINE_WRITE_CHANNELS_OP),
              BIT_16(TEXT_CHANNEL),
              BIT_16(GRAPH_CHANNEL),
              BIT_16(IMAGE_CHANNEL)));

    end DEFINE_WRITE_CHANNELS;

    procedure DISPLAY_ARC
       (CENTER          : LEXI_POINT;
        RADIUS          : LEXI_RADIUS_TYPE;
        COLOUR          : LEXI_COLOUR_INDEX;
        START           : LEXI_COUNT_VALUE;
        PIXEL_COUNT     : LEXI_COUNT_VALUE) is

    -- This procedure displays the arc of a circle in the write mode
    -- previously specified by SET_DISPLAY_PARAMETERS.
    --
    -- CENTER    - Center point of the arc.
    -- RADIUS    - The radius of the arc.
    -- COLOUR    - Color intensity value written to display memory.
    -- START     - Starting position of arc, counted in pixels
    --             counterclockwise from 0 degrees.
    -- PIXEL_COUNT - Size of the arc in pixels, counted counterclockwise
    --               from start.
    --
    -- Procedure name: DSARC

    begin

       LEXI3700_COMMUNICATION.WRITE_TO_BUFFER
            ((BIT_16(DISPLAY_ARC_OP),
              BIT_16(CENTER.X),
              BIT_16(CENTER.Y),
              BIT_16(RADIUS),
              BIT_16(COLOUR),
              BIT_16(START),
              BIT_16(PIXEL_COUNT)));

    end DISPLAY_ARC;

    procedure DISPLAY_CHAINED_VECTORS
       (COLOUR : LEXI_COLOUR_INDEX;
        POINTS : LEXI_POINTS) is

    -- This procedure displays chained vectors as defined by coordinates
    -- in array POINTS with a color intensity defined by colour index.
    --
    -- COLOUR - Color intensity value to be written to display.
    -- POINTS - Array defining endpoints of the chained vectors.
    --
    -- Procedure name: DSCVEC

       SEND_BLOCK : LEXIDATA_ARRAY (1 .. (2 * POINTS'LENGTH) + 3);
       -- array containing information to be sent to the device.

    begin

       SEND_BLOCK (1 .. 3) := ((BIT_16(DISPLAY_CHAINED_VECTORS_OP),
                               BIT_16(COLOUR),
                               BIT_16(POINTS'LENGTH * 2)));
       for I in 1 .. POINTS'LENGTH loop
           SEND_BLOCK(2*I + 2) := BIT_16(POINTS(I).X);
           SEND_BLOCK(2*I + 3) := BIT_16(POINTS(I).Y);
       end loop;
       LEXI3700_COMMUNICATION.WRITE_TO_BUFFER(SEND_BLOCK);

    end DISPLAY_CHAINED_VECTORS;

    procedure DISPLAY_CIRCLE
       (CENTER : LEXI_POINT;
        RADIUS : LEXI_RADIUS_TYPE;
        COLOUR : LEXI_COLOUR_INDEX) is

    -- This procedure draws a circle with the specified center
    -- and radius.
    --
    -- CENTER - Center point of the circle.
    -- RADIUS - The radius of the circle.
    -- COLOUR - Color intensity index written to pixels comprising
    --          the circle.
    --
    -- Procedure name: DSCIR

    begin

       LEXI3700_COMMUNICATION.WRITE_TO_BUFFER
            ((BIT_16(DISPLAY_CIRCLE_OP),
              BIT_16(CENTER.X),
              BIT_16(CENTER.Y),
              BIT_16(RADIUS),
              BIT_16(COLOUR)));

    end DISPLAY_CIRCLE;

    procedure DISPLAY_TEXT
      (TEXT     : STRING) is

    -- This procedure writes text characters stored in TEXT to the
    -- planes enabled by the current DEFINE_WRITE_CHANNELS TEXT_CHANNEL
    -- value.  The procedure breaks down the character string into an
    -- array of integer, because the device only excepts integer values.
    --
    -- TEXT     - The buffer containing the text to be written.
    --
    -- Procedure name: DSTXT

       IS_ODD     : INTEGER := TEXT'LENGTH rem 2;
       -- IS_ODD     - Used to determine if value is odd or even.

       HALF_SIZE  : INTEGER := TEXT'LENGTH / 2;
       -- HALF_SIZE  - Used to determine size of array of integers.

       SEND_BLOCK : LEXIDATA_ARRAY(1 .. HALF_SIZE + IS_ODD + 2);
       -- SEND_BLOCK - Contains the checks to send to the LEXIDATA.

       INDEX      : INTEGER := 2;
       -- INDEX      - Index for SEND_BLOCK.

    begin

        SEND_BLOCK(1 .. 2) := ((BIT_16(DISPLAY_TEXT_OP),
                             BIT_16(TEXT'length)));
        for I in TEXT'first .. TEXT'first + HALF_SIZE - 1 loop
            INDEX := INDEX + 1;
            SEND_BLOCK(INDEX) := BIT_16(CHARACTER'POS(TEXT(2 * I - 1)) *
                              256 + CHARACTER'POS (TEXT (2 * I)));
        end loop;
        if IS_ODD = 1 then
           SEND_BLOCK (INDEX + 1) := BIT_16(CHARACTER'POS(TEXT(TEXT'LAST))
                                  * 256);
        end if;
        LEXI3700_COMMUNICATION.WRITE_TO_BUFFER(SEND_BLOCK);

    end DISPLAY_TEXT;

    procedure FLUSH is

    -- This procedure clears out the buffer.

    begin

       LEXI3700_COMMUNICATION.FLUSH_BUFFER;

    end FLUSH;

    procedure OPEN (CHANNEL_IN  : INTEGER;
                    CHANNEL_OUT : INTEGER;
                    ERROR_CODE  : out INTEGER) is

    -- This procedure establishes the connection of the device .
    --
    -- CHANNEL_IN  - The input channel.
    -- CHANNEL_OUT - The output channel.
    -- ERROR_CODE  - The error return code from OPEN.

       OPEN_ERROR : INTEGER;
       -- OPEN_ERROR contains the error value returned when the device
       -- cannot be connected.

    begin

       LEXI3700_COMMUNICATION.OPEN_LEXIDATA(CHANNEL_IN, CHANNEL_OUT,
             OPEN_ERROR);
       ERROR_CODE := OPEN_ERROR;

    end OPEN;

    procedure POLYGON_EDGE_FLAG_FILL
       (FILL_VALUE      : LEXI_COLOUR_INDEX;
        LEXI_PLANE_MASK : LEXI_PLANE_VALUE :=
              LEXI3700_CONFIGURATION.LEXI_FILL_PLANE_VALUE) is

    -- This procedure fills polygons according to the edge flag method
    -- of polygon filling.
    --
    -- FILL_VALUE - Pixel (color intensity) value used to fill polygon.
    -- LEXI_PLANE_MASK - Mask indicating planes containing edge flags.
    --
    -- Procedure name: DSEFIL

    begin

       LEXI3700_COMMUNICATION.WRITE_TO_BUFFER
            ((BIT_16(POLYGON_EDGE_FLAG_FILL_OP),
              BIT_16(LEXI_PLANE_MASK),
              BIT_16(FILL_VALUE)));

    end POLYGON_EDGE_FLAG_FILL;

    procedure RANDOM_PIXEL_READ
       (POINTS       : LEXI_POINTS;
        PIXEL_ARRAY  : out LEXI_PIXEL_ARRAY_INDEX) is

    -- This procedure causes the display processor to send back a number
    -- of pixel values from locations specified by POINTS, on planes
    -- enable by the current DEFINE_WRITE_CHANNELS IMAGE_CHANNEL value.
    --
    -- POINTS      - Number of pixels to be read.
    -- PIXEL_ARRAY - Buffer containing pixels to be read.
    --
    -- Procedure name: DSRNR

       PIXEL_POINTER   : LEXIDATA_ARRAY(1 .. 2 * POINTS'length + 2);
       -- PIXEL_POINTER - Array pointer for pixels.

       PIXEL_ARRAY_GET : LEXIDATA_ARRAY(1 .. PIXEL_ARRAY'length);
       -- PIXEL_ARRAY_GET - Array of pixels.

    begin

       PIXEL_POINTER(1) := BIT_16(RANDOM_PIXEL_READ_OP);
       PIXEL_POINTER(2) := BIT_16(POINTS'LENGTH);
       for I in POINTS'first .. POINTS'last loop
           PIXEL_POINTER(POSITIVE(I * 2 + 1)) :=
                BIT_16(POINTS(I).X);
           PIXEL_POINTER(POSITIVE(I * 2 + 2)) :=
                BIT_16(POINTS(I).Y);
       end loop;

       LEXI3700_COMMUNICATION.WRITE_TO_BUFFER(PIXEL_POINTER);

       LEXI3700_COMMUNICATION.FLUSH_BUFFER(FALSE);

       LEXI3700_COMMUNICATION.READ_FROM_BUFFER
            (PIXEL_ARRAY_GET);

       for I in PIXEL_ARRAY_GET'range loop
           PIXEL_ARRAY(I) := LEXI_COLOUR_INDEX(PIXEL_ARRAY_GET(I));
       end loop;

    end RANDOM_PIXEL_READ;

    procedure RANDOM_PIXEL_WRITE
       (POINTS  : LEXI_POINTS;
        COLOURS : LEXI_PIXEL_ARRAY_INDEX) is

    -- This procedure writes a value into a group for randomly addressed
    -- pixels to display memory planes enabled by the current DEFINE_
    -- WRITE_CHANNELS.
    --
    -- POINTS  - Number of pixels to be written.
    -- COLOURS - Buffer containing pixel coordinates and data.
    --
    -- Procedure name: DSRNW

       SEND_BLOCK  : LEXIDATA_ARRAY (1 .. ((3 * COLOURS'LENGTH + 2)));
       -- array containing information to send to device.

    begin

       SEND_BLOCK (1..2) := (RANDOM_PIXEL_WRITE_OP, COLOURS'LENGTH);
       for I in COLOURS'RANGE loop
           SEND_BLOCK (((I-1) * 3) + 3) := BIT_16(POINTS(I).X);
           SEND_BLOCK (((I-1) * 3) + 4) := BIT_16(POINTS(I).Y);
           SEND_BLOCK (((I-1) * 3) + 5) := BIT_16(COLOURS(I));
       end loop;
       LEXI3700_COMMUNICATION.WRITE_TO_BUFFER(SEND_BLOCK);

    end RANDOM_PIXEL_WRITE;

    procedure READ_FROM_LUT
       (COLOUR_INDEX : LEXI_COLOUR_INDEX;
        COLOUR_VALUE : out LEXI_PIXEL_COLOUR) is

    -- This procedure reads a value from the lookup table
    -- and returns the corresponding value to the host.
    --
    -- COLOUR_INDEX - The index to be read.
    -- COLOUR_VALUE - A record containing the index colour.
    --
    -- Procedure name: DSLRD

       CURRENT_OFFSET       : LEXIDATA_ARRAY (1..3);
       --  CURRENT_OFFSET - Contains the physical locations of the red,
       --                   green, and blue planes.

       PIXEL             : LEXIDATA_ARRAY (1 .. 1);
       --  PIXEL       - Contains information about the pixel.

       PIXEL_VALUE       : LEXIDATA_ARRAY (1..3);
       --  PIXEL_VALUE - Array that contains the intensity values
       --                returned from the LEXIDATA.

    begin

       CURRENT_OFFSET := (BIT_16(RED_PLANE_ADDRESS),
                       BIT_16(GREEN_PLANE_ADDRESS),
                       BIT_16(BLUE_PLANE_ADDRESS));
       for I in 1..3 loop
           LEXI3700_COMMUNICATION.WRITE_TO_BUFFER
                ((BIT_16(READ_FROM_LUT_OP),
                  BIT_16(COLOUR_INDEX) + CURRENT_OFFSET(I),
                  1));
            FLUSH;
            LEXI3700_COMMUNICATION.READ_FROM_BUFFER(PIXEL);
            PIXEL_VALUE(I) := PIXEL(1);
       end loop;
       COLOUR_VALUE.RED   := LEXI_COLOUR_INTENSITY(PIXEL_VALUE(1));
       COLOUR_VALUE.GREEN := LEXI_COLOUR_INTENSITY(PIXEL_VALUE(2));
       COLOUR_VALUE.BLUE  := LEXI_COLOUR_INTENSITY(PIXEL_VALUE(3));

    end READ_FROM_LUT;

    procedure SET_DISPLAY_PARAMETERS
       (WIDTH     : LEXI_LINE_WIDTH_TYPE;
        LINE      : LEXI_LINE_TYPE;
        FILL      : LEXI_INTERIOR_STYLE;
        SIZE      : LEXI_PATTERN_SIZE := 2) is

    -- This procedure specifies the way vectors, circles, arcs, and
    -- rectangles are drawn.
    --
    -- WIDTH - Write mode and line weight.
    --    BITS  0 - 11 = Line weight (0 or 1 yields a one-pixel width
    --                      line).
    --    BITS 12 - 14 = Write mode:
    --                   000 = Replace Mode.  Replaces any previous
    --                         value in the selected planes with the
    --                         specified value.
    --
    --                   001 = OR or Set Mode.  ORs the value in the
    --                         selected planes with the specified value;
    --                         does not clear any bit.
    --
    --                   010 = Clear Mode. ANDs the value in the select-
    --                         ed planes with the complement of the
    --                         specified value; does not set any bit.
    --
    --                   011 = XOR or Complement Mode.  XORs the value
    --                         in the selected planes with the specified
    --                         value; complements the selected bits.
    --                         This mode is used to draw polygons that
    --                         are filled with DSEFIL.
    --
    --    BIT  15      = Edge flag enable bit
    --                   0 = Disabled.
    --                   1 = Enabled.
    --
    -- LINE  - Line pattern for vectors and arcs.
    --    BITS  0 - 11 = Pattern description specifying the on/off
    --                   pattern applied to all subsequent lines
    --                   after the call (most significant to least
    --                   significant).
    --
    --    BITS 12 - 15 = Pattern length (number of pattern bits to
    --                   be used).
    --                   0 = Solid line.
    --
    -- FILL  - The interior style.
    --
    -- SIZE  - Pattern size for vectors and arcs, and fill for circles
    --         and rectangles.
    --    BITS  0 - 11 = Number of replications of each bit in pattern.
    --                   (A 0 or 1 in this location specifies a single
    --                   pixel length.)
    --
    --    BIT  12      = Fill enable bit:
    --                   0 = Fill disabled.
    --                   1 = Fill enabled.
    --
    --    BITS 13 - 15 = Reserved; must be zero.
    --
    -- Procedure name: DSDISP

    begin

       LEXI3700_COMMUNICATION.WRITE_TO_BUFFER
            ((BIT_16(SET_DISPLAY_PARAMETERS_OP),
              BIT_16(WIDTH) + BIT_16(LEXI_FILL_VALUE(FILL)),
              BIT_16(LEXI_LINE(LINE)),
              BIT_16(SIZE)));

    end SET_DISPLAY_PARAMETERS;

    procedure SET_HARDWARE_CURSOR
       (CURSOR : LEXI_CURSOR_TYPE := NON_INTERLACED_MATRIX;
        XOFF   : LEXI_COORDINATE := 0;
        YOFF   : LEXI_COORDINATE := 0) is

    -- This procedure selects the hardware crosshair cursor or the user-
    -- defined matrix cursor and provides a variable offset to fine-tune
    -- the position of the cursor.
    --
    -- CURSOR - Cursor type
    --    0  = Non-interlaced crosshair.
    --    2  = Non-interlaced matrix.
    --    8  = Interlaced crosshair.
    --    10 = Interlaced matrix.
    --
    -- XOFF - X displacement from true location.
    -- YOFF - Y displacement from true location.
    --
    -- Procedure name: DSCSL

    begin

       LEXI3700_COMMUNICATION.WRITE_TO_BUFFER
            ((BIT_16(SET_HARDWARE_CURSOR_OP),
              BIT_16(HARDWARE_CURSOR(CURSOR)),
              BIT_16(XOFF),
              BIT_16(YOFF)));

    end SET_HARDWARE_CURSOR;

    procedure SET_RECTANGULAR_LIMIT
       (UPPER_LEFT  : LEXI_POINT;
        LOWER_RIGHT : LEXI_POINT) is

    -- This procedure defines a rectangular section of memory that
    -- is used to do edge fill.
    --
    -- UPPER_LEFT  - Coordinates of upper left corner.
    -- LOWER_RIGHT - Coordinates of lower right corner.
    --
    -- Procedure name: DSLIM

    begin

       LEXI3700_COMMUNICATION.WRITE_TO_BUFFER
            ((BIT_16(SET_RECTANGULAR_LIMIT_OP),
              BIT_16(UPPER_LEFT.X),
              BIT_16(UPPER_LEFT.Y),
              BIT_16(LOWER_RIGHT.X),
              BIT_16(LOWER_RIGHT.Y)));

    end SET_RECTANGULAR_LIMIT;

    procedure SET_TEXT_CHARACTER_ROTATION
       (ROTATION : LEXI_ROTATE_CODE) is

    -- This procedure determines the rotation of characters with respect
    -- to the character path.
    --
    -- ROTATION - Rotation of the characters with respect to the
    --            character path:
    --                  0 - No rotation (default).
    --                  1 - 90 degree rotation clockwise.
    --                  2 - 180 degree rotation clockwise (upside down
    --                      and backwards).
    --                  3 - 270 degree rotation clockwise.
    --
    -- Procedure name: DSSTR

    begin

       LEXI3700_COMMUNICATION.WRITE_TO_BUFFER
            ((BIT_16(SET_TEXT_CHARACTER_ROTATION_OP),
              BIT_16(LEXI_CHARACTER_ROTATION(ROTATION))));

    end SET_TEXT_CHARACTER_ROTATION;

    procedure SET_TEXT_PARAMETERS
       (POSITION : LEXI_POINT;
        COLOUR   : LEXI_COLOUR_INDEX;
        PATH     : LEXI_CHARACTER_PATH;
        SIZE     : LEXI_TEXT_SIZE) is

    -- This procedure sets the display parameters for text written with
    -- DSTXT.
    --
    -- POSITION - The X and Y coordinates of text starting position.
    -- COLOUR   - Value (color intensity index) written to text
    --            pixels.
    --
    -- PATH     - Flag word specifying several parameters.
    --
    --    FONT
    --         bit        description
    --          0 (LSB)   0 = character font 0
    --                    1 = font 1
    --    ADDITIVE
    --          1         0 = erasive
    --                    1 = additive write
    --    REVERSE
    --          2         0 = normal
    --                    1 = reverse video
    --    INCREMENT
    --         3          0 = enable
    --                    1 = disable incrementing to next character
    --    TEXT CURSOR
    --         4          0 = enable
    --                    1 = disable test cursor
    --    CONTROL DISABLE
    --          5         0 = enable  processing of control characters.
    --                    1 = disable processing of control characters.
    --    TEXT PATH
    --          6 - 7     00 = left to right
    --                    01 = bottom to top
    --                    10 = right to left
    --                    11 = top to bottom
    --    NOT USED
    --          8 - 15 (MSB)
    --
    -- SIZE - Multiplication factor for the 5 by 7 character font.
    --        The resulting character is (5 * size) by (7 * size).
    --
    -- Procedure name: DSSAO

    begin

       LEXI3700_COMMUNICATION.WRITE_TO_BUFFER
            ((BIT_16(SET_TEXT_PARAMETERS_OP),
              BIT_16(POSITION.X),
              BIT_16(POSITION.Y),
              BIT_16(COLOUR),
              BIT_16(LEXI_PATH(PATH)),
              BIT_16(SIZE)));

    end SET_TEXT_PARAMETERS;

    procedure SET_TEXT_WINDOW
       (UPPER_LEFT  : LEXI_POINT;
        LOWER_RIGHT : LEXI_POINT) is

    -- This procedure defines a text window beyond which no text is
    -- written.
    --
    -- UPPER_LEFT  - Coordinate of upper left portion of the
    --               text window.
    -- LOWER_RIGHT - Coordinate of lower right portion of the
    --               text window.
    --
    -- Procedure name: DSSTW

    begin

       LEXI3700_COMMUNICATION.WRITE_TO_BUFFER
             ((BIT_16(SET_TEXT_WINDOW_OP),
               BIT_16(UPPER_LEFT.X),
               BIT_16(UPPER_LEFT.Y),
               BIT_16(LOWER_RIGHT.X),
               BIT_16(LOWER_RIGHT.Y)));

    end SET_TEXT_WINDOW;

procedure SEQUENTIAL_PIXEL_WRITE
   (PIXEL_ARRAY : LEXI_PIXEL_ARRAY_INDEX) is

-- This procedure writes a number of colour indexs to the display
-- surface outlined by DSLIM which defines a rectangular limit.
-- The starting position is the upper left.

-- procedure DSPUT

SEND_BLOCK : LEXIDATA_ARRAY (1 .. PIXEL_ARRAY'LENGTH + 2);
    -- Contains information going to the device.

 begin
    SEND_BLOCK(1) := BIT_16(SEQUENTIAL_PIXEL_WRITE_OP);
    SEND_BLOCK(2) := BIT_16(PIXEL_ARRAY'LENGTH);

    for I in PIXEL_ARRAY'RANGE loop
        SEND_BLOCK(I - PIXEL_ARRAY'FIRST + 3) := BIT_16(PIXEL_ARRAY(I));
    end loop;

    LEXI3700_COMMUNICATION.WRITE_TO_BUFFER(SEND_BLOCK);

end SEQUENTIAL_PIXEL_WRITE;

procedure WRITE_TO_LUT
       (COLOUR_INDEX : LEXI_COLOUR_INDEX;
        COLOUR_VALUE : LEXI_PIXEL_COLOUR) is

    -- This procedure writes a record of colour intensity to the
    -- table(CLUT).
    --
    -- COLOUR_INDEX - The colour index to set the intensity values.
    -- COLOUR_VALUE - The intensity values to be written.
    --
    -- Procedure name: DSLWT

        CURRENT_OFFSET      : LEXIDATA_ARRAY (1..3);
        --  CUR_OFFSET  - Contains the physical locations of the red,
        --                green, and blue planes.

        PIXEL_VALUE      : LEXIDATA_ARRAY (1..3);
        --  PIXEL_VALUE - Array containing the intensity values returned
        --                by the LEXIDATA.

    begin

       CURRENT_OFFSET := (BIT_16(RED_PLANE_ADDRESS),
                       BIT_16(GREEN_PLANE_ADDRESS),
                       BIT_16(BLUE_PLANE_ADDRESS));
       PIXEL_VALUE := (BIT_16(COLOUR_VALUE.RED),
                       BIT_16(COLOUR_VALUE.GREEN),
                       BIT_16(COLOUR_VALUE.BLUE));
       for I in 1..3 loop
           LEXI3700_COMMUNICATION.WRITE_TO_BUFFER
                ((BIT_16(WRITE_TO_LUT_OP),
                  BIT_16(COLOUR_INDEX) + CURRENT_OFFSET(I),
                  1));
           LEXI3700_COMMUNICATION.WRITE_TO_BUFFER((PIXEL_VALUE(I .. I)));

       end loop;

    end WRITE_TO_LUT;

end LEXI3700_OUTPUT_DRIVER;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:OUT_ATTR_TYP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: OUTPUT_ATTRIBUTES_TYPE
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: OUT_ATTR_TYP.ADA
-- level: ma, 0a, 1a, 2a

with GKS_TYPES;

use GKS_TYPES;

package OUTPUT_ATTRIBUTES_TYPE is

-- A grouping of all attributes which affect the display of output
-- primitives.

   type OUTPUT_ATTRIBUTES is record

      ASPECT_SOURCE_FLAGS                  : ASF_LIST;

      -- polyline attributes

      CURRENT_POLYLINE_INDEX               : POLYLINE_INDEX;
      CURRENT_LINETYPE                     : LINETYPE;
      CURRENT_LINEWIDTH_SCALE_FACTOR       : LINE_WIDTH;
      CURRENT_POLYLINE_COLOUR_INDEX        : COLOUR_INDEX;

      -- polymarker attributes

      CURRENT_POLYMARKER_INDEX             : POLYMARKER_INDEX;
      CURRENT_MARKER_TYPE                  : MARKER_TYPE;
      CURRENT_MARKER_SIZE_SCALE_FACTOR     : MARKER_SIZE;
      CURRENT_POLYMARKER_COLOUR_INDEX      : COLOUR_INDEX;

      -- text attributes

      CURRENT_TEXT_INDEX                   : TEXT_INDEX;
      CURRENT_TEXT_FONT_AND_PRECISION      : TEXT_FONT_PRECISION;
      CURRENT_CHAR_EXPANSION_FACTOR        : CHAR_EXPANSION;
      CURRENT_CHAR_SPACING                 : CHAR_SPACING;
      CURRENT_TEXT_COLOUR_INDEX            : COLOUR_INDEX;

      -- the following text attributes are not bundlable.

      CURRENT_CHAR_HEIGHT_VECTOR           : NDC.VECTOR;
      CURRENT_CHAR_WIDTH_VECTOR            : NDC.VECTOR;
      CURRENT_TEXT_PATH                    : TEXT_PATH;
      CURRENT_TEXT_ALIGNMENT               : TEXT_ALIGNMENT;

      -- fill area attributes.

      CURRENT_FILL_AREA_INDEX              : FILL_AREA_INDEX;
      CURRENT_FILL_AREA_INTERIOR_STYLE     : INTERIOR_STYLE;
      CURRENT_FILL_AREA_STYLE_INDEX        : STYLE_INDEX;
      CURRENT_FILL_AREA_COLOUR_INDEX       : COLOUR_INDEX;

      -- pattern attributes for pattern fills.

      CURRENT_PATTERN_WIDTH_VECTOR         : NDC.VECTOR;
      CURRENT_PATTERN_HEIGHT_VECTOR        : NDC.VECTOR;
      CURRENT_PATTERN_REFERENCE_POINT      : NDC.POINT;

      -- used for clipping to NDC space. The points are the lower left
      -- corner and the upper right corner.

      CLIPPING_RECTANGLE                   : NDC.RECTANGLE_LIMITS;

   end record;

end OUTPUT_ATTRIBUTES_TYPE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:CGI_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CGI
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  DR004  Reduce size of CGI instruction
------------------------------------------------------------------
-- file: cgi_ma.ada
-- level: ma

with GKS_TYPES;
with OUTPUT_ATTRIBUTES_TYPE;
with unchecked_deallocation;

use GKS_TYPES;

package CGI is

-- Uses the GKS_TYPES package to define the Computer Graphics
-- Interface (CGI) to the Workstation Manager.  The interface is
-- a DATA interface specified by the variant record CGI_INSTR where
-- the discriminant is the type CGI_OPCODES.
-- Package GKS_TYPES provides type definitions.
-- Package OUTPUT_ATTRIBUTES_TYPE provides a grouping of the attributes
-- which affect the display of output primitives.
-- Package unchecked_deallocation is a predefined generic library
-- function for storage deallocation of an object designated by a
-- value of an access type.

   type CGI_OPCODES is
      (NO_OP,

   -- LEVEL ma
   -- logical operation "ws_control"

      OPEN_WS,
      CLOSE_WS,
      ACTIVATE_WS,
      DEACTIVATE_WS,
      CLEAR_WS,
      UPDATE_WS,

   -- logical operation "output_primitives"

      POLYLINE,
      POLYMARKER,
      FILL_AREA,
      TEXT,

   -- logical operation "set_primitive_attributes_ma"

      SET_CHAR_VECTORS,
      SET_TEXT_ALIGNMENT,

   -- logical operation "set_individual_attributes_ma"

      SET_LINETYPE,
      SET_POLYLINE_COLOUR_INDEX,
      SET_MARKER_TYPE,
      SET_POLYMARKER_COLOUR_INDEX,
      SET_TEXT_COLOUR_INDEX,
      SET_FILL_AREA_INTERIOR_STYLE,
      SET_FILL_AREA_COLOUR_INDEX,

   -- logical operation "set_colour_table"

      SET_COLOUR_REPRESENTATION,

   -- logical operation "ws_transformation"

      SET_WS_WINDOW,
      SET_WS_VIEWPORT,

   -- logical operation "inq_ws_description_table_ma"

      INQ_DISPLAY_SPACE_SIZE,
      INQ_POLYLINE_FACILITIES,
      INQ_POLYMARKER_FACILITIES,
      INQ_TEXT_FACILITIES,
      INQ_FILL_AREA_FACILITIES,
      INQ_COLOUR_FACILITIES,
      INQ_MAX_LENGTH_OF_WS_STATE_TABLES,

   -- logical operation "inq_ws_state_list_ma"

      INQ_WS_CONNECTION_AND_TYPE,
      INQ_TEXT_EXTENT,
      INQ_LIST_OF_COLOUR_INDICES,
      INQ_COLOUR_REPRESENTATION,
      INQ_WS_TRANSFORMATION,

   -- logical operation "gks_normalization"

      SET_CLIPPING_RECTANGLE);

   type ACCESS_CONNECTION_ID_TYPE is ACCESS CONNECTION_ID;
   -- used to pass pointer to a connection id string

   type ACCESS_POINT_ARRAY_TYPE is ACCESS NDC.POINT_ARRAY;
   -- used to pass pointer to an array of points

   type ACCESS_STRING_TYPE is ACCESS STRING;
   -- used to pass pointer to a string

   -- instantiate unchecked deallocation for access types

   procedure FREE_CONNECTION_ID is new unchecked_deallocation
         (CONNECTION_ID,ACCESS_CONNECTION_ID_TYPE);

   procedure FREE_POINT_ARRAY is new unchecked_deallocation
         (NDC.POINT_ARRAY,ACCESS_POINT_ARRAY_TYPE);

   procedure FREE_STRING is new unchecked_deallocation
         (STRING,ACCESS_STRING_TYPE);

   type CGI_INSTR (OP : CGI_OPCODES := NO_OP) is
      record
         EI : ERROR_INDICATOR := 0;
   -- enumerate each opcode giving its appropriate arguments.
         case OP is

         when NO_OP =>
            null;

   -- logical operation "ws_control"

         when OPEN_WS =>
            WS_TO_OPEN       :       WS_ID;
            CONNECTION_OPEN  :       ACCESS_CONNECTION_ID_TYPE;
            TYPE_OF_WS_OPEN  :       WS_TYPE;
            ATTRIBUTES_AT_OPEN :     OUTPUT_ATTRIBUTES_TYPE.
                                     OUTPUT_ATTRIBUTES;
         when CLOSE_WS =>
            WS_TO_CLOSE      :       WS_ID;
         when ACTIVATE_WS =>
            WS_TO_ACTIVATE   :       WS_ID;
         when DEACTIVATE_WS =>
            WS_TO_DEACTIVATE :       WS_ID;
         when CLEAR_WS =>
            WS_TO_CLEAR      :       WS_ID;
            FLAG             :       CONTROL_FLAG;
         when UPDATE_WS =>
            WS_TO_UPDATE     :       WS_ID;
            REGENERATION     :       UPDATE_REGENERATION_FLAG;

   -- logical operation "output_primitives"

         when POLYLINE =>
            LINE_POINTS      :       ACCESS_POINT_ARRAY_TYPE;
         when POLYMARKER =>
            MARKER_POINTS    :       ACCESS_POINT_ARRAY_TYPE;
         when FILL_AREA =>
            FILL_AREA_POINTS :       ACCESS_POINT_ARRAY_TYPE;
         when TEXT =>
            TEXT_POSITION    :       NDC.POINT;
            TEXT_STRING      :       ACCESS_STRING_TYPE;

   -- logical operation "set_primitive_attributes_ma"

         when SET_CHAR_VECTORS =>
            CHAR_HEIGHT_VECTOR_SET   :       NDC.VECTOR;
            CHAR_WIDTH_VECTOR_SET    :       NDC.VECTOR;
         when SET_TEXT_ALIGNMENT =>
            TEXT_ALIGNMENT_SET       :       TEXT_ALIGNMENT;

   -- logical operation "set_individual_attributes_ma"

         when SET_LINETYPE =>
            LINETYPE_SET             :       LINETYPE;
         when SET_POLYLINE_COLOUR_INDEX =>
            POLYLINE_COLOUR_INDEX_SET :      COLOUR_INDEX;
         when SET_MARKER_TYPE =>
            MARKER_TYPE_SET          :       MARKER_TYPE;
         when SET_POLYMARKER_COLOUR_INDEX =>
            POLYMARKER_COLOUR_INDEX_SET :    COLOUR_INDEX;
         when SET_TEXT_COLOUR_INDEX =>
            TEXT_COLOUR_INDEX_SET    :       COLOUR_INDEX;
         when SET_FILL_AREA_INTERIOR_STYLE =>
            FILL_AREA_INTERIOR_STYLE_SET :   INTERIOR_STYLE;
         when SET_FILL_AREA_COLOUR_INDEX =>
            FILL_AREA_COLOUR_INDEX_SET :     COLOUR_INDEX;

   -- logical operation "set_colour_table"

         when SET_COLOUR_REPRESENTATION =>
            WS_TO_SET_COLOUR_REP     :       WS_ID;
            COLOUR_INDEX_TO_SET_COLOUR_REP :   COLOUR_INDEX;
            COLOUR_REP_SET           :       COLOUR_REPRESENTATION;

   -- logical operation "ws_transformation"

         when SET_WS_WINDOW =>
            WS_TO_SET_WINDOW      :  WS_ID;
            WS_WINDOW_LIMITS_SET  :  NDC.RECTANGLE_LIMITS;
         when SET_WS_VIEWPORT =>
            WS_TO_SET_VIEWPORT     : WS_ID;
            WS_VIEWPORT_LIMITS_SET : DC.RECTANGLE_LIMITS;

   -- logical operation "inq_ws_description_table_ma"

         when INQ_DISPLAY_SPACE_SIZE =>
            WS_TO_INQ_DISPLAY_SPACE_SIZE :   WS_TYPE;
            DISPLAY_SPACE_UNITS_INQ  :       DC_UNITS;
            MAX_DC_SIZE_INQ          :       DC.SIZE;
            MAX_RASTER_UNIT_SIZE_INQ :       RASTER_UNIT_SIZE;
         when INQ_POLYLINE_FACILITIES =>
            WS_TO_INQ_POLYLINE_FACILITIES :  WS_TYPE;
            LIST_OF_POLYLINE_TYPES_INQ :     LINETYPES.LIST_OF;
            NUMBER_OF_WIDTHS_INQ     :       NATURAL;
            NOMINAL_WIDTH_INQ        :       DC.MAGNITUDE;
            RANGE_OF_WIDTHS_INQ      :       DC.RANGE_OF_MAGNITUDES;
            NUMBER_OF_POLYLINE_INDICES_INQ : NATURAL;
         when INQ_POLYMARKER_FACILITIES =>
            WS_TO_INQ_POLYMARKER_FACILITIES : WS_TYPE;
            LIST_OF_POLYMARKER_TYPES_INQ:    MARKER_TYPES.LIST_OF;
            NUMBER_OF_SIZES_INQ      :       NATURAL;
            NOMINAL_SIZE_INQ         :       DC.MAGNITUDE;
            RANGE_OF_SIZES_INQ       :       DC.RANGE_OF_MAGNITUDES;
            NUMBER_OF_POLYMARKER_INDICES_INQ : NATURAL;
         when INQ_TEXT_FACILITIES =>
            WS_TO_INQ_TEXT_FACILITIES :      WS_TYPE;
            LIST_OF_FONT_PRECISION_PAIRS_INQ :
                                           TEXT_FONT_PRECISIONS.LIST_OF;
            NUMBER_OF_HEIGHTS_INQ    :       NATURAL;
            RANGE_OF_HEIGHTS_INQ     :       DC.RANGE_OF_MAGNITUDES;
            NUMBER_OF_EXPANSIONS_INQ :       NATURAL;
            RANGE_OF_EXPANSIONS_INQ  :       RANGE_OF_EXPANSIONS;
            NUMBER_OF_TEXT_INDICES_INQ :     NATURAL;
         when INQ_FILL_AREA_FACILITIES =>
            WS_TO_INQ_FILL_AREA_FACILITIES : WS_TYPE;
            LIST_OF_INTERIOR_STYLES_INQ :    INTERIOR_STYLES.LIST_OF;
            LIST_OF_HATCH_STYLES_INQ :       HATCH_STYLES.LIST_OF;
            NUMBER_OF_FILL_AREA_INDICES_INQ : NATURAL;
         when INQ_COLOUR_FACILITIES =>
            WS_TO_INQ_COLOUR_FACILITIES :    WS_TYPE;
            NUMBER_OF_COLOURS_INQ    :       NATURAL;
            AVAILABLE_COLOUR_INQ     :       COLOUR_AVAILABLE;
            NUMBER_OF_COLOUR_INDICES_INQ :   NATURAL;
         when INQ_MAX_LENGTH_OF_WS_STATE_TABLES =>
            WS_TO_INQ_MAX_LENGTH_OF_WS_STATE_TABLES : WS_TYPE;
            MAX_POLYLINE_ENTRIES_INQ :       NATURAL;
            MAX_POLYMARKER_ENTRIES_INQ :     NATURAL;
            MAX_TEXT_ENTRIES_INQ     :       NATURAL;
            MAX_FILL_AREA_ENTRIES_INQ :      NATURAL;
            MAX_PATTERN_INDICES_INQ  :       NATURAL;
            MAX_COLOUR_INDICES_INQ   :       NATURAL;

   -- logical operation "inq_ws_state_list_ma"

         when INQ_WS_CONNECTION_AND_TYPE =>
            WS_TO_INQ_CONNECTION_AND_TYPE :  WS_ID;
            CONNECTION_INQ   :       ACCESS_CONNECTION_ID_TYPE;
            TYPE_OF_WS_INQ   :       WS_TYPE;
         when INQ_TEXT_EXTENT =>
            WS_TO_INQ_TEXT_EXTENT :  WS_ID;
            POSITION_TEXT    :       NDC.POINT;
            CHAR_STRING      :       ACCESS_STRING_TYPE;
            CONCATENATION_POINT :    NDC.POINT;
            TEXT_EXTENT_LOWER_LEFT_INQ   : NDC.POINT;
            TEXT_EXTENT_LOWER_RIGHT_INQ  : NDC.POINT;
            TEXT_EXTENT_UPPER_LEFT_INQ   : NDC.POINT;
            TEXT_EXTENT_UPPER_RIGHT_INQ  : NDC.POINT;
         when INQ_LIST_OF_COLOUR_INDICES =>
            WS_TO_INQ_COLOUR_INDICES : WS_ID;
            LIST_OF_COLOUR_INDICES_INQ : COLOUR_INDICES.LIST_OF;
         when INQ_COLOUR_REPRESENTATION =>
            WS_TO_INQ_COLOUR_REP :   WS_ID;
            COLOUR_INDEX_TO_INQ_COLOUR_REP  : COLOUR_INDEX;
            RETURN_VALUE_TO_INQ_COLOUR_REP  : RETURN_VALUE_TYPE;
            COLOUR_REP_INQ                  : COLOUR_REPRESENTATION;
         when INQ_WS_TRANSFORMATION =>
            WS_TO_INQ_TRANSFORMATION :       WS_ID;
            UPDATE_INQ               :       UPDATE_STATE;
            REQUESTED_WINDOW_INQ     :       NDC.RECTANGLE_LIMITS;
            CURRENT_WINDOW_INQ       :       NDC.RECTANGLE_LIMITS;
            REQUESTED_VIEWPORT_INQ   :       DC.RECTANGLE_LIMITS;
            CURRENT_VIEWPORT_INQ     :       DC.RECTANGLE_LIMITS;

   -- logical operation "gks_normalization"

         when SET_CLIPPING_RECTANGLE =>
            CLIPPING_RECTANGLE_SET : NDC.RECTANGLE_LIMITS;

         end case;
      end record;

   -- Subtypes are defined to ensure the correct procedure is called
   -- from the Device Independent layer to the Workstation Manager(WSM)
   -- layer by restricting the opcode to one specified value.

   subtype CGI_NO_OP is
      CGI_INSTR(OP => NO_OP);

   -- LEVEL ma
   -- logical operation "ws_control"

   subtype CGI_OPEN_WS is
      CGI_INSTR(OP => OPEN_WS);
   subtype CGI_CLOSE_WS is
      CGI_INSTR(OP => CLOSE_WS);
   subtype CGI_ACTIVATE_WS is
      CGI_INSTR(OP => ACTIVATE_WS);
   subtype CGI_DEACTIVATE_WS is
      CGI_INSTR(OP => DEACTIVATE_WS);
   subtype CGI_CLEAR_WS is
      CGI_INSTR(OP => CLEAR_WS);
   subtype CGI_UPDATE_WS is
      CGI_INSTR(OP => UPDATE_WS);

   -- logical operation "output_primitives"

   subtype CGI_POLYLINE is
      CGI_INSTR(OP => POLYLINE);
   subtype CGI_POLYMARKER is
      CGI_INSTR(OP => POLYMARKER);
   subtype CGI_FILL_AREA is
      CGI_INSTR(OP => FILL_AREA);
   subtype CGI_TEXT is
      CGI_INSTR(OP => TEXT);

   -- logical operation "set_primitive_attributes_ma"

   subtype CGI_SET_CHAR_VECTORS is
      CGI_INSTR(OP => SET_CHAR_VECTORS);
   subtype CGI_SET_TEXT_ALIGNMENT is
      CGI_INSTR(OP => SET_TEXT_ALIGNMENT);

   -- logical operation "set_individual_attributes_ma"

   subtype CGI_SET_LINETYPE is
      CGI_INSTR(OP => SET_LINETYPE);
   subtype CGI_SET_POLYLINE_COLOUR_INDEX is
      CGI_INSTR(OP => SET_POLYLINE_COLOUR_INDEX);
   subtype CGI_SET_MARKER_TYPE is
      CGI_INSTR(OP => SET_MARKER_TYPE);
   subtype CGI_SET_POLYMARKER_COLOUR_INDEX is
      CGI_INSTR(OP => SET_POLYMARKER_COLOUR_INDEX);
   subtype CGI_SET_TEXT_COLOUR_INDEX is
      CGI_INSTR(OP => SET_TEXT_COLOUR_INDEX);
   subtype CGI_SET_FILL_AREA_INTERIOR_STYLE is
      CGI_INSTR(OP => SET_FILL_AREA_INTERIOR_STYLE);
   subtype CGI_SET_FILL_AREA_COLOUR_INDEX is
      CGI_INSTR(OP => SET_FILL_AREA_COLOUR_INDEX);

   -- logical operation "set_colour_table"

   subtype CGI_SET_COLOUR_REPRESENTATION is
      CGI_INSTR(OP => SET_COLOUR_REPRESENTATION);

   -- logical operation "ws_transformation"

   subtype CGI_SET_WS_WINDOW is
      CGI_INSTR(OP => SET_WS_WINDOW);
   subtype CGI_SET_WS_VIEWPORT is
      CGI_INSTR(OP => SET_WS_VIEWPORT);

   -- logical operation "inq_ws_description_table_ma"

   subtype CGI_INQ_DISPLAY_SPACE_SIZE is
      CGI_INSTR(OP => INQ_DISPLAY_SPACE_SIZE);
   subtype CGI_INQ_POLYLINE_FACILITIES is
      CGI_INSTR(OP => INQ_POLYLINE_FACILITIES);
   subtype CGI_INQ_POLYMARKER_FACILITIES is
      CGI_INSTR(OP => INQ_POLYMARKER_FACILITIES);
   subtype CGI_INQ_TEXT_FACILITIES is
      CGI_INSTR(OP => INQ_TEXT_FACILITIES);
   subtype CGI_INQ_FILL_AREA_FACILITIES is
      CGI_INSTR(OP => INQ_FILL_AREA_FACILITIES);
   subtype CGI_INQ_COLOUR_FACILITIES is
      CGI_INSTR(OP => INQ_COLOUR_FACILITIES);
   subtype CGI_INQ_MAX_LENGTH_OF_WS_STATE_TABLES is
      CGI_INSTR(OP => INQ_MAX_LENGTH_OF_WS_STATE_TABLES);

   -- logical operation "inq_ws_state_list_ma"

   subtype CGI_INQ_WS_CONNECTION_AND_TYPE is
      CGI_INSTR(OP => INQ_WS_CONNECTION_AND_TYPE);
   subtype CGI_INQ_TEXT_EXTENT is
      CGI_INSTR(OP => INQ_TEXT_EXTENT);
   subtype CGI_INQ_LIST_OF_COLOUR_INDICES is
      CGI_INSTR(OP => INQ_LIST_OF_COLOUR_INDICES);
   subtype CGI_INQ_COLOUR_REPRESENTATION is
      CGI_INSTR(OP => INQ_COLOUR_REPRESENTATION);
   subtype CGI_INQ_WS_TRANSFORMATION is
      CGI_INSTR(OP => INQ_WS_TRANSFORMATION);

   -- logical operation "gks_normalization"

   subtype CGI_SET_CLIPPING_RECTANGLE is
      CGI_INSTR(OP => SET_CLIPPING_RECTANGLE);

end CGI;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:DICTIONARY.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: DICTIONARY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: DICTIONARY.ADA
-- Level: all

generic

   type KEY_TYPE is private;

   with function "<" (LEFT, RIGHT : in     KEY_TYPE) return BOOLEAN;

   type VALUE_TYPE is private;

   type KEY_LIST_TYPE is array (POSITIVE range <>) of KEY_TYPE;

   type VALUE_LIST_TYPE is array (POSITIVE range <>) of VALUE_TYPE;

package DICTIONARY is

-- Package DICTIONARY defines an ASSOCIATION_TYPE and a DICTIONARY_TYPE.
--
-- An association between a KEY_TYPE value and a VALUE_TYPE value is
-- represented by an ASSOCIATION_TYPE value, which is a record with
-- components KEY, containing the KEY_TYPE value, and VALUE, containing
-- the VALUE_TYPE value associated with KEY.
--
-- A set of associations is called a dictionary, by analogy of the set
-- of associations between words and their definitions. Dictionaries may
-- be represented with objects of the type DICTIONARY_TYPE.
--
-- A dictionary serves as an associative memory, associating VALUE's to
-- KEY's.  For any KEY, the associated VALUE can be found.
--
-- A pure associative memory, like a set, imposes no order on the
-- entries.  This dictionary, like Webster's dictionary, is sorted.
-- The sorted order is used internally to speed-up searching for a KEY.
-- In order to impose a sorting order the "<" function is imported.  The
-- lists which can be derived from the dictionary, ASSOCIATION_LIST,
-- KEY_LIST, and VALUE_LIST, are returned in this sorted order.
--
-- DICTIONARY_TYPE is actually an access type.  Simple assignment of one
-- DICTIONARY_TYPE object to another only results in having two ways to
-- reference the same dictionary.  A COPY procedure is provided to
-- generate a new copy.

   type ASSOCIATION_TYPE is
      record
         KEY   : KEY_TYPE;
         VALUE : VALUE_TYPE;
      end record;

   type ASSOCIATION_LIST_TYPE is array (POSITIVE range <>)
         of ASSOCIATION_TYPE;

   type DICTIONARY_TYPE is private;

   KEY_IN_USE : exception;

   KEY_NOT_FOUND : exception;

   procedure CREATE
      (DICTIONARY : in out DICTIONARY_TYPE;
       ASSOCIATION : in     ASSOCIATION_TYPE);

   procedure CREATE
      (DICTIONARY : in out DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE;
       VALUE      : in     VALUE_TYPE);

   procedure ALTER
      (DICTIONARY : in     DICTIONARY_TYPE;
       ASSOCIATION : in     ASSOCIATION_TYPE);

   procedure ALTER
      (DICTIONARY : in     DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE;
       VALUE      : in     VALUE_TYPE);

   procedure ENTER
      (DICTIONARY : in out DICTIONARY_TYPE;
       ASSOCIATION : in     ASSOCIATION_TYPE);

   procedure ENTER
      (DICTIONARY : in out DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE;
       VALUE      : in     VALUE_TYPE);

   procedure REMOVE
      (DICTIONARY : in out DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE);

   procedure PURGE
      (DICTIONARY : in out DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE);

   function IS_IN
      (DICTIONARY : in     DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE) return BOOLEAN;

   function ASSOCIATION
      (DICTIONARY : in     DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE) return ASSOCIATION_TYPE;

   function VALUE
      (DICTIONARY : in     DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE) return VALUE_TYPE;

   function SIZE
      (DICTIONARY : in     DICTIONARY_TYPE) return NATURAL;

   function ASSOCIATION_LIST
      (DICTIONARY : in     DICTIONARY_TYPE) return ASSOCIATION_LIST_TYPE;

   function KEY_LIST
      (DICTIONARY : in     DICTIONARY_TYPE) return KEY_LIST_TYPE;

   function VALUE_LIST
      (DICTIONARY : in     DICTIONARY_TYPE) return VALUE_LIST_TYPE;

   function COPY
      (ORIGINAL : in     DICTIONARY_TYPE) return DICTIONARY_TYPE;

private

   type DICTIONARY_NODE_TYPE;

   type DICTIONARY_TYPE is access DICTIONARY_NODE_TYPE;

end DICTIONARY;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:DICTIONARY_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: DICTIONARY - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: DICTIONARY_B.ADA
-- Level: all

with UNCHECKED_DEALLOCATION;

package body DICTIONARY is

-- UNCHECKED_DEALLOCATION is a generic procedure in the predefined
-- language environment. Here, FREE_TREE_NODE is instantiated to
-- provide a procedure to deallocate TREE_NODE_TYPE objects.

   -- First some auxiliary types and subprograms must be defined

   type TREE_NODE_TYPE;

   type TREE_TYPE is access TREE_NODE_TYPE;

   type TREE_NODE_TYPE is
      record
         ASSOCIATION : ASSOCIATION_TYPE;
         -- ASSOCIATION holds the KEY and VALUE.
         L_SON : TREE_TYPE;
         -- L_SON designates the left-hand son of this node
         R_SON : TREE_TYPE;
         -- R_SON designates the right-hand son of this node
      end record;

   -- The TREE_NODE_TYPE contains the ASSOCIATION and access
   -- to the left subtree (L_SON) and the right subtree (R_SON).
   -- Dynamically allocated TREE_NODE_TYPE objects may be linked
   -- by the L_SON and R_SON fields.

   -- In this case, TREE_NODE_TYPE is used to build a sorted binary
   -- tree of linked nodes.  On insertion into the tree, if `KEY < ROOT
   -- . ASSOCIATION . KEY' returns `TRUE', the ASSOCIATION is inserted
   -- into the left subtree, `ROOT . L_SON'.
   -- (It is assumed that "<" is antisymmetric. That is, `A = B or
   -- (A < B xor B < A)'.)

   procedure FREE_TREE_NODE is new UNCHECKED_DEALLOCATION
      (OBJECT => TREE_NODE_TYPE,
       NAME   => TREE_TYPE);

   -- Procedure FREE_TREE_NODE (X : in out TREE_TYPE) deallocates
   -- the memory used for the tree nodes.  Ada semantic rules do not
   -- require an Ada implementation to perform automatic "garbage
   -- collection" of inaccessible nodes.  It is therefore expedient
   -- to perform UNCHECKED_DEALLOCATION of unused designated objects.
   --
   -- X                 - the access value of a TREE_TYPE designated
   --                     object which is no longer needed.

   function COPY
      (TREE : in     TREE_TYPE) return TREE_TYPE;

   -- Function COPY creates an identical copy of the original tree;
   -- Contrast this with simple assignment (":=") which only copies the
   -- access value, resulting in two ways to access the same designated
   -- object.
   --
   -- Note that the ASSOCIATIONs in the tree are only assigned, not
   -- themselves COPY'ed.  This is a warning against the use of access
   -- types for VALUE_TYPE.
   --
   -- TREE              - an access value of the tree to be copied

   function COPY_NOT_NULL
      (TREE : in     TREE_TYPE) return TREE_TYPE;

   -- COPT_NOT_NULL is a helper function for COPY. It creates an
   -- identical copy of the original tree, which is assumed to be
   -- non-null.  This function is more efficient than a single
   -- COPY function, since it does not have to test for a null TREE.
   --
   -- TREE - non-null access value to a tree

   function SEARCH
      (IN_TREE : in     TREE_TYPE;
       KEY  : in     KEY_TYPE) return TREE_TYPE;

   -- Function SEARCH searches the binary tree, returning the access
   -- to the node equal to KEY.  On average, search time is O(log2
   -- SIZE(IN_TREE)). If no node is found, a null access is returned.
   --
   -- IN_TREE           - an access value of the tree to be searched
   -- KEY               - KEY value used to compare tree nodes

   procedure TAKE_OUT
      (TREE : in out TREE_TYPE);

   -- Procedure TAKE_OUT replaces the TREE with the merger of its
   -- left and right subtrees. The subtrees themselves are altered to
   -- merge them together.
   --
   -- TREE              - an access value which is replaced with an
   --                   access to the root of the merged subtrees.

   generic

      with procedure PROCESS
         (ASSOCIATION : in     ASSOCIATION_TYPE);

   procedure PROCESS_TREE
      (TREE : in     TREE_TYPE);

   -- Procedure PROCESS_TREE calls its generic parameter PROCESS once
   -- for each ASSOCIATION in TREE.  Inorder traversal of TREE is used.
   --
   -- TREE              - an access value of the tree to be processed

   --
   -- Define implementations for entities declared in package
   -- specification
   --

   type DICTIONARY_NODE_TYPE is
      record
         SIZE : NATURAL := 0;
         ROOT : TREE_TYPE;
      end record;

   -- The SIZE of the dictionary is explicitly stored along with an
   -- access value to the ROOT of a simple binary tree.  No attempt is
   -- made to keep the tree balanced. This yields good average behavior
   -- over randomly distributed keys, but the worst case is poor for
   -- "linearized trees".  Choose the AVL tree for those cases.

   --
   -- Define bodies of auxiliary subprograms
   --

   function SEARCH
      (IN_TREE : in     TREE_TYPE;
       KEY     : in     KEY_TYPE) return TREE_TYPE is

   -- Function SEARCH returns an access value to the node of `IN_TREE'
   -- which has an `ASSOCIATION . KEY' field equal to `KEY'. If `KEY'
   -- is not found, the returned value is `null'.

      TREE : TREE_TYPE := IN_TREE;

   begin

      while TREE /= null loop

         if KEY = TREE . ASSOCIATION . KEY then

            exit;

         elsif KEY < TREE . ASSOCIATION . KEY then

            TREE := TREE . L_SON;

         else

            TREE := TREE . R_SON;

         end if;

      end loop;

      return TREE;

   end SEARCH;

   procedure PROCESS_TREE
      (TREE : in     TREE_TYPE) is

   -- Procedure PROCESS_TREE calls its generic parameter PROCESS once
   -- for each ASSOCIATION in TREE.  Inorder traversal of TREE is used.
   --
   -- TREE              - an access value of the tree to be processed

   begin

      if TREE /= null then

         PROCESS_TREE (TREE . L_SON);

         PROCESS (TREE . ASSOCIATION);

         PROCESS_TREE (TREE . R_SON);

      end if;

   end PROCESS_TREE;

   function COPY
      (TREE : in     TREE_TYPE) return TREE_TYPE is

   -- Create an identical copy of the original tree.  Contrast this
   -- with simple assignment (":=").
   -- Note that the ASSOCIATIONs in the tree are only assigned, not
   -- COPY'ed, themselves.
   --
   -- TREE - Access to root of binary tree

   begin

      if TREE /= null then

         return  COPY_NOT_NULL (TREE);

      else

         return null;

      end if;

   end COPY;

   function COPY_NOT_NULL
      (TREE : in     TREE_TYPE) return TREE_TYPE is

   -- Create an identical copy of the original tree, assumed to be
   -- non-null.  This function is more efficient than a single
   -- COPY function, since it does not have to test for a null TREE.
   -- It does test for null sons of TREE, but these tests are paid
   -- back by avoiding over half of the procedure calls which would
   -- otherwise be wasted to produce a null value.  (For `N' interior
   -- nodes, there are `N+1' null values.)
   --
   -- TREE - non-null Access to root of binary tree

      TREE_L : TREE_TYPE;
      -- Access Object to designate new left subtree

      TREE_R : TREE_TYPE;
      -- Access Object to designate new right subtree

   begin
      -- We assume that TREE is non-null. We avoid any calls
      -- which would violate this assumption.

      -- Test TREE . L_SON to avoid recursion for null tree

      if TREE . L_SON /= null then

         TREE_L := COPY_NOT_NULL (TREE . L_SON);

      end if;

      -- Test TREE . R_SON to avoid recursion for null tree

      if TREE . R_SON /= null then

         TREE_R := COPY_NOT_NULL (TREE . R_SON);

      end if;

      return new TREE_NODE_TYPE' (
            L_SON       => TREE_L,
            R_SON       => TREE_R,
            ASSOCIATION => TREE . ASSOCIATION);

   end COPY_NOT_NULL;

   procedure TAKE_OUT
      (TREE : in out TREE_TYPE) is

   -- Procedure TAKE_OUT removes the node accessed by `TREE' and
   -- replaces it with another node.  The tree descending from `TREE'
   -- is reformed in a simple way to avoid increasing the depth of
   -- the tree.  After the two trivial cases, where one subtree is null,
   -- two other cases arise. In the first, the left subtree can simply
   -- be attached as `L_SON' of `TREE . R_SON', the successor of TREE.
   -- In the final case, the successor of `TREE' is moved from the end
   -- of the L_SON chain of `TREE . R_SON' to be the new root of the
   -- tree.
   --
   -- TREE - access to the node to be deleted.  Return value is
   --        root of the re-formed tree.  The initial value of TREE
   --        should not be null, or a CONSTRAINT_ERROR arises.

      TREE_L : TREE_TYPE := TREE . L_SON;
      -- TREE_L - Left son of the original root

      TREE_R : TREE_TYPE := TREE . R_SON;
      -- TREE_R - Right son of the original root

   begin

      -- Reclaim storage for deleted node (at TREE)
      -- We still have access to subtrees through TREE_L and TREE_R.

      FREE_TREE_NODE (TREE);

      -- The first two cases can be in arbitrary order

      if TREE_L = null then

         TREE := TREE_R;

      elsif TREE_R = null then

         TREE := TREE_L;

      else
         -- At this point, (TREE_L /= null) and (TREE_R /= null)

         -- TREE_L and TREE_R are two non-null subtrees to be merged.
         -- To preserve the sequence of in-order traversal, either the
         -- predecessor or the successor of the original TREE node can
         -- be installed as the new root node. We arbitrarily choose the
         -- successor, in the right subtree, as the new root.

         TREE := TREE_R;

         if TREE . L_SON = null then

            -- We only have to attach the left subtree

            TREE . L_SON := TREE_L;

         else

            -- Successor is at the end of the "L_SON" chain

            declare

               PREV : TREE_TYPE;
               -- Node from which TREE (the successor) is to be detached

            begin

               loop

                  PREV := TREE;

                  TREE := TREE . L_SON;

                  exit when TREE . L_SON = null;

               end loop;

               -- Replace PREV . L_SON with TREE . R_SON
               -- Note that, currently, TREE = PREV . L_SON;

               PREV . L_SON := TREE . R_SON;

               -- Attach left and right subtrees to TREE

               TREE . L_SON := TREE_L;
               TREE . R_SON := TREE_R;

            end;

         end if;

      end if;

   end TAKE_OUT;

   --
   -- Define implementations for subprograms declared in package
   -- specification
   --

   procedure CREATE
      (DICTIONARY : in out DICTIONARY_TYPE;
       ASSOCIATION : in     ASSOCIATION_TYPE) is

   -- CREATE adds a new association to the dictionary.  If ASSOCIATION .
   -- KEY already is used in an association, then KEY_IN_USE is raised.
   -- Exceptions:  KEY_IN_USE
   --
   -- DICTIONARY        - an access value of the dictionary in which
   --                   ASSOCIATION is to be inserted.  This parameter
   --                   must be `in out' mode because a newly allocated
   --                   access value is returned in place of a null
   --                   `in' value for DICTIONARY.
   -- ASSOCIATION       - a record representing the association of its
   --                   KEY component with its VALUE component.

      KEY : KEY_TYPE renames ASSOCIATION . KEY;

      procedure FIND
         (TREE : in out TREE_TYPE) is

      -- Procedure FIND moves down the TREE recursively searching
      -- for the point to insert the new ASSOCIATION.  Searching
      -- continues until either a node is found with an equal KEY, or
      -- an empty branch is taken.  KEY_IN_USE is raised if the key is
      -- found in the tree.  The null branch is replaced with a new
      -- node.
      --
      -- Procedure FIND originally had more work to do, updating
      -- the SIZE fields of each node along the access path. Now,
      -- the only SIZE field is in the DICTIONARY, not the TREE.
      -- An iterative version of CREATE could be made without using
      -- a recursive procedure.  However, the formal parameter TREE
      -- stands in for both the `TREE . L_SON' and `TREE . R_SON' calls
      -- in this version, resulting in a more compact and readable
      -- algorithm.

      -- WARNING: FIND uses `KEY' and `DICTIONARY . SIZE' from
      -- the enclosing scope.

      begin

         if TREE = null then

            TREE := new TREE_NODE_TYPE'
                 (L_SON        => null,
                  R_SON        => null,
                  ASSOCIATION => ASSOCIATION);

         elsif KEY = TREE . ASSOCIATION . KEY then

            raise KEY_IN_USE;

         elsif KEY < TREE . ASSOCIATION . KEY then

            FIND (TREE . L_SON);

         else

            FIND (TREE . R_SON);

         end if;

      end FIND;

   begin

      if DICTIONARY = null then

         DICTIONARY := new DICTIONARY_NODE_TYPE'
            (SIZE => 0, ROOT => null);

      end if;

      FIND (DICTIONARY . ROOT);

      -- if KEY_IN_USE is raised, the following is not executed
      DICTIONARY . SIZE := DICTIONARY . SIZE + 1;

   end CREATE;

   procedure CREATE
      (DICTIONARY : in out DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE;
       VALUE      : in     VALUE_TYPE) is

   -- CREATE adds a new association to the dictionary linking KEY to its
   -- associated value. If KEY already has an association KEY_IN_USE is
   -- raised.
   -- Exceptions:  KEY_IN_USE
   --
   -- DICTIONARY        - an access value of the dictionary in which
   --                   ASSOCIATION is to be inserted.  This parameter
   --                   must be `in out' mode because a newly allocated
   --                   access value is returned in place of a null
   --                   `in' value for DICTIONARY.
   -- KEY               - the "handle" by which VALUE can be referenced
   --                   in the DICTIONARY. (Corresponds to the "word"
   --                   which is used to order and index the
   --                   dictionary.)
   -- VALUE             - the information which is to be associated with
   --                   KEY.  (Corresponds to the "definition" of KEY in
   --                   a dictionary.)

   begin

      CREATE (DICTIONARY, ASSOCIATION_TYPE' (KEY, VALUE));

   end CREATE;

   procedure ALTER
      (DICTIONARY  : in     DICTIONARY_TYPE;
       ASSOCIATION : in     ASSOCIATION_TYPE) is

   -- ALTER replaces a pre-existing association in the dictionary.
   -- If ASSOCIATION . KEY is not in DICTIONARY then KEY_NOT_FOUND is
   -- raised.
   -- Exceptions:  KEY_NOT_FOUND
   --
   -- DICTIONARY        - an access value of the dictionary in which
   --                   ASSOCIATION is to be altered.
   -- ASSOCIATION       - a record representing the association of its
   --                   KEY component with its VALUE component.

      KEY : KEY_TYPE renames ASSOCIATION . KEY;

      TREE : TREE_TYPE;

   begin

      if DICTIONARY = null then

         raise KEY_NOT_FOUND;

      end if;

      TREE := DICTIONARY . ROOT;

      while TREE /= null
      loop

         if KEY = TREE . ASSOCIATION . KEY then

            TREE . ASSOCIATION := ASSOCIATION;
            return;

         elsif KEY < TREE . ASSOCIATION . KEY then

            TREE := TREE . L_SON;

         else

            TREE := TREE . R_SON;

         end if;

      end loop;

      raise KEY_NOT_FOUND;

   end ALTER;

   procedure ALTER
      (DICTIONARY : in     DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE;
       VALUE      : in     VALUE_TYPE) is

   -- ALTER sets the VALUE corresponding to KEY. KEY must already
   -- be in DICTIONARY or else KEY_NOT_FOUND is raised.
   -- Exceptions:  KEY_NOT_FOUND
   --
   -- DICTIONARY        - an access value of the dictionary in which
   --                   ASSOCIATION is to be inserted.
   -- KEY               - the "handle" by which VALUE can be referenced
   --                   in the DICTIONARY. (Corresponds to the "word"
   --                   which is used to order and index the
   --                   dictionary.)
   -- VALUE             - the information which is to be associated with
   --                   KEY.  (Corresponds to the "definition" of KEY in
   --                   a dictionary.)

      TREE : TREE_TYPE;

   begin

      if DICTIONARY = null then

         raise KEY_NOT_FOUND;

      end if;

      TREE := DICTIONARY . ROOT;

      while TREE /= null
      loop

         if KEY = TREE . ASSOCIATION . KEY then

            TREE . ASSOCIATION . VALUE := VALUE;
            return;

         elsif KEY < TREE . ASSOCIATION . KEY then

            TREE := TREE . L_SON;

         else

            TREE := TREE . R_SON;

         end if;

      end loop;

      raise KEY_NOT_FOUND;

   end ALTER;

   procedure ENTER
      (DICTIONARY  : in out DICTIONARY_TYPE;
       ASSOCIATION : in     ASSOCIATION_TYPE) is

   -- ENTER puts an ASSOCIATION in DICTIONARY.  ASSOCIATION . KEY may
   -- or may not already be in the dictionary.
   --
   -- DICTIONARY        - an access value of the dictionary in which
   --                   ASSOCIATION is to be inserted.  This parameter
   --                   must be `in out' mode because a newly allocated
   --                   access value is returned in place of a null
   --                   `in' value for DICTIONARY.
   -- ASSOCIATION       - a record representing the association of its
   --                   KEY component with its VALUE component.

      KEY : KEY_TYPE renames ASSOCIATION . KEY;

      procedure FIND
         (TREE : in out TREE_TYPE) is

      -- Procedure FIND moves down the TREE recursively searching
      -- for the point to insert the new ASSOCIATION.  Searching
      -- continues until either a node is found with an equal KEY, or
      -- an empty branch is taken.  If the key is found in the tree,
      -- the association of that node is replaced. A null branch is
      -- replaced with a new node.
      --
      -- Procedure FIND originally had more work to do, updating
      -- the SIZE fields of each node along the access path. Now,
      -- the only SIZE field is in the DICTIONARY, not the TREE.
      -- An iterative version of ENTER could be made without using
      -- a recursive procedure.  However, the formal parameter TREE
      -- stands in for both the `TREE . L_SON' and `TREE . R_SON' calls
      -- in this version, resulting in a more compact and readable
      -- algorithm.

      -- WARNING: FIND uses `KEY' and `DICTIONARY . SIZE' from
      -- the enclosing scope.

      begin

         if TREE = null then

            TREE := new TREE_NODE_TYPE' (
                  L_SON        => null,
                  R_SON        => null,
                  ASSOCIATION => ASSOCIATION);

            DICTIONARY . SIZE := DICTIONARY . SIZE + 1;

            return;

         elsif KEY = TREE . ASSOCIATION . KEY then

            TREE . ASSOCIATION := ASSOCIATION;

            return;

         elsif KEY < TREE . ASSOCIATION . KEY then

            FIND (TREE . L_SON);

         else

            FIND (TREE . R_SON);

         end if;

      end FIND;

   begin

      if DICTIONARY = null then

         DICTIONARY := new DICTIONARY_NODE_TYPE'
            (SIZE => 0, ROOT => null);

      end if;

      FIND (DICTIONARY . ROOT);

   end ENTER;

   procedure ENTER
      (DICTIONARY : in out DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE;
       VALUE      : in     VALUE_TYPE) is

   -- ENTER associates VALUE with KEY in DICTIONARY.  KEY may
   -- or may not already be in the dictionary.
   --
   -- DICTIONARY        - an access value of the dictionary in which
   --                   ASSOCIATION is to be inserted.  This parameter
   --                   must be `in out' mode because a newly allocated
   --                   access value is returned in place of a null
   --                   `in' value for DICTIONARY.
   -- KEY               - the "handle" by which VALUE can be referenced
   --                   in the DICTIONARY. (Corresponds to the "word"
   --                   which is used to order and index the
   --                   dictionary.)
   -- VALUE             - the information which is to be associated with
   --                   KEY.  (Corresponds to the "definition" of KEY in
   --                   a dictionary.)

      procedure FIND
         (TREE : in out TREE_TYPE) is

      -- Procedure FIND moves down the TREE recursively searching
      -- for the point to insert the new ASSOCIATION.  Searching
      -- continues until either a node is found with an equal KEY, or
      -- an empty branch is taken.  If the key is found in the tree,
      -- the association of that node is replaced. A null branch is
      -- replaced with a new node.
      --
      -- TREE - The access value to the tree being searched
      --
      -- Procedure FIND originally had more work to do, updating
      -- the SIZE fields of each node along the access path. Now,
      -- the only SIZE field is in the DICTIONARY, not the TREE.
      -- An iterative version of ENTER could be made without using
      -- a recursive procedure.  However, the formal parameter TREE
      -- stands in for both the `TREE . L_SON' and `TREE . R_SON' calls
      -- in this version, resulting in a more compact and readable
      -- algorithm.

      -- WARNING: FIND uses `KEY' and `DICTIONARY . SIZE' from
      -- the enclosing scope.

      begin

         if TREE = null then

            TREE := new TREE_NODE_TYPE' (
                  L_SON        => null,
                  R_SON        => null,
                  ASSOCIATION => ASSOCIATION_TYPE' (KEY, VALUE));

            DICTIONARY . SIZE := DICTIONARY . SIZE + 1;

            return;

         elsif KEY = TREE . ASSOCIATION . KEY then

            TREE . ASSOCIATION . VALUE := VALUE;

            return;

         elsif KEY < TREE . ASSOCIATION . KEY then

            FIND (TREE . L_SON);

         else

            FIND (TREE . R_SON);

         end if;

      end FIND;

   begin

      if DICTIONARY = null then

         DICTIONARY := new DICTIONARY_NODE_TYPE'
            (SIZE => 0, ROOT => null);

      end if;

      FIND (DICTIONARY . ROOT);

      -- The following Code could replace this subprogram body and
      -- its "FIND" routine.  However, code space has been sacrificed
      -- to attempt to provide better run-time speed.
      -- ENTER (DICTIONARY, ASSOCIATION_TYPE' (KEY, VALUE));
      --
   end ENTER;

   procedure REMOVE
      (DICTIONARY : in out DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE) is

   -- Remove the association of KEY to its VALUE in DICTIONARY.  If no
   -- association exists for KEY, raise KEY_NOT_FOUND.
   -- Exceptions:  KEY_NOT_FOUND
   --
   -- DICTIONARY        - an access value of the dictionary from which
   --                   KEY is to be removed.
   -- KEY               - value of the KEY field of the ASSOCIATION to
   --                   be removed from DICTIONARY.

      procedure FIND
         (TREE : in out TREE_TYPE) is

      -- Procedure FIND moves down the TREE recursively searching
      -- for the ASSOCIATION with the given KEY.  Searching
      -- continues until either a node is found with an equal KEY, or
      -- an empty branch is taken.  If the key is found in the tree,
      -- the association of that node is removed. If not found, the
      -- exception KEY_NOT_FOUND is raised.
      --
      -- TREE - Access to root of Tree in being searched
      --
      -- Procedure FIND originally had more work to do, updating
      -- the SIZE fields of each node along the access path. Now,
      -- the only SIZE field is in the DICTIONARY, not the TREE.
      -- An iterative version of ENTER could be made without using
      -- a recursive procedure.  However, the formal parameter TREE
      -- stands in for both the `TREE . L_SON' and `TREE . R_SON' calls
      -- in this version, resulting in a more compact and readable
      -- algorithm.

      -- WARNING: FIND uses `KEY' and `DICTIONARY . SIZE' from
      -- the enclosing scope.

      begin

         if TREE = null then

            raise KEY_NOT_FOUND;

         elsif KEY = TREE . ASSOCIATION . KEY then

            TAKE_OUT (TREE);

            DICTIONARY . SIZE := DICTIONARY . SIZE - 1;

            return;

         elsif KEY < TREE . ASSOCIATION . KEY then

            FIND (TREE . L_SON);

         else

            FIND (TREE . R_SON);

         end if;

      end FIND;

   begin

      if DICTIONARY = null then

         raise KEY_NOT_FOUND;

      end if;

      FIND (DICTIONARY . ROOT);

   end REMOVE;

   procedure PURGE
      (DICTIONARY : in out DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE) is

   -- Remove any association of KEY to its (unknown) VALUE from
   -- DICTIONARY. If no association exists, just return.
   --
   -- DICTIONARY        - an access value of the dictionary from which
   --                   KEY is to be purged.
   -- KEY               - value of the KEY field of the ASSOCIATION to
   --                   be purged from DICTIONARY.

      procedure FIND
         (TREE : in out TREE_TYPE) is

      -- Procedure FIND moves down the TREE recursively searching
      -- for the ASSOCIATION with the given KEY.  Searching
      -- continues until either a node is found with an equal KEY, or
      -- an empty branch is taken.  If the key is found in the tree,
      -- the association of that node is removed. If not found, no
      -- action is taken.
      --
      -- TREE - Access to root of tree being searched
      --
      -- Procedure FIND originally had more work to do, updating
      -- the SIZE fields of each node along the access path. Now,
      -- the only SIZE field is in the DICTIONARY, not the TREE.
      -- An iterative version of ENTER could be made without using
      -- a recursive procedure.  However, the formal parameter TREE
      -- stands in for both the `TREE . L_SON' and `TREE . R_SON' calls
      -- in this version, resulting in a more compact and readable
      -- algorithm.

      -- WARNING: FIND uses `KEY' and `DICTIONARY . SIZE' from
      -- the enclosing scope.

      begin

         if TREE = null then

            return;

         elsif KEY = TREE . ASSOCIATION . KEY then

            TAKE_OUT (TREE);

            DICTIONARY . SIZE := DICTIONARY . SIZE - 1;

            return;

         elsif KEY < TREE . ASSOCIATION . KEY then

            FIND (TREE . L_SON);

         else

            FIND (TREE . R_SON);

         end if;

      end FIND;

   begin

      if DICTIONARY = null then

         return;

      end if;

      FIND (DICTIONARY . ROOT);

   end PURGE;

   function IS_IN
      (DICTIONARY : in     DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE) return BOOLEAN is

   -- Function IS_IN returns TRUE if KEY has an ASSOCIATION in the
   -- DICTIONARY.
   --
   -- DICTIONARY        - an access value of the dictionary that is
   --                   searched for KEY.
   -- KEY               - value of the KEY field of the ASSOCIATION to
   --                   be matched in DICTIONARY.

   begin

      return DICTIONARY /= null and then
            SEARCH (DICTIONARY . ROOT, KEY) /= null;

   end IS_IN;

   function ASSOCIATION
      (DICTIONARY : in     DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE) return ASSOCIATION_TYPE is

   -- Function ASSOCIATION returns the ASSOCIATION associated
   -- with KEY in the DICTIONARY.
   -- Exceptions:  KEY_NOT_FOUND
   -- DICTIONARY        - an access value of the dictionary that is
   --                   searched for KEY.
   -- KEY               - value of the KEY field of the ASSOCIATION to
   --                   be matched in DICTIONARY.

   begin

         if DICTIONARY = null then

         raise KEY_NOT_FOUND;

      end if;

      declare

         TREE : TREE_TYPE := SEARCH (DICTIONARY . ROOT, KEY);

      begin

         if TREE = null then

            raise KEY_NOT_FOUND;

         end if;

         return TREE . ASSOCIATION;

      end;

   end ASSOCIATION;

   function VALUE
      (DICTIONARY : in     DICTIONARY_TYPE;
       KEY        : in     KEY_TYPE) return VALUE_TYPE is

   -- Function VALUE returns the VALUE associated with KEY in the
   -- specified DICTIONARY.
   -- Exceptions:  KEY_NOT_FOUND
   -- DICTIONARY        - an access value of the dictionary that is
   --                   searched for KEY.
   -- KEY               - value of the KEY field of the ASSOCIATION to
   --                   be matched in DICTIONARY.

   begin

      return ASSOCIATION (DICTIONARY, KEY) . VALUE;

   end VALUE;

   function SIZE
      (DICTIONARY : in     DICTIONARY_TYPE) return NATURAL is

   -- Return the number of ASSOCIATIONS in DICTIONARY.
   -- DICTIONARY        - an access value of the dictionary

   begin

      if DICTIONARY = null then

         return 0;

      else

         return DICTIONARY . SIZE;

      end if;

   end SIZE;

   function ASSOCIATION_LIST
      (DICTIONARY : in    DICTIONARY_TYPE)
       return ASSOCIATION_LIST_TYPE is

   -- Return the list of ASSOCIATIONs currently in DICTIONARY.
   --
   -- Note on usage:
   -- Normally one does not return a unconstrained type, since
   -- the calling program must be able to handle the returned value
   -- without raising a CONSTRAINT_ERROR. This is perfectly feasible
   -- here because the calling program can use SIZE(DICTIONARY) to
   -- predict and conform to the constraint.
   --
   -- The order of the keys is ascending, as defined by generic
   -- parameter "<".
   --
   -- DICTIONARY - access to the dictionary

      LIST : ASSOCIATION_LIST_TYPE (1.. SIZE(DICTIONARY));
      -- Array to return list of associations.

      LIST_INDEX : NATURAL := 0;
      -- Current number of associations in LIST

      procedure APPEND_ASSOCIATION_TO_LIST
         (ASSOCIATION : in     ASSOCIATION_TYPE) is

      -- Helper procedure used to define instantiation of generic
      -- PROCESS_TREE.  APPEND_ASSOCIATION_TO_LIST adds the association
      -- to the end of the LIST of associations collected so far.
      --
      -- ASSOCIATION - next association to be added to LIST
      --
      -- LIST_INDEX and LIST come from the enclosing scope

      begin

         LIST_INDEX := LIST_INDEX + 1;
         LIST (LIST_INDEX) := ASSOCIATION;

      end APPEND_ASSOCIATION_TO_LIST;

      procedure BUILD_ASSOCIATION_LIST is new PROCESS_TREE
         (PROCESS => APPEND_ASSOCIATION_TO_LIST);

   begin

      if DICTIONARY /= null then

         BUILD_ASSOCIATION_LIST(DICTIONARY . ROOT);

      end if;

      return LIST;

   end ASSOCIATION_LIST;

   function KEY_LIST
      (DICTIONARY : in    DICTIONARY_TYPE)
         return KEY_LIST_TYPE is

   -- Return the list of KEYS currently used in DICTIONARY.
   --
   -- Note on usage:
   -- Normally one does not return a unconstrained type, since
   -- the calling program must be able to handle the returned value
   -- without raising a CONSTRAINT_ERROR. This is perfectly feasible
   -- here because the calling program can use SIZE(DICTIONARY) to
   -- predict and conform to the constraint.
   --
   -- The order of the keys is ascending, as defined by generic
   -- parameter "<".
   --
   -- DICTIONARY - access to the dictionary

      LIST : KEY_LIST_TYPE(1.. SIZE (DICTIONARY));
      -- Array to return list of keys.

      LIST_INDEX : NATURAL := 0;
      -- Current number of items in LIST

      procedure APPEND_KEY_TO_LIST
         (ASSOCIATION : in     ASSOCIATION_TYPE) is

      -- Helper procedure used to define instantiation of generic
      -- PROCESS_TREE.  APPEND_KEY_TO_LIST adds the key
      -- to the end of the LIST of keys collected so far.
      --
      -- ASSOCIATION - ASSOCIATION . KEY is next KEY to be added to LIST
      --
      -- LIST_INDEX and LIST come from the enclosing scope

      begin

         LIST_INDEX := LIST_INDEX + 1;
         LIST (LIST_INDEX) := ASSOCIATION . KEY;

      end APPEND_KEY_TO_LIST;

      procedure BUILD_KEY_LIST is new PROCESS_TREE
         (PROCESS => APPEND_KEY_TO_LIST);

   begin

      if DICTIONARY /= null then

         BUILD_KEY_LIST(DICTIONARY . ROOT);

      end if;

      return LIST;

   end KEY_LIST;

   function VALUE_LIST
      (DICTIONARY : in    DICTIONARY_TYPE) return VALUE_LIST_TYPE is

   -- Return the list of VALUES currently used in DICTIONARY.
   -- The order of the VALUES is identical to KEY_LIST.
   --
   -- Note on usage:
   -- Normally one does not return a unconstrained type, since
   -- the calling program must be able to handle the returned value
   -- without raising a CONSTRAINT_ERROR. This is perfectly feasible
   -- here because the calling program can use SIZE(DICTIONARY) to
   -- predict and conform to the constraint.
   --

      LIST : VALUE_LIST_TYPE(1.. SIZE (DICTIONARY));
      -- Array to return list of VALUEs

      LIST_INDEX : NATURAL := 0;
      -- Current number of items in LIST

      procedure APPEND_VALUE_TO_LIST
         (ASSOCIATION : in     ASSOCIATION_TYPE) is

      -- Helper procedure used to define instantiation of generic
      -- PROCESS_TREE.  APPEND_VALUE_TO_LIST adds the value
      -- to the end of the LIST of values collected so far.
      --
      -- ASSOCIATION - ASSOCIATION . VALUE is next VALUE to be added
      --
      -- LIST_INDEX and LIST come from the enclosing scope

      begin

         LIST_INDEX := LIST_INDEX + 1;
         LIST (LIST_INDEX) := ASSOCIATION . VALUE;

      end APPEND_VALUE_TO_LIST;

      procedure BUILD_VALUE_LIST is new PROCESS_TREE
         (PROCESS => APPEND_VALUE_TO_LIST);

   begin

      if DICTIONARY /= null then

         BUILD_VALUE_LIST(DICTIONARY . ROOT);

      end if;

      return LIST;

   end VALUE_LIST;

   function COPY
      (ORIGINAL : in     DICTIONARY_TYPE)
         return DICTIONARY_TYPE is

   -- Create an identical copy of the ORIGINAL dictionary.
   -- Contrast this with ":=".
   -- Note that the ASSOCIATIONs in the dictionary are
   -- only assigned, not COPY'ed.
   --
   -- ORIGINAL - Access to original DICTIONARY

   begin

      if ORIGINAL /= null then

         return new DICTIONARY_NODE_TYPE'
            (SIZE => ORIGINAL . SIZE,
             ROOT => COPY (ORIGINAL . ROOT));

      else

         return null;

      end if;

   end COPY;

end DICTIONARY;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:CGI_OPEN_WS_OPS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CGI_OPEN_WS_OPERATIONS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: CGI_OPEN_WS_OPS.ADA
-- level: ma, 0a, 1a, 2a

with GKS_TYPES;
with DICTIONARY;

use GKS_TYPES;

package CGI_OPEN_WS_OPERATIONS is

-- This package contains OPEN_WS package which is an instantiation
-- of a DICTIONARY package.  It provides the workstation manager level
-- the means to maintain a set of open ws ids and their associated
-- workstation types.
-- Package GKS_TYPES provides type definitions.

   type WS_ID_LIST is array (POSITIVE range <>) of
         WS_ID;
   -- Array of workstation ids returned by some subprograms from
   -- DICTIONARY package

   type WS_TYPE_LIST is array (POSITIVE range   <>)
         of WS_TYPE;
   -- Array of workstation types returned by some subprograms from
   -- DICTIONARY package

   package OPEN_WS is new DICTIONARY
      (KEY_TYPE  => WS_ID,
       "<" => "<",
       VALUE_TYPE =>  WS_TYPE,
       KEY_LIST_TYPE => WS_ID_LIST,
       VALUE_LIST_TYPE => WS_TYPE_LIST);
   -- Provides a dictionary and the appropriate operations for the
   -- association between a workstation id and a
   -- workstation type for each open workstation

   OPEN_DICTIONARY : OPEN_WS.DICTIONARY_TYPE;
   -- Association of the workstation id and workstation type for each
   -- open workstation

end CGI_OPEN_WS_OPERATIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI3700_WSD_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_WSD
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: LEXI3700_WSD_MA.ADA
-- level: ma

with CGI;
with GKS_TYPES;

use  CGI;
use  GKS_TYPES;

package LEXI3700_WSD is

-- This package LEXI3700_WSD is the LEXIDATA workstation driver. As
-- a workstation driver, it controls the flow of operations to the
-- device driver.
--
-- Package GKS_TYPES provides type definitions.
-- Package CGI provides the data interface from the workstation
-- manager. The data interface is a discriminant record made up of
-- an OPERATION and the corresponding parameters for the operation.
--
-- This package LEXI3700_WSD provides a single procedure LEXI3700_WSD
-- to perform the workstation operation which is encoded in the CGI
-- instruction.

   procedure LEXI3700_WSD
      (INSTR : in out CGI_INSTR;
       AFFECTED_WS_ID : in WS_ID);

end LEXI3700_WSD;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:ERROR_ROUTINES_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: ERROR_ROUTINES
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  error_routines_ma.ada
-- level: ma

with GKS_TYPES;

use GKS_TYPES;

package ERROR_ROUTINES is

-- This package provides the procedures for gks error handling.

   procedure ERROR_LOGGING
      (EI  : in ERROR_INDICATOR;
      NAME : in SUBPROGRAM_NAME);

end ERROR_ROUTINES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_CONTROL.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_CONTROL
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  gks_control.ada
-- level: all levels

with GKS_TYPES;
with GKS_CONFIGURATION;

use GKS_TYPES;

package GKS_CONTROL is

-- This package provides the functions for GKS
-- control.

   procedure OPEN_GKS
      (ERROR_FILE       : in ERROR_FILE_TYPE :=
                          GKS_CONFIGURATION.DEFAULT_ERROR_FILE;
      AMOUNT_OF_MEMORY  : in MEMORY_UNITS :=
                          GKS_CONFIGURATION.MAX_MEMORY_UNITS);

   procedure CLOSE_GKS;

end GKS_CONTROL;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_NORM_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_NORMALIZATION
--  IDENTIFIER: GIMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR028  Normalization of primitive attributes.
------------------------------------------------------------------
-- file:  gks_norm.ada
-- level: MA

with GKS_TYPES;

use GKS_TYPES;

package GKS_NORMALIZATION is

-- This package provides the normalization transformation
-- procedures for GKS.

   procedure SET_WINDOW
      (TRANSFORMATION : in TRANSFORMATION_NUMBER;
      WINDOW_LIMITS   : in WC.RECTANGLE_LIMITS);

   procedure SET_VIEWPORT
      (TRANSFORMATION : in TRANSFORMATION_NUMBER;
      VIEWPORT_LIMITS : in NDC.RECTANGLE_LIMITS);

   procedure SELECT_NORMALIZATION_TRANSFORMATION
      (TRANSFORMATION : in TRANSFORMATION_NUMBER);

   procedure SET_CLIPPING_INDICATOR
      (CLIPPING : in CLIPPING_INDICATOR);

end GKS_NORMALIZATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:INQ_BUNDLE_IDX.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_BUNDLE_INDICES
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_bundle_idx.ada
-- level: all levels

with GKS_TYPES;

use GKS_TYPES;

package INQ_BUNDLE_INDICES is

-- This package provides the procedures for setting the
-- bundled primitive attributes.

   procedure INQ_POLYLINE_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out POLYLINE_INDEX);

   procedure INQ_POLYMARKER_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out POLYMARKER_INDEX);

   procedure INQ_FILL_AREA_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out FILL_AREA_INDEX);

   procedure INQ_TEXT_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out TEXT_INDEX);

end INQ_BUNDLE_INDICES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:INQ_GKS_DSCR_TBL_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_GKS_DESCRIPTION_TABLE_MA
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_gks_dscr_tbl_ma.ada
-- level: all levels

with GKS_TYPES;

use GKS_TYPES;

package INQ_GKS_DESCRIPTION_TABLE_MA is

-- This package provides the inquiry procedures for inquiring
-- values of the GKS description table.

   procedure INQ_LEVEL_OF_GKS
      (EI   : out ERROR_INDICATOR;
      LEVEL : out GKS_LEVEL);

end INQ_GKS_DESCRIPTION_TABLE_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:INQ_GKS_ST_LST_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_GKS_STATE_LIST_MA
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_gks_st_lst_ma.ada
-- level: all levels

with GKS_TYPES;

use GKS_TYPES;

package INQ_GKS_STATE_LIST_MA is

-- This package provides the inquiry procedures for inquiring
-- values of the GKS_STATE_LIST.

   procedure INQ_CURRENT_NORMALIZATION_TRANSFORMATION_NUMBER
      (EI            : out ERROR_INDICATOR;
      TRANSFORMATION : out TRANSFORMATION_NUMBER);

   procedure INQ_NORMALIZATION_TRANSFORMATION
      (TRANSFORMATION : in TRANSFORMATION_NUMBER;
      EI              : out ERROR_INDICATOR;
      WINDOW_LIMITS   : out WC.RECTANGLE_LIMITS;
      VIEWPORT_LIMITS : out NDC.RECTANGLE_LIMITS);

   procedure INQ_CLIPPING
      (EI                : out ERROR_INDICATOR;
      CLIPPING           : out CLIPPING_INDICATOR;
      CLIPPING_RECTANGLE : out NDC.RECTANGLE_LIMITS);

end INQ_GKS_STATE_LIST_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:INQ_INDV_ATTR.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_INDIVIDUAL_ATTRIBUTES
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_indv_attr.ada
-- level: all levels

with GKS_TYPES;

use GKS_TYPES;

package INQ_INDIVIDUAL_ATTRIBUTES is

-- This package provides the procedures for inquiring the current
-- individual attribute values.  These procedures are a result of
-- the one-to-many mapping of the GKS function Inquire Current
-- Individual Attribute Values.  In addition, this package includes
-- a procedure INQ_CURRENT_INDIVIDUAL_ATTRIBUTE_VALUES that is a
-- one-to-one mapping of the GKS function.  This allows the application
-- to inquire all of the individual attributes in a single call.

   procedure INQ_LINETYPE
      (EI  : out ERROR_INDICATOR;
      LINE : out LINETYPE);

   procedure INQ_LINEWIDTH_SCALE_FACTOR
      (EI   : out ERROR_INDICATOR;
      WIDTH : out LINE_WIDTH);

   procedure INQ_POLYLINE_COLOUR_INDEX
      (EI    : out ERROR_INDICATOR;
      COLOUR : out COLOUR_INDEX);

   procedure INQ_POLYMARKER_TYPE
      (EI    : out ERROR_INDICATOR;
      MARKER : out MARKER_TYPE);

   procedure INQ_POLYMARKER_SIZE_SCALE_FACTOR
      (EI  : out ERROR_INDICATOR;
      SIZE : out MARKER_SIZE);

   procedure INQ_POLYMARKER_COLOUR_INDEX
      (EI    : out ERROR_INDICATOR;
      COLOUR : out COLOUR_INDEX);

   procedure INQ_TEXT_FONT_AND_PRECISION
      (EI            : out ERROR_INDICATOR;
      FONT_PRECISION : out TEXT_FONT_PRECISION);

   procedure INQ_CHAR_EXPANSION_FACTOR
      (EI       : out ERROR_INDICATOR;
      EXPANSION : out CHAR_EXPANSION);

   procedure INQ_CHAR_SPACING
      (EI     : out ERROR_INDICATOR;
      SPACING : out CHAR_SPACING);

   procedure INQ_TEXT_COLOUR_INDEX
      (EI    : out ERROR_INDICATOR;
      COLOUR : out COLOUR_INDEX);

   procedure INQ_FILL_AREA_INTERIOR_STYLE
      (EI   : out ERROR_INDICATOR;
      STYLE : out INTERIOR_STYLE);

   procedure INQ_FILL_AREA_STYLE_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out STYLE_INDEX);

   procedure INQ_FILL_AREA_COLOUR_INDEX
      (EI    : out ERROR_INDICATOR;
      COLOUR : out COLOUR_INDEX);

   procedure INQ_LIST_OF_ASF
      (EI  : out ERROR_INDICATOR;
      LIST : out ASF_LIST);

   procedure INQ_CURRENT_INDIVIDUAL_ATTRIBUTE_VALUES
      (EI         : out ERROR_INDICATOR;
      ATTRIBUTES  : out INDIVIDUAL_ATTRIBUTE_VALUES);

end INQ_INDIVIDUAL_ATTRIBUTES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:INQ_PRIM_ATTR.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_PRIMITIVE_ATTRIBUTES
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_prim_attr.ada
-- level: all levels

with GKS_TYPES;

use GKS_TYPES;

package INQ_PRIMITIVE_ATTRIBUTES is

-- This package provides the procedures for inquiring the
-- primitive attribute values.  These procedures are a result
-- of the one-to-many mapping of the GKS procedure Inquire
-- Current Primitive Attribute Values.  In addition, a procedure
-- INQ_CURRENT_PRIMITIVE_ATTRIBUTE_VALUES is included that is a
-- one-to-one mapping of the GKS procedure to allow the application
-- to inquire all of the primitive attributes in one call.

   procedure INQ_CHAR_HEIGHT
      (EI    : out ERROR_INDICATOR;
      HEIGHT : out WC.MAGNITUDE);

   procedure INQ_CHAR_UP_VECTOR
      (EI    : out ERROR_INDICATOR;
      VECTOR : out WC.VECTOR);

   procedure INQ_TEXT_PATH
      (EI  : out ERROR_INDICATOR;
      PATH : out TEXT_PATH);

   procedure INQ_TEXT_ALIGNMENT
      (EI       : out ERROR_INDICATOR;
      ALIGNMENT : out TEXT_ALIGNMENT);

   procedure INQ_PATTERN_REFERENCE_POINT
      (EI             : out ERROR_INDICATOR;
      REFERENCE_POINT : out WC.POINT);

   procedure INQ_PATTERN_HEIGHT_VECTOR
      (EI    : out ERROR_INDICATOR;
      VECTOR : out WC.VECTOR);

   procedure INQ_PATTERN_WIDTH_VECTOR
      (EI   : out ERROR_INDICATOR;
      WIDTH : out WC.VECTOR);

   procedure INQ_CHAR_WIDTH
      (EI   : out ERROR_INDICATOR;
      WIDTH : out WC.MAGNITUDE);

   procedure INQ_CHAR_BASE_VECTOR
      (EI    : out ERROR_INDICATOR;
      VECTOR : out WC.VECTOR);

   procedure INQ_CURRENT_PRIMITIVE_ATTRIBUTE_VALUES
      (EI         : out ERROR_INDICATOR;
       ATTRIBUTES : out PRIMITIVE_ATTRIBUTE_VALUES);

end INQ_PRIMITIVE_ATTRIBUTES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:INQ_WS_DSCR_TBL_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_WS_DESCRIPTION_TABLE_MA
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_ws_dscr_tbl_ma.ada
-- level: all levels

with GKS_TYPES;

use GKS_TYPES;

package INQ_WS_DESCRIPTION_TABLE_MA is

-- This package provides the functions for calling the workstation
-- manager to inquire the workstation description tables for level ma.

   procedure INQ_DISPLAY_SPACE_SIZE
      (WS                  : in WS_TYPE;
      EI                   : out ERROR_INDICATOR;
      UNITS                : out DC_UNITS;
      MAX_DC_SIZE          : out DC.SIZE;
      MAX_RASTER_UNIT_SIZE : out RASTER_UNIT_SIZE);

   procedure INQ_POLYLINE_FACILITIES
      (WS               : in WS_TYPE;
      EI                : out ERROR_INDICATOR;
      LIST_OF_TYPES     : out LINETYPES.LIST_OF;
      NUMBER_OF_WIDTHS  : out NATURAL;
      NOMINAL_WIDTH     : out DC.MAGNITUDE;
      RANGE_OF_WIDTHS   : out DC.RANGE_OF_MAGNITUDES;
      NUMBER_OF_INDICES : out NATURAL);

   procedure INQ_POLYMARKER_FACILITIES
      (WS               : in WS_TYPE;
      EI                : out ERROR_INDICATOR;
      LIST_OF_TYPES     : out MARKER_TYPES.LIST_OF;
      NUMBER_OF_SIZES   : out NATURAL;
      NOMINAL_SIZE      : out DC.MAGNITUDE;
      RANGE_OF_SIZES    : out DC.RANGE_OF_MAGNITUDES;
      NUMBER_OF_INDICES : out NATURAL);

   procedure INQ_TEXT_FACILITIES
      (WS                  : in WS_TYPE;
      EI                   : out ERROR_INDICATOR;
      LIST_OF_FONT_PRECISION_PAIRS: out TEXT_FONT_PRECISIONS.LIST_OF;
      NUMBER_OF_HEIGHTS    : out NATURAL;
      RANGE_OF_HEIGHTS     : out DC.RANGE_OF_MAGNITUDES;
      NUMBER_OF_EXPANSIONS : out NATURAL;
      EXPANSION_RANGE      : out RANGE_OF_EXPANSIONS;
      NUMBER_OF_INDICES    : out NATURAL);

   procedure INQ_FILL_AREA_FACILITIES
      (WS                     : WS_TYPE;
      EI                      : out ERROR_INDICATOR;
      LIST_OF_INTERIOR_STYLES : out INTERIOR_STYLES.LIST_OF;
      LIST_OF_HATCH_STYLES    : out HATCH_STYLES.LIST_OF;
      NUMBER_OF_INDICES       : out NATURAL);

   procedure INQ_COLOUR_FACILITIES
      (WS                      : in WS_TYPE;
      EI                       : out ERROR_INDICATOR;
      NUMBER_OF_COLOURS        : out NATURAL;
      AVAILABLE_COLOUR         : out COLOUR_AVAILABLE;
      NUMBER_OF_COLOUR_INDICES : out NATURAL);

   procedure INQ_MAX_LENGTH_OF_WS_STATE_TABLES
      (WS                    : in WS_TYPE;
      EI                     : out ERROR_INDICATOR;
      MAX_POLYLINE_ENTRIES   : out NATURAL;
      MAX_POLYMARKER_ENTRIES : out NATURAL;
      MAX_TEXT_ENTRIES       : out NATURAL;
      MAX_FILL_AREA_ENTRIES  : out NATURAL;
      MAX_PATTERN_INDICES    : out NATURAL;
      MAX_COLOUR_INDICES     : out NATURAL);

end INQ_WS_DESCRIPTION_TABLE_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:INQ_WS_ST_LST_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_WS_STATE_LIST_MA
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_ws_st_lst_ma.ada
-- level: all levels

with GKS_TYPES;

use GKS_TYPES;

package INQ_WS_STATE_LIST_MA is

-- This package provides the procedures for calling the
-- workstation manager to inquire the workstation state list.

   procedure INQ_WS_CONNECTION_AND_TYPE
      (WS        : in WS_ID;
      EI         : out ERROR_INDICATOR;
      CONNECTION : out VARIABLE_CONNECTION_ID;
      TYPE_OF_WS : out WS_TYPE);

   procedure INQ_TEXT_EXTENT
      (WS                 : in WS_ID;
      POSITION            : in WC.POINT;
      CHAR_STRING         : in STRING;
      EI                  : out ERROR_INDICATOR;
      CONCATENATION_POINT : out WC.POINT;
      TEXT_EXTENT         : out TEXT_EXTENT_PARALLELOGRAM);

   procedure INQ_LIST_OF_COLOUR_INDICES
      (WS     : in WS_ID;
      EI      : out ERROR_INDICATOR;
      INDICES : out COLOUR_INDICES.LIST_OF);

   procedure INQ_COLOUR_REPRESENTATION
      (WS             : in WS_ID;
      INDEX           : in COLOUR_INDEX;
      RETURNED_VALUES : in RETURN_VALUE_TYPE;
      EI              : out ERROR_INDICATOR;
      COLOUR          : out COLOUR_REPRESENTATION);

   procedure INQ_WS_TRANSFORMATION
      (WS                : in WS_ID;
      EI                 : out ERROR_INDICATOR;
      UPDATE             : out UPDATE_STATE;
      REQUESTED_WINDOW   : out NDC.RECTANGLE_LIMITS;
      CURRENT_WINDOW     : out NDC.RECTANGLE_LIMITS;
      REQUESTED_VIEWPORT : out DC.RECTANGLE_LIMITS;
      CURRENT_VIEWPORT   : out DC.RECTANGLE_LIMITS);

end INQ_WS_STATE_LIST_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:OUT_PRIM.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: OUTPUT_PRIMITIVES
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  out_prim.ada
-- level: all levels

with GKS_TYPES;

use GKS_TYPES;

package OUTPUT_PRIMITIVES is

-- This package provides the level ma output primitive functions.

   procedure POLYLINE
      (LINE_POINTS : in WC.POINT_ARRAY);

   procedure POLYMARKER
      (MARKER_POINTS : in WC.POINT_ARRAY);

   procedure FILL_AREA
      (FILL_AREA_POINTS : in WC.POINT_ARRAY);

   procedure TEXT
      (POSITION   : in WC.POINT;
      TEXT_STRING : in STRING);

end OUTPUT_PRIMITIVES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:SET_CLR_TBL.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_COLOUR_TABLE
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  set_clr_tbl.ada
-- level: all levels

with GKS_TYPES;

use GKS_TYPES;

package SET_COLOUR_TABLE is

-- This package provides the procedures for calling the workstation
-- manager to set the workstation attributes at level ma.

   procedure SET_COLOUR_REPRESENTATION
      (WS    : in WS_ID;
      INDEX  : in COLOUR_INDEX;
      COLOUR : in COLOUR_REPRESENTATION);

end SET_COLOUR_TABLE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:SET_INDV_ATTR_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_INDIVIDUAL_ATTRIBUTES_MA
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  set_indv_attr_ma.ada
-- level: all levels

with GKS_TYPES;

use GKS_TYPES;

package SET_INDIVIDUAL_ATTRIBUTES_MA is

-- This package provides the functions for setting the individual
-- attributes for output primitives.

   procedure SET_LINETYPE
      (LINE : in LINETYPE);

   procedure SET_POLYLINE_COLOUR_INDEX
      (COLOUR : in COLOUR_INDEX);

   procedure SET_MARKER_TYPE
      (MARKER : in MARKER_TYPE);

   procedure SET_POLYMARKER_COLOUR_INDEX
      (COLOUR : in COLOUR_INDEX);

   procedure SET_TEXT_COLOUR_INDEX
      (COLOUR : in COLOUR_INDEX);

   procedure SET_FILL_AREA_INTERIOR_STYLE
      (STYLE : in INTERIOR_STYLE);

   procedure SET_FILL_AREA_COLOUR_INDEX
      (COLOUR : in COLOUR_INDEX);

end SET_INDIVIDUAL_ATTRIBUTES_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:SET_PRIM_ATTR_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_PRIMITIVE_ATTRIBUTES_MA
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  set_prim_attr_ma.ada
-- level: all levels

with GKS_TYPES;

use GKS_TYPES;

package SET_PRIMITIVE_ATTRIBUTES_MA is

-- This package provides the procedures for setting the
-- primitive attribute values for level ma.

   procedure SET_CHAR_HEIGHT
      (HEIGHT : in WC.MAGNITUDE);

   procedure SET_CHAR_UP_VECTOR
      (CHAR_UP_VECTOR : IN WC.VECTOR);

   procedure SET_TEXT_ALIGNMENT
      (ALIGNMENT : in TEXT_ALIGNMENT);

end SET_PRIMITIVE_ATTRIBUTES_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WS_CONTROL.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WS_CONTROL
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  ws_control.ada
-- level: all levels

with GKS_TYPES;

use GKS_TYPES;

package WS_CONTROL is

-- This package provides the workstation control functions.

   procedure OPEN_WS
      (WS         : in WS_ID;
       CONNECTION : in CONNECTION_ID;
       TYPE_OF_WS : in WS_TYPE);

   procedure CLOSE_WS
      (WS : in WS_ID);

   procedure ACTIVATE_WS
      (WS : in WS_ID);

   procedure DEACTIVATE_WS
      (WS : in WS_ID);

   procedure CLEAR_WS
      (WS  : in WS_ID;
      FLAG : in CONTROL_FLAG);

   procedure UPDATE_WS
      (WS           : in WS_ID;
      REGENERATION  : in UPDATE_REGENERATION_FLAG);

end WS_CONTROL;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WS_XFORM.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WS_TRANSFORMATION
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  ws_xform.ada
-- level: all levels

with GKS_TYPES;

use GKS_TYPES;

package WS_TRANSFORMATION is

-- This package provides the procedures for calling the
-- workstation manager to do the workstation transformations.

   procedure SET_WS_WINDOW
      (WS              : in WS_ID;
      WS_WINDOW_LIMITS : in NDC.RECTANGLE_LIMITS);

   procedure SET_WS_VIEWPORT
      (WS                : in WS_ID;
      WS_VIEWPORT_LIMITS : in DC.RECTANGLE_LIMITS);

end WS_TRANSFORMATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WS_TBL_TYP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-- File: WS_TBL_TYP.ADA
-- ALL LEVELS

with GKS_TYPES;

use GKS_TYPES;

package WS_TABLE_TYPES is

-- This package is designed to be `with'ed by the packages
-- WS_DESCRIPTION_TABLE and WS_STATE_LIST to allow them to use
-- the types declared here.

   type POLYLINE_BUNDLE is
      record
         L_TYPE  : LINETYPE;
         L_WIDTH : LINE_WIDTH;
         COLOUR  : COLOUR_INDEX;
      end record;

   type POLYLINE_BUNDLE_LIST is array (POSITIVE range <>)
                                       of POLYLINE_BUNDLE;

   type POLYMARKER_BUNDLE is
      record
         M_TYPE : MARKER_TYPE;
         M_SIZE : MARKER_SIZE;
         COLOUR : COLOUR_INDEX;
      end record;

   type POLYMARKER_BUNDLE_LIST is array (POSITIVE range <>)
                                         of POLYMARKER_BUNDLE;

   type TEXT_BUNDLE is
      record
         TEXT_FONT    : TEXT_FONT_PRECISION;
         CH_EXPANSION : CHAR_EXPANSION;
         CH_SPACE     : CHAR_SPACING;
         COLOUR       : COLOUR_INDEX;
      end record;

   type TEXT_BUNDLE_LIST is array (POSITIVE range <>) of TEXT_BUNDLE;

   type FILL_AREA_BUNDLE is
      record
         INT_STYLE : INTERIOR_STYLE;
         STYLE     : STYLE_INDEX;
         COLOUR    : COLOUR_INDEX;
      end record;

   type FILL_AREA_BUNDLE_LIST is array (POSITIVE range <>)
                                        of FILL_AREA_BUNDLE;

   type PATTERN_TABLE_LIST is array (NATURAL range <>)
                                     of COLOUR_MATRICES
                                         .VARIABLE_MATRIX_OF;

   type COLOUR_TABLE_LIST is array (COLOUR_INDEX range <>)
                                    of COLOUR_REPRESENTATION;

   type ATTR_USED_LIST is array (GDP_ID range <>)
                                 of ATTRIBUTES_USED.LIST_OF;

   subtype MAX_INTENSITIES_TYPE is INTEGER range 2 .. (2 ** 16) - 1;

end WS_TABLE_TYPES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WS_DSCR_TBL_TYP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-- File: ws_dscr_tbl.ada
-- level ma - 2a

with GKS_TYPES;
with WS_TABLE_TYPES;

use GKS_TYPES;

package WS_DESCRIPTION_TABLE_TYPES is

-- All entries are implementation dependent

   type DYN_MOD_ACCEPTED_FOR_WS_ATTRIBUTES is
      record
         POLYLINE_BUNDLE_REP   : DYNAMIC_MODIFICATION;
         POLYMARKER_BUNDLE_REP : DYNAMIC_MODIFICATION;
         TEXT_BUNDLE_REP       : DYNAMIC_MODIFICATION;
         FILL_AREA_BUNDLE_REP  : DYNAMIC_MODIFICATION;
         PATTERN_REP           : DYNAMIC_MODIFICATION;
         COLOUR_REP            : DYNAMIC_MODIFICATION;
         WS_TRANSFORMATION     : DYNAMIC_MODIFICATION;
      end record;

   type DYN_MOD_ACCEPTED_FOR_SEGMENT_ATTRIBUTES is
      record
         SEGMENT_TRANSFORMATION     : DYNAMIC_MODIFICATION;
         VISIBILITY_TO_INVISIBLE    : DYNAMIC_MODIFICATION;
         VISIBILITY_TO_VISIBLE      : DYNAMIC_MODIFICATION;
         HIGHLIGHTING               : DYNAMIC_MODIFICATION;
         SEGMENT_PRIORITY           : DYNAMIC_MODIFICATION;
         ADDING_TO_OBSCURED_SEGMENT : DYNAMIC_MODIFICATION;
         DELETE_SEGMENT             : DYNAMIC_MODIFICATION;
      end record;

   subtype PLIN_INDEX is NATURAL      range 0 .. 5;
   subtype PMRK_INDEX is NATURAL      range 0 .. 5;
   subtype TXT_INDEX  is NATURAL      range 0 .. 5;
   subtype FA_INDEX   is NATURAL      range 0 .. 5;
   subtype PAT_INDEX  is NATURAL      range 0 .. 0;
   subtype CLR_INDEX  is COLOUR_INDEX range 0 .. 7;
   subtype GDP_INDEX  is GDP_ID       range 0 .. 3;
   -- The subtypes are declared to constrain the size of the
   -- discriminant components of the record WS_DESCRIPTION_TBL.
   -- These were put here so as not to raise a STORAGE ERROR at
   -- the time the object is declared of the type.

   -- The following record is the WS_DESCRIPTION_TABLE.
   type WS_DESCRIPTION_TBL
      (NUM_PREDEFINED_PLIN_BUNDLE   : PLIN_INDEX := 0;
       NUM_PREDEFINED_PMRK_BUNDLE   : PMRK_INDEX := 0;
       NUM_PREDEFINED_TEXT_BUNDLE   : TXT_INDEX  := 0;
       NUM_PREDEFINED_FA_BUNDLE     : FA_INDEX   := 0;
       NUM_PREDEFINED_PATTERN_TABLE : PAT_INDEX  := 0;
       LAST_PREDEFINED_COLOUR_REP   : CLR_INDEX  := 0;
       NUM_OF_GDP_ID                : GDP_INDEX  := 0)
   is record

      -- Entries in this group exist for all workstation categories.

      WORKSTATION_TYPE     : WS_TYPE;
      WORKSTATION_CATEGORY : WS_CATEGORY;

      -- Entries in this group exist for OUTPUT, INPUT, OUTIN

      DEVICE_COOR_UNITS                : DC_UNITS;
      MAX_DISPLAY_SURFACE_DC_UNITS     : DC.SIZE;
      MAX_DISPLAY_SURFACE_RASTER_UNITS : RASTER_UNIT_SIZE;

      -- Entries in this group exist for OUTPUT, OUTIN

      DISPLAY_TYPE        : DISPLAY_CLASS;
      WS_DYNAMICS         : DYN_MOD_ACCEPTED_FOR_WS_ATTRIBUTES;
      DEFER_MODE          : DEFERRAL_MODE;
      IMPLICIT_REGEN_MODE : REGENERATION_MODE;

      -- entries in this group exist for OUTPUT,OUTIN and refer to
      -- linetypes.

      LIST_AVAILABLE_LTYPE : LINETYPES.LIST_OF;
      NUM_AVAILABLE_LWIDTH : NATURAL;
      NOMINAL_LWIDTH       : DC.MAGNITUDE;
      RANGE_OF_LWIDTH      : DC.RANGE_OF_MAGNITUDES;

      -- entries in this group exist for OUTPUT,OUTIN and refer to
      -- polylines.

      PREDEFINED_PLIN_BUNDLES  : WS_TABLE_TYPES.POLYLINE_BUNDLE_LIST
            (1..NUM_PREDEFINED_PLIN_BUNDLE);

      -- entries in this group exist for OUTPUT,OUTIN and refer to
      -- polymarkers.

      LIST_AVAILABLE_MARKER_TYPES : MARKER_TYPES.LIST_OF;
      NUM_AVAILABLE_MARKER_SIZES  : NATURAL;
      NOMINAL_MARKER_SIZE         : DC.MAGNITUDE;
      RANGE_OF_MARKER_SIZES       : DC.RANGE_OF_MAGNITUDES;

      -- entries in this group exist for OUTPUT,OUTIN and refer to
      -- polymarker bundles.
      -- It is the list of predefined polymarker bundles.

      PREDEFINED_PMRK_BUNDLES : WS_TABLE_TYPES.POLYMARKER_BUNDLE_LIST
            (1..NUM_PREDEFINED_PMRK_BUNDLE);

      -- entries in this group exist for OUTPUT,OUTIN and refer to
      -- the list text fonts.

      LIST_TEXT_FONT_AND_PRECISION :  TEXT_FONT_PRECISIONS.LIST_OF;

      -- entries in this group exist for OUTPUT,OUTIN and refer to
      -- characters.

      NUM_AVAILABLE_CHAR_EXPANSIONS : NATURAL;
      RANGE_OF_CHAR_EXPANSIONS      : RANGE_OF_EXPANSIONS;

      -- entries in this group exist for OUTPUT,OUTIN and refer to
      -- character heights.

      NUM_AVAILABLE_CHAR_HEIGHTS : NATURAL;
      RANGE_OF_CHAR_HEIGHTS      : DC.RANGE_OF_MAGNITUDES;

      -- entries in this group exist for OUTPUT,OUTIN and refer to
      -- text bundles.

      PREDEFINED_TEXT_BUNDLES : WS_TABLE_TYPES.TEXT_BUNDLE_LIST
            (1..NUM_PREDEFINED_TEXT_BUNDLE);

      -- entries in this group exist for OUTPUT,OUTIN and refer to
      -- fill areas. It is the list of predefined INTERIOR_STYLES,
      -- HATCH_STYLES, and FILL_AREA_BUNDLES.

      LIST_OF_AVAL_INTERIOR_STYLE : INTERIOR_STYLES.LIST_OF;
      LIST_OF_AVAL_HATCH_STYLE    : HATCH_STYLES.LIST_OF;
      PREDEFINED_FA_BUNDLES       : WS_TABLE_TYPES.FILL_AREA_BUNDLE_LIST
            (1..NUM_PREDEFINED_FA_BUNDLE);

      -- entries in this group exist for OUTPUT,OUTIN and refer to
      -- pattern tables. It is the list of predefined patterns.

      PREDEFINED_PATTERN_REP : WS_TABLE_TYPES.PATTERN_TABLE_LIST
                                  (1..NUM_PREDEFINED_PATTERN_TABLE);

      -- entries in this group exist for OUTPUT, OUTIN and refer to
      -- colour tables.

      MAX_INTENSITIES             : WS_TABLE_TYPES.MAX_INTENSITIES_TYPE;
      NUM_OF_AVAL_COLOUR_INTENSITY : NATURAL;
      COLOUR_AVAL                  : COLOUR_AVAILABLE;
      PREDEFINED_COLOUR_REP        : WS_TABLE_TYPES.COLOUR_TABLE_LIST
                                        (0..LAST_PREDEFINED_COLOUR_REP);

      -- entries in this group exist for OUTPUT, OUTIN and refer to
      -- generalized drawing primitives (GDP)

      AVAL_GDP  : GDP_IDS.LIST_OF;
      ATTR_USED : WS_TABLE_TYPES.ATTR_USED_LIST (1 .. NUM_OF_GDP_ID);

      -- entries in this group exist for OUTPUT, OUTIN and refer to the
      -- the maximum number of predefined values for this implementation

      MAX_NUM_PLIN_BUNDLE_TBL_ENTRIES : NATURAL;
      MAX_NUM_PMRK_BUNDLE_TBL_ENTRIES : NATURAL;
      MAX_NUM_TEXT_BUNDLE_TBL_ENTRIES : NATURAL;
      MAX_NUM_FA_BUNDLE_TBL_ENTRIES   : NATURAL;
      MAX_NUM_PATTERN_INDICES         : NATURAL;
      MAX_NUM_COLOUR_INDICES          : NATURAL;

      -- entries in this group exist for OUTPUT, OUTIN and refer to
      -- segments

      NUM_OF_SEG_PRIO_SUPPORTED : NATURAL;
      SEGMENT_DYNAMICS        : DYN_MOD_ACCEPTED_FOR_SEGMENT_ATTRIBUTES;

   end record;

end WS_DESCRIPTION_TABLE_TYPES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_INQ_WS_DSCR_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_INQ_WS_DESCRIPTION_TABLE_MA
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File:  WSR_INQ_WS_DSCR_MA.ADA
-- Level: MA

with GKS_TYPES;
with WS_DESCRIPTION_TABLE_TYPES;

use GKS_TYPES;

package WSR_INQ_WS_DESCRIPTION_TABLE_MA is

-- Package GKS_TYPES provides type definitions for the return
-- parameters.

-- Package WS_DESCRIPTION_TABLE_TYPES provides type definition for the
-- Workstation Description Table parameter.

procedure INQ_DISPLAY_SPACE_SIZE
      (WS_DT                : in     WS_DESCRIPTION_TABLE_TYPES .
                                     WS_DESCRIPTION_TBL;
       DC_UNITS             :    out GKS_TYPES . DC_UNITS;
       MAX_DC_SIZE          :    out DC . SIZE;
       MAX_RASTER_UNIT_SIZE :    out RASTER_UNIT_SIZE);

   procedure INQ_MAX_LENGTH_OF_WS_STATE_TABLES
      (WS_DT                  : in     WS_DESCRIPTION_TABLE_TYPES .
                                       WS_DESCRIPTION_TBL;
       MAX_POLYLINE_ENTRIES   :    out NATURAL;
       MAX_POLYMARKER_ENTRIES :    out NATURAL;
       MAX_TEXT_ENTRIES       :    out NATURAL;
       MAX_FILL_AREA_ENTRIES  :    out NATURAL;
       MAX_PATTERN_INDICES    :    out NATURAL;
       MAX_COLOUR_INDICES     :    out NATURAL);

   procedure INQ_POLYLINE_FACILITIES
      (WS_DT             : in     WS_DESCRIPTION_TABLE_TYPES .
                                  WS_DESCRIPTION_TBL;
       LIST_OF_LINETYPES :    out LINETYPES . LIST_OF;
       NUMBER_OF_WIDTHS  :    out NATURAL;
       NOMINAL_WIDTH     :    out DC . MAGNITUDE;
       RANGE_OF_WIDTHS   :    out DC . RANGE_OF_MAGNITUDES;
       NUMBER_OF_INDICES :    out NATURAL);

   procedure INQ_POLYMARKER_FACILITIES
      (WS_DT                : in     WS_DESCRIPTION_TABLE_TYPES .
                                     WS_DESCRIPTION_TBL;
       LIST_OF_MARKER_TYPES :    out MARKER_TYPES . LIST_OF;
       NUMBER_OF_SIZES      :    out NATURAL;
       NOMINAL_SIZE         :    out DC . MAGNITUDE;
       RANGE_OF_SIZES       :    out DC . RANGE_OF_MAGNITUDES;
       NUMBER_OF_INDICES    :    out NATURAL);

   procedure INQ_TEXT_FACILITIES
      (WS_DT                : in     WS_DESCRIPTION_TABLE_TYPES .
                                     WS_DESCRIPTION_TBL;
       LIST_OF_FONT_PRECISION_PAIRS :    out TEXT_FONT_PRECISIONS .
                                                 LIST_OF;
       NUMBER_OF_HEIGHTS            :    out NATURAL;
       RANGE_OF_HEIGHTS             :    out DC . RANGE_OF_MAGNITUDES;
       NUMBER_OF_EXPANSIONS         :    out NATURAL;
       RANGE_OF_CHAR_EXPANSIONS     :    out RANGE_OF_EXPANSIONS;
       NUMBER_OF_INDICES            :    out NATURAL);

   procedure INQ_FILL_AREA_FACILITIES
      (WS_DT                   : in     WS_DESCRIPTION_TABLE_TYPES .
                                        WS_DESCRIPTION_TBL;
       LIST_OF_INTERIOR_STYLES :    out INTERIOR_STYLES . LIST_OF;
       LIST_OF_HATCH_STYLES    :    out HATCH_STYLES . LIST_OF;
       NUMBER_OF_INDICES       :    out NATURAL);

   procedure INQ_COLOUR_FACILITIES
      (WS_DT             : in     WS_DESCRIPTION_TABLE_TYPES .
                                  WS_DESCRIPTION_TBL;
       NUMBER_OF_COLOURS :    out NATURAL;
       AVAILABLE_COLOUR  :    out COLOUR_AVAILABLE;
       NUMBER_OF_INDICES :    out NATURAL);

end WSR_INQ_WS_DESCRIPTION_TABLE_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_INQ_WS_DSCR_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_INQ_WS_DESCRIPTION_MA - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File:  WSR_INQ_WS_DSCR_MA_B.ADA
-- Level: MA, 0A, 1A, 2A

package body WSR_INQ_WS_DESCRIPTION_TABLE_MA is

-- The procedures in this package provide a convenient mechanism for
-- returning groups of values from the Workstation Description Table.

   use GKS_TYPES;

   procedure INQ_DISPLAY_SPACE_SIZE
      (WS_DT                : in     WS_DESCRIPTION_TABLE_TYPES .
                                     WS_DESCRIPTION_TBL;
       DC_UNITS             :    out GKS_TYPES . DC_UNITS;
       MAX_DC_SIZE          :    out DC . SIZE;
       MAX_RASTER_UNIT_SIZE :    out RASTER_UNIT_SIZE) is

   begin

      DC_UNITS             := WS_DT . DEVICE_COOR_UNITS;
      MAX_DC_SIZE          := WS_DT . MAX_DISPLAY_SURFACE_DC_UNITS;
      MAX_RASTER_UNIT_SIZE := WS_DT . MAX_DISPLAY_SURFACE_RASTER_UNITS;

   end INQ_DISPLAY_SPACE_SIZE;

   procedure INQ_MAX_LENGTH_OF_WS_STATE_TABLES
      (WS_DT                  : in     WS_DESCRIPTION_TABLE_TYPES .
                                       WS_DESCRIPTION_TBL;
       MAX_POLYLINE_ENTRIES   :    out NATURAL;
       MAX_POLYMARKER_ENTRIES :    out NATURAL;
       MAX_TEXT_ENTRIES       :    out NATURAL;
       MAX_FILL_AREA_ENTRIES  :    out NATURAL;
       MAX_PATTERN_INDICES    :    out NATURAL;
       MAX_COLOUR_INDICES     :    out NATURAL) is

   begin

      MAX_POLYLINE_ENTRIES :=
            WS_DT . MAX_NUM_PLIN_BUNDLE_TBL_ENTRIES;

      MAX_POLYMARKER_ENTRIES :=
            WS_DT . MAX_NUM_PMRK_BUNDLE_TBL_ENTRIES;

      MAX_TEXT_ENTRIES :=
            WS_DT . MAX_NUM_TEXT_BUNDLE_TBL_ENTRIES;

      MAX_FILL_AREA_ENTRIES :=
            WS_DT . MAX_NUM_FA_BUNDLE_TBL_ENTRIES;

      MAX_PATTERN_INDICES :=
            WS_DT . MAX_NUM_PATTERN_INDICES;

      MAX_COLOUR_INDICES :=
            WS_DT . MAX_NUM_COLOUR_INDICES;

   end INQ_MAX_LENGTH_OF_WS_STATE_TABLES;

   procedure INQ_POLYLINE_FACILITIES
      (WS_DT             : in     WS_DESCRIPTION_TABLE_TYPES .
                                  WS_DESCRIPTION_TBL;
       LIST_OF_LINETYPES :    out LINETYPES . LIST_OF;
       NUMBER_OF_WIDTHS  :    out NATURAL;
       NOMINAL_WIDTH     :    out DC . MAGNITUDE;
       RANGE_OF_WIDTHS   :    out DC . RANGE_OF_MAGNITUDES;
       NUMBER_OF_INDICES :    out NATURAL) is

   begin

      LIST_OF_LINETYPES := WS_DT . LIST_AVAILABLE_LTYPE;
      NUMBER_OF_WIDTHS  := WS_DT . NUM_AVAILABLE_LWIDTH;
      NOMINAL_WIDTH     := WS_DT . NOMINAL_LWIDTH;
      RANGE_OF_WIDTHS   := WS_DT . RANGE_OF_LWIDTH;
      NUMBER_OF_INDICES := WS_DT . NUM_PREDEFINED_PLIN_BUNDLE;

   end INQ_POLYLINE_FACILITIES;


   procedure INQ_POLYMARKER_FACILITIES
      (WS_DT                : in     WS_DESCRIPTION_TABLE_TYPES .
                                     WS_DESCRIPTION_TBL;
       LIST_OF_MARKER_TYPES :    out MARKER_TYPES . LIST_OF;
       NUMBER_OF_SIZES      :    out NATURAL;
       NOMINAL_SIZE         :    out DC . MAGNITUDE;
       RANGE_OF_SIZES       :    out DC . RANGE_OF_MAGNITUDES;
       NUMBER_OF_INDICES    :    out NATURAL) is

   begin

      LIST_OF_MARKER_TYPES := WS_DT . LIST_AVAILABLE_MARKER_TYPES;
      NUMBER_OF_SIZES      := WS_DT . NUM_AVAILABLE_MARKER_SIZES;
      NOMINAL_SIZE         := WS_DT . NOMINAL_MARKER_SIZE;
      RANGE_OF_SIZES       := WS_DT . RANGE_OF_MARKER_SIZES;
      NUMBER_OF_INDICES    := WS_DT . NUM_PREDEFINED_PMRK_BUNDLE;

   end INQ_POLYMARKER_FACILITIES;

   procedure INQ_TEXT_FACILITIES
      (WS_DT                : in     WS_DESCRIPTION_TABLE_TYPES .
                                     WS_DESCRIPTION_TBL;
       LIST_OF_FONT_PRECISION_PAIRS :    out TEXT_FONT_PRECISIONS .
                                                 LIST_OF;
       NUMBER_OF_HEIGHTS        :    out NATURAL;
       RANGE_OF_HEIGHTS         :    out DC . RANGE_OF_MAGNITUDES;
       NUMBER_OF_EXPANSIONS     :    out NATURAL;
       RANGE_OF_CHAR_EXPANSIONS :    out RANGE_OF_EXPANSIONS;
       NUMBER_OF_INDICES        :    out NATURAL) is

   begin

      LIST_OF_FONT_PRECISION_PAIRS :=
            WS_DT . LIST_TEXT_FONT_AND_PRECISION;

      NUMBER_OF_HEIGHTS        := WS_DT . NUM_AVAILABLE_CHAR_HEIGHTS;

      RANGE_OF_HEIGHTS         := WS_DT . RANGE_OF_CHAR_HEIGHTS;

      NUMBER_OF_EXPANSIONS     := WS_DT . NUM_AVAILABLE_CHAR_EXPANSIONS;

      RANGE_OF_CHAR_EXPANSIONS := WS_DT . RANGE_OF_CHAR_EXPANSIONS;

      NUMBER_OF_INDICES        := WS_DT . NUM_PREDEFINED_TEXT_BUNDLE;

   end INQ_TEXT_FACILITIES;

   procedure INQ_FILL_AREA_FACILITIES
      (WS_DT                   : in     WS_DESCRIPTION_TABLE_TYPES .
                                        WS_DESCRIPTION_TBL;
       LIST_OF_INTERIOR_STYLES :    out INTERIOR_STYLES . LIST_OF;
       LIST_OF_HATCH_STYLES    :    out HATCH_STYLES . LIST_OF;
       NUMBER_OF_INDICES       :    out NATURAL) is

   begin

      LIST_OF_INTERIOR_STYLES := WS_DT . LIST_OF_AVAL_INTERIOR_STYLE;
      LIST_OF_HATCH_STYLES    := WS_DT . LIST_OF_AVAL_HATCH_STYLE;
      NUMBER_OF_INDICES       := WS_DT . NUM_PREDEFINED_FA_BUNDLE;

   end INQ_FILL_AREA_FACILITIES;

   procedure INQ_COLOUR_FACILITIES
      (WS_DT             : in     WS_DESCRIPTION_TABLE_TYPES .
                                  WS_DESCRIPTION_TBL;
       NUMBER_OF_COLOURS :    out NATURAL;
       AVAILABLE_COLOUR  :    out COLOUR_AVAILABLE;
       NUMBER_OF_INDICES :    out NATURAL) is

   begin

      NUMBER_OF_COLOURS := WS_DT . NUM_OF_AVAL_COLOUR_INTENSITY;
      AVAILABLE_COLOUR  := WS_DT . COLOUR_AVAL;
      NUMBER_OF_INDICES := NATURAL(WS_DT . LAST_PREDEFINED_COLOUR_REP + 1);

   end INQ_COLOUR_FACILITIES;

end WSR_INQ_WS_DESCRIPTION_TABLE_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:RECTANGLE_OPS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: RECTANGLE_LIMITS_OPS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: RECTANGLE_OPS.ADA
-- Level: all

generic
   type COORDINATE is digits <>;

   type RECTANGLE_LIMITS is private;

   with function XMIN(R : in RECTANGLE_LIMITS) return COORDINATE is <>;
   with function XMAX(R : in RECTANGLE_LIMITS) return COORDINATE is <>;
   with function YMIN(R : in RECTANGLE_LIMITS) return COORDINATE is <>;
   with function YMAX(R : in RECTANGLE_LIMITS) return COORDINATE is <>;
   with function RECTANGLE_LIMITS_MAKE
      (XMIN : in     COORDINATE;
       XMAX : in     COORDINATE;
       YMIN : in     COORDINATE;
       YMAX : in     COORDINATE) return  RECTANGLE_LIMITS is <>;

package RECTANGLE_LIMITS_OPS is

   UNIT_SQR : constant RECTANGLE_LIMITS :=
      RECTANGLE_LIMITS_MAKE
         (XMIN => 0.0, XMAX => 1.0,
          YMIN => 0.0, YMAX => 1.0);

   function IS_VALID
      (A : in     RECTANGLE_LIMITS) return BOOLEAN;

   function "<"
      (A : in     RECTANGLE_LIMITS;
       B : in     RECTANGLE_LIMITS) return BOOLEAN;

   function "<="
      (A : in     RECTANGLE_LIMITS;
       B : in     RECTANGLE_LIMITS) return BOOLEAN;

   function ">="
      (A : in     RECTANGLE_LIMITS;
       B : in     RECTANGLE_LIMITS) return BOOLEAN;

   function ">"
      (A : in     RECTANGLE_LIMITS;
       B : in     RECTANGLE_LIMITS) return BOOLEAN;

   function "or"
      (A : in     RECTANGLE_LIMITS;
       B : in     RECTANGLE_LIMITS) return RECTANGLE_LIMITS;

   function "and"
      (A : in     RECTANGLE_LIMITS;
       B : in     RECTANGLE_LIMITS) return RECTANGLE_LIMITS;

end RECTANGLE_LIMITS_OPS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:RECTANGLE_OPS_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: RECTANGLE_LIMITS_OPS - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: RECTANGLE_OPS_B.ADA
-- Level: all

package body RECTANGLE_LIMITS_OPS is

-- Package RECTANGLE_LIMITS_OPS provides functions useful in
-- comparing rectangles instantiated from the GKS_COORDINATE_SYSTEM
-- package.  To allow this package to be generic, it is necessary to
-- augment the record type RECTANGLE_LIMITS with access and aggregate
-- functions since the components are not visible here.

   -- Auxiliary function specificiations

   function MIN
      (A : in     COORDINATE;
       B : in     COORDINATE) return COORDINATE;

   function MAX
      (A : in     COORDINATE;
       B : in     COORDINATE) return COORDINATE;

   -- Implementations of subprograms in the package specification

   function IS_VALID
      (A : in     RECTANGLE_LIMITS) return BOOLEAN is
   -- Predicate returning `TRUE' when `A' is a positive rectangle.

   begin

      return XMIN(A) < XMAX(A) and then YMIN(A) < YMAX(A);

   end IS_VALID;

   function "<"
      (A : in     RECTANGLE_LIMITS;
       B : in     RECTANGLE_LIMITS) return BOOLEAN is
   -- Predicate returning `TRUE' when `A' is a proper subset of `B'.

   begin

      return   XMIN(B) < XMIN(A) and then XMAX(A) < XMAX(B)
      and then YMIN(B) < YMIN(A) and then YMAX(A) < YMAX(B);

   end "<";

   function "<="
      (A : in     RECTANGLE_LIMITS;
       B : in     RECTANGLE_LIMITS) return BOOLEAN is
   -- Predicate returning `TRUE' when `A' completely contained in `B'.

   begin

      return   XMIN(B) <= XMIN(A) and then XMAX(A) <= XMAX(B)
      and then YMIN(B) <= YMIN(A) and then YMAX(A) <= YMAX(B);

   end "<=";

   function ">="
      (A : in     RECTANGLE_LIMITS;
       B : in     RECTANGLE_LIMITS) return BOOLEAN is
   -- Predicate returning `TRUE' when `B' completely contained in `A'.

   begin

      return   XMIN(B) >= XMIN(A) and then XMAX(A) >= XMAX(B)
      and then YMIN(B) >= YMIN(A) and then YMAX(A) >= YMAX(B);

   end ">=";

   function ">"
      (A : in     RECTANGLE_LIMITS;
       B : in     RECTANGLE_LIMITS) return BOOLEAN is
   -- Predicate returning `TRUE' when `B' is a proper subset of `A'.

   begin

      return   XMIN(B) > XMIN(A) and then XMAX(A) > XMAX(B)
      and then YMIN(B) > YMIN(A) and then YMAX(A) > YMAX(B);

   end ">";

   function "or"
      (A : in     RECTANGLE_LIMITS;
       B : in     RECTANGLE_LIMITS) return RECTANGLE_LIMITS is
   -- Returns a RECTANGLE_LIMITS "enclosing" both `A' and `B'.
   -- Let `R' be the returned RECTANGLE_LIMITS.  Then the following
   -- predicate holds:  A <= R and B <= R.

   begin

      return RECTANGLE_LIMITS_MAKE (
            XMIN => MIN( XMIN(A) , XMIN(B) ),
            XMAX => MAX( XMAX(A) , XMAX(B) ),
            YMIN => MIN( YMIN(A) , YMIN(B) ),
            YMAX => MAX( YMAX(A) , YMAX(B) ));

   end "or";

   function "and"
      (A : in     RECTANGLE_LIMITS;
       B : in     RECTANGLE_LIMITS) return RECTANGLE_LIMITS is
   -- Returns a RECTANGLE_LIMITS "enclosed" by both `A' and `B'.
   -- Let `R' be the returned RECTANGLE_LIMITS.  Then the following
   -- predicate holds:  R <= A and R <= B.

   begin

      return RECTANGLE_LIMITS_MAKE (
            XMIN => MAX( XMIN(A) , XMIN(B) ),
            XMAX => MIN( XMAX(A) , XMAX(B) ),
            YMIN => MAX( YMIN(A) , YMIN(B) ),
            YMAX => MIN( YMAX(A) , YMAX(B) ));

   end "and";

   function MIN
      (A : in     COORDINATE;
       B : in     COORDINATE) return COORDINATE is
   -- Returns the minimum of `A' and `B'.
   -- Let `C' be the returned COORDINATE.  Then the following
   -- predicate holds:  C <= A and C <= B.

   begin

      if A < B then
         return A;
      else
         return B;
      end if;

   end MIN;

   function MAX
      (A : in     COORDINATE;
       B : in     COORDINATE) return COORDINATE is
   -- Returns the maximum of `A' and `B'.
   -- Let `C' be the returned COORDINATE.  Then the following
   -- predicate holds:  A <= C and B <= C.

   begin

      if B < A then
         return A;
      else
         return B;
      end if;

   end MAX;

end RECTANGLE_LIMITS_OPS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:DC_OPS_DEFS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: DC_OPS_DEFS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: DC_OPS_DEFS.ADA
-- Level: all

with GKS_TYPES;

use GKS_TYPES;

package DC_OPS_DEFS is

   -- Access

   function XMIN
      (RECT : in     DC . RECTANGLE_LIMITS) return DC_TYPE;

   function XMAX
      (RECT : in     DC . RECTANGLE_LIMITS) return DC_TYPE;

   function YMIN
      (RECT : in     DC . RECTANGLE_LIMITS) return DC_TYPE;

   function YMAX
      (RECT : in     DC . RECTANGLE_LIMITS) return DC_TYPE;

   -- Assignment

   procedure SET_XMIN
      (RECT  : in out DC . RECTANGLE_LIMITS;
       COORD : in     DC_TYPE);

   procedure SET_XMAX
      (RECT  : in out DC . RECTANGLE_LIMITS;
       COORD : in     DC_TYPE);

   procedure SET_YMIN
      (RECT  : in out DC . RECTANGLE_LIMITS;
       COORD : in     DC_TYPE);

   procedure SET_YMAX
      (RECT  : in out DC . RECTANGLE_LIMITS;
       COORD : in     DC_TYPE);

   -- Aggregate

   function RECTANGLE_LIMITS_MAKE
      (XMIN : in     DC_TYPE;
       XMAX : in     DC_TYPE;
       YMIN : in     DC_TYPE;
       YMAX : in     DC_TYPE)
       return  DC . RECTANGLE_LIMITS;

end DC_OPS_DEFS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:DC_OPS_DEFS_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: DC_OPS_DEFS - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: DC_OPS_DEFS_B.ADA
-- Level: all

package body DC_OPS_DEFS is

   -- Access functions provide functions to be used in a generic
   -- instantiation to access the values of components of the record.
   -- The name of each function is the name of its component.

   function XMIN
      (RECT : in     DC . RECTANGLE_LIMITS)
      return DC_TYPE is
   -- Return the XMIN component of RECT.

   begin

      return RECT . XMIN;

   end XMIN;

   function XMAX
      (RECT : in     DC . RECTANGLE_LIMITS)
      return DC_TYPE is
   -- Return the XMAX component of RECT.

   begin

      return RECT . XMAX;

   end XMAX;

   function YMIN
      (RECT : in     DC . RECTANGLE_LIMITS)
      return DC_TYPE is
   -- Return the YMIN component of RECT.

   begin

      return RECT . YMIN;

   end YMIN;

   function YMAX
      (RECT : in     DC . RECTANGLE_LIMITS)
      return DC_TYPE is
   -- Return the YMAX component of RECT.

   begin

      return RECT . YMAX;

   end YMAX;

   -- Assignment functions provide functions to be used in a generic
   -- instantiation to assign new values to components of the record.
   -- The name of each function is `SET_' & the name of its component.

   procedure SET_XMIN
      (RECT  : in out DC . RECTANGLE_LIMITS;
       COORD : in     DC_TYPE) is
   -- Assign COORD to the XMIN component of RECT.

   begin

      RECT . XMIN := COORD;

   end SET_XMIN;

   procedure SET_XMAX
      (RECT  : in out DC . RECTANGLE_LIMITS;
       COORD : in     DC_TYPE) is
   -- Assign COORD to the XMAX component of RECT.

   begin

      RECT . XMAX := COORD;

   end SET_XMAX;

   procedure SET_YMIN
      (RECT  : in out DC . RECTANGLE_LIMITS;
       COORD : in     DC_TYPE) is
   -- Assign COORD to the YMIN component of RECT.

   begin

      RECT . YMIN := COORD;

   end SET_YMIN;

   procedure SET_YMAX
      (RECT  : in out DC . RECTANGLE_LIMITS;
       COORD : in     DC_TYPE) is
   -- Assign COORD to the YMAX component of RECT.

   begin

      RECT . YMAX := COORD;

   end SET_YMAX;

   -- Aggregate

   function RECTANGLE_LIMITS_MAKE
      (XMIN : in     DC_TYPE;
       XMAX : in     DC_TYPE;
       YMIN : in     DC_TYPE;
       YMAX : in     DC_TYPE)
       return  DC . RECTANGLE_LIMITS is
   -- Return a rectangle formed from the corresponding input parameters.

   begin

      return DC . RECTANGLE_LIMITS'
         (XMIN => XMIN,
          XMAX => XMAX,
          YMIN => YMIN,
          YMAX => YMAX);

   end RECTANGLE_LIMITS_MAKE;

end DC_OPS_DEFS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:DC_OPS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: DC_OPS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: DC_OPS.ADA
-- Level: all

with RECTANGLE_LIMITS_OPS;
with GKS_TYPES;
with DC_OPS_DEFS;

use GKS_TYPES;

package DC_OPS is new RECTANGLE_LIMITS_OPS
   (COORDINATE            => DC_TYPE,
    RECTANGLE_LIMITS      => DC . RECTANGLE_LIMITS,
    XMIN                  => DC_OPS_DEFS . XMIN,
    XMAX                  => DC_OPS_DEFS . XMAX,
    YMIN                  => DC_OPS_DEFS . YMIN,
    YMAX                  => DC_OPS_DEFS . YMAX,
    RECTANGLE_LIMITS_MAKE => DC_OPS_DEFS . RECTANGLE_LIMITS_MAKE);

-- Package GKS_TYPES defines the DC_TYPE and the DC package.
-- Package DC_OPS_DEFS defines the access and aggregate subprograms
-- needed to instantiate RECTANGLE_LIMITS_OPS.
-- Package RECTANGLE_LIMITS_OPS is a generic package which defines
-- relational operations on rectangles.
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:NDC_OPS_DEFS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: NDC_OPS_DEFS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: NDC_OPS_DEFS.ADA
-- Level: all

with GKS_TYPES;

use GKS_TYPES;

package NDC_OPS_DEFS is

   -- Access

   function XMIN
      (RECT : in     NDC . RECTANGLE_LIMITS) return NDC_TYPE;

   function XMAX
      (RECT : in     NDC . RECTANGLE_LIMITS) return NDC_TYPE;

   function YMIN
      (RECT : in     NDC . RECTANGLE_LIMITS) return NDC_TYPE;

   function YMAX
      (RECT : in     NDC . RECTANGLE_LIMITS) return NDC_TYPE;

   -- Assignment

   procedure SET_XMIN
      (RECT  : in out NDC . RECTANGLE_LIMITS;
       COORD : in     NDC_TYPE);

   procedure SET_XMAX
      (RECT  : in out NDC . RECTANGLE_LIMITS;
       COORD : in     NDC_TYPE);

   procedure SET_YMIN
      (RECT  : in out NDC . RECTANGLE_LIMITS;
       COORD : in     NDC_TYPE);

   procedure SET_YMAX
      (RECT  : in out NDC . RECTANGLE_LIMITS;
       COORD : in     NDC_TYPE);

   -- Aggregate

   function RECTANGLE_LIMITS_MAKE
      (XMIN : in     NDC_TYPE;
       XMAX : in     NDC_TYPE;
       YMIN : in     NDC_TYPE;
       YMAX : in     NDC_TYPE)
       return  NDC . RECTANGLE_LIMITS;

end NDC_OPS_DEFS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:NDC_OPS_DEFS_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: NDC_OPS_DEFS - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: NDC_OPS_DEFS_B.ADA
-- Level: all

package body NDC_OPS_DEFS is

   -- Access functions provide functions to be used in a generic
   -- instantiation to access the values of components of the record.
   -- The name of each function is the name of its component.

   function XMIN
      (RECT : in     NDC . RECTANGLE_LIMITS)
      return NDC_TYPE is
   -- Return the XMIN component of RECT.

   begin

      return RECT . XMIN;

   end XMIN;

   function XMAX
      (RECT : in     NDC . RECTANGLE_LIMITS)
      return NDC_TYPE is
   -- Return the XMAX component of RECT.

   begin

      return RECT . XMAX;

   end XMAX;

   function YMIN
      (RECT : in     NDC . RECTANGLE_LIMITS)
      return NDC_TYPE is
   -- Return the YMIN component of RECT.

   begin

      return RECT . YMIN;

   end YMIN;

   function YMAX
      (RECT : in     NDC . RECTANGLE_LIMITS)
      return NDC_TYPE is
   -- Return the YMAX component of RECT.

   begin

      return RECT . YMAX;

   end YMAX;

   -- Assignment functions provide functions to be used in a generic
   -- instantiation to assign new values to components of the record.
   -- The name of each function is `SET_' & the name of its component.

   procedure SET_XMIN
      (RECT  : in out NDC . RECTANGLE_LIMITS;
       COORD : in     NDC_TYPE) is
   -- Assign COORD to the XMIN component of RECT.

   begin

      RECT . XMIN := COORD;

   end SET_XMIN;

   procedure SET_XMAX
      (RECT  : in out NDC . RECTANGLE_LIMITS;
       COORD : in     NDC_TYPE) is
   -- Assign COORD to the XMAX component of RECT.

   begin

      RECT . XMAX := COORD;

   end SET_XMAX;

   procedure SET_YMIN
      (RECT  : in out NDC . RECTANGLE_LIMITS;
       COORD : in     NDC_TYPE) is
   -- Assign COORD to the YMIN component of RECT.

   begin

      RECT . YMIN := COORD;

   end SET_YMIN;

   procedure SET_YMAX
      (RECT  : in out NDC . RECTANGLE_LIMITS;
       COORD : in     NDC_TYPE) is
   -- Assign COORD to the YMAX component of RECT.

   begin

      RECT . YMAX := COORD;

   end SET_YMAX;

   -- Aggregate

   function RECTANGLE_LIMITS_MAKE
      (XMIN : in     NDC_TYPE;
       XMAX : in     NDC_TYPE;
       YMIN : in     NDC_TYPE;
       YMAX : in     NDC_TYPE)
       return  NDC . RECTANGLE_LIMITS is
   -- Return a rectangle formed from the corresponding input parameters.

   begin

      return NDC . RECTANGLE_LIMITS'
         (XMIN => XMIN,
          XMAX => XMAX,
          YMIN => YMIN,
          YMAX => YMAX);

   end RECTANGLE_LIMITS_MAKE;

end NDC_OPS_DEFS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:NDC_OPS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: NDC_OPS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: NDC_OPS.ADA
-- Level: all

with RECTANGLE_LIMITS_OPS;
with GKS_TYPES;
with NDC_OPS_DEFS;

use GKS_TYPES;

package NDC_OPS is new RECTANGLE_LIMITS_OPS
   (COORDINATE            => NDC_TYPE,
    RECTANGLE_LIMITS      => NDC . RECTANGLE_LIMITS,
    XMIN                  => NDC_OPS_DEFS . XMIN,
    XMAX                  => NDC_OPS_DEFS . XMAX,
    YMIN                  => NDC_OPS_DEFS . YMIN,
    YMAX                  => NDC_OPS_DEFS . YMAX,
    RECTANGLE_LIMITS_MAKE => NDC_OPS_DEFS . RECTANGLE_LIMITS_MAKE);

-- Package GKS_TYPES defines the NDC_TYPE and the NDC package.
-- Package NDC_OPS_DEFS defines the access and aggregate subprograms
-- needed to instantiate RECTANGLE_LIMITS_OPS.
-- Package RECTANGLE_LIMITS_OPS is a generic package which defines
-- relational operations on rectangles.
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:DC_POINT_OPS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: DC_POINT_OPS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: DC_POINT_OPS.ADA
-- Level: all

with GKS_TYPES;

use GKS_TYPES;

package DC_POINT_OPS is

-- Package DC_POINT_OPS provides extended functionality to the POINT
-- and VECTOR types defined in package DC, an instance of
-- GKS_COORDINATE_SYSTEM.  The extensions are functions which perform
-- commonly desired operations on points and vectors.
--
-- The functions are grouped by the argument and result types, and
-- perform well-known mathematical functions:
--      DOT             vector dot product
--      NORM            the norm or length of a vector
--      DIST            Euclidean distance between points
--      "*"             Multiply VECTOR or POINT by a DC_TYPE or
--                      DC . MAGNITUDE and vice versa
--      "/"             Divide VECTOR or POINT by a DC_TYPE or
--                      DC . MAGNITUDE
--      "-"             Negative of a VECTOR or a POINT
--      "+","-"         Sum or difference of a VECTOR or a POINT
--      "+","-"         Mixed sums of VECTORs and POINTs with POINTs
--                      regarded as absolute positions and VECTORs as
--                      relative displacements.
--
-- One set of functions is somewhat unconventional:
--      "*","/"         Coordinate-wise multiply or divide of a VECTOR
--                      or a POINT
--
-- Because POINT and VECTOR are record types, not array types, it is
-- clumsy to use them as generic parameters, but see packages NDC_OPS and
-- DC_OPS for an instance of this technique. Instead of a generic
-- extension to GKS_COORDINATE_SYSTEM, this package directly implements
-- extensions to package DC.
--
-- IMPORTANT, IMPLEMENTATION RESTRICTION:
-- A sister package, NDC_POINT_OPS was generated from this one by
-- swapping all occurrences of the strings "NDC" and "DC".  By avoiding
-- any other use of these strings, an easy pseudo-generic instantiation
-- is made. Even comments should follow this rule.

   use DC;

   subtype COORD is DC_TYPE;
   subtype MAGNITUDE is DC . MAGNITUDE;

-- DOT(V, V) => S  DOT PRODUCT
-- NORM(V)   => S  [S := SQRT( DOT(V,V) );]

   function DOT
      (A : in     VECTOR;
       B : in     VECTOR) return COORD;

   function NORM
      (A : in     VECTOR) return COORD;

   function NORM
      (A : in     VECTOR) return MAGNITUDE;

   function DIST
      (A : in     POINT;
       B : in     POINT) return COORD;

   function DIST
      (A : in     POINT;
       B : in     POINT) return MAGNITUDE;

-- Scalar operations

   function "*"
      (V : in     VECTOR;
       S : in     COORD) return VECTOR;

   function "*"
      (S : in     COORD;
       V : in     VECTOR) return VECTOR;

   function "/"
      (V : in     VECTOR;
       S : in     COORD) return VECTOR;

   function "*"
      (V : in     VECTOR;
       S : in     MAGNITUDE) return VECTOR;

   function "*"
      (S : in     MAGNITUDE;
       V : in     VECTOR) return VECTOR;

   function "/"
      (V : in     VECTOR;
       S : in     MAGNITUDE) return VECTOR;

   function "*"
      (P : in     POINT;
       S : in     COORD) return POINT;

   function "*"
      (S : in     COORD;
       P : in     POINT) return POINT;

   function "/"
      (P : in     POINT;
       S : in     COORD) return POINT;

   function "*"
      (P : in     POINT;
       S : in     MAGNITUDE) return POINT;

   function "*"
      (S : in     MAGNITUDE;
       P : in     POINT) return POINT;

   function "/"
      (P : in     POINT;
       S : in     MAGNITUDE) return POINT;

-- - V   => V [for I in X..Y loop V(I) := - V(I); end loop;]
-- V + V => V [for I in X..Y loop V(I) := VA(I) + VB(I); end loop;]
-- V - V => V [for I in X..Y loop V(I) := VA(I) - VB(I); end loop;]
-- V * V => V [for I in X..Y loop V(I) := VA(I) * VB(I); end loop;]
-- V / V => V [for I in X..Y loop V(I) := VA(I) / VB(I); end loop;]

   function "-"
      (A: in     VECTOR) return VECTOR;

   function "+"
      (A : in     VECTOR;
       B : in     VECTOR) return VECTOR;

   function "-"
      (A : in     VECTOR;
       B : in     VECTOR) return VECTOR;

   function "*"
      (A : in     VECTOR;
       B : in     VECTOR) return VECTOR;

   function "/"
      (A : in     VECTOR;
       B : in     VECTOR) return VECTOR;


-- - P   => P [for I in X..Y loop P(I) := - P(I); end loop;]
-- P + P => P [for I in X..Y loop P(I) := PA(I) + PB(I); end loop;]
-- P - P => P [for I in X..Y loop P(I) := PA(I) - PB(I); end loop;]
-- P * P => P [for I in X..Y loop P(I) := PA(I) * PB(I); end loop;]
-- P / P => P [for I in X..Y loop P(I) := PA(I) / PB(I); end loop;]
--
   function "-"
      (A : in     POINT) return POINT;

   function "+"
      (A : in     POINT;
       B : in     POINT) return POINT;

   function "-"
      (A : in     POINT;
       B : in     POINT) return POINT;

   function "*"
      (A : in     POINT;
       B : in     POINT) return POINT;

   function "/"
       (A : in     POINT;
        B : in     POINT) return POINT;

-- P - P => V [for I in X..Y loop V(I) := PA(I) - PB(I); end loop;]

   function "-"
      (HEAD : in     POINT;
       TAIL : in     POINT) return VECTOR;

-- P + V => P [for I in X..Y loop P(I) := PA(I) + VB(I); end loop;]
-- V + P => P [for I in X..Y loop P(I) := VA(I) + PB(I); end loop;]
-- P - V => P [for I in X..Y loop P(I) := PA(I) - VB(I); end loop;]
-- V - P => P [for I in X..Y loop P(I) := VA(I) - PB(I); end loop;]

   function "+"
      (P : in     POINT;
       V : in     VECTOR) return POINT;

   function "+"
      (V : in     VECTOR;
       P : in     POINT) return POINT;

   function "-"
      (P : in     POINT;
       V : in     VECTOR) return POINT;

   function "-"
      (V : in     VECTOR;
       P : in     POINT) return POINT;

end DC_POINT_OPS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:DC_POINT_OPS_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: DC_POINT_OPS - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: DC_POINT_OPS_B.ADA
-- Level: all

package body DC_POINT_OPS is

   use GKS_TYPES;
   use DC;

   function SQRT
      (X : in    FLOAT) return FLOAT is

   -- Compute the square root of X.
   -- Normally, a square root function would test for X < 0.0, but this
   -- function is never called with a negative number here.
   --
   -- X - positive number to take the square root of
   --
   -- Implementation note: This function uses FLOAT because the
   -- difference R - R0 could be zero (truncation effects, or just
   -- luck).
   -- This implementation is based on Newton-Raphson iteration for the
   -- roots of the function F(R) = R**2 - X.
   -- The Newton-Raphson iteration is:
   --    R' := R - F(R)/F'(R)
   -- Substituting F(R) = R**2 - X, and F'(R) = 2*R we get:
   --    R' := R - (R**2 - X)/(2*R)
   -- Rearranging:
   --    R' := R - (R**2 / R - X / R) / 2
   --    R' := R - (R - X / R) / 2
   --    R' := (R * 2 - R + X / R) / 2
   --    R' := (R + X / R) / 2
   -- Strength reduction, multiply instead of divide, yields:
   --    R' := (R + X/R) * 0.5

      R0 : FLOAT := 1.0;
      -- Previous guess at square root

      R : FLOAT := X;
      -- Next quess at square root

   begin

      while abs ((R - R0) / R) > 0.000001 loop

         R0 := R;

         R := (R + X / R) * 0.5;

      end loop;

      return R;

   end SQRT;

   function SQRT
      (X : in    MAGNITUDE) return MAGNITUDE is

   -- Square root of a MAGNITUDE (which is always positive)
   --
   -- X - MAGNITUDE to take the square root of

   begin

      return MAGNITUDE ( FLOAT' ( SQRT ( FLOAT(X) ) ) );

   end SQRT;

   function DOT
      (A : in     VECTOR;
       B : in     VECTOR) return COORD is

   -- DOT product is sum of product of components
   --
   -- A - first vector of DOT product
   -- B - second vector of DOT product

   begin

      return (A.X * B.X) + (A.Y * B.Y);

   end DOT;

   function NORM
      (A : VECTOR) return MAGNITUDE is

   -- Return Euclidean length of a VECTOR as a MAGNITUDE
   --
   -- A - VECTOR whose length is sought

   begin

      return SQRT ( DC . MAGNITUDE ( DOT (A,A) ) );
      -- This is a simple algorithm.  Better numerical accuracy and
      -- greater functional domain can be had, but graphics do not
      -- require it.

   end NORM;

   function NORM
      (A : VECTOR) return COORD is

   -- Return Euclidean length of a VECTOR as a COORD
   --
   -- A - VECTOR whose length is sought

   begin

      return COORD ( MAGNITUDE' ( NORM(A) ) );

   end NORM;

   function DIST
      (A : in     POINT;
       B : in     POINT) return MAGNITUDE is

   -- Return Euclidean distance between two point as a MAGNITUDE
   --
   -- A - Starting point
   -- B - Ending point

   begin

      return NORM ( VECTOR' (A - B) );

   end DIST;

   function DIST
      (A : in     POINT;
       B : in     POINT) return COORD is

   -- Return Euclidean distance between two point as a COORD
   --
   -- A - Starting point
   -- B - Ending point

   begin

      return NORM ( VECTOR' (A - B) );

   end DIST;

-- Scalar operations: VECTOR and COORD

   function "*"
      (V : VECTOR;
       S : COORD) return VECTOR is

   -- Multiply a VECTOR by a COORD
   --
   -- V - Vector to be multiplied
   -- S - Scalar to multiply vector by

   begin

      return VECTOR '( V.X * S, V.Y * S);

   end "*";

   function "*"
      (S : COORD;
       V : VECTOR) return VECTOR is

   -- Multiply a COORD by a VECTOR
   --
   -- S - Scalar to multiply vector by
   -- V - Vector to be multiplied

   begin

      return VECTOR '( S * V.X, S * V.Y);

   end "*";

   function "/"
      (V : VECTOR;
       S : COORD) return VECTOR is

   -- Divide a VECTOR by a COORD
   --
   -- V - Vector to be divided
   -- S - Scalar to divide vector by

   begin

      return VECTOR '( V.X / S, V.Y / S);

   end "/";

-- Scalar operations: POINT and COORD

   function "*"
      (P : POINT;
       S : COORD) return POINT is

   -- Multiply a POINT by a COORD
   --
   -- P - POINT to be multiplied
   -- S - Scalar to multiply POINT by

   begin

      return POINT '( P.X * S, P.Y * S);

   end "*";

   function "*"
      (S : COORD;
       P : POINT) return POINT is

   -- Multiply a COORD by a POINT
   --
   -- S - Scalar to multiply POINT by
   -- P - POINT to be multiplied

   begin

      return POINT '( S * P.X, S * P.Y);

   end "*";

   function "/"
      (P : POINT;
       S : COORD) return POINT is

   -- Divide a POINT by a COORD
   --
   -- P - POINT to be divided
   -- S - Scalar to divide POINT by

   begin

      return POINT '( P.X / S, P.Y / S);

   end "/";

-- Scalar operations: VECTOR and MAGNITUDE

   function "*"
      (V : VECTOR;
       S : MAGNITUDE) return VECTOR is

   -- Multiply a VECTOR by a MAGNITUDE
   --
   -- V - Vector to be multiplied
   -- S - Scalar to multiply vector by

      C : COORD := COORD ( S );
      -- Convert S to a COORD

   begin

      return VECTOR '( V.X * C, V.Y * C);

   end "*";

   function "*"
      (S : MAGNITUDE;
       V : VECTOR) return VECTOR is

   -- Multiply a MAGNITUDE by a VECTOR
   --
   -- S - Scalar to multiply vector by
   -- V - Vector to be multiplied

      C : COORD := COORD ( S );
      -- Convert S to a COORD

   begin

      return VECTOR '( C * V.X, C * V.Y);

   end "*";

   function "/"
      (V : VECTOR;
       S : MAGNITUDE) return VECTOR is

   -- Divide a VECTOR by a MAGNITUDE
   --
   -- V - Vector to be divided
   -- S - Scalar to divide vector by

      C : COORD := COORD ( S );
      -- Convert S to a COORD

   begin

      return VECTOR '( V.X / C, V.Y / C);

   end "/";

-- Scalar operations: POINT and MAGNITUDE

   function "*"
      (P : POINT;
       S : MAGNITUDE) return POINT is

   -- Multiply a POINT by a MAGNITUDE
   --
   -- P - POINT to be multiplied
   -- S - Scalar to multiply POINT by

      C : COORD := COORD ( S );
      -- Convert S to a COORD

   begin

      return POINT '( P.X * C, P.Y * C);

   end "*";

   function "*"
      (S : MAGNITUDE;
       P : POINT) return POINT is

   -- Multiply a MAGNITUDE by a POINT
   --
   -- S - Scalar to multiply POINT by
   -- P - POINT to be multiplied

      C : COORD := COORD ( S );
      -- Convert S to a COORD

   begin

      return POINT '( C * P.X, C * P.Y);

   end "*";

   function "/"
      (P : POINT;
       S : MAGNITUDE) return POINT is

   -- Divide a POINT by a MAGNITUDE
   --
   -- P - POINT to be divided
   -- S - Scalar to divide POINT by

      C : COORD := COORD ( S );
      -- Convert S to a COORD

   begin

      return POINT '( P.X / C, P.Y / C);

   end "/";

   --
   -- VECTOR op VECTOR ==> VECTOR
   --

   function "-"
      ( A : VECTOR) return VECTOR is

   -- Negate a VECTOR
   --
   -- A - a VECTOR

   begin

      return VECTOR '( -A.X, -A.Y);

   end "-";

   function "-"
      (A : VECTOR;
       B : VECTOR) return VECTOR is

   -- Subtract two VECTORs
   --
   -- A - a VECTOR
   -- B - a VECTOR to subtract from `A'

   begin

      return VECTOR '( A.X - B.X, A.Y - B.Y);

   end "-";

   function "+"
      (A : VECTOR;
       B : VECTOR) return VECTOR is

   -- Add two VECTORs
   --
   -- A - a VECTOR
   -- B - a VECTOR to add to `A'

   begin

      return VECTOR '( A.X + B.X, A.Y + B.Y);

   end "+";

   function "*"
      (A : VECTOR;
       B : VECTOR) return VECTOR is

   -- Multiply two VECTORs
   --
   -- A - a VECTOR
   -- B - a VECTOR to multiply `A' by (component-wise)

   begin

      return VECTOR '( A.X * B.X, A.Y * B.Y);

   end "*";

   function "/"
      (A : VECTOR;
       B : VECTOR) return VECTOR is

   -- Divide two VECTORs
   --
   -- A - a VECTOR
   -- B - a VECTOR to divide `A' by (component-wise)

   begin

      return VECTOR '( A.X / B.X, A.Y / B.Y);

   end "/";

   --
   -- POINT op POINT ==> POINT
   --

   function "-"
      ( A : POINT) return POINT is

   -- Negate a POINT
   --
   -- A - a POINT

   begin

      return POINT '( -A.X, -A.Y);

   end "-";

   function "-"
      (A : POINT;
       B : POINT) return POINT is

   -- Subtract two POINTs
   --
   -- A - a POINT
   -- B - a POINT to subtract from `A'

   begin

      return POINT '( A.X - B.X, A.Y - B.Y);

   end "-";

   function "+"
      (A : POINT;
       B : POINT) return POINT is

   -- Add two POINTs
   --
   -- A - a POINT
   -- B - a POINT to add to `A'

   begin

      return POINT '( A.X + B.X, A.Y + B.Y);

   end "+";

   function "*"
      (A : POINT;
       B : POINT) return POINT is

   -- Multiply two POINTs
   --
   -- A - a POINT
   -- B - a POINT to multiply `A' by (component-wise)

   begin

      return POINT '( A.X * B.X, A.Y * B.Y);

   end "*";

   function "/"
      (A : POINT;
       B : POINT) return POINT is

   -- Divide two POINTs
   --
   -- A - a POINT
   -- B - a POINT to divide `A' by (component-wise)

   begin

      return POINT '( A.X / B.X, A.Y / B.Y);

   end "/";

-- Functions mixing VECTOR and POINT

   function "-"
      (HEAD : POINT;
       TAIL : POINT) return VECTOR is

   -- Subtract two POINTs yielding a VECTOR
   --
   -- A - a displacement POINT
   -- B - a reference POINT to subtract from `A'

   begin

      return VECTOR '( HEAD.X - TAIL.X, HEAD.Y - TAIL.Y);

   end "-";

   function "+"
      (P : POINT;
       V : VECTOR) return POINT is

   -- Add a VECTOR to a POINT yielding a POINT
   --
   -- P - a reference POINT
   -- V - a displacement VECTOR to add to `A'

   begin

      return POINT '( P.X + V.X, P.Y + V.Y);

   end "+";

   function "+"
      (V : VECTOR;
       P : POINT) return POINT is

   -- Add a VECTOR to a POINT yielding a POINT
   --
   -- V - a displacement VECTOR to add to `A'
   -- P - a reference POINT

   begin

      return POINT '( V.X + P.X, V.Y + P.Y);

   end "+";

   function "-"
      (P : POINT;
       V : VECTOR) return POINT is

   -- Subtract a VECTOR from a POINT yielding a POINT
   --
   -- P - a reference POINT
   -- V - a displacement VECTOR to subtract from `A'

   begin

      return POINT '( P.X - V.X, P.Y - V.Y);

   end "-";

   function "-"
      (V : VECTOR;
       P : POINT) return POINT is

   -- Subtract a VECTOR from a POINT yielding a POINT
   --
   -- V - a displacement VECTOR
   -- P - a reference POINT to subtract from `A'

   begin

      return POINT '( V.X - P.X, V.Y - P.Y);

   end "-";

end DC_POINT_OPS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:NDC_POINT_OPS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: NDC_POINT_OPS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: NDC_POINT_OPS.ADA
-- Level: all

with GKS_TYPES;

use GKS_TYPES;

package NDC_POINT_OPS is

-- Package NDC_POINT_OPS provides extended functionality to the POINT
-- and VECTOR types defined in package NDC, an instance of
-- GKS_COORDINATE_SYSTEM.  The extensions are functions which perform
-- commonly desired operations on points and vectors.
--
-- The functions are grouped by the argument and result types, and
-- perform well-known mathematical functions:
--      DOT             vector dot product
--      NORM            the norm or length of a vector
--      DIST            Euclidean distance between points
--      "*"             Multiply VECTOR or POINT by a NDC_TYPE or
--                      NDC . MAGNITUDE and vice versa
--      "/"             Divide VECTOR or POINT by a NDC_TYPE or
--                      NDC . MAGNITUDE
--      "-"             Negative of a VECTOR or a POINT
--      "+","-"         Sum or difference of a VECTOR or a POINT
--      "+","-"         Mixed sums of VECTORs and POINTs with POINTs
--                      regarded as absolute positions and VECTORs as
--                      relative displacements.
--
-- One set of functions is somewhat unconventional:
--      "*","/"         Coordinate-wise multiply or divide of a VECTOR
--                      or a POINT
--
-- Because POINT and VECTOR are record types, not array types, it is
-- clumsy to use them as generic parameters, but see packages DC_OPS and
-- NDC_OPS for an instance of this technique. Instead of a generic
-- extension to GKS_COORDINATE_SYSTEM, this package directly implements
-- extensions to package NDC.
--
-- IMPORTANT, IMPLEMENTATION RESTRICTION:
-- A sister package, DC_POINT_OPS was generated from this one by
-- swapping all occurrences of the strings "DC" and "NDC".  By avoiding
-- any other use of these strings, an easy pseudo-generic instantiation
-- is made. Even comments should follow this rule.

   use NDC;

   subtype COORD is NDC_TYPE;
   subtype MAGNITUDE is NDC . MAGNITUDE;

-- DOT(V, V) => S  DOT PRODUCT
-- NORM(V)   => S  [S := SQRT( DOT(V,V) );]

   function DOT
      (A : in     VECTOR;
       B : in     VECTOR) return COORD;

   function NORM
      (A : in     VECTOR) return COORD;

   function NORM
      (A : in     VECTOR) return MAGNITUDE;

   function DIST
      (A : in     POINT;
       B : in     POINT) return COORD;

   function DIST
      (A : in     POINT;
       B : in     POINT) return MAGNITUDE;

-- Scalar operations

   function "*"
      (V : in     VECTOR;
       S : in     COORD) return VECTOR;

   function "*"
      (S : in     COORD;
       V : in     VECTOR) return VECTOR;

   function "/"
      (V : in     VECTOR;
       S : in     COORD) return VECTOR;

   function "*"
      (V : in     VECTOR;
       S : in     MAGNITUDE) return VECTOR;

   function "*"
      (S : in     MAGNITUDE;
       V : in     VECTOR) return VECTOR;

   function "/"
      (V : in     VECTOR;
       S : in     MAGNITUDE) return VECTOR;

   function "*"
      (P : in     POINT;
       S : in     COORD) return POINT;

   function "*"
      (S : in     COORD;
       P : in     POINT) return POINT;

   function "/"
      (P : in     POINT;
       S : in     COORD) return POINT;

   function "*"
      (P : in     POINT;
       S : in     MAGNITUDE) return POINT;

   function "*"
      (S : in     MAGNITUDE;
       P : in     POINT) return POINT;

   function "/"
      (P : in     POINT;
       S : in     MAGNITUDE) return POINT;

-- - V   => V [for I in X..Y loop V(I) := - V(I); end loop;]
-- V + V => V [for I in X..Y loop V(I) := VA(I) + VB(I); end loop;]
-- V - V => V [for I in X..Y loop V(I) := VA(I) - VB(I); end loop;]
-- V * V => V [for I in X..Y loop V(I) := VA(I) * VB(I); end loop;]
-- V / V => V [for I in X..Y loop V(I) := VA(I) / VB(I); end loop;]

   function "-"
      (A: in     VECTOR) return VECTOR;

   function "+"
      (A : in     VECTOR;
       B : in     VECTOR) return VECTOR;

   function "-"
      (A : in     VECTOR;
       B : in     VECTOR) return VECTOR;

   function "*"
      (A : in     VECTOR;
       B : in     VECTOR) return VECTOR;

   function "/"
      (A : in     VECTOR;
       B : in     VECTOR) return VECTOR;


-- - P   => P [for I in X..Y loop P(I) := - P(I); end loop;]
-- P + P => P [for I in X..Y loop P(I) := PA(I) + PB(I); end loop;]
-- P - P => P [for I in X..Y loop P(I) := PA(I) - PB(I); end loop;]
-- P * P => P [for I in X..Y loop P(I) := PA(I) * PB(I); end loop;]
-- P / P => P [for I in X..Y loop P(I) := PA(I) / PB(I); end loop;]
--
   function "-"
      (A : in     POINT) return POINT;

   function "+"
      (A : in     POINT;
       B : in     POINT) return POINT;

   function "-"
      (A : in     POINT;
       B : in     POINT) return POINT;

   function "*"
      (A : in     POINT;
       B : in     POINT) return POINT;

   function "/"
       (A : in     POINT;
        B : in     POINT) return POINT;

-- P - P => V [for I in X..Y loop V(I) := PA(I) - PB(I); end loop;]

   function "-"
      (HEAD : in     POINT;
       TAIL : in     POINT) return VECTOR;

-- P + V => P [for I in X..Y loop P(I) := PA(I) + VB(I); end loop;]
-- V + P => P [for I in X..Y loop P(I) := VA(I) + PB(I); end loop;]
-- P - V => P [for I in X..Y loop P(I) := PA(I) - VB(I); end loop;]
-- V - P => P [for I in X..Y loop P(I) := VA(I) - PB(I); end loop;]

   function "+"
      (P : in     POINT;
       V : in     VECTOR) return POINT;

   function "+"
      (V : in     VECTOR;
       P : in     POINT) return POINT;

   function "-"
      (P : in     POINT;
       V : in     VECTOR) return POINT;

   function "-"
      (V : in     VECTOR;
       P : in     POINT) return POINT;

end NDC_POINT_OPS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:NDC_POINT_OPS_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: NDC_POINT_OPS - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: NDC_POINT_OPS_B.ADA
-- Level: all

package body NDC_POINT_OPS is

   use GKS_TYPES;
   use NDC;

   function SQRT
      (X : in    FLOAT) return FLOAT is

   -- Compute the square root of X.
   -- Normally, a square root function would test for X < 0.0, but this
   -- function is never called with a negative number here.
   --
   -- X - positive number to take the square root of
   --
   -- Implementation note: This function uses FLOAT because the
   -- difference R - R0 could be zero (truncation effects, or just
   -- luck).
   -- This implementation is based on Newton-Raphson iteration for the
   -- roots of the function F(R) = R**2 - X.
   -- The Newton-Raphson iteration is:
   --    R' := R - F(R)/F'(R)
   -- Substituting F(R) = R**2 - X, and F'(R) = 2*R we get:
   --    R' := R - (R**2 - X)/(2*R)
   -- Rearranging:
   --    R' := R - (R**2 / R - X / R) / 2
   --    R' := R - (R - X / R) / 2
   --    R' := (R * 2 - R + X / R) / 2
   --    R' := (R + X / R) / 2
   -- Strength reduction, multiply instead of divide, yields:
   --    R' := (R + X/R) * 0.5

      R0 : FLOAT := 1.0;
      -- Previous guess at square root

      R : FLOAT := X;
      -- Next quess at square root

   begin

      while abs ((R - R0) / R) > 0.000001 loop

         R0 := R;

         R := (R + X / R) * 0.5;

      end loop;

      return R;

   end SQRT;

   function SQRT
      (X : in    MAGNITUDE) return MAGNITUDE is

   -- Square root of a MAGNITUDE (which is always positive)
   --
   -- X - MAGNITUDE to take the square root of

   begin

      return MAGNITUDE ( FLOAT' ( SQRT ( FLOAT(X) ) ) );

   end SQRT;

   function DOT
      (A : in     VECTOR;
       B : in     VECTOR) return COORD is

   -- DOT product is sum of product of components
   --
   -- A - first vector of DOT product
   -- B - second vector of DOT product

   begin

      return (A.X * B.X) + (A.Y * B.Y);

   end DOT;

   function NORM
      (A : VECTOR) return MAGNITUDE is

   -- Return Euclidean length of a VECTOR as a MAGNITUDE
   --
   -- A - VECTOR whose length is sought

   begin

      return SQRT ( NDC . MAGNITUDE ( DOT (A,A) ) );
      -- This is a simple algorithm.  Better numerical accuracy and
      -- greater functional domain can be had, but graphics do not
      -- require it.

   end NORM;

   function NORM
      (A : VECTOR) return COORD is

   -- Return Euclidean length of a VECTOR as a COORD
   --
   -- A - VECTOR whose length is sought

   begin

      return COORD ( MAGNITUDE' ( NORM(A) ) );

   end NORM;

   function DIST
      (A : in     POINT;
       B : in     POINT) return MAGNITUDE is

   -- Return Euclidean distance between two point as a MAGNITUDE
   --
   -- A - Starting point
   -- B - Ending point

   begin

      return NORM ( VECTOR' (A - B) );

   end DIST;

   function DIST
      (A : in     POINT;
       B : in     POINT) return COORD is

   -- Return Euclidean distance between two point as a COORD
   --
   -- A - Starting point
   -- B - Ending point

   begin

      return NORM ( VECTOR' (A - B) );

   end DIST;

-- Scalar operations: VECTOR and COORD

   function "*"
      (V : VECTOR;
       S : COORD) return VECTOR is

   -- Multiply a VECTOR by a COORD
   --
   -- V - Vector to be multiplied
   -- S - Scalar to multiply vector by

   begin

      return VECTOR '( V.X * S, V.Y * S);

   end "*";

   function "*"
      (S : COORD;
       V : VECTOR) return VECTOR is

   -- Multiply a COORD by a VECTOR
   --
   -- S - Scalar to multiply vector by
   -- V - Vector to be multiplied

   begin

      return VECTOR '( S * V.X, S * V.Y);

   end "*";

   function "/"
      (V : VECTOR;
       S : COORD) return VECTOR is

   -- Divide a VECTOR by a COORD
   --
   -- V - Vector to be divided
   -- S - Scalar to divide vector by

   begin

      return VECTOR '( V.X / S, V.Y / S);

   end "/";

-- Scalar operations: POINT and COORD

   function "*"
      (P : POINT;
       S : COORD) return POINT is

   -- Multiply a POINT by a COORD
   --
   -- P - POINT to be multiplied
   -- S - Scalar to multiply POINT by

   begin

      return POINT '( P.X * S, P.Y * S);

   end "*";

   function "*"
      (S : COORD;
       P : POINT) return POINT is

   -- Multiply a COORD by a POINT
   --
   -- S - Scalar to multiply POINT by
   -- P - POINT to be multiplied

   begin

      return POINT '( S * P.X, S * P.Y);

   end "*";

   function "/"
      (P : POINT;
       S : COORD) return POINT is

   -- Divide a POINT by a COORD
   --
   -- P - POINT to be divided
   -- S - Scalar to divide POINT by

   begin

      return POINT '( P.X / S, P.Y / S);

   end "/";

-- Scalar operations: VECTOR and MAGNITUDE

   function "*"
      (V : VECTOR;
       S : MAGNITUDE) return VECTOR is

   -- Multiply a VECTOR by a MAGNITUDE
   --
   -- V - Vector to be multiplied
   -- S - Scalar to multiply vector by

      C : COORD := COORD ( S );
      -- Convert S to a COORD

   begin

      return VECTOR '( V.X * C, V.Y * C);

   end "*";

   function "*"
      (S : MAGNITUDE;
       V : VECTOR) return VECTOR is

   -- Multiply a MAGNITUDE by a VECTOR
   --
   -- S - Scalar to multiply vector by
   -- V - Vector to be multiplied

      C : COORD := COORD ( S );
      -- Convert S to a COORD

   begin

      return VECTOR '( C * V.X, C * V.Y);

   end "*";

   function "/"
      (V : VECTOR;
       S : MAGNITUDE) return VECTOR is

   -- Divide a VECTOR by a MAGNITUDE
   --
   -- V - Vector to be divided
   -- S - Scalar to divide vector by

      C : COORD := COORD ( S );
      -- Convert S to a COORD

   begin

      return VECTOR '( V.X / C, V.Y / C);

   end "/";

-- Scalar operations: POINT and MAGNITUDE

   function "*"
      (P : POINT;
       S : MAGNITUDE) return POINT is

   -- Multiply a POINT by a MAGNITUDE
   --
   -- P - POINT to be multiplied
   -- S - Scalar to multiply POINT by

      C : COORD := COORD ( S );
      -- Convert S to a COORD

   begin

      return POINT '( P.X * C, P.Y * C);

   end "*";

   function "*"
      (S : MAGNITUDE;
       P : POINT) return POINT is

   -- Multiply a MAGNITUDE by a POINT
   --
   -- S - Scalar to multiply POINT by
   -- P - POINT to be multiplied

      C : COORD := COORD ( S );
      -- Convert S to a COORD

   begin

      return POINT '( C * P.X, C * P.Y);

   end "*";

   function "/"
      (P : POINT;
       S : MAGNITUDE) return POINT is

   -- Divide a POINT by a MAGNITUDE
   --
   -- P - POINT to be divided
   -- S - Scalar to divide POINT by

      C : COORD := COORD ( S );
      -- Convert S to a COORD

   begin

      return POINT '( P.X / C, P.Y / C);

   end "/";

   --
   -- VECTOR op VECTOR ==> VECTOR
   --

   function "-"
      ( A : VECTOR) return VECTOR is

   -- Negate a VECTOR
   --
   -- A - a VECTOR

   begin

      return VECTOR '( -A.X, -A.Y);

   end "-";

   function "-"
      (A : VECTOR;
       B : VECTOR) return VECTOR is

   -- Subtract two VECTORs
   --
   -- A - a VECTOR
   -- B - a VECTOR to subtract from `A'

   begin

      return VECTOR '( A.X - B.X, A.Y - B.Y);

   end "-";

   function "+"
      (A : VECTOR;
       B : VECTOR) return VECTOR is

   -- Add two VECTORs
   --
   -- A - a VECTOR
   -- B - a VECTOR to add to `A'

   begin

      return VECTOR '( A.X + B.X, A.Y + B.Y);

   end "+";

   function "*"
      (A : VECTOR;
       B : VECTOR) return VECTOR is

   -- Multiply two VECTORs
   --
   -- A - a VECTOR
   -- B - a VECTOR to multiply `A' by (component-wise)

   begin

      return VECTOR '( A.X * B.X, A.Y * B.Y);

   end "*";

   function "/"
      (A : VECTOR;
       B : VECTOR) return VECTOR is

   -- Divide two VECTORs
   --
   -- A - a VECTOR
   -- B - a VECTOR to divide `A' by (component-wise)

   begin

      return VECTOR '( A.X / B.X, A.Y / B.Y);

   end "/";

   --
   -- POINT op POINT ==> POINT
   --

   function "-"
      ( A : POINT) return POINT is

   -- Negate a POINT
   --
   -- A - a POINT

   begin

      return POINT '( -A.X, -A.Y);

   end "-";

   function "-"
      (A : POINT;
       B : POINT) return POINT is

   -- Subtract two POINTs
   --
   -- A - a POINT
   -- B - a POINT to subtract from `A'

   begin

      return POINT
      ( A.X - B.X, A.Y - B.Y);

   end "-";

   function "+"
      (A : POINT;
       B : POINT) return POINT is

   -- Add two POINTs
   --
   -- A - a POINT
   -- B - a POINT to add to `A'

   begin

      return POINT '( A.X + B.X, A.Y + B.Y);

   end "+";

   function "*"
      (A : POINT;
       B : POINT) return POINT is

   -- Multiply two POINTs
   --
   -- A - a POINT
   -- B - a POINT to multiply `A' by (component-wise)

   begin

      return POINT '( A.X * B.X, A.Y * B.Y);

   end "*";

   function "/"
      (A : POINT;
       B : POINT) return POINT is

   -- Divide two POINTs
   --
   -- A - a POINT
   -- B - a POINT to divide `A' by (component-wise)

   begin

      return POINT '( A.X / B.X, A.Y / B.Y);

   end "/";

-- Functions mixing VECTOR and POINT

   function "-"
      (HEAD : POINT;
       TAIL : POINT) return VECTOR is

   -- Subtract two POINTs yielding a VECTOR
   --
   -- A - a displacement POINT
   -- B - a reference POINT to subtract from `A'

   begin

      return VECTOR '( HEAD.X - TAIL.X, HEAD.Y - TAIL.Y);

   end "-";

   function "+"
      (P : POINT;
       V : VECTOR) return POINT is

   -- Add a VECTOR to a POINT yielding a POINT
   --
   -- P - a reference POINT
   -- V - a displacement VECTOR to add to `A'

   begin

      return POINT '( P.X + V.X, P.Y + V.Y);

   end "+";

   function "+"
      (V : VECTOR;
       P : POINT) return POINT is

   -- Add a VECTOR to a POINT yielding a POINT
   --
   -- V - a displacement VECTOR to add to `A'
   -- P - a reference POINT

   begin

      return POINT '( V.X + P.X, V.Y + P.Y);

   end "+";

   function "-"
      (P : POINT;
       V : VECTOR) return POINT is

   -- Subtract a VECTOR from a POINT yielding a POINT
   --
   -- P - a reference POINT
   -- V - a displacement VECTOR to subtract from `A'

   begin

      return POINT '( P.X - V.X, P.Y - V.Y);

   end "-";

   function "-"
      (V : VECTOR;
       P : POINT) return POINT is

   -- Subtract a VECTOR from a POINT yielding a POINT
   --
   -- V - a displacement VECTOR
   -- P - a reference POINT to subtract from `A'

   begin

      return POINT '( V.X - P.X, V.Y - P.Y);

   end "-";

end NDC_POINT_OPS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:CONVERT_NDC_DC_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CONVERT_NDC_DC
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: CONVERT_NDC_DC_MA.ADA
-- Level: ma, 0a

with GKS_TYPES;

use GKS_TYPES;

package CONVERT_NDC_DC is

-- This package performs 2-D coordinate transformations between the NDC
-- and DC coordinate systems.
--
-- In support of levels m and 0, workstation transformations and their
-- inverse transforms are supported for POINT, VECTOR, POINT_ARRAY,
-- RECTANGLE_LIMITS and SIZE types.
--
   type NDC_DC_SCALE_TYPE is private;
   -- NDC_DC_SCALE_TYPE is an abstraction of the workstation
   -- transformation and its inverse transformation.

   subtype WINDOW_TYPE is NDC . RECTANGLE_LIMITS;
   -- WINDOW_TYPE is used to specify the window of the workstation
   -- transformation

   subtype VIEWPORT_TYPE is DC . RECTANGLE_LIMITS;
   -- VIEWPORT_TYPE is used to specify the viewport of the workstation
   -- transformation

   procedure SET_UNIFORM_SCALES
      (WINDOW   :        WINDOW_TYPE;
       VIEWPORT :        VIEWPORT_TYPE;
       SCALE    :    out NDC_DC_SCALE_TYPE);

   function DC_POINT
      (POINT : NDC . POINT;
       SCALE : NDC_DC_SCALE_TYPE) return DC . POINT;

   function DC_POINT_ARRAY
      (POINT_ARRAY : NDC . POINT_ARRAY;
       SCALE       : NDC_DC_SCALE_TYPE) return DC . POINT_ARRAY;

   function DC_RECTANGLE_LIMITS
      (RECTANGLE_LIMITS : NDC . RECTANGLE_LIMITS;
       SCALE            : NDC_DC_SCALE_TYPE)
       return DC . RECTANGLE_LIMITS;

   -- The following functions are for relative scaling only,
   -- not absolute positions

   function DC_VECTOR
      (VECTOR : NDC . VECTOR;
       SCALE  : NDC_DC_SCALE_TYPE) return DC . VECTOR;

   function DC_SIZE
      (SIZE  : NDC . SIZE;
       SCALE : NDC_DC_SCALE_TYPE) return DC . SIZE;

   -- Conversions from DC to NDC

   function NDC_POINT
      (POINT : DC . POINT;
       SCALE : NDC_DC_SCALE_TYPE) return NDC . POINT;

   function NDC_POINT_ARRAY
      (POINT_ARRAY : DC . POINT_ARRAY;
       SCALE       : NDC_DC_SCALE_TYPE) return NDC . POINT_ARRAY;

   function NDC_RECTANGLE_LIMITS
      (RECTANGLE_LIMITS : DC . RECTANGLE_LIMITS;
       SCALE           : NDC_DC_SCALE_TYPE)
       return NDC . RECTANGLE_LIMITS;

   -- The following functions are for relative scaling only,
   -- not absolute positions

   function NDC_VECTOR
      (VECTOR : DC . VECTOR;
       SCALE  : NDC_DC_SCALE_TYPE) return NDC . VECTOR;

   function NDC_SIZE
      (SIZE  : DC . SIZE;
       SCALE : NDC_DC_SCALE_TYPE) return NDC . SIZE;

private

   type NDC_DC_SCALE_TYPE is
      record
         V_SCALE : DC . POINT;
         V_SHIFT : DC . POINT;
         W_SCALE : NDC . POINT;
         W_SHIFT : NDC . POINT;
      end record;
   -- V_SCALE and V_SHIFT are used to transform to DC types.
   -- W_SCALE and W_SHIFT are used to transform to NDC types.

end CONVERT_NDC_DC;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:CONVERT_NDC_DC_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CONVERT_NDC_DC - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: CONVERT_NDC_DC_MA_B.ADA
-- Level: ma, 0a

with DC_POINT_OPS;
with NDC_POINT_OPS;

use DC_POINT_OPS;
use NDC_POINT_OPS;

package body CONVERT_NDC_DC is

-- This package body implements the SCALING and TRANSFORMATION
-- functions used to convert between the NDC and DC coordinate systems.
--
-- Type NDC_DC_SCALE_TYPE contains the ready-to-use scale and shift
-- factors needed to perform the workstation transformation and its
-- inverse.
--

   -- Define index for range arrays

   type LIMIT is (MIN, MAX);

   -- Define a new kind of rectangle which is easier to manipulate,
   -- using NDC_POINT_OPS, than the GKS_COORDINATE_SYSTEM records

   type NDC_RECTANGLE is array (LIMIT) of NDC . POINT;

   type DC_RECTANGLE is array (LIMIT) of DC . POINT;

   --
   -- Define simple conversions
   --

   function NDC_POINT
      (POINT : DC . POINT ) return NDC . POINT;

   -- Convert each coordinate using basic conversion

   function NDC_VECTOR
      (VECTOR : DC . VECTOR ) return NDC . VECTOR;

   -- Convert each coordinate using basic conversion

   function DC_POINT
      (POINT : NDC . POINT ) return DC . POINT;

   -- Convert each coordinate using basic conversion

   function DC_VECTOR
      (VECTOR : NDC . VECTOR ) return DC . VECTOR;

   -- Convert each coordinate using basic conversion

   --
   -- Define scaling conversions
   --

   procedure SET_UNIFORM_SCALES
      (WINDOW   :        WINDOW_TYPE;
       VIEWPORT :        VIEWPORT_TYPE;
       SCALE    :    out NDC_DC_SCALE_TYPE) is

   -- Compute SCALE based on largest image of WINDOW fitting in the
   -- lower-left of VIEWPORT.  This retains the uniform scale factors.
   -- The NDC_DC_SCALE_TYPE is not, itself, restricted to uniform
   -- scaling; it is this procedure which produces restricted values.
   --
   -- WINDOW   - NDC units window of uniform transform
   -- VIEWPORT - DC units viewport of uniform transform
   -- SCALE    - private type holding returned scale values

      -- Get rectangles into two-point form, for readable operations

      W_RECT : NDC_RECTANGLE := NDC_RECTANGLE '(
            NDC . POINT '( WINDOW . XMIN, WINDOW . YMIN),
            NDC . POINT '( WINDOW . XMAX, WINDOW . YMAX));
      -- W_RECT is the window rectangle

      V_RECT : DC_RECTANGLE := DC_RECTANGLE '(
            DC . POINT '( VIEWPORT . XMIN, VIEWPORT . YMIN),
            DC . POINT '( VIEWPORT . XMAX, VIEWPORT . YMAX));
      -- V_RECT is the viewport rectangle

      -- Compute deltas

      W_DELTA : NDC . VECTOR := W_RECT (MAX) - W_RECT (MIN);
      -- W_DELTA is the size of the window

      V_DELTA :  DC . VECTOR := V_RECT (MAX) - V_RECT (MIN);
      -- V_DELTA is the size of the viewport

      W_SCALE : NDC . POINT;
      -- W_SCALE is the scale factors to transform to the window-space

      V_SCALE :  DC . POINT;
      -- V_SCALE is the scale factors to transform to the viewport-space

   begin

      begin

         W_SCALE . X := W_DELTA . X / NDC_TYPE (V_DELTA . X);

      exception

         when others =>

            -- V_DELTA . X may be zero resulting in overflow
            W_SCALE . X := 1.0;

      end;

      begin

         W_SCALE . Y := W_DELTA . Y / NDC_TYPE (V_DELTA . Y);

      exception

         when others =>

            -- V_DELTA . Y may be zero resulting in overflow
            W_SCALE . Y := 1.0;

      end;

      begin

         V_SCALE . X := V_DELTA . X / DC_TYPE (W_DELTA . X);

      exception

         when others =>

            -- W_DELTA . X may be zero resulting in overflow
            V_SCALE . X := 1.0;

      end;

      begin

         V_SCALE . Y := V_DELTA . Y / DC_TYPE (W_DELTA . Y);

      exception

         when others =>

            -- W_DELTA . Y may be zero resulting in overflow
            V_SCALE . Y := 1.0;

      end;

      -- To achieve a uniform scale, the dimension of V_SCALE with the
      -- smaller scale is allowed to dominate the other dimension .

      if V_SCALE . X < V_SCALE . Y then

         -- X scale dominates Y scale
         V_SCALE . Y := V_SCALE . X;

         -- W_SCALE follows V_SCALE proportions
         W_SCALE . Y := W_SCALE . X;

      else

         -- Y scale dominates X scale
         V_SCALE . X := V_SCALE . Y;

         -- W_SCALE follows V_SCALE proportions
         W_SCALE . X := W_SCALE . Y;

      end if;

      SCALE := NDC_DC_SCALE_TYPE' (
         V_SCALE => V_SCALE,
         V_SHIFT => V_RECT (MIN) - V_SCALE * DC_POINT (W_RECT (MIN)),
         W_SCALE => W_SCALE,
         W_SHIFT => W_RECT (MIN) - W_SCALE * NDC_POINT (V_RECT (MIN)));

   end SET_UNIFORM_SCALES;

   -- Define Conversion to DC types

   function DC_POINT
      (POINT  : NDC . POINT;
       SCALE  : NDC_DC_SCALE_TYPE) return DC . POINT  is

   -- Convert POINT to DC units using SCALE factor
   --
   -- POINT - input POINT
   -- SCALE - pre-computed scaling factors

   begin

      return DC_POINT (POINT) * SCALE . V_SCALE + SCALE . V_SHIFT;

   end DC_POINT;

   function DC_POINT_ARRAY
      (POINT_ARRAY : NDC . POINT_ARRAY;
       SCALE       : NDC_DC_SCALE_TYPE) return DC . POINT_ARRAY is

   -- Convert all POINTs in POINT_ARRAY to DC units using SCALE factor
   --
   -- POINT_ARRAY - array of input POINTs
   -- SCALE - pre-computed scaling factors

      POINTS : DC . POINT_ARRAY (POINT_ARRAY'RANGE);
      -- Array to hold converted points

   begin

      for I in POINT_ARRAY'RANGE loop

         POINTS (I) := DC_POINT (POINT_ARRAY (I), SCALE);

      end loop;

      return POINTS;

   end DC_POINT_ARRAY;

   function DC_RECTANGLE_LIMITS
      (RECTANGLE_LIMITS : NDC . RECTANGLE_LIMITS;
       SCALE             : NDC_DC_SCALE_TYPE)
       return DC . RECTANGLE_LIMITS is

   -- Convert RECTANGLE_LIMITS to DC units using SCALE factor
   --
   -- RECTANGLE_LIMITS - input RECTANGLE_LIMITS
   -- SCALE - pre-computed scaling factors

      SX : DC_TYPE renames SCALE . V_SCALE . X;
      SY : DC_TYPE renames SCALE . V_SCALE . Y;
      DX : DC_TYPE renames SCALE . V_SHIFT . X;
      DY : DC_TYPE renames SCALE . V_SHIFT . Y;

   begin

      return DC . RECTANGLE_LIMITS' (
            XMIN => DC_TYPE (RECTANGLE_LIMITS . XMIN) * SX + DX,
            XMAX => DC_TYPE (RECTANGLE_LIMITS . XMAX) * SX + DX,
            YMIN => DC_TYPE (RECTANGLE_LIMITS . YMIN) * SY + DY,
            YMAX => DC_TYPE (RECTANGLE_LIMITS . YMAX) * SY + DY);

      -- RECTANGLE_LIMITS are not compatible with DC_POINT_OPS, so
      -- component-by-component expressions are used.

   end DC_RECTANGLE_LIMITS;

   -- The following functions are for relative scaling only,
   -- not absolute positions

   function DC_VECTOR
      (VECTOR : NDC . VECTOR;
       SCALE  : NDC_DC_SCALE_TYPE) return DC . VECTOR is

   -- Convert VECTOR to DC units using SCALE factor
   --
   -- VECTOR - input VECTOR
   -- SCALE - pre-computed scaling factors

   begin

      return DC_VECTOR (VECTOR) * DC . VECTOR (SCALE . V_SCALE);

   end DC_VECTOR;

   function DC_SIZE
      (SIZE  : NDC . SIZE;
       SCALE : NDC_DC_SCALE_TYPE) return DC . SIZE is

   -- Convert SIZE to DC units using SCALE factor
   --
   -- SIZE - input SIZE
   -- SCALE - pre-computed scaling factors

      SX : DC . MAGNITUDE := DC . MAGNITUDE (abs SCALE . V_SCALE . X);
      -- Scale factor compatible with output type (DC . MAGNITUDE)
      SY : DC . MAGNITUDE := DC . MAGNITUDE (abs SCALE . V_SCALE . Y);
      -- Scale factor compatible with output type (DC . MAGNITUDE)

   begin

      return DC . SIZE' (
         XAXIS => DC . MAGNITUDE (SIZE . XAXIS) * SX,
         YAXIS => DC . MAGNITUDE (SIZE . YAXIS) * SY);

   end DC_SIZE;

   --
   -- Define bodies of simple conversions
   -- It is possible to use UNCHECKED_CONVERSIONS if the element types
   -- are the same.  However, explicit handling of each component is
   -- more general.
   --

   function DC_POINT
      (POINT : NDC . POINT ) return DC . POINT is

   -- Convert `POINT' to an equal `DC . POINT' (no scaling)
   --
   -- POINT - input NDC . POINT

   begin

      return DC . POINT'
         (DC_TYPE (POINT . X), DC_TYPE (POINT . Y));

   end DC_POINT;

   function DC_VECTOR
      (VECTOR : NDC . VECTOR ) return DC . VECTOR is

   -- Convert `VECTOR' to an equal `DC . VECTOR' (no scaling)
   --
   -- VECTOR - input NDC . VECTOR

   begin

      return DC . VECTOR'
            (DC_TYPE (VECTOR . X), DC_TYPE (VECTOR . Y));

   end DC_VECTOR;

   -- Define Conversion to NDC types

   function NDC_POINT
      (POINT : DC . POINT;
       SCALE : NDC_DC_SCALE_TYPE) return NDC . POINT is

   -- Convert POINT to DC units using SCALE factor
   --
   -- POINT - input POINT
   -- SCALE - pre-computed scaling factors

   begin

      return NDC_POINT (POINT) * SCALE . W_SCALE + SCALE . W_SHIFT;

   end NDC_POINT;

   function NDC_POINT_ARRAY
      (POINT_ARRAY  : DC . POINT_ARRAY;
       SCALE       : NDC_DC_SCALE_TYPE) return NDC . POINT_ARRAY is

   -- Convert all POINTs in POINT_ARRAY to NDC units using SCALE factor
   --
   -- POINT_ARRAY - array of input POINTs
   -- SCALE - pre-computed scaling factors

      POINTS : NDC . POINT_ARRAY (POINT_ARRAY'RANGE);
      -- Array to hold converted points

   begin

      for I in POINT_ARRAY'RANGE loop

         POINTS (I) := NDC_POINT (POINT_ARRAY (I),SCALE);

      end loop;
      return POINTS;

   end NDC_POINT_ARRAY;

   function NDC_RECTANGLE_LIMITS
      (RECTANGLE_LIMITS : DC . RECTANGLE_LIMITS;
       SCALE           : NDC_DC_SCALE_TYPE)
       return NDC . RECTANGLE_LIMITS is

   -- Convert RECTANGLE_LIMITS to NDC units using SCALE factor
   --
   -- RECTANGLE_LIMITS - input RECTANGLE_LIMITS
   -- SCALE - pre-computed scaling factors

      SX : NDC_TYPE renames SCALE . W_SCALE . X;
      SY : NDC_TYPE renames SCALE . W_SCALE . Y;
      DX : NDC_TYPE renames SCALE . W_SHIFT . X;
      DY : NDC_TYPE renames SCALE . W_SHIFT . Y;

   begin

      return NDC . RECTANGLE_LIMITS' (
            XMIN => NDC_TYPE (RECTANGLE_LIMITS . XMIN) * SX + DX,
            XMAX => NDC_TYPE (RECTANGLE_LIMITS . XMAX) * SX + DX,
            YMIN => NDC_TYPE (RECTANGLE_LIMITS . YMIN) * SY + DY,
            YMAX => NDC_TYPE (RECTANGLE_LIMITS . YMAX) * SY + DY);

      -- RECTANGLE_LIMITS are not compatible with DC_POINT_OPS, so
      -- component-by-component expressions are used.

   end NDC_RECTANGLE_LIMITS;

   -- The following functions are for relative scaling only,
   -- not absolute positions

   function NDC_VECTOR
      (VECTOR : DC . VECTOR;
       SCALE  : NDC_DC_SCALE_TYPE) return NDC . VECTOR is

   -- Convert VECTOR to NDC units using SCALE factor
   --
   -- VECTOR - input VECTOR
  -- SCALE - pre-computed scaling factors

   begin

      return NDC_VECTOR (VECTOR) * NDC . VECTOR (SCALE . W_SCALE);

   end NDC_VECTOR;

   function NDC_SIZE
      (SIZE  : DC . SIZE;
       SCALE : NDC_DC_SCALE_TYPE) return NDC . SIZE is

   -- Convert SIZE to NDC units using SCALE factor
   --
   -- SIZE - input SIZE
   -- SCALE - pre-computed scaling factors

      SX : NDC . MAGNITUDE := NDC . MAGNITUDE (abs SCALE . W_SCALE . X);
      -- Scale factor compatible with output type (NDC . MAGNITUDE)
      SY : NDC . MAGNITUDE := NDC . MAGNITUDE (abs SCALE . W_SCALE . Y);
      -- Scale factor compatible with output type (NDC . MAGNITUDE)

   begin

      return NDC . SIZE' (
            XAXIS => NDC . MAGNITUDE (SIZE . XAXIS) * SX,
            YAXIS => NDC . MAGNITUDE (SIZE . YAXIS) * SY);

   end NDC_SIZE;

   -- Define bodies of simple conversions
   -- It is possible to use UNCHECKED_CONVERSIONS if the element types
   -- are the same .   However, explicit handling of each component is
   -- more general .

   function NDC_POINT
      (POINT : DC . POINT ) return NDC . POINT is

   -- Convert `POINT' to an equal `NDC . POINT' (no scaling)
   --
   -- POINT - input DC . POINT

   begin

      return NDC . POINT'
            (NDC_TYPE (POINT . X), NDC_TYPE (POINT . Y));

   end NDC_POINT;

   function NDC_VECTOR
      (VECTOR : DC . VECTOR ) return NDC . VECTOR is

   -- Convert `VECTOR' to an equal `NDC . VECTOR' (no scaling)
   --
   -- VECTOR - input DC . VECTOR

   begin

      return NDC . VECTOR'
            (NDC_TYPE (VECTOR . X), NDC_TYPE (VECTOR . Y));

   end NDC_VECTOR;

end CONVERT_NDC_DC;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WS_ST_LST_TYP_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-- file:  ws_st_lst_typ_ma.ada
-- level: ma

with GKS_TYPES;
with OUTPUT_ATTRIBUTES_TYPE;
with WS_TABLE_TYPES;
with CONVERT_NDC_DC;

use GKS_TYPES;

package WS_STATE_LIST_TYPES is

   subtype CLR_INDEX  is COLOUR_INDEX     range 0 .. 127;
   -- The preceding subtype was declared so as not to raise a
   -- STORAGE ERROR at execution time.  The upper bound was chosen
   -- for the present implementation.  CLR_INDEX could be changed
   -- to support a larger colour table for other devices.

   type WS_STATE_LST
          (NUM_COLOUR_REPRESENTATION : CLR_INDEX := 0) is record

      -- The following is a copy of a subset of the GKS_STATE_LIST.
      OUTPUT_ATTR                     : OUTPUT_ATTRIBUTES_TYPE.
                                           OUTPUT_ATTRIBUTES;

      -- The application programmer's ID for a workstation.
      WORKSTATION_ID                  : WS_ID;

      -- The physical connection to the device.
      -- CONNECTION_ID must have default value to remain unconstrained
      CONNECT_ID                      : VARIABLE_CONNECTION_ID;

      -- The workstation category from the WS_DESCRIPTION_TABLE.
      WORKSTATION_CATEGORY            : WS_CATEGORY;

      -- The type of workstation.
      WORKSTATION_TYPE                : WS_TYPE;

      -- The workstation state, active or inactive.
      WS_STATE                        : GKS_TYPES.WS_STATE;

      -- Used for the deferral of output.
      WS_DEFERRAL_MODE                : DEFERRAL_MODE;

      -- Used to SUPPRESS or ALLOW implicit regeneration.
      WS_IMPLICIT_REGEN_MODE          : REGENERATION_MODE;

      -- Used to tell whether the display surface is EMPTY or not.
      WS_DISPLAY_SURFACE              : DISPLAY_SURFACE_EMPTY := EMPTY;

      -- Used to identify if a picture needs an implicit regeneration.
      WS_NEW_FRAME_ACTION             : NEW_FRAME_NECESSARY := NO;

      -- color table

      SET_OF_COLOUR_IDC          : COLOUR_INDICES.LIST_OF;
      COLOUR_TABLE               : WS_TABLE_TYPES.COLOUR_TABLE_LIST
                                       (0 .. NUM_COLOUR_REPRESENTATION);

      -- transformations

      -- Tells whether an update of the workstation transformation is
      -- needed.
      WS_XFORM_UPDATE_STATE      : UPDATE_STATE := NOTPENDING;

      -- The value to which the CURRENT_WS_WINDOW is set.
      REQUESTED_WS_WINDOW        : NDC.RECTANGLE_LIMITS :=
                                       (0.0, 1.0, 0.0, 1.0);

      -- The current workstation window.
      CURRENT_WS_WINDOW          : NDC.RECTANGLE_LIMITS :=
                                       (0.0, 1.0, 0.0, 1.0);

      -- The value to which the CURRENT_WS_VIEWPORT is set.
      REQUESTED_WS_VIEWPORT      : DC.RECTANGLE_LIMITS :=
                                       (0.0, 1.0, 0.0, 1.0);

      -- The current workstation viewport.
      CURRENT_WS_VIEWPORT        : DC.RECTANGLE_LIMITS :=
                                       (0.0, 1.0, 0.0, 1.0);

      -- clipping rectangle

      -- The computed clipping rectangle from the CURRENT_CLIPPING_
      -- RECTANGLE plus the CURRENT_WS_WINDOW.

      EFFECTIVE_CLIPPING_RECTANGLE : DC.RECTANGLE_LIMITS :=
                                        (0.0, 1.0, 0.0, 1.0);

      -- The following attributes are computed from the attributes
      -- in the GKS_STATE_LIST and the bundles in the WS_STATE_LIST
      -- depending on whether an ASF is BUNDLE or INDIVIDUAL.

      EFFECTIVE_POLYLINE_ATTR   : WS_TABLE_TYPES.POLYLINE_BUNDLE;

      EFFECTIVE_POLYMARKER_ATTR : WS_TABLE_TYPES.POLYMARKER_BUNDLE;

      EFFECTIVE_TEXT_ATTR       : WS_TABLE_TYPES.TEXT_BUNDLE;

      EFFECTIVE_FILL_AREA_ATTR  : WS_TABLE_TYPES.FILL_AREA_BUNDLE;

      -- The following is computed from the WS window and WS viewport
      -- and stored for easy access by the WS DRIVER.

      WS_TRANSFORM              : CONVERT_NDC_DC.NDC_DC_SCALE_TYPE;

   end record;

   type WS_STATE_LIST_PTR is access WS_STATE_LST;

end WS_STATE_LIST_TYPES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI3700_TBLS_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-- file : LEXI3700_TBLS_MA.ADA
-- level: ma

with OUTPUT_ATTRIBUTES_TYPE;
with WS_STATE_LIST_TYPES;
with WS_DESCRIPTION_TABLE_TYPES;
with GKS_TYPES;

use  GKS_TYPES;

package LEXI3700_WS_TABLES is

-- This package contains the specific WS_DESCRIPTION_TABLE and the list
-- of WS_STATE_LIST.  It also contains a function for retrieving a
-- pointer to a WS_STATE_LIST and a procedure that initializes a
-- WS_STATE_LIST and adds it to the list.  This package is used by
-- the WS driver.
-- The following packages are 'withed' for the following reasons:
-- The OUTPUT_ATTRIBUTES_TYPE package is the output attributes from
-- the GKS_STATE_LIST that are passed down as a parameter for the
-- workstation to keep track of.
-- The WS_STATE_LIST_TYPES package is used as a template to create a
-- new WS_STATE_LIST.
-- The WS_DESCRIPTION_TABLES_TYPES package is used as a template to
-- initialize LEXI3700_WS_DT.
-- The LEXI3700_CONFIGURATION package gives the capabilities of the
-- device to initialize LEXI3700_WS_DT.

   LEXI3700_WS_DT : WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL
      (NUM_PREDEFINED_PLIN_BUNDLE       => 0,
       NUM_PREDEFINED_PMRK_BUNDLE       => 0,
       NUM_PREDEFINED_TEXT_BUNDLE       => 0,
       NUM_PREDEFINED_FA_BUNDLE         => 0,
       NUM_PREDEFINED_PATTERN_TABLE     => 0,
       LAST_PREDEFINED_COLOUR_REP       => 7,
       NUM_OF_GDP_ID                    => 1);

   function GET_STATE_LIST_PTR
      (WS_ID : in GKS_TYPES.WS_ID) return
            WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;

   procedure ADD_STATE_LIST_TO_LIST
      (WS_ID          : in GKS_TYPES.WS_ID;
       CONNECT_ID     : in VARIABLE_CONNECTION_ID;
       WS_TYPE        : in GKS_TYPES.WS_TYPE;
       ATTRIBUTES     : in OUTPUT_ATTRIBUTES_TYPE
                           .OUTPUT_ATTRIBUTES;
       EI             : out ERROR_INDICATOR);

   procedure DELETE_STATE_LIST_FROM_LIST
      (WS_ID : in GKS_TYPES.WS_ID);

end LEXI3700_WS_TABLES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI_UTILITIES.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI_UTILITIES
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: LEXI_UTILITIES.ADA
-- LEVEL : MA

with GKS_TYPES;
with LEXI3700_TYPES;

use GKS_TYPES;
use LEXI3700_TYPES;

package LEXI_UTILITIES is

-- This package contains utility functions specific to the LEXIDATA 3700

   function IDC
      (SINGLE_POINT : DC.POINT) return LEXI_POINT;

   function IDC
      (POINT_LIST  : DC.POINT_ARRAY) return LEXI_POINTS;

end LEXI_UTILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI_UTILITIES_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI_UTILITIES - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: LEXI_UTILITIES_B.ADA
-- LEVEL : ma

with LEXI3700_WS_TABLES;

package body LEXI_UTILITIES is

   function IDC
      (POINT_LIST  : DC.POINT_ARRAY) return LEXI_POINTS is

   -- This function transforms coordinates from DC space to Integer
   -- Device Coordinates. It changes from a float type to an integer
   -- type. It also inverts the Y coordinates so that the origin is in
   -- the upper left corner of IDC instead of the lower left corner of
   -- DC. The first index of the array returned by this function will
   -- be 1 regardless of the indices of the array it received.
   --
   -- POINT_LIST is the list of points in DC to be converted to IDC.

   SCREEN_SIZE : RASTER_UNIT_SIZE;
   -- Contains the maximum X and Y dimensions on the Lexidata screen.

   IDC_POINTS : LEXI_POINTS(1 .. POINT_LIST'LENGTH);
   -- Contains the device coordinate points to be returned.

   IDC_COUNT : POSITIVE := 1;
   -- This is the index into the IDC_POINTS array. The value returned
   -- is guarenteed to begin at index #1.

   begin

      -- Assign to SCREEN_SIZE the value found in the description table.
      SCREEN_SIZE := LEXI3700_WS_TABLES.LEXI3700_WS_DT.
         MAX_DISPLAY_SURFACE_RASTER_UNITS;

      -- Repeat with each of the points in the input.
      for DC_COUNT in POINT_LIST'RANGE loop

         -- Convert the X coordinate of the point to an integer.
         IDC_POINTS(IDC_COUNT).X :=
            LEXI_COORDINATE(POINT_LIST(DC_COUNT).X);

         -- Invert the Y coordinate and convert it to an integer.
         IDC_POINTS(IDC_COUNT).Y := LEXI_COORDINATE
            (DC_TYPE(SCREEN_SIZE.Y) - POINT_LIST(DC_COUNT).Y -
             DC_TYPE'(1.0));

         IDC_COUNT := IDC_COUNT + 1;

      end loop;

      return IDC_POINTS;

   end IDC;

   function IDC
      (SINGLE_POINT : DC.POINT) return LEXI_POINT is

   -- This function transforms coordinates from DC space to Integer
   -- Device Coordinates. It changes from a float type to an integer
   -- type. It also inverts the Y coordinate so that the origin is in
   -- the upper left corner of IDC instead of the lower left corner of
   -- DC.
   --
   -- SINGLE_POINT is the point in DC to be converted to IDC.

   IDC_POINT : LEXI_POINT;
   -- Contains the device coordinate point to be returned.

   SCREEN_SIZE : RASTER_UNIT_SIZE;
   -- Contains the maximum X and Y dimensions on the Lexidata screen.

   begin

      -- Assign to SCREEN_SIZE the value found in the description table.
      SCREEN_SIZE := LEXI3700_WS_TABLES.LEXI3700_WS_DT.
         MAX_DISPLAY_SURFACE_RASTER_UNITS;

      -- Convert the X coordinate of the point to an integer.
      IDC_POINT.X := LEXI_COORDINATE(SINGLE_POINT.X);

      -- Invert the Y coordinate and convert it to an integer.
      IDC_POINT.Y := LEXI_COORDINATE
         (DC_TYPE(SCREEN_SIZE.Y) - SINGLE_POINT.Y - DC_TYPE'(1.0));

      return IDC_POINT;

   end IDC;

end LEXI_UTILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI_OUT_PRIM_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_OUTPUT_PRIMITIVES
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  Not listed
------------------------------------------------------------------
-- FILE  : LEXI3700_OUT_PRIM.ADA
-- LEVEL : MA - 0A

with CGI;
with GKS_TYPES;
with WS_STATE_LIST_TYPES;

use  CGI;
use  GKS_TYPES;

package LEXI3700_OUTPUT_PRIMITIVES is

-- This package contains four output primitive procedures
-- for the Lexidata 3700 output device.

   procedure POLYLINE
      (WS_SL       : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       LINE_POINTS : ACCESS_POINT_ARRAY_TYPE);

   procedure POLYMARKER
      (WS_SL         : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       MARKER_POINTS : ACCESS_POINT_ARRAY_TYPE);

   procedure FILL_AREA
      (WS_SL            : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       FILL_AREA_POINTS : ACCESS_POINT_ARRAY_TYPE);

   procedure TEXT
      (WS_SL         : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       TEXT_POSITION : NDC.POINT;
       TEXT_STRING   : ACCESS_STRING_TYPE);

end LEXI3700_OUTPUT_PRIMITIVES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_PRIM_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_SET_PRIMITIVE_ATTRIBUTES_MA
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_PRIM_MA.ADA
-- level: ma,0a,1a,2a

with GKS_TYPES;
with WS_STATE_LIST_TYPES;
with WS_DESCRIPTION_TABLE_TYPES;

use  GKS_TYPES;

package WSR_SET_PRIMITIVE_ATTRIBUTES_MA is

-- This package is a workstation resource package.  It can be used by
-- any workstation that needs to have the primitive attributes changed
-- in its workstation state list.

   procedure SET_CHAR_VECTORS
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       CHAR_HEIGHT_VECTOR : in NDC.VECTOR;
       CHAR_WIDTH_VECTOR  : in NDC.VECTOR);

   procedure SET_TEXT_ALIGNMENT
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       ALIGNMENT : in TEXT_ALIGNMENT);

end WSR_SET_PRIMITIVE_ATTRIBUTES_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_PRIM_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_SET_PRIMITIVE_ATTRIBUTES_MA - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_PRIM_MA_B.ADA
-- level: ma,0a,1a,2a

package body WSR_SET_PRIMITIVE_ATTRIBUTES_MA is

-- The following procedures set the value specified by the parameter
-- in the WS_STATE_LIST.

   procedure SET_CHAR_VECTORS
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       CHAR_HEIGHT_VECTOR : in NDC.VECTOR;
       CHAR_WIDTH_VECTOR  : in NDC.VECTOR) is separate;

   procedure SET_TEXT_ALIGNMENT
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       ALIGNMENT : in TEXT_ALIGNMENT) is separate;

end WSR_SET_PRIMITIVE_ATTRIBUTES_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_CHAR_VECS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_CHAR_VECTORS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_CHAR_VECS.ADA
-- level: ma,0a,1a,2a

separate (WSR_SET_PRIMITIVE_ATTRIBUTES_MA)

procedure SET_CHAR_VECTORS
   (WS_ST_LST      : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    CHAR_HEIGHT_VECTOR : in NDC.VECTOR;
    CHAR_WIDTH_VECTOR  : in NDC.VECTOR) is

-- The CURRENT_HEIGHT_VECTOR and CURRENT_WIDTH_VECTOR entries in the
-- OUTPUT_ATTR record in the WS_STATE_LIST_TYPES package is set to
-- the values specified by the parameters.
--
-- The following parameters are used in this procedure :
-- WS_ST_LST - The specified WS_STATE_LIST to set the value on.
-- CHAR_HEIGHT_VECTOR - the upward direction that the character takes,
--                      as well as the height of the character.
-- CHAR_WIDTH_VECTOR - the vector in a 90 degree direction with the
--                     character height.  Also gives the width of the
--                     character.

begin

   WS_ST_LST.OUTPUT_ATTR.CURRENT_CHAR_HEIGHT_VECTOR :=
         CHAR_HEIGHT_VECTOR;

   WS_ST_LST.OUTPUT_ATTR.CURRENT_CHAR_WIDTH_VECTOR :=
         CHAR_WIDTH_VECTOR;

end SET_CHAR_VECTORS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_TEXT_AL.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_TEXT_ALIGNMENT
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_TEXT_AL.ADA
-- level: ma - 2a

separate (WSR_SET_PRIMITIVE_ATTRIBUTES_MA)

procedure SET_TEXT_ALIGNMENT
   (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    ALIGNMENT : in TEXT_ALIGNMENT) is

-- The CURRENT_TEXT_ALIGNMENT entry in the OUTPUT_ATTR record in the
-- WS_STATE_LIST_TYPES package is set to the value specified by the
-- parameter.
--
-- The following parameters are used in this procedure :
-- WS_ST_LST - The specified WS_STATE_LIST to set the value on.
-- TEXT_ALIGNMENT - the position where the text should line up for
--                  the starting (x, y) value. (i.e. (top,right),
--                  (normal,normal), or (centre, top) )

begin

   WS_ST_LST.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT := ALIGNMENT;

end SET_TEXT_ALIGNMENT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_INDV_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_SET_INDIVIDUAL_ATTRIBUTES_MA
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_INDV_MA.ADA
-- level: ma,0a,1a,2a

with GKS_TYPES;
with WS_STATE_LIST_TYPES;
with WS_DESCRIPTION_TABLE_TYPES;

use GKS_TYPES;

package WSR_SET_INDIVIDUAL_ATTRIBUTES_MA is

-- This package is used by any workstation driver that needs to have
-- the individual attributes changed in its workstation state list.
-- The procedures first change the entry in the specified workstation
-- state list then they compute the EFFECTIVE ATTRIBUTES.  The EFFECTIVE
-- ATTRIBUTES are the attributes the primitives use when being output.
-- They are the combination of BUNDLED and INDIVIDUAL attributes stored
-- in a common place.  The EFFECTIVE ATTRIBUTES are an implementation
-- dependent feature used to optimize the output of primitives.

   procedure SET_LINETYPE
      (WS_ST_LST    : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       WS_DSCR_TBL  : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       LINE         : in out LINETYPE);

   procedure SET_POLYLINE_COLOUR_INDEX
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       COLOUR    : in COLOUR_INDEX);

   procedure SET_MARKER_TYPE
      (WS_ST_LST    : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       WS_DSCR_TBL  : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       MARKER       : in out MARKER_TYPE);

   procedure SET_POLYMARKER_COLOUR_INDEX
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       COLOUR    : in COLOUR_INDEX);

   procedure SET_TEXT_COLOUR_INDEX
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       COLOUR    : in COLOUR_INDEX);

   procedure SET_FILL_AREA_INTERIOR_STYLE
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       STYLE     : in INTERIOR_STYLE);

   procedure SET_FILL_AREA_COLOUR_INDEX
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       COLOUR    : in COLOUR_INDEX);

end WSR_SET_INDIVIDUAL_ATTRIBUTES_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_INDV_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_SET_INDIVIDUAL_ATTRIBUTES_MA - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_INDV_MA_B.ADA
-- level: ma,0a,1a,2a

package body WSR_SET_INDIVIDUAL_ATTRIBUTES_MA is

-- The following procedures set the value specified by the parameter
-- in the WS_STATE_LIST.  Some of the attributes chosen may not be
-- supported on a particular device.  This resource package only
-- checks the attributes that GKS defines to have a default value if
-- its not supported and will set it to the default value if not
-- supported.  The other attributes not having a default value but
-- defined as being implimentation dependent by GKS are set to the value
-- chosen by the application programmer.  The converting to a supported
-- value is left to the implementor of a WS DRIVER.

   procedure SET_LINETYPE
      (WS_ST_LST   : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       LINE        : in out LINETYPE) is separate;

   procedure SET_POLYLINE_COLOUR_INDEX
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       COLOUR    : in COLOUR_INDEX) is separate;

   procedure SET_MARKER_TYPE
      (WS_ST_LST   : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       MARKER      : in out MARKER_TYPE) is separate;

   procedure SET_POLYMARKER_COLOUR_INDEX
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       COLOUR    : in COLOUR_INDEX) is separate;

   procedure SET_TEXT_COLOUR_INDEX
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       COLOUR    : in COLOUR_INDEX) is separate;

   procedure SET_FILL_AREA_INTERIOR_STYLE
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       STYLE     : in INTERIOR_STYLE) is separate;

   procedure SET_FILL_AREA_COLOUR_INDEX
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       COLOUR    : in COLOUR_INDEX) is separate;

end WSR_SET_INDIVIDUAL_ATTRIBUTES_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_LINETYPE.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_LINETYPE
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_LINETYPE.ADA
-- level: ma,0a,1a,2a

separate (WSR_SET_INDIVIDUAL_ATTRIBUTES_MA)

procedure SET_LINETYPE
   (WS_ST_LST   : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
    LINE        : in out LINETYPE) is

-- The CURRENT_LINETYPE entry in the WS_STATE_LIST in the record
-- OUTPUT_ATTR is set to the value specified by the parameter. If
-- the value of the ASF is set to INDIVIDUAL the L_TYPE entry in the
-- EFFECTIVE_POLYLINE_ATTR is also set to the value specified
-- by the parameter.
--
-- The following parameters are used in this procedure:
-- WS_ST_LST - The WS_STATE_LIST to set the LINE_TYPE on.
-- WS_DSCR_TBL - The WS description table describing the specified
--               device.
-- LINE - the style line to be used.

begin

   if LINETYPES.IS_IN_LIST
          (LINE, WS_DSCR_TBL.LIST_AVAILABLE_LTYPE) then
      WS_ST_LST.OUTPUT_ATTR.CURRENT_LINETYPE := LINE;
   else
      -- If the line type is not supported on the specified workstation
      -- the GKS SPECIFICATION requires that the default be linetype 1;
      LINE := 1;
      WS_ST_LST.OUTPUT_ATTR.CURRENT_LINETYPE := LINE;
   end if;

   -- The following checks the ASF to set if it is set to INDIVIDUAL.
   if WS_ST_LST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS.LINETYPE =
                                                        INDIVIDUAL then
      WS_ST_LST.EFFECTIVE_POLYLINE_ATTR.L_TYPE := LINE;
   end if;

end SET_LINETYPE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_PLIN_CLR_IDX.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_POLYLINE_COLOUR_INDEX
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_PLIN_CLR_IDX.ADA
-- level: ma - 2a

separate (WSR_SET_INDIVIDUAL_ATTRIBUTES_MA)

procedure SET_POLYLINE_COLOUR_INDEX
   (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    COLOUR    : in COLOUR_INDEX) is

-- The CURRENT_POLYLINE_COLOUR_INDEX  entry in the WS_STATE_LIST in the
-- OUTPUT_ATTR record is  set to the value specified by the parameter.
-- It only affects the display of subsequent POLYLINES if
-- its ASF is set to INDIVIDUAL.
--
-- The following parameters are used in this procedure:
-- WS_ST_LST - The specified WS_STATE_LIST to set the value on.
-- COLOUR - The specified colour to be used.

begin

   WS_ST_LST.OUTPUT_ATTR.CURRENT_POLYLINE_COLOUR_INDEX := COLOUR;

   -- The following checks the ASF to see if it is set to INDIVIDUAL.
   -- If it is, the entry COLOUR in EFFECTIVE_POLYLINE_ATTR will be
   -- set to the value specified by the parameter.

   if WS_ST_LST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .LINE_COLOUR = INDIVIDUAL then

      WS_ST_LST.EFFECTIVE_POLYLINE_ATTR.COLOUR := COLOUR;

   end if;

end SET_POLYLINE_COLOUR_INDEX;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_PMRK_CLR_IDX.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_POLYMARKER_COLOUR_INDEX
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_PMRK_CLR_IDX.ADA
-- level: ma - 2a

separate (WSR_SET_INDIVIDUAL_ATTRIBUTES_MA)

procedure SET_POLYMARKER_COLOUR_INDEX
   (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    COLOUR    : in COLOUR_INDEX) is

-- The CURRENT_POLYMARKER_COLOUR_INDEX entry in the WS_STATE_LIST in the
-- OUTPUT_ATTR record is  set to the value specified by the parameter.
-- It only affects the display of subsequent POLYMARKERS if
-- its ASF is set to INDIVIDUAL.
--
-- The following parameters are used in this procedure:
-- WS_ST_LST - The specified WS_STATE_LIST to set the value on.
-- COLOUR - the specified colour to be used.

begin

   WS_ST_LST.OUTPUT_ATTR.CURRENT_POLYMARKER_COLOUR_INDEX := COLOUR;

   -- The following checks the ASF to see if it is set to INDIVIDUAL.
   -- If it is, the entry COLOUR in EFFECTIVE_POLYMARKER_ATTR is
   -- set to the value specified by the parameter.

   if WS_ST_LST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .MARKER_COLOUR = INDIVIDUAL then

      WS_ST_LST.EFFECTIVE_POLYMARKER_ATTR.COLOUR := COLOUR;

   end if;

end SET_POLYMARKER_COLOUR_INDEX;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_TEXT_CLR_IDX.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_TEXT_COLOUR_INDEX
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_TEXT_CLR_IDX.ADA
-- level: ma - 2a

separate (WSR_SET_INDIVIDUAL_ATTRIBUTES_MA)

procedure SET_TEXT_COLOUR_INDEX
   (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    COLOUR    : in COLOUR_INDEX) is

-- The CURRENT_TEXT_COLOUR_INDEX entry in the WS_STATE_LIST in the
-- OUTPUT_ATTR record is  set to the value specified by the parameter.
-- If only affects the display of subsequent TEXT if its ASF is set to
-- INDIVIDUAL.
--
-- The following parameters are used in this procedure:
-- WS_ST_LST - The specified WS_STATE_LIST to set the value on.
-- COLOUR  - the specified colour to be used.

begin

   WS_ST_LST.OUTPUT_ATTR.CURRENT_TEXT_COLOUR_INDEX := COLOUR;

   -- The following checks the ASF to see if it is set to INDIVIDUAL.
   -- If it is, the entry COLOUR in EFFECTIVE_TEXT_ATTR is
   -- set to the value specified by the parameter.

   if WS_ST_LST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .TEXT_COLOUR = INDIVIDUAL then

      WS_ST_LST.EFFECTIVE_TEXT_ATTR.COLOUR := COLOUR;

   end if;

end SET_TEXT_COLOUR_INDEX;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_FA_INT_STY.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_FILL_AREA_INTERIOR_STYLE
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_FA_INT_STY.ADA
-- level: ma - 2a

separate (WSR_SET_INDIVIDUAL_ATTRIBUTES_MA)

procedure SET_FILL_AREA_INTERIOR_STYLE
   (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    STYLE     : in INTERIOR_STYLE) is

-- The CURRENT_FILL_AREA_INTERIOR_STYLE entry in the WS_STATE_LIST in
-- the OUTPUT_ATTR record is set to the value specified by the
-- parameter.  It only affects the display of subsequent FILL_AREAs
-- if its ASF is set to INDIVIDUAL.
--
-- The following parameters are used in this procedure:
-- WS_ST_LST - The specified WS_STATE_LIST to set the value on.
-- STYLE - the specified intrior style to be used.

begin

   WS_ST_LST.OUTPUT_ATTR.CURRENT_FILL_AREA_INTERIOR_STYLE := STYLE;

   -- The following checks the ASF to see if it is set to INDIVIDUAL.
   -- If it is, the entry INT_STYLE in EFFECTIVE_FILL_AREA_ATTR is
   -- set to the value specified by the parameter.

   if WS_ST_LST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .INTERIOR_STYLE = INDIVIDUAL then

      WS_ST_LST.EFFECTIVE_FILL_AREA_ATTR.INT_STYLE := STYLE;

   end if;

end SET_FILL_AREA_INTERIOR_STYLE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_FA_CLR_IDX.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_FILL_AREA_COLOUR_INDEX
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_FA_CLR_IDX.ADA
-- level: ma - 2a

separate (WSR_SET_INDIVIDUAL_ATTRIBUTES_MA)

procedure SET_FILL_AREA_COLOUR_INDEX
   (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    COLOUR    : in COLOUR_INDEX) is

-- The CURRENT_FILL_AREA_COLOUR_INDEX entry in the WS_STATE_LIST in the
-- OUTPUT_ATTR record is set to the value specified by the parameter.
-- It only affects the display of subsequent FILL_AREAS if
-- its ASF is set to INDIVIDUAL.
--
-- The following parameters are used in this procedure:
-- WS_ST_LST - The specified WS_STATE_LIST to set the value on.
-- COLOUR - the specified colour to be used.

begin

   WS_ST_LST.OUTPUT_ATTR.CURRENT_FILL_AREA_COLOUR_INDEX := COLOUR;

   -- The following checks the ASF to see if it is set to INDIVIDUAL.
   -- If it is, the entry COLOUR in EFFECTIVE_FILL_AREA_ATTR is
   -- set to the value specified by the parameter.

   if WS_ST_LST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .FILL_AREA_COLOUR = INDIVIDUAL then

      WS_ST_LST.EFFECTIVE_FILL_AREA_ATTR.COLOUR := COLOUR;

   end if;

end SET_FILL_AREA_COLOUR_INDEX;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_MARK_TYPE.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_MARKER_TYPE
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
-----------------------------------------------------------------
-- file: WSR_SET_MARK_TYPE.ADA
-- level: ma - 2a

separate (WSR_SET_INDIVIDUAL_ATTRIBUTES_MA)

procedure SET_MARKER_TYPE
   (WS_ST_LST   : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
    MARKER      : in out MARKER_TYPE) is

-- The CURRENT_MARKER_TYPE  entry in the WS_STATE_LIST in the
-- OUTPUT_ATTR record is  set to the value specified by the parameter.
-- It only affects the display of subsequent POLYMARKERS if
-- its ASF is set to INDIVIDUAL.
--
-- The following parameters are used in this procedure:
-- WS_ST_LST - The specified WS_STATE_LIST to set the value on.
-- MARKER - the specified polymarker to be used.

begin

   if MARKER_TYPES.IS_IN_LIST
         (MARKER, WS_DSCR_TBL.LIST_AVAILABLE_MARKER_TYPES) then

      WS_ST_LST.OUTPUT_ATTR.CURRENT_MARKER_TYPE := MARKER;

   else

      -- If the specified polymarker is not supported on the specified
      -- workstation the GKS SPECIFICATION defines marker type 3 must
      -- be used.
      MARKER := 3;
      WS_ST_LST.OUTPUT_ATTR.CURRENT_MARKER_TYPE := MARKER;

   end if;

   -- The following checks the ASF to see if it is set to INDIVIDUAL.
   -- If it is, the entry M_TYPE in EFFECTIVE_POLYMARKER_ATTR will be
   -- set to the value specified by the parameter.

   if WS_ST_LST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS.MARKER_TYPE =
         INDIVIDUAL then

      WS_ST_LST.EFFECTIVE_POLYMARKER_ATTR.M_TYPE := MARKER;

   end if;

end SET_MARKER_TYPE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_WS_XFORM.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_WS_TRANSFORMATION
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File:  WSR_WS_XFORM.ADA
-- Level: MA

with GKS_TYPES;
with WS_STATE_LIST_TYPES;

use GKS_TYPES;

package WSR_WS_TRANSFORMATION is

-- This package, WSR_WS_TRANSFORMATION, provides two procedures to
-- process requests to specify the Workstation Transformation, and
-- one procedure to update the workstation transformation.
--
-- Packages GKS_TYPES and WS_STATE_LIST_TYPES provide type definitions
-- for procedure parameters.  Note that packages NDC and DC are from the
-- GKS_TYPES package and are instantiations of the GKS_COORDINATE_SYSTEM
-- package.

   procedure SET_WS_WINDOW
      (DYNAMIC_MODIFICATION : in     GKS_TYPES . DYNAMIC_MODIFICATION;
       WS_SL     : in     WS_STATE_LIST_TYPES . WS_STATE_LIST_PTR;
       WS_WINDOW : in     NDC . RECTANGLE_LIMITS);

   procedure SET_WS_VIEWPORT
      (DYNAMIC_MODIFICATION : in     GKS_TYPES . DYNAMIC_MODIFICATION;
       WS_SL       : in     WS_STATE_LIST_TYPES . WS_STATE_LIST_PTR;
       WS_VIEWPORT : in     DC . RECTANGLE_LIMITS);

   procedure UPDATE_WS_TRANSFORMATION
      (WS_SL     : in     WS_STATE_LIST_TYPES . WS_STATE_LIST_PTR);

end WSR_WS_TRANSFORMATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_WS_XFORM_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_WS_TRANSFORMATION - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File:  WSR_WS_XFORM_B.ADA
-- Level: MA, 0A

package body WSR_WS_TRANSFORMATION is

   procedure SET_WS_WINDOW
      (DYNAMIC_MODIFICATION : in     GKS_TYPES . DYNAMIC_MODIFICATION;
       WS_SL     : in     WS_STATE_LIST_TYPES . WS_STATE_LIST_PTR;
       WS_WINDOW : in     NDC . RECTANGLE_LIMITS) is

   --     The overall function of SET_WS_WINDOW is to update the WS_SL
   -- to reflect the new WS_WINDOW of the Workstation Transformation.
   -- For efficiency's sake additional transformation matrices have been
   -- included in the WS_SL for use by the Workstation Driver. These
   -- must also be updated. In the same vein, an Effective Clipping
   -- Rectangle is computed. All of these efficiency measures are
   -- handled by the UPDATE_TRANSFORMATION subprogram.
   --
   -- Components of the WS_SL affected are as follows:
   -- REQUESTED_WS_WINDOW, WS_XFORM_UPDATE_STATE, WS_NEW_FRAME_ACTION,
   -- If UPDATE_TRANSFORMATION is called, then CURRENT_WS_WINDOW is set
   -- and additional calculations are done for updating the
   -- transformations and clipping rectangles.
   --
   -- DYNAMIC_MODIFICATION - specifies whether to update the CURRENT
   --       transformation immediately (IMM), or to cause an implicit
   --       regeneration (IRG).
   -- WS_SL - is the Workstation State List of the Workstation Driver.
   -- WS_WINDOW - specifies the Workstation Transformation window limits
   --       requested.
   --
   -- A note on the DYNAMIC_MODIFICATION parameter:  This should be
   -- equal to the value of the Workstation Description Table component
   -- WS_DYNAMICS . WS_TRANSFORMATION, but there are two ways for this
   -- to occur: 1) the Driver is written with a constant and the
   -- Workstation Description Table is defined in terms of the driver's
   -- behavior. 2) the Driver uses whatever value is in the Workstation
   -- Description Table to determine its actions. Case 1 can be used in
   -- most simple situations. In case 2, the Workstation Description
   -- Table component WS_DYNAMICS . WS_TRANSFORMATION should be passed.

   begin

      WS_SL . REQUESTED_WS_WINDOW := WS_WINDOW;

      if DYNAMIC_MODIFICATION = IMM or else

            WS_SL . WS_DISPLAY_SURFACE = EMPTY then

         UPDATE_WS_TRANSFORMATION(WS_SL);

      else

         WS_SL . WS_XFORM_UPDATE_STATE := PENDING;

         WS_SL . WS_NEW_FRAME_ACTION := YES;

      end if;

   end SET_WS_WINDOW;

   procedure SET_WS_VIEWPORT
      (DYNAMIC_MODIFICATION : in     GKS_TYPES . DYNAMIC_MODIFICATION;
       WS_SL       : in     WS_STATE_LIST_TYPES . WS_STATE_LIST_PTR;
       WS_VIEWPORT : in     DC . RECTANGLE_LIMITS) is

   --     The purpose of SET_WS_VIEWPORT to update the WS_SL to
   -- reflect the new WS_VIEWPORT of the Workstation Transformation. For
   -- efficiency's sake additional transformations have been included
   -- in the WS_SL for use by the Workstation Driver. These must
   -- also be updated. In the same vein, an Effective Clipping Rectangle
   -- is computed. All of these efficiency measures are handled by the
   -- UPDATE_TRANSFORMATION subprogram.
   --
   -- Components of the WS_SL affected are as follows:
   -- REQUESTED_WS_VIEWPORT, WS_XFORM_UPDATE_STATE, WS_NEW_FRAME_ACTION,
   -- If UPDATE_TRANSFORMATION is called, then CURRENT_WS_VIEWPORT is
   -- set and additional calculations are done for updating the
   -- transformations and clipping rectangles.
   --
   -- DYNAMIC_MODIFICATION - specifies whether to update the CURRENT
   --       transformation immediately (IMM), or to cause an implicit
   --       regeneration (IRG).
   -- WS_SL - is the Workstation State List of the Workstation Driver.
   -- WS_VIEWPORT - specifies the Workstation Transformation viewport
   --       limits requested.
   --
   -- A note on the DYNAMIC_MODIFICATION parameter:  This should be
   -- equal to the value of the Workstation Description Table component
   -- WS_DYNAMICS . WS_TRANSFORMATION, but there are two ways for this
   -- to occur: 1) the Driver is written with a constant and the
   -- Workstation Description Table is defined in terms of the driver's
   -- behavior. 2) the Driver uses whatever value is in the Workstation
   -- Description Table to determine its actions. Case 1 can be used in
   -- most simple situations. In case 2, the Workstation Description
   -- Table component WS_DYNAMICS . WS_TRANSFORMATION should be passed.

   begin

      WS_SL . REQUESTED_WS_VIEWPORT := WS_VIEWPORT;

      if DYNAMIC_MODIFICATION = IMM or else

            WS_SL . WS_DISPLAY_SURFACE = EMPTY then

         UPDATE_WS_TRANSFORMATION ( WS_SL );

      else

         WS_SL . WS_XFORM_UPDATE_STATE := PENDING;

         WS_SL . WS_NEW_FRAME_ACTION := YES;

      end if;

   end SET_WS_VIEWPORT;

   procedure UPDATE_WS_TRANSFORMATION
      (WS_SL     : in     WS_STATE_LIST_TYPES . WS_STATE_LIST_PTR) is

         separate;

end WSR_WS_TRANSFORMATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_UPDATE_WS_XFORM.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: UPDATE_WS_TRANSFORMATION
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File: WSR_UPDATE_WS_XFORM.ADA
-- Level: MA, 0A

with CONVERT_NDC_DC;
with NDC_OPS;

separate (WSR_WS_TRANSFORMATION)

procedure UPDATE_WS_TRANSFORMATION
   (WS_SL     : in     WS_STATE_LIST_TYPES . WS_STATE_LIST_PTR) is

-- Procedure UPDATE_WS_TRANSFORMATION updates the Workstation State List
-- `WS_SL' to reflect the current values of REQUESTED_WS_WINDOW and
-- REQUESTED_WS_VIEWPORT.  The CURRENT_WS_WINDOW and the
-- CURRENT_WS_VIEWPORT are updated. If there is any change in these
-- values, the WS_TRANSFORM and EFFECTIVE_CLIPPING_RECTANGLE are also
-- updated.

-- WS_SL is the Workstation State List (access value) to be updated.

   NDC_EFFECTIVE_CLIPPING_RECTANGLE : NDC . RECTANGLE_LIMITS;
   -- Intersection of `WS_SL . OUTPUT_ATTR . CLIPPING_RECTANGLE',
   -- with the `WS_SL . CURRENT_WS_WINDOW'.

begin

   -- Test if current WINDOW//VIEWPORT is up to date (equal requested)
   if WS_SL . CURRENT_WS_WINDOW /= WS_SL . REQUESTED_WS_WINDOW or else
      WS_SL . CURRENT_WS_VIEWPORT /= WS_SL . REQUESTED_WS_VIEWPORT then

      WS_SL . CURRENT_WS_WINDOW := WS_SL . REQUESTED_WS_WINDOW;

      WS_SL . CURRENT_WS_VIEWPORT := WS_SL . REQUESTED_WS_VIEWPORT;

      -- Compute and change the pre-computed transformation value
      --
      -- Note that the Workstation transformation is an EQUAL scaling
      -- in both X and Y --- no distortion is introduced into the NDC
      -- picture.  As far as scaling is concerned, the Workstation
      -- Viewport is reduced to the same X-Y proportion as the
      -- Workstation Window. Clipping is performed at the actual
      -- window.

      CONVERT_NDC_DC . SET_UNIFORM_SCALES
            (WS_SL . CURRENT_WS_WINDOW,
             WS_SL . CURRENT_WS_VIEWPORT,
             WS_SL . WS_TRANSFORM);

      -- Change `WS_SL . EFFECTIVE_CLIPPING_RECTANGLE'.
      -- The effective clipping rectangle is stored in Device
      -- Coordinates; hence it must be recomputed with each change
      -- to the Workstation Transformation.  This includes changes in
      -- the Workstation Viewport, not just when the Workstation Window
      -- changes.
      --   The current clipping rectangle, stored in NDC, is "and"ed
      -- with the workstation window and then converted to DC units.

      NDC_EFFECTIVE_CLIPPING_RECTANGLE := NDC_OPS . "and"
            (WS_SL . OUTPUT_ATTR . CLIPPING_RECTANGLE,
             WS_SL . CURRENT_WS_WINDOW);

      WS_SL . EFFECTIVE_CLIPPING_RECTANGLE :=
            CONVERT_NDC_DC . DC_RECTANGLE_LIMITS
            (NDC_EFFECTIVE_CLIPPING_RECTANGLE,
            WS_SL . WS_TRANSFORM);

   end if;

   WS_SL . WS_XFORM_UPDATE_STATE := NOTPENDING;

end UPDATE_WS_TRANSFORMATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_ERRORS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_ERRORS
--  IDENTIFIER: GIMXXX.2(1)
--  DISCREPANCY REPORTS:
--  #022  06/13/85  "Add error #85 back into GKS_ERRORS"
------------------------------------------------------------------
-- file : GKS_ERRORS.ADA
-- levels : all levels

with GKS_TYPES;

use GKS_TYPES;

package GKS_ERRORS is

-- This package defines error indicator constants to be used
-- in place of error indicator numbers within code.

-- IMPLEMENTATION DEPENDENT ERRORS

   SUCCESSFUL : constant ERROR_INDICATOR := 0;

-- STATE ERRORS

-- 1   GKS not in proper state: GKS shall be in state GKCL
   NOT_GKCL   : constant ERROR_INDICATOR := 1;

-- 2   GKS not in proper state: GKS shall be in state GKOP
   NOT_GKOP   : constant ERROR_INDICATOR := 2;

-- 3   GKS not in proper state: GKS shall be in state WSAC
   NOT_WSAC   : constant ERROR_INDICATOR := 3;

-- 4   GKS not in proper state: GKS shall be in state SGOP
   NOT_SGOP   : constant ERROR_INDICATOR := 4;

-- 5   GKS not in proper state: GKS shall be in either in
--     state WSAC or in state SGOP
   NOT_WSAC_SGOP  : constant ERROR_INDICATOR := 5;

-- 6   GKS not in proper state: GKS shall be in either state
--     WSOP or in state WSAC
   NOT_WSOP_WSAC  : constant ERROR_INDICATOR := 6;

-- 7   GKS not in proper state: GKS shall be in one of the
--     states WSOP, WSAC or SGOP
   NOT_WSOP_WSAC_SGOP  : constant ERROR_INDICATOR := 7;

-- 8   GKS not in proper state: GKS shall be in one of the
--     states GKOP, WSOP, WSAC or SGOP
   NOT_GKOP_WSOP_WSAC_SGOP : constant ERROR_INDICATOR := 8;


-- WS ERRORS

-- 21  Specified connection identifier is invalid
   INVALID_CONN_ID  : constant ERROR_INDICATOR := 21;

-- 23  Specified workstation type does not exist
   WS_TYPE_DOES_NOT_EXIST : constant ERROR_INDICATOR := 23;

-- 24  Specified workstation is open
   WS_IS_OPEN       : constant ERROR_INDICATOR := 24;

-- 25  Specified workstation is not open
   WS_NOT_OPEN      : constant ERROR_INDICATOR := 25;

-- 26  Specified workstation cannot be opened
   WS_CANNOT_OPEN   : constant ERROR_INDICATOR := 26;

-- 27  Workstation Independent Segment Storage is not open
   WISS_NOT_OPEN    : constant ERROR_INDICATOR := 27;

-- 28  Workstation Independent Segment Storage is already open
   WISS_ALREADY_OPEN : constant ERROR_INDICATOR := 28;

-- 29  Specified workstation is active
   WS_IS_ACTIVE     : constant ERROR_INDICATOR := 29;

-- 30  Specified workstation is not active
   WS_IS_NOT_ACTIVE : constant ERROR_INDICATOR := 30;

-- 31  Specified workstation is of category MO
   WS_CATEGORY_IS_MO : constant ERROR_INDICATOR := 31;

-- 32  Specified workstation is not of category MO
   WS_CATEGORY_NOT_MO  : constant ERROR_INDICATOR := 32;

-- 33  Specified workstation is of category MI
   WS_CATEGORY_IS_MI   : constant ERROR_INDICATOR := 33;

-- 34  Specified workstation is not of category MI
   WS_CATEGORY_NOT_MI  : constant ERROR_INDICATOR := 34;

-- 35  Specified workstation is of category INPUT
   WS_CATEGORY_IS_INPUT : constant ERROR_INDICATOR := 35;

-- 36  Specified workstation is Workstation Independent
--     Segment Storage
   WS_IS_WISS           : constant ERROR_INDICATOR := 36;

-- 37  Specified workstation is not of category OUTIN
   WS_CATEGORY_NOT_OUTIN : constant ERROR_INDICATOR := 37;

-- 38  Specified workstation is neither of category INPUT nor
--     of category OUTIN
   WS_NOT_INPUT_OUTIN    : constant ERROR_INDICATOR := 38;

-- 39  Specified workstation is neither of category OUTPUT nor
--     of category OUTIN
   WS_NOT_OUTPUT_OUTIN   : constant ERROR_INDICATOR := 39;

-- 40  Specified workstation has no pixel store readback
--     capability
   WS_CANNOT_PIXEL_READBACK : constant ERROR_INDICATOR := 40;

-- 41  Specified workstation type is not able to generate the
--     specified generalized drawing primitive
   WS_TYPE_CANNOT_GEN_GDP   : constant ERROR_INDICATOR := 41;

-- 42  Maximum number of simultaneously open workstations would
--     be exceeded
   MAX_NUM_OF_OPEN_WS       : constant ERROR_INDICATOR := 42;

-- 43  Maximum number of simultaneously active workstations would
--     be exceeded
   MAX_NUM_OF_ACTIVE_WS     : constant ERROR_INDICATOR := 43;


-- TRANSFORMATION ERRORS

-- 50  Transformation number is invalid
   INVALID_XFORM_NUMBER           : constant ERROR_INDICATOR :=50;

-- 51  Rectangle definition is invalid
   INVALID_RECTANGLE              : constant ERROR_INDICATOR :=51;

-- 52  Viewport is not within the Normalized Device Coordinate
--     unit square
   VIEWPORT_NOT_IN_NDC_UNIT_SQR        : constant ERROR_INDICATOR :=52;

-- 53  Workstation window is not within the Normalized Device
--     Coordinate unit square
   WS_WINDOW_NOT_IN_NDC_UNIT_SQR    : constant ERROR_INDICATOR :=53;

-- 54  Workstation viewport is not within the display space
   WS_VIEWPORT_NOT_IN_DISPLAY_SPACE : constant ERROR_INDICATOR :=54;


-- OUTPUT ATTRIBUTE ERRORS

-- 60  Polyline index is invalid
--     This error is precluded by the Ada language.
   INVALID_POLYLINE_INDEX     : constant ERROR_INDICATOR := 60;

-- 61  A representation for the specified polyline index has not
--     been defined on this workstation
   NO_POLYLINE_REP            : constant ERROR_INDICATOR := 61;

-- 62  A representation for the specified polyline index has not
--     been predefined on this workstation
   NO_PREDEF_POLYLINE_REP     : constant ERROR_INDICATOR := 62;

-- 63  Linetype is equal to zero
   LINETYPE_IS_ZERO           : constant ERROR_INDICATOR := 63;

-- 64  Specified linetype is not supported on this workstation
   LINETYPE_NOT_ON_WS         : constant ERROR_INDICATOR := 64;

-- 66  Polymarker index is invalid
--     This error is precluded by the Ada language.
   INVALID_POLYMARKER_INDEX   : constant ERROR_INDICATOR := 66;

-- 67  A representation for the specified polymarker index has
--     not been defined on this workstation
   NO_POLYMARKER_REP          : constant ERROR_INDICATOR := 67;

-- 68  A representation for the specified polymarker index has not
--     been predefined on this workstation
   NO_PREDEF_POLYMARKER_REP   : constant ERROR_INDICATOR := 68;

-- 69  Marker type is equal to zero
   MARKER_TYPE_IS_ZERO        : constant ERROR_INDICATOR := 69;

-- 70  Specified marker type is not supported on this workstation
   MARKER_TYPE_NOT_ON_WS      : constant ERROR_INDICATOR := 70;

-- 72  Text index is invalid
--     This error is precluded by the Ada language.
   INVALID_TEXT_INDEX         : constant ERROR_INDICATOR := 72;

-- 73  A representation for the specified text index has not been
--     defined on this workstation
   NO_TEXT_REP                : constant ERROR_INDICATOR := 73;

-- 74  A representation for the specified text index has not
--     been predefined on this workstation
   NO_PREDEF_TEXT_REP         : constant ERROR_INDICATOR := 74;

-- 75  Text font is equal to zero
   TEXT_FONT_IS_ZERO          : constant ERROR_INDICATOR := 75;

-- 76  Requested text font is not supported for the specified
--     precision on this workstation
   TEXT_FONT_NOT_ON_WS        : constant ERROR_INDICATOR := 76;

-- 79  Length of character up vector is zero
   CHAR_UP_VECTOR_IS_ZERO     : constant ERROR_INDICATOR := 79;

-- 80  Fill area index is invalid
--     This error is precluded by the Ada language.
   INVALID_FILL_AREA_INDEX    : constant ERROR_INDICATOR := 80;

-- 81  A representation for the specified fill area index has
--     not been defined on this workstation
   NO_FILL_AREA_REP           : constant ERROR_INDICATOR := 81;

-- 82  A representation for the specified fill area index has
--     not been predefined on this workstation
   NO_PREDEF_FILL_AREA_REP    : constant ERROR_INDICATOR := 82;

-- 83  Specified fill area interior style is not supported on
--     this workstation
   FILL_AREA_STYLE_NOT_ON_WS  : constant ERROR_INDICATOR := 83;

-- 84  Style (pattern or hatch) index is equal to zero
   STYLE_INDEX_IS_ZERO        : constant ERROR_INDICATOR :=84;

-- 85  Specified pattern index is invalid                      -- DR022
   INVALID_PATTERN_INDEX      : constant ERROR_INDICATOR :=85; -- DR022
                                                               -- DR022
-- 86  Specified hatch style is not supported on this workstation
   HATCH_STYLE_NOT_ON_WS      : constant ERROR_INDICATOR :=86;

-- 88  A representation for the specified pattern index has not
--     been defined on this workstation
   NO_PATTERN_REP             : constant ERROR_INDICATOR :=88;

-- 89  A representation for the specified pattern index has not
--     been predefined on this workstation
   NO_PREDEF_PATTERN_REP      : constant ERROR_INDICATOR :=89;

-- 90  Interior style PATTERN is not supported on this worksta-
--     tion
   PATTERN_STYLE_NOT_ON_WS    : constant ERROR_INDICATOR :=90;

-- 93  Colour index is invalid
--     This error is precluded by the Ada language.
   INVALID_COLOUR_INDEX       : constant ERROR_INDICATOR := 93;

-- 94  A representation for the specified colour index has not
--     been defined on this workstation
   NO_COLOUR_REP              : constant ERROR_INDICATOR := 94;

-- 95  A representation for the specified colour index has not
--     been predefined on this workstation
   NO_PREDEF_COLOUR_REP       : constant ERROR_INDICATOR := 95;


--   OUTPUT PRIMITIVE ERRORS

-- 100  Number of points is invalid
   INVALID_NUMBER_OF_POINTS        : constant ERROR_INDICATOR := 100;

-- 101  Invalid code in string
   INVALID_STRING_CODE        : constant ERROR_INDICATOR := 101;

-- 102  Generalized drawing primitive identifier is invalid
   INVALID_GDP_ID             : constant ERROR_INDICATOR := 102;

-- 103  Content of generalized drawing primitive data record
--       is invalid
   INVALID_GDP_DATA_RECORD    : constant ERROR_INDICATOR := 103;

-- 104  At least one active workstation is not able to generate
--      the specified generalized drawing primitive
   SOME_WS_CANNOT_GEN_GDP : constant ERROR_INDICATOR := 104;

-- 105  At least one active workstation is not able to generate
--      the specified generalized drawing primitive under the
--      current transformations and clipping rectangle
   SOME_WS_CANNOT_GEN_XFORM_CLIP_GDP : constant ERROR_INDICATOR := 105;

-- SEGMENT_ERROR

-- 121 Specified segment name is already in use
   SEGMENT_IN_USE              : constant ERROR_INDICATOR := 121;

-- 122 Specified segment does not exist
   SEGMENT_DOES_NOT_EXIST      : constant ERROR_INDICATOR := 122;

-- 123 Specified segment does not exist on specified workstation
   SEGMENT_NOT_ON_WS           : constant ERROR_INDICATOR := 123;

-- 124 Specified segment does not exist on Workstation
--     Independent segment storage
   SEGMENT_NOT_ON_WISS         : constant ERROR_INDICATOR := 124;

-- 125 Specified segment is open
   SEGMENT_IS_OPEN             : constant ERROR_INDICATOR := 125;


--      INPUT ERROR

-- 140 Specified input device is not present on workstation
   INPUT_DEVICE_NOT_ON_WS  : constant ERROR_INDICATOR := 140;

-- 141 Input device is not in REQUEST mode
   INPUT_DEVICE_NOT_REQUEST : constant ERROR_INDICATOR := 141;

-- 142 Input device is not in SAMPLE mode
   INPUT_DEVICE_NOT_SAMPLE : constant ERROR_INDICATOR := 142;

-- 143 EVENT and SAMPLE input mode are not available at
--     this level of GKS
   NO_EVENT_OR_SAMPLE      : constant ERROR_INDICATOR := 143;

-- 144 Specified prompt and echo type is not supported on
--     this workstation
   NO_PROMPT_AND_ECHO_ON_WS : constant ERROR_INDICATOR := 144;

-- 145 Echo area is outside display space
   ECHO_AREA_OUT_OF_DISPLAY : constant ERROR_INDICATOR := 145;

-- 146 Contents of input data record are invalid
   INVALID_INPUT_DATA_RECORD : constant ERROR_INDICATOR := 146;

-- 147 Input queue has overflowed
   INPUT_QUEUE_OVERFLOW     : constant ERROR_INDICATOR := 147;

-- 148 Input queue has not overflowed since GKS was opened or
--     the last invocation of INQUIRE INPUT QUEUE OVERFLOW
   NO_INPUT_QUEUE_OVERFLOW : constant ERROR_INDICATOR := 148;

-- 149 Input queue has overflowed, but associated workstation
--     has been closed
   INPUT_QUEUE_OVERFLOW_NO_WS : constant ERROR_INDICATOR := 149;

-- 150 No input value of the correct class is in the
--     current event report
   NO_INPUT_VALUE_FOR_CLASS : constant ERROR_INDICATOR := 150;

-- 152 Initial value is invalid
   INVALID_INITIAL_VALUE         : constant ERROR_INDICATOR := 152;

-- 153 Number of points in the initial stroke is greater than the
--     buffer size
   EXCEEDED_INITIAL_STROKE_POINTS : constant ERROR_INDICATOR := 153;

-- 154  Length of the initial string is greater than the buffer size
   EXCEEDED_INITIAL_STRING_LENGTH : constant ERROR_INDICATOR := 154;


-- METAFILE ERRORS

-- 160 Item type is not allowed for user items
   ITEM_TYPE_NOT_ALLOWED      : constant ERROR_INDICATOR := 160;

-- 161 Item length is invalid
   INVALID_ITEM_LENGTH        : constant ERROR_INDICATOR := 161;

-- 162 No item is left in GKS metafile input
   NO_ITEM_IN_GKSM_INPUT      : constant ERROR_INDICATOR := 162;

-- 163 Metafile item is invalid
   INVALID_METAFILE_ITEM      : constant ERROR_INDICATOR := 163;

-- 164 Item type is not a valid GKS item
   INVALID_GKS_ITEM_TYPE      : constant ERROR_INDICATOR := 164;

-- 165 Content of item data record is invalid for the specified
--     item type
   INVALID_ITEM_DATA_RECORD   : constant ERROR_INDICATOR := 165;

-- 167 User item cannot be interpreted
   CANNOT_INTERPRET_USER_ITEM   : constant ERROR_INDICATOR := 167;

-- 168 Specified function is not supported at this level of GKS
   FUNCTION_NOT_SUPPORTED     : constant ERROR_INDICATOR := 168;



-- ESCAPE ERRORS

-- 180 Specified escape function is not supported
   ESCAPE_FUNCTION_NOT_SUPPORTED : constant ERROR_INDICATOR := 180;

-- 181 Specified escape function identification is invalid
   INVALID_ESCAPE_ID           : constant ERROR_INDICATOR := 181;

-- 182 Contents of escape data record are invalid
   INVALID_ESCAPE_DATA_RECORD       : constant ERROR_INDICATOR := 182;



-- MISCELLANEOUS ERRORS

-- 200 Specified error file is invalid
   INVALID_ERROR_FILE          : constant ERROR_INDICATOR := 200;



-- SYSTEM ERRORS

-- 300 Storage overflow has occurred in GKS
   GKS_STORAGE_OVERFLOW       : constant ERROR_INDICATOR := 300;

-- 301 Storage overflow has occurred in segment storage
   SEGMENT_STORAGE_OVERFLOW   : constant ERROR_INDICATOR := 301;

-- 302 Input/Output error has occurred while reading
   IO_ERROR_WHILE_READING     : constant ERROR_INDICATOR := 302;

-- 303 Input/Output error has occurred while writing
   IO_ERROR_WHILE_WRITING     : constant ERROR_INDICATOR := 303;

-- 304 Input/Output error has occurred while sending data to a
--     workstation
   IO_ERROR_WHILE_SENDING_WS  : constant ERROR_INDICATOR := 304;

-- 305 Input/Output error has occurred while receiving data
--     from a workstation
   IO_ERROR_WHILE_RECEIVE_WS  : constant ERROR_INDICATOR := 305;

-- 306 Input/Output error has occurred during program library
--     management
   IO_ERROR_LIBRARY_MANAGEMENT  : constant ERROR_INDICATOR := 306;

-- 307 Input/Output error has occurred while reading workstation
--     description table
   IO_ERROR_READING_WS_DESCR  : constant ERROR_INDICATOR := 307;

-- 308 Arithmetic error has occurred
   ARITHMETIC                 : constant ERROR_INDICATOR := 308;



-- LANGUAGE BINDING ERRORS

-- 2500 Invalid use of input data record
   INVALID_USE_OF_INPUT_DATA  : constant ERROR_INDICATOR := 2500;


-- OTHERS

-- 2501 Unknown error occurred during processing.
   UNKNOWN               : constant ERROR_INDICATOR := 2501;

end GKS_ERRORS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_INQ_WS_ST_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_INQ_WS_STATE_LIST_MA
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  DR004  Reduce storage size of CGI instruction.
------------------------------------------------------------------
-- file:  WSR_INQ_WS_ST_MA.ADA
-- level: all levels

with GKS_TYPES;
with CGI;
with WS_STATE_LIST_TYPES;
with GKS_ERRORS;

use GKS_TYPES;
use CGI;

package WSR_INQ_WS_STATE_LIST_MA is

-- WS_STATE_LIST_PTR is declared in WS_STATE_LIST_TYPES; the
-- other parameter types are declared in GKS_TYPES.
-- Each procedure is called by the workstation driver which
-- passes a pointer to the workstation state list being inquired.

   procedure INQ_WS_CONNECTION_AND_TYPE
   (WS_STATE_LIST : in WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    CONNECTION    : out ACCESS_CONNECTION_ID_TYPE;
    TYPE_OF_WS    : out WS_TYPE);

   procedure INQ_LIST_OF_COLOUR_INDICES
   (WS_STATE_LIST : in WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    INDICES       : out COLOUR_INDICES.LIST_OF);

   procedure INQ_COLOUR_REPRESENTATION
   (WS_STATE_LIST   : in WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    INDEX           : in COLOUR_INDEX;
    RETURNED_VALUES : in RETURN_VALUE_TYPE;
    COLOUR          : out COLOUR_REPRESENTATION;
    EI              : out ERROR_INDICATOR);

   procedure INQ_WS_TRANSFORMATION
   (WS_STATE_LIST      : in WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    UPDATE             : out UPDATE_STATE;
    REQUESTED_WINDOW   : out NDC.RECTANGLE_LIMITS;
    CURRENT_WINDOW     : out NDC.RECTANGLE_LIMITS;
    REQUESTED_VIEWPORT : out DC.RECTANGLE_LIMITS;
    CURRENT_VIEWPORT   : out DC.RECTANGLE_LIMITS);

end WSR_INQ_WS_STATE_LIST_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_INQ_WS_ST_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_INQ_WS_STATE_LIST_MA - BODY
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  DR004  Reduce storage size of CGI instruction.
------------------------------------------------------------------
-- file:  WSR_INQ_WS_ST_MA_B.ADA
-- level: all levels

package body WSR_INQ_WS_STATE_LIST_MA is

--  The following procedures inquire into the specified workstation
--  state list accessed by the pointer passed as a parameter,
--  to retrieve the needed information.

   procedure INQ_WS_CONNECTION_AND_TYPE
   (WS_STATE_LIST : in WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    CONNECTION    : out ACCESS_CONNECTION_ID_TYPE;
    TYPE_OF_WS    : out WS_TYPE) is separate;

   procedure INQ_LIST_OF_COLOUR_INDICES
   (WS_STATE_LIST : in WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    INDICES       : out COLOUR_INDICES.LIST_OF) is separate;

   procedure INQ_COLOUR_REPRESENTATION
   (WS_STATE_LIST   : in WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    INDEX           : in COLOUR_INDEX;
    RETURNED_VALUES : in RETURN_VALUE_TYPE;
    COLOUR          : out COLOUR_REPRESENTATION;
    EI              : out ERROR_INDICATOR) is separate;

   procedure INQ_WS_TRANSFORMATION
   (WS_STATE_LIST      : in WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    UPDATE             : out UPDATE_STATE;
    REQUESTED_WINDOW   : out NDC.RECTANGLE_LIMITS;
    CURRENT_WINDOW     : out NDC.RECTANGLE_LIMITS;
    REQUESTED_VIEWPORT : out DC.RECTANGLE_LIMITS;
    CURRENT_VIEWPORT   : out DC.RECTANGLE_LIMITS) is separate;

end WSR_INQ_WS_STATE_LIST_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_INQ_WS_CON_TYPE.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_WS_CONNECTION_AND_TYPE
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  DR004  Reduce storage size of CGI instruction.
------------------------------------------------------------------
-- file:  WSR_INQ_WS_CON_TYPE.ADA
-- level: all levels

separate (WSR_INQ_WS_STATE_LIST_MA)

procedure INQ_WS_CONNECTION_AND_TYPE
   (WS_STATE_LIST : in WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    CONNECTION    : out ACCESS_CONNECTION_ID_TYPE;
    TYPE_OF_WS    : out WS_TYPE) is

-- Return the values of connection identifier and workstation
-- type from the workstation state list, accessed by WS_STATE_LIST,
-- in the specified parameters.
--
-- The parameters in this procedure are used as follows:
--
-- WS_STATE_LIST  - pointer to the workstation state list.
-- CONNECTION     - pointer to the workstation identifier to return.
-- TYPE_OF_WS     - workstation type to return.
--
-- No errors are checked in this procedure.

begin

   -- Inquire connection identifier
   CONNECTION := new CONNECTION_ID'(WS_STATE_LIST.CONNECT_ID.CONNECT);

   -- Inquire workstation type
   TYPE_OF_WS := WS_STATE_LIST.WORKSTATION_TYPE;

end INQ_WS_CONNECTION_AND_TYPE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_INQ_WS_XFORM.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_WS_TRANSFORMATION
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS
--
------------------------------------------------------------------
-- file:  WSR_INQ_WS_XFORM.ADA
-- level: all levels

separate (WSR_INQ_WS_STATE_LIST_MA)

procedure INQ_WS_TRANSFORMATION
   (WS_STATE_LIST : in WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    UPDATE        : out UPDATE_STATE;
    REQUESTED_WINDOW   : out NDC.RECTANGLE_LIMITS;
    CURRENT_WINDOW     : out NDC.RECTANGLE_LIMITS;
    REQUESTED_VIEWPORT : out DC.RECTANGLE_LIMITS;
    CURRENT_VIEWPORT   : out DC.RECTANGLE_LIMITS) is

-- Find the workstation transformation update state, the requested
-- workstation window, the current workstation window, the requested
-- workstation viewport and the current workstation viewport from
-- the workstation state list accessed by the pointer WS_STATE_LIST.
-- The workstation transformation state is PENDING if a workstation
-- transformation change has been requested but not yet provided.
--
-- The parameters in this procedure are used as follows:
--
-- WS_STATE_LIST                - pointer to the workstation state list.
-- UPDATE                       - update information
--                                (pending,not pending).
-- REQUESTED_WINDOW             - requested workstation window in
--                                NDC coordinates.
-- CURRENT_WINDOW               - current workstation window in
--                                NDC coordinates.
-- REQUESTED_VIEWPORT           - requested viewport in DC coordinates.
-- CURRENT_VIEWPORT             - current viewport in DC coordinates.

begin

   -- Inquire workstation transformation update state
   UPDATE := WS_STATE_LIST.WS_XFORM_UPDATE_STATE;

   -- Inquire requested workstation window
   REQUESTED_WINDOW := WS_STATE_LIST.REQUESTED_WS_WINDOW;

   -- Inquire current workstation window
   CURRENT_WINDOW := WS_STATE_LIST.CURRENT_WS_WINDOW;

   -- Inquire requested workstation viewport
   REQUESTED_VIEWPORT := WS_STATE_LIST.REQUESTED_WS_VIEWPORT;

   -- Inquire current workstation viewport
   CURRENT_VIEWPORT := WS_STATE_LIST.CURRENT_WS_VIEWPORT;

end INQ_WS_TRANSFORMATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_INQ_LST_CLR_IDC.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_LIST_OF_COLOUR_INDICES
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  WSR_INQ_LST_CLR_IDC.ADA
-- level: all levels

separate (WSR_INQ_WS_STATE_LIST_MA)

procedure INQ_LIST_OF_COLOUR_INDICES
   (WS_STATE_LIST : in WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    INDICES       : out COLOUR_INDICES.LIST_OF) is

-- Return the list of colour indices from the workstation state list,
-- accessed by the pointer WS_STATE_LIST, in the specified parameter.
--
-- The parameters in this procedure are used as follows:
--
-- WS_STATE_LIST     - pointer to the workstation state list.
-- INDICES           - list of colour indices to return.

begin

   -- Inquire the list of colour indices.

   INDICES := WS_STATE_LIST.SET_OF_COLOUR_IDC;

end INQ_LIST_OF_COLOUR_INDICES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_INQ_CLR_REP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_COLOUR_REPRESENTATION
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  WSR_INQ_CLR_REP.ADA
-- level: all levels

separate (WSR_INQ_WS_STATE_LIST_MA)

procedure INQ_COLOUR_REPRESENTATION
   (WS_STATE_LIST   : in WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    INDEX           : in COLOUR_INDEX;
    RETURNED_VALUES : in RETURN_VALUE_TYPE;
    COLOUR          : out COLOUR_REPRESENTATION;
    EI              : out ERROR_INDICATOR) is

-- This procedure returns information about
-- the colour table from the workstation state list accessed by
-- the WS_STATE_LIST pointer.
--
-- The parameters in this procedure are used as follows:
--
-- WS_STATE_LIST     - pointer to the workstation state list
--                     being inquired.
-- INDEX             - colour index.
-- RETURNED_VALUES   - indicates whether the returned values
--                   - should be as they were set by the program
--                   - or as they were actually realized by the
--                   - device.
-- COLOUR            - colour intensity.
-- EI                - used to log errors.
--
-- EI is set to NO_COLOUR_REP if a representation for the
-- specified colour index has not been defined on this
-- workstation.

begin

   -- set the error indicator to insure that a successful value
   -- is passed out when no errors occur.
   EI := GKS_ERRORS.SUCCESSFUL;

   -- set the default value of the out parameter.
   COLOUR := (0.0,0.0,0.0);

   if RETURNED_VALUES = REALIZED then

      if not COLOUR_INDICES.IS_IN_LIST
            (INDEX,WS_STATE_LIST.SET_OF_COLOUR_IDC) then

         -- the specified colour representation has not been
         -- defined on this workstation and RETURNED_VALUES
         -- has value REALIZED.  So return the values using
         -- the default index.

         COLOUR := WS_STATE_LIST.COLOUR_TABLE(1);

      else

         -- the index specified is within the colour table.
         -- return the value found in the workstation state list.

         COLOUR := WS_STATE_LIST.COLOUR_TABLE(INDEX);

      end if;

   else

      if INDEX not in WS_STATE_LIST.COLOUR_TABLE'RANGE then

         -- the specified colour index is invalid for this workstation.
         EI := GKS_ERRORS.INVALID_COLOUR_INDEX;

      elsif not COLOUR_INDICES.IS_IN_LIST(INDEX,WS_STATE_LIST
            .SET_OF_COLOUR_IDC) then
         -- the specified colour representation has not been
         -- defined on this workstation and RETURNED_VALUES
         -- has value SET.

         EI := GKS_ERRORS.NO_COLOUR_REP;

      else

         -- the index specified is within the colour table.
         -- return the value found in the workstation state list.

         COLOUR := WS_STATE_LIST.COLOUR_TABLE(INDEX);

      end if;

   end if;

end INQ_COLOUR_REPRESENTATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_CLR_TABLE.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_SET_COLOUR_TABLE
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file : WSR_SET_CLR_TABLE.ADA
-- level: ma,0a,1a,2a

with GKS_TYPES;
with WS_STATE_LIST_TYPES;

use  GKS_TYPES;

package WSR_SET_COLOUR_TABLE  is

-- This package is a resource package.  It can be used by any device
-- that needs it.  It sets the colour table in the workstation state
-- list to the value specified by the parameter INDEX to the colour
-- specified by COLOUR.  It also needs the specified workstation state
-- list as a parameter to be passed to it.

   procedure SET_COLOUR_REPRESENTATION
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       INDEX     : in COLOUR_INDEX;
       COLOUR    : in COLOUR_REPRESENTATION;
       EI        : out ERROR_INDICATOR);

end WSR_SET_COLOUR_TABLE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_SET_CLR_TABLE_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_SET_COLOUR_TABLE - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  WSR_SET_CLR_TABLE_B.ADA
-- level: ma,0a,1a,2a

with GKS_ERRORS;

package body WSR_SET_COLOUR_TABLE  is

   procedure SET_COLOUR_REPRESENTATION
      (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       INDEX     : in COLOUR_INDEX;
       COLOUR    : in COLOUR_REPRESENTATION;
       EI        : out ERROR_INDICATOR) is

   -- This procedure changes the colour specified by the index in
   -- the colour table of the WS_STATE_LIST specified by the parameter.
   -- It checks to see if the INDEX chosen is valid for the specified
   -- workstation.
   --
   -- The following parameters are used this procedure :
   -- WS_ST_LST -  the WS_STATE_LIST to which the colour is being
   --              directed.
   -- INDEX - the indexed colour being set.
   -- COLOUR - the intensities of red, green, blue to set the
   --          colour.
   -- EI - An error indicator used for logging errors.

   begin

      if INDEX not in WS_ST_LST.COLOUR_TABLE'range then
         EI := GKS_ERRORS.INVALID_COLOUR_INDEX;
      else
         EI := GKS_ERRORS.SUCCESSFUL;

         -- Set the specified WS_STATE_LIST to the
         -- value specified by the parameter.
         WS_ST_LST.COLOUR_TABLE (INDEX) := COLOUR;

         -- The index is added to the SET_OF_COLOUR_IDC in the WS_STATE
         -- LIST.  The set contains all the set indices on the device.
         COLOUR_INDICES.ADD_TO_LIST (INDEX,
                                     WS_ST_LST.SET_OF_COLOUR_IDC);
      end if;

   end SET_COLOUR_REPRESENTATION;

end WSR_SET_COLOUR_TABLE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_UTILITIES.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_UTILITIES
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : WSR_UTILITIES.ADA
-- LEVEL : all

with GKS_TYPES;

use  GKS_TYPES;

package WSR_UTILITIES is

-- The Workstation Resource Utilities contains procedures to handle
-- clipping of polylines and handling of text.

   type AREA;

   type LIST_OF_AREAS is access AREA;

   type AREA is
      record
         BORDER    : DC.POINT_LIST;
         NEXT_AREA : LIST_OF_AREAS;
      end record;
   -- The preceeding 3 declarations allow for the clip routine to return
   -- a variable number of areas.

   procedure PLINE_CLIP
      (POINTER_ARRAY  : DC.POINT_ARRAY;
       STARTING_PT    : out DC.POINT;
       STARTING_INDEX : in out POSITIVE;
       LAST_INDEX     : in out POSITIVE;
       FINISHING_PT   : out DC.POINT;
       CLIP_RECTANGLE : DC.RECTANGLE_LIMITS);

   function PMRK_CLIP
      (PTR_TO_LIST_OF_POINTS : DC.POINT_ARRAY;
       CLIP_RECTANGLE        : DC.RECTANGLE_LIMITS)
      return DC.POINT_LIST;

   procedure TEXT_CLIP
      (TEXT_POSITION   : DC.POINT;
       TEXT_LENGTH     : INTEGER;
       CLIP_RECTANGLE  : DC.RECTANGLE_LIMITS;
       OFFSET          : DC.POINT;
       FIRST_VIS_CHAR  : out POSITIVE;
       LAST_VIS_CHAR   : out POSITIVE);

   procedure TEXT_HANDLING
      (CAP_TOP          : DC_TYPE;
       BASE_BOTTOM      : DC_TYPE;
       T_PATH           : TEXT_PATH;
       T_ALIGNMENT      : TEXT_ALIGNMENT;
       CHAR_HEIGHT_VECT : DC.VECTOR;
       CHAR_WIDTH_VECT  : DC.VECTOR;
       CHAR_EXP_FACTOR  : CHAR_EXPANSION;
       CHAR_SPACE       : CHAR_SPACING;
       TEXT_POSITION    : in DC.POINT;
       TEXT_LENGTH      : INTEGER;
       CHARACTER_FONT   : DC_TYPE;
       START_POSITION   : out DC.POINT;
       OFFSET           : out DC.POINT;
       TEI_LOWER_LEFT   : out DC.POINT;
       TEI_LOWER_RIGHT  : out DC.POINT;
       TEI_UPPER_LEFT   : out DC.POINT;
       TEI_UPPER_RIGHT  : out DC.POINT);

   function TRANSFORM
      (INPUT_VALUE     : float;
       INPUT_UPPER     : float;
       INPUT_LOWER     : float;
       TRANSFORM_UPPER : integer;
       TRANSFORM_LOWER : integer) return integer;

   procedure AREA_CLIP
      (INPUT_AREA         : in DC.POINT_ARRAY;
       CLIPPING_RECTANGLE : in DC.RECTANGLE_LIMITS;
       OUTPUT_AREAS       : in out LIST_OF_AREAS);
   -- This procedure takes an input area and clips it by the CLIPPING_
   -- RECTANGLE.

end WSR_UTILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_UTILITIES_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_UTILITIES - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: WSR_UTILITIES_B.ADA
-- LEVEL: all

with DC_POINT_OPS;

package body WSR_UTILITIES is

   type CLIP_INDICATOR is
      (OUT_OF_BOUNDS, NO_CLIPPING, FIRST, LAST, ERROR);
   -- Used to indicate what action was performed on the line.

   procedure LINE_CLIP
      (FIRST_POINT    : DC.POINT;
       LAST_POINT     : DC.POINT;
       CLIPPED_FIRST  : out DC.POINT;
       CLIPPED_LAST   : out DC.POINT;
       CLIP_RECTANGLE : DC.RECTANGLE_LIMITS;
       CLIP_FLAG      : out CLIP_INDICATOR) is separate;

   procedure PLINE_CLIP
      (POINTER_ARRAY  : DC.POINT_ARRAY;
       STARTING_PT    : out DC.POINT;
       STARTING_INDEX : in out POSITIVE;
       LAST_INDEX     : in out POSITIVE;
       FINISHING_PT   : out DC.POINT;
       CLIP_RECTANGLE : DC.RECTANGLE_LIMITS) is separate;

   function PMRK_CLIP
       (PTR_TO_LIST_OF_POINTS : DC.POINT_ARRAY;
        CLIP_RECTANGLE        : DC.RECTANGLE_LIMITS)
       return DC.POINT_LIST is separate;

   procedure TEXT_CLIP
      (TEXT_POSITION   : DC.POINT;
       TEXT_LENGTH     : INTEGER;
       CLIP_RECTANGLE  : DC.RECTANGLE_LIMITS;
       OFFSET          : DC.POINT;
       FIRST_VIS_CHAR  : out POSITIVE;
       LAST_VIS_CHAR   : out POSITIVE) is separate;

   procedure TEXT_HANDLING
      (CAP_TOP          : DC_TYPE;
       BASE_BOTTOM      : DC_TYPE;
       T_PATH           : TEXT_PATH;
       T_ALIGNMENT      : TEXT_ALIGNMENT;
       CHAR_HEIGHT_VECT : DC.VECTOR;
       CHAR_WIDTH_VECT  : DC.VECTOR;
       CHAR_EXP_FACTOR  : CHAR_EXPANSION;
       CHAR_SPACE       : CHAR_SPACING;
       TEXT_POSITION    : in DC.POINT;
       TEXT_LENGTH      : INTEGER;
       CHARACTER_FONT   : DC_TYPE;
       START_POSITION   : out DC.POINT;
       OFFSET           : out DC.POINT;
       TEI_LOWER_LEFT   : out DC.POINT;
       TEI_LOWER_RIGHT  : out DC.POINT;
       TEI_UPPER_LEFT   : out DC.POINT;
       TEI_UPPER_RIGHT  : out DC.POINT) is separate;

   function TRANSFORM
      (INPUT_VALUE     : float;
       INPUT_UPPER     : float;
       INPUT_LOWER     : float;
       TRANSFORM_UPPER : integer;
       TRANSFORM_LOWER : integer) return integer
      is separate;


   -- The following package contains procedures called by AREA_CLIP.
   package AREA_CLIPPING_UTILITIES is

      procedure CLIP_ON_RIGHT
         (INPUT_AREA    : in DC.POINT_ARRAY;
          RIGHT_BORDER  : in DC_TYPE;
          CLIPPED_AREAS : in out LIST_OF_AREAS);

      procedure CLIP_ON_BOTTOM
         (INPUT_AREA    : in DC.POINT_ARRAY;
          BOTTOM_BORDER : in DC_TYPE;
          CLIPPED_AREAS : in out LIST_OF_AREAS);

      procedure CLIP_ON_LEFT
         (INPUT_AREA    : in DC.POINT_ARRAY;
          LEFT_BORDER   : in DC_TYPE;
          CLIPPED_AREAS : in out LIST_OF_AREAS);

      procedure CLIP_ON_TOP
         (INPUT_AREA    : in DC.POINT_ARRAY;
          TOP_BORDER    : in DC_TYPE;
          CLIPPED_AREAS : in out LIST_OF_AREAS);

   end AREA_CLIPPING_UTILITIES;

   package body AREA_CLIPPING_UTILITIES is separate;

   procedure AREA_CLIP
      (INPUT_AREA         : in DC.POINT_ARRAY;
       CLIPPING_RECTANGLE : in DC.RECTANGLE_LIMITS;
       OUTPUT_AREAS       : in out LIST_OF_AREAS) is separate;

end WSR_UTILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI_OUT_PRIM_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_OUTPUT_PRIMITIVES - BODY
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  Not listed
------------------------------------------------------------------
-- FILE : LEXI3700_OUT_PRIM_B.ADA
-- LEVEL : MA - 0A

with LEXI3700_CONFIGURATION;
with LEXI3700_TYPES;
with LEXI3700_OUTPUT_DRIVER;
with CONVERT_NDC_DC;
with DC_POINT_OPS;
with WSR_UTILITIES;
with LEXI_UTILITIES;

use  LEXI3700_TYPES;

package body LEXI3700_OUTPUT_PRIMITIVES is

-- The package LEXI3700_TYPES contains all types used by the device
-- driver.
--
-- The package LEXI3700_DRIVER contains all device specific calls
-- for the device driver.
--
-- The package WSD_UTILITIES contains the functions and procedures needed
-- by the workstation driver to perform transformations and clipping.

   procedure POLYLINE
      (WS_SL       : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       LINE_POINTS : ACCESS_POINT_ARRAY_TYPE) is separate;

   procedure POLYMARKER
      (WS_SL         : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       MARKER_POINTS : ACCESS_POINT_ARRAY_TYPE) is separate;

   procedure FILL_AREA
      (WS_SL            : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       FILL_AREA_POINTS : ACCESS_POINT_ARRAY_TYPE) is separate;

   procedure TEXT
      (WS_SL         : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       TEXT_POSITION : NDC.POINT;
       TEXT_STRING   : ACCESS_STRING_TYPE) is separate;

end LEXI3700_OUTPUT_PRIMITIVES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_PLINE_CLIP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: PLINE_CLIP
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR031  Polyline clipping.
------------------------------------------------------------------
-- FILE: WSR_PLINE_CLIP.ADA
-- LEVEL: all

separate (WSR_UTILITIES)

procedure PLINE_CLIP
   (POINTER_ARRAY   : DC.POINT_ARRAY;
    STARTING_PT     : out DC.POINT;
    STARTING_INDEX  : in out POSITIVE;
    LAST_INDEX      : in out POSITIVE;
    FINISHING_PT    : out DC.POINT;
    CLIP_RECTANGLE  : DC.RECTANGLE_LIMITS) is

-- This procedure performs all of the clipping that is required for polylines.
-- In order for clipping to occur, the line drawn between the two points
-- must intersect a section of the viewing window.  The first step is
-- to determine if each point lies inside or outside of the clipping
-- window.  If both points lie inside the window, then no clipping is
-- required, and CLIPPING_CODE is set to "NO_CLIPPING".  If both points
-- do not lie inside, the next step is to determine if no intersection
-- occurs.  If both points are HIGH, LOW, RIGHT, or LEFT of the window,
-- then no intersection can occur, and CLIPPING_CODE is set to "OUT_OF_
-- BOUNDS".  The diagram below better represents the definitions:
--
--                         HIGH
--                       --------
--                  LEFT |  OK  | RIGHT
--                       --------
--                         LOW
--
-- If CLIPPING_CODE has not been modified, intersections are calculated
-- using a simple line-intersection equation, and the new points are
-- returned.
--
-- POINTER_ARRAY  - is the initial array of points.
-- STARTING_PT    - is the initial point (X1,Y1) entered.
-- STARTING_INDEX - is the index of the first point.
-- LAST_INDEX     - is the index of the last point.
-- FINISHING_PT  - is the ending point (X2,Y2) entered.

CLIP_FLAG     : CLIP_INDICATOR;
-- CLIP_FLAG returns action performed by LINE_CLIP.

RETURN_POINT1 : DC.POINT;
-- Contains the first clipped point.

RETURN_POINT2 : DC.POINT;
-- Contains the second clipped point.

START : POSITIVE := STARTING_INDEX;
-- Contains starting index.

NOT_FOUND_FIRST : BOOLEAN := TRUE;
-- Contains a flag indicating if the first valid point has been found.

begin
  for I in START .. (POINTER_ARRAY'last - 1) loop
      LINE_CLIP
         (POINTER_ARRAY(I), POINTER_ARRAY(I+1),
          RETURN_POINT1, RETURN_POINT2,
          CLIP_RECTANGLE, CLIP_FLAG);

      case CLIP_FLAG is

         when FIRST =>
            NOT_FOUND_FIRST := FALSE;
            STARTING_PT := RETURN_POINT1;
            STARTING_INDEX := I + 1;
            FINISHING_PT := POINTER_ARRAY(I+1);
            LAST_INDEX := I;

         when LAST  =>
            FINISHING_PT := RETURN_POINT2;
            LAST_INDEX := I;
            if NOT_FOUND_FIRST then
               STARTING_INDEX := I + 1;
               STARTING_PT := RETURN_POINT1;
            end if;
            exit;

         when OUT_OF_BOUNDS =>
            STARTING_INDEX := POINTER_ARRAY'LAST + 1;

         when NO_CLIPPING =>
            if NOT_FOUND_FIRST then
               STARTING_PT     := POINTER_ARRAY(I);
               STARTING_INDEX  := I + 1;
               -- The following two lines cover a polyline of two points
               FINISHING_PT := POINTER_ARRAY(I+1);
               LAST_INDEX := I;
               NOT_FOUND_FIRST := FALSE;
            end if;
            if I = (POINTER_ARRAY'LAST - 1) then
               FINISHING_PT := POINTER_ARRAY(POINTER_ARRAY'last);
               LAST_INDEX   := I;
            end if;
         when ERROR =>
             null;
      end case;

  end loop;
end PLINE_CLIP;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_PMRK_CLIP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: PMRK_CLIP
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_PMRK_CLIP.ADA
-- level: ma,0a,1a,2a

separate (WSR_UTILITIES)

function PMRK_CLIP
   (PTR_TO_LIST_OF_POINTS  : DC.POINT_ARRAY;
    CLIP_RECTANGLE  : DC.RECTANGLE_LIMITS) return DC.POINT_LIST is

-- This function receives a list of center points for polymarkers and a
-- a clipping rectangle. It determines if the center of the polymarker
-- is within the clipping rectangle.  If it is, it is stored in the
-- UNCLIPPED_POLYMARKERS array.  This function does not ensure
-- that the extent of the polymarker will not extend out of the clipping
-- rectangle, just that the center is within the clipping rectangle. Also
-- it does not check for polymarkers that have a center outside the
-- clipping rectangle, but extend into the clipping rectangle.
--
-- The following parameters are used in this function:
-- PTR_TO_LIST_OF_POINTS - A list of center points in device coordinates
--                         of the polymarkers to be displayed.
-- CLIP_RECTANGLE - The clipping rectangle to test the points against.

UNCLIPPED_POLYMARKERS : DC.POINT_ARRAY
                         (1 .. PTR_TO_LIST_OF_POINTS'length);
COUNTER : NATURAL := 0;

begin
   for I in PTR_TO_LIST_OF_POINTS'range loop

      if PTR_TO_LIST_OF_POINTS(I).X >= CLIP_RECTANGLE.XMIN and then
         PTR_TO_LIST_OF_POINTS(I).X <= CLIP_RECTANGLE.XMAX and then
         PTR_TO_LIST_OF_POINTS(I).Y >= CLIP_RECTANGLE.YMIN and then
         PTR_TO_LIST_OF_POINTS(I).Y <= CLIP_RECTANGLE.YMAX then
            COUNTER := COUNTER + 1;
            UNCLIPPED_POLYMARKERS(COUNTER) := PTR_TO_LIST_OF_POINTS(I);
      else
        null;
        -- point was out of the window.
      end if;
   end loop;

   return DC.POINT_LIST'(LENGTH => COUNTER,
      POINTS => UNCLIPPED_POLYMARKERS(1 .. COUNTER));

end PMRK_CLIP;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_AREA_CLIP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: AREA_CLIP
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : WSR_AREA_CLIP.ADA
-- LEVELS : all

with UNCHECKED_DEALLOCATION;

separate (WSR_UTILITIES)

procedure AREA_CLIP
   (INPUT_AREA         : in DC.POINT_ARRAY;
    CLIPPING_RECTANGLE : in DC.RECTANGLE_LIMITS;
    OUTPUT_AREAS       : in out LIST_OF_AREAS) is

-- This procedure accepts a list of points which define an area. The
-- portions of this area which are outside of the CLIPPING_RECTANGLE
-- are removed, and the areas which are left, if any, are returned to
-- the calling procedure. The algorithm used is a modification of
-- the Sutherland - Hodgman algorithm for clipping polygons against
-- convex polyhedrons. The algorithm was modified to use a rectangle
-- and to remove the extraneous edges formed when the result of the
-- clipping is more than one area.
--
-- INPUT_AREA         - the points which make up the area to be clipped.
-- CLIPPING_RECTANGLE - the rectangle used for clipping.
-- OUTPUT_AREAS       - a linked list of the areas which are interior to
--                      the clipping rectangle.

   RIGHT_CLIPPED_AREAS : LIST_OF_AREAS := null;
   -- This variable holds the intermediate results of clipping to the
   -- right edge of the clipping rectangle.

   BOTTOM_CLIPPED_AREAS : LIST_OF_AREAS := null;
   -- This variable holds the intermediate results of clipping the
   -- previous variable to the bottom edge of the clipping rectangle.

   LEFT_CLIPPED_AREAS : LIST_OF_AREAS := null;
   -- This variable holds the intermediate results of clipping the
   -- previous variable to the left edge of the clipping rectangle.

   procedure DISPOSE is new UNCHECKED_DEALLOCATION
      (OBJECT => AREA, NAME => LIST_OF_AREAS);
   -- This procedure is used to get rid of the intermediate areas after
   -- they have been used in the next stage.

   OLD_AREA : LIST_OF_AREAS;
   -- This variable is used when disposing of unneeded areas.

   function "=" (FIRST, LAST : DC.POINT) return BOOLEAN
      renames DC."=";
   -- This allows the function to be visible locally.

begin

   -- Test to see if the list of points already connects the last point
   -- with the first point.
   if INPUT_AREA (1) = INPUT_AREA (INPUT_AREA'LAST) then

      -- If so, send the original input points to a procedure which
      -- clips them on the right edge of the clipping rectangle.
      AREA_CLIPPING_UTILITIES.CLIP_ON_RIGHT
         (INPUT_AREA, CLIPPING_RECTANGLE.XMAX, RIGHT_CLIPPED_AREAS);

   else
      -- If not, then make the last point connect to the first one, and
      -- call the clipping procedure.
      declare
         COMPLETE_INPUT_AREA :
            DC.POINT_ARRAY (1 .. INPUT_AREA'LAST + 1);
      begin
         COMPLETE_INPUT_AREA (1 .. INPUT_AREA'LAST) := INPUT_AREA;
         COMPLETE_INPUT_AREA (INPUT_AREA'LAST + 1) := INPUT_AREA (1);
         AREA_CLIPPING_UTILITIES.CLIP_ON_RIGHT (COMPLETE_INPUT_AREA,
            CLIPPING_RECTANGLE.XMAX, RIGHT_CLIPPED_AREAS);
      end; -- block

   end if;

   -- Send the resulting area(s) to a procedure which clips them by
   -- the lower edge of the clipping rectangle.
   while RIGHT_CLIPPED_AREAS /= null loop

      AREA_CLIPPING_UTILITIES.CLIP_ON_BOTTOM
         (RIGHT_CLIPPED_AREAS.BORDER.POINTS, CLIPPING_RECTANGLE.YMIN,
          BOTTOM_CLIPPED_AREAS);

      -- Repeat with the next area and get rid of the old one.
      OLD_AREA := RIGHT_CLIPPED_AREAS;
      RIGHT_CLIPPED_AREAS := RIGHT_CLIPPED_AREAS.NEXT_AREA;
      DISPOSE (OLD_AREA);

   end loop;

   -- Send the resulting area(s) to a procedure which clips them by
   -- the left edge of the clipping rectangle.
   while BOTTOM_CLIPPED_AREAS /= null loop

      AREA_CLIPPING_UTILITIES.CLIP_ON_LEFT
         (BOTTOM_CLIPPED_AREAS.BORDER.POINTS, CLIPPING_RECTANGLE.XMIN,
          LEFT_CLIPPED_AREAS);

      -- Repeat with the next area and get rid of the old one.
      OLD_AREA := BOTTOM_CLIPPED_AREAS;
      BOTTOM_CLIPPED_AREAS := BOTTOM_CLIPPED_AREAS.NEXT_AREA;
      DISPOSE (OLD_AREA);

   end loop;

   OUTPUT_AREAS := null;

   -- Send the resulting area(s) to a procedure which clips them by
   -- the top edge of the clipping rectangle.
   while LEFT_CLIPPED_AREAS /= null loop

      AREA_CLIPPING_UTILITIES.CLIP_ON_TOP
         (LEFT_CLIPPED_AREAS.BORDER.POINTS, CLIPPING_RECTANGLE.YMAX,
          OUTPUT_AREAS);

      -- Repeat with the next area and get rid of the old one.
      OLD_AREA := LEFT_CLIPPED_AREAS;
      LEFT_CLIPPED_AREAS := LEFT_CLIPPED_AREAS.NEXT_AREA;
      DISPOSE (OLD_AREA);

   end loop;

end AREA_CLIP;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_TEXT_CLIP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: TEXT_CLIP
--  IDENTIFIER: GDMXXX.1(4)
--  DISCREPANCY REPORTS:
--  DR029  Completely clipped string of text.
------------------------------------------------------------------
-- FILE  : TEXT_CLIP.ADA
-- LEVEL : MA

separate (WSR_UTILITIES)

procedure TEXT_CLIP
   (TEXT_POSITION      : DC.POINT;
    TEXT_LENGTH        : INTEGER;
    CLIP_RECTANGLE     : DC.RECTANGLE_LIMITS;
    OFFSET             : DC.POINT;
    FIRST_VIS_CHAR     : out POSITIVE;
    LAST_VIS_CHAR      : out POSITIVE) is

-- This procedure does the clipping required for string precision,
-- it looks at the starting position to see if it is in the effective
-- clipping rectangle. The starting point can be in the rectangle and
-- part of the text could extend out.

TEXT_POS   : DC.POINT := ((TEXT_POSITION.X, TEXT_POSITION.Y));
-- Contains the TEXT_POS to enable us to change the value.

IN_WINDOW  : BOOLEAN := FALSE;
-- Contains a flag indicating if a point is in the window.

FIRST_CHAR : POSITIVE := 1;
-- Indicates the first character in the string that is visible.

LAST_CHAR  : POSITIVE := 1;
-- Indicates the last character in the string that is visible.

begin

  for I in 1 .. TEXT_LENGTH loop

      if (TEXT_POS.X < CLIP_RECTANGLE.XMIN) or
         (TEXT_POS.Y < CLIP_RECTANGLE.YMIN) or
         (TEXT_POS.X > CLIP_RECTANGLE.XMAX) or
         (TEXT_POS.Y > CLIP_RECTANGLE.YMAX) then

         if IN_WINDOW = FALSE then
            FIRST_CHAR := FIRST_CHAR + 1;
            LAST_CHAR := LAST_CHAR + 1;
            -- start of character in string is out of window
         else
            LAST_CHAR := LAST_CHAR - 1;
            exit;
            -- character in string is out of window, previous character
            -- is in the window.
            -- EXIT CONDITION RAISED.
         end if;
      else
         IN_WINDOW := TRUE;
         if LAST_CHAR = TEXT_LENGTH then
            exit;
         else
            LAST_CHAR := LAST_CHAR + 1;
         end if;
      end if;
      TEXT_POS.X := TEXT_POS.X + OFFSET.X;
      TEXT_POS.Y := TEXT_POS.Y + OFFSET.Y;
   end loop;

   if IN_WINDOW = false then
      FIRST_CHAR := 2; -- FORCES A NULL LOOP IN TEXT.
      LAST_CHAR  := 1;
      -- Covers the case where no characters are in the window.
   end if;

   FIRST_VIS_CHAR := FIRST_CHAR;
   LAST_VIS_CHAR  := LAST_CHAR;

end TEXT_CLIP;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_LINE_CLIP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LINE_CLIP
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR018  One case goes into infinite loop.
------------------------------------------------------------------
-- FILE: WSR_LINE_CLIP.ADA
-- LEVEL: all

SEPARATE(WSR_UTILITIES)

procedure LINE_CLIP
   (FIRST_POINT    : DC.POINT;
    LAST_POINT     : DC.POINT;
    CLIPPED_FIRST  : out DC.POINT;
    CLIPPED_LAST   : out DC.POINT;
    CLIP_RECTANGLE : DC.RECTANGLE_LIMITS;
    CLIP_FLAG      : out CLIP_INDICATOR) is

   -- This procedure clips a single line made up of two points, FIRST_
   -- POINT and LAST_POINT. The line is clipped to the CLIP_RECTANGLE
   -- limits. This procedure returns a CLIP_FLAG that decribes the
   -- action performed from the applied clipping.
   --
   -- FIRST_POINT    - Contains the first point of the line.
   -- LAST_POINT     - Contains the last point of the line.
   -- CLIPPED_FIRST  - Contains the first clipped point.
   -- CLIPPED_LAST   - Contains the last clipped point.
   -- CLIP_RECTANGLE - Contains the clipping rectangle.
   -- CLIP_FLAG      - Contains the action performed on the points.

   type LOCATION is (OK, LEFT, TOP, RIGHT, BOTTOM);
   -- Contains the position of a point.

   type POSITION_STATUS is record
        X : LOCATION := OK;
        Y : LOCATION := OK;
   end record;
   -- Contains a record describing the point.

   STATUS_FIRST, STATUS_LAST : POSITION_STATUS;
   -- Keeps track of the position of each point.

   VALID_POINTS : INTEGER := 0;
   -- Number of valid points.

   CLIP_STATE : CLIP_INDICATOR := ERROR;
   -- Contains the state of clipping.

   X : DC_TYPE;
   -- Temporary X value
   Y : DC_TYPE;
   -- Temporary Y value

   XMIN        : DC_TYPE := CLIP_RECTANGLE.XMIN;
   YMIN        : DC_TYPE := CLIP_RECTANGLE.YMIN;
   XMAX        : DC_TYPE := CLIP_RECTANGLE.XMAX;
   YMAX        : DC_TYPE := CLIP_RECTANGLE.YMAX;

   INTERCEPT : array (LOCATION) of DC_TYPE := (0.0,XMIN,YMAX,XMAX,YMIN);

begin

   CLIPPED_FIRST := FIRST_POINT;
   CLIPPED_LAST  := LAST_POINT;

   if (FIRST_POINT.X < XMIN) then STATUS_FIRST.X := LEFT ; end if;
   if (FIRST_POINT.X > XMAX) then STATUS_FIRST.X := RIGHT; end if;
   if (FIRST_POINT.Y < YMIN) then STATUS_FIRST.Y := BOTTOM ; end if;
   if (FIRST_POINT.Y > YMAX) then STATUS_FIRST.Y := TOP ; end if;

   if (LAST_POINT.X < XMIN) then STATUS_LAST.X := LEFT ; end if;
   if (LAST_POINT.X > XMAX) then STATUS_LAST.X := RIGHT; end if;
   if (LAST_POINT.Y < YMIN) then STATUS_LAST.Y := BOTTOM ; end if;
   if (LAST_POINT.Y > YMAX) then STATUS_LAST.Y := TOP ; end if;
   -- finds the locations of both points.

   if STATUS_FIRST.X = OK and STATUS_FIRST.Y = OK then
      VALID_POINTS := VALID_POINTS + 1;
   end if;

   if STATUS_LAST.X = OK and STATUS_LAST.Y = OK then
      VALID_POINTS := VALID_POINTS + 1;
   end if;

   if VALID_POINTS = 2 then
      CLIP_STATE := NO_CLIPPING;
   end if;

   if STATUS_FIRST.X = STATUS_LAST.X and STATUS_FIRST.X /= OK then
      CLIP_STATE := OUT_OF_BOUNDS;
   end if;

   if STATUS_FIRST.Y = STATUS_LAST.Y and STATUS_FIRST.Y /= OK then
      CLIP_STATE := OUT_OF_BOUNDS;
   end if;

   if CLIP_STATE /= OUT_OF_BOUNDS and CLIP_STATE /= NO_CLIPPING then

      for I in LEFT .. BOTTOM loop
          if STATUS_FIRST.Y = I or STATUS_LAST.Y = I then
             X := (INTERCEPT(I) - FIRST_POINT.Y) *
                  (LAST_POINT.X - FIRST_POINT.X) /
                  (LAST_POINT.Y - FIRST_POINT.Y) + FIRST_POINT.X;
             -- Find the x intersection.
             if X >= XMIN and X <= XMAX then
                if STATUS_FIRST.Y = I then
                   CLIPPED_FIRST.Y := INTERCEPT(I);
                   CLIPPED_FIRST.X := X;
                   if CLIP_STATE = ERROR then
                      CLIP_STATE := FIRST;
                   end if;
                else
                   CLIPPED_LAST.Y := INTERCEPT(I);
                   CLIPPED_LAST.X := X;
                   CLIP_STATE := LAST;
                end if;
                VALID_POINTS := VALID_POINTS + 1;
             end if;
          end if;
          if VALID_POINTS = 2 then
             exit;
          end if;

          if STATUS_FIRST.X = I or STATUS_LAST.X = I then
             Y := (INTERCEPT(I) - FIRST_POINT.X) *
                  (LAST_POINT.Y - FIRST_POINT.Y) /
                  (LAST_POINT.X - FIRST_POINT.X) + FIRST_POINT.Y;
             -- Finds the Y intersection.
             if Y >= YMIN and Y <= YMAX then
                if STATUS_FIRST.X = I then
                   CLIPPED_FIRST.X := INTERCEPT(I);
                   CLIPPED_FIRST.Y := Y;
                   if CLIP_STATE = ERROR then
                      CLIP_STATE := FIRST;
                   end if;
                else
                   CLIPPED_LAST.X := INTERCEPT(I);
                   CLIPPED_LAST.Y := Y;
                   CLIP_STATE := LAST;
                end if;
                VALID_POINTS := VALID_POINTS + 1;
             end if;
          end if;
          if VALID_POINTS = 2 then
             exit;
          end if;
       end loop;
   end if;
   CLIP_FLAG := CLIP_STATE;
end LINE_CLIP;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_TEXT_HANDLING.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: TEXT_HANDLING
--  IDENTIFIER: GDMXXX.2(2)
--  DISCREPANCY REPORTS:
--  DR020  Text not working.
------------------------------------------------------------------
-- FILE  : WSR_TEXT_HANDLING.ADA
-- LEVEL : MA

separate (WSR_UTILITIES)

procedure TEXT_HANDLING
   (CAP_TOP          : DC_TYPE;
    BASE_BOTTOM      : DC_TYPE;
    T_PATH           : TEXT_PATH;
    T_ALIGNMENT      : TEXT_ALIGNMENT;
    CHAR_HEIGHT_VECT : DC.VECTOR;
    CHAR_WIDTH_VECT  : DC.VECTOR;
    CHAR_EXP_FACTOR  : CHAR_EXPANSION;
    CHAR_SPACE       : CHAR_SPACING;
    TEXT_POSITION    : in DC.POINT;
    TEXT_LENGTH      : INTEGER;
    CHARACTER_FONT   : DC_TYPE;
    START_POSITION   : out DC.POINT;
    OFFSET           : out DC.POINT;
    TEI_LOWER_LEFT   : out DC.POINT;
    TEI_LOWER_RIGHT  : out DC.POINT;
    TEI_UPPER_LEFT   : out DC.POINT;
    TEI_UPPER_RIGHT  : out DC.POINT) is

-- This procedure defines the Starting Point and the X-Y Displacements
-- for displaying a given text string.  This procedure also calculates
-- the Text Extent Parallelogram.  The Starting Point returned is the
-- LEFT-BASE point of the first character to be displayed.  The Text
-- Extent Parallelogram consists of the Upper Left, Lower Left, Upper
-- Right, and Lower Right points of the text string.
--
-- Parameter definition section.
--
--  CAP_TOP          - The fraction of character height to Topline.
--  BASE_BOTTOM      - The fraction of character width to Bottomline.
--  T_PATH           - The text flow: Right, Left, Up, or Down.
--  T_ALIGNMENT      - The horizontal and vertical text position.
--  CHAR_HEIGHT_VECT - The Up/Down component vector.
--  CHAR_WIDTH_VECT  - The Left/Right component vector.
--  CHAR_EXP_FACTOR  - The width only ratio scale factor.
--  CHAR_SPACE       - The character spacing term.
--  TEXT_POSITION    - The requested starting position of the text.
--  TEXT_LENGTH      - The text string length.
--  CHARACTER_FONT   - The Font Height/Width ratio factor.
--  START_POSITION   - The returned starting position of the text.
--  OFFSET           - The text displacement for each character.
--  TEI_LOWER_LEFT   - The lower left part of the text parallelogram.
--  TEI_LOWER_RIGHT  - The lower right part of the text parallelogram.
--  TEI_UPPER_LEFT   - The upper left part of the text parallelogram.
--  TEI_UPPER_RIGHT  - The upper right part of the text parallelogram.

-- Variable section.

PHYS_CHAR_HT         : DC_TYPE;
-- The character height, from topline to bottomline, measured along
-- the character.

PHYS_CHAR_WT         : DC_TYPE;
--  The character width, from left to right, measured along the character.

X_COMP_HT_VECT       : DC_TYPE;
-- The X component of the Up Vector.

Y_COMP_HT_VECT       : DC_TYPE;
-- The Y component of the Up Vector.

X_COMP_WT_VECT       : DC_TYPE;
-- The X component of the Base Vector.

Y_COMP_WT_VECT       : DC_TYPE;
-- The Y component of the Base Vector.

TOTAL_CHAR_HT        : DC_TYPE;
-- The total height of the text string.

TOTAL_CHAR_WT        : DC_TYPE;
-- The total width of the text string.

BOTT_VALUE           : DC_TYPE;
-- A percentage of the character height.

TOP_VALUE            : DC_TYPE;
-- A percentage of the character height.

CHAR_HEIGHT          : DC_TYPE;
-- The character height determined from its vector.

CHAR_WIDTH           : DC_TYPE;
-- The character width determined from its vector.

TEXT_ALIGN           : TEXT_ALIGNMENT := T_ALIGNMENT;
-- A copy of the Text Alignment used to resolve any NORMAL components.

START_POINT          : DC.POINT;
-- A copy of Start Position used for calculations.

TEXT_LOWER_LEFT      : DC.POINT;
-- Temporary Text Extent Rectangle value.

TEXT_LOWER_RIGHT     : DC.POINT;
-- Temporary Text Extent Rectangle value.

TEXT_UPPER_LEFT      : DC.POINT;
-- Temporary Text Extent Rectangle value.

TEXT_UPPER_RIGHT     : DC.POINT;
-- Temporary Text Extent Rectangle value.

DISPLACE             : DC.POINT;
-- Temporary Offset value.

CHAR_SPACE_VALUE     : DC_TYPE;
-- Actual character spacing value.

-- Square Root routine using Newton-Raphson Method.

function SQRT (C : DC_TYPE) return DC_TYPE is

X0 : DC_TYPE := 1.0;
XK : DC_TYPE;
CT : INTEGER := 0;

begin
   XK := (C + (X0 * X0)) / (2.0 * X0);

   loop
      X0 := XK;
      XK := (C + (X0 * X0)) / (2.0 * X0);
      if XK > X0 then
         if (XK - X0) <= 0.00001 then
            exit;
         end if;
      else
         if (X0 - XK) <= 0.00001 then
            exit;
         end if;
      end if;

      CT := CT + 1;
      if CT > 50 then
         exit;
      end if;
   end loop;

   return XK;
end SQRT;

begin

   -- Initialize the Starting Position to the given Text Position.

   START_POINT.X := TEXT_POSITION.X;
   START_POINT.Y := TEXT_POSITION.Y;

   -- Resolve any NORMAL components of the Text Alignment.
   -- Horizontal component.

   if TEXT_ALIGN.HORIZONTAL = NORMAL then
      case T_PATH is
         when RIGHT     =>
                           TEXT_ALIGN.HORIZONTAL := LEFT;

         when LEFT      =>
                           TEXT_ALIGN.HORIZONTAL := RIGHT;

         when UP | DOWN =>
                           TEXT_ALIGN.HORIZONTAL := CENTRE;
      end case;
   end if;

   -- Vertical component.

   if TEXT_ALIGN.VERTICAL = NORMAL then
      case T_PATH is
         when DOWN              =>
                                   TEXT_ALIGN.VERTICAL := TOP;

         when RIGHT | LEFT | UP =>
                                   TEXT_ALIGN.VERTICAL := BASE;
      end case;
   end if;

   -- Determine the Character Height Vector and Character Width Vector
   -- components.  These components are used in place of SIN and COS to
   -- perform the vector calculations.

   CHAR_HEIGHT := SQRT ((CHAR_HEIGHT_VECT.X * CHAR_HEIGHT_VECT.X) +
        (CHAR_HEIGHT_VECT.Y * CHAR_HEIGHT_VECT.Y));

   CHAR_WIDTH := SQRT ((CHAR_WIDTH_VECT.X * CHAR_WIDTH_VECT.X) +
        (CHAR_WIDTH_VECT.Y * CHAR_WIDTH_VECT.Y));

   BOTT_VALUE := CHAR_HEIGHT * BASE_BOTTOM;
   TOP_VALUE := CHAR_HEIGHT * CAP_TOP;

   PHYS_CHAR_HT := CHAR_HEIGHT + BOTT_VALUE + TOP_VALUE;
   PHYS_CHAR_WT := CHAR_WIDTH * DC_TYPE (CHAR_EXP_FACTOR) *
        CHARACTER_FONT;

   X_COMP_HT_VECT := CHAR_HEIGHT_VECT.X / CHAR_HEIGHT;
   Y_COMP_HT_VECT := CHAR_HEIGHT_VECT.Y / CHAR_HEIGHT;

   X_COMP_WT_VECT := CHAR_WIDTH_VECT.X / CHAR_WIDTH;
   Y_COMP_WT_VECT := CHAR_WIDTH_VECT.Y / CHAR_WIDTH;

   CHAR_SPACE_VALUE := DC_TYPE (CHAR_SPACE) * CHAR_HEIGHT;

   -- Determine the Offsets.

   case T_PATH is
      when UP    =>
                    DISPLACE.X := (PHYS_CHAR_HT + CHAR_SPACE_VALUE) *
                       X_COMP_HT_VECT;
                    DISPLACE.Y := (PHYS_CHAR_HT + CHAR_SPACE_VALUE) *
                       Y_COMP_HT_VECT;

      when DOWN  =>
                    DISPLACE.X := 0.0 - ((PHYS_CHAR_HT +
                       CHAR_SPACE_VALUE) * X_COMP_HT_VECT);
                    DISPLACE.Y := 0.0 - ((PHYS_CHAR_HT +
                       CHAR_SPACE_VALUE) * Y_COMP_HT_VECT);

      when LEFT  =>
                    DISPLACE.X := 0.0 - ((PHYS_CHAR_WT +
                       CHAR_SPACE_VALUE) * X_COMP_WT_VECT);
                    DISPLACE.Y := 0.0 - ((PHYS_CHAR_WT +
                       CHAR_SPACE_VALUE) * Y_COMP_WT_VECT);

      when RIGHT =>
                    DISPLACE.X := (PHYS_CHAR_WT + CHAR_SPACE_VALUE) *
                       X_COMP_WT_VECT;
                    DISPLACE.Y := (PHYS_CHAR_WT + CHAR_SPACE_VALUE) *
                       Y_COMP_WT_VECT;
   end case;

   -- Determine the Total Character Height, the Total Character Width, the
   -- Text Alignment (TA) offset for the specified Text Path, and the
   -- proper X and Y components to be used.  All alignments are offset to
   -- the LEFT-BASE of the first text character during initial calculation.

   case T_PATH is
      when UP =>
                    TOTAL_CHAR_HT := (DC_TYPE (TEXT_LENGTH) *
                       (PHYS_CHAR_HT + CHAR_SPACE_VALUE)) -
                       CHAR_SPACE_VALUE;

                    TOTAL_CHAR_WT := PHYS_CHAR_WT;

                    -- Offset the Starting Point from CENTRE-BASE to
                    -- LEFT-BASE of the first character.

                    START_POINT.X := START_POINT.X -
                       ((PHYS_CHAR_WT / 2.0) * X_COMP_WT_VECT);
                    START_POINT.Y := START_POINT.Y -
                       ((PHYS_CHAR_WT / 2.0) * Y_COMP_WT_VECT);

      when DOWN =>
                    TOTAL_CHAR_HT := (DC_TYPE (TEXT_LENGTH) *
                       (PHYS_CHAR_HT + CHAR_SPACE_VALUE)) -
                       CHAR_SPACE_VALUE;

                    TOTAL_CHAR_WT := PHYS_CHAR_WT;

                    -- Offset the Starting Point from CENTRE-TOP to
                    --  LEFT-BASE of the first charactter.

                    START_POINT.X := START_POINT.X -
                       ((PHYS_CHAR_WT / 2.0) * X_COMP_WT_VECT);
                    START_POINT.Y := START_POINT.Y -
                       ((PHYS_CHAR_WT / 2.0) * Y_COMP_WT_VECT);

                    START_POINT.X := START_POINT.X -
                       ((PHYS_CHAR_HT - BOTT_VALUE) * X_COMP_HT_VECT);
                    START_POINT.Y := START_POINT.Y -
                       ((PHYS_CHAR_HT - BOTT_VALUE) * Y_COMP_HT_VECT);

      when LEFT =>
                    TOTAL_CHAR_HT := PHYS_CHAR_HT;

                    TOTAL_CHAR_WT := (DC_TYPE (TEXT_LENGTH) *
                       (PHYS_CHAR_WT + CHAR_SPACE_VALUE)) -
                       CHAR_SPACE_VALUE;

                    -- Offset the Starting Point from RIGHT-BASE to
                    -- LEFT-BASE of the first character.

                    START_POINT.X := START_POINT.X -
                       (PHYS_CHAR_WT * X_COMP_WT_VECT);
                    START_POINT.Y := START_POINT.Y -
                       (PHYS_CHAR_WT * Y_COMP_WT_VECT);

      when RIGHT =>
                    TOTAL_CHAR_HT := PHYS_CHAR_HT;

                    TOTAL_CHAR_WT := (DC_TYPE (TEXT_LENGTH) *
                       (PHYS_CHAR_WT + CHAR_SPACE_VALUE)) -
                       CHAR_SPACE_VALUE;

                    -- No Starting Point offset is required because the
                    -- default is already LEFT-BASE.
   end case;

   -- Determine the actual Starting Point.
   -- Horizontal component.

   case T_PATH is
      when UP =>
            case TEXT_ALIGN.HORIZONTAL is
               when CENTRE =>
                     null;

               when LEFT =>
                     START_POINT.X := START_POINT.X + ((TOTAL_CHAR_WT *
                        X_COMP_WT_VECT) / 2.0);
                     START_POINT.Y := START_POINT.Y + ((TOTAL_CHAR_WT *
                        Y_COMP_WT_VECT) / 2.0);

               when RIGHT =>
                     START_POINT.X := START_POINT.X - ((TOTAL_CHAR_WT *
                        X_COMP_WT_VECT) / 2.0);
                     START_POINT.Y := START_POINT.Y - ((TOTAL_CHAR_WT *
                        Y_COMP_WT_VECT) / 2.0);

               when NORMAL =>
                    null; -- Will never occur.
            end case;

            case TEXT_ALIGN.VERTICAL is
               when TOP =>
                     START_POINT.X := START_POINT.X - ((TOTAL_CHAR_HT -
                        BOTT_VALUE) * X_COMP_HT_VECT);
                     START_POINT.Y := START_POINT.Y - ((TOTAL_CHAR_HT -
                        BOTT_VALUE) * Y_COMP_HT_VECT);

               when CAP =>
                     START_POINT.X := START_POINT.X - ((TOTAL_CHAR_HT -
                        BOTT_VALUE - TOP_VALUE) * X_COMP_HT_VECT);
                     START_POINT.Y := START_POINT.Y - ((TOTAL_CHAR_HT -
                        BOTT_VALUE - TOP_VALUE) * Y_COMP_HT_VECT);

               when HALF =>
                     START_POINT.X := START_POINT.X - (((TOTAL_CHAR_HT -
                        BOTT_VALUE) * X_COMP_HT_VECT) / 2.0);
                     START_POINT.Y := START_POINT.Y - (((TOTAL_CHAR_HT -
                        BOTT_VALUE) * Y_COMP_HT_VECT) / 2.0);

               when BASE =>
                     null;

               when BOTTOM =>
                     START_POINT.X := START_POINT.X + (BOTT_VALUE *
                        X_COMP_HT_VECT);
                     START_POINT.Y := START_POINT.Y + (BOTT_VALUE *
                        Y_COMP_HT_VECT);

               when NORMAL =>
                     null; -- Will never occur.
            end case;

      when DOWN =>
            case TEXT_ALIGN.HORIZONTAL is
               when CENTRE =>
                     null;

               when LEFT =>
                     START_POINT.X := START_POINT.X + ((TOTAL_CHAR_WT *
                        X_COMP_WT_VECT) / 2.0);
                     START_POINT.Y := START_POINT.Y + ((TOTAL_CHAR_WT *
                        Y_COMP_WT_VECT) / 2.0);

               when RIGHT =>
                     START_POINT.X := START_POINT.X - ((TOTAL_CHAR_WT *
                        X_COMP_WT_VECT) / 2.0);
                     START_POINT.Y := START_POINT.Y - ((TOTAL_CHAR_WT *
                        Y_COMP_WT_VECT) / 2.0);

               when NORMAL =>
                    null; -- Will never occur.
            end case;

            case TEXT_ALIGN.VERTICAL is
               when TOP =>
                     null;

               when CAP =>
                     START_POINT.X := START_POINT.X + (TOP_VALUE *
                        X_COMP_HT_VECT);
                     START_POINT.Y := START_POINT.Y + (TOP_VALUE *
                        Y_COMP_HT_VECT);

               when HALF =>
                     START_POINT.X := START_POINT.X + ((TOTAL_CHAR_HT
                        * X_COMP_HT_VECT) / 2.0);
                     START_POINT.Y := START_POINT.Y + ((TOTAL_CHAR_HT
                        * Y_COMP_HT_VECT) / 2.0);

               when BASE =>
                     START_POINT.X := START_POINT.X + ((TOTAL_CHAR_WT -
                        BOTT_VALUE) * X_COMP_HT_VECT);
                     START_POINT.Y := START_POINT.Y + ((TOTAL_CHAR_HT -
                        BOTT_VALUE) * Y_COMP_HT_VECT);

               when BOTTOM =>
                     START_POINT.X := START_POINT.X + (TOTAL_CHAR_WT *
                        X_COMP_HT_VECT);
                     START_POINT.Y := START_POINT.Y + (TOTAL_CHAR_WT *
                        Y_COMP_HT_VECT);

               when NORMAL =>
                     null; -- Will never occur.
            end case;

      when LEFT =>
            case TEXT_ALIGN.HORIZONTAL is
               when CENTRE =>
                     START_POINT.X := START_POINT.X + ((TOTAL_CHAR_WT *
                        X_COMP_WT_VECT) / 2.0);
                     START_POINT.Y := START_POINT.Y + ((TOTAL_CHAR_WT *
                        Y_COMP_WT_VECT) / 2.0);

               when LEFT =>
                     START_POINT.X := START_POINT.X + (TOTAL_CHAR_WT *
                        X_COMP_WT_VECT);
                     START_POINT.Y := START_POINT.Y + (TOTAL_CHAR_WT *
                        Y_COMP_WT_VECT);

               when RIGHT =>
                     null;

               when NORMAL =>
                    null; -- Will never occur.
            end case;

            case TEXT_ALIGN.VERTICAL is
               when TOP =>
                     START_POINT.X := START_POINT.X - ((TOTAL_CHAR_HT -
                        BOTT_VALUE) * X_COMP_HT_VECT);
                     START_POINT.Y := START_POINT.Y - ((TOTAL_CHAR_HT -
                        BOTT_VALUE) * Y_COMP_HT_VECT);

               when CAP =>
                     START_POINT.X := START_POINT.X - ((TOTAL_CHAR_HT -
                        BOTT_VALUE - TOP_VALUE) * X_COMP_HT_VECT);
                     START_POINT.Y := START_POINT.Y - ((TOTAL_CHAR_HT -
                        BOTT_VALUE - TOP_VALUE) * Y_COMP_HT_VECT);

               when HALF =>
                     START_POINT.X := START_POINT.X - (((TOTAL_CHAR_HT -
                        BOTT_VALUE) * X_COMP_HT_VECT) / 2.0);
                     START_POINT.Y := START_POINT.Y - (((TOTAL_CHAR_HT -
                        BOTT_VALUE) * Y_COMP_HT_VECT) / 2.0);

               when BASE =>
                     null;

               when BOTTOM =>
                     START_POINT.X := START_POINT.X + (BOTT_VALUE *
                        X_COMP_HT_VECT);
                     START_POINT.Y := START_POINT.Y + (BOTT_VALUE *
                        Y_COMP_HT_VECT);

               when NORMAL =>
                     null; -- Will never occur.
            end case;

      when RIGHT =>
            case TEXT_ALIGN.HORIZONTAL is
               when CENTRE =>
                     START_POINT.X := START_POINT.X - ((TOTAL_CHAR_WT *
                        X_COMP_WT_VECT) / 2.0);
                     START_POINT.Y := START_POINT.Y - ((TOTAL_CHAR_WT *
                        Y_COMP_WT_VECT) / 2.0);

               when LEFT =>
                     null;

               when RIGHT =>
                     START_POINT.X := START_POINT.X - (TOTAL_CHAR_WT *
                        X_COMP_WT_VECT);
                     START_POINT.Y := START_POINT.Y - (TOTAL_CHAR_WT *
                        Y_COMP_WT_VECT);

               when NORMAL =>
                    null; -- Will never occur.
            end case;

            case TEXT_ALIGN.VERTICAL is
               when TOP =>
                     START_POINT.X := START_POINT.X - ((TOTAL_CHAR_HT -
                        BOTT_VALUE) * X_COMP_HT_VECT);
                     START_POINT.Y := START_POINT.Y - ((TOTAL_CHAR_HT -
                        BOTT_VALUE) * Y_COMP_HT_VECT);

               when CAP =>
                     START_POINT.X := START_POINT.X - ((TOTAL_CHAR_HT -
                        BOTT_VALUE - TOP_VALUE) * X_COMP_HT_VECT);
                     START_POINT.Y := START_POINT.Y - ((TOTAL_CHAR_HT -
                        BOTT_VALUE - TOP_VALUE) * Y_COMP_HT_VECT);

               when HALF =>
                     START_POINT.X := START_POINT.X - ((TOTAL_CHAR_HT
                        * X_COMP_HT_VECT) / 2.0);
                     START_POINT.Y := START_POINT.Y - ((TOTAL_CHAR_HT
                        * Y_COMP_HT_VECT) / 2.0);

               when BASE =>
                     null;

               when BOTTOM =>
                     START_POINT.X := START_POINT.X + (BOTT_VALUE *
                        X_COMP_HT_VECT);
                     START_POINT.Y := START_POINT.Y + (BOTT_VALUE *
                        Y_COMP_HT_VECT);

               when NORMAL =>
                     null; -- Will never occur.
            end case;
   end case;

   -- Calculate the all of the Text Extent Rectange coordinates.

   case T_PATH is
      when UP    =>
                    TEXT_LOWER_LEFT.X := START_POINT.X -
                       (BOTT_VALUE * X_COMP_HT_VECT);
                    TEXT_LOWER_LEFT.Y := START_POINT.Y -
                       (BOTT_VALUE * Y_COMP_HT_VECT);

                    TEXT_LOWER_RIGHT.X :=
                       TEXT_LOWER_LEFT.X + (PHYS_CHAR_WT *
                          X_COMP_WT_VECT);
                    TEXT_LOWER_RIGHT.Y :=
                       TEXT_LOWER_LEFT.Y + (PHYS_CHAR_WT *
                          Y_COMP_WT_VECT);

                    TEXT_UPPER_LEFT.X :=
                       TEXT_LOWER_LEFT.X + (DISPLACE.X *
                          DC_TYPE (TEXT_LENGTH));
                    TEXT_UPPER_LEFT.Y :=
                       TEXT_LOWER_LEFT.Y + (DISPLACE.Y *
                          DC_TYPE (TEXT_LENGTH));

                    TEXT_UPPER_RIGHT.X :=
                       TEXT_LOWER_RIGHT.X + (DISPLACE.X *
                          DC_TYPE (TEXT_LENGTH));
                    TEXT_UPPER_RIGHT.Y :=
                       TEXT_LOWER_RIGHT.Y + (DISPLACE.Y *
                          DC_TYPE (TEXT_LENGTH));

      when DOWN  =>
                    TEXT_UPPER_LEFT.X := START_POINT.X +
                       ((PHYS_CHAR_HT - BOTT_VALUE) * X_COMP_HT_VECT);
                    TEXT_UPPER_LEFT.Y := START_POINT.Y +
                       ((PHYS_CHAR_HT - BOTT_VALUE) * Y_COMP_HT_VECT);

                    TEXT_UPPER_RIGHT.X :=
                       TEXT_UPPER_LEFT.X + (PHYS_CHAR_WT *
                          X_COMP_WT_VECT);
                    TEXT_UPPER_RIGHT.Y :=
                       TEXT_UPPER_LEFT.Y + (PHYS_CHAR_WT *
                          Y_COMP_WT_VECT);

                    TEXT_LOWER_LEFT.X :=
                       TEXT_UPPER_LEFT.X + (DISPLACE.X *
                          DC_TYPE (TEXT_LENGTH));
                    TEXT_LOWER_LEFT.Y :=
                       TEXT_UPPER_LEFT.Y + (DISPLACE.Y *
                          DC_TYPE (TEXT_LENGTH));

                    TEXT_LOWER_RIGHT.X :=
                       TEXT_UPPER_RIGHT.X + (DISPLACE.X *
                          DC_TYPE (TEXT_LENGTH));
                    TEXT_LOWER_RIGHT.Y :=
                       TEXT_UPPER_RIGHT.Y + (DISPLACE.Y *
                          DC_TYPE (TEXT_LENGTH));

      when LEFT  =>
                    TEXT_LOWER_RIGHT.X := START_POINT.X - DISPLACE.X -
                       (BOTT_VALUE * X_COMP_HT_VECT);
                    TEXT_LOWER_RIGHT.Y := START_POINT.Y - DISPLACE.Y -
                       (BOTT_VALUE * Y_COMP_HT_VECT);

                    TEXT_UPPER_RIGHT.X := START_POINT.X - DISPLACE.X +
                       ((PHYS_CHAR_HT - BOTT_VALUE) * X_COMP_HT_VECT);
                    TEXT_UPPER_RIGHT.Y := START_POINT.Y - DISPLACE.Y +
                       ((PHYS_CHAR_HT - BOTT_VALUE) * Y_COMP_HT_VECT);

                    TEXT_LOWER_LEFT.X :=
                       TEXT_LOWER_RIGHT.X + (DISPLACE.X *
                          DC_TYPE (TEXT_LENGTH));
                    TEXT_LOWER_LEFT.Y :=
                       TEXT_LOWER_RIGHT.Y + (DISPLACE.Y *
                          DC_TYPE (TEXT_LENGTH));

                    TEXT_UPPER_LEFT.X :=
                       TEXT_UPPER_RIGHT.X + (DISPLACE.X *
                          DC_TYPE (TEXT_LENGTH));
                    TEXT_UPPER_LEFT.Y :=
                       TEXT_UPPER_RIGHT.Y + (DISPLACE.Y *
                          DC_TYPE (TEXT_LENGTH));

      when RIGHT =>
                    TEXT_LOWER_LEFT.X := START_POINT.X -
                       (BOTT_VALUE * X_COMP_HT_VECT);
                    TEXT_LOWER_LEFT.Y := START_POINT.Y -
                       (BOTT_VALUE * Y_COMP_HT_VECT);

                    TEXT_UPPER_LEFT.X := START_POINT.X +
                       ((PHYS_CHAR_HT - BOTT_VALUE) * X_COMP_HT_VECT);
                    TEXT_UPPER_LEFT.Y := START_POINT.Y +
                       ((PHYS_CHAR_HT - BOTT_VALUE) * Y_COMP_HT_VECT);

                    TEXT_LOWER_RIGHT.X :=
                       TEXT_LOWER_LEFT.X + (DISPLACE.X *
                          DC_TYPE (TEXT_LENGTH));
                    TEXT_LOWER_RIGHT.Y :=
                       TEXT_LOWER_LEFT.Y + (DISPLACE.Y *
                          DC_TYPE (TEXT_LENGTH));

                    TEXT_UPPER_RIGHT.X :=
                       TEXT_UPPER_LEFT.X + (DISPLACE.X *
                          DC_TYPE (TEXT_LENGTH));
                    TEXT_UPPER_RIGHT.Y :=
                       TEXT_UPPER_LEFT.Y + (DISPLACE.Y *
                          DC_TYPE (TEXT_LENGTH));
   end case;

   START_POSITION.X := START_POINT.X;
   START_POSITION.Y := START_POINT.Y;

   -- Set the out parameters of the Text Extent Rectangle to their proper
   -- values.

   TEI_LOWER_LEFT.X := TEXT_LOWER_LEFT.X;
   TEI_LOWER_LEFT.Y := TEXT_LOWER_LEFT.Y;

   TEI_LOWER_RIGHT.X := TEXT_LOWER_RIGHT.X;
   TEI_LOWER_RIGHT.Y := TEXT_LOWER_RIGHT.Y;

   TEI_UPPER_LEFT.X := TEXT_UPPER_LEFT.X;
   TEI_UPPER_LEFT.Y := TEXT_UPPER_LEFT.Y;

   TEI_UPPER_RIGHT.X := TEXT_UPPER_RIGHT.X;
   TEI_UPPER_RIGHT.Y := TEXT_UPPER_RIGHT.Y;

   OFFSET.X := DISPLACE.X;
   OFFSET.Y := DISPLACE.Y;

end TEXT_HANDLING;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_TRANSFORM.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: TRANSFORM
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: WSR_TRANSFORM.ADA
-- LEVEL: all

separate (WSR_UTILITIES)

function TRANSFORM
   (INPUT_VALUE     : float;
    INPUT_UPPER     : float;
    INPUT_LOWER     : float;
    TRANSFORM_UPPER : integer;
    TRANSFORM_LOWER : integer) return integer is

-- This function returns a transformed value that is converted from
-- one range of values to another range of values.
--
-- INPUT_VALUE      - The value to be converted.
-- INPUT_UPPER      - The upper range of the input number.
-- INPUT_LOWER      - The lower range of the input number.
-- TRANSFORM_UPPER  - The upper range of the new transformed range.
-- TRANSFORM_LOWER  - The lower range of the new transformed range.

OLD_RANGE : float := INPUT_UPPER - INPUT_LOWER;
-- Contains the input value range.

NEW_RANGE : integer := TRANSFORM_UPPER - TRANSFORM_LOWER;
-- Contains the transformed value range.

INTERMEDIATE_VALUE : float;
-- Contains the value mapped into the new range.

LOCATE_RANGE : integer;
-- Contains the number of the range the INTERMEDIATE_VALUE is in.

TRANSFORM_VALUE : integer;
-- Contains the number in the transformed range.

   begin
      if INPUT_VALUE = INPUT_UPPER then
         TRANSFORM_VALUE := TRANSFORM_UPPER;
      elsif INPUT_VALUE = INPUT_LOWER then
         TRANSFORM_VALUE := TRANSFORM_LOWER;
      else
         INTERMEDIATE_VALUE := (float(TRANSFORM_LOWER) *
            (INPUT_UPPER - INPUT_VALUE) / OLD_RANGE) -
            (float(TRANSFORM_UPPER) * (INPUT_LOWER - INPUT_VALUE) /
            OLD_RANGE);

          LOCATE_RANGE :=  integer(INTERMEDIATE_VALUE -
             float(TRANSFORM_LOWER));

          TRANSFORM_VALUE := integer(INTERMEDIATE_VALUE +
              (float(LOCATE_RANGE) / float(NEW_RANGE)) - 0.5);
      end if;
      return TRANSFORM_VALUE;
end TRANSFORM;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI_CLR_OPS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_COLOUR_OPERATIONS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: LEXI_CLR_OPS.ADA
-- LEVEL: MA

with GKS_TYPES;
with WS_STATE_LIST_TYPES;

use  GKS_TYPES;

package LEXI3700_COLOUR_OPERATIONS is

-- This package contains a procedure that sets the colour values for the
-- colour lookup table.

   procedure SET_COLOUR_REPRESENTATION
      (WS_SL  : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       INDEX  : COLOUR_INDEX;
       COLOUR : COLOUR_REPRESENTATION;
       ERROR  : out ERROR_INDICATOR);

end LEXI3700_COLOUR_OPERATIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI_CLR_OPS_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_COLOUR_OPERATIONS - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: LEXI_CLR_OPS_B.ADA
-- LEVEL: MA

with LEXI3700_TYPES;
with LEXI3700_OUTPUT_DRIVER;
with GKS_ERRORS;
with WSR_SET_COLOUR_TABLE;
with WSR_UTILITIES;

use  LEXI3700_TYPES;

package body LEXI3700_COLOUR_OPERATIONS is

-- The procedure for setting the colour representation on the Lexidata
-- is found in a separate file.

   procedure SET_COLOUR_REPRESENTATION
      (WS_SL  : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       INDEX  : COLOUR_INDEX;
       COLOUR : COLOUR_REPRESENTATION;
       ERROR  : out ERROR_INDICATOR) is separate;

end LEXI3700_COLOUR_OPERATIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSD_SET_CLR_REP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_COLOUR_REPRESENTATION
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: WSD_SET_CLR_REP.ADA
-- LEVEL : MA

separate (LEXI3700_COLOUR_OPERATIONS)

procedure SET_COLOUR_REPRESENTATION
   (WS_SL  : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    INDEX  : COLOUR_INDEX;
    COLOUR : COLOUR_REPRESENTATION;
    ERROR  : out ERROR_INDICATOR) is

-- This procedure sets the requested entry in the color lookup table to
-- a particular colour value.
--
-- This procedure calls a procedure to set the colour in the workstation
-- state list, converts the colour density values into the device
-- dependent values, and calls another procedure in the device driver
-- which sets the colour.
--
-- WS_SL  - a pointer to the workstation state list.
-- INDEX  - contains the index into its colour lookup table.
-- COLOUR - contains the new intensity value for the three colours -
--          red, blue, and green.
-- ERROR  - returns an error_indicator.

EI : ERROR_INDICATOR;
-- Used to hold the returned error from WSR_SET_CLR_REP.

LEXI_COLOUR_VALUE : LEXI_PIXEL_COLOUR;
-- LEXI_COLOUR_VALUE - this contains COLOUR after its intensity values
-- are converted into Lexidata compatable intensity values.

   function CONVERT_TO_DEVICE_RANGE
     (STANDARD_INTENSITY : INTENSITY)
      return LEXI_COLOUR_INTENSITY is

   -- This function accepts intensity values which are in the range of
   -- the standard GKS intensities [0,1] and converts them into
   -- intensity values that can be sent to the device.
   --
   -- STANDARD_INTENSITY - the intensity value given as a percentage
   --                      between zero and one.

   begin

      -- A procedure is called in the Workstation Resource which will
      -- convert from a range of floating values into an even distri-
      -- bution of integer values.
      return LEXI_COLOUR_INTENSITY
         (WSR_UTILITIES.TRANSFORM
          (FLOAT (STANDARD_INTENSITY),
           FLOAT (INTENSITY'LAST),
           FLOAT (INTENSITY'FIRST),
           INTEGER (LEXI_COLOUR_INTENSITY'LAST),
           INTEGER (LEXI_COLOUR_INTENSITY'FIRST)));
   end CONVERT_TO_DEVICE_RANGE;

begin

   -- A procedure is called in the Workstation Resource which sets
   -- the Workstation's Colour Lookup Table entry at INDEX to COLOUR.
   WSR_SET_COLOUR_TABLE.SET_COLOUR_REPRESENTATION
      (WS_SL, INDEX, COLOUR, EI);

   -- If error #93 is not detected, further processing is done to set
   -- the colour on the Lexidata's own colour lookup table.
   if EI = GKS_ERRORS.SUCCESSFUL then

      -- The three intensity values are converted into values which are
      -- meaningful to the Lexidata.
      LEXI_COLOUR_VALUE.RED   := CONVERT_TO_DEVICE_RANGE (COLOUR.RED);
      LEXI_COLOUR_VALUE.BLUE  := CONVERT_TO_DEVICE_RANGE (COLOUR.BLUE);
      LEXI_COLOUR_VALUE.GREEN := CONVERT_TO_DEVICE_RANGE (COLOUR.GREEN);

      -- The Device Driver is called to set the colour value at INDEX.
      LEXI3700_OUTPUT_DRIVER.WRITE_TO_LUT
         (LEXI_COLOUR_INDEX(INDEX), LEXI_COLOUR_VALUE);

   end if;

   -- The value of the Error Indicator is returned.
   ERROR := EI;

end SET_COLOUR_REPRESENTATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_GKS_NORM.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_GKS_NORMALIZATION
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file : WSR_GKS_NORM.ADA
-- level: ma,0a,1a,2a

with GKS_TYPES;
with WS_STATE_LIST_TYPES;

use  GKS_TYPES;

package WSR_GKS_NORMALIZATION is

-- This package is a workstation resource package that can be used by
-- any workstation driver that needs to have the CLIPPING_RECTANGLE
-- set in the specified workstation state list.  It sets the value
-- in the WS_ST_LST to the specified value then it finds the inter-
-- section between the CLIP_RECTANGLE and the CURRENT_WS_WINDOW that
-- is in the workstation state list and sets the EFFECTIVE_CLIPPING_
-- RECTANGLE in the WS_ST_LST.

   procedure SET_CLIPPING_RECTANGLE
      (WS_ST_LST      : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       CLIP_RECTANGLE : in NDC.RECTANGLE_LIMITS);

 end WSR_GKS_NORMALIZATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSR_GKS_NORM_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_GKS_NORMALIZATION - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file : WSR_GKS_NORM_B.ADA
-- level: ma - 2a

with NDC_OPS;
with CONVERT_NDC_DC;

package body WSR_GKS_NORMALIZATION is

   procedure SET_CLIPPING_RECTANGLE
      (WS_ST_LST      : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       CLIP_RECTANGLE : in NDC.RECTANGLE_LIMITS) is

   -- This procedure sets the value for the CLIPPING_RECTANGLE in the
   -- WS_STATE_LIST to the value specified by the parameter.
   --
   -- The following parameters are used in this procedure:
   -- WS_ST_LST - The specified WS_STATE_LIST to set the clipping
   --             rectangle on.
   -- CLIP_RECTANGLE - The value to which the CLIPPING_RECTANGLE is set.

      NDC_CLIPPING_RECTANGLE : NDC.RECTANGLE_LIMITS;
      -- A temporary location for storage of the EFFECTIVE_CLIPPING
      -- RECTANGLE before it is transformed to DC points and stored in
      -- the WS_ST_LST.

   begin

      WS_ST_LST.OUTPUT_ATTR.CLIPPING_RECTANGLE := CLIP_RECTANGLE;

      -- Compute the EFFECTIVE_CLIPPING_RECTANGLE.
      NDC_CLIPPING_RECTANGLE :=
            NDC_OPS."and"(CLIP_RECTANGLE,WS_ST_LST.CURRENT_WS_WINDOW);

      -- Transform the clipping rectangle from NDC to DC.
      WS_ST_LST.EFFECTIVE_CLIPPING_RECTANGLE :=
            CONVERT_NDC_DC.DC_RECTANGLE_LIMITS
               (NDC_CLIPPING_RECTANGLE,WS_ST_LST.WS_TRANSFORM);

   end SET_CLIPPING_RECTANGLE;

end WSR_GKS_NORMALIZATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI3700_TBLS_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_WS_TABLES - BODY
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR015  Change the field for Deferral Mode.
------------------------------------------------------------------
-- file : lexi3700_tbls_ma_b.ada
-- level: ma

with WS_TABLE_TYPES;
with LEXI3700_CONFIGURATION;
with GKS_CONFIGURATION;

package body LEXI3700_WS_TABLES is

-- This package initializes the LEXI3700_DT.  It uses the WS_DESCRIPTION
-- TABLE_TYPES package as a template and it fills in the fields.  Some
-- of the fields are based on values in the LEXI3700_CONFIGURATION
-- package, others are based on what GKS supports at level MA
-- while still others are strictly implementation dependent.

   -- The following subtype is declared to rename the COLOUR_TABLE in
   -- the WS_TABLE_TYPES package.
   subtype PRE_COLOUR_REP is GKS_TYPES.COLOUR_REPRESENTATION;

   -- The following constants are used to create lists of supported
   -- items in the GKS_LIST_UTILITIES package.
   LINE_TYPE_LIST : constant LINETYPES.LIST_VALUES := (1,2,3,4);
   MARKER_TYPE_LIST : constant MARKER_TYPES.LIST_VALUES := (1,2,3,4,5);
   INTERIOR_STYLE_LIST : constant INTERIOR_STYLES.LIST_VALUES :=
         (SOLID,HOLLOW);
   TEXT_FONT_AND_PRECISION_LIST : constant TEXT_FONT_PRECISIONS
         .LIST_VALUES := (1 => TEXT_FONT_PRECISION'
         (FONT => 1, PRECISION => STRING_PRECISION));

   -- A pointer to a WORKSTATION_STATE_LIST.  The initial value is
   -- NULL.  Since only one workstation can be opened at one time at
   -- level ma there is no need to create more than one state list at
   -- a time.

   LEXI_ST_LST : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;

   -- A function used to get a specified WS_STATE_LIST.
   function GET_STATE_LIST_PTR( WS_ID : in GKS_TYPES.WS_ID ) return
         WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR
   is separate;

   -- A procedure used to add a WS_STATE_LIST to the list.
   procedure ADD_STATE_LIST_TO_LIST
        (WS_ID       : in GKS_TYPES.WS_ID;
         CONNECT_ID  : in VARIABLE_CONNECTION_ID;
         WS_TYPE     : in GKS_TYPES.WS_TYPE;
         ATTRIBUTES  : in OUTPUT_ATTRIBUTES_TYPE.OUTPUT_ATTRIBUTES;
         EI          : out ERROR_INDICATOR)
   is separate;

   -- A procedure used for deleting a WS_STATE_LIST from the list.
   procedure DELETE_STATE_LIST_FROM_LIST
        (WS_ID : in GKS_TYPES.WS_ID)
   is separate;

begin

   LEXI3700_WS_DT.WORKSTATION_TYPE := GKS_CONFIGURATION
         .LEXIDATA_3700_OUTPUT_TYPE;
   LEXI3700_WS_DT.WORKSTATION_CATEGORY := OUTPUT;

   -- The coordinate units are not in meters they are in raster units.
   LEXI3700_WS_DT.DEVICE_COOR_UNITS    := OTHER;

   -- The size of the display in DC units.
   LEXI3700_WS_DT.MAX_DISPLAY_SURFACE_DC_UNITS  :=
         (DC.MAGNITUDE(LEXI3700_CONFIGURATION.LEXI_X_MAXIMUM),
          DC.MAGNITUDE(LEXI3700_CONFIGURATION.LEXI_Y_MAXIMUM));

   -- The size of the display surface in raster units.
   -- The plus one is added because the LEXIDATA physical addressing
   -- of the raster units starts at (0,0).
   LEXI3700_WS_DT.MAX_DISPLAY_SURFACE_RASTER_UNITS :=
         (LEXI3700_CONFIGURATION.LEXI_X_MAXIMUM + 1,
          LEXI3700_CONFIGURATION.LEXI_Y_MAXIMUM + 1);

   -- The display type (raster, vector etc)
   LEXI3700_WS_DT.DISPLAY_TYPE := RASTER_DISPLAY;

   -- The dynamic capabilities of the workstation.
   LEXI3700_WS_DT.WS_DYNAMICS := WS_DESCRIPTION_TABLE_TYPES
         .DYN_MOD_ACCEPTED_FOR_WS_ATTRIBUTES'
           (POLYLINE_BUNDLE_REP   => IRG,
            POLYMARKER_BUNDLE_REP => IRG,
            TEXT_BUNDLE_REP       => IRG,
            FILL_AREA_BUNDLE_REP  => IRG,
            PATTERN_REP           => IRG,
            COLOUR_REP            => IMM,
            WS_TRANSFORMATION     => IRG);

   -- The workstation deferral mode.  Set to AT SOME TIME.
   LEXI3700_WS_DT.DEFER_MODE    := ASAP;

   -- The implicit regeneration mode.  Set to SUPPRESS regeneration.
   LEXI3700_WS_DT.IMPLICIT_REGEN_MODE := SUPPRESSED;

   -- Initializes the LIST_OF_AVAILABLE_LTYPE entry.
   LEXI3700_WS_DT.LIST_AVAILABLE_LTYPE := LINETYPES.LIST
         ( LINE_TYPE_LIST );

   -- Only the default line width supported at level ma.
   LEXI3700_WS_DT.NUM_AVAILABLE_LWIDTH := 1;

   LEXI3700_WS_DT.NOMINAL_LWIDTH := DC.MAGNITUDE(LEXI3700_CONFIGURATION
                                    .LEXI_NOMINAL_LINE_WIDTH);

   -- Only the default line width is available.
   LEXI3700_WS_DT.RANGE_OF_LWIDTH := (1.0,1.0);

   -- Initializes the LIST_OF_AVAILABLE_MARKER_TYPES.
   LEXI3700_WS_DT.LIST_AVAILABLE_MARKER_TYPES := MARKER_TYPES.LIST
         ( MARKER_TYPE_LIST );

   -- The number of available marker sizes.
   -- There are no available marker sizes.  Just one predefined size.
   LEXI3700_WS_DT.NUM_AVAILABLE_MARKER_SIZES := 1;

   -- The normal marker size drawn.
   LEXI3700_WS_DT.NOMINAL_MARKER_SIZE := DC.MAGNITUDE
        (LEXI3700_CONFIGURATION.LEXI_NOMINAL_TEXT_SIZE);

   -- The range of available marker sizes.
   -- Only one marker size available at level ma.
   LEXI3700_WS_DT.RANGE_OF_MARKER_SIZES := (1.0,1.0);

   -- The list of text font and precisions.
   LEXI3700_WS_DT.LIST_TEXT_FONT_AND_PRECISION :=
         TEXT_FONT_PRECISIONS.LIST( TEXT_FONT_AND_PRECISION_LIST );

   -- The number of available character expansions.  However this
   -- device doesn't support character expansions.
   LEXI3700_WS_DT.NUM_AVAILABLE_CHAR_EXPANSIONS := 1;

   -- Lexi3700 does not support character expansion factors
   LEXI3700_WS_DT.RANGE_OF_CHAR_EXPANSIONS := (1.0,1.0);

   -- The number of available character heights.
   LEXI3700_WS_DT.NUM_AVAILABLE_CHAR_HEIGHTS :=
         (LEXI3700_CONFIGURATION.LEXI_MAXIMUM_TEXT_SIZE);

   -- The range of character heights available.
   -- The minimum character height to the maximum character height.
   LEXI3700_WS_DT.RANGE_OF_CHAR_HEIGHTS :=
        (DC.MAGNITUDE(LEXI3700_CONFIGURATION.LEXI_MINIMUM_TEXT_SIZE),
         DC.MAGNITUDE(LEXI3700_CONFIGURATION.LEXI_MAXIMUM_TEXT_SIZE));

   -- Initializes the LIST_OF_AVAL_INTERIOR_STYLE entry.
   LEXI3700_WS_DT.LIST_OF_AVAL_INTERIOR_STYLE :=
         INTERIOR_STYLES.LIST( INTERIOR_STYLE_LIST );

   -- Initializes the LIST_OF_AVAL_HATCH_STYLE entry.
   -- However out implementation does not support HATCH STYLES therefore
   -- the entry is NULL.
   LEXI3700_WS_DT.LIST_OF_AVAL_HATCH_STYLE := HATCH_STYLES.NULL_LIST;

   -- The number of available colours.  The LEXIDATA supports 255
   -- intensities for each colour (red, green, blue).  This would
   -- mean an application programmer can access up to approximately
   -- sixteen million colours.  We feel that this constitutes a
   -- continue ranges of colours available, therefore we have put a
   -- zero for the following entry.

   LEXI3700_WS_DT.NUM_OF_AVAL_COLOUR_INTENSITY := 0;

   -- Tells that there is colour available on the device.
   LEXI3700_WS_DT.COLOUR_AVAL := COLOUR;

   -- The list of predefined colours for the device.
   LEXI3700_WS_DT.PREDEFINED_COLOUR_REP :=  WS_TABLE_TYPES
         .COLOUR_TABLE_LIST'
         (0=> PRE_COLOUR_REP'( RED=>0.0,GREEN=>0.0,BLUE=>0.0), --black
          1=> PRE_COLOUR_REP'( RED=>1.0,GREEN=>1.0,BLUE=>1.0), --white
          2=> PRE_COLOUR_REP'( RED=>1.0,GREEN=>0.0,BLUE=>0.0), --red
          3=> PRE_COLOUR_REP'( RED=>0.0,GREEN=>1.0,BLUE=>0.0), --green
          4=> PRE_COLOUR_REP'( RED=>0.0,GREEN=>0.0,BLUE=>1.0), --blue
          5=> PRE_COLOUR_REP'( RED=>1.0,GREEN=>1.0,BLUE=>0.0), --yellow
          6=> PRE_COLOUR_REP'( RED=>1.0,GREEN=>0.0,BLUE=>1.0), --magenta
          7=> PRE_COLOUR_REP'( RED=>0.0,GREEN=>1.0,BLUE=>1.0));--cyan

   LEXI3700_WS_DT.MAX_NUM_PLIN_BUNDLE_TBL_ENTRIES := 0;
   LEXI3700_WS_DT.MAX_NUM_PMRK_BUNDLE_TBL_ENTRIES := 0;
   LEXI3700_WS_DT.MAX_NUM_TEXT_BUNDLE_TBL_ENTRIES := 0;
   LEXI3700_WS_DT.MAX_NUM_FA_BUNDLE_TBL_ENTRIES   := 0;
   LEXI3700_WS_DT.MAX_NUM_PATTERN_INDICES         := 0;

   -- There are 128 colour indices that can be accessed on the device,
   -- but we have reserved the eight plane on the device (which is
   -- accessed by colour index 128) for polygon fills.  Therefore the
   -- application programmer can only use colour indices 0 through 127.

   LEXI3700_WS_DT.MAX_NUM_COLOUR_INDICES :=
         NATURAL(LEXI3700_CONFIGURATION.LEXI_MAXIMUM_COLOUR_INDEX);

end LEXI3700_WS_TABLES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:ADD_ST_LST_TO_LST_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-- file: ADD_ST_LST_TO_LST_MA.ADA
-- level: ma

with WSR_WS_TRANSFORMATION;
with GKS_ERRORS;

separate (LEXI3700_WS_TABLES)

procedure ADD_STATE_LIST_TO_LIST
   (WS_ID      : in GKS_TYPES.WS_ID;
    CONNECT_ID : in VARIABLE_CONNECTION_ID;
    WS_TYPE    : in GKS_TYPES.WS_TYPE;
    ATTRIBUTES : in OUTPUT_ATTRIBUTES_TYPE.OUTPUT_ATTRIBUTES;
    EI         : out ERROR_INDICATOR) is

-- This procedure will create a WS state list and initialize it.
-- At level ma there is only one open WS at a time so it does not
-- need to add it to a list.

-- The following parameters are used in this procedure:
-- WS_ID - The workstation identifier choosen by the application
--         programmer to identify a particular workstation.
-- CONNECT_ID - The connection identifier to access the specified
--              device.
-- WS_TYPE - The type of workstation being opened.
-- ATTRIBUTES - A copy of the output attributes from the GKS_STATE_LIST
--              as they appeared at the time of this call.
-- EI - An error indicator used for logging errors.

-- The following constant is used to create a list of predefined colours
-- by the GKS_LIST_UTILITIES package.

COLOUR_IDC_LIST : constant COLOUR_INDICES.LIST_VALUES :=
                           (0,1,2,3,4,5,6,7);
begin
  declare
    begin

      -- Get a new WS_STATE_LIST.
      LEXI_ST_LST := new WS_STATE_LIST_TYPES.WS_STATE_LST
             (NUM_COLOUR_REPRESENTATION => WS_STATE_LIST_TYPES
                                         .CLR_INDEX( LEXI3700_WS_DT
                                         .MAX_NUM_COLOUR_INDICES - 1));

      -- Initialize the LEXI_ST_LST.

      -- The following are parameters passed in to the procedure.

      LEXI_ST_LST.OUTPUT_ATTR       := ATTRIBUTES;
      LEXI_ST_LST.WORKSTATION_ID    := WS_ID;
      LEXI_ST_LST.CONNECT_ID        := CONNECT_ID;
      LEXI_ST_LST.WORKSTATION_TYPE  := WS_TYPE;

      -- The following are initialized from the LEXI3700_WS_DT.

      LEXI_ST_LST.WS_DEFERRAL_MODE :=
            LEXI3700_WS_DT.DEFER_MODE;
      LEXI_ST_LST.WS_IMPLICIT_REGEN_MODE :=
            LEXI3700_WS_DT.IMPLICIT_REGEN_MODE;

      -- The colour table.

      LEXI_ST_LST.SET_OF_COLOUR_IDC :=
            COLOUR_INDICES.LIST(COLOUR_IDC_LIST);

      LEXI_ST_LST.COLOUR_TABLE
           (LEXI3700_WS_DT.PREDEFINED_COLOUR_REP'first ..
            LEXI3700_WS_DT.PREDEFINED_COLOUR_REP'last) :=
            LEXI3700_WS_DT.PREDEFINED_COLOUR_REP;

      -- This code sets the effective attributes in the ws state list.
      -- It is put here for now, but a future implementation could
      -- remove the following code into a procedure and make it more
      -- general to handle all workstations.

         LEXI_ST_LST.EFFECTIVE_POLYLINE_ATTR.L_TYPE :=
               LEXI_ST_LST.OUTPUT_ATTR.CURRENT_LINETYPE;

         LEXI_ST_LST.EFFECTIVE_POLYLINE_ATTR.L_WIDTH :=
               LEXI_ST_LST.OUTPUT_ATTR
               .CURRENT_LINEWIDTH_SCALE_FACTOR;

         LEXI_ST_LST.EFFECTIVE_POLYLINE_ATTR.COLOUR :=
               LEXI_ST_LST.OUTPUT_ATTR
               .CURRENT_POLYLINE_COLOUR_INDEX;

         LEXI_ST_LST.EFFECTIVE_POLYMARKER_ATTR.M_TYPE :=
               LEXI_ST_LST.OUTPUT_ATTR.CURRENT_MARKER_TYPE;

         LEXI_ST_LST.EFFECTIVE_POLYMARKER_ATTR.M_SIZE :=
               LEXI_ST_LST.OUTPUT_ATTR
               .CURRENT_MARKER_SIZE_SCALE_FACTOR;

         LEXI_ST_LST.EFFECTIVE_POLYMARKER_ATTR.COLOUR :=
               LEXI_ST_LST.OUTPUT_ATTR
               .CURRENT_POLYMARKER_COLOUR_INDEX;

         LEXI_ST_LST.EFFECTIVE_TEXT_ATTR.TEXT_FONT :=
               LEXI_ST_LST.OUTPUT_ATTR
               .CURRENT_TEXT_FONT_AND_PRECISION;

         LEXI_ST_LST.EFFECTIVE_TEXT_ATTR.CH_EXPANSION :=
               LEXI_ST_LST.OUTPUT_ATTR
               .CURRENT_CHAR_EXPANSION_FACTOR;

         LEXI_ST_LST.EFFECTIVE_TEXT_ATTR.CH_SPACE :=
               LEXI_ST_LST.OUTPUT_ATTR.CURRENT_CHAR_SPACING;

         LEXI_ST_LST.EFFECTIVE_TEXT_ATTR.COLOUR :=
               LEXI_ST_LST.OUTPUT_ATTR
               .CURRENT_TEXT_COLOUR_INDEX;

         LEXI_ST_LST.EFFECTIVE_FILL_AREA_ATTR.INT_STYLE :=
               LEXI_ST_LST.OUTPUT_ATTR
               .CURRENT_FILL_AREA_INTERIOR_STYLE;

         LEXI_ST_LST.EFFECTIVE_FILL_AREA_ATTR.STYLE :=
               LEXI_ST_LST.OUTPUT_ATTR
               .CURRENT_FILL_AREA_STYLE_INDEX;

         LEXI_ST_LST.EFFECTIVE_FILL_AREA_ATTR.COLOUR :=
               LEXI_ST_LST.OUTPUT_ATTR
               .CURRENT_FILL_AREA_COLOUR_INDEX;

         -- Convert REQUESTED_WS_VIEWPORT in the WS_STATE_LIST_TYPES
         -- package from the default (0.0,0.0), (1.0,1.0) to the
         -- maximum square that fits in the display space.

         LEXI_ST_LST.REQUESTED_WS_VIEWPORT := (0.0,1023.0,0.0,1023.0);

         -- A call is made here to initialize the WS_TRANSFORMATION
         -- and set the CURRENT_WS_VIEWPORT.
         WSR_WS_TRANSFORMATION.SET_WS_VIEWPORT
               (IMM,
                LEXI_ST_LST,
                LEXI_ST_LST.REQUESTED_WS_VIEWPORT);

      -- If the procedure gets to this point without raising an
      -- exception, the workstation was opened successfully.
      EI := GKS_ERRORS.SUCCESSFUL;

   end;

   exception
      when OTHERS =>
         EI := GKS_ERRORS.WS_CANNOT_OPEN;

end ADD_STATE_LIST_TO_LIST;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:DEL_ST_LST_FR_LST_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-- file: DELETE_ST_LST_FR_LST_MA.ADA
-- level: ma

with UNCHECKED_DEALLOCATION;

separate (LEXI3700_WS_TABLES)

procedure DELETE_STATE_LIST_FROM_LIST
   (WS_ID : in GKS_TYPES.WS_ID) is

-- Given a WS_ID, this procedure deallocates the specified state list.
--
-- This procedure uses the UNCHECKED_DEALLOCATION package to free the
-- memory the state list used before it use closed.
--
-- Since this is a level ma procedure and only one workstation can be
-- opened at a time,  this code is simplified to minimize memory space.
--
-- The following parameter is used in this procedure:
-- WS_ID - The workstation identifier of the whose state list is deleted

procedure FREE_WS_ST_LST is new UNCHECKED_DEALLOCATION
   (WS_STATE_LIST_TYPES.WS_STATE_LST,
    WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR);

begin

   FREE_WS_ST_LST(LEXI_ST_LST);

end DELETE_STATE_LIST_FROM_LIST;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GET_ST_LST_PTR_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-- file: GET_ST_LST_PTR_MA.ADA
-- level: ma

separate (LEXI3700_WS_TABLES)

function GET_STATE_LIST_PTR
   (WS_ID : in GKS_TYPES.WS_ID) return
         WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR is

-- This procedure given a WS_ID returns a pointer to the
-- state list specified.
--
-- Since this is a level ma procedure and only one workstation can be
-- opened at a time,  this code is simplified to minimize memory space.
--
-- The following parameter is used in this procedure:
-- WS_ID - The workstation identifier of the whose state list pointer
--         is returned

begin

   return LEXI_ST_LST;

end GET_STATE_LIST_PTR;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI_WS_CONT_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_CONTROL_OPERATIONS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: LEXI_WS_CONT_MA.ADA
-- level: ma,0a

with GKS_TYPES;
with OUTPUT_ATTRIBUTES_TYPE;
with WS_STATE_LIST_TYPES;
with CGI;

use GKS_TYPES;

package LEXI3700_CONTROL_OPERATIONS is

-- This package is a workstation driver package used to control the
-- device.  It has direct access to the device driver procedures for
-- communication to the device.

   procedure OPEN_WS
      (WS          : in WS_ID;
       CONNECTION  : in CGI.ACCESS_CONNECTION_ID_TYPE;
       TYPE_OF_WS  : in WS_TYPE;
       ATTRIBUTES  : in out OUTPUT_ATTRIBUTES_TYPE.OUTPUT_ATTRIBUTES;
       EI          : out ERROR_INDICATOR);

   procedure CLOSE_WS
      (WS_ST_LST   : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR);

   procedure CLEAR_WS
      (WS_ST_LST   : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       FLAG        : in CONTROL_FLAG);

   procedure UPDATE_WS
      (WS_ST_LST    : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       REGENERATION : in UPDATE_REGENERATION_FLAG);

end LEXI3700_CONTROL_OPERATIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI_WS_CONT_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_CONTROL_OPERATIONS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: LEXI_WS_CONT_MA_B.ADA
-- level: ma,0a

with LEXI3700_OUTPUT_DRIVER;
with LEXI3700_TYPES;
with GKS_ERRORS;

use  LEXI3700_TYPES;

package body LEXI3700_CONTROL_OPERATIONS is

-- The following packages are used in this package for the given
-- reasons:
-- The LEXI3700_OUTPUT_DRIVER package contains all procedures that are
-- used in the device driver.
-- The LEXI3700_TYPES package contains all types used by the device
-- driver.
-- The GKS_ERRORS package contain all the error constants.

   procedure OPEN_WS
      (WS         : in WS_ID;
       CONNECTION : in CGI.ACCESS_CONNECTION_ID_TYPE;
       TYPE_OF_WS : in WS_TYPE;
       ATTRIBUTES : in out OUTPUT_ATTRIBUTES_TYPE.OUTPUT_ATTRIBUTES;
       EI         : out ERROR_INDICATOR)
   is separate;

   procedure CLOSE_WS
      (WS_ST_LST  : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR)
   is separate;

   procedure CLEAR_WS
      (WS_ST_LST  : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       FLAG       : in CONTROL_FLAG)
   is separate;

   procedure UPDATE_WS
      (WS_ST_LST  : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       REGENERATION : in UPDATE_REGENERATION_FLAG)
   is separate;

end LEXI3700_CONTROL_OPERATIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSD_OPEN_WS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: OPEN_WS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSD_OPEN_WS.ADA
-- level: ma,0a,1a,2a

with LEXI3700_COLOUR_OPERATIONS;
with LEXI3700_WS_TABLES;

separate (LEXI3700_CONTROL_OPERATIONS)

procedure OPEN_WS
   (WS         : in WS_ID;
    CONNECTION : in CGI.ACCESS_CONNECTION_ID_TYPE;
    TYPE_OF_WS : in WS_TYPE;
    ATTRIBUTES : in out OUTPUT_ATTRIBUTES_TYPE.OUTPUT_ATTRIBUTES;
    EI         : out ERROR_INDICATOR) is

-- This procedure calls the device driver procedure to open the device
-- and establish communication to it.  If there is no error in opening
-- the device it creates and initializes a WS_STATE_LIST from its
-- WS_DESCRIPTION_TABLE.  It initializes the OUTPUT_ATTR record in the
-- WS_STATE_LIST from the parameter ATTRIBUTES.
--
-- The parameters used in this procedure are:
-- WS - The workstation id the application programmer assigned to
--      associate the workstation with.
-- CONNECTION - The physical location the device driver needs to
--              decide which device to open.
-- TYPE_OF_WS - The type of workstation that is being opened.
-- ATTRIBUTES - A copy of the output attributes stored in the GKS_STATE_
--              LIST.
-- EI - contains any error that may be returned while
--      attempting to open the device.

CHANNEL_IN  : constant := 48;
CHANNEL_OUT : constant := 49;
-- The preceding define the communication channels to the device.
-- The present implimentation has them hard coded in for efficiency.
-- A future implimentation that supports multiple workstations from
-- the same host will need parameterize needs values to communicate
-- with the appropriate device.

CONNECTION_ID : VARIABLE_CONNECTION_ID(CONNECTION'length);
-- Creates an object the length of the string access type passed in.

ERROR_CONDITION : INTEGER;
-- This is the LEXIDATA ERROR CODE that is returned from the device.

begin

   -- Call the device driver to open the workstation
   LEXI3700_OUTPUT_DRIVER.OPEN(CHANNEL_IN,
                               CHANNEL_OUT,
                               ERROR_CONDITION);

   -- Check the error number from the device.  If it is anything but
   -- zero the device could not be opened successfully.

   If ERROR_CONDITION /= 0 then
      EI := GKS_ERRORS.WS_CANNOT_OPEN;
   else
      -- The device was opened succesfully.
      EI := GKS_ERRORS.SUCCESSFUL;

      -- Clears the display.
      LEXI3700_OUTPUT_DRIVER.CLEAR_DISPLAY;

      -- Defines the display memory planes on the device.
      LEXI3700_OUTPUT_DRIVER.DEFINE_WRITE_CHANNELS;

      -- Moves the cursor off the screen.
      LEXI3700_OUTPUT_DRIVER.SET_HARDWARE_CURSOR;

      -- Call the LEXI3700_WS_TBLS package to initialize the WS_STATE_
      -- LIST and add its WS_ID to the LIST_OF_WS_STATE_LISTS.
      CONNECTION_ID.CONNECT := CONNECTION.all;

      LEXI3700_WS_TABLES.ADD_STATE_LIST_TO_LIST
            (WS,
             CONNECTION_ID,
             TYPE_OF_WS,
             ATTRIBUTES,
             EI);

      declare
         WS_SL : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
         ERROR : ERROR_INDICATOR;
         -- A dummy error indicator that will always be successful.
         -- When this error indicator is returned it is expected that
         -- it will be successful.  The device has already been opened
         -- and the ws state list allocated, therefore no other error
         -- can happen.  Since the colours and indices SET_COLOUR_
         -- REPRESENTATION procedure receives are from its own
         -- description table it is assumed that they are valid,
         -- therefore this error indicator does not need to be checked.

      begin
         WS_SL := LEXI3700_WS_TABLES.GET_STATE_LIST_PTR(WS);
         -- Initialize the Look up table on the device.
         for I in LEXI3700_WS_TABLES.LEXI3700_WS_DT
               .PREDEFINED_COLOUR_REP'range loop
            LEXI3700_COLOUR_OPERATIONS.SET_COLOUR_REPRESENTATION
                  (WS_SL,
                   COLOUR_INDEX(I),
                   LEXI3700_WS_TABLES.LEXI3700_WS_DT
                         .PREDEFINED_COLOUR_REP (I),
                   ERROR);
         end loop;
      end;
   end if;

end OPEN_WS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSD_CLOSE_WS_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CLOSE_WS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSD_CLOSE_WS_MA.ADA
-- level: ma,0a

with LEXI3700_WS_TABLES;

separate (LEXI3700_CONTROL_OPERATIONS)

procedure CLOSE_WS
   (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR) is

-- This procedure calls a procedure in the device driver to
-- flush the device buffer.  It then calls the DELETE_WS_STATE_LIST_FROM
-- _LIST procedure in the LEXI3700_WS_TABLES package to deallocate the
-- WS_STATE_LIST.
--
-- note: The interface from the host to the target device that we
--       presently have does not allow us to close the device and
--       reopen it from the same process.  This is not acceptable
--       in GKS so we have decided not to close the device in this
--       procedure call for the LEXIDATA 3700 workstation.

begin

   LEXI3700_OUTPUT_DRIVER.FLUSH;

   -- Delete the WS_STATE_LIST from the list.
   LEXI3700_WS_TABLES.DELETE_STATE_LIST_FROM_LIST( WS_ST_LST
         .WORKSTATION_ID);

end CLOSE_WS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSD_CLEAR_WS_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CLEAR_WS
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR021  Need to flush clear WS out of buffer.
------------------------------------------------------------------
-- file: WSD_CLEAR_WS_MA.ADA
-- level: ma,0a

with WSR_WS_TRANSFORMATION;

separate (LEXI3700_CONTROL_OPERATIONS)

procedure CLEAR_WS
   (WS_ST_LST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    FLAG      : in CONTROL_FLAG) is

-- This procedure calls the FLUSH procedure that empties the device
-- buffer.  It then updates the WS_ST_LST and calls the device driver
-- procedure CLEAR_DISPLAY to clear the display.
--
-- The following parameters are used in this procedure:
-- WS_ST_LST - The workstation state list for the specified device.
-- FLAG - A flag used to control if the display surface should be
--        cleared needlessly.

begin

   -- Execute all deferred actions.
   LEXI3700_OUTPUT_DRIVER.FLUSH;

   -- Check the FLAG if it's ALWAYS or if the WS_DISPLAY_SURFACE is
   -- NOTEMPTY then clear the device.
   if FLAG = ALWAYS or else WS_ST_LST.WS_DISPLAY_SURFACE = NOTEMPTY then
      -- Clear the display.
      LEXI3700_OUTPUT_DRIVER.CLEAR_DISPLAY;
      -- Flush the buffer to get the CLEAR_DISPLAY out
      LEXI3700_OUTPUT_DRIVER.FLUSH;
   end if;

   -- If the WS_XFORM_UPDATE_STATE entry in the WS_OUTPUT_STATE_
   -- LIST is PENDING, the CURRENT_WS_WINDOW and CURRENT_WS_
   -- VIEWPORT entries in the WS_OUTPUT_STATE LIST are assigned
   -- the values of the REQUESTED_WS_WINDOW and REQUESTED_WS_
   -- VIEWPORT entries; the WS_XFORM_UPDATE_STATE entry is set
   -- to NOTPENDING.  The package WSR_WS_TRANSFORMATION also
   -- computes the EFFECTIVE_CLIPPING_RECTANGLE.

   if WS_ST_LST.WS_XFORM_UPDATE_STATE = PENDING then
      WSR_WS_TRANSFORMATION.UPDATE_WS_TRANSFORMATION( WS_ST_LST );
   end if;

   -- The WS_NEW_FRAME_ACTION entry in the WS_OUTPUT_STATE_LIST
   -- is set to NO.
   WS_ST_LST.WS_NEW_FRAME_ACTION := NO;

   -- The WS_DISPLAY_SURFACE entry in the WS_OUTPUT_STATE_LIST
   -- is set to EMPTY.
   WS_ST_LST.WS_DISPLAY_SURFACE := EMPTY;

end CLEAR_WS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSD_UP_WS_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: UPDATE_WS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSD_UP_WS_MA.ADA
-- level: ma,0a

with WSR_WS_TRANSFORMATION;

separate (LEXI3700_CONTROL_OPERATIONS)

procedure UPDATE_WS
   (WS_ST_LST    : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    REGENERATION : in UPDATE_REGENERATION_FLAG) is

-- This procedure updates the workstation.  Since this is a level ma
-- and 0a procedure there is no implicit regeneration of all visible
-- segments stored on this workstation done in this procedure.
--
-- The following parameters are used in this procedure:
-- WS_ST_LST - The workstation state list for the specified device.
-- REGENERATION - A flag used to determine if an implicit regeneration
--                should be done with this UPDATE_WS call.

begin

   -- Call the device driver to flush all deferred actions.
   LEXI3700_OUTPUT_DRIVER.FLUSH;

   -- IF the REGENERATION flag is set to PERFORM and the
   -- WS_NEW_FRAME_ACTION entry in the WS_STATE_LIST is
   -- YES, then the following actions will be performed:

   if REGENERATION = PERFORM and WS_ST_LST
         .WS_NEW_FRAME_ACTION = YES then

      -- The display surface is cleared only if the WS_DISPLAY_
      -- SURFACE entry in the WS_STATE_LIST is NOTEMPTY.
      -- The entry is set to EMPTY.

      if WS_ST_LST.WS_DISPLAY_SURFACE = NOTEMPTY  then

         LEXI3700_OUTPUT_DRIVER.CLEAR_DISPLAY;
         WS_ST_LST.WS_DISPLAY_SURFACE := EMPTY;

      end if;

      -- If the WS_XFORM_UPDATE_STATE entry in the WS_STATE_LIST is
      -- PENDING, the CURRENT_WS_WINDOW and CURRENT_WS_VIEWPORT
      -- entries in the WS_OUTPUT_STATE LIST are assigned the values
      -- of the REQUESTED_WS_WINDOW and REQUESTED_WS_VIEWPORT entries;
      -- the WS_XFORM_UPDATE_STATE entry is set to NOTPENDING.

      if WS_ST_LST.WS_XFORM_UPDATE_STATE = PENDING then
         -- The following procedure updates the transformation state
         -- and compute the new EFFECTIVE_CLIPPING_RECTANGLE in the
         -- workstation state list.
         WSR_WS_TRANSFORMATION.UPDATE_WS_TRANSFORMATION( WS_ST_LST );
      end if;

      -- The WS_NEW_FRAME_ACTION entry in the WS_STATE_LIST
      -- is set to NO.
      WS_ST_LST.WS_NEW_FRAME_ACTION := NO;

   end if;

end UPDATE_WS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI_INQ_TEXT.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_INQ_TEXT
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  Not listed
------------------------------------------------------------------
-- FILE: LEXI_INQ_TEXT.ADA
-- LEVEL: MA

with GKS_TYPES;
with CGI;
with WS_STATE_LIST_TYPES;

use  CGI;
use  GKS_TYPES;

package LEXI3700_INQ_TEXT is

-- This package contains a procedure that inquires the Text Extent of
-- a text string.

   procedure INQ_TEXT_EXTENT
      (WS_SL                   : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       POSITION_TEXT           : NDC.POINT;
       CHAR_STRING             : ACCESS_STRING_TYPE;
       CONCATENATION_POINT     : out NDC.POINT;
       TEXT_EXTENT_LOWER_LEFT  : out NDC.POINT;
       TEXT_EXTENT_LOWER_RIGHT : out NDC.POINT;
       TEXT_EXTENT_UPPER_LEFT  : out NDC.POINT;
       TEXT_EXTENT_UPPER_RIGHT : out NDC.POINT);

end LEXI3700_INQ_TEXT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI_INQ_TEXT_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_INQ_TEXT - BODY
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  Not listed
------------------------------------------------------------------
-- FILE: LEXI_INQ_TEXT_B.ADA
-- LEVEL: MA

with LEXI3700_CONFIGURATION;
with WSR_UTILITIES;
with CONVERT_NDC_DC;

package body LEXI3700_INQ_TEXT is

   procedure INQ_TEXT_EXTENT
      (WS_SL                   : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       POSITION_TEXT           : NDC.POINT;
       CHAR_STRING             : ACCESS_STRING_TYPE;
       CONCATENATION_POINT     : out NDC.POINT;
       TEXT_EXTENT_LOWER_LEFT  : out NDC.POINT;
       TEXT_EXTENT_LOWER_RIGHT : out NDC.POINT;
       TEXT_EXTENT_UPPER_LEFT  : out NDC.POINT;
       TEXT_EXTENT_UPPER_RIGHT : out NDC.POINT) is separate;

end LEXI3700_INQ_TEXT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSD_INQ_TEXT_EXT.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_TEXT_EXTENT
--  IDENTIFIER: GDMXXX.3(3)
--  DISCREPANCY REPORTS:
--  DR041  Miscellaneous updates.
------------------------------------------------------------------
-- FILE  : WSD_INQ_TEXT_EXT.ADA
-- LEVEL : MA

with DC_POINT_OPS;
separate (LEXI3700_INQ_TEXT)

   procedure INQ_TEXT_EXTENT
      (WS_SL                   : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       POSITION_TEXT           : NDC.POINT;
       CHAR_STRING             : ACCESS_STRING_TYPE;
       CONCATENATION_POINT     : out NDC.POINT;
       TEXT_EXTENT_LOWER_LEFT  : out NDC.POINT;
       TEXT_EXTENT_LOWER_RIGHT : out NDC.POINT;
       TEXT_EXTENT_UPPER_LEFT  : out NDC.POINT;
       TEXT_EXTENT_UPPER_RIGHT : out NDC.POINT) is

-- This procedure defines the Text Extent Rectangle for the input Text
-- string.  This procedure also returns the Concatenation Point, which
-- is used to position addition text as required.

-- Parameter definition section.

--  WS_SL            - A pointer to the work station state list.
--  POSITION_TEXT    - The requested starting position of the text.
--  CHAR_STRING      - The character string used in the calculations.
--  CONCATENATION_PT - The point used to append additional text.
--  TEXT_EXTENT_INQ  - The Text Extent Rectangle.

-- Variable section.

CAP_TOP              : DC_TYPE :=
      LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_CAP_TOP;
-- CAP_TOP           - The fraction of character height to Topline.

BASE_BOTTOM          : DC_TYPE :=
      LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_BASE_BOTTOM;
-- BASE_BOTTOM       - The fraction of character width to Bottomline.

CHARACTER_FONT       : DC_TYPE :=
      LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT;
-- CHARACTER_FONT    - Describes the Width/Height ratio of the font.

CAT_POINT            : DC.POINT;
-- CAT_POINT         - The DC.POINT version of the Concatenation Point.

OFFSET               : DC.POINT;
-- OFFSET            - The X-Y displacements for text positioning.

START_POSITION       : DC.POINT;
-- START_POSITION    - The returned actual starting text position.

DC_POINT             : DC.POINT;
-- DC_POINT          - The input text position point.

TEI_LOWER_LEFT       : DC.POINT;
-- Contains the parallelogram containing the text string.

TEI_LOWER_RIGHT      : DC.POINT;
-- Contains the parallelogram containing the text string.

TEI_UPPER_LEFT       : DC.POINT;
-- Contains the parallelogram containing the text string.

TEI_UPPER_RIGHT      : DC.POINT;
-- Contains the parallelogram containing the text string.

HCOS                 : DC_TYPE;
-- The Cosine of the Height Vector.

HSIN                 : DC_TYPE;
-- The Sine of the Height Vector.

DC_CHAR_HEIGHT_VECTOR : DC.VECTOR;
-- Contains the vector in dc.

CHAR_HEIGHT : DC_TYPE;
-- Contains the sqrt of the height vector;

begin
   DC_POINT := CONVERT_NDC_DC.DC_POINT
      (POSITION_TEXT, WS_SL.WS_TRANSFORM);

-- Call the procedure TEXT_HANDLING to calculate the Offsets and Start
-- Position needed to calculate the Concatenation Point.  TEXT_HANDLING
-- calculates the Text Extent Rectangle, which is also returned.

   WSR_UTILITIES.TEXT_HANDLING
       (CAP_TOP,
        BASE_BOTTOM,
        WS_SL.OUTPUT_ATTR.CURRENT_TEXT_PATH,
        WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT,
        CONVERT_NDC_DC.DC_VECTOR
             (WS_SL.OUTPUT_ATTR.CURRENT_CHAR_HEIGHT_VECTOR,
              WS_SL.WS_TRANSFORM),
        CONVERT_NDC_DC.DC_VECTOR
             (WS_SL.OUTPUT_ATTR.CURRENT_CHAR_WIDTH_VECTOR,
              WS_SL.WS_TRANSFORM),
        WS_SL.OUTPUT_ATTR.CURRENT_CHAR_EXPANSION_FACTOR,
        WS_SL.OUTPUT_ATTR.CURRENT_CHAR_SPACING,
        DC_POINT,
        CHAR_STRING'LENGTH,
        CHARACTER_FONT,
        START_POSITION,
        OFFSET,
        TEI_LOWER_LEFT,
        TEI_LOWER_RIGHT,
        TEI_UPPER_LEFT,
        TEI_UPPER_RIGHT);

-- Determine the Concatenation Point.

   DC_CHAR_HEIGHT_VECTOR := CONVERT_NDC_DC.DC_VECTOR
      (WS_SL.OUTPUT_ATTR.CURRENT_CHAR_HEIGHT_VECTOR,
       WS_SL.WS_TRANSFORM);

   CHAR_HEIGHT := DC_POINT_OPS.NORM(DC_CHAR_HEIGHT_VECTOR);

   HCOS := DC_CHAR_HEIGHT_VECTOR.X / CHAR_HEIGHT;
   HSIN := DC_CHAR_HEIGHT_VECTOR.Y / CHAR_HEIGHT;

   case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_PATH is
      when UP =>
         case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.VERTICAL is
            when TOP =>
               case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.HORIZONTAL is
                  when CENTRE | NORMAL =>
                                 CAT_POINT.X := (TEI_LOWER_LEFT.X +
                                    TEI_LOWER_RIGHT.X) / 2.0;
                                 CAT_POINT.Y := (TEI_LOWER_LEFT.Y +
                                    TEI_LOWER_RIGHT.Y) / 2.0;

                  when LEFT =>   CAT_POINT.X := TEI_LOWER_LEFT.X;
                                 CAT_POINT.Y := TEI_LOWER_LEFT.Y;

                  when RIGHT =>  CAT_POINT.X := TEI_LOWER_RIGHT.X;
                                 CAT_POINT.Y := TEI_LOWER_RIGHT.Y;
               end case;

            when CAP =>
               case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.HORIZONTAL is
                  when CENTRE | NORMAL =>
                                 CAT_POINT.X := ((TEI_LOWER_LEFT.X +
                                    TEI_LOWER_RIGHT.X) / 2.0) +
                                    (BASE_BOTTOM * HCOS);
                                 CAT_POINT.Y := ((TEI_LOWER_LEFT.Y +
                                    TEI_LOWER_RIGHT.Y) / 2.0) +
                                    (BASE_BOTTOM * HSIN);

                  when LEFT =>   CAT_POINT.X := TEI_LOWER_LEFT.X +
                                    (BASE_BOTTOM * HCOS);
                                 CAT_POINT.Y := TEI_LOWER_LEFT.Y +
                                    (BASE_BOTTOM * HSIN);

                  when RIGHT =>  CAT_POINT.X := TEI_LOWER_RIGHT.X +
                                    (BASE_BOTTOM * HCOS);
                                 CAT_POINT.Y := TEI_LOWER_RIGHT.Y +
                                    (BASE_BOTTOM * HSIN);
               end case;

            when HALF =>          CAT_POINT.X := START_POSITION.X;
                                  CAT_POINT.Y := START_POSITION.Y;

            when BASE | NORMAL =>
               case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.HORIZONTAL is
                  when CENTRE | NORMAL =>
                                 CAT_POINT.X := ((TEI_UPPER_LEFT.X +
                                    TEI_UPPER_RIGHT.X) / 2.0) -
                                    (CAP_TOP * HCOS);
                                 CAT_POINT.Y := ((TEI_UPPER_LEFT.Y +
                                    TEI_UPPER_RIGHT.Y) / 2.0) -
                                    (CAP_TOP * HSIN);

                  when LEFT =>   CAT_POINT.X := TEI_UPPER_LEFT.X -
                                    (CAP_TOP * HCOS);
                                 CAT_POINT.Y := TEI_UPPER_LEFT.Y -
                                    (CAP_TOP * HSIN);

                  when RIGHT =>  CAT_POINT.X := TEI_UPPER_RIGHT.X -
                                    (CAP_TOP * HCOS);
                                 CAT_POINT.Y := TEI_UPPER_RIGHT.Y -
                                    (CAP_TOP * HSIN);
               end case;

            when BOTTOM =>
               case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.HORIZONTAL is
                  when CENTRE | NORMAL =>
                                 CAT_POINT.X := (TEI_UPPER_LEFT.X +
                                    TEI_UPPER_RIGHT.X) / 2.0;
                                 CAT_POINT.Y := (TEI_UPPER_LEFT.Y +
                                    TEI_UPPER_RIGHT.Y) / 2.0;

                  when LEFT =>   CAT_POINT.X := TEI_UPPER_LEFT.X;
                                 CAT_POINT.Y := TEI_UPPER_LEFT.Y;

                  when RIGHT =>  CAT_POINT.X := TEI_UPPER_RIGHT.X;
                                 CAT_POINT.Y := TEI_UPPER_RIGHT.Y;
               end case;
         end case;


      when DOWN =>
         case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.VERTICAL is
            when TOP | NORMAL =>
               case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.HORIZONTAL is
                  when CENTRE | NORMAL =>
                                 CAT_POINT.X := (TEI_LOWER_LEFT.X +
                                    TEI_LOWER_RIGHT.X) / 2.0;
                                 CAT_POINT.Y := (TEI_LOWER_LEFT.Y +
                                    TEI_LOWER_RIGHT.Y) / 2.0;

                  when LEFT =>   CAT_POINT.X := TEI_LOWER_LEFT.X;
                                 CAT_POINT.Y := TEI_LOWER_LEFT.Y;

                  when RIGHT =>  CAT_POINT.X := TEI_LOWER_RIGHT.X;
                                 CAT_POINT.Y := TEI_LOWER_RIGHT.Y;
               end case;

            when CAP =>
               case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.HORIZONTAL is
                  when CENTRE | NORMAL =>
                                 CAT_POINT.X := ((TEI_LOWER_LEFT.X +
                                    TEI_LOWER_RIGHT.X) / 2.0) +
                                    (BASE_BOTTOM * HCOS);
                                 CAT_POINT.Y := ((TEI_LOWER_LEFT.Y +
                                    TEI_LOWER_RIGHT.Y) / 2.0) +
                                    (BASE_BOTTOM * HSIN);

                  when LEFT =>   CAT_POINT.X := TEI_LOWER_LEFT.X +
                                    (BASE_BOTTOM * HCOS);
                                 CAT_POINT.Y := TEI_LOWER_LEFT.Y +
                                    (BASE_BOTTOM * HSIN);

                  when RIGHT =>  CAT_POINT.X := TEI_LOWER_RIGHT.X +
                                    (BASE_BOTTOM * HCOS);
                                 CAT_POINT.Y := TEI_LOWER_RIGHT.Y +
                                    (BASE_BOTTOM * HSIN);
               end case;

            when HALF =>          CAT_POINT.X := START_POSITION.X;
                                  CAT_POINT.Y := START_POSITION.Y;

            when BASE =>
               case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.HORIZONTAL is
                  when CENTRE | NORMAL =>
                                 CAT_POINT.X := ((TEI_UPPER_LEFT.X +
                                    TEI_UPPER_RIGHT.X) / 2.0) -
                                    (CAP_TOP * HCOS);
                                 CAT_POINT.Y := ((TEI_UPPER_LEFT.Y +
                                    TEI_UPPER_RIGHT.Y) / 2.0) -
                                    (CAP_TOP * HSIN);

                  when LEFT =>   CAT_POINT.X := TEI_UPPER_LEFT.X -
                                    (CAP_TOP * HCOS);
                                 CAT_POINT.Y := TEI_UPPER_LEFT.Y -
                                    (CAP_TOP * HSIN);

                  when RIGHT =>  CAT_POINT.X := TEI_UPPER_RIGHT.X -
                                    (CAP_TOP * HCOS);
                                 CAT_POINT.Y := TEI_UPPER_RIGHT.Y -
                                    (CAP_TOP * HSIN);
               end case;

            when BOTTOM =>
               case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.HORIZONTAL is
                  when CENTRE | NORMAL =>
                                 CAT_POINT.X := (TEI_UPPER_LEFT.X +
                                    TEI_UPPER_RIGHT.X) / 2.0;
                                 CAT_POINT.Y := (TEI_UPPER_LEFT.Y +
                                    TEI_UPPER_RIGHT.Y) / 2.0;

                  when LEFT =>   CAT_POINT.X := TEI_UPPER_LEFT.X;
                                 CAT_POINT.Y := TEI_UPPER_LEFT.Y;

                  when RIGHT =>  CAT_POINT.X := TEI_UPPER_RIGHT.X;
                                 CAT_POINT.Y := TEI_UPPER_RIGHT.Y;
               end case;

         end case;


   when LEFT =>
         case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.HORIZONTAL is
            when LEFT =>
               case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.VERTICAL is
                  when TOP =>  CAT_POINT.X := TEI_UPPER_RIGHT.X;
                               CAT_POINT.Y := TEI_UPPER_RIGHT.Y;

                  when CAP =>  CAT_POINT.X := TEI_UPPER_RIGHT.X -
                                  (CAP_TOP * HCOS);
                               CAT_POINT.Y := TEI_UPPER_RIGHT.Y -
                                  (CAP_TOP * HSIN);

                  when HALF => CAT_POINT.X := (TEI_LOWER_RIGHT.X +
                                  TEI_UPPER_RIGHT.X) / 2.0;
                               CAT_POINT.Y := (TEI_LOWER_RIGHT.Y +
                                  TEI_UPPER_RIGHT.Y) / 2.0;

                  when BASE | NORMAL =>
                                  CAT_POINT.X := TEI_LOWER_RIGHT.X +
                                     (BASE_BOTTOM * HCOS);
                                  CAT_POINT.Y := TEI_LOWER_RIGHT.Y +
                                     (BASE_BOTTOM * HSIN);

                  when BOTTOM =>  CAT_POINT.X := TEI_LOWER_RIGHT.X;
                                  CAT_POINT.Y := TEI_LOWER_RIGHT.Y;
               end case;

            when CENTRE =>        CAT_POINT.X := START_POSITION.X;
                                  CAT_POINT.Y := START_POSITION.Y;

            when RIGHT | NORMAL =>
               case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.VERTICAL is
                  when TOP =>    CAT_POINT.X := TEI_UPPER_LEFT.X;
                                 CAT_POINT.Y := TEI_UPPER_LEFT.Y;

                  when CAP =>    CAT_POINT.X := TEI_UPPER_LEFT.X -
                                    (CAP_TOP * HCOS);
                                 CAT_POINT.Y := TEI_UPPER_LEFT.Y -
                                    (CAP_TOP * HSIN);

                  when HALF =>   CAT_POINT.X := (TEI_LOWER_LEFT.X +
                                    TEI_UPPER_LEFT.X) / 2.0;
                                 CAT_POINT.Y := (TEI_LOWER_LEFT.Y +
                                    TEI_UPPER_LEFT.Y) / 2.0;

                  when BASE | NORMAL =>
                                 CAT_POINT.X := TEI_LOWER_LEFT.X +
                                    (BASE_BOTTOM * HCOS);
                                 CAT_POINT.Y := TEI_LOWER_LEFT.Y +
                                    (BASE_BOTTOM * HSIN);

                  when BOTTOM => CAT_POINT.X := TEI_LOWER_LEFT.X;
                                 CAT_POINT.Y := TEI_LOWER_LEFT.Y;
               end case;
         end case;


      when RIGHT =>
         case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.HORIZONTAL is
            when LEFT | NORMAL =>
               case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.VERTICAL is
                  when TOP =>    CAT_POINT.X := TEI_UPPER_RIGHT.X;
                                 CAT_POINT.Y := TEI_UPPER_RIGHT.Y;

                  when CAP =>    CAT_POINT.X := TEI_UPPER_RIGHT.X -
                                    (CAP_TOP * HCOS);
                                 CAT_POINT.Y := TEI_UPPER_RIGHT.Y -
                                    (CAP_TOP * HSIN);

                  when HALF =>   CAT_POINT.X := (TEI_LOWER_RIGHT.X +
                                    TEI_UPPER_RIGHT.X) / 2.0;
                                 CAT_POINT.Y := (TEI_LOWER_RIGHT.Y +
                                    TEI_UPPER_RIGHT.Y) / 2.0;

                  when BASE | NORMAL =>
                                 CAT_POINT.X := TEI_LOWER_RIGHT.X +
                                    (BASE_BOTTOM * HCOS);
                                 CAT_POINT.Y := TEI_LOWER_RIGHT.Y +
                                    (BASE_BOTTOM * HSIN);

                  when BOTTOM => CAT_POINT.X := TEI_LOWER_RIGHT.X;
                                 CAT_POINT.Y := TEI_LOWER_RIGHT.Y;
               end case;

            when CENTRE =>        CAT_POINT.X := START_POSITION.X;
                                  CAT_POINT.Y := START_POSITION.Y;

            when RIGHT =>
               case WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT.VERTICAL is
                  when TOP =>    CAT_POINT.X := TEI_UPPER_LEFT.X;
                                 CAT_POINT.Y := TEI_UPPER_LEFT.Y;

                  when CAP =>    CAT_POINT.X := TEI_UPPER_LEFT.X -
                                    (CAP_TOP * HCOS);
                                 CAT_POINT.Y := TEI_UPPER_LEFT.Y -
                                    (CAP_TOP * HSIN);

                  when HALF =>   CAT_POINT.X := (TEI_LOWER_LEFT.X +
                                    TEI_UPPER_LEFT.X) / 2.0;
                                 CAT_POINT.Y := (TEI_LOWER_LEFT.Y +
                                    TEI_UPPER_LEFT.Y) / 2.0;

                  when BASE | NORMAL =>
                                 CAT_POINT.X := TEI_LOWER_LEFT.X +
                                    (BASE_BOTTOM * HCOS);
                                 CAT_POINT.Y := TEI_LOWER_LEFT.Y +
                                    (BASE_BOTTOM * HSIN);

                  when BOTTOM => CAT_POINT.X := TEI_LOWER_LEFT.X;
                                 CAT_POINT.Y := TEI_LOWER_LEFT.Y;
               end case;
         end case;
   end case;

   CONCATENATION_POINT := CONVERT_NDC_DC.NDC_POINT
      (CAT_POINT, WS_SL.WS_TRANSFORM);

   TEXT_EXTENT_LOWER_LEFT  := CONVERT_NDC_DC.NDC_POINT
      (TEI_LOWER_LEFT, WS_SL.WS_TRANSFORM);
   TEXT_EXTENT_LOWER_RIGHT := CONVERT_NDC_DC.NDC_POINT
      (TEI_LOWER_RIGHT, WS_SL.WS_TRANSFORM);
   TEXT_EXTENT_UPPER_LEFT  := CONVERT_NDC_DC.NDC_POINT
      (TEI_UPPER_LEFT, WS_SL.WS_TRANSFORM);
   TEXT_EXTENT_UPPER_RIGHT := CONVERT_NDC_DC.NDC_POINT
      (TEI_UPPER_RIGHT, WS_SL.WS_TRANSFORM);

end INQ_TEXT_EXTENT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEXI3700_WSD_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_WSD - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: LEXI3700_WSD_MA_B.ADA
-- level: ma

with WS_STATE_LIST_TYPES;
with LEXI3700_WS_TABLES;

-- Workstation Driver operations for level ma
with LEXI3700_CONTROL_OPERATIONS;
with LEXI3700_OUTPUT_PRIMITIVES;
with LEXI3700_COLOUR_OPERATIONS;
with LEXI3700_INQ_TEXT;

-- Resource operations for level ma
with WSR_SET_PRIMITIVE_ATTRIBUTES_MA;
with WSR_SET_INDIVIDUAL_ATTRIBUTES_MA;
with WSR_WS_TRANSFORMATION;
with WSR_INQ_WS_DESCRIPTION_TABLE_MA;
with WSR_INQ_WS_STATE_LIST_MA;
with WSR_GKS_NORMALIZATION;

package body LEXI3700_WSD is

-- This package is the LEXIDATA workstation driver and
-- controls the flow of commands to the device driver.
--
-- Package WS_STATE_LIST_TYPES provides a type for access to a
-- workstation state list.
-- Package LEXI3700_WS_TABLES provides a procedure GET_STATE_LIST_PTR
-- to get the pointer of a workstation state list currently allocated
-- for the Lexidata device corresponding to the given workstation id.
-- If no state list has been allocated for the current id, a null
-- pointer is returned.

   procedure LEXI3700_WSD
      (INSTR : in out CGI_INSTR;
       AFFECTED_WS_ID : WS_ID) is

   -- The workstation id is used to find the appropriate workstation
   -- state list.  A pointer to the workstation state list is passed to
   -- all workstation resource (wsr) routines.
   --
   -- This procedure decodes the op_code that is passed from the
   -- workstation manager. Once the op_code has been decoded, this
   -- procedure calls a procedure in either a resource package for
   -- common functions among workstations or a LEXI3700 package for
   -- operations specific to the Lexidata.  The LEXI3700 packages
   -- produce a call to the device driver for actual output.
   --
   --
   -- INSTR - contains the operation and the related parameters.
   -- AFFECTED_WS_ID - the workstation id  of the workstation that is
   --                  affected by the current operation

   -- A pointer to the workstation state list corresponding to WS_ID
   WS_SL : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;

   -- The workstation description table used by this driver
   --        LEXI3700_WS_TABLES.LEXI3700_WS_DT

   begin

      WS_SL := LEXI3700_WS_TABLES.
            GET_STATE_LIST_PTR(AFFECTED_WS_ID);

      case INSTR.OP is

         when NO_OP =>
            null;

         -- logical operation "ws_control"

         when OPEN_WS =>
            LEXI3700_CONTROL_OPERATIONS.OPEN_WS
               (INSTR.WS_TO_OPEN,
                INSTR.CONNECTION_OPEN,
                INSTR.TYPE_OF_WS_OPEN,
                INSTR.ATTRIBUTES_AT_OPEN,
                INSTR.EI);
         when CLOSE_WS =>
            LEXI3700_CONTROL_OPERATIONS.CLOSE_WS(WS_SL);
         when ACTIVATE_WS =>
            WS_SL.WS_STATE := ACTIVE;
         when DEACTIVATE_WS =>
            WS_SL.WS_STATE := INACTIVE;
         when CLEAR_WS =>
            LEXI3700_CONTROL_OPERATIONS.CLEAR_WS
               (WS_SL,
                INSTR.FLAG);
         when UPDATE_WS =>
            LEXI3700_CONTROL_OPERATIONS.UPDATE_WS
               (WS_SL,
                INSTR.REGENERATION);

         -- logical operation "output_primitives"

         when POLYLINE =>
            LEXI3700_OUTPUT_PRIMITIVES.POLYLINE
               (WS_SL,
                INSTR.LINE_POINTS);
         when POLYMARKER =>
            LEXI3700_OUTPUT_PRIMITIVES.POLYMARKER
               (WS_SL,
                INSTR.MARKER_POINTS);
         when FILL_AREA =>
            LEXI3700_OUTPUT_PRIMITIVES.FILL_AREA
               (WS_SL,
                INSTR.FILL_AREA_POINTS);
         when TEXT =>
            LEXI3700_OUTPUT_PRIMITIVES.TEXT
               (WS_SL,
                INSTR.TEXT_POSITION,
                INSTR.TEXT_STRING);

         -- logical operation "set_primitive_attributes_ma"

         when SET_CHAR_VECTORS =>
            WSR_SET_PRIMITIVE_ATTRIBUTES_MA.SET_CHAR_VECTORS
                  (WS_SL,
                   INSTR.CHAR_HEIGHT_VECTOR_SET,
                   INSTR.CHAR_WIDTH_VECTOR_SET);
         when SET_TEXT_ALIGNMENT =>
            WSR_SET_PRIMITIVE_ATTRIBUTES_MA.SET_TEXT_ALIGNMENT
                  (WS_SL,
                   INSTR.TEXT_ALIGNMENT_SET);

         -- logical operation "set_individual_attributes_ma"

         when SET_LINETYPE =>
            WSR_SET_INDIVIDUAL_ATTRIBUTES_MA.SET_LINETYPE
                  (WS_SL,
                   LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.LINETYPE_SET);
         when SET_POLYLINE_COLOUR_INDEX =>
            WSR_SET_INDIVIDUAL_ATTRIBUTES_MA.SET_POLYLINE_COLOUR_INDEX
                  (WS_SL,
                   INSTR.POLYLINE_COLOUR_INDEX_SET);
         when SET_MARKER_TYPE =>
            WSR_SET_INDIVIDUAL_ATTRIBUTES_MA.SET_MARKER_TYPE
                  (WS_SL,
                   LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.MARKER_TYPE_SET);
         when SET_POLYMARKER_COLOUR_INDEX =>
            WSR_SET_INDIVIDUAL_ATTRIBUTES_MA
                  .SET_POLYMARKER_COLOUR_INDEX
                  (WS_SL,
                   INSTR.POLYMARKER_COLOUR_INDEX_SET);
         when SET_TEXT_COLOUR_INDEX =>
            WSR_SET_INDIVIDUAL_ATTRIBUTES_MA.SET_TEXT_COLOUR_INDEX
                  (WS_SL,
                   INSTR.TEXT_COLOUR_INDEX_SET);
         when SET_FILL_AREA_INTERIOR_STYLE =>
            WSR_SET_INDIVIDUAL_ATTRIBUTES_MA
                  .SET_FILL_AREA_INTERIOR_STYLE
                  (WS_SL,
                   INSTR.FILL_AREA_INTERIOR_STYLE_SET);
         when SET_FILL_AREA_COLOUR_INDEX =>
            WSR_SET_INDIVIDUAL_ATTRIBUTES_MA.SET_FILL_AREA_COLOUR_INDEX
                  (WS_SL,
                   INSTR.FILL_AREA_COLOUR_INDEX_SET);

         -- logical operation "set_colour_table"

         when SET_COLOUR_REPRESENTATION =>
            LEXI3700_COLOUR_OPERATIONS.SET_COLOUR_REPRESENTATION
                  (WS_SL,
                   INSTR.COLOUR_INDEX_TO_SET_COLOUR_REP,
                   INSTR.COLOUR_REP_SET,
                   INSTR.EI);

         -- logical operation "ws_transformation"

         when SET_WS_WINDOW =>
            WSR_WS_TRANSFORMATION.SET_WS_WINDOW
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT.WS_DYNAMICS.
                         WS_TRANSFORMATION,
                   WS_SL,
                   INSTR.WS_WINDOW_LIMITS_SET);
         when SET_WS_VIEWPORT =>
            WSR_WS_TRANSFORMATION.SET_WS_VIEWPORT
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT.WS_DYNAMICS.
                         WS_TRANSFORMATION,
                   WS_SL,
                   INSTR.WS_VIEWPORT_LIMITS_SET);

         -- logical operation "inq_ws_description_table_ma"

         when INQ_DISPLAY_SPACE_SIZE =>
            WSR_INQ_WS_DESCRIPTION_TABLE_MA.INQ_DISPLAY_SPACE_SIZE
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.DISPLAY_SPACE_UNITS_INQ,
                   INSTR.MAX_DC_SIZE_INQ,
                   INSTR.MAX_RASTER_UNIT_SIZE_INQ);
         when INQ_POLYLINE_FACILITIES =>
            WSR_INQ_WS_DESCRIPTION_TABLE_MA.INQ_POLYLINE_FACILITIES
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.LIST_OF_POLYLINE_TYPES_INQ,
                   INSTR.NUMBER_OF_WIDTHS_INQ,
                   INSTR.NOMINAL_WIDTH_INQ,
                   INSTR.RANGE_OF_WIDTHS_INQ,
                   INSTR.NUMBER_OF_POLYLINE_INDICES_INQ);
         when INQ_POLYMARKER_FACILITIES =>
            WSR_INQ_WS_DESCRIPTION_TABLE_MA.INQ_POLYMARKER_FACILITIES
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.LIST_OF_POLYMARKER_TYPES_INQ,
                   INSTR.NUMBER_OF_SIZES_INQ,
                   INSTR.NOMINAL_SIZE_INQ,
                   INSTR.RANGE_OF_SIZES_INQ,
                   INSTR.NUMBER_OF_POLYMARKER_INDICES_INQ);
         when INQ_TEXT_FACILITIES =>
            WSR_INQ_WS_DESCRIPTION_TABLE_MA.INQ_TEXT_FACILITIES
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.LIST_OF_FONT_PRECISION_PAIRS_INQ,
                   INSTR.NUMBER_OF_HEIGHTS_INQ,
                   INSTR.RANGE_OF_HEIGHTS_INQ,
                   INSTR.NUMBER_OF_EXPANSIONS_INQ,
                   INSTR.RANGE_OF_EXPANSIONS_INQ,
                   INSTR.NUMBER_OF_TEXT_INDICES_INQ);
         when INQ_FILL_AREA_FACILITIES =>
            WSR_INQ_WS_DESCRIPTION_TABLE_MA.INQ_FILL_AREA_FACILITIES
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.LIST_OF_INTERIOR_STYLES_INQ,
                   INSTR.LIST_OF_HATCH_STYLES_INQ,
                   INSTR.NUMBER_OF_FILL_AREA_INDICES_INQ);
         when INQ_COLOUR_FACILITIES =>
            WSR_INQ_WS_DESCRIPTION_TABLE_MA.INQ_COLOUR_FACILITIES
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.NUMBER_OF_COLOURS_INQ,
                   INSTR.AVAILABLE_COLOUR_INQ,
                   INSTR.NUMBER_OF_COLOUR_INDICES_INQ);
         when INQ_MAX_LENGTH_OF_WS_STATE_TABLES =>
            WSR_INQ_WS_DESCRIPTION_TABLE_MA.
                  INQ_MAX_LENGTH_OF_WS_STATE_TABLES
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.MAX_POLYLINE_ENTRIES_INQ,
                   INSTR.MAX_POLYMARKER_ENTRIES_INQ,
                   INSTR.MAX_TEXT_ENTRIES_INQ,
                   INSTR.MAX_FILL_AREA_ENTRIES_INQ,
                   INSTR.MAX_PATTERN_INDICES_INQ,
                   INSTR.MAX_COLOUR_INDICES_INQ);

         -- logical operation "inq_ws_state_list_ma"

         when INQ_WS_CONNECTION_AND_TYPE =>
            WSR_INQ_WS_STATE_LIST_MA.INQ_WS_CONNECTION_AND_TYPE
                  (WS_SL,
                   INSTR.CONNECTION_INQ,
                   INSTR.TYPE_OF_WS_INQ);
         when INQ_TEXT_EXTENT =>
            LEXI3700_INQ_TEXT.INQ_TEXT_EXTENT
                  (WS_SL,
                   INSTR.POSITION_TEXT,
                   INSTR.CHAR_STRING,
                   INSTR.CONCATENATION_POINT,
                   INSTR.TEXT_EXTENT_LOWER_LEFT_INQ,
                   INSTR.TEXT_EXTENT_LOWER_RIGHT_INQ,
                   INSTR.TEXT_EXTENT_UPPER_LEFT_INQ,
                   INSTR.TEXT_EXTENT_UPPER_RIGHT_INQ);
         when INQ_LIST_OF_COLOUR_INDICES =>
            WSR_INQ_WS_STATE_LIST_MA.INQ_LIST_OF_COLOUR_INDICES
                  (WS_SL,
                   INSTR.LIST_OF_COLOUR_INDICES_INQ);
         when INQ_COLOUR_REPRESENTATION =>
            WSR_INQ_WS_STATE_LIST_MA.INQ_COLOUR_REPRESENTATION
                  (WS_SL,
                   INSTR.COLOUR_INDEX_TO_INQ_COLOUR_REP,
                   INSTR.RETURN_VALUE_TO_INQ_COLOUR_REP,
                   INSTR.COLOUR_REP_INQ,
                   INSTR.EI);
         when INQ_WS_TRANSFORMATION =>
            WSR_INQ_WS_STATE_LIST_MA.INQ_WS_TRANSFORMATION
                  (WS_SL,
                   INSTR.UPDATE_INQ,
                   INSTR.REQUESTED_WINDOW_INQ,
                   INSTR.CURRENT_WINDOW_INQ,
                   INSTR.REQUESTED_VIEWPORT_INQ,
                   INSTR.CURRENT_VIEWPORT_INQ);

         -- logical operation "gks_normalization"

         when SET_CLIPPING_RECTANGLE =>
            WSR_GKS_NORMALIZATION.SET_CLIPPING_RECTANGLE
                  (WS_SL,
                   INSTR.CLIPPING_RECTANGLE_SET);

      end case;

   end LEXI3700_WSD;

end LEXI3700_WSD;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSM_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSM
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  wsm_ma.ada
-- level: ma

with CGI;

use CGI;

package WSM is

-- This is the single entry point for the GKS device independent layer
-- to interface to all "virtual" devices.  The Work Station manager has
-- the responsibility of accepting a CGI interface call from GKS,
-- performing any common operations for workstations and transmitting
-- the operation to the appropriate workstation drivers via the WS_
-- COMMUNICATION package.

   procedure WS_MANAGER
      (INSTR    : in out CGI_INSTR);

end WSM;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WS_COMM.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WS_COMMUNICATION
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WS_COMM.ADA
-- level: all levels

with CGI;
with GKS_TYPES;

use CGI;
use GKS_TYPES;

package WS_COMMUNICATION is

-- CGI_INSTR is declared in the CGI package.
-- WS_TYPE and WS_ID are declared in GKS_TYPES.
-- XMIT_ALL is passed a list of workstations for which
-- to transmit the instruction.

   procedure XMIT
      (INSTR      : in out CGI_INSTR;
       XMIT_WS_ID : in WS_ID);

   procedure XMIT_TYPE
      (INSTR      : in out CGI_INSTR;
       XMIT_TYPE  : in WS_TYPE);

   procedure XMIT_ALL
      (INSTR   : in out CGI_INSTR;
       WS_XMIT_LIST : in WS_IDS.LIST_OF);

end WS_COMMUNICATION;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WS_COMM_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WS_COMMUNICATION
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WS_COMM_B.ADA
-- level: all levels

package body WS_COMMUNICATION is

-- This package provides the data interface between
-- the WS_MANAGER and output device drivers.

   procedure XMIT
      (INSTR      : in out CGI_INSTR;
       XMIT_WS_ID : in WS_ID) is separate;

   procedure XMIT_TYPE
      (INSTR      : in out CGI_INSTR;
       XMIT_TYPE  : in WS_TYPE) is separate;

   procedure XMIT_ALL
      (INSTR        : in out CGI_INSTR;
       WS_XMIT_LIST : in WS_IDS.LIST_OF) is separate;

end WS_COMMUNICATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:XMIT.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: XMIT
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: XMIT.ADA
-- level: ma

with GKS_CONFIGURATION;
with LEXI3700_WSD;
with CGI_OPEN_WS_OPERATIONS;

separate (WS_COMMUNICATION)

procedure XMIT
   (INSTR      : in out CGI_INSTR;
    XMIT_WS_ID : in WS_ID) is

-- This procedure may be rewritten at each level and
-- for each implementation of GKS due to changes in system
-- configuration of devices. Capabilities of GKS increase at
-- each level. Level a has output capabilities and level b
-- has some input capabilities. The case statement
-- in this procedure changes to reflect these capability
-- changes to include output devices at level a or to include
-- input or output devices at levels b and c.
-- Also, various implementations of GKS will have varied
-- devices and the case statement changes to reflect alternative
-- device selections.

XMIT_WS_TYPE : WS_TYPE;

begin

   -- Send the INSTR and the WS_ID to the workstation driver
   -- for the workstation type corresponding to the WS_ID.
   -- CGI_OPEN_WS_OPERATIONS contains the function which
   -- returns the workstation type, on which to case, for the
   -- given XMIT_WS_ID and dictionary in which it resides.

   XMIT_WS_TYPE := CGI_OPEN_WS_OPERATIONS.OPEN_WS.VALUE
         (CGI_OPEN_WS_OPERATIONS.OPEN_DICTIONARY,XMIT_WS_ID);

   case XMIT_WS_TYPE is

      when GKS_CONFIGURATION.LEXIDATA_3700_OUTPUT_TYPE  =>
            LEXI3700_WSD.LEXI3700_WSD(INSTR,XMIT_WS_ID);
      when others =>
            null;
   end case;

end XMIT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:XMIT_TYPE.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: XMIT_TYPE
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: XMIT_TYPE.ADA
-- level: ma

with GKS_CONFIGURATION;
with LEXI3700_WSD;

separate (WS_COMMUNICATION)

procedure XMIT_TYPE
   (INSTR      : in out CGI_INSTR;
    XMIT_TYPE  : in WS_TYPE) is

-- This procedure may be rewritten at each level and
-- for each implementation of GKS due to changes in system
-- configuration of devices. Capabilities of GKS increase at
-- each level. Level a has output capabilities and level b
-- has some input capabilities. The case statement
-- in this procedure changes to reflect these capability
-- changes to include output devices at level a or to include
-- input or output devices at levels b and c.
-- Also, various implementations of GKS will have varied
-- devices and the case statement changes to reflect alternative
-- device selections.

begin

   -- Send a workstation id as a dummy parameter with the INSTR
   -- to the workstation driver for the XMIT_TYPE specified
   -- by the parameter.

   case XMIT_TYPE is
      when GKS_CONFIGURATION.LEXIDATA_3700_OUTPUT_TYPE  =>
            LEXI3700_WSD.LEXI3700_WSD(INSTR,WS_ID'LAST);
      when others => null;
   end case;

end XMIT_TYPE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:XMIT_ALL.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: XMIT_ALL
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: XMIT_ALL.ADA
-- level: all levels

separate (WS_COMMUNICATION)

procedure XMIT_ALL
   (INSTR : in out CGI_INSTR;
    WS_XMIT_LIST : in WS_IDS.LIST_OF) is

begin

   -- The XMIT procedure is called for every workstation
   -- in the WS_XMIT_LIST.

   for I in 1..WS_IDS.SIZE_OF_LIST(WS_XMIT_LIST) loop
      XMIT(INSTR,WS_IDS.LIST_ELEMENT(I,WS_XMIT_LIST));
   end loop;

end XMIT_ALL;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSM_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSM - BODY
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  #001 05/13/85  "No WS_ID in dictionary for use by XMIT"
------------------------------------------------------------------
-- file:  wsm_ma_b.ada
-- level: ma

with GKS_TYPES;
with WS_COMMUNICATION;
with CGI_OPEN_WS_OPERATIONS;
with GKS_ERRORS;

use  GKS_TYPES;

package body WSM is

-- This is the single entry point for the GKS device independent layer
-- to interface to all "virtual" devices.  The Work Station manager has
-- the responsibility of accepting a CGI interface call from GKS,
-- performing any common operations for workstations and transmitting
-- the operation to the appropriate workstation drivers via the WS_
-- COMMUNICATION package.
-- Package GKS_TYPES provides type definitions.
-- Package WS_COMMUNICATIONS provides communication of instructions to
-- different workstation drivers.
-- Package CGI_OPEN_WS_OPERATIONS provides a dictionary of associations
-- between workstation ids and workstation types for each currently
-- open workstation.
-- Package GKS_ERRORS provides named constants for possible error
-- indicator values.

   LIST_OF_OPEN_WS : WS_IDS.LIST_OF;
   -- WS manager copy of list of currently open workstations

   LIST_OF_ACTIVE_WS : WS_IDS.LIST_OF;
   -- WS manager copy of list of currently active workstations


   procedure WS_MANAGER
      (INSTR  : in out CGI_INSTR) is

   -- Decodes all CGI interface instructions and invokes the
   -- appropriate procedure of WS_COMMUNICATION to transmit to a
   -- Workstation Driver.

   begin

      -- Call the appropriate WS_COMMUNICATION routine based on
      -- the CGI instruction opcode

      case INSTR.OP is

         when NO_OP =>
            null;

         -- logical operation "ws_control"

         when OPEN_WS =>
            -- Add association of ws id and ws type to dictionary
            CGI_OPEN_WS_OPERATIONS.OPEN_WS.ENTER               --DR001
                  (CGI_OPEN_WS_OPERATIONS.OPEN_DICTIONARY,     --DR001
                   INSTR.WS_TO_OPEN,                           --DR001
                   INSTR.TYPE_OF_WS_OPEN);                     --DR001
            WS_COMMUNICATION.XMIT(INSTR,INSTR.WS_TO_OPEN);     --DR001
            if  INSTR.EI = GKS_ERRORS.SUCCESSFUL then          --DR001
               -- Add workstation id to list of open workstations
               WS_IDS.ADD_TO_LIST(INSTR.WS_TO_OPEN,            --DR001
                     LIST_OF_OPEN_WS);                         --DR001
            else                                               --DR001
               -- remove ws id entry from open dictionary      --DR001
               CGI_OPEN_WS_OPERATIONS.OPEN_WS.PURGE            --DR001
                     (CGI_OPEN_WS_OPERATIONS.OPEN_DICTIONARY,  --DR001
                      INSTR.WS_TO_OPEN);                       --DR001
            end if;                                            --DR001
         when CLOSE_WS =>
            WS_COMMUNICATION.XMIT(INSTR,INSTR.WS_TO_CLOSE);
            -- remove ws id entry from open dictionary
            CGI_OPEN_WS_OPERATIONS.OPEN_WS.PURGE
                  (CGI_OPEN_WS_OPERATIONS.OPEN_DICTIONARY,
                   INSTR.WS_TO_CLOSE);
            -- Delete workstation id from list of open workstations
            WS_IDS.DELETE_FROM_LIST(INSTR.WS_TO_CLOSE,
                  LIST_OF_OPEN_WS);
         when ACTIVATE_WS =>
            WS_COMMUNICATION.XMIT(INSTR,INSTR.WS_TO_ACTIVATE);
            if  INSTR.EI = GKS_ERRORS.SUCCESSFUL then
               -- Add workstation id to list of active workstations
               WS_IDS.ADD_TO_LIST(INSTR.WS_TO_ACTIVATE,
                     LIST_OF_ACTIVE_WS);
            end if;
         when DEACTIVATE_WS =>
            WS_COMMUNICATION.XMIT(INSTR,INSTR.WS_TO_DEACTIVATE);
            -- Delete workstation id from list of active workstations
            WS_IDS.DELETE_FROM_LIST(INSTR.WS_TO_DEACTIVATE,
                  LIST_OF_ACTIVE_WS);
         when CLEAR_WS =>
            WS_COMMUNICATION.XMIT(INSTR,INSTR.WS_TO_CLEAR);
         when UPDATE_WS =>
            WS_COMMUNICATION.XMIT(INSTR,INSTR.WS_TO_UPDATE);

         -- logical operation "set_colour_table"

         when SET_COLOUR_REPRESENTATION =>
            WS_COMMUNICATION.XMIT(INSTR,INSTR.WS_TO_SET_COLOUR_REP);

         -- logical operation "ws_transformation"

         when SET_WS_WINDOW =>
            WS_COMMUNICATION.XMIT(INSTR,INSTR.WS_TO_SET_WINDOW);
         when SET_WS_VIEWPORT =>
            WS_COMMUNICATION.XMIT(INSTR,INSTR.WS_TO_SET_VIEWPORT);

         -- logical operation "inq_ws_description_table_ma"

         when INQ_DISPLAY_SPACE_SIZE =>
            WS_COMMUNICATION.XMIT_TYPE(INSTR,
                  INSTR.WS_TO_INQ_DISPLAY_SPACE_SIZE);
         when INQ_POLYLINE_FACILITIES =>
            WS_COMMUNICATION.XMIT_TYPE(INSTR,
                  INSTR.WS_TO_INQ_POLYLINE_FACILITIES);
         when INQ_POLYMARKER_FACILITIES =>
            WS_COMMUNICATION.XMIT_TYPE(INSTR,
                  INSTR.WS_TO_INQ_POLYMARKER_FACILITIES);
         when INQ_TEXT_FACILITIES =>
            WS_COMMUNICATION.XMIT_TYPE(INSTR,
                  INSTR.WS_TO_INQ_TEXT_FACILITIES);
         when INQ_FILL_AREA_FACILITIES =>
            WS_COMMUNICATION.XMIT_TYPE(INSTR,
                  INSTR.WS_TO_INQ_FILL_AREA_FACILITIES);
         when INQ_COLOUR_FACILITIES =>
            WS_COMMUNICATION.XMIT_TYPE(INSTR,
                  INSTR.WS_TO_INQ_COLOUR_FACILITIES);
         when INQ_MAX_LENGTH_OF_WS_STATE_TABLES =>
            WS_COMMUNICATION.XMIT_TYPE(INSTR,
                  INSTR.WS_TO_INQ_MAX_LENGTH_OF_WS_STATE_TABLES);

         -- logical operation "inq_ws_state_list_ma"

         when INQ_WS_CONNECTION_AND_TYPE =>
            WS_COMMUNICATION.XMIT(INSTR,
                  INSTR.WS_TO_INQ_CONNECTION_AND_TYPE);
         when INQ_TEXT_EXTENT =>
            WS_COMMUNICATION.XMIT(INSTR,INSTR.WS_TO_INQ_TEXT_EXTENT);
         when INQ_LIST_OF_COLOUR_INDICES =>
            WS_COMMUNICATION.XMIT(INSTR,
                  INSTR.WS_TO_INQ_COLOUR_INDICES);
         when INQ_COLOUR_REPRESENTATION =>
            WS_COMMUNICATION.XMIT(INSTR,
                  INSTR.WS_TO_INQ_COLOUR_REP);
         when INQ_WS_TRANSFORMATION =>
            WS_COMMUNICATION.XMIT(INSTR,
                  INSTR.WS_TO_INQ_TRANSFORMATION);

-- The following logical operations go to all ACTIVE workstations

         -- logical operation "output_primitives"

         when POLYLINE   |
              POLYMARKER |
              FILL_AREA  |
              TEXT =>
            WS_COMMUNICATION.XMIT_ALL(INSTR,LIST_OF_ACTIVE_WS);

-- The following logical operations go to all OPEN workstations

         -- logical operation "set_primitive_attributes_ma"

         when SET_CHAR_VECTORS             |
              SET_TEXT_ALIGNMENT           |

         -- logical operation "set_individual_attributes_ma"

              SET_LINETYPE                 |
              SET_POLYLINE_COLOUR_INDEX    |
              SET_MARKER_TYPE              |
              SET_POLYMARKER_COLOUR_INDEX  |
              SET_TEXT_COLOUR_INDEX        |
              SET_FILL_AREA_INTERIOR_STYLE |
              SET_FILL_AREA_COLOUR_INDEX   |

         -- logical operation "gks_normalization"

              SET_CLIPPING_RECTANGLE =>

            -- Send the instruction to all open workstations
            WS_COMMUNICATION.XMIT_ALL(INSTR,LIST_OF_OPEN_WS);

      end case;

   end WS_MANAGER;

end WSM;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_ST_LST.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_STATE_LIST
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:   gks_st_lst.ada
-- levels: ma, 0a, 1a, 2a

with GKS_TYPES;
with GKS_CONFIGURATION;

use GKS_TYPES;

package GKS_STATE_LIST is

   LIST_OF_OPEN_WS                         : WS_IDS.LIST_OF;

   LIST_OF_ACTIVE_WS                       : WS_IDS.LIST_OF;

   CURRENT_ASPECT_SOURCE_FLAGS             : ASF_LIST;

   -- Polyline attributes

   CURRENT_POLYLINE_INDEX                  : POLYLINE_INDEX;
   CURRENT_LINETYPE                        : LINETYPE;
   CURRENT_LINEWIDTH_SCALE_FACTOR          : LINE_WIDTH;
   CURRENT_POLYLINE_COLOUR_INDEX           : COLOUR_INDEX;

   -- Polymarker attributes

   CURRENT_POLYMARKER_INDEX                : POLYMARKER_INDEX;
   CURRENT_MARKER_TYPE                     : MARKER_TYPE;
   CURRENT_MARKER_SIZE_SCALE_FACTOR        : MARKER_SIZE;
   CURRENT_POLYMARKER_COLOUR_INDEX         : COLOUR_INDEX;

   -- Text attributes

   CURRENT_TEXT_INDEX                      : TEXT_INDEX;
   CURRENT_TEXT_FONT_AND_PRECISION         : TEXT_FONT_PRECISION;
   CURRENT_CHAR_EXPANSION_FACTOR           : CHAR_EXPANSION;
   CURRENT_CHAR_SPACING                    : CHAR_SPACING;
   CURRENT_TEXT_COLOUR_INDEX               : COLOUR_INDEX;

   -- The following text attributes are not bundleable.

   CURRENT_CHAR_HEIGHT                     : WC.MAGNITUDE;
   CURRENT_CHAR_UP_VECTOR                  : WC.VECTOR;
   CURRENT_TEXT_PATH                       : TEXT_PATH;
   CURRENT_TEXT_ALIGNMENT                  : TEXT_ALIGNMENT;
   CURRENT_CHAR_WIDTH                      : WC.MAGNITUDE;
   CURRENT_CHAR_BASE_VECTOR                : WC.VECTOR;

   -- Fill area attributes.

   CURRENT_FILL_AREA_INDEX                 : FILL_AREA_INDEX;
   CURRENT_FILL_AREA_INTERIOR_STYLE        : INTERIOR_STYLE;
   CURRENT_FILL_AREA_STYLE_INDEX           : STYLE_INDEX;
   CURRENT_FILL_AREA_COLOUR_INDEX          : COLOUR_INDEX;

   -- Pattern attributes for pattern fills.

   CURRENT_PATTERN_REFERENCE_POINT         : WC.POINT;
   CURRENT_PATTERN_HEIGHT_VECTOR           : WC.VECTOR;
   CURRENT_PATTERN_WIDTH_VECTOR            : WC.VECTOR;
   CURRENT_NORMALIZATION_TRANSFORMATION    : TRANSFORMATION_NUMBER;

   -- Window and Viewport attributes for transforming between coordinate
   -- systems.  The factors contain the scale factor and translation
   -- factor.

   type NORMALIZATION_TRANSFORMATION is
      record
         WINDOW      : WC.RECTANGLE_LIMITS;
         VIEWPORT    : NDC.RECTANGLE_LIMITS;
         NDC_FACTORS : TRANSFORMATION_MATRIX; -- Factors for NDC to WC.
         WC_FACTORS  : TRANSFORMATION_MATRIX; -- Factors for WC to NDC.
      end record;

   type NORMALIZATION_TRANSFORMATION_ARRAY is array
      (TRANSFORMATION_NUMBER range <>) of NORMALIZATION_TRANSFORMATION;

   LIST_OF_NORMALIZATION_TRANSFORMATIONS :
      NORMALIZATION_TRANSFORMATION_ARRAY
         (0..GKS_CONFIGURATION.MAX_NORMALIZATION_TRANSFORMATION_NUMBER);

   PRIORITY_LIST_OF_TRANSFORMATIONS : TRANSFORMATION_PRIORITY_LIST;

   -- Clipping attributes
   CLIP_INDICATOR                        : CLIPPING_INDICATOR;

   procedure INITIALIZE;

end GKS_STATE_LIST;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:TRANS_FACT.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: TRANSLATION_FACTORS
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:   trans_fact.ada
-- levels: ma, 0a, 1a, 2a

with GKS_TYPES;

use GKS_TYPES;

package TRANSLATION_FACTORS is

-- The package TRANSLATION_FACTORS contains functions that compute
-- the scale factor and translation factor used in translating points
-- from one coordinate system to another.

   function GET_NORMALIZATION_FACTORS
      (WINDOW   : WC.RECTANGLE_LIMITS;
       VIEWPORT : NDC.RECTANGLE_LIMITS)
   return TRANSFORMATION_MATRIX;

   function GET_NORMALIZATION_FACTORS
      (WINDOW   : NDC.RECTANGLE_LIMITS;
       VIEWPORT : WC.RECTANGLE_LIMITS)
   return TRANSFORMATION_MATRIX;

end TRANSLATION_FACTORS;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:TRANS_FACT_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: TRANSLATION_FACTORS - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  trans_fact_b.ada
-- level: ma, 0a, 1a, 2a

package body TRANSLATION_FACTORS is

-- The package TRANSLATION_FACTORS contains functions that compute
-- the scale factor and translation factor used in translating points
-- from one coordinate system to another.

   function GET_NORMALIZATION_FACTORS
      (WINDOW   : WC.RECTANGLE_LIMITS;
       VIEWPORT : NDC.RECTANGLE_LIMITS)
   return TRANSFORMATION_MATRIX is

   -- The function GET_NORMALIZATON_FACTORS computes the scale factor
   -- translation factor for going from world coordinates to normalized
   -- device coordinates.  The final matrix consists of
   -- SX - X scale factor.
   -- SY - Y scale factor.
   -- TX - X translation factor.
   -- TY - Y translation factor.
   -- The matrix to be returned is:
   --     SX  0.0 TX
   --     0.0 SY  TY
   --
   -- WINDOW - The window coordinates.
   --
   -- VIEWPORT - The viewport coordinates.

   TEMPORARY : TRANSFORMATION_MATRIX;
   -- The matrix to return.

   begin

      -- The X scale factor.
      TEMPORARY (1,1) :=
                     (VIEWPORT.XMAX - VIEWPORT.XMIN)/
           (NDC_TYPE (WINDOW.XMAX - WINDOW.XMIN));

      -- Not used in translations.
      TEMPORARY (1,2) := 0.0;

      -- The X translation factor.
      TEMPORARY (1,3) :=
                       (VIEWPORT.XMIN) -
         (TEMPORARY  (1,1) * (NDC_TYPE(WINDOW.XMIN)) );

      -- Not used in translations.
      TEMPORARY (2,1) := 0.0;

      -- The Y scale factor.
      TEMPORARY (2,2) :=
                     (VIEWPORT.YMAX - VIEWPORT.YMIN) /
           (NDC_TYPE (WINDOW.YMAX - WINDOW.YMIN));

      -- The Y translation factor.
      TEMPORARY (2,3) :=
                         (VIEWPORT.YMIN) -
                         (TEMPORARY (2,2) * (NDC_TYPE (WINDOW.YMIN)) );

      return TEMPORARY;

   end GET_NORMALIZATION_FACTORS;

   function GET_NORMALIZATION_FACTORS
      (WINDOW   : NDC.RECTANGLE_LIMITS;
       VIEWPORT : WC.RECTANGLE_LIMITS)
   return TRANSFORMATION_MATRIX is

   -- The function GET_NORMALIZATON_FACTORS computes the scale factor
   -- translation factor for going from normalized device coordinates
   -- to world coordinates.  The final matrix consists of
   -- SX - X scale factor.
   -- SY - Y scale factor.
   -- TX - X translation factor.
   -- TY - Y translation factor.
   -- The matrix to be returned is:
   --     SX  0.0 TX
   --     0.0 SY  TY
   --
   -- WINDOW - The window coordinates.
   --
   -- VIEWPORT - The viewport coordinates.

   TEMPORARY : TRANSFORMATION_MATRIX;
   -- The matrix to be returned.

   begin

      -- X scale factor.
      TEMPORARY (1,1) :=
               (NDC_TYPE (VIEWPORT.XMAX - VIEWPORT.XMIN) )/
                         (WINDOW.XMAX - WINDOW.XMIN);

      -- Not used in translation.
      TEMPORARY (1,2) := 0.0;

      -- X translation factor.
      TEMPORARY (1,3) :=
             (NDC_TYPE (VIEWPORT.XMIN) ) -
         (TEMPORARY  (1,1) * (WINDOW.XMIN) );

      -- Not used in translation.
      TEMPORARY (2,1) := 0.0;

      -- Y scale factor.
      TEMPORARY (2,2) :=
           (NDC_TYPE (VIEWPORT.YMAX - VIEWPORT.YMIN) ) /
                     (WINDOW.YMAX - WINDOW.YMIN);

      -- Y translation factor.
      TEMPORARY (2,3) :=
              (NDC_TYPE (VIEWPORT.YMIN)) -
         (TEMPORARY (2,2) * (WINDOW.YMIN) );

      return TEMPORARY;

   end GET_NORMALIZATION_FACTORS;

end TRANSLATION_FACTORS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_ST_LST_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_STATE_LIST - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:   gks_st_lst_b.ada
-- levels: ma, 0a, 1a, 2a

with TRANSLATION_FACTORS;

package body GKS_STATE_LIST is

   procedure INITIALIZE is

   -- This procedure initializes the GKS_STATE_LIST to the default
   -- values given in the GKS specification manual.  It is called
   -- by the GKS procedure OPEN_GKS.

      begin

         LIST_OF_OPEN_WS := WS_IDS.NULL_LIST;

         LIST_OF_ACTIVE_WS := WS_IDS.NULL_LIST;

         CURRENT_ASPECT_SOURCE_FLAGS  :=
            (OTHERS => INDIVIDUAL);

         -- The following are componants with their type of the record
         -- type ASF_LIST and their default values:
         -- LINETYPE                     : ASF := INDIVIDUAL;
         -- LINE_WIDTH                   : ASF := INDIVIDUAL;
         -- LINE_COLOUR                  : ASF := INDIVIDUAL;
         -- MARKER_TYPE                  : ASF := INDIVIDUAL;
         -- MARKER_SIZE                  : ASF := INDIVIDUAL;
         -- MARKER_COLOUR                : ASF := INDIVIDUAL;
         -- TEXT_FONT_PRECISION          : ASF := INDIVIDUAL;
         -- CHAR_EXPANSION               : ASF := INDIVIDUAL;
         -- CHAR_SPACING                 : ASF := INDIVIDUAL;
         -- TEXT_COLOUR                  : ASF := INDIVIDUAL;
         -- INTERIOR_STYLE               : ASF := INDIVIDUAL;
         -- STYLE_INDEX                  : ASF := INDIVIDUAL;
         -- FILL_AREA_COLOUR             : ASF := INDIVIDUAL;

         -- Polyline attributes

         CURRENT_POLYLINE_INDEX  := 1;
         CURRENT_LINETYPE := 1;
         CURRENT_LINEWIDTH_SCALE_FACTOR := 1.0;
         CURRENT_POLYLINE_COLOUR_INDEX  := 1;

         -- Polymarker attributes

         CURRENT_POLYMARKER_INDEX := 1;
         CURRENT_MARKER_TYPE := 3;
         CURRENT_MARKER_SIZE_SCALE_FACTOR := 1.0;
         CURRENT_POLYMARKER_COLOUR_INDEX  := 1;

         -- Text attributes

         CURRENT_TEXT_INDEX := 1;
         CURRENT_TEXT_FONT_AND_PRECISION :=
            (1, STRING_PRECISION);
         CURRENT_CHAR_EXPANSION_FACTOR := 1.0;
         CURRENT_CHAR_SPACING := 0.0;
         CURRENT_TEXT_COLOUR_INDEX := 1;

         -- The following text attributes are not bundleable.

         CURRENT_CHAR_HEIGHT := 0.01;
         CURRENT_CHAR_UP_VECTOR  := (0.0, 1.0);
         CURRENT_TEXT_PATH  := RIGHT;
         CURRENT_TEXT_ALIGNMENT := (NORMAL, NORMAL);
         CURRENT_CHAR_WIDTH := 0.01;
         CURRENT_CHAR_BASE_VECTOR := (1.0, 0.0);

         -- Fill area attributes.

         CURRENT_FILL_AREA_INDEX := 1;
         CURRENT_FILL_AREA_INTERIOR_STYLE := HOLLOW;
         CURRENT_FILL_AREA_STYLE_INDEX := 1;
         CURRENT_FILL_AREA_COLOUR_INDEX := 1;

         -- Pattern attributes for pattern fills.

         CURRENT_PATTERN_REFERENCE_POINT := (0.0, 0.0);
         CURRENT_PATTERN_HEIGHT_VECTOR := (0.0,1.0);
         CURRENT_PATTERN_WIDTH_VECTOR := (1.0,0.0);
         CURRENT_NORMALIZATION_TRANSFORMATION := 0;

         PRIORITY_LIST_OF_TRANSFORMATIONS := (LENGTH => SMALL_NATURAL
            (GKS_CONFIGURATION.MAX_NORMALIZATION_TRANSFORMATION_NUMBER)
            + SMALL_NATURAL(1),CONTENTS =>(OTHERS => 0));

         -- Window and Viewport Attributes.

         for I in TRANSFORMATION_NUMBER(0)..GKS_CONFIGURATION.
            MAX_NORMALIZATION_TRANSFORMATION_NUMBER loop

            LIST_OF_NORMALIZATION_TRANSFORMATIONS(I).WINDOW :=
               (0.0, 1.0, 0.0, 1.0);

            LIST_OF_NORMALIZATION_TRANSFORMATIONS(I).VIEWPORT :=
               (0.0, 1.0, 0.0, 1.0);

            -- Scale factor and translation factor used to translate
            -- WC to NDC
            LIST_OF_NORMALIZATION_TRANSFORMATIONS(I).NDC_FACTORS :=
               TRANSLATION_FACTORS.GET_NORMALIZATION_FACTORS
               (LIST_OF_NORMALIZATION_TRANSFORMATIONS(0).WINDOW,
               LIST_OF_NORMALIZATION_TRANSFORMATIONS(0).VIEWPORT);

            -- Scale factor and translation factor use to translate
            -- NDC to WC.
            LIST_OF_NORMALIZATION_TRANSFORMATIONS(I).WC_FACTORS :=
               TRANSLATION_FACTORS.GET_NORMALIZATION_FACTORS
               (LIST_OF_NORMALIZATION_TRANSFORMATIONS(0).VIEWPORT,
               LIST_OF_NORMALIZATION_TRANSFORMATIONS(0).WINDOW);

            PRIORITY_LIST_OF_TRANSFORMATIONS.CONTENTS(POSITIVE(1+I)) := I;

         end loop;

         -- Clipping attributes
         CLIP_INDICATOR  := CLIP;

      end INITIALIZE;

end GKS_STATE_LIST;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:TRANS_MATH.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: TRANSFORMATION_MATH
--  IDENTIFIER: GIMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR038  Text height problem with window and viewport.
------------------------------------------------------------------
-- file:   trans_math.ada
-- levels: ma, 0a, 1a, 2a

with GKS_TYPES;

use GKS_TYPES;

package TRANSFORMATION_MATH is

-- The package TRANSFORMATION_MATH contains functions to compute
-- transformations.

   function WC_TO_NDC
      (MATRIX : TRANSFORMATION_MATRIX;
       POINT  : WC.POINT)
   return NDC.POINT;

   function WC_TO_NDC
      (MATRIX : TRANSFORMATION_MATRIX;
       POINTS : WC.POINT_ARRAY)
   return NDC.POINT_ARRAY;

   function NDC_TO_WC
      (MATRIX : TRANSFORMATION_MATRIX;
       POINT  : NDC.POINT)
   return WC.POINT;

   function NDC_TO_WC
      (MATRIX : TRANSFORMATION_MATRIX;
       POINTS : NDC.POINT_ARRAY)
   return WC.POINT_ARRAY;

   function WC_TO_NDC
      (MATRIX : TRANSFORMATION_MATRIX;
       VECTOR : WC.VECTOR)
   return NDC.VECTOR;

end TRANSFORMATION_MATH;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:TRANS_MATH_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: TRANSFORMATION_MATH - BODY
--  IDENTIFIER: GIMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR038  Text height problem with window and viewport.
------------------------------------------------------------------
-- file:   trans_math_b.ada
-- levels: ma, 0a, 1a, 2a

package body TRANSFORMATION_MATH is

-- The package TRANSFORMATION_MATH contains functions to compute
-- transformations.

   function WC_TO_NDC
      (MATRIX : TRANSFORMATION_MATRIX;
       POINT  : WC.POINT)
   return NDC.POINT is

   -- The function WC_TO_NDC translates a world coordinate point into
   -- a normalized device coordinate point.
   -- The formula (Scale Factor * Point + Translation Factor) is used.
   --
   -- MATRIX - The scale factor and translation factor used in
   --          translation.
   --
   -- POINT - The world coordinate point to translate.

   begin

      return ( ( (NDC_TYPE (MATRIX (1,1)) * (NDC_TYPE (POINT.X)))
                + NDC_TYPE (MATRIX (1,3)) ),
               ( (NDC_TYPE (MATRIX (2,2)) * (NDC_TYPE (POINT.Y)))
                + NDC_TYPE (MATRIX (2,3)) ) );

   end WC_TO_NDC;

   function WC_TO_NDC
      (MATRIX : TRANSFORMATION_MATRIX;
       POINTS : WC.POINT_ARRAY)
   return NDC.POINT_ARRAY is

   -- The function WC_TO_NDC translates an array of world coordinate
   -- points into an array of normalized device coordinate points.
   -- The formula ( Scale Factor * Points + Translation Factor) is used.
   --
   -- MATRIX - The scale factor and translation factor used in the
   --          translation of points.
   --
   -- POINTS - The array of points to translate.

   TEMPORARY : NDC.POINT_ARRAY(POINTS'range);
   -- The array of points to return.

   begin

      -- Translate all of the points.
      for I in POINTS'range loop

         TEMPORARY(I) :=  ( ( (NDC_TYPE (MATRIX (1,1)) *
                               NDC_TYPE (POINTS(I).X))
                             + NDC_TYPE (MATRIX (1,3)) ),
                            ( (NDC_TYPE (MATRIX (2,2)) *
                               NDC_TYPE (POINTS(I).Y))
                             + NDC_TYPE (MATRIX (2,3)) ) );

      end loop;

      return TEMPORARY;

   end WC_TO_NDC;

   function NDC_TO_WC
      (MATRIX  : TRANSFORMATION_MATRIX;
       POINT   : NDC.POINT)
   return WC.POINT is

   -- The function NDC_TO_WC translates a normalized device coordinate
   -- point into a world coordinate point.
   -- MATRIX - The scale factor and translation factor used in the
   --          transformation.
   -- POINT - The point to transform.

   begin

      return ( ( (WC_TYPE (MATRIX (1,1)) * WC_TYPE(POINT.X) )
                + WC_TYPE (MATRIX (1,3)) ),
               ( (WC_TYPE (MATRIX (2,2)) * WC_TYPE(POINT.Y) )
                + WC_TYPE (MATRIX (2,3)) ) );

   end NDC_TO_WC;

   function NDC_TO_WC
      (MATRIX  : TRANSFORMATION_MATRIX;
       POINTS : NDC.POINT_ARRAY)
   return WC.POINT_ARRAY is

   -- The function NDC_TO_WC transforms an array of normalized device
   -- coordinate points into an array of world coordinate points.
   -- The formula (Scale Factor * Points + Translation Factor) is used.
   --
   -- MATRIX - The scale factor and translation factor used in the
   --          transformation.
   --
   -- POINTS - The array of points to transform.

   TEMPORARY : WC.POINT_ARRAY(POINTS'range);
   -- The array of points to return.

   begin

      -- Translate all of the points.
      for I in POINTS'range loop

         TEMPORARY(I) :=  ( ( (WC_TYPE (MATRIX (1,1)) *
                               WC_TYPE (POINTS(I).X) )
                             + WC_TYPE (MATRIX (1,3)) ),
                            ( (WC_TYPE (MATRIX (2,2)) *
                               WC_TYPE (POINTS(I).Y) )
                             + WC_TYPE (MATRIX (2,3)) ) );

      end loop;

      return TEMPORARY;

   end NDC_TO_WC;

   function WC_TO_NDC
      (MATRIX : TRANSFORMATION_MATRIX;
       VECTOR : WC.VECTOR)
   return NDC.VECTOR is

   -- The function WC_TO_NDC translates a world coordinate vedtor into
   -- a normalized device coordinate vector.
   -- The formula (Scale Factor * Vector) is used.
   --
   -- MATRIX - The scale factor and translation factor used in
   --          translation.
   --
   -- VECTOR - The world coordinate vector to translate.

   begin

      return ( (NDC_TYPE (MATRIX (1,1)) * (NDC_TYPE (VECTOR.X))),
               (NDC_TYPE (MATRIX (2,2)) * (NDC_TYPE (VECTOR.Y))) );

   end WC_TO_NDC;

end TRANSFORMATION_MATH;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_OPERATING_ST_LST.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_OPERATING_STATE_LIST
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  gks_operating_st_lst.ada
-- level: all levels

with GKS_TYPES;

use GKS_TYPES;

package GKS_OPERATING_STATE_LIST is

-- This package contains the variable for the current operating
-- state of GKS.

   CURRENT_OPERATING_STATE : OPERATING_STATE := GKCL;

end GKS_OPERATING_STATE_LIST;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_DSCR_TBL_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_DESCRIPTION_TABLE
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  gks_dscr_tbl_ma.ada
-- level: ma

with GKS_CONFIGURATION;
with GKS_TYPES;

use GKS_TYPES;

package GKS_DESCRIPTION_TABLE is

   LEVEL_OF_GKS               : GKS_LEVEL := LMA;

   LIST_OF_AVAILABLE_WS_TYPES : WS_TYPES.LIST_OF;

   MAX_OPEN_WS                : POSITIVE  := GKS_CONFIGURATION
                                            .MAX_NUMBER_OPEN_WS;

   MAX_ACTIVE_WS              : POSITIVE  := GKS_CONFIGURATION
                                            .MAX_NUMBER_ACTIVE_WS;

   MAX_NORMALIZATION_TRANSFORMATION_NUMBER : TRANSFORMATION_NUMBER
        := GKS_CONFIGURATION.MAX_NORMALIZATION_TRANSFORMATION_NUMBER;

end GKS_DESCRIPTION_TABLE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_DSCR_TBL_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_DESCRIPTION_TABLE - BODY
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR026  Initialization of list of available ws types fix.
------------------------------------------------------------------
-- file:  gks_dscr_tlb_ma_b.ada
-- level: ma

package body GKS_DESCRIPTION_TABLE is

-- This package body initializes the LIST_OF_AVAILABLE_WS_TYPES
-- variable listed in the specification part of the package.

begin

   WS_TYPES.ADD_TO_LIST
      (WS_TYPE(GKS_CONFIGURATION.LEXIDATA_3700_OUTPUT_TYPE),
       LIST_OF_AVAILABLE_WS_TYPES);

end GKS_DESCRIPTION_TABLE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_ERROR_ST_LST.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_ERROR_STATE_LIST
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  gks_error_st_lst.ada
-- level: all levels

with GKS_TYPES;
with TEXT_IO;
with GKS_ERRORS;

use GKS_TYPES;
use GKS_ERRORS;

package GKS_ERROR_STATE_LIST is

   -- Declaration of the logical error file name.  This is necessary
   -- for the physical creating and opening of the error file in
   -- OPEN_GKS and ERROR_LOGGING.

   ERROR_DATA : TEXT_IO.FILE_TYPE;

   LAST_EI : ERROR_INDICATOR := SUCCESSFUL; -- Error 0

   LAST_SUBPROGRAM : VARIABLE_SUBPROGRAM_NAME;

end GKS_ERROR_STATE_LIST;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:SQUARE_ROOT.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SQUARE_ROOT
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  square_root.ada
-- level: all levels

package SQUARE_ROOT is

   function SQRT
      (VALUE : float)
   return float;

end SQUARE_ROOT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:SQUARE_ROOT_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SQUARE_ROOT - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  square_root_b.ada
-- level: all levels

package body SQUARE_ROOT is

   function SQRT
      (VALUE : float)
   return float is

   -- The function SQRT uses the Newton-Raphson method of finding
   -- the square root.
   --
   -- VALUE - The value used to find the square root.

   R1       : float;
   -- Check for thrashing.

   R0       : float := 1.0;
   -- Initial guess.

   RESULT   : float := ( VALUE + (R0*R0) ) / (2.0 * R0);
   -- The final square root.

   PRECISION : float := 1.0 * 10.0 ** (- float'digits); --float'safe_small;
   -- The most precision expected in the answer.

   begin

      if VALUE <= 0.0 then
         raise numeric_error;
      end if;

      loop

         R1 := R0;
         R0 := RESULT;
         RESULT := ( VALUE + (R0*R0) ) / (2.0*R0);

         if (abs ((RESULT-R0)/R0) <= PRECISION) or
            (abs (R1 - RESULT) <= PRECISION) then
            exit;
         end if;

      end loop;

      return RESULT;

   end SQRT;

end SQUARE_ROOT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GET_OUTPUT_ATTR.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GET_OUTPUT_ATTRIBUTES
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  get_output_attr.ada
-- level: ma - 2a

with GKS_TYPES;
with SQUARE_ROOT;
with OUTPUT_ATTRIBUTES_TYPE;
with TRANSFORMATION_MATH;

use GKS_TYPES;

package GET_OUTPUT_ATTRIBUTES IS

   procedure GET_ATTRIBUTES
             (LATEST_OUTPUT_ATTRIBUTES : out OUTPUT_ATTRIBUTES_TYPE.
                                             OUTPUT_ATTRIBUTES);

end GET_OUTPUT_ATTRIBUTES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GET_OUTPUT_ATTR_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GET_OUTPUT_ATTRIBUTES - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  get_output_attr_b.ada
-- level: ma - 2a

with GKS_STATE_LIST;

package body GET_OUTPUT_ATTRIBUTES is


   function WC_VECTOR_TO_NDC_VECTOR
      (WC_VECTOR : in WC.VECTOR)
   return NDC.VECTOR is

   -- The function WC_VECTOR_TO_NDC_VECTOR converts a world coordinate
   -- vector into a normalized device coordinate vector.  It is
   -- converted by using the scale factor only.
   --
   -- WC_VECTOR - The world coordinate vector to be converted.

      TEMPORARY_POINT : NDC.VECTOR;
      -- A temporary holder of the vector to return.

      begin

         TEMPORARY_POINT.X :=
           ( (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
               (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION).
                NDC_FACTORS(1,1)) * NDC_TYPE(WC_VECTOR.X) );

         TEMPORARY_POINT.Y :=
           ( (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
               (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION).
                NDC_FACTORS(2,2)) * NDC_TYPE(WC_VECTOR.Y) );

         return TEMPORARY_POINT;

      end WC_VECTOR_TO_NDC_VECTOR;

   procedure GET_ATTRIBUTES
             (LATEST_OUTPUT_ATTRIBUTES : out OUTPUT_ATTRIBUTES_TYPE.
                                             OUTPUT_ATTRIBUTES) is
   -- The procedure GET_ATTRIBUTES outputs the latest attributes.
   -- Any WC values are converted to NDC.
   --
   -- LATEST_OUTPUT_ATTRIBUTES - The latest attributes to be returned.

      use WC;

      TEMP_ATTR : OUTPUT_ATTRIBUTES_TYPE.OUTPUT_ATTRIBUTES;

      CHAR_HEIGHT_VECTOR : WC.VECTOR;

      CHAR_WIDTH_VECTOR : WC.VECTOR;

      begin

         TEMP_ATTR.ASPECT_SOURCE_FLAGS := GKS_STATE_LIST.
                                          CURRENT_ASPECT_SOURCE_FLAGS;
         -- The following are components with their type of the record
         -- type ASF_LIST and their default values:
         -- LINETYPE                     : ASF := INDIVIDUAL;
         -- LINE_WIDTH                   : ASF := INDIVIDUAL;
         -- LINE_COLOUR                  : ASF := INDIVIDUAL;
         -- MARKER_TYPE                  : ASF := INDIVIDUAL;
         -- MARKER_SIZE                  : ASF := INDIVIDUAL;
         -- MARKER_COLOUR                : ASF := INDIVIDUAL;
         -- TEXT_FONT_PRECISION          : ASF := INDIVIDUAL;
         -- CHAR_EXPANSION               : ASF := INDIVIDUAL;
         -- CHAR_SPACING                 : ASF := INDIVIDUAL;
         -- TEXT_COLOUR                  : ASF := INDIVIDUAL;
         -- INTERIOR_STYLE               : ASF := INDIVIDUAL;
         -- STYLE_INDEX                  : ASF := INDIVIDUAL;
         -- FILL_AREA_COLOUR             : ASF := INDIVIDUAL;

         -- polyline attributes

         TEMP_ATTR.CURRENT_POLYLINE_INDEX
                   := GKS_STATE_LIST.CURRENT_POLYLINE_INDEX;
         TEMP_ATTR.CURRENT_LINETYPE
                   := GKS_STATE_LIST.CURRENT_LINETYPE;
         TEMP_ATTR.CURRENT_LINEWIDTH_SCALE_FACTOR
                   := GKS_STATE_LIST.CURRENT_LINEWIDTH_SCALE_FACTOR;
         TEMP_ATTR.CURRENT_POLYLINE_COLOUR_INDEX
                   := GKS_STATE_LIST.CURRENT_POLYLINE_COLOUR_INDEX;

         -- polymarker attributes

         TEMP_ATTR.CURRENT_POLYMARKER_INDEX
                   := GKS_STATE_LIST.CURRENT_POLYMARKER_INDEX;
         TEMP_ATTR.CURRENT_MARKER_TYPE
                   := GKS_STATE_LIST.CURRENT_MARKER_TYPE;
         TEMP_ATTR.CURRENT_MARKER_SIZE_SCALE_FACTOR
                   := GKS_STATE_LIST.CURRENT_MARKER_SIZE_SCALE_FACTOR;
         TEMP_ATTR.CURRENT_POLYMARKER_COLOUR_INDEX
                   := GKS_STATE_LIST.CURRENT_POLYMARKER_COLOUR_INDEX;

         -- text attributes

         TEMP_ATTR.CURRENT_TEXT_INDEX
                   := GKS_STATE_LIST.CURRENT_TEXT_INDEX;
         TEMP_ATTR.CURRENT_TEXT_FONT_AND_PRECISION
                   := GKS_STATE_LIST.CURRENT_TEXT_FONT_AND_PRECISION;
         TEMP_ATTR.CURRENT_CHAR_EXPANSION_FACTOR
                   := GKS_STATE_LIST.CURRENT_CHAR_EXPANSION_FACTOR;
         TEMP_ATTR.CURRENT_CHAR_SPACING
                   := GKS_STATE_LIST.CURRENT_CHAR_SPACING;
         TEMP_ATTR.CURRENT_TEXT_COLOUR_INDEX
                   := GKS_STATE_LIST.CURRENT_TEXT_COLOUR_INDEX;

         -- the following text attributes are not bundleable.

         -- the following calculations compute the character
         -- height and base vectors, then do the transformations
         -- from WC to NDC

         CHAR_HEIGHT_VECTOR.X := WC_TYPE(FLOAT(GKS_STATE_LIST.
           CURRENT_CHAR_HEIGHT) * FLOAT(GKS_STATE_LIST.
           CURRENT_CHAR_UP_VECTOR.X) / SQUARE_ROOT.SQRT
           (FLOAT(GKS_STATE_LIST.CURRENT_CHAR_UP_VECTOR.X ** 2
           + GKS_STATE_LIST.CURRENT_CHAR_UP_VECTOR.Y ** 2)));

         CHAR_HEIGHT_VECTOR.Y := WC_TYPE(FLOAT(GKS_STATE_LIST.
             CURRENT_CHAR_HEIGHT) * FLOAT(GKS_STATE_LIST.
             CURRENT_CHAR_UP_VECTOR.Y) / SQUARE_ROOT.SQRT
             (FLOAT(GKS_STATE_LIST.CURRENT_CHAR_UP_VECTOR.X ** 2
             + GKS_STATE_LIST.CURRENT_CHAR_UP_VECTOR.Y ** 2)));

         CHAR_WIDTH_VECTOR.X := WC_TYPE(FLOAT(GKS_STATE_LIST.
             CURRENT_CHAR_WIDTH) * FLOAT(GKS_STATE_LIST.
             CURRENT_CHAR_BASE_VECTOR.X) / SQUARE_ROOT.SQRT
             (FLOAT(GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.X ** 2
             + GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.Y ** 2)));

         CHAR_WIDTH_VECTOR.Y := WC_TYPE(FLOAT(GKS_STATE_LIST.
             CURRENT_CHAR_WIDTH) * FLOAT(GKS_STATE_LIST.
             CURRENT_CHAR_BASE_VECTOR.Y) / SQUARE_ROOT.SQRT
             (FLOAT(GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.X ** 2
             + GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.Y ** 2)));

         TEMP_ATTR.CURRENT_CHAR_HEIGHT_VECTOR := NDC.VECTOR
            (TRANSFORMATION_MATH.WC_TO_NDC(GKS_STATE_LIST.
            LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION).
            NDC_FACTORS, POINT(CHAR_HEIGHT_VECTOR)));

         TEMP_ATTR.CURRENT_CHAR_WIDTH_VECTOR := NDC.VECTOR
            (TRANSFORMATION_MATH.WC_TO_NDC(GKS_STATE_LIST.
            LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION).
            NDC_FACTORS, POINT(CHAR_WIDTH_VECTOR)));

         TEMP_ATTR.CURRENT_TEXT_PATH
                   := GKS_STATE_LIST.CURRENT_TEXT_PATH;
         TEMP_ATTR.CURRENT_TEXT_ALIGNMENT
                   := GKS_STATE_LIST.CURRENT_TEXT_ALIGNMENT;

         -- fill area attributes.

         TEMP_ATTR.CURRENT_FILL_AREA_INDEX
                   := GKS_STATE_LIST.CURRENT_FILL_AREA_INDEX;
         TEMP_ATTR.CURRENT_FILL_AREA_INTERIOR_STYLE
                   := GKS_STATE_LIST.CURRENT_FILL_AREA_INTERIOR_STYLE;
         TEMP_ATTR.CURRENT_FILL_AREA_STYLE_INDEX
                   := GKS_STATE_LIST.CURRENT_FILL_AREA_STYLE_INDEX;
         TEMP_ATTR.CURRENT_FILL_AREA_COLOUR_INDEX
                   := GKS_STATE_LIST.CURRENT_FILL_AREA_COLOUR_INDEX;

         -- pattern attributes for pattern fills.

         TEMP_ATTR.CURRENT_PATTERN_REFERENCE_POINT
                   := TRANSFORMATION_MATH.WC_TO_NDC
              ( ( GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
                 (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION).
                  NDC_FACTORS ),
                ( GKS_STATE_LIST.CURRENT_PATTERN_REFERENCE_POINT ) );
         TEMP_ATTR.CURRENT_PATTERN_HEIGHT_VECTOR
                   := WC_VECTOR_TO_NDC_VECTOR
                         (GKS_STATE_LIST.CURRENT_PATTERN_HEIGHT_VECTOR);
         TEMP_ATTR.CURRENT_PATTERN_WIDTH_VECTOR
                   := WC_VECTOR_TO_NDC_VECTOR
                         (GKS_STATE_LIST.CURRENT_PATTERN_WIDTH_VECTOR);

         -- clipping attributes

         -- used for clipping to NDC space. The points are the lower
         -- left corner and the upper right corner.

         TEMP_ATTR.CLIPPING_RECTANGLE
                   := GKS_STATE_LIST.
                      LIST_OF_NORMALIZATION_TRANSFORMATIONS
                      (GKS_STATE_LIST.
                       CURRENT_NORMALIZATION_TRANSFORMATION).VIEWPORT;

         -- Initialize the output attribute list.
         LATEST_OUTPUT_ATTRIBUTES := TEMP_ATTR;

      end GET_ATTRIBUTES;

   end GET_OUTPUT_ATTRIBUTES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:SET_INDV_ATTR_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_INDIVIDUAL_ATTRIBUTES - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  set_indv_attr_ma_b.ada
-- level: all levels

with WSM;
with CGI;
with ERROR_ROUTINES;
with GKS_OPERATING_STATE_LIST;
with GKS_ERRORS;
with GKS_STATE_LIST;

use WSM;
use CGI;
use ERROR_ROUTINES;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body SET_INDIVIDUAL_ATTRIBUTES_MA is

-- This is the package body for setting individual attributes.
--
-- All of the procedures in this package first inquire the
-- GKS_OPERATING_STATE_LIST to check if GKS is in one of
-- the states GKOP, WSOP, WSAC, or SGOP.  If it is not, error
-- 8 occurs and the procedure raises the exception STATE_
-- ERROR.  No error indicators above 0 are expected from the
-- workstation manager for these procedures.
--
-- If error indicator 8 occurs, these procedures call the
-- ERROR_LOGGING procedure of the package ERROR_ROUTINES
-- to log the error indicator and the name of the procedure
-- in the error file specified when the procedure OPEN_GKS
-- was called to begin this session of GKS operation.

   procedure SET_LINETYPE
      (LINE : in LINETYPE) is

   -- This procedure sets the value of the current linetype in the
   -- GKS_STATE_LIST and then sends the value to the WS_MANAGER.
   --
   -- LINE - Indicates the line style to be used for subsequent
   --    polylines.

   GKS_INSTR : CGI_SET_LINETYPE;

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP,
                        "SET_LINETYPE");               -- Error 8
         raise STATE_ERROR;

      elsif LINE = 0 then
         ERROR_LOGGING (LINETYPE_IS_ZERO,
                        "SET_LINETYPE");               -- Error 63
         raise OUTPUT_ATTRIBUTE_ERROR;

      else
         GKS_STATE_LIST.CURRENT_LINETYPE := LINE;

         -- Call to WS_MANAGER with the new line type.
         GKS_INSTR.LINETYPE_SET := LINE;
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OUTPUT_ATTRIBUTE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN, "SET_LINETYPE");    -- Error 2501
            raise;

   end SET_LINETYPE;

   procedure SET_POLYLINE_COLOUR_INDEX
      (COLOUR : in COLOUR_INDEX) is

   -- This procedure sets the value of the current polyline colour
   -- index GKS_STATE_LIST and then sends the value to the WS_MANAGER.
   --
   -- COLOUR - Indicates the colour to be used for subsequent polylines.

   GKS_INSTR : CGI_SET_POLYLINE_COLOUR_INDEX;

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP,
                        "SET_POLYLINE_COLOUR_INDEX");      -- Error 8
         raise STATE_ERROR;
      else
         GKS_STATE_LIST.CURRENT_POLYLINE_COLOUR_INDEX := COLOUR;

         -- Call to WS_MANAGER with the new line colour.

         GKS_INSTR.POLYLINE_COLOUR_INDEX_SET := COLOUR;
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,
                           "SET_POLYLINE_COLOUR_INDEX"); -- Error 2501
            raise;

   end SET_POLYLINE_COLOUR_INDEX;

   procedure SET_MARKER_TYPE
      (MARKER : in MARKER_TYPE) is

   -- This procedure sets the value of the current marker type in
   -- the GKS_STATE_LIST and then sends the value to the WS_MANAGER.
   --
   -- MARKER - Indicates the marker style to be used for subsequent
   --    polymarkers.

   GKS_INSTR : CGI_SET_MARKER_TYPE;

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP,
                        "SET_MARKER_TYPE");          -- Error 8
         raise STATE_ERROR;

      elsif MARKER = 0 then
         ERROR_LOGGING (MARKER_TYPE_IS_ZERO,
                        "SET_MARKER_TYPE");          -- Error 69
         raise OUTPUT_ATTRIBUTE_ERROR;

      else
         GKS_STATE_LIST.CURRENT_MARKER_TYPE := MARKER;

         -- Call to WS_MANAGER with the new marker type.

         GKS_INSTR.MARKER_TYPE_SET := MARKER;
         WS_MANAGER (GKS_INSTR);
      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OUTPUT_ATTRIBUTE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN, "SET_MARKER_TYPE");  -- Error 2501
            raise;

   end SET_MARKER_TYPE;

   procedure SET_POLYMARKER_COLOUR_INDEX
      (COLOUR : in COLOUR_INDEX) is

   -- This procedure sets the value of the current polymarker
   -- colour index in the GKS_STATE_LIST and then sends the
   -- value to the WS_MANAGER.
   --
   -- COLOUR - Indicates the colour to be used for subsequent
   --    polymarkers.

   GKS_INSTR : CGI_SET_POLYMARKER_COLOUR_INDEX;

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP,
                        "SET_POLYMARKER_COLOUR_INDEX");   -- Error 8
         raise STATE_ERROR;

      else

         GKS_STATE_LIST.CURRENT_POLYMARKER_COLOUR_INDEX := COLOUR;

         -- Call to WS_MANAGER with the new marker colour.

         GKS_INSTR.POLYMARKER_COLOUR_INDEX_SET := COLOUR;
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,
                           "SET_POLYMARKER_COLOUR_INDEX"); -- Error 2501
            raise;

   end SET_POLYMARKER_COLOUR_INDEX;

   procedure SET_TEXT_COLOUR_INDEX
      (COLOUR : in COLOUR_INDEX) is

   -- This procedure sets the value of the current text colour index
   -- in the GKS_STATE_LIST and then sends the value to the WS_MANAGER.
   --
   -- COLOUR - Indicates the colour of subsequent text primitives.

   GKS_INSTR : CGI_SET_TEXT_COLOUR_INDEX;

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP,
                        "SET_TEXT_COLOUR_INDEX");       -- Error 8
         raise STATE_ERROR;
      else

         GKS_STATE_LIST.CURRENT_TEXT_COLOUR_INDEX := COLOUR;

         -- Call to WS_MANAGER with the new text colour.

         GKS_INSTR.TEXT_COLOUR_INDEX_SET := COLOUR;
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,
                           "SET_TEXT_COLOUR_INDEX");   -- Error 2501
            raise;

   end SET_TEXT_COLOUR_INDEX;

   procedure SET_FILL_AREA_INTERIOR_STYLE
      (STYLE : in INTERIOR_STYLE) is

   -- This procedure sets the value of the current fill area interior
   -- style in the GKS_STATE_LIST and then sends the value to the
   -- WS_MANAGER.
   --
   -- STYLE - Indicates the interior style to be used for fill area
   --    primitives.  The values may be HOLLOW, SOLID, PATTERN, or
   --    HATCH.

   GKS_INSTR : CGI_SET_FILL_AREA_INTERIOR_STYLE;

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP,
                         "SET_FILL_AREA_INTERIOR_STYLE"); -- Error 8
         raise STATE_ERROR;
      else
         GKS_STATE_LIST.CURRENT_FILL_AREA_INTERIOR_STYLE := STYLE;

         -- Call to WS_MANAGER with the new interior style.

         GKS_INSTR.FILL_AREA_INTERIOR_STYLE_SET := STYLE;
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,
                           "SET_FILL_AREA_INTERIOR_STYLE"); -- Error 2501
            raise;

   end SET_FILL_AREA_INTERIOR_STYLE;

   procedure SET_FILL_AREA_COLOUR_INDEX
      (COLOUR : in COLOUR_INDEX) is

   -- This procedure sets the value of the current fill area colour
   -- index in the GKS_STATE_LIST and then sends the value to the
   -- WS_MANAGER.
   --
   -- COLOUR - Indicates the colour to be used in subsequent
   --    fill area primitives.

   GKS_INSTR : CGI_SET_FILL_AREA_COLOUR_INDEX;

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP,
                        "SET_FILL_AREA_COLOUR_INDEX");  -- Error 8
         raise STATE_ERROR;

      else
         GKS_STATE_LIST.CURRENT_FILL_AREA_COLOUR_INDEX := COLOUR;

         -- Call to WS_MANAGER with the new fill area colour.

         GKS_INSTR.FILL_AREA_COLOUR_INDEX_SET := COLOUR;
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,
                           "SET_FILL_AREA_COLOUR_INDEX"); -- Error 2501
            raise;

   end SET_FILL_AREA_COLOUR_INDEX;

end SET_INDIVIDUAL_ATTRIBUTES_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:SET_PRIM_ATTR_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_PRIMITIVE_ATTRIBUTES_MA - BODY
--  IDENTIFIER: GIMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR038  Text height problem with window and viewport.
------------------------------------------------------------------
-- file:  set_prim_attr_ma_b.ada
-- levels: all levels

with WSM;
with CGI;
with ERROR_ROUTINES;
with GKS_OPERATING_STATE_LIST;
with GKS_ERRORS;
with GKS_STATE_LIST;
with TRANSFORMATION_MATH;
with SQUARE_ROOT;

use WSM;
use CGI;
use ERROR_ROUTINES;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body SET_PRIMITIVE_ATTRIBUTES_MA is

-- This is the package body for the procedures to set the
-- primitive attribute values for level ma.
--
-- Each of the procedures in this package inquires the
-- GKS_OPERATING_STATE_LIST to check if GKS is in one of
-- the states GKOP, WSOP, WSAC, or SGOP.  If it is not,
-- error 8 occurs and the procedure raises the exception
-- STATE_ERROR.
--
-- If an error indicator 8 occurs, these procedures call the
-- ERROR_LOGGING procedure of the package ERROR_ROUTINES
-- to log the error indicator and the name of the procedure
-- in the error file specified when the procedure OPEN_GKS
-- was called to begin this session of GKS operation.

   procedure SET_CHAR_HEIGHT
      (HEIGHT : in WC.MAGNITUDE) is

   -- This procedure sets the value of the current character height in
   -- the GKS_STATE_LIST and then sends the value to the WS_MANAGER.
   --
   -- HEIGHT - Indicates the nominal height of the capital letter
   --    character.

   use WC;
   -- For visiblity to the types and operations on the types
   -- in the GKS_COORDINATE_SYSTEM.

   CHAR_HEIGHT_VECTOR : WC.VECTOR;
   CHAR_WIDTH_VECTOR  : WC.VECTOR;
   -- The above two objects are used to hold the vectors that are
   -- calculated in world coordinates prior to being transformed
   -- and sent to the WS_MANAGER.

   GKS_INSTR : CGI_SET_CHAR_VECTORS;

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP,
                        "SET_CHAR_HEIGHT");        -- Error 8
         raise STATE_ERROR;
      else

         GKS_STATE_LIST.CURRENT_CHAR_HEIGHT := HEIGHT;
         GKS_STATE_LIST.CURRENT_CHAR_WIDTH := HEIGHT;

      -- The following finds the size of the vectors for the
      -- character height and width.

      -- The formula for the character height is:
      -- wc.vector = (current character height) *
      -- (current character up vector)/
      -- (the magnitude of the character up vector).

      CHAR_HEIGHT_VECTOR.X := WC_TYPE (float(HEIGHT) *
         (float (GKS_STATE_LIST.CURRENT_CHAR_UP_VECTOR.X)
         / SQUARE_ROOT.SQRT (float
         (GKS_STATE_LIST.CURRENT_CHAR_UP_VECTOR.X ** 2
         + GKS_STATE_LIST.CURRENT_CHAR_UP_VECTOR.Y ** 2))));


      CHAR_HEIGHT_VECTOR.Y := WC_TYPE (float(HEIGHT) *
         (float(GKS_STATE_LIST.CURRENT_CHAR_UP_VECTOR.Y)
         / SQUARE_ROOT.SQRT (float
         (GKS_STATE_LIST.CURRENT_CHAR_UP_VECTOR.X ** 2
         + GKS_STATE_LIST.CURRENT_CHAR_UP_VECTOR.Y ** 2))));

      -- The formula for the character width is:
      -- wc.vector = (current character width) *
      -- (current character base vector)/
      -- (the magnitude of the character base vector).
      -- Remembering that the current character width is equal to
      -- the parameter HEIGHT that was passed in, the formula
      -- is used below.

      CHAR_WIDTH_VECTOR.X := WC_TYPE (float(HEIGHT) *
         (float(GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.X)
         / SQUARE_ROOT.SQRT (float
         (GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.X ** 2
         + GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.Y ** 2))));

      CHAR_WIDTH_VECTOR.Y := WC_TYPE (float(HEIGHT) *
         (float (GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.Y)
         / SQUARE_ROOT.SQRT (float
         (GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.X ** 2
         + GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.Y ** 2))));

      -- Transform the WC vectors to NDC
      GKS_INSTR.CHAR_HEIGHT_VECTOR_SET := TRANSFORMATION_MATH.WC_TO_NDC
         (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
         (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION).
         NDC_FACTORS, CHAR_HEIGHT_VECTOR);

      GKS_INSTR.CHAR_WIDTH_VECTOR_SET := TRANSFORMATION_MATH.WC_TO_NDC
         (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
         (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION).
         NDC_FACTORS, CHAR_WIDTH_VECTOR);

         -- Call to WS_MANAGER with the new character height vector
         -- and the new character width vector.
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when NUMERIC_ERROR =>
            ERROR_LOGGING (ARITHMETIC, "SET_CHAR_HEIGHT"); -- Error 308
            raise SYSTEM_ERROR;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN, "SET_CHAR_HEIGHT");  -- Error 2501
            raise;

   end SET_CHAR_HEIGHT;

   procedure SET_CHAR_UP_VECTOR
      (CHAR_UP_VECTOR : in WC.VECTOR) is


   -- This procedure sets the value of the current character up vector
   -- in the GKS_STATE_LIST and then sends the value to the WS_MANAGER.
   --
   -- If the workstation manager returns error 79, this procedure
   -- raises OUTPUT_ATTRIBUTE_ERROR.
   --
   -- CHAR_UP_VECTOR - Indicates the up direction of the character.

  GKS_INSTR : CGI_SET_CHAR_VECTORS;

   use WC;
   -- For visiblity to the types and operations on the types
   -- in the GKS_COORDINATE_SYSTEM.

   CHAR_HEIGHT_VECTOR : WC.VECTOR;
   CHAR_WIDTH_VECTOR  : WC.VECTOR;
   -- The above two objects are used to hold the vectors that are
   -- calculated in world coordinates prior to being transformed
   -- and sent to the WS_MANAGER.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP,
                        "SET_CHAR_UP_VECTOR");        -- Error 8
         raise STATE_ERROR;

      elsif (CHAR_UP_VECTOR.X = 0.0) and
            (CHAR_UP_VECTOR.Y = 0.0) then
         ERROR_LOGGING (CHAR_UP_VECTOR_IS_ZERO,
                        "SET_CHAR_UP_VECTOR");        -- Error 79
         raise OUTPUT_ATTRIBUTE_ERROR;

      else

         GKS_STATE_LIST.CURRENT_CHAR_UP_VECTOR := CHAR_UP_VECTOR;

         -- Compute a vector at right angles to the CHAR_UP_VECTOR
         -- to be used for the CURRENT_CHAR_BASE_VECTOR.

         GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR :=
                                  (CHAR_UP_VECTOR.Y,-CHAR_UP_VECTOR.X);

      -- The following finds the size of the vectors for the
      -- character height and width using the new character up vector.

      -- The formula for the character height is:
      -- wc.vector = (current character height) *
      -- (current character up vector)/
      -- (the magnitude of the character up vector).


      CHAR_HEIGHT_VECTOR.X := WC_TYPE
           (float(GKS_STATE_LIST.CURRENT_CHAR_HEIGHT)
         * (float(CHAR_UP_VECTOR.X)
         / SQUARE_ROOT.SQRT (float
         (CHAR_UP_VECTOR.X ** 2 + CHAR_UP_VECTOR.Y ** 2))));

      CHAR_HEIGHT_VECTOR.Y := WC_TYPE
           (float (GKS_STATE_LIST.CURRENT_CHAR_HEIGHT)
         * (float (CHAR_UP_VECTOR.Y)
         / SQUARE_ROOT.SQRT (float
         (CHAR_UP_VECTOR.X ** 2 + CHAR_UP_VECTOR.Y ** 2))));

      -- The formula for the character width is:
      -- wc.vector = (current character width) *
      -- (current character base vector)/
      -- (the magnitude of the character base vector).

      CHAR_WIDTH_VECTOR.X := WC_TYPE
           (float (GKS_STATE_LIST.CURRENT_CHAR_WIDTH)
         * (float (GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.X)
         /  SQUARE_ROOT.SQRT (float
           (GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.X ** 2
         +  GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.Y ** 2))));

      CHAR_WIDTH_VECTOR.Y := WC_TYPE
           (float (GKS_STATE_LIST.CURRENT_CHAR_WIDTH)
         * (float (GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.Y)
         /  SQUARE_ROOT.SQRT (float
           (GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.X ** 2
         +  GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR.Y ** 2))));

      -- Transform the WC vectors to NDC
      GKS_INSTR.CHAR_HEIGHT_VECTOR_SET := TRANSFORMATION_MATH.WC_TO_NDC
         (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
         (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION).
         NDC_FACTORS, CHAR_HEIGHT_VECTOR);

      GKS_INSTR.CHAR_WIDTH_VECTOR_SET := TRANSFORMATION_MATH.WC_TO_NDC
         (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
         (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION).
         NDC_FACTORS, CHAR_WIDTH_VECTOR);

      WS_MANAGER(GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OUTPUT_ATTRIBUTE_ERROR =>
            raise;
         when NUMERIC_ERROR =>
            ERROR_LOGGING(ARITHMETIC,"SET_CHAR_UP_VECTOR"); -- Error 308
            raise SYSTEM_ERROR;
         when OTHERS =>
            ERROR_LOGGING(UNKNOWN, "SET_CHAR_UP_VECTOR");  -- Error 2501
            raise;

   end SET_CHAR_UP_VECTOR;

   procedure SET_TEXT_ALIGNMENT
      (ALIGNMENT : in TEXT_ALIGNMENT) is

   -- This procedure sets the value of the current text alignment in
   -- the GKS_STATE_LIST and then sends the value to the WS_MANAGER.
   --
   -- ALIGNMENT - Indicates the positioning of the text extent
   --    rectangle in relation to the text position. It is a
   --    record with a HORIZONTAL component and a VERTICAL
   --    component.

   GKS_INSTR : CGI_SET_TEXT_ALIGNMENT;

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP,
                        "SET_TEXT_ALIGNMENT");      -- Error 8
         raise STATE_ERROR;
      else

         GKS_STATE_LIST.CURRENT_TEXT_ALIGNMENT := ALIGNMENT;

         -- Call to WS_MANAGER with the new text alignment.

         GKS_INSTR.TEXT_ALIGNMENT_SET := ALIGNMENT;
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN, "SET_TEXT_ALIGNMENT"); -- Error 2501
            raise;

   end SET_TEXT_ALIGNMENT;

end SET_PRIMITIVE_ATTRIBUTES_MA ;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:INQ_PRIM_ATTR_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_PRIMITIVE_ATTRIBUTES
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_prim_attr_b.ada
-- level: all levels

with GKS_OPERATING_STATE_LIST;
with GKS_ERRORS;
with GKS_STATE_LIST;

use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body INQ_PRIMITIVE_ATTRIBUTES is

-- This is the package body for inquiring the primitive
-- attribute values.
--
-- Each of the procedures in this package inquires the
-- GKS_OPERATING_STATE_LIST to check if GKS is in one
-- of the states GKOP, WSOP, WSAC, or SGOP.  If it is not,
-- error indicator 8 occurs but no exception is raised.

   procedure INQ_CHAR_HEIGHT
      (EI    : out ERROR_INDICATOR;
      HEIGHT : out WC.MAGNITUDE) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current character height.  If the inquired infor-
   -- mation is available, the error indicator is returned as 0 and
   -- the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- HEIGHT - This is the nominal height of the capital letter
   --    character.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;  -- Error 8
         HEIGHT := 1.0;
      else
         EI := SUCCESSFUL;               -- Error 0
         HEIGHT := GKS_STATE_LIST.CURRENT_CHAR_HEIGHT;
      end if;

   end INQ_CHAR_HEIGHT;

   procedure INQ_CHAR_UP_VECTOR
      (EI    : out ERROR_INDICATOR;
      VECTOR : out WC.VECTOR) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current character up vector.  If the inquired
   -- information is available, the error indicator is returned as 0
   -- and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- VECTOR - Indicates the up direction of the character.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         VECTOR := (0.0,0.0);
      else
         EI := SUCCESSFUL;              -- Error 0
         VECTOR := GKS_STATE_LIST.CURRENT_CHAR_UP_VECTOR;
      end if;

   end INQ_CHAR_UP_VECTOR;

   procedure INQ_TEXT_PATH
      (EI  : out ERROR_INDICATOR;
      PATH : out TEXT_PATH) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current text path.  If the inquired information
   -- is available, the error indicator is returned as 0 and the
   -- value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- PATH - Indicates the direction taken by the text string.  It may
   --    be RIGHT, LEFT, UP, or DOWN.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         PATH := TEXT_PATH'FIRST;
      else
         EI := SUCCESSFUL;              -- Error 0
         PATH := GKS_STATE_LIST.CURRENT_TEXT_PATH;
      end if;

   end INQ_TEXT_PATH;

   procedure INQ_TEXT_ALIGNMENT
      (EI       : out ERROR_INDICATOR;
      ALIGNMENT : out TEXT_ALIGNMENT) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current text alignment.  If the inquired infor-
   -- mation is available, the error indicator is returned as 0 and
   -- the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- ALIGNMENT - Indicates the positioning of the text extent
   --    rectangle in relation to the text position. It is a
   --    record with a HORIZONTAL component and a VERTICAL
   --    component.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         ALIGNMENT := (NORMAL,NORMAL);
      else
         EI := SUCCESSFUL;              -- Error 0
         ALIGNMENT := GKS_STATE_LIST.CURRENT_TEXT_ALIGNMENT;
      end if;

   end INQ_TEXT_ALIGNMENT;

   procedure INQ_PATTERN_REFERENCE_POINT
      (EI             : out ERROR_INDICATOR;
      REFERENCE_POINT : out WC.POINT) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current pattern reference point.  If the inquired
   -- information is available, the error indicator is returned as 0
   -- and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- REFERENCE_POINT - This is the world coordinate point giving the
   --    position for the start of the pattern.  It is a record type
   --    with X and Y components.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         REFERENCE_POINT := (0.0,0.0);
      else
         EI := SUCCESSFUL;              -- Error 0
         REFERENCE_POINT := GKS_STATE_LIST.
                            CURRENT_PATTERN_REFERENCE_POINT;
      end if;

   end INQ_PATTERN_REFERENCE_POINT;

   procedure INQ_PATTERN_HEIGHT_VECTOR
      (EI : out ERROR_INDICATOR;
      VECTOR : out WC.VECTOR) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current pattern height vector.  If the inquired
   -- information is available, the error indicator is returned as 0
   -- and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- VECTOR - Indicates the pattern height vector.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         VECTOR := (0.0,0.0);
      else
         EI := SUCCESSFUL;              -- Error 0
         VECTOR := GKS_STATE_LIST.CURRENT_PATTERN_HEIGHT_VECTOR;
      end if;

   end INQ_PATTERN_HEIGHT_VECTOR;

   procedure INQ_PATTERN_WIDTH_VECTOR
      (EI   : out ERROR_INDICATOR;
      WIDTH : out WC.VECTOR) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current pattern width vector.  If the inquired
   -- information is available, the error indicator is returned as 0
   -- and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- WIDTH - This is a vector in world coordinates describing the
   --    pattern width.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         WIDTH := (0.0,0.0);
      else
         EI := SUCCESSFUL;              -- Error 0
         WIDTH := GKS_STATE_LIST.CURRENT_PATTERN_WIDTH_VECTOR;
      end if;

   end INQ_PATTERN_WIDTH_VECTOR;

   procedure INQ_CHAR_WIDTH
      (EI   : out ERROR_INDICATOR;
      WIDTH : out WC.MAGNITUDE) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current character nominal width.  If the inquired
   -- information is available, the error indicator is returned as 0
   -- and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- WIDTH - Indicates the nominal width of characters.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         WIDTH := 1.0;
      else
         EI := SUCCESSFUL;              -- Error 0
         WIDTH := GKS_STATE_LIST.CURRENT_CHAR_WIDTH;
      end if;

   end INQ_CHAR_WIDTH;

   procedure INQ_CHAR_BASE_VECTOR
      (EI    : out ERROR_INDICATOR;
      VECTOR : out WC.VECTOR) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current character base vector.  If the inquired
   -- information is available, the error indicator is returned as 0
   -- and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- VECTOR - Indicates the character base vector in world coordinates.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         VECTOR := (0.0,0.0);
      else
         EI := SUCCESSFUL;              -- Error 0
         VECTOR := GKS_STATE_LIST.CURRENT_CHAR_BASE_VECTOR;
      end if;

   end INQ_CHAR_BASE_VECTOR;

   procedure INQ_CURRENT_PRIMITIVE_ATTRIBUTE_VALUES
      (EI        : out ERROR_INDICATOR;
      ATTRIBUTES : out PRIMITIVE_ATTRIBUTE_VALUES) is

   -- This procedure returns the primitive attributes in a single
   -- record rather than calling several procedures.
   -- The values returned by the procedure include:
   --    the current polyline index
   --    the current polymarker index
   --    the current text index
   --    the current character height
   --    the current character up vector
   --    the current character width
   --    the current character base vector
   --    the current text path
   --    the current text alignment
   --    the current fill area index
   --    the current pattern width vector
   --    the current pattern height vector
   --    the current pattern reference point
   -- which are contained in the record PRIMITIVE_ATTRIBUTES.
   -- If the inquired information is available, the error indicator
   -- is returned as 0 and the value is returned.
   --
   -- ATTRIBUTES - This record contains the values for the current
   --    primitive attributes and the bundle indices as described
   --    above.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;  -- Error 8
         ATTRIBUTES.CURRENT_POLYLINE_INDEX    := POLYLINE_INDEX'FIRST;
         ATTRIBUTES.CURRENT_POLYMARKER_INDEX  := POLYMARKER_INDEX'FIRST;
         ATTRIBUTES.CURRENT_TEXT_INDEX        := TEXT_INDEX'FIRST;
         ATTRIBUTES.CURRENT_CHAR_HEIGHT       := 0.0;
         ATTRIBUTES.CURRENT_CHAR_UP_VECTOR    := (0.0,0.0);
         ATTRIBUTES.CURRENT_CHAR_WIDTH        := 0.0;
         ATTRIBUTES.CURRENT_CHAR_BASE_VECTOR  := (0.0,0.0);
         ATTRIBUTES.CURRENT_TEXT_PATH         := TEXT_PATH'FIRST;
         ATTRIBUTES.CURRENT_TEXT_ALIGNMENT    := (NORMAL,NORMAL);
         ATTRIBUTES.CURRENT_FILL_AREA_INDEX   := FILL_AREA_INDEX'FIRST;
         ATTRIBUTES.CURRENT_PATTERN_WIDTH_VECTOR    := (0.0,0.0);
         ATTRIBUTES.CURRENT_PATTERN_HEIGHT_VECTOR   := (0.0,0.0);
         ATTRIBUTES.CURRENT_PATTERN_REFERENCE_POINT := (0.0,0.0);
      else
         EI := SUCCESSFUL;               -- Error 0
         ATTRIBUTES.CURRENT_POLYLINE_INDEX := GKS_STATE_LIST.
                                          CURRENT_POLYLINE_INDEX;
         ATTRIBUTES.CURRENT_POLYMARKER_INDEX := GKS_STATE_LIST.
                                          CURRENT_POLYMARKER_INDEX;
         ATTRIBUTES.CURRENT_TEXT_INDEX := GKS_STATE_LIST.
                                          CURRENT_TEXT_INDEX;
         ATTRIBUTES.CURRENT_CHAR_HEIGHT := GKS_STATE_LIST.
                                          CURRENT_CHAR_HEIGHT;
         ATTRIBUTES.CURRENT_CHAR_UP_VECTOR := GKS_STATE_LIST.
                                          CURRENT_CHAR_UP_VECTOR;
         ATTRIBUTES.CURRENT_CHAR_WIDTH := GKS_STATE_LIST.
                                          CURRENT_CHAR_WIDTH;
         ATTRIBUTES.CURRENT_CHAR_BASE_VECTOR := GKS_STATE_LIST.
                                          CURRENT_CHAR_BASE_VECTOR;
         ATTRIBUTES.CURRENT_TEXT_PATH := GKS_STATE_LIST.
                                          CURRENT_TEXT_PATH;
         ATTRIBUTES.CURRENT_TEXT_ALIGNMENT := GKS_STATE_LIST.
                                          CURRENT_TEXT_ALIGNMENT;
         ATTRIBUTES.CURRENT_FILL_AREA_INDEX := GKS_STATE_LIST.
                                          CURRENT_FILL_AREA_INDEX;
         ATTRIBUTES.CURRENT_PATTERN_WIDTH_VECTOR := GKS_STATE_LIST.
                                          CURRENT_PATTERN_WIDTH_VECTOR;
         ATTRIBUTES.CURRENT_PATTERN_HEIGHT_VECTOR := GKS_STATE_LIST.
                                          CURRENT_PATTERN_HEIGHT_VECTOR;
         ATTRIBUTES.CURRENT_PATTERN_REFERENCE_POINT := GKS_STATE_LIST.
                                          CURRENT_PATTERN_REFERENCE_POINT;

      end if;

   end INQ_CURRENT_PRIMITIVE_ATTRIBUTE_VALUES;

end INQ_PRIMITIVE_ATTRIBUTES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:INQ_BUNDLE_IDX_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_BUNDLE_INDICES - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_bundle_idx_b.ada
-- level: all levels

with GKS_OPERATING_STATE_LIST;
with GKS_ERRORS;
with GKS_STATE_LIST;

use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body INQ_BUNDLE_INDICES is

-- This is the package body for the procedures to inquire the
-- bundled primitive attributes.
--
-- Each of the procedures in this package inquires the
-- GKS_OPERATING_STATE_LIST to check if GKS is in one
-- of the states GKOP, WSOP, WSAC, or SGOP.  If it is not,
-- error indicator 8 occurs but no exception is raised.

   procedure INQ_POLYLINE_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out POLYLINE_INDEX) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current polyline index.  If the inquired infor-
   -- mation is available, the error indicator is returned as 0 and
   -- the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- INDEX - This is an integer index into a polyline bundle table,
   --    each entry of which contains all the non-geometric aspects
   --    of the polyline.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;  -- Error 8
         INDEX := POLYLINE_INDEX'FIRST;
      else
         EI := SUCCESSFUL;               -- Error 0
         INDEX := GKS_STATE_LIST.CURRENT_POLYLINE_INDEX;
      end if;

   end INQ_POLYLINE_INDEX;

   procedure INQ_POLYMARKER_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out POLYMARKER_INDEX) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current polymarker index.  If the inquired infor-
   -- mation is available, the error indicator is returned as 0 and
   -- the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- INDEX - This is an integer index into a polymarker bundle table,
   --    each entry of which contains all the non-geometric aspects
   --    of the polymarker.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;  -- Error 8
         INDEX := POLYMARKER_INDEX'FIRST;
      else
         EI := SUCCESSFUL;               -- Error 0
         INDEX := GKS_STATE_LIST.CURRENT_POLYMARKER_INDEX;
      end if;

   end INQ_POLYMARKER_INDEX;

   procedure INQ_FILL_AREA_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out FILL_AREA_INDEX) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current fill area index.  If the inquired infor-
   -- mation is available, the error indicator is returned as 0 and
   -- the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- INDEX - This is an integer index into a fill area bundle table,
   --    each entry of which contains all the non-geometric aspects
   --    of the fill area primitive.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;  -- Error 8
         INDEX := FILL_AREA_INDEX'FIRST;
      else
         EI := SUCCESSFUL;               -- Error 0
         INDEX := GKS_STATE_LIST.CURRENT_FILL_AREA_INDEX;
      end if;

   end INQ_FILL_AREA_INDEX;

   procedure INQ_TEXT_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out TEXT_INDEX) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current text index.  If the inquired infor-
   -- mation is available, the error indicator is returned as 0 and
   -- the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- INDEX - This is an integer index into a text bundle table,
   --    each entry of which contains all the non-geometric aspects
   --    of the text primitive.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;  -- Error 8
         INDEX := TEXT_INDEX'FIRST;
      else
         EI := SUCCESSFUL;               -- Error 0
         INDEX := GKS_STATE_LIST.CURRENT_TEXT_INDEX;
      end if;

   end INQ_TEXT_INDEX;

end INQ_BUNDLE_INDICES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:INQ_INDV_ATTR_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_INDIVIDUAL_ATTRIBUTES
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_indv_attr_b.ada
-- level: all levels

with GKS_OPERATING_STATE_LIST;
with GKS_ERRORS;
with GKS_STATE_LIST;

use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body INQ_INDIVIDUAL_ATTRIBUTES is

-- This is the package body for inquiring the current
-- individual attributes.
--
-- Each of the procedures in this package inquires the
-- GKS_OPERATING_STATE_LIST to check if GKS is in one
-- of the states GKOP, WSOP, WSAC, or SGOP.  If it is not,
-- error indicator 8 occurs but no exception is raised.

   procedure INQ_LINETYPE
      (EI  : out ERROR_INDICATOR;
      LINE : out LINETYPE) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current line type.  If the inquired information
   -- is available, the error indicator is returned as 0 and the
   -- value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- LINE - This is an integer value representing the type of line
   --    style that is currently selected.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         LINE := LINETYPE'FIRST;
      else
         EI := SUCCESSFUL;               -- Error 0
         LINE := GKS_STATE_LIST.CURRENT_LINETYPE;
      end if;

   end INQ_LINETYPE;

   procedure INQ_LINEWIDTH_SCALE_FACTOR
      (EI   : out ERROR_INDICATOR;
      WIDTH : out LINE_WIDTH) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current linewidth scale factor.  If the inquired
   -- information is available, the error indicator is returned as 0
   -- and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- WIDTH - This is an floating point scale factor value that
   --    represents the width of a line.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         WIDTH := LINE_WIDTH'FIRST;
      else
         EI := SUCCESSFUL;              -- Error 0
         WIDTH := GKS_STATE_LIST.CURRENT_LINEWIDTH_SCALE_FACTOR;
      end if;

   end INQ_LINEWIDTH_SCALE_FACTOR;

   procedure INQ_POLYLINE_COLOUR_INDEX
      (EI    : out ERROR_INDICATOR;
      COLOUR : out COLOUR_INDEX) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current polyline colour index.  If the inquired
   -- information is available, the error indicator is returned as 0
   -- and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- COLOUR - This is an integer value indicating the colour that
   --    is currently selected for polyline primitives.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         COLOUR := COLOUR_INDEX'FIRST;
      else
         EI := SUCCESSFUL;              -- Error 0
         COLOUR := GKS_STATE_LIST.CURRENT_POLYLINE_COLOUR_INDEX;
      end if;

   end INQ_POLYLINE_COLOUR_INDEX;

   procedure INQ_POLYMARKER_TYPE
      (EI    : out ERROR_INDICATOR;
      MARKER : out MARKER_TYPE) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current polymarker type.  If the inquired infor-
   -- mation is available, the error indicator is returned as 0 and
   -- the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- MARKER - This is an integer value representing the type of
   --    polymarker that is currently selected.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;  -- Error 8
         MARKER := MARKER_TYPE'FIRST;
      else
         EI := SUCCESSFUL;                -- Error 0
         MARKER := GKS_STATE_LIST.CURRENT_MARKER_TYPE;
      end if;

   end INQ_POLYMARKER_TYPE;

   procedure INQ_POLYMARKER_SIZE_SCALE_FACTOR
      (EI  : out ERROR_INDICATOR;
      SIZE : out MARKER_SIZE) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current polymarker size scale factor.  If the
   -- inquired information is available, the error indicator is
   -- returned as 0 and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- SIZE - This is a positive scale factor value indicating the
   --    relative size of the polymarker.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;  -- Error 8
         SIZE := MARKER_SIZE'FIRST;
      else
         EI := SUCCESSFUL;               -- Error 0
         SIZE := GKS_STATE_LIST.CURRENT_MARKER_SIZE_SCALE_FACTOR;
      end if;

   end INQ_POLYMARKER_SIZE_SCALE_FACTOR;

   procedure INQ_POLYMARKER_COLOUR_INDEX
      (EI    : out ERROR_INDICATOR;
      COLOUR : out COLOUR_INDEX) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current polymarker colour index.  If the
   -- inquired information is available, the error indicator is
   -- returned as 0 and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- COLOUR - This is an integer value indicating the colour that
   --    is currently selected for polymarker primitives.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;  -- Error 8
         COLOUR := COLOUR_INDEX'FIRST;
      else
         EI := SUCCESSFUL;               -- Error 0
         COLOUR := GKS_STATE_LIST.CURRENT_POLYMARKER_COLOUR_INDEX;
      end if;

   end INQ_POLYMARKER_COLOUR_INDEX;

   procedure INQ_TEXT_FONT_AND_PRECISION
      (EI            : out ERROR_INDICATOR;
      FONT_PRECISION : out TEXT_FONT_PRECISION) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current text font and precision.  If the
   -- inquired information is available, the error indicator is
   -- returned as 0 and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- FONT_PRECISION - This is a record describing the text font
   --    and precision.  The FONT component is an integer value
   --    representing the font selected.  The PRECISION component
   --    may be of the value STRING_PRECISION, CHAR_PRECISION, or
   --    STROKE_PRECISION.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         FONT_PRECISION := (0,STRING_PRECISION);
      else
         EI := SUCCESSFUL;              -- Error 0
         FONT_PRECISION := GKS_STATE_LIST.
                           CURRENT_TEXT_FONT_AND_PRECISION;
      end if;

   end INQ_TEXT_FONT_AND_PRECISION;

   procedure INQ_CHAR_EXPANSION_FACTOR
      (EI       : out ERROR_INDICATOR;
      EXPANSION : out CHAR_EXPANSION) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current character expansion factor.  If the
   -- inquired information is available, the error indicator is
   -- returned as 0 and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- EXPANSION - This is a positive scale factor value that indicates
   --    the character expansion.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         EXPANSION := CHAR_EXPANSION'FIRST;
      else
         EI := SUCCESSFUL;              -- Error 0
         EXPANSION := GKS_STATE_LIST.CURRENT_CHAR_EXPANSION_FACTOR;
      end if;

   end INQ_CHAR_EXPANSION_FACTOR;

   procedure INQ_CHAR_SPACING
      (EI     : out ERROR_INDICATOR;
      SPACING : out CHAR_SPACING) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current character spacing.  If the inquired
   -- information is available, the error indicator is returned
   -- as 0 and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- SPACING - This is a scale factor value representing the
   --    character spacing.  A positive value indicates the amount
   --    of space between characters.  A negative value indicates
   --    the amount of overlap between characters.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         SPACING := 1.0;
      else
         EI := SUCCESSFUL;              -- Error 0
         SPACING := GKS_STATE_LIST.CURRENT_CHAR_SPACING;
      end if;

   end INQ_CHAR_SPACING;

   procedure INQ_TEXT_COLOUR_INDEX
      (EI    : out ERROR_INDICATOR;
      COLOUR : out COLOUR_INDEX) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current text colour index.  If the inquired
   -- information is available, the error indicator is returned
   -- as 0 and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- COLOUR - This is an integer value indicating the colour that
   --    is currently selected for text primitives.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         COLOUR := COLOUR_INDEX'FIRST;
      else
         EI := SUCCESSFUL;              -- Error 0
         COLOUR := GKS_STATE_LIST.CURRENT_TEXT_COLOUR_INDEX;
      end if;

   end INQ_TEXT_COLOUR_INDEX;

   procedure INQ_FILL_AREA_INTERIOR_STYLE
      (EI   : out ERROR_INDICATOR;
      STYLE : out INTERIOR_STYLE) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current fill area interior style.  If the inquired
   -- information is available, the error indicator is returned
   -- as 0 and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- STYLE - This enumerated type indicates whether the current fill
   --    area interior style is HOLLOW, SOLID, PATTERN, or HATCH.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         STYLE := INTERIOR_STYLE'FIRST;
      else
         EI := SUCCESSFUL;              -- Error 0
         STYLE := GKS_STATE_LIST.CURRENT_FILL_AREA_INTERIOR_STYLE;
      end if;

   end INQ_FILL_AREA_INTERIOR_STYLE;

   procedure INQ_FILL_AREA_STYLE_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out STYLE_INDEX) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current fill area style index.  If the inquired
   -- information is available, the error indicator is returned
   -- as 0 and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- INDEX - This is a variant record defining the fill area style
   --    index.  If the discriminant is HOLLOW or SOLID, the record
   --    has a null component.  If it is PATTERN, the component is
   --    a PATTERN_INDEX.  If it is HATCH, the record component is
   --    a HATCH_STYLE_TYPE.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;  -- Error 8
         INDEX := STYLE_INDEX'FIRST;
      else
         EI := SUCCESSFUL;               -- Error 0
         INDEX := GKS_STATE_LIST.CURRENT_FILL_AREA_STYLE_INDEX;
      end if;

   end INQ_FILL_AREA_STYLE_INDEX;

   procedure INQ_FILL_AREA_COLOUR_INDEX
      (EI    : out ERROR_INDICATOR;
      COLOUR : out COLOUR_INDEX) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current fill area colour index.  If the inquired
   -- information is available, the error indicator is returned
   -- as 0 and the value is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- COLOUR - This is an integer value indicating the colour that
   --    is currently selected for fill area primitives.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;  -- Error 8
         COLOUR := COLOUR_INDEX'FIRST;
      else
         EI := SUCCESSFUL;               -- Error 0
         COLOUR := GKS_STATE_LIST.CURRENT_FILL_AREA_COLOUR_INDEX;
      end if;

   end INQ_FILL_AREA_COLOUR_INDEX;

   procedure INQ_LIST_OF_ASF
      (EI    : out ERROR_INDICATOR;
      LIST : out ASF_LIST) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- value of the current list of aspect source flags.  If the
   -- inquired information is available, the error indicator is
   -- returned as 0 and the values are returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- LIST - This is a record listing all of the aspect source flags.
   --    Each component may have a value of INDIVIDUAL or BUNDLED.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;  -- Error 8
         LIST := (OTHERS => INDIVIDUAL);
      else
         EI := SUCCESSFUL;               -- Error 0
         LIST := GKS_STATE_LIST.CURRENT_ASPECT_SOURCE_FLAGS;
      end if;

   end INQ_LIST_OF_ASF;

   procedure INQ_CURRENT_INDIVIDUAL_ATTRIBUTE_VALUES
      (EI         : out ERROR_INDICATOR;
      ATTRIBUTES  : out INDIVIDUAL_ATTRIBUTE_VALUES) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the
   -- values of:
   --    the current line type
   --    the current linewidth scale factor
   --    the current polyline colour index
   --    the current polymarker type
   --    the current polymarker size scale factor
   --    the current polymarker colour index
   --    the current text font and precision
   --    the current character expansion factor
   --    the current character spacing
   --    the current text colour index
   --    the current fill area interior style
   --    the current fill area style index
   --    the current fill area colour index
   --    the current list of aspect source flags
   -- in a single call.  These values are components of the record
   -- ATTRIBUTES.  If the inquired information is available, the error
   -- indicator is returned as 0 and the value is returned.
   --
   -- ATTRIBUTES - This is a record type with all of the current
   --    individual attributes as described above.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         ATTRIBUTES.CURRENT_LINETYPE          := LINETYPE'FIRST;
         ATTRIBUTES.CURRENT_LINE_WIDTH        := LINE_WIDTH'FIRST;
         ATTRIBUTES.CURRENT_POLYLINE_COLOUR   := COLOUR_INDEX'FIRST;
         ATTRIBUTES.CURRENT_MARKER_TYPE       := MARKER_TYPE'FIRST;
         ATTRIBUTES.CURRENT_POLYMARKER_SIZE   := MARKER_SIZE'FIRST;
         ATTRIBUTES.CURRENT_POLYMARKER_COLOUR := COLOUR_INDEX'FIRST;
         ATTRIBUTES.CURRENT_FONT_PRECISION    := (0,STRING_PRECISION);
         ATTRIBUTES.CURRENT_CHAR_EXPANSION    := CHAR_EXPANSION'FIRST;
         ATTRIBUTES.CURRENT_CHAR_SPACING      := CHAR_SPACING'FIRST;
         ATTRIBUTES.CURRENT_TEXT_COLOUR       := COLOUR_INDEX'FIRST;
         ATTRIBUTES.CURRENT_INTERIOR_STYLE    := INTERIOR_STYLE'FIRST;
         ATTRIBUTES.CURRENT_STYLE_INDEX       := STYLE_INDEX'FIRST;
         ATTRIBUTES.CURRENT_FILL_AREA_COLOUR  := COLOUR_INDEX'FIRST;
         ATTRIBUTES.CURRENT_ASF_LIST          := (OTHERS => INDIVIDUAL);
      else
         EI := SUCCESSFUL;     -- Error 0
         ATTRIBUTES.CURRENT_LINETYPE := GKS_STATE_LIST.CURRENT_LINETYPE;
         ATTRIBUTES.CURRENT_LINE_WIDTH := GKS_STATE_LIST.
                                      CURRENT_LINEWIDTH_SCALE_FACTOR;
         ATTRIBUTES.CURRENT_POLYLINE_COLOUR := GKS_STATE_LIST.
                                      CURRENT_POLYLINE_COLOUR_INDEX;
         ATTRIBUTES.CURRENT_MARKER_TYPE := GKS_STATE_LIST.
                                      CURRENT_MARKER_TYPE;
         ATTRIBUTES.CURRENT_POLYMARKER_SIZE := GKS_STATE_LIST.
                                       CURRENT_MARKER_SIZE_SCALE_FACTOR;
         ATTRIBUTES.CURRENT_POLYMARKER_COLOUR := GKS_STATE_LIST.
                                       CURRENT_POLYMARKER_COLOUR_INDEX;
         ATTRIBUTES.CURRENT_FONT_PRECISION := GKS_STATE_LIST.
                                       CURRENT_TEXT_FONT_AND_PRECISION;
         ATTRIBUTES.CURRENT_CHAR_EXPANSION := GKS_STATE_LIST.
                                       CURRENT_CHAR_EXPANSION_FACTOR;
         ATTRIBUTES.CURRENT_CHAR_SPACING := GKS_STATE_LIST.
                                       CURRENT_CHAR_SPACING;
         ATTRIBUTES.CURRENT_TEXT_COLOUR := GKS_STATE_LIST.
                                       CURRENT_TEXT_COLOUR_INDEX;
         ATTRIBUTES.CURRENT_INTERIOR_STYLE := GKS_STATE_LIST.
                                       CURRENT_FILL_AREA_INTERIOR_STYLE;
         ATTRIBUTES.CURRENT_STYLE_INDEX := GKS_STATE_LIST.
                                       CURRENT_FILL_AREA_STYLE_INDEX;
         ATTRIBUTES.CURRENT_FILL_AREA_COLOUR := GKS_STATE_LIST.
                                       CURRENT_FILL_AREA_COLOUR_INDEX;
         ATTRIBUTES.CURRENT_ASF_LIST := GKS_STATE_LIST.
                                        CURRENT_ASPECT_SOURCE_FLAGS;

      end if;

   end INQ_CURRENT_INDIVIDUAL_ATTRIBUTE_VALUES;

end INQ_INDIVIDUAL_ATTRIBUTES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_NORM_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_NORMALIZATION - BODY
--  IDENTIFIER: GIMXXX.1(3)
--  DISCREPANCY REPORTS:
--  DR033  Check for = in determining rectangle validity.
------------------------------------------------------------------
-- file:  gks_norm_b.ada
-- level: ma

with CGI;
with WSM;
with ERROR_ROUTINES;
with GKS_OPERATING_STATE_LIST;
with GKS_STATE_LIST;
with GKS_ERRORS;
with TRANSLATION_FACTORS;
with SET_PRIMITIVE_ATTRIBUTES_MA;

use CGI;
use WSM;
use ERROR_ROUTINES;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body GKS_NORMALIZATION is

-- This is the package body for the normalization transformation
-- procedures for GKS.
--
-- Each of the procedures in this package inquires the
-- GKS_OPERATING_STATE_LIST to check if GKS is in one
-- of the states GKOP, WSOP, WSAC, or SGOP.  If it is not,
-- error 8 occurs and the procedure raises the exception
-- STATE_ERROR.
--
-- If an error indicator above 0 occurs, these procedures call
-- the ERROR_LOGGING procedure of the package ERROR_ROUTINES
-- to log the error indicator and the name of the procedure
-- in the error file specified when the procedure OPEN_GKS
-- was called to begin this session of GKS operation.

   procedure SET_WINDOW
      (TRANSFORMATION : in TRANSFORMATION_NUMBER;
      WINDOW_LIMITS   : in WC.RECTANGLE_LIMITS) is

   -- This procedure checks to see if the transformation number is
   -- greater or equal to 1.  If it is not, error 50 occurs and the
   -- exception TRANSFORMATION_ERROR is raised.  Then, this
   -- procedure checks the value of the window limits passed
   -- in to see if they are valid.  If not, error 51 occurs and the
   -- exception TRANSFORMATION_ERROR is raised.  Otherwise, the
   -- procedure sets the value of the window limits entry for the
   -- specified transformation number in the GKS_STATE_LIST.
   --
   -- TRANSFORMATION - This is an integer value representing a
   --    normalization transformation.
   -- WINDOW_LIMITS - This record defines the extent of the
   --    window RECTANGLE_LIMITS in world coordinates. Its X and Y
   --    components give the limits in relation to the x and y
   --    axes.

   begin

      -- The following if structure inquires the GKS_OPERATING_
      -- STATE_LIST to see if GKS is in the proper state and if
      -- the window limits requested are valid before proceeding
      -- with the set to the GKS_STATE_LIST.

      if CURRENT_OPERATING_STATE = GKCL then
         ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP,"SET_WINDOW");-- Error 8
         raise STATE_ERROR;

      elsif TRANSFORMATION < 1 then
         ERROR_LOGGING (INVALID_XFORM_NUMBER,"SET_WINDOW");  -- Error 50
         raise TRANSFORMATION_ERROR;

      elsif (WINDOW_LIMITS.XMIN >= WINDOW_LIMITS.XMAX) or
            (WINDOW_LIMITS.YMIN >= WINDOW_LIMITS.YMAX) then
         ERROR_LOGGING (INVALID_RECTANGLE, "SET_WINDOW");    -- Error 51
         raise TRANSFORMATION_ERROR;

      else
         GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (TRANSFORMATION).WINDOW := WINDOW_LIMITS;

         GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (TRANSFORMATION).NDC_FACTORS := TRANSLATION_FACTORS.
            GET_NORMALIZATION_FACTORS(WINDOW_LIMITS,GKS_STATE_LIST.
            LIST_OF_NORMALIZATION_TRANSFORMATIONS(TRANSFORMATION).
            VIEWPORT);

         GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (TRANSFORMATION).WC_FACTORS := TRANSLATION_FACTORS.
            GET_NORMALIZATION_FACTORS(GKS_STATE_LIST.
            LIST_OF_NORMALIZATION_TRANSFORMATIONS(TRANSFORMATION).
            VIEWPORT,WINDOW_LIMITS);
      end if;

   -- The following procedure calls ensure that the primitive
   -- attributes that are affected by the new window are reset.
   SET_PRIMITIVE_ATTRIBUTES_MA.SET_CHAR_HEIGHT(GKS_STATE_LIST.
      CURRENT_CHAR_HEIGHT);

   SET_PRIMITIVE_ATTRIBUTES_MA.SET_CHAR_UP_VECTOR(GKS_STATE_LIST.
      CURRENT_CHAR_UP_VECTOR);

   exception
      when STATE_ERROR =>
         raise;
      when TRANSFORMATION_ERROR =>
         raise;
      when OTHERS =>
         ERROR_LOGGING (UNKNOWN, "SET_WINDOW");             -- Error 2501
         raise;

   end SET_WINDOW;

   procedure SET_VIEWPORT
      (TRANSFORMATION : in TRANSFORMATION_NUMBER;
      VIEWPORT_LIMITS : in NDC.RECTANGLE_LIMITS) is

   -- If the transformation number is less than 1, error 50
   -- occurs, and the exception TRANSFORMATION_ERROR is raised.
   -- Then, this procedure checks if the rectangle definition of
   -- the viewport limits passed in is valid.  If it is not,
   -- error 51 occurs and the procedure raises the exception
   -- TRANSFORMATION_ERROR.  If the rectangle is not with in NDC
   -- unit square, error 52 occurs and the exception TRANSFORMATION_
   -- ERROR is raised.
   --
   -- The viewport limits entry of the specified normalization
   -- transformation in the GKS_STATE_LIST is set to the value
   -- passed in.
   --
   -- This procedure also passes the information to the WS_MANAGER
   -- so that it will have access to the new viewport specification.
   --
   -- TRANSFORMATION - This is an integer value representing a
   --    normalization transformation.
   -- VEIWPORT_LIMITS - This record defines the extent of the
   --    viewport rectangle in normalized device coordinates.
   --    Its X and Y components give the limits in relation to
   --    the x and y axes.

   GKS_INSTR : CGI_SET_CLIPPING_RECTANGLE;

   begin

      -- The following if structure inquires the GKS_OPERATING_
      -- STATE_LIST to see if GKS is in the proper state.  It then
      -- checks the TRANSFORMATION parameter to ensure that it is
      -- not less than 1.  Then it checks the validity of the VIEW-
      -- PORT_LIMITS passed in.  This is done by checking the
      -- rectangle values and by checking to see if the viewport
      -- is in the NDC unit square.  If all of the checks are
      -- satisfactory, the viewport is set.

      if CURRENT_OPERATING_STATE = GKCL then
         ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP,"SET_VIEWPORT");-- Error 8
         raise STATE_ERROR;

      elsif TRANSFORMATION < 1 then
         ERROR_LOGGING (INVALID_XFORM_NUMBER, "SET_VIEWPORT");-- Error 50
         raise TRANSFORMATION_ERROR;

      elsif (VIEWPORT_LIMITS.XMIN >= VIEWPORT_LIMITS.XMAX) or
            (VIEWPORT_LIMITS.YMIN >= VIEWPORT_LIMITS.YMAX) then
         ERROR_LOGGING (INVALID_RECTANGLE, "SET_VIEWPORT");   -- Error 51
         raise TRANSFORMATION_ERROR;

      elsif (VIEWPORT_LIMITS.XMIN < 0.0) or
            (VIEWPORT_LIMITS.XMAX > 1.0) or
            (VIEWPORT_LIMITS.YMIN < 0.0) or
            (VIEWPORT_LIMITS.YMAX > 1.0) then
         ERROR_LOGGING (VIEWPORT_NOT_IN_NDC_UNIT_SQR,
                        "SET_VIEWPORT");                  -- Error 52
         raise TRANSFORMATION_ERROR;

      else
         if (TRANSFORMATION = GKS_STATE_LIST.
            CURRENT_NORMALIZATION_TRANSFORMATION) and
            (GKS_STATE_LIST.CLIP_INDICATOR = CLIP) then
            GKS_INSTR.CLIPPING_RECTANGLE_SET := VIEWPORT_LIMITS;
            WS_MANAGER (GKS_INSTR);
         end if;

         GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
         (TRANSFORMATION).VIEWPORT := VIEWPORT_LIMITS;

         GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (TRANSFORMATION).NDC_FACTORS := TRANSLATION_FACTORS.
            GET_NORMALIZATION_FACTORS(GKS_STATE_LIST.
            LIST_OF_NORMALIZATION_TRANSFORMATIONS(TRANSFORMATION).
            WINDOW,VIEWPORT_LIMITS);

         GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (TRANSFORMATION).WC_FACTORS := TRANSLATION_FACTORS.
            GET_NORMALIZATION_FACTORS(VIEWPORT_LIMITS,GKS_STATE_LIST.
            LIST_OF_NORMALIZATION_TRANSFORMATIONS(TRANSFORMATION).
            WINDOW);
      end if;

   -- The following procedure calls ensure that the primitive
   -- attributes that are affected by the new viewport are reset.
   SET_PRIMITIVE_ATTRIBUTES_MA.SET_CHAR_HEIGHT(GKS_STATE_LIST.
      CURRENT_CHAR_HEIGHT);

   SET_PRIMITIVE_ATTRIBUTES_MA.SET_CHAR_UP_VECTOR(GKS_STATE_LIST.
      CURRENT_CHAR_UP_VECTOR);

      exception
         when STATE_ERROR =>
            raise;
         when TRANSFORMATION_ERROR =>
            raise;
         when NUMERIC_ERROR =>
            ERROR_LOGGING (ARITHMETIC, "SET_VIEWPORT"); -- Error 308
            raise SYSTEM_ERROR;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN, "SET_VIEWPORT");    -- Error 2501
            raise;

   end SET_VIEWPORT;

   procedure SELECT_NORMALIZATION_TRANSFORMATION
      (TRANSFORMATION : in TRANSFORMATION_NUMBER) is

   -- The current normalization transformation number entry in the
   -- GKS_STATE_LIST is set to the value that was passed in.
   -- Also, if the clipping indicator is on in the GKS_STATE_LIST,
   -- the procedure passes the clipping rectangle (viewport) of the
   -- normalization transformation to the WS_MANAGER.
   --
   -- TRANSFORMATION - This is an integer value representing a
   --    normalization transformation.

   GKS_INSTR : CGI_SET_CLIPPING_RECTANGLE;


   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding
      -- with the set to the GKS_STATE_LIST.

      if CURRENT_OPERATING_STATE = GKCL then
         ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP,
                       "SELECT_NORMALIZATION_TRANSFORMATION"); -- Error 8
         raise STATE_ERROR;

      elsif  (TRANSFORMATION >
         GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS'LAST) then
         ERROR_LOGGING (INVALID_XFORM_NUMBER,
                       "SELECT_NORMALIZATION_TRANFORMATION"); -- Error 50
         raise TRANSFORMATION_ERROR;

      else
         if (TRANSFORMATION /= GKS_STATE_LIST.
            CURRENT_NORMALIZATION_TRANSFORMATION) and
            (GKS_STATE_LIST.CLIP_INDICATOR = CLIP) then
            GKS_INSTR.CLIPPING_RECTANGLE_SET := GKS_STATE_LIST.
              LIST_OF_NORMALIZATION_TRANSFORMATIONS
              (TRANSFORMATION).VIEWPORT;
            WS_MANAGER(GKS_INSTR);
         end if;

         GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION :=
            TRANSFORMATION;

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when TRANSFORMATION_ERROR =>
            raise;
         when NUMERIC_ERROR =>
            ERROR_LOGGING (ARITHMETIC,
                           "SELECT_NORMALIZATION_TRANSFORMATION");
                                                          -- Error 308
            raise SYSTEM_ERROR;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,
                           "SELECT_NORMALIZATION_TRANSFORMATION");
                                                          -- Error 2501
            raise;

   end SELECT_NORMALIZATION_TRANSFORMATION;

   procedure SET_CLIPPING_INDICATOR
      (CLIPPING : in CLIPPING_INDICATOR) is

   -- This procedure sets the clipping indicator in the GKS_STATE_LIST.
   -- If the indicator is turned OFF, the clipping rectangle of
   -- (0.0,1.0,0.0,1.0) is passed to the WS_MANAGER.  If it is turned
   -- ON, the viewport is sent to the WS_MANAGER.
   --
   -- CLIPPING - The value of this enumerated parameter may be CLIP
   --    or NOCLIP.  Its value determines whether or not clipping
   --    will be performed on successive output.

   GKS_INSTR : CGI_SET_CLIPPING_RECTANGLE;


   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding
      -- with the call to the WS_MANAGER.

      if CURRENT_OPERATING_STATE = GKCL then
            ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP,
                           "SET_CLIPPING_INDICATOR");    -- Error 8
            raise STATE_ERROR;
      else

         if GKS_STATE_LIST.CLIP_INDICATOR /= CLIPPING then
            GKS_STATE_LIST.CLIP_INDICATOR := CLIPPING;
         end if;

      -- Call to the WS_MANAGER.

         if CLIPPING = CLIP then
            GKS_INSTR.CLIPPING_RECTANGLE_SET := GKS_STATE_LIST.
               LIST_OF_NORMALIZATION_TRANSFORMATIONS
               (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION).
               VIEWPORT;
            WS_MANAGER (GKS_INSTR);
         elsif CLIPPING = NOCLIP then
            GKS_INSTR.CLIPPING_RECTANGLE_SET := GKS_STATE_LIST.
               LIST_OF_NORMALIZATION_TRANSFORMATIONS (0).VIEWPORT;
            WS_MANAGER (GKS_INSTR);
         end if;

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when NUMERIC_ERROR =>
            ERROR_LOGGING (ARITHMETIC,"SET_CLIPPING_INDICATOR");
            raise SYSTEM_ERROR;                           -- Error 308
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,"SET_CLIPPING_INDICATOR");-- Error 2501
            raise;

   end SET_CLIPPING_INDICATOR;

end GKS_NORMALIZATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WS_XFORM_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WS_TRANSFORMATION - BODY
--  IDENTIFIER: GIMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR033  Check for = in determining rectangle validity.
------------------------------------------------------------------
-- file:  ws_xform_b.ada
-- level: all levels

with WSM;
with CGI;
with ERROR_ROUTINES;
with GKS_OPERATING_STATE_LIST;
with GKS_STATE_LIST;
with GKS_ERRORS;

use WSM;
use CGI;
use ERROR_ROUTINES;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body WS_TRANSFORMATION is

-- This is the package body for the workstation normalization
-- transformation procedures.
--
-- Each of the procedures in this package inquires the
-- GKS_OPERATING_STATE_LIST to check if GKS is in one
-- of the states WSOP, WSAC, or SGOP.  If it is not, error
-- 7 occurs and the procedure raises the exception STATE_ERROR.
-- In addition, each procedure inquires the GKS_STATE_LIST to see
-- if the WS is in the set of open workstations before calling the
-- WS_MANAGER.  If it is not, error 25 occurs and the exception
-- WS_ERROR is raised.  A check is also made on the rectangle
-- limits to see if the rectangle is valid.  If not, error 51
-- occurs and the procedure raises the exception TRANSFORMATION_
-- ERROR.
--
-- If an error indicator above 0 occurs, these procedures call
-- the ERROR_LOGGING procedure of the package ERROR_ROUTINES
-- to log the error indicator and the name of the procedure
-- in the error file specified when the procedure OPEN_GKS
-- was called to begin this session of GKS operation.

   procedure SET_WS_WINDOW
      (WS              : in WS_ID;
      WS_WINDOW_LIMITS : in NDC.RECTANGLE_LIMITS) is

   -- This procedure calls the workstation manager to set the
   -- value of the requested workstation window entry in the
   -- workstation state list.  If the workstation manager returns
   -- error 33, or 36, this procedure raises  the exception
   -- WS_ERROR.
   --
   -- WS - This is an integer value representing the workstation
   --    identification.
   -- WS_WINDOW_LIMITS - This record defines the extent of the
   --    workstation window rectangle in normalized device coordinates.
   --    Its X and Y components give the limits in relation to the
   --    x and y axes.

   GKS_INSTR : CGI_SET_WS_WINDOW;

   begin

      -- The following if structure inquires the GKS_OPERATING_STATE_
      -- LIST to see if GKS is in the proper state.  It also inquires
      -- the GKS_STATE_LIST to see if the requested window limits are
      -- valid.  Finally, it checks the GKS_STATE_LIST to see if the
      -- workstation is in the set of open workstations before proceed-
      -- ing with the call to the WS_MANAGER.

      if (CURRENT_OPERATING_STATE = GKCL) or
         (CURRENT_OPERATING_STATE = GKOP) then
         ERROR_LOGGING (NOT_WSOP_WSAC_SGOP, "SET_WS_WINDOW"); -- Error 7
         raise STATE_ERROR;

      elsif (WS_WINDOW_LIMITS.XMIN >= WS_WINDOW_LIMITS.XMAX) or
            (WS_WINDOW_LIMITS.YMIN >= WS_WINDOW_LIMITS.YMAX) then
         ERROR_LOGGING (INVALID_RECTANGLE, "SET_WS_WINDOW");  -- Error 51
         raise TRANSFORMATION_ERROR;

      elsif (WS_WINDOW_LIMITS.XMIN < 0.0) or
            (WS_WINDOW_LIMITS.XMAX > 1.0) or
            (WS_WINDOW_LIMITS.YMIN < 0.0) or
            (WS_WINDOW_LIMITS.YMAX > 1.0) then
         ERROR_LOGGING (WS_WINDOW_NOT_IN_NDC_UNIT_SQR,
                        "SET_WS_WINDOW");                    -- Error 53
         raise TRANSFORMATION_ERROR;

      elsif not WS_IDS.IS_IN_LIST(WS,GKS_STATE_LIST.LIST_OF_OPEN_WS) then
         ERROR_LOGGING (WS_NOT_OPEN, "SET_WS_WINDOW");       -- Error 25
         raise WS_ERROR;

      else
         GKS_INSTR.WS_TO_SET_WINDOW := WS;
         GKS_INSTR.WS_WINDOW_LIMITS_SET := WS_WINDOW_LIMITS;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then             -- Error 0
            if (GKS_INSTR.EI = WS_CATEGORY_IS_MI) or    -- Error 33
               (GKS_INSTR.EI = WS_IS_WISS) then         -- Error 36
               ERROR_LOGGING(GKS_INSTR.EI, "SET_WS_WINDOW");
               raise WS_ERROR;
            end if;

         end if;

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when TRANSFORMATION_ERROR =>
            raise;
         when WS_ERROR =>
            raise;
         when NUMERIC_ERROR =>
            ERROR_LOGGING (ARITHMETIC,"SET_WS_WINDOW");   -- Error 308
            raise SYSTEM_ERROR;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN, "SET_WS_WINDOW");     -- Error 2501
            raise;

   end SET_WS_WINDOW;

   procedure SET_WS_VIEWPORT
      (WS                : in WS_ID;
      WS_VIEWPORT_LIMITS : in DC.RECTANGLE_LIMITS) is

   -- This procedure calls the workstation manager to set the value
   -- of the requested workstation viewport in the workstation state
   -- list.  If the workstation manager returns error 33, or 36,
   -- this procedure raises the exception WS_ERROR.  If the workstation
   -- manager returns error 54, this procedure raises the
   -- exception TRANSFORMATION_ERROR.
   --
   -- WS - This is an integer value representing the workstation
   --    identification.
   -- VIEWPORT_LIMITS - This record defines the extent of the
   --    viewport rectangle in device coordinates.  Its X and Y
   --    components give the limits in relation to the x and y axes.

   GKS_INSTR : CGI_SET_WS_VIEWPORT;

   begin

      -- The following if structure inquires the GKS_OPERATING_STATE_
      -- LIST to see if GKS is in the proper state.  It also inquires
      -- the GKS_STATE_LIST to see if the requested window limits are
      -- valid.  Finally, it checks the GKS_STATE_LIST to see if the
      -- workstation is in the set of open workstations before proceed-
      -- ing with the call to the WS_MANAGER.

      if (CURRENT_OPERATING_STATE = GKCL) or
         (CURRENT_OPERATING_STATE = GKOP) then
         ERROR_LOGGING (NOT_WSOP_WSAC_SGOP,
                        "SET_WS_VIEWPORT");             -- Error 7
         raise STATE_ERROR;

      elsif (WS_VIEWPORT_LIMITS.XMIN >= WS_VIEWPORT_LIMITS.XMAX) or
            (WS_VIEWPORT_LIMITS.YMIN >= WS_VIEWPORT_LIMITS.YMAX) then
         ERROR_LOGGING (INVALID_RECTANGLE,
                        "SET_WS_VIEWPORT");                -- Error 51
         raise TRANSFORMATION_ERROR;

      elsif not WS_IDS.IS_IN_LIST(WS,GKS_STATE_LIST.LIST_OF_OPEN_WS) then
         ERROR_LOGGING (WS_NOT_OPEN, "SET_WS_VIEWPORT");    -- Error 25
         raise WS_ERROR;

      else
         GKS_INSTR.WS_TO_SET_VIEWPORT := WS;
         GKS_INSTR.WS_VIEWPORT_LIMITS_SET := WS_VIEWPORT_LIMITS;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then                 -- Error 0
            if (GKS_INSTR.EI = WS_CATEGORY_IS_MI) or        -- Error 33
               (GKS_INSTR.EI = WS_IS_WISS) or               -- Error 36
               (GKS_INSTR.EI = WS_VIEWPORT_NOT_IN_DISPLAY_SPACE) then
                                                            -- Error 54
               ERROR_LOGGING(GKS_INSTR.EI, "SET_WS_VIEWPORT");
               raise WS_ERROR;
            end if;

         end if;

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when WS_ERROR =>
            raise;
         when TRANSFORMATION_ERROR =>
            raise;
         when NUMERIC_ERROR =>
            ERROR_LOGGING (ARITHMETIC,"SET_WS_VIEWPORT");  -- Error 308
            raise SYSTEM_ERROR;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN, "SET_WS_VIEWPORT");  -- Error 2501
            raise;

   end SET_WS_VIEWPORT;

end WS_TRANSFORMATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:INQ_GKS_ST_LST_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_GKS_STATE_LIST_MA - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_gks_st_lst_ma_b.ada
-- level: all levels

with GKS_OPERATING_STATE_LIST;
with GKS_ERRORS;
with GKS_STATE_LIST;

use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body INQ_GKS_STATE_LIST_MA is

-- This is the package body for the procedures to inquire the
-- GKS state list.
--
-- Each of the procedures in this package inquires the
-- GKS_OPERATING_STATE_LIST to check if GKS is in one
-- of the states GKOP, WSOP, WSAC, or SGOP.  If it
-- is not, error indicator 8 occurs but no exception is raised.

   procedure INQ_CURRENT_NORMALIZATION_TRANSFORMATION_NUMBER
      (EI            : out ERROR_INDICATOR;
      TRANSFORMATION : out TRANSFORMATION_NUMBER) is

   -- This procedure inquires the GKS_STATE_LIST for the current
   -- normalization transformation number.  If the inquired infor-
   -- mation is available, the error indicator is returned by this
   -- procedure as 0 and the requested information is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- TRANSFORMATION - This is an integer value representing the current
   --    normalization transformation.

   begin

      -- The following case inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding
      -- with the inquiry of the GKS_STATE_LIST.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;  -- Error 8
         TRANSFORMATION := TRANSFORMATION_NUMBER'FIRST;
      else
         EI := SUCCESSFUL;               -- Error 0
         TRANSFORMATION := GKS_STATE_LIST.
                              CURRENT_NORMALIZATION_TRANSFORMATION;
      end if;

   end INQ_CURRENT_NORMALIZATION_TRANSFORMATION_NUMBER;

   procedure INQ_NORMALIZATION_TRANSFORMATION
      (TRANSFORMATION : in TRANSFORMATION_NUMBER;
      EI              : out ERROR_INDICATOR;
      WINDOW_LIMITS   : out WC.RECTANGLE_LIMITS;
      VIEWPORT_LIMITS : out NDC.RECTANGLE_LIMITS) is

   -- This procedure inquires the GKS_STATE_LIST for the current
   -- normalization transformation.  If the inquired information
   -- is available, the error indicator is returned by this procedure
   -- as 0 and the requested information is returned.
   --
   -- TRANSFORMATION - This is an integer value representing a
   --    normalization transformation.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- WINDOW_LIMITS - This record defines the extent of the
   --    window rectangle in world coordinates. Its X and Y
   --    components give the limits in relation to the x and y
   --    axes.
   -- VIEWPORT_LIMITS - This record defines the extent of the
   --    viewport rectangle in normalized device coordinates.
   --    Its X and Y components give the limits in relation to
   --    the x and y axes.

   begin

      -- The following if structure inquires the GKS_OPERATING_
      -- STATE_LIST to see if GKS is in the proper state and the
      -- transformation number is valid before proceeding with
      -- the inquiry of the GKS_STATE_LIST.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;     -- Error 8
         WINDOW_LIMITS := (0.0,1.0,0.0,1.0);
         VIEWPORT_LIMITS := (0.0,1.0,0.0,1.0);

      elsif TRANSFORMATION < 0 then
         EI := INVALID_XFORM_NUMBER;        -- Error 50
         WINDOW_LIMITS := (0.0,1.0,0.0,1.0);
         VIEWPORT_LIMITS := (0.0,1.0,0.0,1.0);

      else
         EI := SUCCESSFUL;                  -- Error 0
         WINDOW_LIMITS := GKS_STATE_LIST.
            LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (TRANSFORMATION).WINDOW;
         VIEWPORT_LIMITS := GKS_STATE_LIST.
            LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (TRANSFORMATION).VIEWPORT;
      end if;

   end INQ_NORMALIZATION_TRANSFORMATION;

   procedure INQ_CLIPPING
      (EI                : out ERROR_INDICATOR;
      CLIPPING           : out CLIPPING_INDICATOR;
      CLIPPING_RECTANGLE : out NDC.RECTANGLE_LIMITS) is

   -- This procedure inquires the GKS_STATE_LIST to obtain the current
   -- clipping indicator.  If the inquired information is available,
   -- the error indicator is returned to this procedure as 0 and the
   -- requested information is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- CLIPPING - The value of this enumerated parameter may be CLIP
   --    or NOCLIP.  Its value determines whether or not clipping
   --    is being performed on current output.
   -- CLIPPING_RECTANGLE - This record defines the extent of the
   --    clipping area in normalized device coordinates.  The
   --    X and Y components define the limits of the rectangle
   --    along the x and y axes.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP; -- Error 8
         CLIPPING := CLIPPING_INDICATOR'FIRST;
         CLIPPING_RECTANGLE := (0.0,1.0,0.0,1.0);
      else
         EI := SUCCESSFUL;              -- Error 0
         CLIPPING := GKS_STATE_LIST.CLIP_INDICATOR;
         CLIPPING_RECTANGLE := GKS_STATE_LIST.
            LIST_OF_NORMALIZATION_TRANSFORMATIONS(GKS_STATE_LIST.
            CURRENT_NORMALIZATION_TRANSFORMATION).VIEWPORT;
      end if;

   end INQ_CLIPPING;

end INQ_GKS_STATE_LIST_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:INQ_GKS_DSCR_TBL_MAB.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_GKS_DESCRIPTION_TABLE_MA
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_gks_dscr_tbl_mab.ada
-- level: all levels

with GKS_DESCRIPTION_TABLE;
with GKS_OPERATING_STATE_LIST;
with GKS_ERRORS;

use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body INQ_GKS_DESCRIPTION_TABLE_MA is

-- This is the package body for the procedures to inquire the
-- GKS_DESCRIPTION_TABLE.

   procedure INQ_LEVEL_OF_GKS
      (EI   : out ERROR_INDICATOR;
      LEVEL : out GKS_LEVEL) is

   -- This procedure inquires the GKS_OPERATING_STATE_LIST
   -- to see if GKS is in one of the states GKOP, WSOP,
   -- WSAC, or SGOP.  If it is not, error 8 occurs and this
   -- procedure raises the exception STATE_ERROR.  Otherwise,
   -- this procedure inquires the GKS description table for the
   -- level of the current implementation of GKS.  If the inquired
   -- information is available, the error indicator is returned as
   -- 0 by this procedure and the value requested is returned.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- LEVEL - This enumerated type gives level of GKS.  Its value may
   --    be Lma, Lmb, Lmc, L0a, L0b, L0c, L1a, L1b, L1c, L2a, L2b, or
   --    L2c.

   begin

      -- The following if inquires the GKS_OPERATING_STATE_LIST
      -- to see if GKS is in the proper state before proceeding
      -- with the inquiry of the GKS_DESCRIPTION_TABLE.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;  -- Error 8
         LEVEL := GKS_LEVEL'FIRST;
      else
         EI := SUCCESSFUL;               -- Error 0
         LEVEL := GKS_DESCRIPTION_TABLE.LEVEL_OF_GKS;
      end if;

   end INQ_LEVEL_OF_GKS;

end INQ_GKS_DESCRIPTION_TABLE_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:INQ_WS_ST_LST_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_WS_STATE_LIST_MA - BODY
--  IDENTIFIER: GIMXXX.3.1
--  DISCREPANCY REPORTS:
--  DR016  Call deallocation procedures in INQ_WS_ST_LST_MA
------------------------------------------------------------------
-- file:  inq_ws_st_lst_ma_b.ada
-- level: all levels

with WSM;
with CGI;
with GKS_OPERATING_STATE_LIST;
with GKS_STATE_LIST;
with GKS_ERRORS;
with GKS_DESCRIPTION_TABLE;
with TRANSFORMATION_MATH;

use WSM;
use CGI;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body INQ_WS_STATE_LIST_MA is

-- This is the package body for the procedures to call the
-- workstation manager to inquire the workstation state list.
--
-- Each of the procedures in this package inquires the
-- GKS_OPERATING_STATE_LIST to check if GKS is in one of the
-- states WSOP, WSAC, or SGOP.  If it is not, error indicator
-- 7 occurs but no exception is raised.  In addition, each of
-- the procedures inquires the GKS_STATE_LIST to see if the
-- requested WS is open.  If it is not, error indicator 25
-- occurs but no exception is raised.  If neither condition occurs,
-- (the EI is 0) then a call is made to the WS_MANAGER to do the
-- inquiry.

   procedure INQ_WS_CONNECTION_AND_TYPE
      (WS        : in WS_ID;
      EI         : out ERROR_INDICATOR;
      CONNECTION : out VARIABLE_CONNECTION_ID;
      TYPE_OF_WS : out WS_TYPE) is

   -- This procedure calls the workstation manager to obtain the
   -- connection identifier and the workstation type from the
   -- workstation state list.  If the inquired information is
   -- available, the workstation manager returns the error
   -- indicator as 0 and values requested.
   --
   -- WS - This is an integer value indicating the workstation
   --    identification.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- CONNECTION - The physical identifier associated with the logical
   --    WS identifier.
   -- TYPE_OF_WS - This is an integer value representing the type of
   --    workstation.

   GKS_INSTR : CGI_INQ_WS_CONNECTION_AND_TYPE;

   TEMP_CONNECTION : VARIABLE_CONNECTION_ID;

   begin

      -- The following if structure inquires the GKS_OPERATING_
      -- STATE_LIST to see if GKS is in the proper state.  Then
      -- if so, it inquires the GKS_STATE_LIST to see if the WS is
      -- in the set of open workstations before proceeding with the
      -- inquiry call to the WS_MANAGER.

      if (CURRENT_OPERATING_STATE = GKCL) or
         (CURRENT_OPERATING_STATE = GKOP) then
         EI := NOT_WSOP_WSAC_SGOP;            -- Error 7
         CONNECTION := TEMP_CONNECTION;
         TYPE_OF_WS := WS_TYPE'FIRST;

      elsif not WS_IDS.IS_IN_LIST(WS,
            GKS_STATE_LIST.LIST_OF_OPEN_WS) then
         EI := WS_NOT_OPEN;                   -- Error 25
         CONNECTION := TEMP_CONNECTION;
         TYPE_OF_WS := WS_TYPE'FIRST;

      else

         GKS_INSTR.WS_TO_INQ_CONNECTION_AND_TYPE := WS;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then   -- Error 0
            EI := UNKNOWN;                    -- Error 2501
         else
            EI := GKS_INSTR.EI;               -- Error 0
         end if;

         CONNECTION.CONNECT := GKS_INSTR.CONNECTION_INQ.all; -- DR004
         TYPE_OF_WS := GKS_INSTR.TYPE_OF_WS_INQ;

         FREE_CONNECTION_ID (GKS_INSTR.CONNECTION_INQ);

      end if;

   end INQ_WS_CONNECTION_AND_TYPE;

   procedure INQ_TEXT_EXTENT
      (WS                 : in WS_ID;
      POSITION            : in WC.POINT;
      CHAR_STRING         : in STRING;
      EI                  : out ERROR_INDICATOR;
      CONCATENATION_POINT : out WC.POINT;
      TEXT_EXTENT         : out TEXT_EXTENT_PARALLELOGRAM) is

   -- This procedure calls the workstation manager to obtain the
   -- value of the text extent rectangle and the concatenation
   -- point which can be used as the origin of a subsequent text
   -- output primitive for the concatenation of character strings.
   -- If the inquired information is available, the error indicator
   -- is returned by the workstation manager as 0.  If the inquired
   -- information is not available, the workstation manager returns
   -- error 39 to indicate the reason for non-availability.
   --
   -- WS - This is an integer value indicating the workstation
   --    identification.
   -- POSITION - This is a record with X and Y components indicating
   --    the point in world coordinates where the text starts.
   -- CHAR_STRING - This string is the text.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- CONCATENATION_POINT - This is a record with X and Y components
   --    indicating the point in world coordinates that can be used
   --    as the origin of a subsequent text output primitive (as in
   --    the concatenation of strings).
   -- TEXT_EXTENT - This is a record with four components indicating
   --    the LOWER_LEFT, LOWER_RIGHT, UPPER_LEFT, and UPPER_RIGHT
   --    corner points of the text extent rectangle with respect to the
   --    vertical positioning of the text.  Each component is a
   --    record with X and Y components to indicate the point in
   --    world coordinates.

   GKS_INSTR : CGI_INQ_TEXT_EXTENT;

   begin

      -- The following if structure inquires the GKS_OPERATING_
      -- STATE_LIST to see if GKS is in the proper state.  Then
      -- if so, it inquires the GKS_STATE_LIST to see if the WS is
      -- in the set of open workstations before proceeding with the
      -- inquiry call to the WS_MANAGER.

      if (CURRENT_OPERATING_STATE = GKCL) or
         (CURRENT_OPERATING_STATE = GKOP) then
         EI := NOT_WSOP_WSAC_SGOP;            -- Error 7
         CONCATENATION_POINT := (0.0,0.0);
         TEXT_EXTENT := (LOWER_LEFT => (0.0,0.0),
                         LOWER_RIGHT => (0.0,0.0),
                         UPPER_LEFT => (0.0,0.0),
                         UPPER_RIGHT => (0.0,0.0));

      elsif not WS_IDS.IS_IN_LIST (WS,
            GKS_STATE_LIST.LIST_OF_OPEN_WS) then
         EI := WS_NOT_OPEN;                   -- Error 25
         CONCATENATION_POINT := (0.0,0.0);
         TEXT_EXTENT := (LOWER_LEFT => (0.0,0.0),
                         LOWER_RIGHT => (0.0,0.0),
                         UPPER_LEFT => (0.0,0.0),
                         UPPER_RIGHT => (0.0,0.0));

      else
         GKS_INSTR.WS_TO_INQ_TEXT_EXTENT := WS;

         -- Transformation logic for WC to NDC
         GKS_INSTR.POSITION_TEXT := TRANSFORMATION_MATH.WC_TO_NDC
            (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
            .NDC_FACTORS, POSITION);

         GKS_INSTR.CHAR_STRING := new STRING'(CHAR_STRING);

         WS_MANAGER (GKS_INSTR);

         FREE_STRING (GKS_INSTR.CHAR_STRING);

         if GKS_INSTR.EI /= SUCCESSFUL then             -- Error 0
            if GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN then  -- Error 39
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                           -- Error 2501
            end if;
         else
            EI := GKS_INSTR.EI;                         -- Error 0
         end if;

         CONCATENATION_POINT := TRANSFORMATION_MATH.NDC_TO_WC
            (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
            .WC_FACTORS, GKS_INSTR.CONCATENATION_POINT);

         TEXT_EXTENT.LOWER_LEFT := TRANSFORMATION_MATH.NDC_TO_WC
            (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
            .WC_FACTORS, GKS_INSTR.TEXT_EXTENT_LOWER_LEFT_INQ);

         TEXT_EXTENT.LOWER_RIGHT := TRANSFORMATION_MATH.NDC_TO_WC
            (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
            .WC_FACTORS, GKS_INSTR.TEXT_EXTENT_LOWER_RIGHT_INQ);

         TEXT_EXTENT.UPPER_LEFT := TRANSFORMATION_MATH.NDC_TO_WC
            (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
            .WC_FACTORS, GKS_INSTR.TEXT_EXTENT_UPPER_LEFT_INQ);

         TEXT_EXTENT.UPPER_RIGHT := TRANSFORMATION_MATH.NDC_TO_WC
            (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
            .WC_FACTORS, GKS_INSTR.TEXT_EXTENT_UPPER_RIGHT_INQ);

      end if;

      exception
         when NUMERIC_ERROR =>
            EI := ARITHMETIC;                            -- Error 308
            CONCATENATION_POINT := (0.0,0.0);
            TEXT_EXTENT := (LOWER_LEFT => (0.0,0.0),
                           LOWER_RIGHT => (0.0,0.0),
                           UPPER_LEFT  => (0.0,0.0),
                           UPPER_RIGHT => (0.0,0.0));

   end INQ_TEXT_EXTENT;

   procedure INQ_LIST_OF_COLOUR_INDICES
      (WS     : in WS_ID;
      EI      : out ERROR_INDICATOR;
      INDICES : out COLOUR_INDICES.LIST_OF) is

   -- This procedure calls the workstation manager to obtain the
   -- list of defined fill area indices for a particular workstation.
   -- If the inquired information is available, the error indicator is
   -- returned by the workstation manager as 0.  If the inquired infor-
   -- mation is not available, the workstation manager returns the
   -- error indicator as 33, 35, or 36 to indicate the reason for
   -- non-availability.
   --
   -- WS - This is an integer value indicating the workstation
   --    identification.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- INDICES - This is a set type of colour indices.

   GKS_INSTR : CGI_INQ_LIST_OF_COLOUR_INDICES;

   begin

      -- The following if structure inquires the GKS_OPERATING_
      -- STATE_LIST to see if GKS is in the proper state.  Then
      -- if so, it inquires the GKS_STATE_LIST to see if the WS is
      -- in the set of open workstations before proceeding with the
      -- inquiry call to the WS_MANAGER.

      if (CURRENT_OPERATING_STATE = GKCL) or
         (CURRENT_OPERATING_STATE = GKOP) then
         EI := NOT_WSOP_WSAC_SGOP;                  -- Error 7
         INDICES := COLOUR_INDICES.NULL_LIST;

      elsif not WS_IDS.IS_IN_LIST(WS,
            GKS_STATE_LIST.LIST_OF_OPEN_WS) then
         EI := WS_NOT_OPEN;                         -- Error 25
         INDICES := COLOUR_INDICES.NULL_LIST;

      else
         GKS_INSTR.WS_TO_INQ_COLOUR_INDICES := WS;
         WS_MANAGER (GKS_INSTR);

            if GKS_INSTR.EI /= SUCCESSFUL then
               if (GKS_INSTR.EI = WS_CATEGORY_IS_MI) or      -- Error 33
                  (GKS_INSTR.EI = WS_CATEGORY_IS_INPUT) or   -- Error 35
                  (GKS_INSTR.EI = WS_IS_WISS) then           -- Error 36
                  EI := GKS_INSTR.EI;
               else
                  EI := UNKNOWN;                             -- Error 2501
               end if;
            else
               EI := GKS_INSTR.EI;                           -- Error 0
            end if;

         INDICES := GKS_INSTR.LIST_OF_COLOUR_INDICES_INQ;

      end if;

   end INQ_LIST_OF_COLOUR_INDICES;

   procedure INQ_COLOUR_REPRESENTATION
      (WS             : in WS_ID;
      INDEX           : in COLOUR_INDEX;
      RETURNED_VALUES : in RETURN_VALUE_TYPE;
      EI              : out ERROR_INDICATOR;
      COLOUR          : out COLOUR_REPRESENTATION) is

   -- This procedure calls the workstation manager to obtain the
   -- value for the colour intensities for a colour index on a
   -- workstation.  If the inquired information is available, the
   -- error indicator is returned by the workstation manager as 0.
   -- If the inquired information is not available, the error
   -- indicator is returned by the workstation manager as 33, 35,
   -- 36, 93 or 94 to indicate the reason for non-availability.
   --
   -- WS - This is an integer value indicating the workstation
   --    identification.
   -- INDEX - This is an integer value indicating the colour index
   --    into the colour table.
   -- RETURNED_VALUES - This is an enumerated parameter which may have
   --    a value of SET or REALIZED to indicate whether the returned
   --    values should be as they were set by the program or as they
   --    were actually realized.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- COLOUR - This is a record with components RED, GREEN, and BLUE
   --    that represent the colour as a combination of intensities.

   GKS_INSTR : CGI_INQ_COLOUR_REPRESENTATION;

   begin

      -- The following if structure inquires the GKS_OPERATING_
      -- STATE_LIST to see if GKS is in the proper state.  Then
      -- if so, it inquires the GKS_STATE_LIST to see if the WS is
      -- in the set of open workstations before proceeding with the
      -- inquiry call to the WS_MANAGER.

      if (CURRENT_OPERATING_STATE = GKCL) or
         (CURRENT_OPERATING_STATE = GKOP) then
         EI := NOT_WSOP_WSAC_SGOP;               -- Error 7
         COLOUR := (RED => INTENSITY'FIRST,
                    GREEN => INTENSITY'FIRST,
                    BLUE => INTENSITY'FIRST);

      elsif not WS_IDS.IS_IN_LIST (WS,
            GKS_STATE_LIST.LIST_OF_OPEN_WS)  then
         EI := WS_NOT_OPEN;                      -- Error 25
         COLOUR := (RED => INTENSITY'FIRST,
                    GREEN => INTENSITY'FIRST,
                    BLUE => INTENSITY'FIRST);

      else
         GKS_INSTR.WS_TO_INQ_COLOUR_REP := WS;
         GKS_INSTR.COLOUR_INDEX_TO_INQ_COLOUR_REP := INDEX;
         GKS_INSTR.RETURN_VALUE_TO_INQ_COLOUR_REP := RETURNED_VALUES;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then               -- Error 0
            if (GKS_INSTR.EI = WS_CATEGORY_IS_MI) or      -- Error 33
               (GKS_INSTR.EI = WS_CATEGORY_IS_INPUT) or   -- Error 35
               (GKS_INSTR.EI = WS_IS_WISS) or             -- Error 36
               (GKS_INSTR.EI = INVALID_COLOUR_INDEX) or   -- Error 93
               (GKS_INSTR.EI = NO_COLOUR_REP) then        -- Error 94
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                             -- Error 2501
            end if;

         else
            EI := GKS_INSTR.EI;                           -- Error 0
         end if;

         COLOUR := GKS_INSTR.COLOUR_REP_INQ;

      end if;


   end INQ_COLOUR_REPRESENTATION;

   procedure INQ_WS_TRANSFORMATION
      (WS                : in WS_ID;
      EI                 : out ERROR_INDICATOR;
      UPDATE             : out UPDATE_STATE;
      REQUESTED_WINDOW   : out NDC.RECTANGLE_LIMITS;
      CURRENT_WINDOW     : out NDC.RECTANGLE_LIMITS;
      REQUESTED_VIEWPORT : out DC.RECTANGLE_LIMITS;
      CURRENT_VIEWPORT   : out DC.RECTANGLE_LIMITS) is

   -- This procedure calls the workstation manager to obtain the
   -- following workstation transformation information:
   --  1) the workstation transformation update state
   --  2) the requested workstation window
   --  3) the current workstation window
   --  4) the requested workstation viewport
   --  5) the current workstation viewport.
   -- If the inquired information is available, the error indicator
   -- is returned by the workstation manager as 0.  If the inquired
   -- information is not available, the error indicator is returned by
   -- the workstation manager as 33, or 36 to indicate the reason
   -- for non-availability.
   --
   -- WS - This is an integer value indicating the workstation
   --    identification.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- UPDATE - This enumerated parameter may have the value NOTPENDING,
   --    or PENDING to indicate whether or not a workstation transforma-
   --    tion change has been requested and not yet provided.
   -- REQUESTED_WINDOW - This record defines the extent of the
   --    requested window (this is the window "set" by SET_WS_WINDOW)
   --    in normalized device coordinates.  Its X and Y components give
   --    the limits in relation to the x and y axes.
   -- CURRENT_WINDOW  - This record defines the extent of the current
   --    window in normalized device coordinates.  Its X and Y com-
   --    ponents give the limits in relation to the x and y axes.
   -- REQUESTED_VIEWPORT - This record defines the extent of the
   --    requested viewport (this is the viewport "set" by SET_WS_
   --    VIEWPORT) in device coordinates.  Its X and Y components
   --    give the limits in relation to the x and y axes.
   -- CURRENT_VIEWPORT - This record defines the extent of the current
   --    viewport in device coordinates.  Its X and Y components give
   --    limits in relation to the x and y axes.

   GKS_INSTR : CGI_INQ_WS_TRANSFORMATION;

   begin

      -- The following if structure inquires the GKS_OPERATING_
      -- STATE_LIST to see if GKS is in the proper state.  Then
      -- if so, it inquires the GKS_STATE_LIST to see if the WS is
      -- in the set of open workstations before proceeding with the
      -- inquiry call to the WS_MANAGER.

      if (CURRENT_OPERATING_STATE = GKCL) or
         (CURRENT_OPERATING_STATE = GKOP) then
         EI := NOT_WSOP_WSAC_SGOP;            -- Error 7
         REQUESTED_WINDOW := (XMIN => 0.0,
                              XMAX => 0.0,
                              YMIN => 0.0,
                              YMAX => 0.0);
         CURRENT_WINDOW := (XMIN => 0.0,
                            XMAX => 0.0,
                            YMIN => 0.0,
                            YMAX => 0.0);
         REQUESTED_VIEWPORT := (XMIN => 0.0,
                                XMAX => 0.0,
                                YMIN => 0.0,
                                YMAX => 0.0);
         CURRENT_VIEWPORT := (XMIN => 0.0,
                              XMAX => 0.0,
                              YMIN => 0.0,
                              YMAX => 0.0);

      elsif not WS_IDS.IS_IN_LIST (WS,
            GKS_STATE_LIST.LIST_OF_OPEN_WS) then
         EI := WS_NOT_OPEN;                   -- Error 25
         REQUESTED_WINDOW := (XMIN => 0.0,
                              XMAX => 0.0,
                              YMIN => 0.0,
                              YMAX => 0.0);
         CURRENT_WINDOW := (XMIN => 0.0,
                            XMAX => 0.0,
                            YMIN => 0.0,
                            YMAX => 0.0);
         REQUESTED_VIEWPORT := (XMIN => 0.0,
                                XMAX => 0.0,
                                YMIN => 0.0,
                                YMAX => 0.0);
         CURRENT_VIEWPORT := (XMIN => 0.0,
                              XMAX => 0.0,
                              YMIN => 0.0,
                              YMAX => 0.0);

      else
         GKS_INSTR.WS_TO_INQ_TRANSFORMATION := WS;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then            -- Error 0
            if (GKS_INSTR.EI = WS_CATEGORY_IS_MI) or   -- Error 33
               (GKS_INSTR.EI = WS_IS_WISS) then        -- Error 36
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                          -- Error 2501
            end if;

         else
            EI := GKS_INSTR.EI;                         -- Error 0
         end if;

         UPDATE             := GKS_INSTR.UPDATE_INQ;
         REQUESTED_WINDOW   := GKS_INSTR.REQUESTED_WINDOW_INQ;
         CURRENT_WINDOW     := GKS_INSTR.CURRENT_WINDOW_INQ;
         REQUESTED_VIEWPORT := GKS_INSTR.REQUESTED_VIEWPORT_INQ;
         CURRENT_VIEWPORT   := GKS_INSTR.CURRENT_VIEWPORT_INQ;

      end if;


   end INQ_WS_TRANSFORMATION;

end INQ_WS_STATE_LIST_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:INQ_WS_DSCR_TBL_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_WS_DESCRIPTION_TABLE
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_ws_dscr_tbl_ma_b.ada
-- level: all levels

with WSM;
with CGI;
with GKS_OPERATING_STATE_LIST;
with GKS_STATE_LIST;
with GKS_ERRORS;
with GKS_DESCRIPTION_TABLE;

use WSM;
use CGI;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body INQ_WS_DESCRIPTION_TABLE_MA is

-- This is the package body for the procedures for calling the work-
-- station manager to inquire the workstation description tables.
--
-- Each of the procedures in this package inquires the
-- GKS_OPERATING_STATE_LIST to check if GKS is in one of the
-- states GKOP, WSOP, WSAC, or SGOP.  If it is not, error
-- indicator 8 occurs but no exception is raised.

   procedure INQ_DISPLAY_SPACE_SIZE
      (WS                  : in WS_TYPE;
      EI                   : out ERROR_INDICATOR;
      UNITS                : out DC_UNITS;
      MAX_DC_SIZE          : out DC.SIZE;
      MAX_RASTER_UNIT_SIZE : out RASTER_UNIT_SIZE) is

   -- This procedure calls the workstation manager to obtain the value
   -- of the maximum display surface size in device coordinate units
   -- and what units the device coordinate units are (metres or others),
   -- and the maximum display surface size in  raster units.  If the
   -- inquired information is available, the error indicator is returned
   -- by the workstation manager as 0.  If the inquired information is
   -- not available, the workstation manager returns the error indicator
   -- as 31, 33, or 36 to indicate the reason for non-availability.
   --
   -- WS - This is an integer value indicating the workstation
   --    identification.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- UNITS - This is an enumerated parameter which indicates if the
   --    device coordinate units for the WS are in METRES or OTHER.
   -- MAX_DC_SIZE - This record gives the maximum device coordinate
   --    magnitude as length along the X and Y axes (which are the
   --    components of the record).
   -- MAX_RASTER_UNIT_SIZE - This record provides the raster unit
   --    size in terms of the raster units along the X and Y axes.
   --    X and Y are the components of the record.

   GKS_INSTR : CGI_INQ_DISPLAY_SPACE_SIZE;

   begin

      -- The following if structure inquires the GKS_OPERATING
      -- _STATE_LIST to see if GKS is in the proper state.  Then
      -- it checks to see if the WS exists by checking if it is
      -- in the list of available WS types in the GKS_DESCRIPTION_
      -- TABLE.  If both conditions are true, the WS_MANAGER is
      -- called for the inquiry.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;                -- Error 8
         UNITS := DC_UNITS'FIRST;
         MAX_DC_SIZE := (XAXIS => 1.0,
                         YAXIS => 1.0);
         MAX_RASTER_UNIT_SIZE := (X => RASTER_UNITS'FIRST,
                                  Y => RASTER_UNITS'FIRST);

      elsif not WS_TYPES.IS_IN_LIST (WS,GKS_DESCRIPTION_TABLE.
                                LIST_OF_AVAILABLE_WS_TYPES) then
         EI := WS_TYPE_DOES_NOT_EXIST;                 -- Error 23
         UNITS := DC_UNITS'FIRST;
         MAX_DC_SIZE := (XAXIS => 1.0,
                         YAXIS => 1.0);
         MAX_RASTER_UNIT_SIZE := (X => RASTER_UNITS'FIRST,
                                  Y => RASTER_UNITS'FIRST);

      else
         -- Call to WS_MANAGER with the inquiry parameter.
         GKS_INSTR.WS_TO_INQ_DISPLAY_SPACE_SIZE := WS;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then            -- Error 0

            if (GKS_INSTR.EI = WS_CATEGORY_IS_MO) or   -- Error 31
               (GKS_INSTR.EI = WS_CATEGORY_IS_MI) or   -- Error 33
               (GKS_INSTR.EI = WS_IS_WISS) then        -- Error 36
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                          -- Error 2501
            end if;

         else
            EI := GKS_INSTR.EI;                        -- Error 0
         end if;

         UNITS := GKS_INSTR.DISPLAY_SPACE_UNITS_INQ;
         MAX_DC_SIZE := GKS_INSTR.MAX_DC_SIZE_INQ;
               MAX_RASTER_UNIT_SIZE := GKS_INSTR.MAX_RASTER_UNIT_SIZE_INQ;

      end if;

   end INQ_DISPLAY_SPACE_SIZE;

   procedure INQ_POLYLINE_FACILITIES
      (WS               : in WS_TYPE;
      EI                : out ERROR_INDICATOR;
      LIST_OF_TYPES     : out LINETYPES.LIST_OF;
      NUMBER_OF_WIDTHS  : out NATURAL;
      NOMINAL_WIDTH     : out DC.MAGNITUDE;
      RANGE_OF_WIDTHS   : out DC.RANGE_OF_MAGNITUDES;
      NUMBER_OF_INDICES : out NATURAL) is

   -- This procedure calls the workstation manager to obtain the values
   -- of the facilities for polyline.  These include:
   --  1) the number of available linetypes
   --  2) the list of available linetypes
   --  3) the number of available linewidths
   --  4) the nominal linewidth
   --  5) the range of linewidths (minimum, maximum)
   --  6) the number of predefined polyline indices.
   -- If the inquired information is available, the error indicator is
   -- returned by the workstation manager as 0.  If the inquired infor-
   -- mation is not available, the workstation manager returns the error
   -- indicator as 39 to indicate the reason for non-availability.
   --
   -- WS - This is an integer value indicating the workstation
   --    identification.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- LIST_OF_TYPES - This is a list type of LINETYPES.
   -- NUMBER_OF_WIDTHS - This is a natural number representing the
   --    number of line widths.
   -- NOMINAL_WIDTH - Indicates the nominal magnitude of the line
   --    in device coordinates.
   -- RANGE_OF_WIDTHS - This record type gives the MIN and MAX width
   --    limits for polylines.
   -- NUMBER_OF_INDICES - This is a natural number representing the
   --    number of indices.

   GKS_INSTR : CGI_INQ_POLYLINE_FACILITIES;

   begin

      -- The following if structure inquires the GKS_OPERATING
      -- _STATE_LIST to see if GKS is in the proper state.  Then
      -- it checks to see if the WS exists by checking if it is
      -- in the list of available WS types in the GKS_DESCRIPTION_
      -- TABLE.  If both conditions are true, the WS_MANAGER is
      -- called for the inquiry.

      if CURRENT_OPERATING_STATE = GKCL then

         EI := NOT_GKOP_WSOP_WSAC_SGOP;          -- Error 8
         LIST_OF_TYPES := LINETYPES.NULL_LIST;
         NUMBER_OF_WIDTHS := NATURAL'FIRST;
         NOMINAL_WIDTH := 1.0;
         RANGE_OF_WIDTHS := (MIN => 1.0,
                             MAX => 1.0);
         NUMBER_OF_INDICES := NATURAL'FIRST;

      elsif not WS_TYPES.IS_IN_LIST(WS,GKS_DESCRIPTION_TABLE.
                               LIST_OF_AVAILABLE_WS_TYPES) then

         EI := WS_TYPE_DOES_NOT_EXIST;           -- Error 23
         LIST_OF_TYPES := LINETYPES.NULL_LIST;
         NUMBER_OF_WIDTHS := NATURAL'FIRST;
         NOMINAL_WIDTH := 1.0;
         RANGE_OF_WIDTHS := (MIN => 1.0,
                             MAX => 1.0);
         NUMBER_OF_INDICES := NATURAL'FIRST;

      else

         GKS_INSTR.WS_TO_INQ_POLYLINE_FACILITIES := WS;

         -- The inquiry call is made to the workstation manager
         -- for the appropriate workstation.

         WS_MANAGER (GKS_INSTR);

         if (GKS_INSTR.EI /= SUCCESSFUL) then              -- Error 0
            if (GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN) then   -- Error 39
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                              -- Error 2501
            end if;

         else
            EI := GKS_INSTR.EI;                            -- Error 0
         end if;

         LIST_OF_TYPES     := GKS_INSTR.LIST_OF_POLYLINE_TYPES_INQ;
         NUMBER_OF_WIDTHS  := GKS_INSTR.NUMBER_OF_WIDTHS_INQ;
         NOMINAL_WIDTH     := GKS_INSTR.NOMINAL_WIDTH_INQ;
         RANGE_OF_WIDTHS   := GKS_INSTR.RANGE_OF_WIDTHS_INQ;
         NUMBER_OF_INDICES := GKS_INSTR.
                              NUMBER_OF_POLYLINE_INDICES_INQ;

      end if;

   end INQ_POLYLINE_FACILITIES;

   procedure INQ_POLYMARKER_FACILITIES
      (WS               : in WS_TYPE;
      EI                : out ERROR_INDICATOR;
      LIST_OF_TYPES     : out MARKER_TYPES.LIST_OF;
      NUMBER_OF_SIZES   : out NATURAL;
      NOMINAL_SIZE      : out DC.MAGNITUDE;
      RANGE_OF_SIZES    : out DC.RANGE_OF_MAGNITUDES;
      NUMBER_OF_INDICES : out NATURAL) is

   -- This procedure calls the workstation manager to obtain the values
   -- of the facilities for polymarker.  These include:
   --  1) the number of available marker types
   --  2) the list of available marker types
   --  3) the number of available marker sizes
   --  4) the nominal marker size
   --  5) the range of marker sizes (minimum, maximum)
   --  6) the number of predefined polymarker indices.
   -- If the inquired information is available, the error indicator is
   -- returned by the workstation manager as 0.  If the inquired infor-
   -- mation is not available, the workstation manager returns the error
   -- indicator as 39 to indicate the reason for non-availability.
   --
   -- WS - This is an integer value indicating the workstation
   --    identification.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- LIST_OF_TYPES - This is a set type of MARKER_TYPES.
   -- NUMBER_OF_SIZES - This is a natural number representing the
   --    number of marker sizes.
   -- NOMINAL_SIZE - Indicates the nominal magnitude of the marker
   --    in device coordinates.
   -- RANGE_OF_SIZES - This record type gives the MIN and MAX size
   --    limits for polymarkers.
   -- NUMBER_OF_INDICES - This is a natural number representing the
   --    number of indices.

   GKS_INSTR : CGI_INQ_POLYMARKER_FACILITIES;

   begin

      -- The following if structure inquires the GKS_OPERATING
      -- _STATE_LIST to see if GKS is in the proper state.  Then
      -- it checks to see if the WS exists by checking if it is
      -- in the list of available WS types in the GKS_DESCRIPTION_
      -- TABLE.  If both conditions are true, the WS_MANAGER is
      -- called for the inquiry.

      if CURRENT_OPERATING_STATE = GKCL then

         EI := NOT_GKOP_WSOP_WSAC_SGOP;        -- Error 8
         LIST_OF_TYPES := MARKER_TYPES.NULL_LIST;
         NUMBER_OF_SIZES := NATURAL'FIRST;
         NOMINAL_SIZE := 1.0;
         RANGE_OF_SIZES := (MIN => 1.0,
                            MAX => 1.0);
         NUMBER_OF_INDICES := NATURAL'FIRST;

      elsif not WS_TYPES.IS_IN_LIST(WS,GKS_DESCRIPTION_TABLE.
                               LIST_OF_AVAILABLE_WS_TYPES) then
         EI := WS_TYPE_DOES_NOT_EXIST;         -- Error 23
         LIST_OF_TYPES := MARKER_TYPES.NULL_LIST;
         NUMBER_OF_SIZES := NATURAL'FIRST;
         NOMINAL_SIZE := 1.0;
         RANGE_OF_SIZES := (MIN => 1.0,
                            MAX => 1.0);
         NUMBER_OF_INDICES := NATURAL'FIRST;

      else

         GKS_INSTR.WS_TO_INQ_POLYMARKER_FACILITIES := WS;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then              -- Error 0
            if GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN then   -- Error 39
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                            -- Error 2501
            end if;

         else
            EI := GKS_INSTR.EI;                          -- Error 0
         end if;

         LIST_OF_TYPES     := GKS_INSTR.LIST_OF_POLYMARKER_TYPES_INQ;
         NUMBER_OF_SIZES   := GKS_INSTR.NUMBER_OF_SIZES_INQ;
         NOMINAL_SIZE      := GKS_INSTR.NOMINAL_SIZE_INQ;
         RANGE_OF_SIZES    := GKS_INSTR.RANGE_OF_SIZES_INQ;
         NUMBER_OF_INDICES := GKS_INSTR.
                              NUMBER_OF_POLYMARKER_INDICES_INQ;

      end if;

   end INQ_POLYMARKER_FACILITIES;

   procedure INQ_TEXT_FACILITIES
      (WS                  : in WS_TYPE;
      EI                   : out ERROR_INDICATOR;
      LIST_OF_FONT_PRECISION_PAIRS: out TEXT_FONT_PRECISIONS.LIST_OF;
      NUMBER_OF_HEIGHTS    : out NATURAL;
      RANGE_OF_HEIGHTS     : out DC.RANGE_OF_MAGNITUDES;
      NUMBER_OF_EXPANSIONS : out NATURAL;
      EXPANSION_RANGE      : out RANGE_OF_EXPANSIONS;
      NUMBER_OF_INDICES    : out NATURAL) is

   -- This procedure calls the workstation manager to obtain the values
   -- of the facilities for text.  These include:
   --  1) the number of text font and precision pairs
   --  2) the list of text font and precision pairs
   --  3) the number of available character heights
   --  4) the minimum character height
   --  5) the maximum character height
   --  6) the number of available character expansion factors
   --  7) the minimum character expansion factor
   --  8) the maximum character expansion factor
   --  9) the number of predefined text indices.
   -- If the inquired information is available, the error indicator is
   -- returned by the workstation manager as 0.  If the inquired infor-
   -- mation is not available, the workstation manager returns the
   -- error indication as 39 to indicate the reason for non-
   -- availability.
   --
   -- WS - This is an integer value indicating the workstation
   --    identification.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- LIST_OF_FONT_PRECISION_PAIRS - This is a record containing a list
   --    of records which provides the text FONT and PRECISION.
   -- NUMBER_OF_HEIGHTS - This is a natural number representing the
   --    number of text character heights.
   -- RANGE_OF_HEIGHTS - This record type gives the MIN and MAX
   --    value for the character heights in device coordinates.
   -- NUMBER_OF_EXPANSIONS - This is a natural number representing the
   --    number of expansions factors available.
   -- EXPANSION_RANGE - This record type gives the MIN and MAX
   --    values for the character expansion factors in device coordi-
   --    nates.
   -- NUMBER_OF_INDICES - This is a natural number representing the
   --    number of indices.

   GKS_INSTR : CGI_INQ_TEXT_FACILITIES;

   begin

      -- The following if structure inquires the GKS_OPERATING
      -- _STATE_LIST to see if GKS is in the proper state.  Then
      -- it checks to see if the WS exists by checking if it is
      -- in the list of available WS types in the GKS_DESCRIPTION_
      -- TABLE.  If both conditions are true, the WS_MANAGER is
      -- called for the inquiry.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;        -- Error 8
         LIST_OF_FONT_PRECISION_PAIRS := TEXT_FONT_PRECISIONS.
                                         NULL_LIST;
         NUMBER_OF_HEIGHTS := NATURAL'FIRST;
         RANGE_OF_HEIGHTS := (MIN => 1.0,
                              MAX => 1.0);
         NUMBER_OF_EXPANSIONS := NATURAL'FIRST;
         EXPANSION_RANGE := (MIN => 1.0,
                             MAX => 1.0);
         NUMBER_OF_INDICES := NATURAL'FIRST;

      elsif not WS_TYPES.IS_IN_LIST(WS,GKS_DESCRIPTION_TABLE.
                               LIST_OF_AVAILABLE_WS_TYPES) then
         EI := WS_TYPE_DOES_NOT_EXIST;         -- Error 23
         LIST_OF_FONT_PRECISION_PAIRS := TEXT_FONT_PRECISIONS.
                                         NULL_LIST;
         NUMBER_OF_HEIGHTS := NATURAL'FIRST;
         RANGE_OF_HEIGHTS := (MIN => 1.0,
                              MAX => 1.0);
         NUMBER_OF_EXPANSIONS := NATURAL'FIRST;
         EXPANSION_RANGE := (MIN => 1.0,
                             MAX => 1.0);
         NUMBER_OF_INDICES := NATURAL'FIRST;

      else
         GKS_INSTR.WS_TO_INQ_TEXT_FACILITIES := WS;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then              -- Error 0
            if GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN then   -- Error 39
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                            -- Error 2501
            end if;

         else
            EI := GKS_INSTR.EI;                          -- Error 0
         end if;

         LIST_OF_FONT_PRECISION_PAIRS := GKS_INSTR.
                                         LIST_OF_FONT_PRECISION_PAIRS_INQ;
         NUMBER_OF_HEIGHTS := GKS_INSTR.NUMBER_OF_HEIGHTS_INQ;
         RANGE_OF_HEIGHTS := GKS_INSTR.RANGE_OF_HEIGHTS_INQ;
         NUMBER_OF_EXPANSIONS := GKS_INSTR.NUMBER_OF_EXPANSIONS_INQ;
         EXPANSION_RANGE := GKS_INSTR.RANGE_OF_EXPANSIONS_INQ;
         NUMBER_OF_INDICES := GKS_INSTR.NUMBER_OF_TEXT_INDICES_INQ;

      end if;

   end INQ_TEXT_FACILITIES;

   procedure INQ_FILL_AREA_FACILITIES
      (WS                     : WS_TYPE;
      EI                      : out ERROR_INDICATOR;
      LIST_OF_INTERIOR_STYLES : out INTERIOR_STYLES.LIST_OF;
      LIST_OF_HATCH_STYLES    : out HATCH_STYLES.LIST_OF;
      NUMBER_OF_INDICES       : out NATURAL) is

   -- This procedure calls the workstation manager to obtain the values
   -- of the facilities for the fill area construct.  These include:
   --  1) the number of available fill area interior styles
   --  2) the list of available fill area interior styles
   --  3) the number of available hatch styles
   --  4) the list of available hatch styles
   --  5) the number of predefined fill area indices.
   -- If the inquired information is available, the error indicator is
   -- returned by the workstation manager as 0.  If the inquired infor-
   -- mation is not available, the workstation manager returns the
   -- error indicator as 39 to indicate the reason for non-availability.
   --
   -- WS - This is an integer value indicating the workstation
   --    identification.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- LIST_OF_INTERIOR_STYLES - This is a set type of the interior
   --    styles available.  The value of the components are set to 1
   --    if the corresponding style is available.
   -- LIST_OF_HATCH_STYLES - This is a set type of the hatch styles
   --    available.  The value of the components are set to 1 if the
   --    corresponding hatch style is available.
   -- NUMBER_OF_INDICES - This is a natural number representing the
   --    number of indices.

   GKS_INSTR : CGI_INQ_FILL_AREA_FACILITIES;

   begin

      -- The following if structure inquires the GKS_OPERATING
      -- _STATE_LIST to see if GKS is in the proper state.  Then
      -- it checks to see if the WS exists by checking if it is
      -- in the list of available WS types in the GKS_DESCRIPTION_
      -- TABLE.  If both conditions are true, the WS_MANAGER is
      -- called for the inquiry.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;        -- Error 8
         LIST_OF_INTERIOR_STYLES := INTERIOR_STYLES.NULL_LIST;
         LIST_OF_HATCH_STYLES := HATCH_STYLES.NULL_LIST;
         NUMBER_OF_INDICES := NATURAL'FIRST;

      elsif not WS_TYPES.IS_IN_LIST(WS,GKS_DESCRIPTION_TABLE.
                               LIST_OF_AVAILABLE_WS_TYPES) then
         EI := WS_TYPE_DOES_NOT_EXIST;         -- Error 23
         LIST_OF_INTERIOR_STYLES := INTERIOR_STYLES.NULL_LIST;
         LIST_OF_HATCH_STYLES := HATCH_STYLES.NULL_LIST;
         NUMBER_OF_INDICES := NATURAL'FIRST;

      else
         GKS_INSTR.WS_TO_INQ_FILL_AREA_FACILITIES := WS;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then              -- Error 0
            if GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN then   -- Error 39
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                            -- Error 2501
            end if;

         else
            EI := GKS_INSTR.EI;
         end if;

         LIST_OF_INTERIOR_STYLES := GKS_INSTR.
                                    LIST_OF_INTERIOR_STYLES_INQ;
         LIST_OF_HATCH_STYLES    := GKS_INSTR.LIST_OF_HATCH_STYLES_INQ;
         NUMBER_OF_INDICES       := GKS_INSTR.
                                    NUMBER_OF_FILL_AREA_INDICES_INQ;

      end if;

   end INQ_FILL_AREA_FACILITIES;

   procedure INQ_COLOUR_FACILITIES
      (WS                      : in WS_TYPE;
      EI                       : out ERROR_INDICATOR;
      NUMBER_OF_COLOURS        : out NATURAL;
      AVAILABLE_COLOUR         : out COLOUR_AVAILABLE;
      NUMBER_OF_COLOUR_INDICES : out NATURAL) is

   -- This procedure calls the workstation manager to obtain the values
   -- of the facilities for colour.  These include:
   --  1) the number of available colours or intensities
   --  2) if colour is available
   --  3) the number of predefined colour indices.
   -- If the inquired information is available, the error indicator is
   -- returned by the workstation manager as 0.  If the inquired infor-
   -- mation is not available, the workstation manager returns the
   -- error indicator as 39 to indicate the reason for non-availability.
   --
   -- WS - This is an integer value indicating the workstation
   --    identification.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- NUMBER_OF_COLOURS - This is a natural number indicating the
   --    number of colours available.
   -- AVAILABLE_COLOUR - The value of this enumerated parameter
   --    can be COLOUR or MONOCHROME to indicate whether colour
   --    output is available on WS.
   -- NUMBER_OF_COLOUR_INDICES - This is an natural value representing
   --    the number of colour indices.

   GKS_INSTR : CGI_INQ_COLOUR_FACILITIES;

   begin

      -- The following if structure inquires the GKS_OPERATING
      -- _STATE_LIST to see if GKS is in the proper state.  Then
      -- it checks to see if the WS exists by checking if it is
      -- in the list of available WS types in the GKS_DESCRIPTION_
      -- TABLE.  If both conditions are true, the WS_MANAGER is
      -- called for the inquiry.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;        -- Error 8
         NUMBER_OF_COLOURS        := NATURAL'FIRST;
         AVAILABLE_COLOUR         := COLOUR_AVAILABLE'FIRST;
         NUMBER_OF_COLOUR_INDICES := NATURAL'FIRST;

      elsif not WS_TYPES.IS_IN_LIST(WS,GKS_DESCRIPTION_TABLE.
                               LIST_OF_AVAILABLE_WS_TYPES) then
         EI := WS_TYPE_DOES_NOT_EXIST;         -- Error 23
         NUMBER_OF_COLOURS        := NATURAL'FIRST;
         AVAILABLE_COLOUR         := COLOUR_AVAILABLE'FIRST;
         NUMBER_OF_COLOUR_INDICES := NATURAL'FIRST;

      else
         GKS_INSTR.WS_TO_INQ_COLOUR_FACILITIES := WS;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then              -- Error 0
            if GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN then   -- Error 39
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                            -- Error 2501
            end if;

         else
            EI := GKS_INSTR.EI;                          -- Error 0
         end if;

         NUMBER_OF_COLOURS        := GKS_INSTR.NUMBER_OF_COLOURS_INQ;
         AVAILABLE_COLOUR         := GKS_INSTR.AVAILABLE_COLOUR_INQ;
         NUMBER_OF_COLOUR_INDICES := GKS_INSTR.
                                     NUMBER_OF_COLOUR_INDICES_INQ;

      end if;

   end INQ_COLOUR_FACILITIES;

   procedure INQ_MAX_LENGTH_OF_WS_STATE_TABLES
      (WS                    : in WS_TYPE;
      EI                     : out ERROR_INDICATOR;
      MAX_POLYLINE_ENTRIES   : out NATURAL;
      MAX_POLYMARKER_ENTRIES : out NATURAL;
      MAX_TEXT_ENTRIES       : out NATURAL;
      MAX_FILL_AREA_ENTRIES  : out NATURAL;
      MAX_PATTERN_INDICES    : out NATURAL;
      MAX_COLOUR_INDICES     : out NATURAL) is

   -- This procedure calls the workstation manager to obtain the values
   -- of the maximum number of entries in the following bundle tables:
   --  1) polyline
   --  2) polymarker
   --  3) text
   --  4) fill area
   -- It also obtains the maximum number of pattern indices and the
   -- maximum number of colour indices.
   -- If the inquired information is available, the error indicator is
   -- returned by the workstation manager as 0.  If the inquired infor-
   -- mation is not available, the workstation manager returns the
   -- error indicator as 39 to indicate the reason for non-availability.
   --
   -- WS - This is an integer value indicating the workstation
   --    identification.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- MAX_POLYLINE_ENTRIES - This is a natural number representing the
   --    maximum number of polyline entries in the workstation state
   --    tables.
   -- MAX_POLYMARKER_ENTRIES - This is a natural number representing the
   --    maximum number of polymarker entries in the workstation state
   --    tables.
   -- MAX_TEXT_ENTRIES - This is a natural number representing the
   --    maximum number of text entries in the workstation state
   --    tables.
   -- MAX_FILL_AREA_ENTRIES - This is a natural number representing the
   --    maximum number of fill area entries in the workstation state
   --    tables.
   -- MAX_PATTERN_INDICES - This is a natural number representing the
   --    maximum number of pattern indices in the workstation state
   --    tables.
   -- MAX_COLOUR_INDICES - This is a natural number representing the
   --    maximum number of colour indices in the workstation state
   --    tables.

   GKS_INSTR : CGI_INQ_MAX_LENGTH_OF_WS_STATE_TABLES;

   begin

      -- The following if structure inquires the GKS_OPERATING
      -- _STATE_LIST to see if GKS is in the proper state.  Then
      -- it checks to see if the WS exists by checking if it is
      -- in the list of available WS types in the GKS_DESCRIPTION_
      -- TABLE.  If both conditions are true, the WS_MANAGER is
      -- called for the inquiry.

      if CURRENT_OPERATING_STATE = GKCL then
         EI := NOT_GKOP_WSOP_WSAC_SGOP;        -- Error 8
         MAX_POLYLINE_ENTRIES := NATURAL'FIRST;
         MAX_POLYMARKER_ENTRIES := NATURAL'FIRST;
         MAX_TEXT_ENTRIES := NATURAL'FIRST;
         MAX_FILL_AREA_ENTRIES := NATURAL'FIRST;
         MAX_PATTERN_INDICES := NATURAL'FIRST;
         MAX_COLOUR_INDICES := NATURAL'FIRST;

      elsif not WS_TYPES.IS_IN_LIST(WS,GKS_DESCRIPTION_TABLE.
                               LIST_OF_AVAILABLE_WS_TYPES) then
         EI := WS_TYPE_DOES_NOT_EXIST;         -- Error 23
         MAX_POLYLINE_ENTRIES := NATURAL'FIRST;
         MAX_POLYMARKER_ENTRIES := NATURAL'FIRST;
         MAX_TEXT_ENTRIES := NATURAL'FIRST;
         MAX_FILL_AREA_ENTRIES := NATURAL'FIRST;
         MAX_PATTERN_INDICES := NATURAL'FIRST;
         MAX_COLOUR_INDICES := NATURAL'FIRST;

      else
         GKS_INSTR.WS_TO_INQ_MAX_LENGTH_OF_WS_STATE_TABLES := WS;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then             -- Error 0
            if GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN then  -- Error 39
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                            -- Error 2501
            end if;

         else
            EI := GKS_INSTR.EI;                          -- Error 0
         end if;

         MAX_POLYLINE_ENTRIES   := GKS_INSTR.MAX_POLYLINE_ENTRIES_INQ;
         MAX_POLYMARKER_ENTRIES := GKS_INSTR.MAX_POLYMARKER_ENTRIES_INQ;
         MAX_TEXT_ENTRIES       := GKS_INSTR.MAX_TEXT_ENTRIES_INQ;
         MAX_FILL_AREA_ENTRIES  := GKS_INSTR.MAX_FILL_AREA_ENTRIES_INQ;
         MAX_PATTERN_INDICES    := GKS_INSTR.MAX_PATTERN_INDICES_INQ;
         MAX_COLOUR_INDICES     := GKS_INSTR.MAX_COLOUR_INDICES_INQ;

      end if;

   end INQ_MAX_LENGTH_OF_WS_STATE_TABLES;

end INQ_WS_DESCRIPTION_TABLE_MA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:SET_CLR_TBL_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_COLOUR_TABLE - BODY
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR005  OUTPUT_ATTRIBUTE_ERROR missing from SET_CLR_TBL_B
------------------------------------------------------------------
-- file:  set_clr_tbl_b.ada
-- level: all levels

with WSM;
with CGI;
with ERROR_ROUTINES;
with GKS_OPERATING_STATE_LIST;
with GKS_STATE_LIST;
with GKS_ERRORS;

use WSM;
use CGI;
use ERROR_ROUTINES;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body SET_COLOUR_TABLE is

-- This is the package body for procedures for calling the work-
-- station manager to set the workstation attributes at level ma.
--
-- If an error indicator above 0 occurs, these procedures call
-- the ERROR_LOGGING procedure of the package ERROR_ROUTINES
-- to log the error indicator and the name of the procedure
-- in the error file specified when the procedure OPEN_GKS
-- was called to begin this session of GKS operation.

   procedure SET_COLOUR_REPRESENTATION
      (WS    : in WS_ID;
      INDEX  : in COLOUR_INDEX;
      COLOUR : in COLOUR_REPRESENTATION) is

   -- This procedure inquires the GKS_OPERATING_STATE_LIST to
   -- check if GKS is in one of the states WSOP, WSAC, or SGOP.
   -- If it is not, error 7 occurs and the procedure raises the
   -- exception STATE_ERROR.  It also checks the GKS_STATE_LIST
   -- to see if the WS is open.  If not, error 25 occurs and the
   -- procedure raises the exception WS_ERROR.  Otherwise, this
   -- procedure calls the workstation manager to map a given colour
   -- index with a specified colour of certain intensities of red,
   -- green, and blue and to set this value in the workstation state
   -- list.  If the workstation manager returns error 33, 35, or 36,
   -- this procedure raises the exception WS_ERROR.
   --
   -- WS - Identifies the workstation on which the colour represen-
   --    tation.
   -- INDEX - Indicates the entry in the colour table to be set.
   -- COLOUR - Defines the representation of a colour as a combina-
   --    tion of RED, GREEN, and BLUE intensities which are the
   --    components of the record.

   GKS_INSTR : CGI_SET_COLOUR_REPRESENTATION;

   begin

      -- The following if structure inquires the GKS_OPERATING_STATE_
      -- LIST to see if GKS is in the proper state and the workstation
      -- specified is open.

      if (CURRENT_OPERATING_STATE = GKCL) or
         (CURRENT_OPERATING_STATE = GKOP) then
         ERROR_LOGGING (NOT_WSOP_WSAC_SGOP, "SET_COLOUR_TABLE");-- Error 7
         raise STATE_ERROR;

      elsif not WS_IDS.IS_IN_LIST(WS,GKS_STATE_LIST.LIST_OF_OPEN_WS) then
         ERROR_LOGGING (WS_NOT_OPEN, "SET_COLOUR_TABLE");    -- Error 25
         raise WS_ERROR;

      else
         GKS_INSTR.WS_TO_SET_COLOUR_REP := WS;
         GKS_INSTR.COLOUR_INDEX_TO_SET_COLOUR_REP := INDEX;
         GKS_INSTR.COLOUR_REP_SET := COLOUR;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then               -- Error 0
            if (GKS_INSTR.EI = WS_CATEGORY_IS_MI) or      -- Error 33
               (GKS_INSTR.EI = WS_CATEGORY_IS_INPUT) or   -- Error 35
               (GKS_INSTR.EI = WS_IS_WISS) then           -- Error 36
               ERROR_LOGGING (GKS_INSTR.EI, "SET_COLOUR_TABLE");
               raise WS_ERROR;
            elsif (GKS_INSTR.EI = INVALID_COLOUR_INDEX) then -- Error 93
               ERROR_LOGGING (GKS_INSTR.EI, "SET_COLOUR_TABLE");
               raise OUTPUT_ATTRIBUTE_ERROR;
            end if;

         end if;

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when WS_ERROR =>
            raise;
         when OUTPUT_ATTRIBUTE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,
                          "SET_COLOUR_REPRESENTATION"); -- ERROR 2501
            raise;

   end SET_COLOUR_REPRESENTATION;

end SET_COLOUR_TABLE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:ERROR_ROUTINES_MA_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: ERROR_ROUTINES - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  error_routines_ma_b.ada
-- level: ma

with GKS_ERRORS;

use GKS_ERRORS;

package body ERROR_ROUTINES is

-- This is the package body providing the procedures
-- for GKS error handling.

   procedure ERROR_LOGGING
      (EI  : in ERROR_INDICATOR;
      NAME : in SUBPROGRAM_NAME) is separate;

end ERROR_ROUTINES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WS_CONTROL_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WS_CONTROL - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  ws_control_b.ada
-- level: all levels

with WSM;
with CGI;
with ERROR_ROUTINES;
with GKS_OPERATING_STATE_LIST;
with GKS_STATE_LIST;
with GKS_ERRORS;
with GKS_DESCRIPTION_TABLE;

use WSM;
use CGI;
use ERROR_ROUTINES;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body WS_CONTROL is

-- This is the package body for the workstation control
-- functions.  All of these functions call the workstation
-- manager.
--
-- If an error indicator above 0 occurs, these procedures call
-- the ERROR_LOGGING procedure of the package ERROR_ROUTINES
-- to log the error indicator and the name of the procedure
-- in the error file specified when the procedure OPEN_GKS
-- was called to begin this session of GKS operation.

   procedure OPEN_WS
      (WS : in WS_ID;
      CONNECTION : in CONNECTION_ID;
      TYPE_OF_WS : in WS_TYPE) is separate;

   procedure CLOSE_WS
      (WS : in WS_ID) is separate;

   procedure ACTIVATE_WS
      (WS : in WS_ID) is separate;

   procedure DEACTIVATE_WS
      (WS : in WS_ID) is separate;

   procedure CLEAR_WS
      (WS  : in WS_ID;
      FLAG : in CONTROL_FLAG) is separate;

   procedure UPDATE_WS
      (WS          : in WS_ID;
      REGENERATION : in UPDATE_REGENERATION_FLAG) is separate;

end WS_CONTROL;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_CONTROL_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_CONTROL - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  gks_control_b.ada
-- level: all levels

with GKS_STATE_LIST;
with GKS_OPERATING_STATE_LIST;
with GKS_ERROR_STATE_LIST;
with ERROR_ROUTINES;
with GKS_CONFIGURATION;
with GKS_ERRORS;

use ERROR_ROUTINES;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body GKS_CONTROL is

-- This is the package body for the GKS control functions.
--
-- If an error indicator above 0 occurs, these procedures call
-- the ERROR_LOGGING procedure of the package ERROR_ROUTINES
-- to log the error indicator and the name of the procedure
-- in the error file specified when the procedure OPEN_GKS
-- was called to begin this session of GKS operation.

   procedure OPEN_GKS
      (ERROR_FILE       : in ERROR_FILE_TYPE :=
                          GKS_CONFIGURATION.DEFAULT_ERROR_FILE;
      AMOUNT_OF_MEMORY  : in MEMORY_UNITS    :=
                          GKS_CONFIGURATION.MAX_MEMORY_UNITS) is separate;

   procedure CLOSE_GKS is separate;

end GKS_CONTROL;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:OUT_PRIM_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: OUTPUT_PRIMITIVES - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  out_prim_b.ada
-- level: all levels

with WSM;
with CGI;
with ERROR_ROUTINES;
with GKS_OPERATING_STATE_LIST;
with GKS_ERRORS;
with TRANSFORMATION_MATH;
with GKS_STATE_LIST;

use WSM;
use CGI;
use ERROR_ROUTINES;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body OUTPUT_PRIMITIVES is

-- This is the package body for output primitive functions.
-- All of these procedures call the workstation manager.
--
-- All of these procedures inquire the GKS_OPERATING_STATE_LIST
-- to check if GKS is in one of the states WSAC or SGOP.  If it is
-- not, error 5 occurs and the procedure raises the exception
-- STATE_ERROR.
--
-- If an error indicator above 0 occurs, these procedures call
-- the ERROR_LOGGING procedure of the package ERROR_ROUTINES
-- to log the error indicator and the name of the procedure
-- in the error file specified when the procedure OPEN_GKS
-- was called to begin this session of GKS operation.

   procedure POLYLINE
      (LINE_POINTS : in WC.POINT_ARRAY) is separate;

   procedure POLYMARKER
      (MARKER_POINTS : in WC.POINT_ARRAY) is separate;

   procedure FILL_AREA
      (FILL_AREA_POINTS : in WC.POINT_ARRAY) is separate;

   procedure TEXT
      (POSITION   : in WC.POINT;
      TEXT_STRING : in STRING) is separate;

end OUTPUT_PRIMITIVES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:ERROR_LOGGING_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: ERROR_LOGGING
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  error_logging_s.ada
-- level: ma

with TEXT_IO;
with GKS_ERROR_STATE_LIST;
with GKS_CONFIGURATION;

separate (ERROR_ROUTINES)

procedure ERROR_LOGGING
   (EI  : in ERROR_INDICATOR;
   NAME : in SUBPROGRAM_NAME) is

-- This procedure writes the error number and the GKS function
-- name detecting the error to the error file (created when the
-- GKS function OPEN_GKS was called) using the I/O facilities of
-- TEXT_IO.
--
-- EI - This is the error indicator.  Its numeric value represents
--    the type of error being logged.
-- NAME - This is a string type.  Its value is the name of the
--    procedure in which the error being logged occurred.

begin

   -- Write the error indicator and the subprogram name to the
   -- error file.

   if not TEXT_IO.IS_OPEN(GKS_ERROR_STATE_LIST.ERROR_DATA) then
      TEXT_IO.CREATE (GKS_ERROR_STATE_LIST.ERROR_DATA,
                      TEXT_IO.OUT_FILE,
                      GKS_CONFIGURATION.DEFAULT_ERROR_FILE);
   end if;
   TEXT_IO.NEW_LINE(GKS_ERROR_STATE_LIST.ERROR_DATA);
   TEXT_IO.PUT(GKS_ERROR_STATE_LIST.ERROR_DATA,
      "GKS ERROR NUMBER ");
   TEXT_IO.PUT(GKS_ERROR_STATE_LIST.ERROR_DATA,ERROR_INDICATOR'IMAGE(EI));
   TEXT_IO.PUT(GKS_ERROR_STATE_LIST.ERROR_DATA,
      " OCCURRED IN ");
   TEXT_IO.PUT(GKS_ERROR_STATE_LIST.ERROR_DATA, NAME);
   TEXT_IO.NEW_LINE;

end ERROR_LOGGING;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:ACTIVATE_WS_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: ACTIVATE_WS
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  activate_ws_s.ada
-- level: all levels

separate (WS_CONTROL)

procedure ACTIVATE_WS
   (WS : in WS_ID) is

-- This procedure first checks the GKS_OPERATING_STATE_LIST
-- to see if GKS is in state WSOP or WSAC.  If it is not,
-- error 6 occurs and the exception STATE_ERROR is raised.
-- Then the procedure inquires the GKS_STATE_LIST to check
-- if the WS is in the set of open workstations. If it is not,
-- error 25 occurs and the exception WS_ERROR is raised.
-- The procedure also checks the GKS_STATE_LIST to see if the
-- WS is in the set of active workstations.  If it is, error
-- 29 occurs and the exception WS_ERROR is raised.  Then,
-- if the addition of another active workstation would
-- exceed the MAX_ACTIVE_WS number in the GKS_DESCRIPTION_TABLE,
-- error 43 occurs and the exception WS_ERROR is raised.
--
-- Otherwise, this procedure calls the workstation manager
-- to activate the workstation.  If the workstation manager
-- returns errors 33, or 35, this procedure raises
-- the exception WS_ERROR.
--
-- WS - This is the identifier of the workstation that is
--    to be activated.

GKS_INSTR : CGI_ACTIVATE_WS;

begin

   -- The following if structure inquires the GKS_OPERATING_STATE_
   -- LIST to see if GKS is in the proper state. Then it inquires
   -- the GKS_STATE_LIST to see if the WS is in the set of open
   -- workstations and if it is already activated (in the set of
   -- active workstations).

   if (CURRENT_OPERATING_STATE /= WSOP) and
      (CURRENT_OPERATING_STATE /= WSAC) then
      ERROR_LOGGING (NOT_WSOP_WSAC, "ACTIVATE_WS"); -- Error 6
      raise STATE_ERROR;

   elsif not WS_IDS.IS_IN_LIST(WS, GKS_STATE_LIST.LIST_OF_OPEN_WS) then
      ERROR_LOGGING (WS_NOT_OPEN, "ACTIVATE_WS");   -- Error 25
      raise WS_ERROR;

   elsif WS_IDS.IS_IN_LIST(WS, GKS_STATE_LIST.LIST_OF_ACTIVE_WS) then
      ERROR_LOGGING (WS_IS_ACTIVE, "ACTIVATE_WS");   -- Error 29
      raise WS_ERROR;

   elsif WS_IDS.SIZE_OF_LIST(GKS_STATE_LIST.LIST_OF_ACTIVE_WS) =
      GKS_DESCRIPTION_TABLE.MAX_ACTIVE_WS then
      ERROR_LOGGING (MAX_NUM_OF_ACTIVE_WS, "ACTIVATE_WS"); -- Error 43
      raise WS_ERROR;

   else
      GKS_INSTR.WS_TO_ACTIVATE := WS;
      WS_MANAGER (GKS_INSTR);

      if GKS_INSTR.EI /= SUCCESSFUL then               -- Error 0

         if (GKS_INSTR.EI = WS_CATEGORY_IS_MI) or      -- Error 33
            (GKS_INSTR.EI = WS_CATEGORY_IS_INPUT) then -- Error 35
            ERROR_LOGGING (GKS_INSTR.EI, "ACTIVATE_WS");
            raise WS_ERROR;
         end if;

      else
         WS_IDS.ADD_TO_LIST(WS, GKS_STATE_LIST.LIST_OF_ACTIVE_WS);

         if CURRENT_OPERATING_STATE /= WSAC then
            CURRENT_OPERATING_STATE := WSAC;
         end if;

      end if;

   end if;

   exception
      when STATE_ERROR =>
         raise;
      when WS_ERROR =>
         raise;
      when OTHERS =>
         ERROR_LOGGING (UNKNOWN, "ACTIVATE_WS");        -- Error 2501
         raise;

end ACTIVATE_WS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:DEACTIVATE_WS_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: DEACTIVATE_WS
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  deactivate_ws_s.ada
-- level: all levels

separate (WS_CONTROL)

procedure DEACTIVATE_WS
   (WS : in WS_ID) is

-- This procedure first inquires the GKS_OPERATING_STATE_LIST
-- to see if GKS is in state WSAC.  If it is not, error 3
-- occurs and this procedure raises the exception STATE_ERROR.
-- This procedure then inquires the GKS_STATE_LIST to see if
-- the WS is in the set of active workstations.  If it is not,
-- error 30 occurs and the exception WS_ERROR is raised.
-- Otherwise, this procedure calls the workstation manager to
-- deactivate the workstation.  If the workstation manager returns
-- errors  33, or 35, this procedure raises the exception
-- WS_ERROR.
--
-- This procedure sets the operating state to WSOP = "At least
-- one workstation open" in the GKS_OPERATING_STATE_LIST if no
-- workstations remain active.  This is determined by inquiring
-- the GKS_STATE_LIST.
--
-- WS - This is the identifier of the workstation that is
--    to be deactivated.

GKS_INSTR : CGI_DEACTIVATE_WS;

begin

   -- The following if structure inquires the GKS_OPERATING_STATE_
   -- LIST to see if GKS is in the proper state. Then it inquires
   -- the GKS_STATE_LIST to see if the WS is in the set of active
   -- workstations before calling the WS_MANAGER.

   if (CURRENT_OPERATING_STATE /= WSAC) then
      ERROR_LOGGING (NOT_WSAC, "DEACTIVATE_WS");         -- Error 3
      raise STATE_ERROR;

   elsif not WS_IDS.IS_IN_LIST(WS,GKS_STATE_LIST.LIST_OF_ACTIVE_WS) then
      ERROR_LOGGING (WS_IS_NOT_ACTIVE, "DEACTIVATE_WS"); -- Error 30
      raise WS_ERROR;

   else
      GKS_INSTR.WS_TO_DEACTIVATE := WS;
      WS_MANAGER (GKS_INSTR);

      if GKS_INSTR.EI /= SUCCESSFUL then                -- Error 0
         if (GKS_INSTR.EI = WS_CATEGORY_IS_MI) or       -- Error 33
            (GKS_INSTR.EI = WS_CATEGORY_IS_INPUT) then  -- Error 35
            ERROR_LOGGING (GKS_INSTR.EI, "DEACTIVATE_WS");
            raise WS_ERROR;
         end if;

      else
         WS_IDS.DELETE_FROM_LIST(WS,GKS_STATE_LIST.LIST_OF_ACTIVE_WS);

         if WS_IDS.SIZE_OF_LIST(GKS_STATE_LIST.LIST_OF_ACTIVE_WS) = 0
            then
            CURRENT_OPERATING_STATE := WSOP;
         end if;

      end if;

   end if;

   exception
      when STATE_ERROR =>
         raise;
      when WS_ERROR =>
         raise;
      when OTHERS =>
         ERROR_LOGGING (UNKNOWN, "DEACTIVATE_WS");       -- Error 2501
         raise;

end DEACTIVATE_WS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:CLEAR_WS_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CLEAR_WS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  clear_ws_s.ada
-- level: all levels

separate (WS_CONTROL)

procedure CLEAR_WS
   (WS  : in WS_ID;
   FLAG : in CONTROL_FLAG) is

-- This procedure inquires the GKS_OPERATING_STATE_LIST to
-- see if GKS is in the states WSOP, or WSAC.  If it is not,
-- error 6 occurs and the exception STATE_ERROR is raised.
-- Then this procedure inquires the GKS_STATE_LIST to check
-- if the WS is in the set of open workstations.  If it is not,
-- error 25 occurs, and the exception WS_ERROR is raised.
--
-- Otherwise, this procedure calls the workstation manager to
-- clear the workstation.  If the workstation manager returns errors
-- 33, or 35 this procedure raises the exception WS_ERROR.
--
-- WS - This is the identifier of the workstation on which the
--    display surface is to be cleared.
-- FLAG - Indicates the conditions under which the display
--    surface is to be cleared.  It may be set to either
--    CONDITIONALLY or ALWAYS.

GKS_INSTR : CGI_CLEAR_WS;

begin

   -- The following if structure inquires the GKS_OPERATING_STATE_
   -- LIST to see if GKS is in the proper state. Then it inquires
   -- the GKS_STATE_LIST to see if the WS is in the set of open
   -- workstations before calling the WS_MANAGER.

   if (CURRENT_OPERATING_STATE /= WSOP) and
      (CURRENT_OPERATING_STATE /= WSAC) then
      ERROR_LOGGING (NOT_WSOP_WSAC, "CLEAR_WS");  -- Error 6
      raise STATE_ERROR;

   elsif not WS_IDS.IS_IN_LIST(WS,GKS_STATE_LIST.LIST_OF_OPEN_WS) then
      ERROR_LOGGING (WS_NOT_OPEN, "CLEAR_WS");     -- Error 25
      raise WS_ERROR;

   else
      GKS_INSTR.WS_TO_CLEAR := WS;
      GKS_INSTR.FLAG := FLAG;
      WS_MANAGER (GKS_INSTR);

      if GKS_INSTR.EI /= SUCCESSFUL then               -- Error 0

         if (GKS_INSTR.EI = WS_CATEGORY_IS_MI) or      -- Error 33
            (GKS_INSTR.EI = WS_CATEGORY_IS_INPUT) then -- Error 35
            ERROR_LOGGING (GKS_INSTR.EI, "CLEAR_WS");
            raise WS_ERROR;
         end if;

      end if;

   end if;

   exception
      when STATE_ERROR =>
         raise;
      when WS_ERROR =>
         raise;
      when OTHERS =>
         ERROR_LOGGING (UNKNOWN, "CLEAR_WS");             -- Error 2501
         raise;

end CLEAR_WS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:CLOSE_WS_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CLOSE_WS
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  close_ws_s.ada
-- level: all levels

separate (WS_CONTROL)

procedure CLOSE_WS
   (WS : in WS_ID) is

-- This procedure inquires the GKS_OPERATING_STATE_LIST
-- to see if GKS is in state WSOP, WSAC, or SGOP. If it
-- is not, then error 7 occurs and the exception STATE_
-- ERROR is raised.  Then it inquires the GKS_STATE_LIST
-- to see if the WS is in the set of open workstations. If
-- it is not, error 25 occurs and the exception WS_ERROR is
-- raised.  The procedure also checks the GKS_STATE_LIST to
-- see if the WS is in the set of active workstations. If
-- it is, error 29 occurs and the exception WS_ERROR is
-- raised.
--
-- Otherwise, this procedure calls the workstation manager to
-- release the connection between the workstation and GKS.
--
-- If the workstation manager returns error 147, this procedure
-- raises the exception INPUT_ERROR.
--
-- WS - This is the identifier of the workstation that is
--    to be closed.

GKS_INSTR : CGI_CLOSE_WS;

begin

   -- The following if structure inquires the GKS_OPERATING_STATE_
   -- LIST to see if GKS is in the proper state. Then it inquires
   -- the GKS_STATE_LIST to see if the WS is in the set of open
   -- workstations and if it is not activated (not in the set of
   -- active workstations).

   if (CURRENT_OPERATING_STATE = GKCL) or
      (CURRENT_OPERATING_STATE = GKOP) then
      ERROR_LOGGING (NOT_WSOP_WSAC_SGOP, "CLOSE_WS");   -- Error 7
      raise STATE_ERROR;

   elsif not WS_IDS.IS_IN_LIST(WS,GKS_STATE_LIST.LIST_OF_OPEN_WS) then
      ERROR_LOGGING (WS_NOT_OPEN, "CLOSE_WS");          -- Error 25
      raise WS_ERROR;

   elsif WS_IDS.IS_IN_LIST(WS,GKS_STATE_LIST.LIST_OF_ACTIVE_WS) then
      ERROR_LOGGING (WS_IS_ACTIVE, "CLOSE_WS");         -- Error 29
      raise WS_ERROR;

   else
      GKS_INSTR.WS_TO_CLOSE := WS;
      WS_MANAGER (GKS_INSTR);

      if GKS_INSTR.EI /= SUCCESSFUL then                   -- Error 0
         if GKS_INSTR.EI = INPUT_QUEUE_OVERFLOW then       -- Error 147
            ERROR_LOGGING (INPUT_QUEUE_OVERFLOW, "CLOSE_WS");
            raise INPUT_ERROR;
         end if;
      else
         WS_IDS.DELETE_FROM_LIST(WS,GKS_STATE_LIST.LIST_OF_OPEN_WS);

         if WS_IDS.SIZE_OF_LIST(GKS_STATE_LIST.LIST_OF_OPEN_WS) = 0 then
            CURRENT_OPERATING_STATE := GKOP;
         end if;

      end if;

   end if;

   exception
      when STATE_ERROR =>
         raise;
      when WS_ERROR =>
         raise;
      when OTHERS =>
         ERROR_LOGGING (UNKNOWN, "CLOSE_WS");              -- Error 2501
         raise;

end CLOSE_WS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:CLOSE_GKS_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CLOSE_GKS
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  close_gks_s.ada
-- level: all levels

with TEXT_IO;

separate (GKS_CONTROL)

procedure CLOSE_GKS is

--  This function closes GKS.  All of the GKS data
--  structures are made unavailable.  No further GKS
--  functions may be invoked.  The operating state is
--  set to GKCL = "GKS closed."

--  The procedure inquires the GKS_OPERATING_STATE_LIST
--  initially.  If the operating state is not GKOP,
--  error 2 occurs, and the exception STATE_ERROR is
--  raised.

EI : ERROR_INDICATOR;

begin

   -- The following if inquires the GKS_OPERATING_STATE_LIST
   -- to see if GKS is in the proper state before proceeding.
   if CURRENT_OPERATING_STATE /= GKOP then
      ERROR_LOGGING (NOT_GKOP, "CLOSE_GKS");       -- Error 2
      raise STATE_ERROR;
   else
      TEXT_IO.CLOSE (GKS_ERROR_STATE_LIST.ERROR_DATA);
      CURRENT_OPERATING_STATE := GKCL;
   end if;

   exception
      when STATE_ERROR =>
         raise;
      when OTHERS =>
         ERROR_LOGGING (UNKNOWN, "CLOSE_GKS");       -- Error 2501
         raise;

end CLOSE_GKS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:FA_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: FILL_AREA
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  fa_s.ada
-- level: all levels

separate (OUTPUT_PRIMITIVES)

procedure FILL_AREA
   (FILL_AREA_POINTS : in WC.POINT_ARRAY) is

-- This procedure first inquires the GKS_OPERATING_STATE_LIST
-- to check if GKS is in state WSAC or SGOP.  If it is not,
-- error 5 occurs and the exception STATE_ERROR is raised.  In
-- addition, it checks if the number of points is invalid.  If
-- so, error 100 occurs and the exception OUTPUT_PRIMITIVE_ERROR
-- is raised.  Otherwise, this procedure performs a normalization
-- transformation on the world coordinate points passed in and
-- passes the normalized device coordinates that result to the
-- workstation manager to generate a fill area output.
--
-- FILL_AREA_POINTS - Provides the array of world coordinate points.

GKS_INSTR : CGI_FILL_AREA;

NDC_POINTS : NDC.POINT_ARRAY(1..FILL_AREA_POINTS'LENGTH);
-- The above type was created to hold the transformed points.

begin

   -- The following if structure inquires the GKS_OPERATING_STATE_
   -- LIST to see if GKS is in the proper state. Then it checks to
   -- see that the number of points is valid before calling the
   -- WS_MANAGER.

   if (CURRENT_OPERATING_STATE /= WSAC) and
      (CURRENT_OPERATING_STATE /= SGOP) then
      ERROR_LOGGING (NOT_WSAC_SGOP, "FILL_AREA");           -- Error 5
      raise STATE_ERROR;

   elsif FILL_AREA_POINTS'LENGTH < 3 then
      ERROR_LOGGING (INVALID_NUMBER_OF_POINTS, "FILL_AREA"); -- Error 100
      raise OUTPUT_PRIMITIVE_ERROR;

   else
      -- The following performs the transformation on the
      -- points from world coordinates to normalized device coordinates.
      NDC_POINTS := TRANSFORMATION_MATH.WC_TO_NDC (GKS_STATE_LIST.
                    LIST_OF_NORMALIZATION_TRANSFORMATIONS
                   (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
                   .NDC_FACTORS, FILL_AREA_POINTS);

      GKS_INSTR.FILL_AREA_POINTS := new NDC.POINT_ARRAY'(NDC_POINTS);

      WS_MANAGER (GKS_INSTR);

      FREE_POINT_ARRAY(GKS_INSTR.FILL_AREA_POINTS);

   end if;

   exception
      when STATE_ERROR =>
         raise;
      when OUTPUT_PRIMITIVE_ERROR =>
         raise;
      when NUMERIC_ERROR =>
         ERROR_LOGGING (ARITHMETIC, "FILL_AREA");          -- Error 308
         raise SYSTEM_ERROR;
      when OTHERS =>
         ERROR_LOGGING (UNKNOWN, "FILL_AREA");             -- Error 2501
         raise;

end FILL_AREA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:OPEN_GKS_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: OPEN_GKS
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  open_gks_s.ada
-- level: all_levels

with TEXT_IO;

separate (GKS_CONTROL)

procedure OPEN_GKS
   (ERROR_FILE       : in ERROR_FILE_TYPE :=
                       GKS_CONFIGURATION.DEFAULT_ERROR_FILE;
    AMOUNT_OF_MEMORY : in MEMORY_UNITS    :=
                       GKS_CONFIGURATION.MAX_MEMORY_UNITS) is

-- This function initializes GKS.  It must be invoked
-- before any other GKS function.  The GKS state list is
-- allocated and intialised and the GKS description table
-- and the workstation description tables are made avail-
-- able.  The operating state is set to GKOP = "GKS open"
-- in the GKS state list.
--
-- The procedure checks if the operating state is set to
-- GKCL in the GKS_OPERATING_STATE_LIST. If it is not GKCL,
-- error 1 occurs and the exception STATE_ERROR is raised.
--
-- ERROR_FILE - User-defined file for reporting errors detected by GKS.
-- AMOUNT_OF_MEMORY - Required by GKS but currently ignored.

begin

   -- The following if structure inquires the GKS_OPERATING_STATE_LIST
   -- to see if GKS is in the proper state before proceeding.

   if CURRENT_OPERATING_STATE /= GKCL then
      ERROR_LOGGING (NOT_GKCL, "OPEN_GKS"); -- Error 1
      raise STATE_ERROR;

   else

   -- If a TEXT_IO exception occurs after the following statement
   -- the control jumps to the exception handler.

      TEXT_IO.CREATE (GKS_ERROR_STATE_LIST.ERROR_DATA,
                      TEXT_IO.OUT_FILE,
                      ERROR_FILE);

      GKS_STATE_LIST.INITIALIZE;
      CURRENT_OPERATING_STATE := GKOP;

   end if;

   exception
      when STATE_ERROR =>
         raise;

      -- The following exceptions occur if the error file name passed
      -- in is invalid.  The error indicator 200 occurs and the
      -- exception MISC_ERROR is raised to the user.

      when TEXT_IO.NAME_ERROR | TEXT_IO.STATUS_ERROR | TEXT_IO.USE_ERROR =>

         -- Create the error file with the implementation default file.
         TEXT_IO.CREATE (GKS_ERROR_STATE_LIST.ERROR_DATA,
                         TEXT_IO.OUT_FILE,
                         GKS_CONFIGURATION.DEFAULT_ERROR_FILE);

         GKS_STATE_LIST.INITIALIZE;
         CURRENT_OPERATING_STATE := GKOP;
         ERROR_LOGGING (INVALID_ERROR_FILE, "OPEN_GKS"); -- Error 200
         raise MISC_ERROR;

      when OTHERS =>
         ERROR_LOGGING (UNKNOWN, "OPEN_GKS");   -- Error 2501
         raise;

end OPEN_GKS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:OPEN_WS_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: OPEN_WS
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  open_ws_s.ada
-- level: all levels

with OUTPUT_ATTRIBUTES_TYPE;
with GET_OUTPUT_ATTRIBUTES;

separate (WS_CONTROL)

procedure OPEN_WS
   (WS        : in WS_ID;
   CONNECTION : in CONNECTION_ID;
   TYPE_OF_WS : in WS_TYPE) is

-- This procedure calls the workstation manager to open
-- a workstation and thus add it to the set of open
-- workstations in the GKS_STATE_LIST.  This procedure
-- inquires the GKS_OPERATING_STATE_LIST for the GKS
-- operating state.  If GKS is not in the proper state,
-- error 8 occurs and the procedure raises the exception
-- STATE_ERROR.  If it is in the proper state, this procedure
-- inquires the GKS_STATE_LIST to check if the WS is already
-- open.  If it is, error 24 occurs and the procedure raises
-- the exception WS_ERROR. Then the call to the WS_MANAGER is
-- made.  If no errors occur, this procedure sets the operating
-- state to WSOP = "at least one workstation open." If errors
-- 21, 22, 26 or 28 are returned by the workstation manager,
-- this procedure will raise the exception WS_ERROR.
--
-- WS - Workstation to be opened.
-- CONNECTION - The physical identifier associated with the logical
--    WS identifier.
-- TYPE_OF_WS - Indicates the type of workstation being opened.

GKS_INSTR : CGI_OPEN_WS;

OPEN_WS_ATTRIBUTES : OUTPUT_ATTRIBUTES_TYPE.OUTPUT_ATTRIBUTES;

begin

   -- The following if structure inquires the GKS_OPERATING_STATE_
   -- LIST to see if GKS is in the proper state. Then it inquires
   -- the GKS_STATE_LIST to make sure the WS is not in the set of open
   -- workstations.

   if (CURRENT_OPERATING_STATE = GKCL) then
      ERROR_LOGGING (NOT_GKOP_WSOP_WSAC_SGOP, "OPEN_WS");  -- Error 8
      raise STATE_ERROR;

   elsif WS_IDS.IS_IN_LIST (WS, GKS_STATE_LIST.LIST_OF_OPEN_WS) then
      ERROR_LOGGING (WS_IS_OPEN, "OPEN_WS");          -- Error 24
      raise WS_ERROR;

   elsif WS_IDS.SIZE_OF_LIST (GKS_STATE_LIST.LIST_OF_OPEN_WS) =
      GKS_DESCRIPTION_TABLE.MAX_OPEN_WS then
      ERROR_LOGGING (MAX_NUM_OF_OPEN_WS, "OPEN_WS");  -- Error 42
      raise WS_ERROR;

   else
      GKS_INSTR.WS_TO_OPEN := WS;
      GKS_INSTR.CONNECTION_OPEN := new CONNECTION_ID'(CONNECTION);
      GKS_INSTR.TYPE_OF_WS_OPEN := TYPE_OF_WS;

      GET_OUTPUT_ATTRIBUTES.GET_ATTRIBUTES (OPEN_WS_ATTRIBUTES);
      GKS_INSTR.ATTRIBUTES_AT_OPEN := OPEN_WS_ATTRIBUTES;
      WS_MANAGER (GKS_INSTR);

      FREE_CONNECTION_ID (GKS_INSTR.CONNECTION_OPEN);

      if GKS_INSTR.EI /= SUCCESSFUL then                    -- Error 0
         if (GKS_INSTR.EI = INVALID_CONN_ID) or             -- Error 21
            (GKS_INSTR.EI = WS_CANNOT_OPEN) or              -- Error 26
            (GKS_INSTR.EI = WISS_ALREADY_OPEN) then         -- Error 28
            ERROR_LOGGING (GKS_INSTR.EI, "OPEN_WS");
            raise WS_ERROR;
         end if;

      else
         WS_IDS.ADD_TO_LIST(WS,GKS_STATE_LIST.LIST_OF_OPEN_WS);

         if CURRENT_OPERATING_STATE = GKOP then
            CURRENT_OPERATING_STATE := WSOP;
         end if;

      end if;

   end if;

   exception
      when STATE_ERROR =>
         raise;
      when WS_ERROR =>
         raise;
      when OTHERS =>
         ERROR_LOGGING (UNKNOWN, "OPEN_WS");          -- Error 2501
         raise;

end OPEN_WS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:PLIN_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: POLYLINE
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  plin_s.ada
-- level: all levels

separate (OUTPUT_PRIMITIVES)

procedure POLYLINE
   (LINE_POINTS : in WC.POINT_ARRAY) is

-- This procedure first inquires the GKS_OPERATING_STATE_LIST
-- to check if GKS is in state WSAC or SGOP.  If it is not,
-- error 5 occurs and the exception STATE_ERROR is raised.  In
-- addition, it checks if the number of points is invalid.  If
-- so, error 100 occurs and the exception OUTPUT_PRIMITIVE_ERROR
-- is raised.  Otherwise, this procedure performs a normalization
-- transformation on the world coordinate points passed in and
-- passes the normalized device coordinates that result to the
-- workstation manager to draw a sequence of connected straight
-- lines.
--
-- LINE_POINTS - Provides the array of world coordinate points.

GKS_INSTR : CGI_POLYLINE;

NDC_POINTS : NDC.POINT_ARRAY(1..LINE_POINTS'LENGTH);
-- The above type was created to hold the transformed points.

begin

   -- The following if structure inquires the GKS_OPERATING_STATE_
   -- LIST to see if GKS is in the proper state. Then it checks to
   -- see that the number of points is valid before calling the
   -- WS_MANAGER.

   if (CURRENT_OPERATING_STATE /= WSAC) and
      (CURRENT_OPERATING_STATE /= SGOP) then
      ERROR_LOGGING (NOT_WSAC_SGOP, "POLYLINE");            -- Error 5
      raise STATE_ERROR;

   elsif LINE_POINTS'LENGTH < 2 then
      ERROR_LOGGING (INVALID_NUMBER_OF_POINTS, "POLYLINE"); -- Error 100
      raise OUTPUT_PRIMITIVE_ERROR;

   else

      -- The following logic will perform a transformation on the
      -- points from world coordinates to normalized device coordinates.

      NDC_POINTS := TRANSFORMATION_MATH.WC_TO_NDC (GKS_STATE_LIST.
                    LIST_OF_NORMALIZATION_TRANSFORMATIONS
                   (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
                   .NDC_FACTORS, LINE_POINTS);

      GKS_INSTR.LINE_POINTS := new NDC.POINT_ARRAY'(NDC_POINTS);

      WS_MANAGER (GKS_INSTR);

      FREE_POINT_ARRAY (GKS_INSTR.LINE_POINTS);

   end if;

   exception
      when STATE_ERROR =>
         raise;
      when OUTPUT_PRIMITIVE_ERROR =>
         raise;
      when NUMERIC_ERROR =>
         ERROR_LOGGING (ARITHMETIC, "POLYLINE");          -- Error 308
         raise SYSTEM_ERROR;
      when OTHERS =>
         ERROR_LOGGING (UNKNOWN, "POLYLINE");             -- Error 2501
         raise;

end POLYLINE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:PMRK_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: POLYMARKER
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  pmrk_s.ada
-- level: all levels

separate (OUTPUT_PRIMITIVES)

procedure POLYMARKER
   (MARKER_POINTS : in WC.POINT_ARRAY) is

-- This procedure first inquires the GKS_OPERATING_STATE_LIST
-- to check if GKS is in state WSAC or SGOP.  If it is not,
-- error 5 occurs and the exception STATE_ERROR is raised.  In
-- addition, it checks if the number of points is invalid.  If
-- so, error 100 occurs and the exception OUTPUT_PRIMITIVE_ERROR
-- is raised.  Otherwise, this procedure performs a normalization
-- transformation on the world coordinate points passed in and
-- passes the normalized device coordinates that result to the
-- workstation manager to draw a sequence of markers.
--
-- MARKER_POINTS - Provides the array of world coordinate points.

GKS_INSTR : CGI_POLYMARKER;

NDC_POINTS : NDC.POINT_ARRAY(1..MARKER_POINTS'LENGTH);
-- The above type was created to hold the transformed points.

begin

   -- The following if structure inquires the GKS_OPERATING_STATE_
   -- LIST to see if GKS is in the proper state. Then it checks to
   -- see that the number of points is valid before calling the
   -- WS_MANAGER.

   if (CURRENT_OPERATING_STATE /= WSAC) and
      (CURRENT_OPERATING_STATE /= SGOP) then
      ERROR_LOGGING (NOT_WSAC_SGOP, "POLYMARKER");  -- Error 5
      raise STATE_ERROR;

   elsif MARKER_POINTS'LENGTH < 1 then
      ERROR_LOGGING (INVALID_NUMBER_OF_POINTS, "POLYMARKER");-- Error 100
      raise OUTPUT_PRIMITIVE_ERROR;

   else

      -- The following logic will perform a transformation on the
      -- points from world coordinates to normalized device coordinates.
      NDC_POINTS := TRANSFORMATION_MATH.WC_TO_NDC (GKS_STATE_LIST.
                    LIST_OF_NORMALIZATION_TRANSFORMATIONS
                   (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
                   .NDC_FACTORS, MARKER_POINTS);

      GKS_INSTR.MARKER_POINTS := new NDC.POINT_ARRAY'(NDC_POINTS);

      WS_MANAGER (GKS_INSTR);

      FREE_POINT_ARRAY (GKS_INSTR.MARKER_POINTS);

   end if;

   exception
      when STATE_ERROR =>
         raise;
      when OUTPUT_PRIMITIVE_ERROR =>
         raise;
      when NUMERIC_ERROR =>
         ERROR_LOGGING (ARITHMETIC, "POLYMARKER");         -- Error 308
         raise SYSTEM_ERROR;
      when OTHERS =>
         ERROR_LOGGING (UNKNOWN, "POLYMARKER");            -- Error 2501
         raise;

end POLYMARKER;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:TXT_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: TEXT
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  txt_s.ada
-- levels: all levels

separate (OUTPUT_PRIMITIVES)

procedure TEXT
   (POSITION   : in WC.POINT;
   TEXT_STRING : in STRING) is

-- This procedure first inquires the GKS_OPERATING_STATE_LIST
-- to check if GKS is in one of the states WSAC or SGOP.  If
-- it is not, error 5 occurs and the exception STATE_ERROR is
-- raised.  Otherwise, the procedure does a normalization
-- transformation on the world coordinate point passed in
-- as the text position.  The resulting normalized device
-- coordinates and the text string are passed to the work-
-- station manager to be clipped and generated on the output.
-- If the WS_MANAGER returns error_indicator 101, this procedure
-- will raise the exception OUTPUT_PRIMITIVE_ERROR.
--
-- POSITION - This is a point in world coordinates at which the
--    text begins.
-- TEXT_STRING - This is text to be displayed.

GKS_INSTR : CGI_TEXT;

begin

   -- The following if structure inquires the GKS_OPERATING_STATE_
   -- LIST to see if GKS is in the proper state.

   if (CURRENT_OPERATING_STATE /= WSAC) and
      (CURRENT_OPERATING_STATE /= SGOP) then
      ERROR_LOGGING (NOT_WSAC_SGOP, "TEXT");    -- Error 5
      raise STATE_ERROR;

   else
      GKS_INSTR.TEXT_STRING := new STRING'(TEXT_STRING);

      -- The following logic will perform a transformation on the
      -- point from world coordinates to normalized device coordinates.

      GKS_INSTR.TEXT_POSITION := TRANSFORMATION_MATH.WC_TO_NDC
         (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
         (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
         .NDC_FACTORS, POSITION);

      WS_MANAGER (GKS_INSTR);

      FREE_STRING (GKS_INSTR.TEXT_STRING);

      if GKS_INSTR.EI /= SUCCESSFUL then              -- Error 0
         if GKS_INSTR.EI = INVALID_STRING_CODE then   -- Error 101
            ERROR_LOGGING (GKS_INSTR.EI, "TEXT");
            raise OUTPUT_PRIMITIVE_ERROR;

       end if;
      end if;

   end if;

   exception
      when STATE_ERROR =>
         raise;
      when OUTPUT_PRIMITIVE_ERROR =>
         raise;
      when NUMERIC_ERROR =>
         ERROR_LOGGING (ARITHMETIC, "TEXT");          -- Error 308
         raise SYSTEM_ERROR;
      when OTHERS =>
         ERROR_LOGGING (UNKNOWN, "TEXT");             -- Error 2501
         raise;

end TEXT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:UP_WS_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: UPDATE_WS
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  up_ws_s.ada
-- level: all levels

separate (WS_CONTROL)

procedure UPDATE_WS
   (WS          : in WS_ID;
   REGENERATION : in UPDATE_REGENERATION_FLAG) is

-- This procedure first inquires the GKS_OPERATING_STATE_LIST
-- to check if GKS is states WSOP, WSAC, or SGOP.  If it is not
-- then error 7 occurs, and the exception STATE_ERROR is raised.
-- Then this procedure inquires the GKS_STATE_LIST to see if the
-- WS is open.  If it is not, error 25 occurs and the exception
-- WS_ERROR is raised.
--
-- Otherwise, this procedure calls the workstation manager to
-- update the workstation.  If the workstation manager returns
-- error 33, 35, or 36 this procedure raises the exception WS_ERROR.
--
-- WS - This is the identifier of the workstation that is
--    to be updated.
-- REGENERATION - This flag may have one of two values, PERFORM
--    or POSTPONE to indicate the regeneration action on the
--    display.

GKS_INSTR : CGI_UPDATE_WS;

begin

   -- The following if structure inquires the GKS_OPERATING_STATE_
   -- LIST to see if GKS is in the proper state. Then it inquires
   -- the GKS_STATE_LIST to see if the WS is in the set of open
   -- workstations before calling the WS_MANAGER.

   if (CURRENT_OPERATING_STATE = GKCL) or
      (CURRENT_OPERATING_STATE = GKOP) then
      ERROR_LOGGING (NOT_WSOP_WSAC_SGOP, "UPDATE_WS");  -- Error 7
      raise STATE_ERROR;

   elsif not WS_IDS.IS_IN_LIST(WS, GKS_STATE_LIST.LIST_OF_OPEN_WS) then
      ERROR_LOGGING (WS_NOT_OPEN, "UPDATE_WS");         -- Error 25
      raise WS_ERROR;

   else
      GKS_INSTR.WS_TO_UPDATE := WS;
      GKS_INSTR.REGENERATION := REGENERATION;
      WS_MANAGER (GKS_INSTR);

      if GKS_INSTR.EI /= SUCCESSFUL then               -- Error 0
         if (GKS_INSTR.EI = WS_CATEGORY_IS_MI) or      -- Error 33
            (GKS_INSTR.EI = WS_CATEGORY_IS_INPUT) or   -- Error 35
            (GKS_INSTR.EI = WS_IS_WISS) then           -- Error 36
            ERROR_LOGGING (GKS_INSTR.EI, "UPDATE_WS");
            raise WS_ERROR;
         end if;

      end if;

   end if;

  exception
     when STATE_ERROR =>
        raise;
     when WS_ERROR =>
        raise;
     when SYSTEM_ERROR =>
        ERROR_LOGGING (ARITHMETIC,"UPDATE_WS");       -- Error 308
        raise;
     when OTHERS =>
        ERROR_LOGGING (UNKNOWN, "UPDATE_WS");         -- Error 2501
        raise;

end UPDATE_WS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:A_CLIP_UTILITIES_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: AREA_CLIPPING_UTILITIES - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : WSR_UTILITIES_B.ADA
-- LEVEL : all

separate (WSR_UTILITIES)

package body AREA_CLIPPING_UTILITIES is

-- This package contains all of the types and procedures needed by the
-- clipping algorithm for the FILL_AREA.

   type LINE;

   type LIST_OF_LINES is access LINE;

   type LINE is
      record
         POINTS    : DC.POINT_LIST;
         NEXT_LINE : LIST_OF_LINES;
      end record;
   -- These types define a linked list of lines. They are used to
   -- return the results of clipping an area because the area may
   -- be clipped into more than one area.

   subtype INTERSECTION_LIST is DC.POINT_LIST;

   procedure BEGIN_NEW_INTERIOR_LINE
      (FIRST_POINT   : in DC.POINT;
       INTERIOR_LINE : in out LIST_OF_LINES) is separate;

   procedure ADD_TO_INTERIOR_LINE
      (NEXT_POINT    : in DC.POINT;
       INTERIOR_LINE : in out LIST_OF_LINES) is separate;

   procedure ADD_TO_EDGE_LIST
      (INTERSECTION_POINT : in DC.POINT;
       EDGE_LIST          : in out INTERSECTION_LIST) is separate;

   procedure SORT_EDGE_LIST_BY_INCREASING_X_VALUE
      (EDGE_LIST : in out INTERSECTION_LIST) is separate;

   procedure SORT_EDGE_LIST_BY_INCREASING_Y_VALUE
      (EDGE_LIST : in out INTERSECTION_LIST) is separate;

   procedure PAIR_UP_EDGE_POINTS_ADD_LINES_TO_LIST_OF_INTERIOR_LINES
      (EDGE_LIST           : in INTERSECTION_LIST;
       CLIPPED_POINTS_LIST : in out LIST_OF_LINES) is separate;

   procedure JOIN_LINES_TO_FORM_AREAS
      (LINES : in out LIST_OF_LINES;
       AREAS : in out LIST_OF_AREAS) is separate;

   procedure CLIP_ON_RIGHT
      (INPUT_AREA    : in DC.POINT_ARRAY;
       RIGHT_BORDER  : in DC_TYPE;
       CLIPPED_AREAS : in out LIST_OF_AREAS) is separate;

   procedure CLIP_ON_BOTTOM
      (INPUT_AREA    : in DC.POINT_ARRAY;
       BOTTOM_BORDER : in DC_TYPE;
       CLIPPED_AREAS : in out LIST_OF_AREAS) is separate;

   procedure CLIP_ON_LEFT
      (INPUT_AREA    : in DC.POINT_ARRAY;
       LEFT_BORDER   : in DC_TYPE;
       CLIPPED_AREAS : in out LIST_OF_AREAS)is separate;

   procedure CLIP_ON_TOP
      (INPUT_AREA    : in DC.POINT_ARRAY;
       TOP_BORDER    : in DC_TYPE;
       CLIPPED_AREAS : in out LIST_OF_AREAS) is separate;

end AREA_CLIPPING_UTILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:A_ADD_EDGES.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: A_ADD_EDGES
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : A_ADD_EDGES.ADA
-- LEVEL : all

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES)

procedure PAIR_UP_EDGE_POINTS_ADD_LINES_TO_LIST_OF_INTERIOR_LINES
   (EDGE_LIST           : in INTERSECTION_LIST;
    CLIPPED_POINTS_LIST : in out LIST_OF_LINES) is

-- This procedure removes the points from the edge list two points at a
-- time. The two points are made into a line and added to the end of the
-- list of lines.
--
-- EDGE_LIST           - the list of points to be consumed.
-- CLIPPED_POINTS_LIST - the list of line segments which is being
--                       augmented.

   LINE_SEGMENT : DC.POINT_LIST (LENGTH => 2);
   -- Contains the border line being added to the list.

   NEW_CLIPPED_POINTS_LIST : LIST_OF_LINES;
   -- Points to the newly augmented list.

   POINT_NUMBER : NATURAL := 1;
   -- A counter through the EDGE_LIST beginning at the first point.

begin

   -- Take pairs of points off of the EDGE_LIST until it is all gone.
   while POINT_NUMBER < EDGE_LIST.LENGTH loop

      -- Put the next two points in the EDGE_LIST into the LINE_SEGMENT.
      LINE_SEGMENT.POINTS :=
         EDGE_LIST.POINTS (POINT_NUMBER .. POINT_NUMBER + 1);

      -- Get a new record and put the new LINE_SEGMENT in it and put it
      -- at the beginning of the OUTPUT_LIST.
      NEW_CLIPPED_POINTS_LIST := new LINE'
         (POINTS => LINE_SEGMENT,
          NEXT_LINE => CLIPPED_POINTS_LIST);

      -- Update the value of CLIPPED_POINTS_LIST.
      CLIPPED_POINTS_LIST := NEW_CLIPPED_POINTS_LIST;

      -- Go on to the next pair of points.
      POINT_NUMBER := POINT_NUMBER + 2;

   end loop;

end PAIR_UP_EDGE_POINTS_ADD_LINES_TO_LIST_OF_INTERIOR_LINES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:A_ADD_INTERIOR.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: ADD_TO_INTERIOR_LINE
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : A_ADD_INTERIOR.ADA
-- LEVEL : all

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES)

procedure ADD_TO_INTERIOR_LINE
   (NEXT_POINT    : in DC.POINT;
    INTERIOR_LINE : in out LIST_OF_LINES) is

-- This procedure adds the NEXT_POINT onto the end of the current
-- interior line.
--
-- NEXT_POINT    - the point to be added onto the list.
-- INTERIOR_LINE - the line being added to.

   NEW_POINT_ARRAY :
      DC.POINT_ARRAY (1 .. INTERIOR_LINE.POINTS.LENGTH + 1);
   -- The new line, one point longer than the original line.

begin

   -- Put the original points at the beginning of the new line.
   NEW_POINT_ARRAY (1 .. INTERIOR_LINE.POINTS.LENGTH) :=
      INTERIOR_LINE.POINTS.POINTS;

   -- Put the new point at the end of the new line.
   NEW_POINT_ARRAY (INTERIOR_LINE.POINTS.LENGTH + 1) := NEXT_POINT;

   -- Assign the new list to the out parameter, changing the length at
   -- the same time as the array is changed.
   INTERIOR_LINE.POINTS :=
      (INTERIOR_LINE.POINTS.LENGTH + 1, NEW_POINT_ARRAY);

end ADD_TO_INTERIOR_LINE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:A_ADD_TO_EDGE_LIST.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: ADD_TO_EDGE_LIST
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : A_ADD_TO_EDGE_LIST.ADA
-- LEVEL : all

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES)

procedure ADD_TO_EDGE_LIST
   (INTERSECTION_POINT : in DC.POINT;
    EDGE_LIST          : in out INTERSECTION_LIST) is

-- This procedure adds the given point onto the end of the intersection
-- list.
--
-- INTERSECTION_POINT - the new point to be added to the list.
-- EDGE_LIST          - the list being added to.

   NEW_EDGE_LIST : DC.POINT_ARRAY (1 .. EDGE_LIST.LENGTH + 1);
   -- The new list is defined to be one item longer than the input list.

begin

   -- Put the old points at the beginning of the new list.
   NEW_EDGE_LIST (1 .. EDGE_LIST.LENGTH) := EDGE_LIST.POINTS;

   -- Put the new point at the end of the list.
   NEW_EDGE_LIST (EDGE_LIST.LENGTH + 1) := INTERSECTION_POINT;

   -- Assign the new list to the out parameter, changing the length at
   -- the same time as the array is changed.
   EDGE_LIST := (EDGE_LIST.LENGTH + 1, NEW_EDGE_LIST);

end ADD_TO_EDGE_LIST;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:A_BEGIN_INTERIOR.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: BEGIN_NEW_INTERIOR_LINE
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : A_BEGIN_INTERIOR.ADA
-- LEVEL : all

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES)

procedure BEGIN_NEW_INTERIOR_LINE
   (FIRST_POINT   : in DC.POINT;
    INTERIOR_LINE : in out LIST_OF_LINES) is

-- This procedure starts a new interior line which only contains one
-- point, FIRST_POINT. The procedure puts the new line at the beginning
-- of the list of interior lines.
--
-- FIRST_POINT   - the sole point in the new line.
-- INTERIOR_LINE - the linked list of interior lines.

   NEW_LINE : LIST_OF_LINES;
   -- Points to the new line.

   NEW_POINT_LIST : DC.POINT_LIST :=
       (LENGTH => 1, POINTS => (1 => FIRST_POINT));
   -- Contains the point which makes up the new line.

begin

   NEW_LINE := new LINE'
      (POINTS => NEW_POINT_LIST, NEXT_LINE => INTERIOR_LINE);

   INTERIOR_LINE := NEW_LINE;

end BEGIN_NEW_INTERIOR_LINE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:A_JOIN_LINES.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: JOIN_LINES_TO_FORM_AREAS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : A_JOIN_LINES.ADA
-- LEVEL : all

with UNCHECKED_DEALLOCATION;

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES)

procedure JOIN_LINES_TO_FORM_AREAS
   (LINES : in out LIST_OF_LINES;
    AREAS : in out LIST_OF_AREAS) is

-- This procedure takes in a list of line segments. It joins up the
-- segments into areas by finding endpoints that match.
--
-- LINES - the lines to be joined.
-- AREAS - the result of joining the lines.

   NEW_AREA : LIST_OF_AREAS;
   -- Holds the newest area being worked on.

   procedure DISPOSE is new UNCHECKED_DEALLOCATION
      (OBJECT => LINE, NAME => LIST_OF_LINES);
   -- This procedure is used to get rid of the lines once they have been
   -- processed.

   USED_LINE : LIST_OF_LINES;
   -- Contains a line before it is disposed of.

   NEXT_LINE_SEGMENT : DC.POINT_LIST;
   -- Contains the next line to be added to the list of ACCUMULATED_
   -- AREAS.

   function "=" (LEFT, RIGHT : DC.POINT)
      return BOOLEAN renames DC."=";
   -- Make the procedure for equality local for use in infix notation.

   procedure SEPARATE_OUT_NEXT_LINE_SEGMENT
      (LIST_OF_SEGMENTS  : in out LIST_OF_LINES;
       COMMON_POINT      : in DC.POINT;
       NEXT_LINE_SEGMENT : in out DC.POINT_LIST) is separate;

begin


   while LINES /= null loop

      -- Begin a NEW_AREA with the first set of lines on the list.
      -- Join the NEW_AREA onto the front of the list of ACCUMULATED_
      -- AREAS.
      NEW_AREA := new AREA' (BORDER => LINES.POINTS,
         NEXT_AREA => AREAS);
      AREAS := NEW_AREA;

      -- Remove the used line from the list of lines and dispose of the
      -- used line.
      USED_LINE := LINES;
      LINES := LINES.NEXT_LINE;
      DISPOSE (USED_LINE);

      -- Repeat until the area has been closed up.
      while not (AREAS.BORDER.POINTS(1) =
         AREAS.BORDER.POINTS (AREAS.BORDER.LENGTH)) loop

         -- Find a line which has an endpoint that matches the current
         -- point. Remove that line from the list of lines.
         SEPARATE_OUT_NEXT_LINE_SEGMENT (LINES,
            AREAS.BORDER.POINTS (1), NEXT_LINE_SEGMENT);

         declare

            TOTAL_LENGTH : constant POSITIVE := AREAS.BORDER.LENGTH +
               NEXT_LINE_SEGMENT.LENGTH;

            ARRAY_OF_POINTS : DC.POINT_ARRAY (1 .. TOTAL_LENGTH);
            -- This variable will hold all of the current area.

         begin

            -- Put the new segment at the beginning of the new area.
            ARRAY_OF_POINTS (1 .. NEXT_LINE_SEGMENT.LENGTH) :=
               NEXT_LINE_SEGMENT.POINTS;

            -- Put the old part of the area at the end of the list.
            ARRAY_OF_POINTS (NEXT_LINE_SEGMENT.LENGTH + 1 ..
               TOTAL_LENGTH) := AREAS.BORDER.POINTS;

            -- Update the current area.
            AREAS.BORDER := (TOTAL_LENGTH, ARRAY_OF_POINTS);

         end;

      end loop;

   end loop;

end JOIN_LINES_TO_FORM_AREAS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:A_SEP_NEXT_SEGMENT.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SEPARATE_OUT_NEXT_LINE_SEGMENT
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : A_SEP_NEXT_SEGMENT.ADA
-- LEVEL : all

with UNCHECKED_DEALLOCATION;

separate
   (WSR_UTILITIES.AREA_CLIPPING_UTILITIES.JOIN_LINES_TO_FORM_AREAS)

procedure SEPARATE_OUT_NEXT_LINE_SEGMENT
   (LIST_OF_SEGMENTS  : in out LIST_OF_LINES;
    COMMON_POINT      : in DC.POINT;
    NEXT_LINE_SEGMENT : in out DC.POINT_LIST) is

-- This procedure searches through the LIST_OF_SEGMENTS looking for a
-- segment whose first or last point is the same as the COMMON_POINT.
-- When it is found the line segment is returned in NEXT_LINE_SEGMENT
-- with the COMMON_POINT as the last point, and the line segment is
-- removed from the LIST_OF_SEGMENTS.
--
-- LIST_OF_SEGMENTS  - the list of segments being searched through.
-- COMMON_POINT      - the point being searched for.
-- NEXT_LINE_SEGMENT - the segment which matches.

   PREVIOUS_SEGMENT : LIST_OF_LINES := null;
   -- A pointer to the line segment previous to the one currently under
   -- consideration.

   CURRENT_SEGMENT : LIST_OF_LINES := LIST_OF_SEGMENTS;
   -- A pointer to the line segment currently under consideration.

   procedure DISPOSE is new UNCHECKED_DEALLOCATION
      (OBJECT => LINE, NAME => LIST_OF_LINES);
   -- Used to dispose of a pointer to a line segment after the data has
   -- been returned in NEXT_LINE_SEGMENT;

   function "=" (FIRST, LAST : DC.POINT) return BOOLEAN
      renames DC."=";

   function INVERT_POINTS (ORIGINAL_POINTS : in DC.POINT_ARRAY)
      return DC.POINT_ARRAY is

   -- This function is used for inverting the order of the points in an
   -- array.

      TEMPORARY_ARRAY : DC.POINT_ARRAY(ORIGINAL_POINTS'RANGE);
      -- Holds the inverted value of the ORIGINAL_POINTS while they are
      -- being swapped.

   begin

      for I in ORIGINAL_POINTS'RANGE loop
         TEMPORARY_ARRAY (ORIGINAL_POINTS'LAST + 1 - I)
            := ORIGINAL_POINTS (I);
      end loop;

      return TEMPORARY_ARRAY;

   end INVERT_POINTS;

begin

   -- Search until a match is found with an endpoint of a segment.
   while not (COMMON_POINT = CURRENT_SEGMENT.POINTS.POINTS (1)) and
      not (COMMON_POINT = CURRENT_SEGMENT.POINTS.POINTS
      (CURRENT_SEGMENT.POINTS.POINTS'LAST)) loop

      PREVIOUS_SEGMENT := CURRENT_SEGMENT;
      CURRENT_SEGMENT := CURRENT_SEGMENT.NEXT_LINE;

   end loop;

   -- Put the segment into NEXT_LINE_SEGMENT with the matching point
   -- as the last point of the array.
   if not (COMMON_POINT = CURRENT_SEGMENT.POINTS.POINTS (1)) then

      NEXT_LINE_SEGMENT := CURRENT_SEGMENT.POINTS;

   else
      NEXT_LINE_SEGMENT := (CURRENT_SEGMENT.POINTS.LENGTH,
         INVERT_POINTS (CURRENT_SEGMENT.POINTS.POINTS));

   end if;

   -- Remove the used line segment from the list of segments.
   if PREVIOUS_SEGMENT /= null then
      PREVIOUS_SEGMENT.NEXT_LINE := CURRENT_SEGMENT.NEXT_LINE;
   else
      LIST_OF_SEGMENTS := CURRENT_SEGMENT.NEXT_LINE;
   end if;

   -- Return its storage space to the heap.
   DISPOSE (CURRENT_SEGMENT);

   -- Delete the matching point from the end of the list of points.
   NEXT_LINE_SEGMENT := (NEXT_LINE_SEGMENT.LENGTH - 1,
      NEXT_LINE_SEGMENT.POINTS (1 .. NEXT_LINE_SEGMENT.LENGTH - 1));

end SEPARATE_OUT_NEXT_LINE_SEGMENT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:A_SORT_BY_X.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SORT_EDGE_LIST_BY_INCREASING_X_VALUE
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : A_SORT_BY_X.ADA
-- LEVEL : all

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES)

procedure SORT_EDGE_LIST_BY_INCREASING_X_VALUE
   (EDGE_LIST : in out INTERSECTION_LIST) is

-- This procedure performs a simple sort on the list of points based
-- upon the value of their X coordinate. It sorts from smallest to
-- largest.
--
-- EDGE_LIST - the list of points to be sorted.

   TEMPORARY_POINT : DC.POINT;
   -- This is a temporary holding place used for swapping points.

begin

   -- One pass through this loop will place one point in the correct
   -- position.
   for STATIONARY_POINT in 1 .. EDGE_LIST.LENGTH - 1 loop

      -- Compare each of the remaining points with the STATIONARY_POINT.
      for LATER_POINT in STATIONARY_POINT + 1 .. EDGE_LIST.LENGTH loop

         -- Swap the two points if the first one is not the smaller.
         if EDGE_LIST.POINTS (LATER_POINT).X <
            EDGE_LIST.POINTS (STATIONARY_POINT).X then

            TEMPORARY_POINT := EDGE_LIST.POINTS (STATIONARY_POINT);
            EDGE_LIST.POINTS (STATIONARY_POINT) :=
               EDGE_LIST.POINTS (LATER_POINT);
            EDGE_LIST.POINTS (LATER_POINT) := TEMPORARY_POINT;
         end if;

      end loop;

   end loop;

end SORT_EDGE_LIST_BY_INCREASING_X_VALUE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:A_SORT_BY_Y.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SORT_EDGE_LIST_BY_INCREASING_Y_VALUE
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : A_SORT_BY_Y.ADA
-- LEVEL : all

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES)

procedure SORT_EDGE_LIST_BY_INCREASING_Y_VALUE
   (EDGE_LIST : in out INTERSECTION_LIST) is

-- This procedure performs a simple sort on the list of points based
-- upon the value of their Y coordinates. It sorts from smallest to
-- largest.
--
-- EDGE_LIST - the list of points to be sorted.

   TEMPORARY_POINT : DC.POINT;
   -- This is a temporary holding place used for swapping points.

begin

   -- One pass through this loop will place one point in the correct
   -- position.
   for STATIONARY_POINT in 1 .. EDGE_LIST.LENGTH - 1 loop

      -- Compare each of the remaining points with the STATIONARY_POINT.
      for LATER_POINT in STATIONARY_POINT + 1 .. EDGE_LIST.LENGTH loop

         -- Swap the two points if the first one is not the smaller.
         if EDGE_LIST.POINTS (LATER_POINT).Y <
            EDGE_LIST.POINTS (STATIONARY_POINT).Y then

            TEMPORARY_POINT := EDGE_LIST.POINTS (STATIONARY_POINT);
            EDGE_LIST.POINTS (STATIONARY_POINT) :=
               EDGE_LIST.POINTS (LATER_POINT);
            EDGE_LIST.POINTS (LATER_POINT) := TEMPORARY_POINT;
         end if;

      end loop;

   end loop;

end SORT_EDGE_LIST_BY_INCREASING_Y_VALUE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:CLIP_ON_BOTTOM.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CLIP_ON_BOTTOM
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : CLIP_ON_BOTTOM.ADA
-- LEVEL : all

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES)

procedure CLIP_ON_BOTTOM
   (INPUT_AREA     : in DC.POINT_ARRAY;
    BOTTOM_BORDER  : in DC_TYPE;
    CLIPPED_AREAS  : in out LIST_OF_AREAS) is

-- This procedure clips the points to the bottom border of the clipping
-- rectangle. The input list is clipped at the line Y = BOTTOM_BORDER
-- and zero or more areas are returned.
--
-- INPUT_AREA    - the list of points to be clipped.
-- BOTTOM_BORDER - the Y value of the bottom edge of the clipping
--                 rectangle.
-- CLIPPED_AREAS - the resulting areas.

   BOTTOM_EDGE_LIST : INTERSECTION_LIST;
   -- This holds a list of all the intersections points with the bottom
   -- edge of the clipping rectangle.

   INTERIOR_POINT_LISTS : LIST_OF_LINES := null;
   -- This is a list of the line segments which are interior to the
   -- clipping rectangle.

   procedure BOTTOM_SUTHERLAND_AND_HODGMAN
      (INPUT_AREA      : in DC.POINT_ARRAY;
       BOTTOM_BORDER   : in DC_TYPE;
       INTERSECTIONS   : in out INTERSECTION_LIST;
       INTERIOR_POINTS : in out LIST_OF_LINES) is separate;

begin

   -- Perform the first stage of the Sutherland and Hodgman algorithm
   -- as outlined in Foley and Van Dam except for one addition. Instead
   -- of joining the intersection points to the interior lines in the
   -- order that they were generated, keep a separate list of each of
   -- the interior line segments and the intersection points.
   BOTTOM_SUTHERLAND_AND_HODGMAN (INPUT_AREA, BOTTOM_BORDER,
      BOTTOM_EDGE_LIST, INTERIOR_POINT_LISTS);

   -- Put the list of edges into the order that they are connected to
   -- each other.
   SORT_EDGE_LIST_BY_INCREASING_X_VALUE (BOTTOM_EDGE_LIST);

   -- Make lines out of adjacent intersection points. Put the lines onto
   -- the list of lines formed in the first step.
   PAIR_UP_EDGE_POINTS_ADD_LINES_TO_LIST_OF_INTERIOR_LINES
      (BOTTOM_EDGE_LIST, INTERIOR_POINT_LISTS);

   -- Find which lines in the list connect with which lines and join
   -- them together to form areas.
   JOIN_LINES_TO_FORM_AREAS (INTERIOR_POINT_LISTS, CLIPPED_AREAS);

end CLIP_ON_BOTTOM;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:BOTTOM_S_AND_H.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: BOTTOM_SUTHERLAND_AND_HODGMAN
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : BOTTOM_S_AND_H.ADA
-- LEVEL : all

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES.CLIP_ON_BOTTOM)

procedure BOTTOM_SUTHERLAND_AND_HODGMAN
   (INPUT_AREA      : in DC.POINT_ARRAY;
    BOTTOM_BORDER   : in DC_TYPE;
    INTERSECTIONS   : in out INTERSECTION_LIST;
    INTERIOR_POINTS : in out LIST_OF_LINES) is

-- This procedure performs the Sutherland and Hodgman algorithm on one
-- side of the clipping rectangle. It is different from the standard
-- algorithm in that it does not return a single list of points. A
-- single list of points is not adaquate because multiple areas cannot
-- be represented as a single list of points. This procedure gets
-- around this flaw by returning a list of those line segments which
-- are interior to the clipping rectangle and a list of the intersection
-- points.
--
-- INPUT_AREA      - the list of points to be clipped.
-- BOTTOM_BORDER   - the X value of the right edge of the clipping
--                   rectangle.
-- INTERSECTIONS   - a list of the points where the input line crosses
--                   the bottom edge of the clipping rectangle.
-- INTERIOR_POINTS - a linked list of lines interior to the clipping
--                   rectangle. It is made up of points from the
--                   original INPUT_AREA plus the intersection points.

   FIRST_POINT : POSITIVE := 1;
   -- This variable is an index into the INPUT_AREA. Processing begins
   -- with the line segment connecting the first point of INPUT_AREA
   -- with the second point.

   INTERSECTION_POINT : DC.POINT;
   -- A point where the INPUT_AREA crosses over the border of the
   -- clipping rectangle.

   function FIND_INTERSECTION
      (FIRST_POINT  : DC.POINT;
       SECOND_POINT : DC.POINT;
       Y_VALUE      : DC_TYPE) return DC_TYPE is

   -- This function returns the Y value of the point where the line
   -- segment connecting the FIRST_POINT with the SECOND_POINT crosses
   -- the line defined by X = X_VALUE.

   begin

      return FIRST_POINT.X - ((FIRST_POINT.Y - Y_VALUE) *
         (FIRST_POINT.X - SECOND_POINT.X)) /
         (FIRST_POINT.Y - SECOND_POINT.Y);

   end FIND_INTERSECTION;

begin

   -- If the point is inside of the clipping area, put it on the list
   -- of interior points.
   if INPUT_AREA (FIRST_POINT).Y >= BOTTOM_BORDER then
      BEGIN_NEW_INTERIOR_LINE (INPUT_AREA (FIRST_POINT),
         INTERIOR_POINTS);
   end if;

   -- Repeat with each of the line segments in the list beginning with
   -- the line segment joining the first point to the second point and
   -- continuing with all the other line segments.
   for SECOND_POINT in 2 .. INPUT_AREA'LAST loop

      -- If the second point is inside.
      if INPUT_AREA (SECOND_POINT).Y >= BOTTOM_BORDER then

         -- If the line segment is inside to inside, put the second
         -- point on the list of interior points.
         if INPUT_AREA (FIRST_POINT).Y >= BOTTOM_BORDER then

            ADD_TO_INTERIOR_LINE (INPUT_AREA (SECOND_POINT),
               INTERIOR_POINTS);

         -- If the line segment is outside to inside, put the point
         -- where the line intersects the edge onto the list of
         -- intersections. Also begin a new interior line with the
         -- intersection point and the interior point.
         else

            INTERSECTION_POINT := (X => FIND_INTERSECTION
               (INPUT_AREA (FIRST_POINT), INPUT_AREA (SECOND_POINT),
                BOTTOM_BORDER), Y => BOTTOM_BORDER);

            ADD_TO_EDGE_LIST (INTERSECTION_POINT, INTERSECTIONS);

            BEGIN_NEW_INTERIOR_LINE (INTERSECTION_POINT,
               INTERIOR_POINTS);

            ADD_TO_INTERIOR_LINE (INPUT_AREA (SECOND_POINT),
               INTERIOR_POINTS);

         end if;

      -- If the line segment is inside to outside, put the point of
      -- intersection onto the list of intersections. Also put the
      -- intersection point onto the list of interior points. (It will
      -- be the last point put on to the current interior line segment.)
      elsif INPUT_AREA (FIRST_POINT).Y >= BOTTOM_BORDER then

         INTERSECTION_POINT := (X => FIND_INTERSECTION
            (INPUT_AREA (FIRST_POINT), INPUT_AREA (SECOND_POINT),
             BOTTOM_BORDER), Y => BOTTOM_BORDER);

         ADD_TO_EDGE_LIST (INTERSECTION_POINT, INTERSECTIONS);

         ADD_TO_INTERIOR_LINE (INTERSECTION_POINT, INTERIOR_POINTS);

      -- If the line segment is outside to outside, do nothing.
      end if;

      FIRST_POINT := SECOND_POINT;

   end loop;

end BOTTOM_SUTHERLAND_AND_HODGMAN;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:CLIP_ON_LEFT.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CLIP_ON_LEFT
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : CLIP_ON_LEFT.ADA
-- LEVEL : all

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES)

procedure CLIP_ON_LEFT
   (INPUT_AREA    : in DC.POINT_ARRAY;
    LEFT_BORDER   : in DC_TYPE;
    CLIPPED_AREAS : in out LIST_OF_AREAS) is

-- This procedure clips the points to the left border of the clipping
-- rectangle. The input list is clipped at the line X = LEFT_BORDER
-- and zero or more areas are returned.
--
-- INPUT_AREA    - the list of points to be clipped.
-- LEFT_BORDER   - the X value of the left edge of the clipping
--                 rectangle.
-- CLIPPED_AREAS - the resulting areas.

   LEFT_EDGE_LIST : INTERSECTION_LIST;
   -- This holds a list of all the intersections points with the left
   -- edge of the clipping rectangle.

   INTERIOR_POINT_LISTS : LIST_OF_LINES := null;
   -- This is a list of the line segments which are interior to the
   -- clipping rectangle.

   procedure LEFT_SUTHERLAND_AND_HODGMAN
      (INPUT_AREA      : in DC.POINT_ARRAY;
       LEFT_BORDER     : in DC_TYPE;
       INTERSECTIONS   : in out INTERSECTION_LIST;
       INTERIOR_POINTS : in out LIST_OF_LINES) is separate;

begin

   -- Perform the first stage of the Sutherland and Hodgman algorithm
   -- as outlined in Foley and Van Dam except for one addition. Instead
   -- of joining the intersection points to the interior lines in the
   -- order that they were generated, keep a separate list of each of
   -- the interior line segments and the intersection points.
   LEFT_SUTHERLAND_AND_HODGMAN (INPUT_AREA, LEFT_BORDER,
      LEFT_EDGE_LIST, INTERIOR_POINT_LISTS);

   -- Put the list of edges into the order that they are connected to
   -- each other.
   SORT_EDGE_LIST_BY_INCREASING_Y_VALUE (LEFT_EDGE_LIST);

   -- Make lines out of adjacent intersection points. Put the lines onto
   -- the list of lines formed in the first step.
   PAIR_UP_EDGE_POINTS_ADD_LINES_TO_LIST_OF_INTERIOR_LINES
      (LEFT_EDGE_LIST, INTERIOR_POINT_LISTS);

   -- Find which lines in the list connect with which lines and join
   -- them together to form areas.
   JOIN_LINES_TO_FORM_AREAS (INTERIOR_POINT_LISTS, CLIPPED_AREAS);

end CLIP_ON_LEFT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:CLIP_ON_RIGHT.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CLIP_ON_RIGHT
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : CLIP_ON_RIGHT.ADA
-- LEVEL : all

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES)

procedure CLIP_ON_RIGHT
   (INPUT_AREA    : in DC.POINT_ARRAY;
    RIGHT_BORDER  : in DC_TYPE;
    CLIPPED_AREAS : in out LIST_OF_AREAS) is

-- This procedure clips the points to the right border of the clipping
-- rectangle. The input list is clipped at the line X = RIGHT_BORDER
-- and zero or more areas are returned.
--
-- INPUT_AREA    - the list of points to be clipped.
-- RIGHT_BORDER  - the X value of the right edge of the clipping
--                 rectangle.
-- CLIPPED_AREAS - the resulting areas.

   RIGHT_EDGE_LIST : INTERSECTION_LIST;
   -- This holds a list of all the intersections points with the right
   -- edge of the clipping rectangle.

   INTERIOR_POINT_LISTS : LIST_OF_LINES := null;
   -- This is a list of the line segments which are interior to the
   -- clipping rectangle.

   procedure RIGHT_SUTHERLAND_AND_HODGMAN
      (INPUT_AREA      : in DC.POINT_ARRAY;
       RIGHT_BORDER    : in DC_TYPE;
       INTERSECTIONS   : in out INTERSECTION_LIST;
       INTERIOR_POINTS : in out LIST_OF_LINES) is separate;

begin

   -- Perform the first stage of the Sutherland and Hodgman algorithm
   -- as outlined in Foley and Van Dam except for one addition. Instead
   -- of joining the intersection points to the interior lines in the
   -- order that they were generated, keep a separate list of each of
   -- the interior line segments and the intersection points.
   RIGHT_SUTHERLAND_AND_HODGMAN (INPUT_AREA, RIGHT_BORDER,
      RIGHT_EDGE_LIST, INTERIOR_POINT_LISTS);

   -- Put the list of edges into the order that they are connected to
   -- each other.
   SORT_EDGE_LIST_BY_INCREASING_Y_VALUE (RIGHT_EDGE_LIST);

   -- Make lines out of adjacent intersection points. Put the lines onto
   -- the list of lines formed in the first step.
   PAIR_UP_EDGE_POINTS_ADD_LINES_TO_LIST_OF_INTERIOR_LINES
      (RIGHT_EDGE_LIST, INTERIOR_POINT_LISTS);

   -- Find which lines in the list connect with which lines and join
   -- them together to form areas.
   JOIN_LINES_TO_FORM_AREAS (INTERIOR_POINT_LISTS, CLIPPED_AREAS);

end CLIP_ON_RIGHT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:CLIP_ON_TOP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CLIP_ON_TOP
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : CLIP_ON_TOP.ADA
-- LEVEL : all

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES)

procedure CLIP_ON_TOP
   (INPUT_AREA    : in DC.POINT_ARRAY;
    TOP_BORDER    : in DC_TYPE;
    CLIPPED_AREAS : in out LIST_OF_AREAS) is

-- This procedure clips the points to the top border of the clipping
-- rectangle. The input list is clipped at the line Y = TOP_BORDER
-- and zero or more areas are returned.
--
-- INPUT_AREA    - the list of points to be clipped.
-- TOP_BORDER    - the X value of the right edge of the clipping
--                 rectangle.
-- CLIPPED_AREAS - the resulting areas.

   TOP_EDGE_LIST : INTERSECTION_LIST;
   -- This holds a list of all the intersections points with the top
   -- edge of the clipping rectangle.

   INTERIOR_POINT_LISTS : LIST_OF_LINES := null;
   -- This is a list of the line segments which are interior to the
   -- clipping rectangle.

   procedure TOP_SUTHERLAND_AND_HODGMAN
      (INPUT_AREA      : in DC.POINT_ARRAY;
       TOP_BORDER      : in DC_TYPE;
       INTERSECTIONS   : in out INTERSECTION_LIST;
       INTERIOR_POINTS : in out LIST_OF_LINES) is separate;

begin

   -- Perform the first stage of the Sutherland and Hodgman algorithm
   -- as outlined in Foley and Van Dam except for one addition. Instead
   -- of joining the intersection points to the interior lines in the
   -- order that they were generated, keep a separate list of each of
   -- the interior line segments and the intersection points.
   TOP_SUTHERLAND_AND_HODGMAN (INPUT_AREA, TOP_BORDER,
      TOP_EDGE_LIST, INTERIOR_POINT_LISTS);

   -- Put the list of edges into the order that they are connected to
   -- each other.
   SORT_EDGE_LIST_BY_INCREASING_X_VALUE (TOP_EDGE_LIST);

   -- Make lines out of adjacent intersection points. Put the lines onto
   -- the list of lines formed in the first step.
   PAIR_UP_EDGE_POINTS_ADD_LINES_TO_LIST_OF_INTERIOR_LINES
      (TOP_EDGE_LIST, INTERIOR_POINT_LISTS);

   -- Find which lines in the list connect with which lines and join
   -- them together to form areas.
   JOIN_LINES_TO_FORM_AREAS (INTERIOR_POINT_LISTS, CLIPPED_AREAS);

end CLIP_ON_TOP;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:LEFT_S_AND_H.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEFT_SUTHERLAND_AND_HODGMAN
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : LEFT_S_AND_H.ADA
-- LEVEL : all

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES.CLIP_ON_LEFT)

procedure LEFT_SUTHERLAND_AND_HODGMAN
   (INPUT_AREA      : in DC.POINT_ARRAY;
    LEFT_BORDER     : in DC_TYPE;
    INTERSECTIONS   : in out INTERSECTION_LIST;
    INTERIOR_POINTS : in out LIST_OF_LINES) is

-- This procedure performs the Sutherland and Hodgman algorithm on one
-- side of the clipping rectangle. It is different from the standard
-- algorithm in that it does not return a single list of points. A
-- single list of points is not adaquate because multiple areas cannot
-- be represented as a single list of points. This procedure gets
-- around this flaw by returning a list of those line segments which
-- are interior to the clipping rectangle and a list of the intersection
-- points.
--
-- INPUT_AREA      - the list of points to be clipped.
-- LEFT_BORDER     - the Y value of the left edge of the clipping
--                   rectangle.
-- INTERSECTIONS   - a list of the points where the input line crosses
--                   the left edge of the clipping rectangle.
-- INTERIOR_POINTS - a linked list of lines interior to the clipping
--                   rectangle. It is made up of points from the
--                   original INPUT_AREA plus the intersection points.

   FIRST_POINT : POSITIVE := 1;
   -- This variable is an index into the INPUT_AREA. Processing begins
   -- with the line segment connecting the first point of INPUT_AREA
   -- with the last point.

   INTERSECTION_POINT : DC.POINT;
   -- A point where the INPUT_AREA crosses over the border of the
   -- clipping rectangle.

   function FIND_INTERSECTION
      (FIRST_POINT  : DC.POINT;
       SECOND_POINT : DC.POINT;
       X_VALUE      : DC_TYPE) return DC_TYPE is

   -- This function returns the Y value of the point where the line
   -- segment connecting the FIRST_POINT with the SECOND_POINT crosses
   -- the line defined by X = X_VALUE.
   --
   -- FIRST_POINT  - the first point of the line being clipped.
   -- SECOND_POINT - the last point of the line being clipped.
   -- X_VALUE      - the X coordinate of the intersection point.

   begin

      return FIRST_POINT.Y - ((FIRST_POINT.X - X_VALUE) *
         (FIRST_POINT.Y - SECOND_POINT.Y)) /
         (FIRST_POINT.X - SECOND_POINT.X);

   end FIND_INTERSECTION;

begin

   -- If the point is inside of the clipping area, put it on the list
   -- of interior points.
   if INPUT_AREA (FIRST_POINT).X >= LEFT_BORDER then
      BEGIN_NEW_INTERIOR_LINE (INPUT_AREA (FIRST_POINT),
         INTERIOR_POINTS);
   end if;

   -- Repeat with each of the line segments in the list beginning with
   -- the line segment joining the first point to the second point and
   -- continuing with each line segment.
   for SECOND_POINT in 2 .. INPUT_AREA'LAST loop

      -- If the second point is inside.
      if INPUT_AREA (SECOND_POINT).X >= LEFT_BORDER then

         -- If the line segment is inside to inside, put the second
         -- point on the list of interior points.
         if INPUT_AREA (FIRST_POINT).X >= LEFT_BORDER then

            ADD_TO_INTERIOR_LINE (INPUT_AREA (SECOND_POINT),
               INTERIOR_POINTS);

         -- If the line segment is outside to inside, put the point
         -- where the line intersects the edge onto the list of
         -- intersections. Also begin a new interior line with the
         -- intersection point and the interior point.
         else

            INTERSECTION_POINT := (X => LEFT_BORDER,
               Y => FIND_INTERSECTION (INPUT_AREA (FIRST_POINT),
                  INPUT_AREA (SECOND_POINT), LEFT_BORDER));

            ADD_TO_EDGE_LIST (INTERSECTION_POINT, INTERSECTIONS);

            BEGIN_NEW_INTERIOR_LINE (INTERSECTION_POINT,
               INTERIOR_POINTS);

            ADD_TO_INTERIOR_LINE (INPUT_AREA (SECOND_POINT),
               INTERIOR_POINTS);

         end if;

      -- If the line segment is inside to outside, put the point of
      -- intersection onto the list of intersections. Also put the
      -- intersection point onto the list of interior points. (It will
      -- be the last point put on to the current interior line segment.)
      elsif INPUT_AREA (FIRST_POINT).X >= LEFT_BORDER then

         INTERSECTION_POINT := (X => LEFT_BORDER,
            Y => FIND_INTERSECTION (INPUT_AREA (FIRST_POINT),
               INPUT_AREA (SECOND_POINT), LEFT_BORDER));

         ADD_TO_EDGE_LIST (INTERSECTION_POINT, INTERSECTIONS);

         ADD_TO_INTERIOR_LINE (INTERSECTION_POINT, INTERIOR_POINTS);

      -- If the line segment is outside to outside, do nothing.
      -- else
      --    null;
      end if;

      FIRST_POINT := SECOND_POINT;

   end loop;

end LEFT_SUTHERLAND_AND_HODGMAN;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:RIGHT_S_AND_H.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: RIGHT_SUTHERLAND_AND_HODGMAN
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : RIGHT_S_AND_H.ADA
-- LEVEL : all

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES.CLIP_ON_RIGHT)

procedure RIGHT_SUTHERLAND_AND_HODGMAN
   (INPUT_AREA      : in DC.POINT_ARRAY;
    RIGHT_BORDER    : in DC_TYPE;
    INTERSECTIONS   : in out INTERSECTION_LIST;
    INTERIOR_POINTS : in out LIST_OF_LINES) is

-- This procedure performs the Sutherland and Hodgman algorithm on one
-- side of the clipping rectangle. It is different from the standard
-- algorithm in that it does not return a single list of points. A
-- single list of points is not adaquate because multiple areas cannot
-- be represented as a single list of points. This procedure gets
-- around this flaw by returning a list of those line segments which
-- are interior to the clipping rectangle and a list of the intersection
-- points.
--
-- INPUT_AREA      - the list of points to be clipped.
-- RIGHT_BORDER    - the X value of the right edge of the clipping
--                   rectangle.
-- INTERSECTIONS   - a list of the points where the input line crosses
--                   the right edge of the clipping rectangle.
-- INTERIOR_POINTS - a linked list of lines interior to the clipping
--                   rectangle. It is made up of points from the
--                   original INPUT_AREA plus the intersection points.

   FIRST_POINT : POSITIVE := 1;
   -- This variable is an index into the INPUT_AREA. Processing begins
   -- with the line segment connecting the first point of INPUT_AREA
   -- with the second point.

   INTERSECTION_POINT : DC.POINT;
   -- A point where the INPUT_AREA crosses over the border of the
   -- clipping rectangle.

   function FIND_INTERSECTION
      (FIRST_POINT  : DC.POINT;
       SECOND_POINT : DC.POINT;
       X_VALUE      : DC_TYPE) return DC_TYPE is

   -- This function returns the Y value of the point where the line
   -- segment connecting the FIRST_POINT with the SECOND_POINT crosses
   -- the line defined by X = X_VALUE.
   --
   -- FIRST_POINT  - the first endpoint of the line being clipped.
   -- SECOND_POINT - the last endpoint of the line being clipped.
   -- X_VALUE      - the value of the X coordinate of the intersection
   --                point.

   begin

      return FIRST_POINT.Y - ((FIRST_POINT.X - X_VALUE) *
         (FIRST_POINT.Y - SECOND_POINT.Y)) /
         (FIRST_POINT.X - SECOND_POINT.X);

   end FIND_INTERSECTION;

begin


   -- If the point is inside of the clipping area, put it on the list
   -- of interior points.
   if INPUT_AREA (FIRST_POINT).X <= RIGHT_BORDER then
      BEGIN_NEW_INTERIOR_LINE (INPUT_AREA (FIRST_POINT),
         INTERIOR_POINTS);
   end if;

   -- Repeat with each of the line segments in the list beginning with
   -- the line segment joining the first point to the second point and
   -- continuing with each line segment. (Note: The first point in the
   -- list will always match the last point in the list.)
   for SECOND_POINT in 2 ..  INPUT_AREA'LAST loop

      -- If the second point is inside.
      if INPUT_AREA (SECOND_POINT).X <= RIGHT_BORDER then

         -- If the line segment is inside to inside, put the second
         -- point on the list of interior points.
         if INPUT_AREA (FIRST_POINT).X <= RIGHT_BORDER then

            ADD_TO_INTERIOR_LINE (INPUT_AREA (SECOND_POINT),
               INTERIOR_POINTS);

         -- If the line segment is outside to inside, put the point
         -- where the line intersects the edge onto the list of
         -- intersections. Also begin a new interior line with the
         -- intersection point and the interior point.
         else

            INTERSECTION_POINT := (X => RIGHT_BORDER,
               Y => FIND_INTERSECTION (INPUT_AREA (FIRST_POINT),
                  INPUT_AREA (SECOND_POINT), RIGHT_BORDER));

            ADD_TO_EDGE_LIST (INTERSECTION_POINT, INTERSECTIONS);

            BEGIN_NEW_INTERIOR_LINE (INTERSECTION_POINT,
               INTERIOR_POINTS);

            ADD_TO_INTERIOR_LINE (INPUT_AREA (SECOND_POINT),
               INTERIOR_POINTS);

         end if;

      -- If the line segment is inside to outside, put the point of
      -- intersection onto the list of intersections. Also put the
      -- intersection point onto the list of interior points. (It will
      -- be the last point put on to the current interior line segment.)
      elsif INPUT_AREA (FIRST_POINT).X <= RIGHT_BORDER then

         INTERSECTION_POINT := (X => RIGHT_BORDER,
            Y => FIND_INTERSECTION (INPUT_AREA (FIRST_POINT),
               INPUT_AREA (SECOND_POINT), RIGHT_BORDER));

         ADD_TO_EDGE_LIST (INTERSECTION_POINT, INTERSECTIONS);

         ADD_TO_INTERIOR_LINE (INTERSECTION_POINT, INTERIOR_POINTS);

      -- If the line segment is outside to outside, do nothing.
      end if;

      FIRST_POINT := SECOND_POINT;

   end loop;

end RIGHT_SUTHERLAND_AND_HODGMAN;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:TOP_S_AND_H.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: TOP_SUTHERLAND_AND_HODGMAN
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : TOP_S_AND_H.ADA
-- LEVEL : all

separate (WSR_UTILITIES.AREA_CLIPPING_UTILITIES.CLIP_ON_TOP)

procedure TOP_SUTHERLAND_AND_HODGMAN
   (INPUT_AREA      : in DC.POINT_ARRAY;
    TOP_BORDER      : in DC_TYPE;
    INTERSECTIONS   : in out INTERSECTION_LIST;
    INTERIOR_POINTS : in out LIST_OF_LINES) is

-- This procedure performs the Sutherland and Hodgman algorithm on one
-- side of the clipping rectangle. It is different from the standard
-- algorithm in that it does not return a single list of points. A
-- single list of points is not adaquate because multiple areas cannot
-- be represented as a single list of points. This procedure gets
-- around this flaw by returning a list of those line segments which
-- are interior to the clipping rectangle and a list of the intersection
-- points.
--
-- INPUT_AREA      - the list of points to be clipped.
-- TOP_BORDER      - the Y value of the top edge of the clipping
--                   rectangle.
-- INTERSECTIONS   - a list of the points where the input line crosses
--                   the top edge of the clipping rectangle.
-- INTERIOR_POINTS - a linked list of lines interior to the clipping
--                   rectangle. It is made up of points from the
--                   original INPUT_AREA plus the intersection points.

   FIRST_POINT : POSITIVE := 1;
   -- This variable is an index into the INPUT_AREA. Processing begins
   -- with the line segment connecting the first point of INPUT_AREA
   -- with the second point.

   INTERSECTION_POINT : DC.POINT;
   -- A point where the INPUT_AREA crosses over the border of the
   -- clipping rectangle.

   function FIND_INTERSECTION
      (FIRST_POINT  : DC.POINT;
       SECOND_POINT : DC.POINT;
       Y_VALUE      : DC_TYPE) return DC_TYPE is

   -- This function returns the Y value of the point where the line
   -- segment connecting the FIRST_POINT with the SECOND_POINT crosses
   -- the line defined by X = X_VALUE.

   begin

      return FIRST_POINT.X - ((FIRST_POINT.Y - Y_VALUE) *
         (FIRST_POINT.X - SECOND_POINT.X)) /
         (FIRST_POINT.Y - SECOND_POINT.Y);

   end FIND_INTERSECTION;

begin

   -- If the point is inside of the clipping area, put it on the list
   -- of interior points.
   if INPUT_AREA (FIRST_POINT).Y <= TOP_BORDER then
      BEGIN_NEW_INTERIOR_LINE (INPUT_AREA (FIRST_POINT),
         INTERIOR_POINTS);
   end if;

   -- Repeat with each of the line segments in the list beginning with
   -- the line segment joining the first point to the second point and
   -- continuing with each line segment. (Note: The first point in the
   -- list will always match the last point in the list.)
   for SECOND_POINT in 2 ..  INPUT_AREA'LAST loop

      -- If the second point is inside.
      if INPUT_AREA (SECOND_POINT).Y <= TOP_BORDER then

         -- If the line segment is inside to inside, put the second
         -- point on the list of interior points.
         if INPUT_AREA (FIRST_POINT).Y <= TOP_BORDER then

            ADD_TO_INTERIOR_LINE (INPUT_AREA (SECOND_POINT),
               INTERIOR_POINTS);

         -- If the line segment is outside to inside, put the point
         -- where the line intersects the edge onto the list of
         -- intersections. Also begin a new interior line with the
         -- intersection point and the interior point.
         else

            INTERSECTION_POINT := (X => FIND_INTERSECTION
               (INPUT_AREA (FIRST_POINT), INPUT_AREA (SECOND_POINT),
                TOP_BORDER), Y => TOP_BORDER);

            ADD_TO_EDGE_LIST (INTERSECTION_POINT, INTERSECTIONS);

            BEGIN_NEW_INTERIOR_LINE (INTERSECTION_POINT,
               INTERIOR_POINTS);

            ADD_TO_INTERIOR_LINE (INPUT_AREA (SECOND_POINT),
               INTERIOR_POINTS);

         end if;

      -- If the line segment is inside to outside, put the point of
      -- intersection onto the list of intersections. Also put the
      -- intersection point onto the list of interior points. (It will
      -- be the last point put on to the current interior line segment.)
      elsif INPUT_AREA (FIRST_POINT).Y <= TOP_BORDER then

         INTERSECTION_POINT := (X => FIND_INTERSECTION
            (INPUT_AREA (FIRST_POINT), INPUT_AREA (SECOND_POINT),
             TOP_BORDER), Y => TOP_BORDER);

         ADD_TO_EDGE_LIST (INTERSECTION_POINT, INTERSECTIONS);

         ADD_TO_INTERIOR_LINE (INTERSECTION_POINT, INTERIOR_POINTS);

      -- If the line segment is outside to outside, do nothing.
      -- else
        -- null;
      end if;

      FIRST_POINT := SECOND_POINT;

   end loop;

end TOP_SUTHERLAND_AND_HODGMAN;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSD_FA_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: FILL_AREA
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR009  Fill area debug statements.
------------------------------------------------------------------
-- FILE: WSD_FA_MA.ADA
-- LEVEL : MA - 0A

with UNCHECKED_DEALLOCATION;

separate (LEXI3700_OUTPUT_PRIMITIVES)

procedure FILL_AREA
   (WS_SL            : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    FILL_AREA_POINTS : ACCESS_POINT_ARRAY_TYPE) is

-- This procedure gathers the appropriate attributes from the Work-
-- station state list and then calls the device driver procedures which
-- fill in the area defined by the input points.
--
-- If the Effective Interior Style is HOLLOW the attributes of polyline
-- are used to draw the border points. If the Effective Interior Style
-- is SOLID the border points are drawn by the device driver with a
-- special flag so that the area can then be filled in. Interior styles
-- of PATTERN or HATCH are not supported; they will default to HOLLOW.
--
-- The FILL_AREA_POINTS will be clipped and transformed from NDC into
-- IDC coordinate space.
--
-- WS_SL             - the pointer to the Workstation State List.
-- FILL_AREA_POINTS  - a pointer to an array of points in NDC.

   EFFECTIVE_LINETYPE : LEXI_LINE_TYPE := LEXI_LINE_TYPE'FIRST;
   -- The value used for drawing the border lines is always solid.

   EFFECTIVE_LINE_WIDTH : LEXI_LINE_WIDTH_TYPE :=
      LEXI_LINE_WIDTH_TYPE'FIRST;
   -- The value used for drawing the border lines is always one.

   EFFECTIVE_AREA_COLOUR_INDEX : LEXI_COLOUR_INDEX;
   -- The value derived from the state list fill area colour and used
   -- for drawing the border lines and the area itself if solid.

   EFFECTIVE_INTERIOR_STYLE : LEXI_INTERIOR_STYLE;
   -- The value derived from the state list fill area interior style and
   -- used to determine if the interior area is solid.

   DC_AREA : DC.POINT_ARRAY (FILL_AREA_POINTS'RANGE);
   -- Contains the points in FILL_AREA_POINTS after they have been
   -- transformed into DC.

   CLIPPED_DC_AREAS : WSR_UTILITIES.LIST_OF_AREAS;
   -- Contains the border points of any area(s) which are obtained by
   -- clipping the DC_POINTS to the area of the Effective Clipping
   -- Rectangle.

   function "=" (LEFT, RIGHT : WSR_UTILITIES.LIST_OF_AREAS)
      return BOOLEAN renames WSR_UTILITIES."=";
   -- The equals function is made locally visible for use in infix
   -- notation.

   TEMP_CLIPPED_DC_AREAS : WSR_UTILITIES.LIST_OF_AREAS;
   -- A temporary holding place for CLIPPED_DC_AREAS;

   procedure DISPOSE_AREA is new UNCHECKED_DEALLOCATION
      (OBJECT => WSR_UTILITIES.AREA,
       NAME   => WSR_UTILITIES.LIST_OF_AREAS);
   -- This procedure is used to dispose of CLIPPED_DC_AREAS after they
   -- have been drawn.

   type RECTANGLE is
      record
         UPPER_LEFT  : DC.POINT;
         LOWER_RIGHT : DC.POINT;
      end record;
   -- This type defines the corner points of a rectangle which is
   -- parallel to the X and Y axes.

   SMALLEST_SURROUNDING_RECTANGLE : RECTANGLE;
   -- This contains two opposite corners of the smallest rectangle which
   -- is square with the axes and contains all of points in an area.

   IDC_LOWER_RIGHT_CORNER, IDC_UPPER_LEFT_CORNER : LEXI_POINT;
   -- Contains the two corner points from the SMALLEST_SURROUNDING_
   -- RECTANGLE translated into IDC coordinates.

   SOMETHING_VISIBLE_IN_VIEWPORT : BOOLEAN := FALSE;
   -- Set to FALSE when all of the FILL_AREA_POINTS are clipped. Set to
   -- TRUE when some part of the Fill Area is visible.

   procedure FIND_EXTENTS
      (INPUT_POINTS                   : in WSR_UTILITIES.LIST_OF_AREAS;
       SMALLEST_SURROUNDING_RECTANGLE : out RECTANGLE)
      is separate;

begin

   -- Translate the input points from NDC to DC.
   DC_AREA := CONVERT_NDC_DC.DC_POINT_ARRAY
      (FILL_AREA_POINTS.all, WS_SL.WS_TRANSFORM);

   -- Use the EFFECTIVE_CLIPPING_RECTANGLE to clip the input region into
   -- an arbitrary number of areas interior to the clipping rectangle.
   -- Obtain the enclosing rectangle's corners from the Workstation
   -- Resource.
   WSR_UTILITIES.AREA_CLIP (DC_AREA,
      WS_SL.EFFECTIVE_CLIPPING_RECTANGLE, CLIPPED_DC_AREAS);

   -- Determine if anything will be drawn and set the display attributes
   -- before drawing the areas' borders.
   if not (CLIPPED_DC_AREAS = null) then

      -- Assign the current fill area colour index to EFFECTIVE_AREA_
      -- COLOUR_INDEX. If the colour index is not in the list of indices
      -- which have been associated with a set of intensity values, the
      -- value 1 is assigned.
      if not COLOUR_INDICES.IS_IN_LIST
         (WS_SL.EFFECTIVE_FILL_AREA_ATTR.COLOUR,
          WS_SL.SET_OF_COLOUR_IDC) then
         EFFECTIVE_AREA_COLOUR_INDEX := 1;
      else EFFECTIVE_AREA_COLOUR_INDEX := LEXI_COLOUR_INDEX
         (WS_SL.EFFECTIVE_FILL_AREA_ATTR.COLOUR);
      end if;

      -- Assign the current fill area interior style to the EFFECTIVE_
      -- INTERIOR_STYLE. If the current fill area interior style is not
      -- supported on the Lexidata, the value HOLLOW is assigned.
      if WS_SL.EFFECTIVE_FILL_AREA_ATTR.INT_STYLE = SOLID then
         EFFECTIVE_INTERIOR_STYLE := LEXI3700_TYPES.SOLID;
      else
         EFFECTIVE_INTERIOR_STYLE := LEXI3700_TYPES.HOLLOW;
      end if;

      -- Set the flags which indicate that something is being drawn.
      SOMETHING_VISIBLE_IN_VIEWPORT := TRUE;
      WS_SL.WS_DISPLAY_SURFACE := NOTEMPTY;

   -- Repeat until all of the boundry points are drawn.
   while not (CLIPPED_DC_AREAS = null) loop

      declare

         IDC_AREA : LEXI_POINTS (CLIPPED_DC_AREAS.BORDER.POINTS'RANGE);
         -- Contains the border points of the next fill area after they
         -- have been translated into IDC coordinates.

      begin

         -- Translate the boundary points of an area into IDC.
         IDC_AREA := LEXI_UTILITIES.IDC
            (CLIPPED_DC_AREAS.BORDER.POINTS);

         -- If the interior style is SOLID, fill in the area.
         if EFFECTIVE_INTERIOR_STYLE = SOLID then

            -- Clear the edge flags in the last bit plane that had been
            -- set during the previous FILL_AREA.
            LEXI3700_OUTPUT_DRIVER.CLEAR_DISPLAY
               (LEXI_PLANE_VALUE'(128));

            -- Set the display parameters for setting the flags.
            LEXI3700_OUTPUT_DRIVER.SET_DISPLAY_PARAMETERS
               (EFFECTIVE_LINE_WIDTH, EFFECTIVE_LINETYPE,
                LEXI_INTERIOR_STYLE'(SOLID));

            -- Set the fill flags around the border of the area.
            LEXI3700_OUTPUT_DRIVER.DISPLAY_CHAINED_VECTORS
                  (LEXI_COLOUR_INDEX(128), IDC_AREA);

            -- Determine the smallest area that must be analysed by the
            -- Device Driver's Fill Area.
            FIND_EXTENTS
               (CLIPPED_DC_AREAS, SMALLEST_SURROUNDING_RECTANGLE);

            -- Translate the smallest enclosing rectangle into IDC.
            IDC_UPPER_LEFT_CORNER  := LEXI_UTILITIES.IDC
               (SMALLEST_SURROUNDING_RECTANGLE.UPPER_LEFT);

            IDC_LOWER_RIGHT_CORNER := LEXI_UTILITIES.IDC
               (SMALLEST_SURROUNDING_RECTANGLE.LOWER_RIGHT);

            -- Call the Device Driver to set the scan area for the fill.
            LEXI3700_OUTPUT_DRIVER.SET_RECTANGULAR_LIMIT
               (IDC_UPPER_LEFT_CORNER, IDC_LOWER_RIGHT_CORNER);

            -- Reset the display parameters so that the solid colours
            -- don't bleed.
            LEXI3700_OUTPUT_DRIVER.SET_DISPLAY_PARAMETERS
               (EFFECTIVE_LINE_WIDTH, EFFECTIVE_LINETYPE,
                LEXI_INTERIOR_STYLE'(HOLLOW));

            -- Fill with the proper colour.
            LEXI3700_OUTPUT_DRIVER.POLYGON_EDGE_FLAG_FILL
               (EFFECTIVE_AREA_COLOUR_INDEX);

         -- If the area is hollow, set the proper attributes for the
         -- border.
         else

            -- Set the attributes for drawing the border points. Send
            -- the Device Driver the linetype and line width as well as
            -- a flag indicating that the points will not be used later
            -- on for a polygon fill.
            LEXI3700_OUTPUT_DRIVER.SET_DISPLAY_PARAMETERS
               (EFFECTIVE_LINE_WIDTH, EFFECTIVE_LINETYPE,
                LEXI_INTERIOR_STYLE'(HOLLOW));

         end if;

         -- Draw the border points both for HOLLOW and SOLID.
         LEXI3700_OUTPUT_DRIVER.DISPLAY_CHAINED_VECTORS
               (EFFECTIVE_AREA_COLOUR_INDEX, IDC_AREA);

      -- declare block.
      end;

      -- Continue with the next region and destroy the space occupied by
      -- the current region.
      TEMP_CLIPPED_DC_AREAS := CLIPPED_DC_AREAS;
      CLIPPED_DC_AREAS := CLIPPED_DC_AREAS.NEXT_AREA;
      DISPOSE_AREA (TEMP_CLIPPED_DC_AREAS);

   end loop;

   end if;

   -- Flush the output buffer on the device if the deferral mode is ASAP
   if WS_SL.WS_DEFERRAL_MODE = ASAP then
      LEXI3700_OUTPUT_DRIVER.FLUSH;
   end if;

end FILL_AREA;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSD_FIND_EXTENTS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: FIND_EXTENTS
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR039  New WSD_FIND_EXTENTS replaces ma & 0a version.
------------------------------------------------------------------
-- FILE : WSD_FIND_EXTENTS.ADA
-- LEVEL : All levels

separate (LEXI3700_OUTPUT_PRIMITIVES.FILL_AREA)

procedure FIND_EXTENTS
   (INPUT_POINTS                   : in WSR_UTILITIES.LIST_OF_AREAS;
    SMALLEST_SURROUNDING_RECTANGLE : out RECTANGLE) is

-- This procedure is used to find the extent or bounding box of the
-- figure being output. All of the X and Y coordinates are compared
-- and the largest and smallest are returned as the opposite corners
-- of the bounding box.
--
-- INPUT_POINTS                   - the figure being boxed in.
-- SMALLEST_SURROUNDING_RECTANGLE - the box which surrounds it.

   X_MIN : DC_TYPE := INPUT_POINTS.BORDER.POINTS(1).X;
   X_MAX : DC_TYPE := INPUT_POINTS.BORDER.POINTS(1).X;
   Y_MIN : DC_TYPE := INPUT_POINTS.BORDER.POINTS(1).Y;
   Y_MAX : DC_TYPE := INPUT_POINTS.BORDER.POINTS(1).Y;
   -- The extrema are initialized to the value of the first point in the
   -- first area.

begin

   -- Repeat for each point in the area.
   for I in 2 .. INPUT_POINTS.BORDER.LENGTH loop

      -- If the X value of the current point is larger or smaller
      -- than all previous points, alter the proper extrema.
      if INPUT_POINTS.BORDER.POINTS (I).X < X_MIN then
         X_MIN := INPUT_POINTS.BORDER.POINTS (I).X;
      elsif INPUT_POINTS.BORDER.POINTS (I).X > X_MAX then
         X_MAX := INPUT_POINTS.BORDER.POINTS (I).X;
      end if;

      -- If the Y value of the current point is larger or smaller
      -- than all previous points, alter the proper extrema.
      if INPUT_POINTS.BORDER.POINTS (I).Y < Y_MIN then
         Y_MIN := INPUT_POINTS.BORDER.POINTS (I).Y;
      elsif INPUT_POINTS.BORDER.POINTS (I).Y > Y_MAX then
         Y_MAX := INPUT_POINTS.BORDER.POINTS (I).Y;
      end if;

    -- Go on to the next point.
   end loop;

   -- Return to the calling program with the proper values.
   SMALLEST_SURROUNDING_RECTANGLE.UPPER_LEFT := (X_MIN, Y_MAX);
   SMALLEST_SURROUNDING_RECTANGLE.LOWER_RIGHT := (X_MAX, Y_MIN);

end FIND_EXTENTS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSD_PLINE_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: POLYLINE
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR034  Fix pline clip.
--
------------------------------------------------------------------
-- FILE: WSD_PLINE_MA.ADA
-- LEVEL : MA - 0A

separate (LEXI3700_OUTPUT_PRIMITIVES)

procedure POLYLINE
   (WS_SL        : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    LINE_POINTS  : ACCESS_POINT_ARRAY_TYPE) is

-- This procedure uses the Workstation State List to find the
-- effective clipping matrix and the attributes used to control
-- the appearance of the polyline.
--
-- WS_SL - is a pointer to the Workstation State List.
--
-- LINE_POINTS  - is a pointer to an array containing points to generate
--                a set of connected lines.

DEVICE_UNIT_POINTS : DC.POINT_ARRAY(LINE_POINTS'range);
-- Contain points of type dc.

FIRST_VALUE : DC.POINT;
LAST_VALUE  : DC.POINT;
-- FIRST_VALUE and LAST_VALUE contain the first and last points of the
-- array.

FIRST_INDEX : POSITIVE := DEVICE_UNIT_POINTS'FIRST;
LAST_INDEX  : POSITIVE := DEVICE_UNIT_POINTS'FIRST;
-- FIRST_INDEX and LAST_INDEX are pointers into the array being clipped.
-- These pointers point to the first and last index of the array that
-- are in the effective clipping rectangle.

LINE_WIDTH : INTEGER;
-- Contains the line width.

LEXI_LINE_WIDTH : LEXI_LINE_WIDTH_TYPE;
-- Contains the line width for the device.

LINE_COLOUR : LEXI_COLOUR_INDEX;
-- Contains the Colour index .

IS_VALID : BOOLEAN;
-- Contains a flag indicating if the colour index is valid.

function "&"(A : DC.POINT; B : DC.POINT_ARRAY) return DC.POINT_ARRAY
            renames DC."&";
function "&"(A : DC.POINT_ARRAY; B : DC.POINT) return DC.POINT_ARRAY
            renames DC."&";

begin

   IS_VALID := COLOUR_INDICES.IS_IN_LIST
                 (WS_SL.EFFECTIVE_POLYLINE_ATTR.COLOUR,
                  WS_SL.SET_OF_COLOUR_IDC);
   if IS_VALID then
      LINE_COLOUR := LEXI_COLOUR_INDEX(WS_SL.EFFECTIVE_POLYLINE_ATTR.COLOUR);
   else
      LINE_COLOUR := LEXI_COLOUR_INDEX(1);
   end if;
   -- Finds colour for polyline.

   LINE_WIDTH  := INTEGER(WS_SL.EFFECTIVE_POLYLINE_ATTR.L_WIDTH);
   if LINE_WIDTH <  INTEGER(LEXI_LINE_WIDTH_TYPE'FIRST) then
      LEXI_LINE_WIDTH := LEXI_LINE_WIDTH_TYPE'FIRST;
   elsif LINE_WIDTH >  INTEGER(LEXI_LINE_WIDTH_TYPE'LAST) then
      LEXI_LINE_WIDTH := LEXI_LINE_WIDTH_TYPE'LAST;
   else
      LEXI_LINE_WIDTH := LEXI_LINE_WIDTH_TYPE(LINE_WIDTH);
   end if;
   -- Finds line width for polyline.

   DEVICE_UNIT_POINTS := CONVERT_NDC_DC.DC_POINT_ARRAY
         (LINE_POINTS.all,WS_SL.WS_TRANSFORM);
   -- Converts points to DC

   LEXI3700_OUTPUT_DRIVER.SET_DISPLAY_PARAMETERS
         (LEXI_LINE_WIDTH,
          LEXI_LINE_TYPE'VAL(WS_SL.EFFECTIVE_POLYLINE_ATTR.L_TYPE - 1),
          LEXI_INTERIOR_STYLE'(HOLLOW));

   while FIRST_INDEX /= DEVICE_UNIT_POINTS'LAST loop

      WSR_UTILITIES.PLINE_CLIP
         (DEVICE_UNIT_POINTS, FIRST_VALUE, FIRST_INDEX, LAST_INDEX,
          LAST_VALUE, WS_SL.EFFECTIVE_CLIPPING_RECTANGLE);

      if FIRST_INDEX > DEVICE_UNIT_POINTS'LAST then
         exit;
         -- The points were outside the clipping rectangle.
      else
          declare
            DEVICE_POINTS : LEXI_POINTS(1 .. LAST_INDEX - FIRST_INDEX + 3);
          begin

             DEVICE_POINTS := LEXI_UTILITIES.IDC
                   (FIRST_VALUE &
                    DEVICE_UNIT_POINTS(FIRST_INDEX .. LAST_INDEX) &
                    LAST_VALUE);

             LEXI3700_OUTPUT_DRIVER.DISPLAY_CHAINED_VECTORS
                   (LINE_COLOUR, DEVICE_POINTS);
          end;
          FIRST_INDEX := LAST_INDEX + 1;
          WS_SL.WS_DISPLAY_SURFACE := NOTEMPTY;
      end if;
   end loop;

   if WS_SL.WS_DEFERRAL_MODE = ASAP then
      LEXI3700_OUTPUT_DRIVER.FLUSH;
   end if;
   -- Flush the output buffer on the device if the deferral mode is ASAP

end POLYLINE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSD_PMRK_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: POLYMARKER
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR006  Polymarker tests do not execute.
------------------------------------------------------------------
-- FILE: WSD_PMRK_MA.ADA
-- LEVEL: MA - 0A

separate (LEXI3700_OUTPUT_PRIMITIVES)

procedure POLYMARKER
   (WS_SL         : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    MARKER_POINTS : ACCESS_POINT_ARRAY_TYPE) is

-- This procedure uses the Workstation State List to find the effective
-- clipping matrix and the attributes used to control the appearance
-- of the polymarker.
--
-- WS_SL         - is a pointer to the Workstation State List.

-- MARKER_POINTS - is a pointer to an array containing points to give
--                 position of polymarkers.

MARKER_SIZE : INTEGER;
-- Contains the request marker size.

LEXI_MARKER_SIZE : LEXI_TEXT_SIZE;
-- Contains the size of the marker.

IS_VALID : BOOLEAN;
-- Contains a flag indicating if the colour index is valid.

MARKER_COLOUR : LEXI_COLOUR_INDEX;
-- Contains the colour index for the device.

CLIPPED_MARKER_POINTS : DC.POINT_LIST;
-- Contains the clipped Polymarkers.

LEXI_MARKER : LEXI_MARKER_TYPE;
-- Contains the available marker type.

MARKER_TYPE : INTEGER;
-- Contains the Requested Marker type.

procedure ADJUST_MARKER_POSITION
   (DEVICE_POINTS : in out LEXI_POINTS;
    MARKER_SIZE : LEXI_TEXT_SIZE) is

OFFSET_X : LEXI_COORDINATE :=
      LEXI_COORDINATE(LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_WIDTH)
      * LEXI_COORDINATE(MARKER_SIZE) / LEXI_COORDINATE'(2);
OFFSET_Y : LEXI_COORDINATE :=
      LEXI_COORDINATE(LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_HEIGHT)
      * LEXI_COORDINATE(MARKER_SIZE) / LEXI_COORDINATE'(2);

begin
   for I in DEVICE_POINTS'range loop
       if INTEGER(DEVICE_POINTS(I).X - OFFSET_X) > 0 then
          DEVICE_POINTS(I).X := DEVICE_POINTS(I).X - OFFSET_X;
       else
          DEVICE_POINTS(I).X := LEXI_COORDINATE'(0);
       end if;
       if INTEGER(DEVICE_POINTS(I).Y - OFFSET_Y) > 0 then
          DEVICE_POINTS(I).Y := DEVICE_POINTS(I).Y - OFFSET_Y;
       else
          DEVICE_POINTS(I).Y := LEXI_COORDINATE'(0);
       end if;
   end loop;
end ADJUST_MARKER_POSITION;

begin

   IS_VALID := COLOUR_INDICES.IS_IN_LIST
                 (WS_SL.EFFECTIVE_POLYMARKER_ATTR.COLOUR,
                  WS_SL.SET_OF_COLOUR_IDC);
   if IS_VALID then
      MARKER_COLOUR := LEXI_COLOUR_INDEX(WS_SL.EFFECTIVE_POLYMARKER_ATTR.COLOUR)
;
   else
      MARKER_COLOUR := LEXI_COLOUR_INDEX'(1);
   end if;
   -- Finds the polymarker colour.

   MARKER_SIZE := INTEGER(WS_SL.EFFECTIVE_POLYMARKER_ATTR.M_SIZE);
   if MARKER_SIZE < INTEGER(LEXI_TEXT_SIZE'FIRST) then
      LEXI_MARKER_SIZE := LEXI_TEXT_SIZE'FIRST;
   elsif MARKER_SIZE > INTEGER(LEXI_TEXT_SIZE'LAST) then
      LEXI_MARKER_SIZE := LEXI_TEXT_SIZE'LAST;
   else
      LEXI_MARKER_SIZE := LEXI_TEXT_SIZE(MARKER_SIZE);
   end if;
   -- Finds the polymarker size.

   LEXI_MARKER := LEXI_MARKER_TYPE'VAL
      (WS_SL.EFFECTIVE_POLYMARKER_ATTR.M_TYPE - 1);

   CLIPPED_MARKER_POINTS := WSR_UTILITIES.PMRK_CLIP
        (CONVERT_NDC_DC.DC_POINT_ARRAY(MARKER_POINTS.all,
         WS_SL.WS_TRANSFORM),
         WS_SL.EFFECTIVE_CLIPPING_RECTANGLE);

   if CLIPPED_MARKER_POINTS.POINTS'LENGTH > 0 then
      declare
         DEVICE_POINTS : LEXI_POINTS(1 .. CLIPPED_MARKER_POINTS.LENGTH);
      begin
         DEVICE_POINTS := LEXI_UTILITIES.IDC (CLIPPED_MARKER_POINTS.POINTS);
         ADJUST_MARKER_POSITION(DEVICE_POINTS,LEXI_MARKER_SIZE);
         for I in DEVICE_POINTS'range loop
             LEXI3700_OUTPUT_DRIVER.SET_TEXT_PARAMETERS
                  (DEVICE_POINTS(I), MARKER_COLOUR,
                   LEXI_CHARACTER_PATH'(LEFT_TO_RIGHT),
                   LEXI_MARKER_SIZE);
             LEXI3700_OUTPUT_DRIVER.DISPLAY_TEXT
                  (LEXI3700_OUTPUT_DRIVER.LEXI_MARKER(LEXI_MARKER));
         end loop;
      WS_SL.WS_DISPLAY_SURFACE := NOTEMPTY;
      end;
   end if;

   if WS_SL.WS_DEFERRAL_MODE = ASAP then
      LEXI3700_OUTPUT_DRIVER.FLUSH;
   end if;
   -- Flush the output buffer on the device if the deferral mode is ASAP

end POLYMARKER;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:WSD_TEXT_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: TEXT
--  IDENTIFIER: GCMXXX.2(2)
--  DISCREPANCY REPORTS:
--  DR029  Completely clipped string of text.
------------------------------------------------------------------
-- FILE: WSD_TEXT_MA.ADA
-- LEVEL: LEVEL MA

separate (LEXI3700_OUTPUT_PRIMITIVES)

procedure TEXT
   (WS_SL         : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    TEXT_POSITION : NDC.POINT;
    TEXT_STRING   : ACCESS_STRING_TYPE) is

-- This procedure inquires into the WS State List to find
-- what the current attribute settings are.
--
-- The relevant attributes are as follows:
-- CHARACTER_SPACING, TEXT_COLOUR_INDEX, CHARACTER_HEIGHT, TEXT_PATH
-- CHARACTER_UP_VECTOR, TEXT_ALIGNMENT
--
-- This procedure calls the IDC procedure in WSD_UTILITIES to
-- convert the NDC points to IDC (INTEGER DEVICE COORDINATES).
--
-- POSITION    - contains the position to display text.
-- TEXT_STRING - contains a string of text to be displayed.
-- WS_SL       - is a pointer to the Workstation State List.

DEVICE_POINT : LEXI_POINT;
-- contains the starting point for the text string.

DC_POINT : DC.POINT;
-- contains the starting point in DC coordinates.

IS_VALID : BOOLEAN;
-- Contains a flag indicating if a colour index is valid.

TEXT_COLOUR : LEXI_COLOUR_INDEX;
-- Contains the colour index to be used.

OFFSET : DC.POINT;
-- Contains an x and y offset to use for each character.

LEXI_CHAR_SIZE : LEXI_TEXT_SIZE;
-- Contains the multiplication factor for text size.

CHAR_HEIGHT : DC_TYPE;
-- Contains the physical requested height of the character.

AVAILABLE_HEIGHT : INTEGER;
-- Contains the available scale factor for text sizes.

FIRST_VALID, LAST_VALID : POSITIVE;
-- An index into the string of characters.

LEXI_CHAR_ROTATION : LEXI_ROTATE_CODE;
-- Contains the character rotation offered by the device.

LEXI_PATH : LEXI_CHARACTER_PATH;
-- Contains the path offered by the device.

FORTY_FIVE     : constant DC_TYPE := 0.707107;
NEG_FORTY_FIVE : constant DC_TYPE := -0.707107;
-- Contains the vector values to determine the character rotation.

DC_CHAR_HEIGHT_VECTOR : DC.VECTOR;
-- Contains the height vector converted to DC.

Y_COMP_VECTOR, X_COMP_VECTOR : DC_TYPE;
-- Contains the X and Y vectors to determine the character rotation.

START_POSITION : DC.POINT;
-- Contains the physical starting point to display the text string.

TEI_LOWER_LEFT  : DC.POINT;
-- Contains the parallelogram containing the text string.

TEI_LOWER_RIGHT : DC.POINT;
-- Contains the parallelogram containing the text string.

TEI_UPPER_LEFT  : DC.POINT;
-- Contains the parallelogram containing the text string.

TEI_UPPER_RIGHT : DC.POINT;
-- Contains the parallelogram containing the text string.

begin
   IS_VALID := COLOUR_INDICES.IS_IN_LIST
                 (WS_SL.EFFECTIVE_TEXT_ATTR.COLOUR,
                  WS_SL.SET_OF_COLOUR_IDC);
   if IS_VALID then
      TEXT_COLOUR := LEXI_COLOUR_INDEX(WS_SL.EFFECTIVE_TEXT_ATTR.COLOUR);
   else
      TEXT_COLOUR := LEXI_COLOUR_INDEX(1);
   end if;
   DC_CHAR_HEIGHT_VECTOR := CONVERT_NDC_DC.DC_VECTOR
        (WS_SL.OUTPUT_ATTR.CURRENT_CHAR_HEIGHT_VECTOR, WS_SL.WS_TRANSFORM);

   CHAR_HEIGHT := DC_POINT_OPS.NORM(DC_CHAR_HEIGHT_VECTOR);

   DC_POINT := CONVERT_NDC_DC.DC_POINT
                 (TEXT_POSITION, WS_SL.WS_TRANSFORM);

   WSR_UTILITIES.TEXT_HANDLING
       (DC_TYPE(LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_CAP_TOP),
        DC_TYPE(LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_BASE_BOTTOM),
        WS_SL.OUTPUT_ATTR.CURRENT_TEXT_PATH,
        WS_SL.OUTPUT_ATTR.CURRENT_TEXT_ALIGNMENT,
        DC_CHAR_HEIGHT_VECTOR,
        CONVERT_NDC_DC.DC_VECTOR
             (WS_SL.OUTPUT_ATTR.CURRENT_CHAR_WIDTH_VECTOR,
              WS_SL.WS_TRANSFORM),
        WS_SL.OUTPUT_ATTR.CURRENT_CHAR_EXPANSION_FACTOR,
        WS_SL.OUTPUT_ATTR.CURRENT_CHAR_SPACING,
        DC_POINT,
        TEXT_STRING'LENGTH,
        DC_TYPE(LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT),
        START_POSITION,
        OFFSET,
        TEI_LOWER_LEFT,
        TEI_LOWER_RIGHT,
        TEI_UPPER_LEFT,
        TEI_UPPER_RIGHT);

   X_COMP_VECTOR := DC_CHAR_HEIGHT_VECTOR.X / CHAR_HEIGHT;
   Y_COMP_VECTOR := DC_CHAR_HEIGHT_VECTOR.Y / CHAR_HEIGHT;


   AVAILABLE_HEIGHT := abs (INTEGER (CHAR_HEIGHT) /
      LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_HEIGHT);

   if AVAILABLE_HEIGHT > INTEGER(LEXI_TEXT_SIZE'LAST) then
      LEXI_CHAR_SIZE := LEXI_TEXT_SIZE'LAST;
   elsif AVAILABLE_HEIGHT < INTEGER(LEXI_TEXT_SIZE'FIRST) then
      LEXI_CHAR_SIZE := LEXI_TEXT_SIZE'FIRST;
   else
      LEXI_CHAR_SIZE := LEXI_TEXT_SIZE(AVAILABLE_HEIGHT);
   end if;

   if X_COMP_VECTOR > NEG_FORTY_FIVE and X_COMP_VECTOR < FORTY_FIVE then
      if Y_COMP_VECTOR < 0.0 then
         LEXI_CHAR_ROTATION := ROTATION_180;
         START_POSITION.Y := START_POSITION.Y -
              (DC_TYPE
              (LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_HEIGHT)
              + DC_TYPE
              (LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_CAP_TOP))
              * DC_TYPE(LEXI_CHAR_SIZE);
      else
         LEXI_CHAR_ROTATION := NO_ROTATION;
         START_POSITION.Y := START_POSITION.Y +
              (DC_TYPE
              (LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_HEIGHT)
              + DC_TYPE
              (LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_CAP_TOP))
              * DC_TYPE(LEXI_CHAR_SIZE);
     end if;
   else
      if X_COMP_VECTOR < 0.0 then
         LEXI_CHAR_ROTATION := ROTATION_90;
         START_POSITION.X := START_POSITION.X -
              (DC_TYPE
              (LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_HEIGHT)
              + DC_TYPE
              (LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_CAP_TOP))
              * DC_TYPE(LEXI_CHAR_SIZE);
      else
         LEXI_CHAR_ROTATION := ROTATION_270;
         START_POSITION.X := START_POSITION.X +
              (DC_TYPE
              (LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_HEIGHT)
              + DC_TYPE
              (LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_CAP_TOP))
              * DC_TYPE(LEXI_CHAR_SIZE);
      end if;
   end if;

   WSR_UTILITIES.TEXT_CLIP
       (START_POSITION,
        TEXT_STRING'LENGTH,
        WS_SL.EFFECTIVE_CLIPPING_RECTANGLE,
        OFFSET,
        FIRST_VALID,
        LAST_VALID);

   START_POSITION.X := START_POSITION.X + (OFFSET.X *
        DC_TYPE(FIRST_VALID - 1));
   START_POSITION.Y := START_POSITION.Y + (OFFSET.Y *
        DC_TYPE(FIRST_VALID - 1));

   LEXI3700_OUTPUT_DRIVER.SET_TEXT_CHARACTER_ROTATION
       (LEXI_CHAR_ROTATION);

   case LEXI_CHAR_ROTATION is
      when NO_ROTATION  => LEXI_PATH := LEFT_TO_RIGHT;
      when ROTATION_90  => LEXI_PATH := BOTTOM_TO_TOP;
      when ROTATION_180 => LEXI_PATH := RIGHT_TO_LEFT;
      when ROTATION_270 => LEXI_PATH := TOP_TO_BOTTOM;
   end case;

   if LAST_VALID >= FIRST_VALID then
      DEVICE_POINT :=  LEXI_UTILITIES.IDC(START_POSITION);
   end if;

   for I in FIRST_VALID .. LAST_VALID loop
      LEXI3700_OUTPUT_DRIVER.SET_TEXT_PARAMETERS
          (DEVICE_POINT, TEXT_COLOUR,
           LEXI_CHARACTER_PATH'(LEXI_PATH),
           LEXI_CHAR_SIZE);
      LEXI3700_OUTPUT_DRIVER.DISPLAY_TEXT(TEXT_STRING(I .. I));

      if I /= LAST_VALID then
         DEVICE_POINT.X := LEXI_COORDINATE(DC_TYPE(DEVICE_POINT.X) +
               OFFSET.X);
         DEVICE_POINT.Y := LEXI_COORDINATE(DC_TYPE(DEVICE_POINT.Y) -
               OFFSET.Y);
      else
         WS_SL.WS_DISPLAY_SURFACE := NOTEMPTY;
         -- If text is being displayed, we set the display surface
         -- to not empty, is occurs after the text has been drawn.
      end if;
   end loop;

   if WS_SL.WS_DEFERRAL_MODE = ASAP then
      LEXI3700_OUTPUT_DRIVER.FLUSH;
   end if;
   -- Flush the output buffer on the device if the deferral mode is ASAP

end TEXT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:MA:GKS_MA.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_MA
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  gks_ma.ada
-- level: ma

-- The following context clauses refer to the logical groups
-- for level ma.

with GKS_CONTROL;
with WS_CONTROL;
with OUTPUT_PRIMITIVES;
with SET_INDIVIDUAL_ATTRIBUTES_MA;
with SET_PRIMITIVE_ATTRIBUTES_MA;
with SET_COLOUR_TABLE;
with INQ_PRIMITIVE_ATTRIBUTES;
with INQ_BU9TNDLE_INDICES;
with INQ_INDIVIDUAL_ATTRIBUTES;
with GKS_NORMALIZATION;
with WS_TRANSFORMATION;
with INQ_GKS_STATE_LIST_MA;
with INQ_GKS_DESCRIPTION_TABLE_MA;
with INQ_WS_STATE_LIST_MA;
with INQ_WS_DESCRIPTION_TABLE_MA;
with ERROR_ROUTINES;

with GKS_TYPES;
with GKS_CONFIGURATION;

use GKS_TYPES;

package GKS_MA is

-- This package provides the interface to the applications
-- programmer.  It provides the full functionality for a
-- level ma implementation of GKS.

   -- GKS_CONTROL logical functions
   procedure OPEN_GKS
      (ERROR_FILE      : in ERROR_FILE_TYPE :=
                         GKS_CONFIGURATION.DEFAULT_ERROR_FILE;
      AMOUNT_OF_MEMORY : in MEMORY_UNITS :=
                         GKS_CONFIGURATION.MAX_MEMORY_UNITS)
   renames GKS_CONTROL.OPEN_GKS;

   procedure CLOSE_GKS renames GKS_CONTROL.CLOSE_GKS;


   -- WS_CONTROL logical functions
   procedure OPEN_WS
      (WS        : in WS_ID;
      CONNECTION : in CONNECTION_ID;
      TYPE_OF_WS : in WS_TYPE)
   renames WS_CONTROL.OPEN_WS;

   procedure CLOSE_WS
      (WS : in WS_ID)
   renames WS_CONTROL.CLOSE_WS;

   procedure ACTIVATE_WS
      (WS : in WS_ID)
   renames WS_CONTROL.ACTIVATE_WS;

   procedure DEACTIVATE_WS
      (WS : in WS_ID)
   renames WS_CONTROL.DEACTIVATE_WS;

   procedure CLEAR_WS
      (WS  : in WS_ID;
      FLAG : in CONTROL_FLAG)
   renames WS_CONTROL.CLEAR_WS;

   procedure UPDATE_WS
      (WS          : in WS_ID;
      REGENERATION : in UPDATE_REGENERATION_FLAG)
   renames WS_CONTROL.UPDATE_WS;


   -- OUTPUT_PRIMITIVES logical functions
   procedure POLYLINE
      (LINE_POINTS : in WC.POINT_ARRAY)
   renames OUTPUT_PRIMITIVES.POLYLINE;

   procedure POLYMARKER
      (MARKER_POINTS : in WC.POINT_ARRAY)
   renames OUTPUT_PRIMITIVES.POLYMARKER;

   procedure FILL_AREA
      (FILL_AREA_POINTS : in WC.POINT_ARRAY)
   renames OUTPUT_PRIMITIVES.FILL_AREA;

   procedure TEXT
      (POSITION   : in WC.POINT;
      TEXT_STRING : in STRING)
   renames OUTPUT_PRIMITIVES.TEXT;


   -- SET_INDIVIDUAL_ATTRIBUTES_MA logical functions
   procedure SET_LINETYPE
      (LINE : in LINETYPE)
   renames SET_INDIVIDUAL_ATTRIBUTES_MA.SET_LINETYPE;

   procedure SET_POLYLINE_COLOUR_INDEX
      (COLOUR : in COLOUR_INDEX)
   renames SET_INDIVIDUAL_ATTRIBUTES_MA.SET_POLYLINE_COLOUR_INDEX;

   procedure SET_MARKER_TYPE
      (MARKER : in MARKER_TYPE)
   renames SET_INDIVIDUAL_ATTRIBUTES_MA.SET_MARKER_TYPE;

   procedure SET_POLYMARKER_COLOUR_INDEX
      (COLOUR : in COLOUR_INDEX)
   renames SET_INDIVIDUAL_ATTRIBUTES_MA.SET_POLYMARKER_COLOUR_INDEX;

   procedure SET_TEXT_COLOUR_INDEX
      (COLOUR : in COLOUR_INDEX)
   renames SET_INDIVIDUAL_ATTRIBUTES_MA.SET_TEXT_COLOUR_INDEX;

   procedure SET_FILL_AREA_INTERIOR_STYLE
      (STYLE : in INTERIOR_STYLE)
   renames SET_INDIVIDUAL_ATTRIBUTES_MA.SET_FILL_AREA_INTERIOR_STYLE;

   procedure SET_FILL_AREA_COLOUR_INDEX
      (COLOUR : in COLOUR_INDEX)
   renames SET_INDIVIDUAL_ATTRIBUTES_MA.SET_FILL_AREA_COLOUR_INDEX;


   -- SET_PRIMITIVE_ATTRIBUTES_MA logical functions
   procedure SET_CHAR_HEIGHT
      (HEIGHT : in WC.MAGNITUDE)
   renames SET_PRIMITIVE_ATTRIBUTES_MA.SET_CHAR_HEIGHT;

   procedure SET_CHAR_UP_VECTOR
      (CHAR_UP_VECTOR : IN WC.VECTOR)
   renames SET_PRIMITIVE_ATTRIBUTES_MA.SET_CHAR_UP_VECTOR;

   procedure SET_TEXT_ALIGNMENT
      (ALIGNMENT : in TEXT_ALIGNMENT)
   renames SET_PRIMITIVE_ATTRIBUTES_MA.SET_TEXT_ALIGNMENT;


   -- SET_COLOUR_TABLE logical functions
   procedure SET_COLOUR_REPRESENTATION
      (WS    : in WS_ID;
      INDEX  : in COLOUR_INDEX;
      COLOUR : in COLOUR_REPRESENTATION)
   renames SET_COLOUR_TABLE.SET_COLOUR_REPRESENTATION;


   -- INQ_PRIMITIVE_ATTRIBUTES logical functions
   procedure INQ_CHAR_HEIGHT
      (EI    : out ERROR_INDICATOR;
      HEIGHT : out WC.MAGNITUDE)
   renames INQ_PRIMITIVE_ATTRIBUTES.INQ_CHAR_HEIGHT;

   procedure INQ_CHAR_UP_VECTOR
      (EI    : out ERROR_INDICATOR;
      VECTOR : out WC.VECTOR)
   renames INQ_PRIMITIVE_ATTRIBUTES.INQ_CHAR_UP_VECTOR;

   procedure INQ_TEXT_PATH
      (EI  : out ERROR_INDICATOR;
      PATH : out TEXT_PATH)
   renames INQ_PRIMITIVE_ATTRIBUTES.INQ_TEXT_PATH;

   procedure INQ_TEXT_ALIGNMENT
      (EI       : out ERROR_INDICATOR;
      ALIGNMENT : out TEXT_ALIGNMENT)
   renames INQ_PRIMITIVE_ATTRIBUTES.INQ_TEXT_ALIGNMENT;

   procedure INQ_PATTERN_REFERENCE_POINT
      (EI             : out ERROR_INDICATOR;
      REFERENCE_POINT : out WC.POINT)
   renames INQ_PRIMITIVE_ATTRIBUTES.INQ_PATTERN_REFERENCE_POINT;

   procedure INQ_PATTERN_HEIGHT_VECTOR
      (EI    : out ERROR_INDICATOR;
      VECTOR : out WC.VECTOR)
   renames INQ_PRIMITIVE_ATTRIBUTES.INQ_PATTERN_HEIGHT_VECTOR;

   procedure INQ_PATTERN_WIDTH_VECTOR
      (EI   : out ERROR_INDICATOR;
      WIDTH : out WC.VECTOR)
   renames INQ_PRIMITIVE_ATTRIBUTES.INQ_PATTERN_WIDTH_VECTOR;

   procedure INQ_CHAR_WIDTH
      (EI   : out ERROR_INDICATOR;
      WIDTH : out WC.MAGNITUDE)
   renames INQ_PRIMITIVE_ATTRIBUTES.INQ_CHAR_WIDTH;

   procedure INQ_CHAR_BASE_VECTOR
      (EI    : out ERROR_INDICATOR;
      VECTOR : out WC.VECTOR)
   renames INQ_PRIMITIVE_ATTRIBUTES.INQ_CHAR_BASE_VECTOR;


   -- INQ_BUNDLE_INDICES logical functions
   procedure INQ_POLYLINE_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out POLYLINE_INDEX)
   renames INQ_BUNDLE_INDICES.INQ_POLYLINE_INDEX;

   procedure INQ_POLYMARKER_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out POLYMARKER_INDEX)
   renames INQ_BUNDLE_INDICES.INQ_POLYMARKER_INDEX;

   procedure INQ_TEXT_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out TEXT_INDEX)
   renames INQ_BUNDLE_INDICES.INQ_TEXT_INDEX;

   procedure INQ_FILL_AREA_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out FILL_AREA_INDEX)
   renames INQ_BUNDLE_INDICES.INQ_FILL_AREA_INDEX;


   -- INQ_INDIVIDUAL_ATTRIBUTES logical functions
   procedure INQ_LINETYPE
      (EI  : out ERROR_INDICATOR;
      LINE : out LINETYPE)
   renames INQ_INDIVIDUAL_ATTRIBUTES.INQ_LINETYPE;

   procedure INQ_LINEWIDTH_SCALE_FACTOR
      (EI   : out ERROR_INDICATOR;
      WIDTH : out LINE_WIDTH)
   renames INQ_INDIVIDUAL_ATTRIBUTES.INQ_LINEWIDTH_SCALE_FACTOR;

   procedure INQ_POLYLINE_COLOUR_INDEX
      (EI    : out ERROR_INDICATOR;
      COLOUR : out COLOUR_INDEX)
   renames INQ_INDIVIDUAL_ATTRIBUTES.INQ_POLYLINE_COLOUR_INDEX;

   procedure INQ_POLYMARKER_TYPE
      (EI    : out ERROR_INDICATOR;
      MARKER : out MARKER_TYPE)
   renames INQ_INDIVIDUAL_ATTRIBUTES.INQ_POLYMARKER_TYPE;

   procedure INQ_POLYMARKER_SIZE_SCALE_FACTOR
      (EI  : out ERROR_INDICATOR;
      SIZE : out MARKER_SIZE)
   renames INQ_INDIVIDUAL_ATTRIBUTES.INQ_POLYMARKER_SIZE_SCALE_FACTOR;

   procedure INQ_POLYMARKER_COLOUR_INDEX
      (EI    : out ERROR_INDICATOR;
      COLOUR : out COLOUR_INDEX)
   renames INQ_INDIVIDUAL_ATTRIBUTES.INQ_POLYMARKER_COLOUR_INDEX;

   procedure INQ_TEXT_FONT_AND_PRECISION
      (EI            : out ERROR_INDICATOR;
      FONT_PRECISION : out TEXT_FONT_PRECISION)
   renames INQ_INDIVIDUAL_ATTRIBUTES.INQ_TEXT_FONT_AND_PRECISION;

   procedure INQ_CHAR_EXPANSION_FACTOR
      (EI       : out ERROR_INDICATOR;
      EXPANSION : out CHAR_EXPANSION)
   renames INQ_INDIVIDUAL_ATTRIBUTES.INQ_CHAR_EXPANSION_FACTOR;

   procedure INQ_CHAR_SPACING
      (EI     : out ERROR_INDICATOR;
      SPACING : out CHAR_SPACING)
   renames INQ_INDIVIDUAL_ATTRIBUTES.INQ_CHAR_SPACING;

   procedure INQ_TEXT_COLOUR_INDEX
      (EI    : out ERROR_INDICATOR;
      COLOUR : out COLOUR_INDEX)
   renames INQ_INDIVIDUAL_ATTRIBUTES.INQ_TEXT_COLOUR_INDEX;

   procedure INQ_FILL_AREA_INTERIOR_STYLE
      (EI   : out ERROR_INDICATOR;
      STYLE : out INTERIOR_STYLE)
   renames INQ_INDIVIDUAL_ATTRIBUTES.INQ_FILL_AREA_INTERIOR_STYLE;

   procedure INQ_FILL_AREA_STYLE_INDEX
      (EI   : out ERROR_INDICATOR;
      INDEX : out STYLE_INDEX)
   renames INQ_INDIVIDUAL_ATTRIBUTES.INQ_FILL_AREA_STYLE_INDEX;

   procedure INQ_FILL_AREA_COLOUR_INDEX
      (EI    : out ERROR_INDICATOR;
      COLOUR : out COLOUR_INDEX)
   renames INQ_INDIVIDUAL_ATTRIBUTES.INQ_FILL_AREA_COLOUR_INDEX;

   procedure INQ_LIST_OF_ASF
      (EI  : out ERROR_INDICATOR;
      LIST : out ASF_LIST)
   renames INQ_INDIVIDUAL_ATTRIBUTES.INQ_LIST_OF_ASF;


   -- GKS_NORMALIZATION logical functions
   procedure SET_WINDOW
      (TRANSFORMATION : in TRANSFORMATION_NUMBER;
      WINDOW_LIMITS   : in WC.RECTANGLE_LIMITS)
   renames GKS_NORMALIZATION.SET_WINDOW;

   procedure SET_VIEWPORT
      (TRANSFORMATION : in TRANSFORMATION_NUMBER;
      VIEWPORT_LIMITS : in NDC.RECTANGLE_LIMITS)
   renames GKS_NORMALIZATION.SET_VIEWPORT;

   procedure SELECT_NORMALIZATION_TRANSFORMATION
      (TRANSFORMATION : in TRANSFORMATION_NUMBER)
   renames GKS_NORMALIZATION.SELECT_NORMALIZATION_TRANSFORMATION;

   procedure SET_CLIPPING_INDICATOR
      (CLIPPING : in CLIPPING_INDICATOR)
   renames GKS_NORMALIZATION.SET_CLIPPING_INDICATOR;


   -- WS_TRANSFORMATION logical functions
   procedure SET_WS_WINDOW
      (WS              : in WS_ID;
      WS_WINDOW_LIMITS : in NDC.RECTANGLE_LIMITS)
   renames WS_TRANSFORMATION.SET_WS_WINDOW;

   procedure SET_WS_VIEWPORT
      (WS                : in WS_ID;
      WS_VIEWPORT_LIMITS : in DC.RECTANGLE_LIMITS)
   renames WS_TRANSFORMATION.SET_WS_VIEWPORT;

   -- INQ_GKS_STATE_LIST_MA logical functions
   procedure INQ_CURRENT_NORMALIZATION_TRANSFORMATION_NUMBER
      (EI            : out ERROR_INDICATOR;
      TRANSFORMATION : out TRANSFORMATION_NUMBER)
   renames INQ_GKS_STATE_LIST_MA.
                       INQ_CURRENT_NORMALIZATION_TRANSFORMATION_NUMBER;

   procedure INQ_NORMALIZATION_TRANSFORMATION
      (TRANSFORMATION : in TRANSFORMATION_NUMBER;
      EI              : out ERROR_INDICATOR;
      WINDOW_LIMITS   : out WC.RECTANGLE_LIMITS;
      VIEWPORT_LIMITS : out NDC.RECTANGLE_LIMITS)
   renames INQ_GKS_STATE_LIST_MA.INQ_NORMALIZATION_TRANSFORMATION;

   procedure INQ_CLIPPING
      (EI                : out ERROR_INDICATOR;
      CLIPPING           : out CLIPPING_INDICATOR;
      CLIPPING_RECTANGLE_LIMITS : out NDC.RECTANGLE_LIMITS)
   renames INQ_GKS_STATE_LIST_MA.INQ_CLIPPING;


   -- INQ_GKS_DESCRIPTION_TABLE_MA logical functions
   procedure INQ_LEVEL_OF_GKS
      (EI   : out ERROR_INDICATOR;
      LEVEL : out GKS_LEVEL)
   renames INQ_GKS_DESCRIPTION_TABLE_MA.INQ_LEVEL_OF_GKS;


   -- INQ_WS_STATE_LIST_MA logical functions
   procedure INQ_WS_CONNECTION_AND_TYPE
      (WS        : in WS_ID;
      EI         : out ERROR_INDICATOR;
      CONNECTION : out VARIABLE_CONNECTION_ID;
      TYPE_OF_WS : out WS_TYPE)
   renames INQ_WS_STATE_LIST_MA.INQ_WS_CONNECTION_AND_TYPE;

   procedure INQ_TEXT_EXTENT
      (WS                 : in WS_ID;
      POSITION            : in WC.POINT;
      CHAR_STRING         : in STRING;
      EI                  : out ERROR_INDICATOR;
      CONCATENATION_POINT : out WC.POINT;
      TEXT_EXTENT         : out TEXT_EXTENT_PARALLELOGRAM)
   renames INQ_WS_STATE_LIST_MA.INQ_TEXT_EXTENT;

   procedure INQ_LIST_OF_COLOUR_INDICES
      (WS     : in WS_ID;
      EI      : out ERROR_INDICATOR;
      INDICES : out COLOUR_INDICES.LIST_OF)
   renames INQ_WS_STATE_LIST_MA.INQ_LIST_OF_COLOUR_INDICES;

   procedure INQ_COLOUR_REPRESENTATION
      (WS             : in WS_ID;
      INDEX           : in COLOUR_INDEX;
      RETURNED_VALUES : in RETURN_VALUE_TYPE;
      EI              : out ERROR_INDICATOR;
      COLOUR          : out COLOUR_REPRESENTATION)
   renames INQ_WS_STATE_LIST_MA.INQ_COLOUR_REPRESENTATION;

   procedure INQ_WS_TRANSFORMATION
      (WS                : in WS_ID;
      EI                 : out ERROR_INDICATOR;
      UPDATE             : out UPDATE_STATE;
      REQUESTED_WINDOW   : out NDC.RECTANGLE_LIMITS;
      CURRENT_WINDOW     : out NDC.RECTANGLE_LIMITS;
      REQUESTED_VIEWPORT : out DC.RECTANGLE_LIMITS;
      CURRENT_VIEWPORT   : out DC.RECTANGLE_LIMITS)
   renames INQ_WS_STATE_LIST_MA.INQ_WS_TRANSFORMATION;


   -- INQ_WS_DESCRIPTION_TABLE_MA logical functions
   procedure INQ_DISPLAY_SPACE_SIZE
      (WS                  : in WS_TYPE;
      EI                   : out ERROR_INDICATOR;
      UNITS                : out DC_UNITS;
      MAX_DC_SIZE          : out DC.SIZE;
      MAX_RASTER_UNIT_SIZE : out RASTER_UNIT_SIZE)
   renames INQ_WS_DESCRIPTION_TABLE_MA.INQ_DISPLAY_SPACE_SIZE;

   procedure INQ_POLYLINE_FACILITIES
      (WS               : in WS_TYPE;
      EI                : out ERROR_INDICATOR;
      LIST_OF_TYPES     : out LINETYPES.LIST_OF;
      NUMBER_OF_WIDTHS  : out NATURAL;
      NOMINAL_WIDTH     : out DC.MAGNITUDE;
      RANGE_OF_WIDTHS   : out DC.RANGE_OF_MAGNITUDES;
      NUMBER_OF_INDICES : out NATURAL)
   renames INQ_WS_DESCRIPTION_TABLE_MA.INQ_POLYLINE_FACILITIES;

   procedure INQ_POLYMARKER_FACILITIES
      (WS               : in WS_TYPE;
      EI                : out ERROR_INDICATOR;
      LIST_OF_TYPES     : out MARKER_TYPES.LIST_OF;
      NUMBER_OF_SIZES   : out NATURAL;
      NOMINAL_SIZE      : out DC.MAGNITUDE;
      RANGE_OF_SIZES    : out DC.RANGE_OF_MAGNITUDES;
      NUMBER_OF_INDICES : out NATURAL)
   renames INQ_WS_DESCRIPTION_TABLE_MA.INQ_POLYMARKER_FACILITIES;

   procedure INQ_TEXT_FACILITIES
      (WS                  : in WS_TYPE;
      EI                   : out ERROR_INDICATOR;
      LIST_OF_FONT_PRECISION_PAIRS: out TEXT_FONT_PRECISIONS.LIST_OF;
      NUMBER_OF_HEIGHTS    : out NATURAL;
      RANGE_OF_HEIGHTS     : out DC.RANGE_OF_MAGNITUDES;
      NUMBER_OF_EXPANSIONS : out NATURAL;
      EXPANSION_RANGE      : out RANGE_OF_EXPANSIONS;
      NUMBER_OF_INDICES    : out NATURAL)
   renames INQ_WS_DESCRIPTION_TABLE_MA.INQ_TEXT_FACILITIES;

   procedure INQ_FILL_AREA_FACILITIES
      (WS                     : WS_TYPE;
      EI                      : out ERROR_INDICATOR;
      LIST_OF_INTERIOR_STYLES : out INTERIOR_STYLES.LIST_OF;
      LIST_OF_HATCH_STYLES    : out HATCH_STYLES.LIST_OF;
      NUMBER_OF_INDICES       : out NATURAL)
   renames INQ_WS_DESCRIPTION_TABLE_MA.INQ_FILL_AREA_FACILITIES;

   procedure INQ_COLOUR_FACILITIES
      (WS                      : in WS_TYPE;
      EI                       : out ERROR_INDICATOR;
      NUMBER_OF_COLOURS        : out NATURAL;
      AVAILABLE_COLOUR         : out COLOUR_AVAILABLE;
      NUMBER_OF_COLOUR_INDICES : out NATURAL)
   renames INQ_WS_DESCRIPTION_TABLE_MA.INQ_COLOUR_FACILITIES;

   procedure INQ_MAX_LENGTH_OF_WS_STATE_TABLES
      (WS                    : in WS_TYPE;
      EI                     : out ERROR_INDICATOR;
      MAX_POLYLINE_ENTRIES   : out NATURAL;
      MAX_POLYMARKER_ENTRIES : out NATURAL;
      MAX_TEXT_ENTRIES       : out NATURAL;
      MAX_FILL_AREA_ENTRIES  : out NATURAL;
      MAX_PATTERN_INDICES    : out NATURAL;
      MAX_COLOUR_INDICES     : out NATURAL)
   renames INQ_WS_DESCRIPTION_TABLE_MA.INQ_MAX_LENGTH_OF_WS_STATE_TABLES;

end GKS_MA;








 $