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

Text File | 1988-05-03 | 1.1 MB | 32,120 lines

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:GKS_CONFIGURATION_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_CONFIGURATION
--  IDENTIFIER: GIMXXX.2(1)
--  DISCREPANCY REPORTS:
--  DR003 Unassigned CGM constants in GKS_CONFIGURATION_0A
------------------------------------------------------------------
-- file:  gks_configuration_0a.ada
-- level: 0a

package GKS_CONFIGURATION is

-- This package is external to GKS and contains implementation-defined
-- constants used by a particular level 0a 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;

   GKSM_MO                       : constant := 91;

   GKSM_MI                       : constant := 92;

   CGM_MO                        : constant := 60;

   CGM_MI                        : constant := 70;

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 ramge 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: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: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_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_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:0A:GKS_NORM_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_NORMALIZATION - BODY
--  IDENTIFIER: GIMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR028  Normalization of primitive attributes.
------------------------------------------------------------------
-- file:  gks_norm.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

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: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: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_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_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: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: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: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: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: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: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:0A:CGI_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CGI
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  #019  06/14/85  "Change SET_PATTERN_SIZE to SET_PATTERN_VECTORS"
------------------------------------------------------------------
-- file: cgi_0a.ada
-- level: 0a

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,

   -- LEVEL 0a
   -- logical operation "extended_output_primitives"

      CELL_ARRAY,

   -- Generalized Drawing Primitives

      CIRCLE,

   -- logical operation "set_bundle_indices"

      SET_POLYLINE_INDEX,
      SET_POLYMARKER_INDEX,
      SET_TEXT_INDEX,
      SET_FILL_AREA_INDEX,

   -- logical operation "set_primitive_attributes_0a"

      SET_TEXT_PATH,
      SET_PATTERN_VECTORS,                                  -- DR019
      SET_PATTERN_REFERENCE_POINT,

   -- logical operation "set_individual_attributes_0a"

      SET_LINE_WIDTH_SCALE_FACTOR,
      SET_MARKER_SIZE_SCALE_FACTOR,
      SET_TEXT_FONT_AND_PRECISION,
      SET_CHAR_EXPANSION_FACTOR,
      SET_CHAR_SPACING,
      SET_FILL_AREA_STYLE_INDEX,
      SET_ASF,

   -- logical operation "inq_ws_description_table_0a"

      INQ_WS_CATEGORY,
      INQ_WS_CLASS,
      INQ_PREDEFINED_POLYLINE_REPRESENTATION,
      INQ_PREDEFINED_POLYMARKER_REPRESENTATION,
      INQ_PREDEFINED_TEXT_REPRESENTATION,
      INQ_PREDEFINED_FILL_AREA_REPRESENTATION,
      INQ_PATTERN_FACILITIES,
      INQ_PREDEFINED_PATTERN_REPRESENTATION,
      INQ_PREDEFINED_COLOUR_REPRESENTATION,
      INQ_LIST_OF_AVAILABLE_GDP,
      INQ_GDP,

   -- logical operation "inq_ws_state_list_0a"

      INQ_WS_STATE,
      INQ_WS_DEFERRAL_AND_UPDATE_STATES,

   -- logical operation "pixels"

      INQ_PIXEL_ARRAY_DIMENSIONS,
      INQ_PIXEL_ARRAY,
      INQ_PIXEL);

   type ACCESS_COLOUR_MATRIX_TYPE is ACCESS
      COLOUR_MATRICES.MATRIX_OF;
   -- used to pass pointer to a matrix of colour indices

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

   type ACCESS_PIXEL_COLOUR_MATRIX_TYPE is ACCESS
      PIXEL_COLOUR_MATRICES.MATRIX_OF;
   -- used to pass pointer to a matrix of pixel colour indices

   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_COLOUR_MATRIX is new unchecked_deallocation
         (COLOUR_MATRICES.MATRIX_OF,ACCESS_COLOUR_MATRIX_TYPE);

   procedure FREE_CONNECTION_ID is new unchecked_deallocation
         (CONNECTION_ID,ACCESS_CONNECTION_ID_TYPE);

   procedure FREE_PIXEL_COLOUR_MATRIX is new unchecked_deallocation
         (PIXEL_COLOUR_MATRICES.MATRIX_OF,
         ACCESS_PIXEL_COLOUR_MATRIX_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;

   -- LEVEL 0a
   -- logical operation "extended_output_primitives"

         when CELL_ARRAY =>
            CELL_ARRAY_CORNER_1_1    :       NDC.POINT;
            CELL_ARRAY_CORNER_DX_DY  :       NDC.POINT;
            CELL_ARRAY_CORNER_DX_1   :       NDC.POINT;
            CELL_COLOUR_MATRIX       :     ACCESS_COLOUR_MATRIX_TYPE;

   -- Generalized Drawing Primitives
         when CIRCLE =>
            CIRCLE_CENTER            :       NDC.POINT;
            CIRCLE_PERIPHERAL_POINT   :      NDC.POINT;

   -- logical operation "set_bundle_indices"

         when SET_POLYLINE_INDEX =>
            POLYLINE_INDEX_SET       :       POLYLINE_INDEX;
         when SET_POLYMARKER_INDEX =>
            POLYMARKER_INDEX_SET     :       POLYMARKER_INDEX;
         when SET_TEXT_INDEX =>
            TEXT_INDEX_SET           :       TEXT_INDEX;
         when SET_FILL_AREA_INDEX =>
            FILL_AREA_INDEX_SET      :       FILL_AREA_INDEX;

   -- logical operation "set_primitive_attributes_0a"

         when SET_TEXT_PATH =>
            TEXT_PATH_SET            :       TEXT_PATH;
         when SET_PATTERN_VECTORS =>                          -- DR019
            PATTERN_HEIGHT_VECTOR_SET   :    NDC.VECTOR;      -- DR019
            PATTERN_WIDTH_VECTOR_SET    :    NDC.VECTOR;      -- DR019
         when SET_PATTERN_REFERENCE_POINT =>
            PATTERN_REFERENCE_POINT_SET :    NDC.POINT;

   -- logical operation "set_individual_attributes_0a"

         when SET_LINE_WIDTH_SCALE_FACTOR =>
            LINE_WIDTH_SCALE_FACTOR_SET :    LINE_WIDTH;
         when SET_MARKER_SIZE_SCALE_FACTOR =>
            MARKER_SIZE_SCALE_FACTOR_SET :   MARKER_SIZE;
         when SET_TEXT_FONT_AND_PRECISION =>
            TEXT_FONT_AND_PRECISION_SET :    TEXT_FONT_PRECISION;
         when SET_CHAR_EXPANSION_FACTOR =>
            CHAR_EXPANSION_FACTOR_SET :      CHAR_EXPANSION;
         when SET_CHAR_SPACING =>
            CHAR_SPACING_SET         :       CHAR_SPACING;
         when SET_FILL_AREA_STYLE_INDEX =>
            FILL_AREA_STYLE_INDEX_SET :      STYLE_INDEX;
         when SET_ASF =>
            ASF_SET                  :       ASF_LIST;

   -- logical operation "inq_ws_description_table_0a"

         when INQ_WS_CATEGORY =>
            WS_TO_INQ_CATEGORY       :       WS_TYPE;
            WS_CATEGORY_INQ          :       WS_CATEGORY;
         when INQ_WS_CLASS =>
            WS_TO_INQ_CLASS          :       WS_TYPE;
            WS_CLASS_INQ             :       DISPLAY_CLASS;
         when INQ_PREDEFINED_POLYLINE_REPRESENTATION =>
            WS_TO_INQ_PRE_POLYLINE_REP :     WS_TYPE;
            PRE_POLYLINE_INDEX_TO_INQ_PRE_POLYLINE_REP : POLYLINE_INDEX;
            PRE_POLYLINE_TYPE_INQ    :       LINETYPE;
            PRE_POLYLINE_WIDTH_INQ   :       LINE_WIDTH;
            PRE_POLYLINE_COLOUR_INQ  :       COLOUR_INDEX;
         when INQ_PREDEFINED_POLYMARKER_REPRESENTATION =>
            WS_TO_INQ_PRE_POLYMARKER_REP :   WS_TYPE;
            PRE_POLYMARKER_INDEX_TO_INQ_PRE_POLYMARKER_REP :
                                                       POLYMARKER_INDEX;
            PRE_POLYMARKER_TYPE_INQ  :       MARKER_TYPE;
            PRE_POLYMARKER_SIZE_INQ  :       MARKER_SIZE;
            PRE_POLYMARKER_COLOUR_INQ :      COLOUR_INDEX;
         when INQ_PREDEFINED_TEXT_REPRESENTATION =>
            WS_TO_INQ_PRE_TEXT_REP   :       WS_TYPE;
            PRE_TEXT_INDEX_TO_INQ_PRE_TEXT_REP : TEXT_INDEX;
            PRE_TEXT_FONT_PRECISION_INQ :    TEXT_FONT_PRECISION;
            PRE_TEXT_CHAR_EXPANSION_INQ :    CHAR_EXPANSION;
            PRE_TEXT_CHAR_SPACING_INQ :      CHAR_SPACING;
            PRE_TEXT_COLOUR_INQ      :       COLOUR_INDEX;
         when INQ_PREDEFINED_FILL_AREA_REPRESENTATION =>
            WS_TO_INQ_PRE_FILL_AREA_REP :    WS_TYPE;
            PRE_FILL_AREA_INDEX_TO_INQ_PRE_FILL_AREA_REP :
                                                        FILL_AREA_INDEX;
            PRE_FILL_AREA_INTERIOR_INQ :     INTERIOR_STYLE;
            PRE_FILL_AREA_STYLE_INQ  :       STYLE_INDEX;
            PRE_FILL_AREA_COLOUR_INQ :       COLOUR_INDEX;
         when INQ_PATTERN_FACILITIES =>
            WS_TO_INQ_PATTERN_FACILITIES :   WS_TYPE;
            NUMBER_OF_PATTERN_INDICES :      NATURAL;
         when INQ_PREDEFINED_PATTERN_REPRESENTATION =>
            WS_TO_INQ_PRE_PATTERN_REP :      WS_TYPE;
            PRE_PATTERN_INDEX_TO_INQ_PRE_PATTERN_REP : PATTERN_INDEX;
            PRE_PATTERN_REP_INQ :            ACCESS_COLOUR_MATRIX_TYPE;
         when INQ_PREDEFINED_COLOUR_REPRESENTATION =>
            WS_TO_INQ_PRE_COLOUR_REP :       WS_TYPE;
            PRE_COLOUR_INDEX_TO_INQ_PRE_COLOUR_REP : COLOUR_INDEX;
            PRE_COLOUR_REP_INQ       :       COLOUR_REPRESENTATION;
         when INQ_LIST_OF_AVAILABLE_GDP =>
            WS_TO_INQ_LIST_OF_AVAILABLE_GDP: WS_TYPE;
            LIST_OF_GDP_INQ          :       GDP_IDS.LIST_OF;
         when INQ_GDP =>
            WS_TO_INQ_GDP            :       WS_TYPE;
            GDP_TO_INQ_GDP          :        GDP_ID;
            LIST_OF_ATTRIBUTES_USED_INQ :   ATTRIBUTES_USED.LIST_OF;

   -- logical operation "inq_ws_state_list_0a"

         when INQ_WS_STATE =>
            WS_TO_INQ_STATE  :       WS_ID;
            WS_STATE_INQ     :       WS_STATE;
         when INQ_WS_DEFERRAL_AND_UPDATE_STATES =>
            WS_TO_INQ_DEFERRAL_AND_UPDATE_STATES :   WS_ID;
            DEFERRAL_INQ :           DEFERRAL_MODE;
            REGENERATION_INQ :       REGENERATION_MODE;
            DISPLAY_INQ      :       DISPLAY_SURFACE_EMPTY;
            FRAME_ACTION_INQ :       NEW_FRAME_NECESSARY;

   -- logical operation "pixels"

         when INQ_PIXEL_ARRAY_DIMENSIONS =>
            WS_TO_INQ_PIXEL_ARRAY_DIMENSIONS :       WS_ID;
            PIXEL_ARRAY_CORNER_1_1_INQ       :       NDC.POINT;
            PIXEL_ARRAY_CORNER_DX_DY_INQ     :       NDC.POINT;
            DIMENSIONS_INQ                   :     RASTER_UNIT_SIZE;
         when INQ_PIXEL_ARRAY =>
            WS_TO_INQ_PIXEL_ARRAY :  WS_ID;
            PIXEL_ARRAY_CORNER_INQ :  NDC.POINT;
            DX_INQ           :       RASTER_UNITS;
            DY_INQ           :       RASTER_UNITS;
            INVALID_VALUES_INQ :     INVALID_VALUES_INDICATOR;
            PIXEL_ARRAY_INQ  :       ACCESS_PIXEL_COLOUR_MATRIX_TYPE;
         when INQ_PIXEL =>
            WS_TO_INQ_PIXEL  :       WS_ID;
            PIXEL_POINT_INQ  :       NDC.POINT;
            PIXEL_COLOUR_INQ :       PIXEL_COLOUR_INDEX;

         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);

   -- LEVEL 0a
   -- logical operation "extended_output_primitives"

   subtype CGI_CELL_ARRAY is
      CGI_INSTR(OP => CELL_ARRAY);
   -- Generalized Drawing Primitives
   subtype CGI_CIRCLE is
      CGI_INSTR(OP => CIRCLE);

   -- logical operation "set_bundle_indices"

   subtype CGI_SET_POLYLINE_INDEX is
      CGI_INSTR(OP => SET_POLYLINE_INDEX);
   subtype CGI_SET_POLYMARKER_INDEX is
      CGI_INSTR(OP => SET_POLYMARKER_INDEX);
   subtype CGI_SET_TEXT_INDEX is
      CGI_INSTR(OP => SET_TEXT_INDEX);
   subtype CGI_SET_FILL_AREA_INDEX is
      CGI_INSTR(OP => SET_FILL_AREA_INDEX);

   -- logical operation "set_primitive_attributes_0a"

   subtype CGI_SET_TEXT_PATH is
      CGI_INSTR(OP => SET_TEXT_PATH);
   subtype CGI_SET_PATTERN_VECTORS is                        -- DR019
      CGI_INSTR(OP => SET_PATTERN_VECTORS);                  -- DR019
   subtype CGI_SET_PATTERN_REFERENCE_POINT is
      CGI_INSTR(OP => SET_PATTERN_REFERENCE_POINT);

   -- logical operation "set_individual_attributes_0a"

   subtype CGI_SET_LINE_WIDTH_SCALE_FACTOR is
      CGI_INSTR(OP => SET_LINE_WIDTH_SCALE_FACTOR);
   subtype CGI_SET_MARKER_SIZE_SCALE_FACTOR is
      CGI_INSTR(OP => SET_MARKER_SIZE_SCALE_FACTOR);
   subtype CGI_SET_TEXT_FONT_AND_PRECISION is
      CGI_INSTR(OP => SET_TEXT_FONT_AND_PRECISION);
   subtype CGI_SET_CHAR_EXPANSION_FACTOR is
      CGI_INSTR(OP => SET_CHAR_EXPANSION_FACTOR);
   subtype CGI_SET_CHAR_SPACING is
      CGI_INSTR(OP => SET_CHAR_SPACING);
   subtype CGI_SET_FILL_AREA_STYLE_INDEX is
      CGI_INSTR(OP => SET_FILL_AREA_STYLE_INDEX);
   subtype CGI_SET_ASF is
      CGI_INSTR(OP => SET_ASF);

   -- logical operation "inq_ws_description_table_0a"

   subtype CGI_INQ_WS_CATEGORY is
      CGI_INSTR(OP => INQ_WS_CATEGORY);
   subtype CGI_INQ_WS_CLASS is
      CGI_INSTR(OP => INQ_WS_CLASS);
   subtype CGI_INQ_PREDEFINED_POLYLINE_REPRESENTATION is
      CGI_INSTR(OP => INQ_PREDEFINED_POLYLINE_REPRESENTATION);
   subtype CGI_INQ_PREDEFINED_POLYMARKER_REPRESENTATION is
      CGI_INSTR(OP => INQ_PREDEFINED_POLYMARKER_REPRESENTATION);
   subtype CGI_INQ_PREDEFINED_TEXT_REPRESENTATION is
      CGI_INSTR(OP => INQ_PREDEFINED_TEXT_REPRESENTATION);
   subtype CGI_INQ_PREDEFINED_FILL_AREA_REPRESENTATION is
      CGI_INSTR(OP => INQ_PREDEFINED_FILL_AREA_REPRESENTATION);
   subtype CGI_INQ_PATTERN_FACILITIES is
      CGI_INSTR(OP => INQ_PATTERN_FACILITIES);
   subtype CGI_INQ_PREDEFINED_PATTERN_REPRESENTATION is
      CGI_INSTR(OP => INQ_PREDEFINED_PATTERN_REPRESENTATION);
   subtype CGI_INQ_PREDEFINED_COLOUR_REPRESENTATION is
      CGI_INSTR(OP => INQ_PREDEFINED_COLOUR_REPRESENTATION);
   subtype CGI_INQ_LIST_OF_AVAILABLE_GDP is
      CGI_INSTR(OP => INQ_LIST_OF_AVAILABLE_GDP);
   subtype CGI_INQ_GDP is
      CGI_INSTR(OP => INQ_GDP);

   -- logical operation "inq_ws_state_list_0a"

   subtype CGI_INQ_WS_STATE is
      CGI_INSTR(OP => INQ_WS_STATE);
   subtype CGI_INQ_WS_DEFERRAL_AND_UPDATE_STATES is
      CGI_INSTR(OP => INQ_WS_DEFERRAL_AND_UPDATE_STATES);

   -- logical operation "pixels"

   subtype CGI_INQ_PIXEL_ARRAY_DIMENSIONS is
      CGI_INSTR(OP => INQ_PIXEL_ARRAY_DIMENSIONS);
   subtype CGI_INQ_PIXEL_ARRAY is
      CGI_INSTR(OP => INQ_PIXEL_ARRAY);
   subtype CGI_INQ_PIXEL is
      CGI_INSTR(OP => INQ_PIXEL);

end CGI;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSM_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSM
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  wsm_0a.ada
-- level: 0a

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:0A:ERROR_ROUTINES_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: ERROR_ROUTINES
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  error_routines_0a.ada
-- level: 0a

with GKS_TYPES;

use GKS_TYPES;

package ERROR_ROUTINES is

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

   procedure EMERGENCY_CLOSE_GKS;

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

   procedure GET_ERROR
      (EI  : out ERROR_INDICATOR;
      NAME : out VARIABLE_SUBPROGRAM_NAME);

end ERROR_ROUTINES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:EXT_OUT_PRIM.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: EXTENDED_OUTPUT_PRIMITIVES
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  ext_out_prim.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with GKS_TYPES;

use GKS_TYPES;

package EXTENDED_OUTPUT_PRIMITIVES is

-- This package provides the extended output primitives
-- for level 0a.

   procedure CELL_ARRAY
      (CORNER_1_1 : in WC.POINT;
      CORNER_DX_DY: in WC.POINT;
      CELL        : in COLOUR_MATRICES.MATRIX_OF);

   procedure GDP_CIRCLE
      (CENTER          : in WC.POINT;
      PERIPHERAL_POINT : in WC.POINT);

end EXTENDED_OUTPUT_PRIMITIVES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--: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:0A:INQ_GKS_DSCR_TBL_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_GKS_DESCRIPTION_TABLE_0A
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_gks_dscr_tbl_0a.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with GKS_TYPES;

use GKS_TYPES;

package INQ_GKS_DESCRIPTION_TABLE_0A is

-- This package provides the procedures for inquiring the
-- GKS_DESCRIPTION_TABLE for level 0a.

   procedure INQ_LIST_OF_AVAILABLE_WS_TYPES
      (EI   : out ERROR_INDICATOR;
      TYPES : out WS_TYPES.LIST_OF);

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

end INQ_GKS_DESCRIPTION_TABLE_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:INQ_GKS_ST_LST_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_GKS_STATE_LIST_0A
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_gks_st_lst_0a.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with GKS_TYPES;

use GKS_TYPES;

package INQ_GKS_STATE_LIST_0A is

-- This package provides the procedures to inquire the GKS_
-- STATE_LIST at levels no lower than 0a.

   procedure INQ_OPERATING_STATE_VALUE
      (VALUE : out OPERATING_STATE);

   procedure INQ_SET_OF_OPEN_WS
      (EI : out ERROR_INDICATOR;
      WS  : out WS_IDS.LIST_OF);

   procedure INQ_LIST_OF_NORMALIZATION_TRANSFORMATION_NUMBERS
      (EI  : out ERROR_INDICATOR;
      LIST : out TRANSFORMATION_PRIORITY_LIST);

end INQ_GKS_STATE_LIST_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:INQ_WS_DSCR_TBL_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-- file:  inq_ws_dscr_tbl_0a.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with GKS_TYPES;

use GKS_TYPES;

package INQ_WS_DESCRIPTION_TABLE_0A is

-- This package provides the procedures for inquiring the work-
-- station description table.

   procedure INQ_WS_CATEGORY
      (WS      : in WS_TYPE;
      EI       : out ERROR_INDICATOR;
      CATEGORY : out WS_CATEGORY);

   procedure INQ_WS_CLASS
      (WS   : in WS_TYPE;
      EI    : out ERROR_INDICATOR;
      CLASS : out DISPLAY_CLASS);

   procedure INQ_PREDEFINED_POLYLINE_REPRESENTATION
      (WS    : in WS_TYPE;
      INDEX  : in POLYLINE_INDEX;
      EI     : out ERROR_INDICATOR;
      LINE   : out LINETYPE;
      WIDTH  : out LINE_WIDTH;
      COLOUR : out COLOUR_INDEX);

   procedure INQ_PREDEFINED_POLYMARKER_REPRESENTATION
      (WS    : in WS_TYPE;
      INDEX  : in POLYMARKER_INDEX;
      EI     : out ERROR_INDICATOR;
      MARKER : out MARKER_TYPE;
      SIZE   : out MARKER_SIZE;
      COLOUR : out COLOUR_INDEX);

   procedure INQ_PREDEFINED_TEXT_REPRESENTATION
      (WS            : in WS_TYPE;
      INDEX          : in TEXT_INDEX;
      EI             : out ERROR_INDICATOR;
      FONT_PRECISION : out TEXT_FONT_PRECISION;
      EXPANSION      : out CHAR_EXPANSION;
      SPACING        : out CHAR_SPACING;
      COLOUR         : out COLOUR_INDEX);

   procedure INQ_PREDEFINED_FILL_AREA_REPRESENTATION
      (WS      : in WS_TYPE;
      INDEX    : in FILL_AREA_INDEX;
      EI       : out ERROR_INDICATOR;
      INTERIOR : out INTERIOR_STYLE;
      STYLE    : out STYLE_INDEX;
      COLOUR   : out COLOUR_INDEX);

   procedure INQ_PATTERN_FACILITIES
      (WS               : in WS_TYPE;
      EI                : out ERROR_INDICATOR;
      NUMBER_OF_INDICES : out NATURAL);

   procedure INQ_PREDEFINED_PATTERN_REPRESENTATION
      (WS     : in WS_TYPE;
      INDEX   : in PATTERN_INDEX;
      EI      : out ERROR_INDICATOR;
      LAST_X  : out NATURAL;
      LAST_Y  : out NATURAL;
      PATTERN : out COLOUR_MATRICES.VARIABLE_MATRIX_OF);

   procedure INQ_PREDEFINED_COLOUR_REPRESENTATION
      (WS    : in WS_TYPE;
      INDEX  : in COLOUR_INDEX;
      EI     : out ERROR_INDICATOR;
      COLOUR : out COLOUR_REPRESENTATION);

   procedure INQ_LIST_OF_AVAILABLE_GDP
      (WS         : in WS_TYPE;
      EI          : out ERROR_INDICATOR;
      LIST_OF_GDP : out GDP_IDS.LIST_OF);

   procedure INQ_GDP
      (WS    : in WS_TYPE;
      GDP    : in GDP_ID;
      EI     : out ERROR_INDICATOR;
      LIST_OF_ATTRIBUTES_USED : out ATTRIBUTES_USED.LIST_OF);

end INQ_WS_DESCRIPTION_TABLE_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:INQ_WS_ST_LST_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_WS_STATE_LIST_0A
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_ws_st_lst_0a.ada
-- level: 0a, 1a, 2a, 0b, 0c

with GKS_TYPES;

use GKS_TYPES;

package INQ_WS_STATE_LIST_0A is

-- This package provides the procedures for calling the work-
-- station manager to inquire the workstation state lists
-- at levels no lower than 0a.

   procedure INQ_WS_STATE
      (WS   : in WS_ID;
      EI    : out ERROR_INDICATOR;
      STATE : out WS_STATE);

   procedure INQ_WS_DEFERRAL_AND_UPDATE_STATES
      (WS          : in WS_ID;
      EI           : out ERROR_INDICATOR;
      DEFERRAL     : out DEFERRAL_MODE;
      REGENERATION : out REGENERATION_MODE;
      DISPLAY      : out DISPLAY_SURFACE_EMPTY;
      FRAME_ACTION : out NEW_FRAME_NECESSARY);

end INQ_WS_STATE_LIST_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:PIXELS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-- file:  pixels.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with GKS_TYPES;

use GKS_TYPES;

package PIXELS is

-- This package provides the procedures for calling the work-
-- station manager to inquire information about pixels.

   procedure INQ_PIXEL_ARRAY_DIMENSIONS
      (WS          : in WS_ID;
      CORNER_1_1   : in WC.POINT;
      CORNER_DX_DY : in WC.POINT;
      EI           : out ERROR_INDICATOR;
      DIMENSIONS   : out RASTER_UNIT_SIZE);

   procedure INQ_PIXEL_ARRAY
      (WS            : in WS_ID;
      CORNER         : in WC.POINT;
      DX             : in RASTER_UNITS;
      DY             : in RASTER_UNITS;
      EI             : out ERROR_INDICATOR;
      INVALID_VALUES : out INVALID_VALUES_INDICATOR;
      LAST_X         : out NATURAL;
      LAST_Y         : out NATURAL;
      PIXEL_ARRAY    : out PIXEL_COLOUR_MATRICES.VARIABLE_MATRIX_OF);

   procedure INQ_PIXEL
      (WS    : in WS_ID;
      POINT  : in WC.POINT;
      EI     : out ERROR_INDICATOR;
      COLOUR : out PIXEL_COLOUR_INDEX);

end PIXELS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:SET_BUNDLE_IDX.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_BUNDLE_INDICES
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  set_bundle_idx.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with GKS_TYPES;

use GKS_TYPES;

package SET_BUNDLE_INDICES is

-- This package provides the procedures for setting the values of
-- the bundle table indices.

   procedure SET_POLYLINE_INDEX
      (INDEX : in POLYLINE_INDEX);

   procedure SET_POLYMARKER_INDEX
      (INDEX : in POLYMARKER_INDEX);

   procedure SET_TEXT_INDEX
      (INDEX : in TEXT_INDEX);

   procedure SET_FILL_AREA_INDEX
      (INDEX : in FILL_AREA_INDEX);

end SET_BUNDLE_INDICES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:SET_INDV_ATTR_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_INDIVIDUAL_ATTRIBUTES_0A
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  set_indv_attr_0a.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with GKS_TYPES;

use GKS_TYPES;

package SET_INDIVIDUAL_ATTRIBUTES_0A is

-- This package provides the procedures for setting the values of
-- the workstation independent primitive attributes.

   procedure SET_LINEWIDTH_SCALE_FACTOR
      (WIDTH : in LINE_WIDTH);

   procedure SET_MARKER_SIZE_SCALE_FACTOR
      (SIZE : in MARKER_SIZE);

   procedure SET_TEXT_FONT_AND_PRECISION
      (FONT_PRECISION : in TEXT_FONT_PRECISION);

   procedure SET_CHAR_EXPANSION_FACTOR
      (EXPANSION : in CHAR_EXPANSION);

   procedure SET_CHAR_SPACING
      (SPACING : in CHAR_SPACING);

   procedure SET_FILL_AREA_STYLE_INDEX
      (INDEX : in STYLE_INDEX);

   procedure SET_ASF
      (ASF : in ASF_LIST);

end SET_INDIVIDUAL_ATTRIBUTES_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:SET_PRIM_ATTR_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_PRIMITIVE_ATTRIBUTES_0A
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  set_prim_attr_0a.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with GKS_TYPES;

use GKS_TYPES;

package SET_PRIMITIVE_ATTRIBUTES_0A is

-- This package provides the procedures for setting the values
-- of the workstation independent primitive attributes.

   procedure SET_TEXT_PATH
      (PATH : in TEXT_PATH);

   procedure SET_PATTERN_SIZE
      (SIZE : in WC.SIZE);

   procedure SET_PATTERN_REFERENCE_POINT
      (POINT : in WC.POINT);

end SET_PRIMITIVE_ATTRIBUTES_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:GKS_DSCR_TBL_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_DESCRIPTION_TABLE
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR026  Initialization of list of available ws types fix.
------------------------------------------------------------------
-- file:  gks_dscr_tbl_0a.ada
 --level: 0a

with GKS_CONFIGURATION;
with GKS_TYPES;

use GKS_TYPES;

package GKS_DESCRIPTION_TABLE is

   LEVEL_OF_GKS               : GKS_LEVEL := L0A;

   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_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_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:0A:GKS_TRIG_LIB.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_TRIG_LIB
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  gks_trig_lib.ada
-- level: 0a, 1a, 2a

with GKS_TYPES;

use GKS_TYPES;

generic

   type COORDINATE_TYPE is digits <>;

package GKS_TRIG_LIB is

-- The package GKS_TRIG_LIB contains trigonometric functions.

   function SIN
      (X : RADIANS ) return COORDINATE_TYPE;

   function COS
      (X : RADIANS ) return COORDINATE_TYPE;

end GKS_TRIG_LIB;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:GKS_TRIG_LIB_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_TRIG_LIB - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file  : gks_trig_lib_b.ada
-- level : 1a

package body GKS_TRIG_LIB is
-- The package GKS_TRIG_LIB contains trigonometric functions.

   ZERO  : constant COORDINATE_TYPE := 0.0;
   HALF  : constant COORDINATE_TYPE := 0.5;
   ONE   : constant COORDINATE_TYPE := 1.0;
   TWO   : constant COORDINATE_TYPE := 2.0;

   IT    : constant INTEGER := 27;
   IBETA : constant INTEGER := 2;

   PI          : constant COORDINATE_TYPE := 3.14159_26535_89793_23846;
   ONE_OVER_PI : constant COORDINATE_TYPE := 0.31830_98861_83790_67154;
   PI_OVER_TWO : constant COORDINATE_TYPE := 1.57079_63267_94896_61923;


   function TRUNCATE
      (X : COORDINATE_TYPE) return COORDINATE_TYPE is

   -- The function TRUNCATE extracts the mantissa and returns the
   -- characteristic.
   --
   -- X - Represents the floating point number being truncated.

   begin

      if (COORDINATE_TYPE (INTEGER(X)) ) = X then
         return X;
      elsif X > ZERO then
         return COORDINATE_TYPE (INTEGER(X-HALF));
      elsif X = ZERO then
         return ZERO;
      else  -- X < ZERO
         return COORDINATE_TYPE (INTEGER(X+HALF));
      end if;

   end TRUNCATE;


   function R
      (G : COORDINATE_TYPE) return COORDINATE_TYPE is

   -- This function is used to compute the formula given in
   -- in the return statement.  This value is used in the other
   -- trigonometric functions.
   --
   -- G - Defines a floating point value.

      R1 : constant COORDINATE_TYPE := -0.16666_66660_883;
      R2 : constant COORDINATE_TYPE :=  0.83333_30720_556E-2;
      R3 : constant COORDINATE_TYPE := -0.19840_83282_313E-3;
      R4 : constant COORDINATE_TYPE :=  0.27523_97106_775E-5;
      R5 : constant COORDINATE_TYPE := -0.23868_34640_601E-7;

   begin

      return ((((R5*G + R4)*G + R3)*G + R2)*G + R1)*G;

   end R;


   function SIN (X : RADIANS) return COORDINATE_TYPE is separate;


   function COS (X : RADIANS) return COORDINATE_TYPE is separate;


end GKS_TRIG_LIB;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:COS_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: COS
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file : cos_s.ada
-- level: 1a

separate (GKS_TRIG_LIB)

function COS
   (X : RADIANS) return COORDINATE_TYPE is

-- The algorithm in use, is taken from Software Manual for the
-- Elementary Functions by William J. Cody Jr. and William Waite.
--
-- Let |X| = N * pi + f  where |f| <= pi/2
-- then cos (X) = sin (X + pi/2)
--
-- It is accomplished by
-- 1. Reduction of X to a given argument f.
-- 2. Evaluate SIN (f) over a small interval symmetric about the
--    origin.
-- 3. Reconstruction of the desired function value.
--
-- X - The coordinate in radians on which the cos function is
--     performed.

   SIGN          : COORDINATE_TYPE;
   INT_X_OVER_PI : INTEGER;
   X_OVER_PI     : COORDINATE_TYPE;
   F, G          : COORDINATE_TYPE;
   X_PREFIX      : COORDINATE_TYPE;
   X_MANTISSA    : COORDINATE_TYPE;
   RESULT        : COORDINATE_TYPE;
   X_INPUT       : COORDINATE_TYPE := COORDINATE_TYPE (X);

   X_MAX   : COORDINATE_TYPE :=
             COORDINATE_TYPE ( INTEGER (PI * TWO**(IT/2) ) );
   BETA    : COORDINATE_TYPE := COORDINATE_TYPE(IBETA);
   EPSILON : COORDINATE_TYPE := BETA ** (-IT/2);

   -- pi = C1 + C2
   C1 : constant COORDINATE_TYPE := 3.140625;
   C2 : constant COORDINATE_TYPE := 9.6765_35897_93E-4;


begin

   -- cos (-X) = cos (X) so the sign is always positive.
   SIGN    := ONE;

   -- cos (X) = sin (X + pi/2) so X = X + pi/2
   X_INPUT := ABS (X_INPUT) + PI_OVER_TWO;

   -- X too large?
   if X_INPUT > X_MAX  then
      raise SYSTEM_ERROR;
   end if;

   INT_X_OVER_PI := INTEGER (X_INPUT * ONE_OVER_PI);
   X_OVER_PI     := COORDINATE_TYPE (INT_X_OVER_PI);

   -- Determine (-1)**N and multiply by SIGN (X)
   if (INT_X_OVER_PI) mod 2 /= 0  then
      SIGN := -SIGN;
   end if;

   X_OVER_PI := X_OVER_PI - 0.5;     -- TO FORM COS INSTEAD OF SIN

   X_PREFIX   := TRUNCATE (COORDINATE_TYPE (ABS (X)) );
   X_MANTISSA := COORDINATE_TYPE (ABS (X)) - X_PREFIX;

   -- Reduce X to a given argument f.
   -- Remember C1 + C2 = pi and X_PREFIX + X_MANTISSA = |X|
   F  := ((X_PREFIX - X_OVER_PI * C1) + X_MANTISSA) - X_OVER_PI * C2;

   if ABS(F) < EPSILON  then -- f small enough so SIN (f) = f
      RESULT := F;

   else  -- R evaluates sin (f) and the value is reconstructed.
      G      := F * F;
      RESULT := F + F*R(G);
   end if;

   return (SIGN * RESULT);

end COS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:SIN_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SIN
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file : sin_s.ada
-- level: 1a

separate (GKS_TRIG_LIB)

function SIN
   (X : RADIANS ) return COORDINATE_TYPE is

-- The algorithm used is taken from Software Manual for the
-- Elementary Functions by William J. Cody Jr. and William Waite.
--
-- Let |X| = N * pi + f   where  |f| <= pi/2
-- then sin (X) = sign (X) * sin (f) * (-1) ** N
--
-- It is accomplished by
--  1. Reduction of X to a given argument f.
--  2. Evaluate SIN (f) over a small interval symmetric about
--     the origin.
--  3. Reconstruction of the desired function value.
--
-- X - The coordinate in radians on which the sin function is
--     performed.

   SIGN          : COORDINATE_TYPE;
   INT_X_OVER_PI : INTEGER;
   X_OVER_PI     : COORDINATE_TYPE;
   F, G          : COORDINATE_TYPE;
   X_PREFIX      : COORDINATE_TYPE;
   X_MANTISSA    : COORDINATE_TYPE;
   RESULT        : COORDINATE_TYPE;
   X_INPUT       : COORDINATE_TYPE := COORDINATE_TYPE (X);

   X_MAX    : COORDINATE_TYPE :=
              COORDINATE_TYPE (INTEGER(PI * TWO**(IT/2)));
   BETA     : COORDINATE_TYPE := COORDINATE_TYPE(IBETA);
   EPSILON  : COORDINATE_TYPE := BETA ** (-IT/2);

   -- pi = C1 + C2
   C1 : constant COORDINATE_TYPE := 3.140625;
   C2 : constant COORDINATE_TYPE := 9.6765_35897_93E-4;

   begin

      -- Determine SIGN (X) and |X|
      if X_INPUT < ZERO  then
        SIGN    := -ONE;
        X_INPUT := -X_INPUT;
      else
        SIGN    := ONE;
      end if;

      -- X to large?
      if X_INPUT > X_MAX  then
         raise SYSTEM_ERROR;
      end if;

      INT_X_OVER_PI := INTEGER (X_INPUT * ONE_OVER_PI);
      X_OVER_PI     := COORDINATE_TYPE (INT_X_OVER_PI);


      -- Determine (-1)**N and multiply by SIGN (X)
      if (INT_X_OVER_PI) mod 2 /= 0  then
        SIGN := -SIGN;
      end if;

      X_PREFIX   := TRUNCATE (X_INPUT);
      X_MANTISSA := X_INPUT - X_PREFIX;

      -- Reduce X to a given argument f.
      -- Remember C1 + C2 = pi and X_PREFIX + X_MANTISSA = |X|
      F  := ((X_PREFIX - X_OVER_PI * C1) + X_MANTISSA) - X_OVER_PI * C2;

      if ABS(F) < EPSILON  then -- f small enough so SIN (f) = f
        RESULT := F;

      else -- R evaluates sin (f) and the value is reconstructed.
        G      := F * F;
        RESULT := F + F*R(G);
      end if;

      return (SIGN * RESULT);

   end SIN;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--: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:0A:GKS_NORM_0A_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: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

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;
with SET_PRIMITIVE_ATTRIBUTES_0A;

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.

   PATTERN_SIZE : WC.SIZE;
   -- This object is used to store the current pattern size as
   -- it is converted from height and width vectors in the GKS_STATE_
   -- LIST.  It is then used as the actual parameter in the
   -- SET_PATTERN_SIZE call.

   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);

   PATTERN_SIZE := (XAXIS => WC.MAGNITUDE(GKS_STATE_LIST.
      CURRENT_PATTERN_WIDTH_VECTOR.X),
      YAXIS => WC.MAGNITUDE(GKS_STATE_LIST.
      CURRENT_PATTERN_HEIGHT_VECTOR.Y));

   SET_PRIMITIVE_ATTRIBUTES_0A.SET_PATTERN_SIZE(PATTERN_SIZE);

   SET_PRIMITIVE_ATTRIBUTES_0A.SET_PATTERN_REFERENCE_POINT
      (GKS_STATE_LIST.CURRENT_PATTERN_REFERENCE_POINT);

   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;

   PATTERN_SIZE : WC.SIZE;
   -- This object is used to store the current pattern size as
   -- it is converted from height and width vectors in the GKS_STATE_
   -- LIST.  It is then used as the actual parameter in the
   -- SET_PATTERN_SIZE call.

   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);

   PATTERN_SIZE := (XAXIS => WC.MAGNITUDE(GKS_STATE_LIST.
      CURRENT_PATTERN_WIDTH_VECTOR.X),
      YAXIS => WC.MAGNITUDE(GKS_STATE_LIST.
      CURRENT_PATTERN_HEIGHT_VECTOR.Y));

   SET_PRIMITIVE_ATTRIBUTES_0A.SET_PATTERN_SIZE(PATTERN_SIZE);

   SET_PRIMITIVE_ATTRIBUTES_0A.SET_PATTERN_REFERENCE_POINT
      (GKS_STATE_LIST.CURRENT_PATTERN_REFERENCE_POINT);

      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 occured.
   -- 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 sytles
   --  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: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: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: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: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: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: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:0A:GKS_DSCR_TBL_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GKS_DESCRIPTION_TABLE - BODY
--  IDENTIFIER: GIMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR036  Remove WISS_TYPE from level 1a.
------------------------------------------------------------------
-- file:  gks_dscr_tlb_0a_b.ada
-- level: 0a

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.

WS_TYPE_ARRAY : WS_TYPES.LIST_VALUES(1..3);
-- This object is used to store the available workstation types
-- prior to their input into the LIST_OF_AVAILABLE_WS_TYPES.

begin

   WS_TYPE_ARRAY := (WS_TYPE(GKS_CONFIGURATION.
                    LEXIDATA_3700_OUTPUT_TYPE,
                    WS_TYPE(GKS_CONFIGURATION.GKSM_MO,
                    WS_TYPE(GKS_CONFIGURATION.GKSM_MI));

   LIST_OF_AVAILABLE_WS_TYPES := WS_TYPES.LIST (WS_TYPE_ARRAY);

end GKS_DESCRIPTION_TABLE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:PIXELS_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: PIXELS - BODY
--  IDENTIFIER: GIMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR032  INQ_PIXEL_ARRAY constraint error.
------------------------------------------------------------------
-- file:  pixels_b.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with WSM;
with CGI;
with GKS_OPERATING_STATE_LIST;
with GKS_ERRORS;
with GKS_STATE_LIST;
with TRANSFORMATION_MATH;

use WSM;
use CGI;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body PIXELS is

-- This is the package body providing the procedures to call the
-- workstation manager to inquire information about pixels.
--
-- 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 is not, error
-- indicator 7 occurs but no exception is raised.  In addition,
-- each procedure inquires the GKS_STATE_LIST to see if the
-- workstation is in the set of open workstations.  If it is not,
-- error indicator 25 occurs but no exception is raised.

   procedure INQ_PIXEL_ARRAY_DIMENSIONS
      (WS          : in WS_ID;
      CORNER_1_1   : in WC.POINT;
      CORNER_DX_DY : in WC.POINT;
      EI          : out ERROR_INDICATOR;
      DIMENSIONS  : out RASTER_UNIT_SIZE) is

   -- This procedure calls the workstation manager to obtain the
   -- dimensions of the pixel array.  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 - Determines the specified workstation whose device
   --    coordinate resolution will be used to calculate the
   --    dimension of the pixel array.
   -- CORNER_1_1 - Specifies the lower left point of the inquired
   --    pixel array area.
   -- CORNER_DX_DY - Specifies the upper right point of the inquired
   --    pixel array area.
   -- EI - Returns an error code, if any.
   -- DIMENSIONS - Returns the dimensions in raster units of the
   --    inquired pixel area.

   GKS_INSTR : CGI_INQ_PIXEL_ARRAY_DIMENSIONS;

   begin

      -- The following if structure inquires the GKS_OPERATING_
      -- STATE_LIST to see if GKS is in the correct state.  Then
      -- it inquires the GKS_STATE_LIST to see if the WS is in the
      -- set of open workstations.  If both conditions are true,
      -- the call to the WS_MANAGER is made.

      if (CURRENT_OPERATING_STATE = GKCL) or
         (CURRENT_OPERATING_STATE = GKOP) then
         EI := NOT_WSOP_WSAC_SGOP;           -- Error 7
         DIMENSIONS := (X => RASTER_UNITS'FIRST,
                        Y => RASTER_UNITS'FIRST);

      elsif not WS_IDS.IS_IN_LIST (WS,GKS_STATE_LIST.LIST_OF_OPEN_WS)
         then
         EI := WS_NOT_OPEN;                  -- Error 25
         DIMENSIONS := (X => RASTER_UNITS'FIRST,
                        Y => RASTER_UNITS'FIRST);

      else
         GKS_INSTR.WS_TO_INQ_PIXEL_ARRAY_DIMENSIONS := WS;

         -- Transformation logic to transform the 2 points passed in
         -- from WC to NDC.

         GKS_INSTR.PIXEL_ARRAY_CORNER_1_1_INQ := TRANSFORMATION_MATH.
            WC_TO_NDC(GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
            .NDC_FACTORS, CORNER_1_1);

         GKS_INSTR.PIXEL_ARRAY_CORNER_DX_DY_INQ := TRANSFORMATION_MATH.
            WC_TO_NDC(GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
            .NDC_FACTORS, CORNER_DX_DY);

         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;

         DIMENSIONS := GKS_INSTR.DIMENSIONS_INQ;

      end if;

      exception
         when NUMERIC_ERROR =>
            EI := ARITHMETIC;                         -- Error 308

   end INQ_PIXEL_ARRAY_DIMENSIONS;

   procedure INQ_PIXEL_ARRAY
      (WS            : in WS_ID;
      CORNER         : in WC.POINT;
      DX             : in RASTER_UNITS;
      DY             : in RASTER_UNITS;
      EI             : out ERROR_INDICATOR;
      INVALID_VALUES : out INVALID_VALUES_INDICATOR;
      LAST_X         : out NATURAL;
      LAST_Y         : out NATURAL;
      PIXEL_ARRAY    : out PIXEL_COLOUR_MATRICES.VARIABLE_MATRIX_OF) is

   -- This procedure calls the workstation manager to obtain the
   -- presence of invalid values and the colour index array.  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
   -- either error 39, or 40 to indicate the reason for non-
   -- availability.
   --
   -- WS - Determines the specified workstation whose pixels
   --    will be inquired for colour values.
   -- CORNER - The point in WC that will be transformed to NDC and
   --    sent to CGI as the initial point where the pixels will
   --    be inquired for colour values.
   -- DX, DY - These parameters were originally meant to provide the
   --    dimensions of the PIXEL_ARRAY.  Since the PIXEL_ARRAY variable
   --    has the DX and DY as discriminants, these parameters are
   --    essentially ignored.
   -- EI - Returns the error code, if any.
   -- INVALID_VALUES - A flag to indicate the presence of pixels
   --    which had been transformed outside the workstation's
   --    viewport.
   -- LAST_X, LAST_Y - These are the actual dimensions of the pixel
   --    matrix.  The parameters were added for this implementation to
   --    notify the application of the extent of the true pixel colour
   --    indices returned.
   -- PIXEL_ARRAY - The array of colour values of the pixel area
   --    inquired on the workstation.

   GKS_INSTR : CGI_INQ_PIXEL_ARRAY;

   INVALID_PIXEL_ARRAY : PIXEL_COLOUR_MATRICES.VARIABLE_MATRIX_OF
                         (PIXEL_ARRAY.DX,PIXEL_ARRAY.DY);

   begin

      -- The following if structure inquires the GKS_OPERATING_
      -- STATE_LIST to see if GKS is in the correct state.  Then
      -- it inquires the GKS_STATE_LIST to see if the WS is in the
      -- set of open workstations.  If both conditions are true,
      -- the call to the WS_MANAGER is made.

      if (CURRENT_OPERATING_STATE = GKCL) or
         (CURRENT_OPERATING_STATE = GKOP) then
         EI := NOT_WSOP_WSAC_SGOP;           -- Error 7
         INVALID_VALUES := INVALID_VALUES_INDICATOR'FIRST;
         PIXEL_ARRAY := INVALID_PIXEL_ARRAY;

      elsif not WS_IDS.IS_IN_LIST (WS,GKS_STATE_LIST.LIST_OF_OPEN_WS)
         then
         EI := WS_NOT_OPEN;                  -- Error 25
         INVALID_VALUES := INVALID_VALUES_INDICATOR'FIRST;
         PIXEL_ARRAY := INVALID_PIXEL_ARRAY;

      else

         GKS_INSTR.WS_TO_INQ_PIXEL_ARRAY := WS;

         -- Transformation logic to transform the point passed in
         -- from WC to NDC.

         GKS_INSTR.PIXEL_ARRAY_CORNER_INQ:=TRANSFORMATION_MATH.WC_TO_NDC
            (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
            .NDC_FACTORS, CORNER);

         GKS_INSTR.DX_INQ := RASTER_UNITS(PIXEL_ARRAY.DX);
         GKS_INSTR.DY_INQ := RASTER_UNITS(PIXEL_ARRAY.DY);

         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then                  -- Error 0
            if (GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN) or        -- Error 39
               (GKS_INSTR.EI = WS_CANNOT_PIXEL_READBACK) then -- Error 40
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                 -- Error 2501
            end if;
         else
            EI := GKS_INSTR.EI;               -- Error 0
         end if;

         INVALID_VALUES := GKS_INSTR.INVALID_VALUES_INQ;
         LAST_X := NATURAL(GKS_INSTR.PIXEL_ARRAY_INQ'LENGTH(1));
         LAST_Y := NATURAL(GKS_INSTR.PIXEL_ARRAY_INQ'LENGTH(2));

         if (PIXEL_ARRAY.DX < SMALL_NATURAL(GKS_INSTR.
            PIXEL_ARRAY_INQ'LENGTH(1))) then
            for INDEX1 in POSITIVE(1) .. POSITIVE(PIXEL_ARRAY.DX) loop
                if PIXEL_ARRAY.DY < SMALL_NATURAL(GKS_INSTR.
                   PIXEL_ARRAY_INQ'LENGTH(2)) then
                   for INDEX2 in POSITIVE(1) .. POSITIVE(PIXEL_ARRAY.DY)
                   loop
                      PIXEL_ARRAY.MATRIX(INDEX1,INDEX2) :=
                              GKS_INSTR.PIXEL_ARRAY_INQ(INDEX1,INDEX2);
                    end loop;
                 else
                    for INDEX2 in POSITIVE(1) .. POSITIVE(GKS_INSTR.
                       PIXEL_ARRAY_INQ'LENGTH(2)) loop
                       PIXEL_ARRAY.MATRIX(INDEX1,INDEX2) :=
                           GKS_INSTR.PIXEL_ARRAY_INQ(INDEX1,INDEX2);
                    end loop;
                 end if;
            end loop;
         else
             for INDEX1 in POSITIVE(1) .. POSITIVE(GKS_INSTR.
                PIXEL_ARRAY_INQ'LENGTH(1)) loop
                if PIXEL_ARRAY.DY < SMALL_NATURAL(GKS_INSTR.
                   PIXEL_ARRAY_INQ'LENGTH(2)) then
                   for INDEX2 in POSITIVE(1) .. POSITIVE(PIXEL_ARRAY.DY)
                   loop
                      PIXEL_ARRAY.MATRIX(INDEX1,INDEX2) :=
                           GKS_INSTR.PIXEL_ARRAY_INQ(INDEX1,INDEX2);
                   end loop;
                 else
                    for INDEX2 in POSITIVE(1) .. POSITIVE(GKS_INSTR.
                       PIXEL_ARRAY_INQ'LENGTH(2)) loop
                       PIXEL_ARRAY.MATRIX(INDEX1,INDEX2) :=
                           GKS_INSTR.PIXEL_ARRAY_INQ(INDEX1,INDEX2);
                    end loop;
                 end if;
            end loop;
         end if;

         FREE_PIXEL_COLOUR_MATRIX (GKS_INSTR.PIXEL_ARRAY_INQ);

      end if;

      exception
         when NUMERIC_ERROR =>
            EI := ARITHMETIC;              -- Error 308
            INVALID_VALUES := INVALID_VALUES_INDICATOR'FIRST;
            PIXEL_ARRAY := INVALID_PIXEL_ARRAY;

   end INQ_PIXEL_ARRAY;

   procedure INQ_PIXEL
      (WS    : in WS_ID;
      POINT  : in WC.POINT;
      EI     : out ERROR_INDICATOR;
      COLOUR : out PIXEL_COLOUR_INDEX) is

   -- This procedure calls the workstation manager to obtain the
   -- colour index of the pixel.  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 set to 39, or 40 to indicate the
   -- reason for non-availability.
   --
   -- WS - The specified workstation.
   -- POINT - The WC point which when transformed to NDC will be
   --    passed to WS_MANAGER for inquiring the DC pixel colour.
   -- EI - returns the error code, if any.
   -- COLOUR - Returns the colour of the pixel of a valid point
   --    on the workstation viewport.

   GKS_INSTR : CGI_INQ_PIXEL;

   begin

      -- The following if structure inquires the GKS_OPERATING_
      -- STATE_LIST to see if GKS is in the correct state.  Then
      -- it inquires the GKS_STATE_LIST to see if the WS is in the
      -- set of open workstations.  If both conditions are true,
      -- the call to the WS_MANAGER is made.

      if (CURRENT_OPERATING_STATE = GKCL) or
         (CURRENT_OPERATING_STATE = GKOP) then
         EI := NOT_WSOP_WSAC_SGOP;           -- Error 7
         COLOUR := PIXEL_COLOUR_INDEX'FIRST;

      elsif not WS_IDS.IS_IN_LIST (WS,GKS_STATE_LIST.LIST_OF_OPEN_WS)
         then
         EI := WS_NOT_OPEN;                  -- Error 25
         COLOUR := PIXEL_COLOUR_INDEX'FIRST;

      else
         GKS_INSTR.WS_TO_INQ_PIXEL := WS;

         -- Transformation logic to transform the point passed in
         -- from WC to NDC.

         GKS_INSTR.PIXEL_POINT_INQ := TRANSFORMATION_MATH.WC_TO_NDC
            (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
            .NDC_FACTORS, POINT);

         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then                    -- Error 0
            if (GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN) or         -- Error 39
               (GKS_INSTR.EI = WS_CANNOT_PIXEL_READBACK) then  -- Error 40
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                         -- Error 2501
            end if;
         else
            EI := GKS_INSTR.EI;
         end if;

         COLOUR := GKS_INSTR.PIXEL_COLOUR_INQ;

      end if;

      exception
         when NUMERIC_ERROR =>
            EI := ARITHMETIC;

   end INQ_PIXEL;

end PIXELS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:INQ_GKS_DSCR_TBL_0AB.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_GKS_DESCRIPTION_TABLE_0A
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_gks_dscr_tbl_0ab.ada
-- level: 0a, 1a, 2a, 0b, 0c

with GKS_OPERATING_STATE_LIST;
with GKS_DESCRIPTION_TABLE;
with GKS_ERRORS;

use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body INQ_GKS_DESCRIPTION_TABLE_0A is

-- This is the package body for the procedures to inquire the
-- GKS_DESCRIPTION_TABLE.
--
-- Each of the procedures in this package inquires the
-- GKS_OPERATING_STATE_LIST to check if GKS is in one of
-- the states GKCL, GKOP, WSOP, WSAC, SGOP.  If it is not,
-- error 8 occurs but no exception is raised.

   procedure INQ_LIST_OF_AVAILABLE_WS_TYPES
      (EI   : out ERROR_INDICATOR;
      TYPES : out WS_TYPES.LIST_OF) is

   -- This procedure inquires the GKS_DESCRIPTION_TABLE to obtain the
   -- list of available workstation types.  If the inquired information
   -- is available, the error indicator is set to 0.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- TYPES - This is a list type of workstation types.  Its components
   --    are set for each one of the corresponding available workstation
   --    type is available.

   begin

      -- The following if structure 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
         TYPES := WS_TYPES.NULL_LIST;
      else
         EI := SUCCESSFUL;                -- Error 0
         TYPES := GKS_DESCRIPTION_TABLE.LIST_OF_AVAILABLE_WS_TYPES;
      end if;


   end INQ_LIST_OF_AVAILABLE_WS_TYPES;

   procedure INQ_MAX_NORMALIZATION_TRANSFORMATION_NUMBER
      (EI : out ERROR_INDICATOR;
      TRANSFORMATION : out TRANSFORMATION_NUMBER) is

   -- This procedure inquires the GKS_DESCRIPTION_TABLE to obtain the
   -- maximum normalization transformation number.  If the inquired
   -- information is available, the error indicator is set to 0.
   --
   -- 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
   --    maximum transformation number available.

   begin

      -- The following if structure 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
         TRANSFORMATION := TRANSFORMATION_NUMBER'FIRST;
      else
         EI := SUCCESSFUL;                  -- Error 0
         TRANSFORMATION := GKS_DESCRIPTION_TABLE.
                           MAX_NORMALIZATION_TRANSFORMATION_NUMBER;
      end if;

   end INQ_MAX_NORMALIZATION_TRANSFORMATION_NUMBER;

end INQ_GKS_DESCRIPTION_TABLE_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:INQ_GKS_ST_LST_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_GKS_STATE_LIST_0A - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_gks_st_lst_0a_b.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with GKS_OPERATING_STATE_LIST;
with GKS_STATE_LIST;
with GKS_ERRORS;

use GKS_ERRORS;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body INQ_GKS_STATE_LIST_0A is

-- This is the package body for the procedures to inquire
-- the GKS_STATE_LIST at levels no lower than 0a.

   procedure INQ_OPERATING_STATE_VALUE
      (VALUE : out OPERATING_STATE) is

   -- This procedure inquires the GKS_OPERATING_STATE_LIST for
   -- the operating state.
   --
   -- VALUE - The value of this enumerated parameter may be GKCL,
   --    GKOP, WSOP, WSAC, or SGOP to indicate the current operating
   --    state of GKS.

   begin

      VALUE := CURRENT_OPERATING_STATE;

   end INQ_OPERATING_STATE_VALUE;

   procedure INQ_SET_OF_OPEN_WS
      (EI : out ERROR_INDICATOR;
      WS  : out WS_IDS.LIST_OF) is

   -- This procedure 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
   -- returns the error indicator only.  Otherwise, this procedure
   -- inquires the GKS_STATE_LIST for the set of open workstations.
   -- At levels ma and 0a, there need be only one workstation in the
   -- set.  If the inquired information is available, the error indi-
   -- cator is set to 0.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- WS - This is a set type of WS identifiers.

   begin

      -- The following if structure 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
         WS := WS_IDS.NULL_LIST;
      else
         EI := SUCCESSFUL;                  -- Error 0
         WS := GKS_STATE_LIST.LIST_OF_OPEN_WS;
      end if;

   end INQ_SET_OF_OPEN_WS;

   procedure INQ_LIST_OF_NORMALIZATION_TRANSFORMATION_NUMBERS
      (EI  : out ERROR_INDICATOR;
      LIST : out TRANSFORMATION_PRIORITY_LIST) is

   -- This procedure 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
   -- returns the error indicator only.  Otherwise, this procedure
   -- inquires the GKS_STATE_LIST for the list of normalization
   -- transformation numbers.  The list is ordered by viewport input
   -- priority, starting with the highest priority tranformation
   -- number.  If the inquired information is available, the error indi-
   -- cator is set to 0.
   --
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- LIST - This is a list type of TRANSFORMATION_NUMBERS.

   INVALID_PRIORITY_LIST : TRANSFORMATION_PRIORITY_LIST;

   begin

      -- The following if structure 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
         LIST := INVALID_PRIORITY_LIST;
      else
         EI := SUCCESSFUL;                    -- Error 0
         LIST := GKS_STATE_LIST.PRIORITY_LIST_OF_TRANSFORMATIONS;
      end if;

   end INQ_LIST_OF_NORMALIZATION_TRANSFORMATION_NUMBERS;

end INQ_GKS_STATE_LIST_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:INQ_WS_DSCR_TBL_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_WS_DESCRIPTION_TABLE_0A - BODY
--  IDENTIFIER: GIMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR022  Add error #85 back into GKS_ERRORS.
------------------------------------------------------------------
-- file:  inq_ws_dscr_tbl_0a_b.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with WSM;
with CGI;
with GKS_OPERATING_STATE_LIST;
with GKS_DESCRIPTION_TABLE;
with GKS_ERRORS;

use WSM;
use CGI;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body INQ_WS_DESCRIPTION_TABLE_0A is

-- This is the package body for the procedures to call the workstation
-- 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
-- 8 occurs but no exception is raised.

   procedure INQ_WS_CATEGORY
      (WS      : in WS_TYPE;
      EI       : out ERROR_INDICATOR;
      CATEGORY : out WS_CATEGORY) is

   -- This procedure calls the workstation manager to obtain the
   -- value of the workstation category from the workstation
   -- description table.  If the inquired information is available,
   -- the workstation manager returns the error indicator as 0.
   --
   -- WS - This is an integer value representing the type of
   --    workstation.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- CATEGORY - The value of this enumerated parameter may be
   --    OUTPUT, INPUT, OUTIN, WISS, MO, or MI to indicate the
   --    category of the workstation.

   GKS_INSTR : CGI_INQ_WS_CATEGORY;

   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
         CATEGORY := WS_CATEGORY'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
         CATEGORY := WS_CATEGORY'FIRST;

      else
         GKS_INSTR.WS_TO_INQ_CATEGORY := WS;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then              -- Error 0
            EI := UNKNOWN;                  -- Error 2501
         else
            EI := GKS_INSTR.EI;
         end if;

         CATEGORY := GKS_INSTR.WS_CATEGORY_INQ;

      end if;

   end INQ_WS_CATEGORY;

   procedure INQ_WS_CLASS
      (WS   : in WS_TYPE;
      EI    : out ERROR_INDICATOR;
      CLASS : out DISPLAY_CLASS) is

   -- This procedure calls the workstation manager to obtain the
   -- value of the workstation class from the workstation description
   -- table.  If the inquired information is available, the work-
   -- station manager returns the error indicator as 0.
   --
   -- WS - This is an integer value representing the type of
   --    workstation.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- CLASS - The value of this parameter may be VECTOR_DISPLAY,
   --    RASTER_DISPLAY, or OTHER_DISPLAY to indicate the
   --    classification of a workstation of category OUTPUT or
   --    OUTIN.

   GKS_INSTR : CGI_INQ_WS_CLASS;

   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
         CLASS := DISPLAY_CLASS'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
         CLASS := DISPLAY_CLASS'FIRST;

      else
         GKS_INSTR.WS_TO_INQ_CLASS := 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;

         CLASS := GKS_INSTR.WS_CLASS_INQ;

      end if;


   end INQ_WS_CLASS;

   procedure INQ_PREDEFINED_POLYLINE_REPRESENTATION
      (WS    : in WS_TYPE;
      INDEX  : in POLYLINE_INDEX;
      EI     : out ERROR_INDICATOR;
      LINE   : out LINETYPE;
      WIDTH  : out LINE_WIDTH;
      COLOUR : out COLOUR_INDEX) is

   -- This procedure calls the workstation manager to obtain the
   -- value of the workstation predefined polyline information
   -- from the workstation description table.  This includes the
   -- linetype, linewidth scale factor, and the polyline colour
   -- index.  If the inquired information is available, the
   -- workstation manager returns the error indicator as 0.  If
   -- the inquired information is not available, the workstation
   -- manager returns the error indicator as 39, 60 or 62 to indicate
   -- the reason for non-availability.
   --
   -- WS - This is an integer value representing the type of
   --    workstation.
   -- INDEX - This is an integer value representing the index
   --    into the polyline tables.
   -- 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 line type.
   -- WIDTH - This is a positive floating point value representing the
   --    nominal line width.
   -- COLOUR - This is an integer value representing an index into
   --    the colour tables.

   GKS_INSTR : CGI_INQ_PREDEFINED_POLYLINE_REPRESENTATION;

   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
         LINE := LINETYPE'FIRST;
         WIDTH := 0.0;
         COLOUR := COLOUR_INDEX'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
         LINE := LINETYPE'FIRST;
         WIDTH := 0.0;
         COLOUR := COLOUR_INDEX'FIRST;

      else
         GKS_INSTR.WS_TO_INQ_PRE_POLYLINE_REP := WS;
         GKS_INSTR.PRE_POLYLINE_INDEX_TO_INQ_PRE_POLYLINE_REP := INDEX;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then                  -- Error 0
            if (GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN) or       -- Error 39
               (GKS_INSTR.EI = INVALID_POLYLINE_INDEX) or    -- Error 60
               (GKS_INSTR.EI = NO_PREDEF_POLYLINE_REP) then  -- Error 62
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                      -- Error 2501
            end if;
         else
            EI := GKS_INSTR.EI;
         end if;

         LINE := GKS_INSTR.PRE_POLYLINE_TYPE_INQ;
         WIDTH := GKS_INSTR.PRE_POLYLINE_WIDTH_INQ;
         COLOUR := GKS_INSTR.PRE_POLYLINE_COLOUR_INQ;

      end if;

   end INQ_PREDEFINED_POLYLINE_REPRESENTATION;

   procedure INQ_PREDEFINED_POLYMARKER_REPRESENTATION
      (WS    : in WS_TYPE;
      INDEX  : in POLYMARKER_INDEX;
      EI     : out ERROR_INDICATOR;
      MARKER : out MARKER_TYPE;
      SIZE   : out MARKER_SIZE;
      COLOUR : out COLOUR_INDEX) is

   -- This procedure calls the workstation manager to obtain the
   -- value of the workstation predefined polymarker information
   -- from the workstation description table.  This includes the
   -- marker type, marker size scale factor, and the polymarker
   -- colour index.  If the inquired information is available, the
   -- workstation manager returns the error indicator as 0.  If
   -- the inquired information is not available, the workstation
   -- manager returns the error indicator as 39, 66 or 68 to indicate
   -- the reason for non-availability.
   --
   -- WS - This is an integer value representing the type of
   --    workstation.
   -- INDEX - This is an integer value representing the index
   --    into the polymarker tables.
   -- 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 marker type.
   -- SIZE - This is a positive floating point value representing the
   --    nominal marker size.
   -- COLOUR - This is an integer value representing an index into
   --    the colour tables.

   GKS_INSTR : CGI_INQ_PREDEFINED_POLYMARKER_REPRESENTATION;

   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
         MARKER := MARKER_TYPE'FIRST;
         SIZE := 0.0;
         COLOUR := COLOUR_INDEX'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
         MARKER := MARKER_TYPE'FIRST;
         SIZE := 0.0;
         COLOUR := COLOUR_INDEX'FIRST;

      else
         GKS_INSTR.WS_TO_INQ_PRE_POLYMARKER_REP := WS;
         GKS_INSTR.PRE_POLYMARKER_INDEX_TO_INQ_PRE_POLYMARKER_REP :=
            INDEX;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then                  -- Error 0
            if (GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN) or       -- Error 39
               (GKS_INSTR.EI = INVALID_POLYMARKER_INDEX) or  -- Error 66
               (GKS_INSTR.EI = NO_PREDEF_POLYMARKER_REP) then -- Error 68
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                    -- Error 2501
            end if;
         else
            EI := GKS_INSTR.EI;
         end if;

         MARKER := GKS_INSTR.PRE_POLYMARKER_TYPE_INQ;
         SIZE   := GKS_INSTR.PRE_POLYMARKER_SIZE_INQ;
         COLOUR := GKS_INSTR.PRE_POLYMARKER_COLOUR_INQ;

      end if;

   end INQ_PREDEFINED_POLYMARKER_REPRESENTATION;

   procedure INQ_PREDEFINED_TEXT_REPRESENTATION
      (WS            : in WS_TYPE;
      INDEX          : in TEXT_INDEX;
      EI             : out ERROR_INDICATOR;
      FONT_PRECISION : out TEXT_FONT_PRECISION;
      EXPANSION      : out CHAR_EXPANSION;
      SPACING        : out CHAR_SPACING;
      COLOUR         : out COLOUR_INDEX) is

   -- This procedure calls the workstation manager to obtain the
   -- value of the workstation predefined text information from
   -- the workstation description table.  This includes the
   -- list of text font and precision pairs, the number of
   -- available character heights, the minimum and maximum char-
   -- acter heights, the number of available character expansion
   -- factors, and the number of predefined text indices.  If the
   -- inquired information is available, the workstation manager
   -- returns the error indicator as 0.  If the inquired information
   -- is not available, the workstation manager returns the error
   -- indicator as 39, 72 or 74 to indicate the reason for non-
   -- availability.
   --
   -- WS - This is an integer value representing the type of
   --    workstation.
   -- INDEX - This is an integer value representing the index
   --    into the text tables.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- FONT_PRECISION - The two components of this record describe
   --    the text font and precision aspect.  The component FONT
   --    is an integer value representing the character font.  The
   --    component PRECISION may have the value STRING_PRECISION,
   --    CHAR_PRECISION, or STROKE_PRECISION to indicate the text
   --    precision.
   -- EXPANSION - This is a positive floating point value representing
   --    the nominal character expansion amount.
   -- SPACING - This is a floating point value representing the
   --    character spacing factor.  A positive value indicates the
   --    amount of space between characters in a text string, and a
   --    a negative value indicates the amount of overlap between
   --    characters.
   -- COLOUR - This is an integer value representing an index into
   --    the colour tables.

   GKS_INSTR : CGI_INQ_PREDEFINED_TEXT_REPRESENTATION;

   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
         FONT_PRECISION := (FONT => 0,
                            PRECISION => TEXT_PRECISION'FIRST);
         EXPANSION := 1.0;
         SPACING := 0.0;
         COLOUR := COLOUR_INDEX'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
         FONT_PRECISION := (FONT => 0,
                            PRECISION => TEXT_PRECISION'FIRST);
         EXPANSION := 1.0;
         SPACING := 0.0;
         COLOUR := COLOUR_INDEX'FIRST;

      else
         GKS_INSTR.WS_TO_INQ_PRE_TEXT_REP := WS;
         GKS_INSTR.PRE_TEXT_INDEX_TO_INQ_PRE_TEXT_REP := INDEX;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then                  -- Error 0
            if (GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN) or       -- Error 39
               (GKS_INSTR.EI = INVALID_TEXT_INDEX) or        -- Error 72
               (GKS_INSTR.EI = NO_PREDEF_TEXT_REP) then      -- Error 74
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                      -- Error 2501
            end if;
         else
            EI := GKS_INSTR.EI;
         end if;

         FONT_PRECISION := GKS_INSTR.PRE_TEXT_FONT_PRECISION_INQ;
         EXPANSION      := GKS_INSTR.PRE_TEXT_CHAR_EXPANSION_INQ;
         SPACING        := GKS_INSTR.PRE_TEXT_CHAR_SPACING_INQ;
         COLOUR         := GKS_INSTR.PRE_TEXT_COLOUR_INQ;

      end if;

   end INQ_PREDEFINED_TEXT_REPRESENTATION;

   procedure INQ_PREDEFINED_FILL_AREA_REPRESENTATION
      (WS      : in WS_TYPE;
      INDEX    : in FILL_AREA_INDEX;
      EI       : out ERROR_INDICATOR;
      INTERIOR : out INTERIOR_STYLE;
      STYLE    : out STYLE_INDEX;
      COLOUR   : out COLOUR_INDEX) is

   -- This procedure calls the workstation manager to obtain the
   -- value of the workstation predefined fill area information
   -- from the workstation description table.  This includes the
   -- fill area interior style, the fill area style index, and the
   -- fill area colour index.  If the inquired information is
   -- available, the workstation manager returns the error indicator
   -- as 0.  If the inquired information is not available, the
   -- workstation manager returns the error indicator as 39, 80 or 82
   -- to indicate the reason for non-availability.
   --
   -- WS - This is an integer value representing the type of
   --    workstation.
   -- INDEX - This is an integer value representing the index
   --    into the fill area tables.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- INTERIOR - This enumerated variable defines the fill area
   --    interior style.
   -- STYLE - This is a variant record defining the fill area style.
   --    When the discriminant is HOLLOW or SOLID, the index is null.
   --    When the discriminant is PATTERN, the style index is an index
   --    into the pattern tables.  When the discriminant is HATCH, the
   --    style index indicates which hatch style is to be used.
   -- COLOUR - This is an integer value representing an index into
   --    the colour tables.

   GKS_INSTR : CGI_INQ_PREDEFINED_FILL_AREA_REPRESENTATION;

   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
         INTERIOR := INTERIOR_STYLE'FIRST;
         STYLE := STYLE_INDEX'FIRST;
         COLOUR := COLOUR_INDEX'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
         INTERIOR := INTERIOR_STYLE'FIRST;
         STYLE := STYLE_INDEX'FIRST;
         COLOUR := COLOUR_INDEX'FIRST;

      else
         GKS_INSTR.WS_TO_INQ_PRE_FILL_AREA_REP := WS;
         GKS_INSTR.PRE_FILL_AREA_INDEX_TO_INQ_PRE_FILL_AREA_REP := INDEX;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then                  -- Error 0
            if (GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN) or       -- Error 39
               (GKS_INSTR.EI = INVALID_FILL_AREA_INDEX) or   -- Error 80
               (GKS_INSTR.EI = NO_PREDEF_FILL_AREA_REP) then -- Error 82
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                       -- Error 2501
            end if;
         else
            EI := GKS_INSTR.EI;
         end if;

         INTERIOR := GKS_INSTR.PRE_FILL_AREA_INTERIOR_INQ;
         STYLE    := GKS_INSTR.PRE_FILL_AREA_STYLE_INQ;
         COLOUR   := GKS_INSTR.PRE_FILL_AREA_COLOUR_INQ;

      end if;

   end INQ_PREDEFINED_FILL_AREA_REPRESENTATION;

   procedure INQ_PATTERN_FACILITIES
      (WS               : in WS_TYPE;
      EI                : out ERROR_INDICATOR;
      NUMBER_OF_INDICES : out NATURAL) is

   -- This procedure calls the workstation manager to obtain the
   -- number of predefined pattern indices from the workstation
   -- description table.  If the inquired information is available,
   -- the workstation manager returns the error indicator as 0.  If
   -- the inquired information is not available, the error indicator
   -- is returned as 39 to indicate the reason for non-availability.
   --
   -- WS - This is an integer value representing the type of
   --    workstation.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- NUMBER_OF_INDICES - This is a natural number indicating the
   --    number of pattern indices.

   GKS_INSTR : CGI_INQ_PATTERN_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_INDICES := 0;

      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_INDICES := 0;

      else
         GKS_INSTR.WS_TO_INQ_PATTERN_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;

         NUMBER_OF_INDICES := GKS_INSTR.NUMBER_OF_PATTERN_INDICES;

      end if;

   end INQ_PATTERN_FACILITIES;

   procedure INQ_PREDEFINED_PATTERN_REPRESENTATION
      (WS     : in WS_TYPE;
      INDEX   : in PATTERN_INDEX;
      EI      : out ERROR_INDICATOR;
      LAST_X  : out NATURAL;
      LAST_Y  : out NATURAL;
      PATTERN : out COLOUR_MATRICES.VARIABLE_MATRIX_OF) is

   -- This procedure calls the workstation manager to obtain the
   -- value of the workstation predefined pattern information
   -- from the workstation description table.  This includes the
   -- pattern array dimensions and the pattern array.  If the
   -- inquired information is available, the workstation manager
   -- returns the error indicator as 0.  If the inquired information
   -- is not available, the workstation manager returns the error
   -- indicator as 39, 89, or 90 to indicate the reason for non-
   -- availability.
   --
   -- WS - This is an integer value representing the type of
   --    workstation.
   -- INDEX - This is an integer value representing the index
   --    into the pattern tables.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- LAST_X, LAST_Y - These are the actual dimensions of the pattern
   --    matrix.  The parameters were added for this implementation to
   --    notify the application of the extent of the true pattern
   --    indices returned.
   -- PATTERN - This is a record defining a matrix that contains colour
   --    indices as elements.  It is assumed to be constrained.

   GKS_INSTR : CGI_INQ_PREDEFINED_PATTERN_REPRESENTATION;
   INVALID_PATTERN_MATRIX : COLOUR_MATRICES.VARIABLE_MATRIX_OF
                            (PATTERN.DX,PATTERN.DY);

   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
         PATTERN := INVALID_PATTERN_MATRIX;

      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
         PATTERN := INVALID_PATTERN_MATRIX;

      else
         GKS_INSTR.WS_TO_INQ_PRE_PATTERN_REP := WS;
         GKS_INSTR.PRE_PATTERN_INDEX_TO_INQ_PRE_PATTERN_REP := INDEX;

         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then                  -- Error 0
            if (GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN) or       -- Error 39
               (GKS_INSTR.EI = INVALID_PATTERN_INDEX) or     -- Error 85
               (GKS_INSTR.EI = NO_PREDEF_PATTERN_REP) or     -- Error 89
               (GKS_INSTR.EI = PATTERN_STYLE_NOT_ON_WS) then -- Error 90
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                       -- Error 2501
            end if;
         else
            EI := GKS_INSTR.EI;
         end if;

         LAST_X := NATURAL(GKS_INSTR.PRE_PATTERN_REP_INQ'LENGTH(1));
         LAST_Y := NATURAL(GKS_INSTR.PRE_PATTERN_REP_INQ'LENGTH(2));

         if (PATTERN.DX < SMALL_NATURAL(GKS_INSTR.
            PRE_PATTERN_REP_INQ'LENGTH(1))) then
            for INDEX1 in POSITIVE(1) .. POSITIVE(PATTERN.DX) loop
               if PATTERN.DY < SMALL_NATURAL(GKS_INSTR.
                  PRE_PATTERN_REP_INQ'LENGTH(2)) then
                  for INDEX2 in POSITIVE(1) .. POSITIVE(PATTERN.DY) loop
                       PATTERN.MATRIX(INDEX1,INDEX2) :=
                          GKS_INSTR.PRE_PATTERN_REP_INQ(INDEX1,INDEX2);
                    end loop;
                 else
                    for INDEX2 in POSITIVE(1) .. POSITIVE(GKS_INSTR.
                       PRE_PATTERN_REP_INQ'LENGTH(2)) loop
                       PATTERN.MATRIX(INDEX1,INDEX2) :=
                           GKS_INSTR.PRE_PATTERN_REP_INQ(INDEX1,INDEX2);
                    end loop;
                 end if;
            end loop;
         else
            for INDEX1 in POSITIVE(1) .. POSITIVE(GKS_INSTR.
               PRE_PATTERN_REP_INQ'LENGTH(1)) loop
               if PATTERN.DY < SMALL_NATURAL(GKS_INSTR.
                  PRE_PATTERN_REP_INQ'LENGTH(2)) then
                  for INDEX2 in POSITIVE(1) .. POSITIVE(PATTERN.DY) loop
                     PATTERN.MATRIX(INDEX1,INDEX2) :=
                        GKS_INSTR.PRE_PATTERN_REP_INQ(INDEX1,INDEX2);
                  end loop;
               else
                  for INDEX2 in POSITIVE(1) .. POSITIVE(GKS_INSTR.
                     PRE_PATTERN_REP_INQ'LENGTH(2)) loop
                     PATTERN.MATRIX(INDEX1,INDEX2) :=
                        GKS_INSTR.PRE_PATTERN_REP_INQ(INDEX1,INDEX2);
                  end loop;
               end if;
            end loop;
         end if;

       FREE_COLOUR_MATRIX (GKS_INSTR.PRE_PATTERN_REP_INQ);

    end if;

 end INQ_PREDEFINED_PATTERN_REPRESENTATION;

   procedure INQ_PREDEFINED_COLOUR_REPRESENTATION
      (WS    : in WS_TYPE;
      INDEX  : in COLOUR_INDEX;
      EI     : out ERROR_INDICATOR;
      COLOUR : out COLOUR_REPRESENTATION) is

   -- This procedure calls the workstation manager to obtain the
   -- value of the workstation predefined colour information from
   -- the workstation description table.  This includes the red
   -- green, and blue intensities of the colour.  If the inquired
   -- information is available, the workstation manager returns
   -- the error indicator as 0. If the inquired information is not
   -- available, the workstation manager returns the error indicator
   -- as 39, 93 or 95 to indicate the reason for non-availability.
   --
   -- WS - This is an integer value representing the type of
   --    workstation.
   -- INDEX - This is an integer value representing the index
   --    into the pattern tables.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- COLOUR - This is a record with three components, RED, GREEN,
   --    and BLUE which define the representation of a colour as a
   --    combination of intensities.

   GKS_INSTR : CGI_INQ_PREDEFINED_COLOUR_REPRESENTATION;

   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
         COLOUR := (RED => 0.0, GREEN => 0.0, BLUE => 0.0);

      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
         COLOUR := (RED => 0.0, GREEN => 0.0, BLUE => 0.0);

      else
         GKS_INSTR.WS_TO_INQ_PRE_COLOUR_REP := WS;
         GKS_INSTR.PRE_COLOUR_INDEX_TO_INQ_PRE_COLOUR_REP := INDEX;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then                  -- Error 0
            if (GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN) or       -- Error 39
               (GKS_INSTR.EI = INVALID_COLOUR_INDEX) or      -- Error 93
               (GKS_INSTR.EI = NO_PREDEF_COLOUR_REP) then    -- Error 95
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                      -- Error 2501
            end if;

         else
            EI := GKS_INSTR.EI;
         end if;

         COLOUR := GKS_INSTR.PRE_COLOUR_REP_INQ;

      end if;

   end INQ_PREDEFINED_COLOUR_REPRESENTATION;

   procedure INQ_LIST_OF_AVAILABLE_GDP
      (WS         : in WS_TYPE;
      EI          : out ERROR_INDICATOR;
      LIST_OF_GDP : out GDP_IDS.LIST_OF) is

   -- This procedure calls the workstation manager to obtain the
   -- list of generalized drawing primitive identifiers.  If
   -- the inquired information is available,the workstaion manager
   -- returns the error indicator as 0.  If the inquired information
   -- 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 representing the type of
   --    workstation.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- LIST_OF_GDP - This is a set type of GDP identifiers.

   GKS_INSTR : CGI_INQ_LIST_OF_AVAILABLE_GDP;

   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_GDP := GDP_IDS.NULL_LIST;

      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_GDP := GDP_IDS.NULL_LIST;

      else
         GKS_INSTR.WS_TO_INQ_LIST_OF_AVAILABLE_GDP := 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_GDP := GKS_INSTR.LIST_OF_GDP_INQ;

      end if;

   end INQ_LIST_OF_AVAILABLE_GDP;

   procedure INQ_GDP
      (WS    : in WS_TYPE;
      GDP    : in GDP_ID;
      EI     : out ERROR_INDICATOR;
      LIST_OF_ATTRIBUTES_USED : out ATTRIBUTES_USED.LIST_OF) is

   -- This procedure calls the workstation manager to obtain the
   -- list of sets of attributes used for the specified generalized
   -- drawing primitive.  If the inquired information is available,
   -- the workstation manager returns the error indicator as 0.  If
   -- the inquired information is not available, the workstation
   -- manager returns the error indicator as 39 or 41 to indicate the
   -- reason for non-availability.
   --
   -- WS - This is an integer value representing the type of
   --    workstation.
   -- GDP - This is an integer value representing a generalized
   --    drawing primitive.
   -- EI - This is the error indicator.  Its numeric value represents
   --    the type of error, if any, that occurred.
   -- LIST_OF_ATTRIBUTES_USED - This is a set type of ATTRIBUTES_USED_
   --    TYPE.  Its components may be set to 1 or 0 to indicate if the
   --    following attributes are used: POLYLINE_ATTRIBUTES, POLYMARKER_
   --    ATTRIBUTES, TEXT_ATTRIBUTES, or FILL_AREA_ATTRIBUTES.

   GKS_INSTR : CGI_INQ_GDP;

   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_ATTRIBUTES_USED := ATTRIBUTES_USED.NULL_LIST;

      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_ATTRIBUTES_USED := ATTRIBUTES_USED.NULL_LIST;

      else
         GKS_INSTR.WS_TO_INQ_GDP := WS;
         GKS_INSTR.GDP_TO_INQ_GDP := GDP;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI /= SUCCESSFUL then                  -- Error 0
            if (GKS_INSTR.EI = WS_NOT_OUTPUT_OUTIN) or       -- Error 39
               (GKS_INSTR.EI = WS_TYPE_CANNOT_GEN_GDP) then  -- Error 41
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                      -- Error 2501
            end if;
         else
            EI := GKS_INSTR.EI;
         end if;

         LIST_OF_ATTRIBUTES_USED := GKS_INSTR.LIST_OF_ATTRIBUTES_USED_INQ;

      end if;

   end INQ_GDP;

end INQ_WS_DESCRIPTION_TABLE_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:INQ_WS_ST_LST_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_WS_STATE_LIST_0A - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  inq_ws_st_lst_0a_b.ada
-- level: 0a, 1a, 2a, 0b, 0c

with WSM;
with CGI;
with GKS_OPERATING_STATE_LIST;
with GKS_STATE_LIST;
with GKS_ERRORS;

use WSM;
use CGI;
use GKS_ERRORS;
use GKS_OPERATING_STATE_LIST;

package body INQ_WS_STATE_LIST_0A is

-- This is the package body for the procedures to call the work-
-- station manager to inquire the workstation state lists at
-- levels no lower than 0a.

-- 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, SGOP.  If it is not, error 7
-- occurs but no exception is raised.  Then the procedures
-- check if the workstation is in the set of open workstations
-- in the GKS_STATE_LIST.  If it is not, error 25 occurs but
-- no exception is raised.

   procedure INQ_WS_STATE
      (WS   : in WS_ID;
      EI    : out ERROR_INDICATOR;
      STATE : out WS_STATE) is

   -- This procedure calls the workstation manager to obtain the
   -- value of the workstation state entry in the specified
   -- workstation's state list.  If the inquired information is
   -- available, the error indicator is returned as 0 by the work-
   -- station manager.  If the inquired information is not available,
   -- the workstation manager returns an error indicator of 33 or 35
   -- to indicate the reason for unavailabity.
   --
   -- WS - Identifies the workstation to be inquired.
   -- EI - Returns the error code, if any.
   -- STATE - Returns ACTIVE or INACTIVE.

   GKS_INSTR : CGI_INQ_WS_STATE;

   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 is open by checking if it is
      -- in the list of open WS in the GKS_STATE_LIST.  If both
      -- conditions are true, the WS_MANAGER is called for the
      -- inquiry.

      if (CURRENT_OPERATING_STATE = GKCL) or
         (CURRENT_OPERATING_STATE = GKOP) then
         EI := NOT_WSOP_WSAC_SGOP;             -- Error 7
         STATE := WS_STATE'FIRST;

      elsif not WS_IDS.IS_IN_LIST(WS,GKS_STATE_LIST.LIST_OF_OPEN_WS) then
         EI := WS_NOT_OPEN;                    -- Error 25
         STATE := WS_STATE'FIRST;

      else
         GKS_INSTR.WS_TO_INQ_STATE := 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
               EI := GKS_INSTR.EI;
            else
               EI := UNKNOWN;                             -- Error 2501
            end if;
         else
            EI := GKS_INSTR.EI;
         end if;

         STATE := GKS_INSTR.WS_STATE_INQ;

      end if;


   end INQ_WS_STATE;

   procedure INQ_WS_DEFERRAL_AND_UPDATE_STATES
      (WS          : in WS_ID;
      EI           : out ERROR_INDICATOR;
      DEFERRAL     : out DEFERRAL_MODE;
      REGENERATION : out REGENERATION_MODE;
      DISPLAY      : out DISPLAY_SURFACE_EMPTY;
      FRAME_ACTION : out NEW_FRAME_NECESSARY) is

   -- This procedure calls the workstation manager to obtain the
   -- workstation deferral mode and the implicit regeneration mode,
   -- and to determine if the display surface is empty  and if new
   -- frame action is necessary at update time.  If the inquired
   -- information is available, the workstation manager returns the
   -- error indicator as 0.  If the inquired information is not avail-
   -- able, the workstation manager returns the error indicator as 33,
   -- 35, or 36 to indicate the reason for non-availability.
   --
   -- WS - Identifies the workstation to be inquired.
   -- EI - Returns the error code, if any.
   -- DEFERRAL - Returns the deferral mode of the specified workstation.
   -- REGENERATION - Returns the implicit regeneration mode of the
   --    specified workstation.
   -- DISPLAY - Returns whether the display surface is empty.
   -- FRAME_ACTION - Returns whether a frame action is necessary at
   --    update time.

   GKS_INSTR : CGI_INQ_WS_DEFERRAL_AND_UPDATE_STATES;

   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 is open by checking if it is
      -- in the list of open WS in the GKS_STATE_LIST.  If both
      -- conditions are true, the WS_MANAGER is called for the
      -- inquiry.

      if (CURRENT_OPERATING_STATE = GKCL) or
         (CURRENT_OPERATING_STATE = GKOP) then
         EI := NOT_WSOP_WSAC_SGOP;             -- Error 7
         DEFERRAL := DEFERRAL_MODE'FIRST;
         REGENERATION := REGENERATION_MODE'FIRST;
         DISPLAY := DISPLAY_SURFACE_EMPTY'FIRST;
         FRAME_ACTION := NEW_FRAME_NECESSARY'FIRST;

      elsif not WS_IDS.IS_IN_LIST(WS,GKS_STATE_LIST.LIST_OF_OPEN_WS) then

         EI := WS_NOT_OPEN;                    -- Error 25
         DEFERRAL := DEFERRAL_MODE'FIRST;
         REGENERATION := REGENERATION_MODE'FIRST;
         DISPLAY := DISPLAY_SURFACE_EMPTY'FIRST;
         FRAME_ACTION := NEW_FRAME_NECESSARY'FIRST;

      else
         GKS_INSTR.WS_TO_INQ_DEFERRAL_AND_UPDATE_STATES := 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) 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;
         end if;

         DEFERRAL     := GKS_INSTR.DEFERRAL_INQ;
         REGENERATION := GKS_INSTR.REGENERATION_INQ;
         DISPLAY      := GKS_INSTR.DISPLAY_INQ;
         FRAME_ACTION := GKS_INSTR.FRAME_ACTION_INQ;

      end if;

   end INQ_WS_DEFERRAL_AND_UPDATE_STATES;

end INQ_WS_STATE_LIST_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:ERROR_ROUTINES_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: ERROR_ROUTINES - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  error_routines_0a_b.ada
-- level: 0a

package body ERROR_ROUTINES is

-- This is the package body providing the procedures
-- for GKS error handling.

   procedure EMERGENCY_CLOSE_GKS is separate;

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

  procedure GET_ERROR
      (EI  : out ERROR_INDICATOR;
      NAME : out VARIABLE_SUBPROGRAM_NAME) is separate;

end ERROR_ROUTINES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:GET_ERROR_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GET_ERROR
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  get_error_s.ada
-- level: all levels

with GKS_ERROR_STATE_LIST;

separate (ERROR_ROUTINES)

procedure GET_ERROR
   (EI  : out ERROR_INDICATOR;
   NAME : out VARIABLE_SUBPROGRAM_NAME) is

-- This function is an additional function added to GKS to
-- allow the applications program to access the latest error
-- indicator and subprogram name.
--
-- EI - This is the error indicator.  Its numeric value represents
--    the type of error that last occurred.
-- NAME - This is a string type.  Its value is the name of the
--    procedure in which the last error occurred.

begin

   EI := GKS_ERROR_STATE_LIST.LAST_EI;
   NAME := GKS_ERROR_STATE_LIST.LAST_SUBPROGRAM;

end;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:EMER_CLOSE_GKS_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: EMERGENCY_CLOSE_GKS
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  emer_close_gks_s.ada
-- level: 0a

with GKS_OPERATING_STATE_LIST;
with GKS_STATE_LIST;
with GKS_CONTROL;
with WS_CONTROL;

use GKS_OPERATING_STATE_LIST;

separate (ERROR_ROUTINES)

procedure EMERGENCY_CLOSE_GKS is

-- This procedure closes GKS in case of a non-recoverable
-- error and still saves as much information as possible.
-- All workstations are updated (by calling GKS procedure
-- UPDATE_WS).  All active workstations are deactivated
-- (by calling GKS procedure DEACTIVATE_WS).  All WS are
-- closed (by calling GKS procedure CLOSE_WS). And GKS is
-- closed (by calling CLOSE_GKS).

begin

   if CURRENT_OPERATING_STATE /= GKCL then

      for INDEX in 1.. WS_IDS.SIZE_OF_LIST(GKS_STATE_LIST.LIST_OF_OPEN_WS)
         loop

         -- Update all open WS.

         CURRENT_OPERATING_STATE := WSAC;
         -- Change the current operating state to a valid state
         -- for the procedures UPDATE_WS and DEACTIVATE_WS.

         if WS_IDS.IS_IN_LIST(WS_ID(INDEX),
                             GKS_STATE_LIST.LIST_OF_OPEN_WS)then
            WS_CONTROL.UPDATE_WS (WS_ID(INDEX),PERFORM);
         end if;

         -- Deactivate all active WS.
         if WS_IDS.IS_IN_LIST(WS_ID(INDEX),
                             GKS_STATE_LIST.LIST_OF_ACTIVE_WS) then
            WS_CONTROL.DEACTIVATE_WS (WS_ID(INDEX));
         end if;

         -- Close all open WS.

         CURRENT_OPERATING_STATE := WSOP;
         -- To ensure that the current operating state is in a valid
         -- state for the procedure CLOSE_WS.

         if WS_IDS.IS_IN_LIST(WS_ID(INDEX),
                             GKS_STATE_LIST.LIST_OF_OPEN_WS) then
            WS_CONTROL.CLOSE_WS (WS_ID(INDEX));
         end if;

      end loop;

      -- Close GKS.

      CURRENT_OPERATING_STATE := GKOP;
      -- To ensure that the current operating state is in a valid
      -- state for the procedure CLOSE_GKS.

      GKS_CONTROL.CLOSE_GKS;

   end if;

end EMERGENCY_CLOSE_GKS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:ERROR_LOGGING_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: ERROR_LOGGING
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  error_logging_s.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with TEXT_IO;
with GKS_ERROR_STATE_LIST;
with GKS_CONFIGURATION;
with GKS_OPERATING_STATE_LIST;

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 GKS_OPERATING_STATE_LIST.CURRENT_OPERATING_STATE = GKCL then
      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(GKS_ERROR_STATE_LIST.ERROR_DATA);
      TEXT_IO.CLOSE(GKS_ERROR_STATE_LIST.ERROR_DATA);

   else
      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(GKS_ERROR_STATE_LIST.ERROR_DATA);
   end if;

   -- Set the value for the last EI and the last SUBPROGRAM name.
   GKS_ERROR_STATE_LIST.LAST_EI := EI;
   GKS_ERROR_STATE_LIST.LAST_SUBPROGRAM := (LENGTH => NAME'LENGTH,
                                            CONTENTS => NAME);


end ERROR_LOGGING;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:SET_BUNDLE_IDX_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_BUNDLE_INDICES - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  set_bundle_idx_b.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with WSM;
with CGI;
with ERROR_ROUTINES;
with GKS_OPERATING_STATE_LIST;
with GKS_ERRORS;
with GKS_DESCRIPTION_TABLE;
with GKS_STATE_LIST;

use WSM;
use CGI;
use ERROR_ROUTINES;
use GKS_ERRORS;
use GKS_OPERATING_STATE_LIST;

package body SET_BUNDLE_INDICES is

-- This is the package body for the procedures to call the work-
-- station manager to set the values of the bundle table indices
-- in the workstation state lists.
--
-- Each procedure 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_POLYLINE_INDEX
      (INDEX : in POLYLINE_INDEX) is

   -- This procedure sets the value of the current polyline index
   -- in the GKS_STATE_LIST and then sends the value to the
   -- WS_MANAGER.  This value is used when creating subsequent
   -- polyline output primitives.
   --
   -- INDEX - Specifies the polyline index to be set.

   GKS_INSTR : CGI_SET_POLYLINE_INDEX;

   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_GKOP_WSOP_WSAC_SGOP,
                        "SET_POLYLINE_INDEX");    -- Error 8
         raise STATE_ERROR;

      else

         -- Call to WS_MANAGER with the polyline index.

         GKS_INSTR.POLYLINE_INDEX_SET := INDEX;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI = INVALID_POLYLINE_INDEX then  -- Error 60
            ERROR_LOGGING (GKS_INSTR.EI,"SET_POLYLINE_INDEX");
            raise OUTPUT_ATTRIBUTE_ERROR;
         end if;

         GKS_STATE_LIST.CURRENT_POLYLINE_INDEX := INDEX;

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OUTPUT_ATTRIBUTE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN, "SET_POLYLINE_INDEX"); -- Error 2501
            raise;

   end SET_POLYLINE_INDEX;

   procedure SET_POLYMARKER_INDEX
      (INDEX : in POLYMARKER_INDEX) is

   -- This procedure sets the value of the current polymarker index
   -- in the GKS_STATE_LIST and then sends the value to the
   -- WS_MANAGER.  This value is used when creating subsequent
   -- polymarker output primitives.
   --
   -- INDEX - Specifies the polymarker index to be set.

   GKS_INSTR : CGI_SET_POLYMARKER_INDEX;

   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_GKOP_WSOP_WSAC_SGOP,
                        "SET_POLYMARKER_INDEX"); -- Error 8
         raise STATE_ERROR;

      else

         -- Call to WS_MANAGER with the new polymarker index.

         GKS_INSTR.POLYMARKER_INDEX_SET := INDEX;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI = INVALID_POLYMARKER_INDEX then  -- Error 66
            ERROR_LOGGING (GKS_INSTR.EI,"SET_POLYMARKER_INDEX");
            raise OUTPUT_ATTRIBUTE_ERROR;
         end if;

         GKS_STATE_LIST.CURRENT_POLYMARKER_INDEX := INDEX;

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OUTPUT_ATTRIBUTE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,
                           "SET_POLYMARKER_INDEX"); -- Error 2501
            raise;

   end SET_POLYMARKER_INDEX;

   procedure SET_TEXT_INDEX
      (INDEX : in TEXT_INDEX) is

   -- This procedure sets the value of the current text index
   -- in the GKS_STATE_LIST and then sends the value to the
   -- WS_MANAGER.  This value is used when creating subsequent
   -- text output primitives.
   --
   -- INDEX - Specifies the text index to be set.

   GKS_INSTR : CGI_SET_TEXT_INDEX;

   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_GKOP_WSOP_WSAC_SGOP,
                        "SET_TEXT_INDEX");      -- Error 8
         raise STATE_ERROR;

      else

         -- Call to WS_MANAGER with the new text index.

         GKS_INSTR.TEXT_INDEX_SET := INDEX;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI = INVALID_TEXT_INDEX then       -- Error 72
            ERROR_LOGGING (GKS_INSTR.EI, "SET_TEXT_INDEX");
            raise OUTPUT_ATTRIBUTE_ERROR;
         end if;

         GKS_STATE_LIST.CURRENT_TEXT_INDEX := INDEX;

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OUTPUT_ATTRIBUTE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN, "SET_TEXT_INDEX"); -- Error 2501
            raise;

   end SET_TEXT_INDEX;

   procedure SET_FILL_AREA_INDEX
      (INDEX : in FILL_AREA_INDEX) is

   -- This procedure sets the value of the current fill area index
   -- in the GKS_STATE_LIST and then sends the value to the
   -- WS_MANAGER.  This value is used when creating subsequent
   -- fill area output primitives.
   --
   -- INDEX - Specifies the fill area index to be set.

   GKS_INSTR : CGI_SET_FILL_AREA_INDEX;

   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_GKOP_WSOP_WSAC_SGOP,
                        "SET_FILL_AREA_INDEX");   -- Error 8
         raise STATE_ERROR;

      else

         -- Call to WS_MANAGER with the new fill area index.

         GKS_INSTR.FILL_AREA_INDEX_SET := INDEX;
         WS_MANAGER (GKS_INSTR);

         if GKS_INSTR.EI = INVALID_FILL_AREA_INDEX then  -- Error 80
            ERROR_LOGGING (GKS_INSTR.EI,"SET_FILL_AREA_INDEX");
            raise OUTPUT_ATTRIBUTE_ERROR;
         end if;

         GKS_STATE_LIST.CURRENT_FILL_AREA_INDEX := INDEX;

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OUTPUT_ATTRIBUTE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN, "SET_FILL_AREA_INDEX"); -- Error 2501
            raise;

   end SET_FILL_AREA_INDEX;

end SET_BUNDLE_INDICES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:SET_PRIM_ATTR_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_PRIMITIVE_ATTRIBUTES_0A - BODY
--  IDENTIFIER: GIMXXX.1(2)
--  DISCREPANCY REPORTS:
--  #019  06/14/85  "Change SET_PATTERN_SIZE to SET_PATTERN_VECTORS"
------------------------------------------------------------------
-- file:  set_prim_attr_0a_b.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with WSM;
with CGI;
with ERROR_ROUTINES;
with GKS_OPERATING_STATE_LIST;
with GKS_ERRORS;
with GKS_STATE_LIST;
with TRANSFORMATION_MATH;

use WSM;
use CGI;
use ERROR_ROUTINES;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body SET_PRIMITIVE_ATTRIBUTES_0A is

-- This is the package body for the procedures which set the values
-- of the workstation independent 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 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.  In
-- addition, this procedure will raise the appropriate exception.

   procedure SET_TEXT_PATH
      (PATH : in TEXT_PATH) is

   -- This procedure sets the value of the current text path entry
   -- in the GKS_STATE_LIST to the value specified.  Then it calls
   -- the WS_MANAGER to pass it the value.  This value is used when
   -- creating subsequent text output primitives.
   --
   -- PATH - Specifies the text path to be set.

   GKS_INSTR : CGI_SET_TEXT_PATH;

   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_GKOP_WSOP_WSAC_SGOP,
                        "SET_TEXT_PATH");           -- Error 8
         raise STATE_ERROR;

      else

         GKS_STATE_LIST.CURRENT_TEXT_PATH := PATH;

         -- Call to WS_MANAGER with the new text path.

         GKS_INSTR.TEXT_PATH_SET := PATH;
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN, "SET_TEXT_PATH"); -- Error 2501
            raise;

   end SET_TEXT_PATH;

   procedure SET_PATTERN_SIZE
      (SIZE : in WC.SIZE) is

   -- This procedure sets the value of the current pattern size entry
   -- in the GKS_STATE_LIST to the value specified.  Then it calls
   -- the WS_MANAGER to pass it the value.
   --
   -- SIZE - Specifies the pattern size in WC to be set.

   GKS_INSTR : CGI_SET_PATTERN_VECTORS;                        -- DR019

   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_GKOP_WSOP_WSAC_SGOP,
                        "SET_PATTERN_SIZE");      -- Error 8
         raise STATE_ERROR;

      else

         GKS_STATE_LIST.CURRENT_PATTERN_WIDTH_VECTOR :=
            (WC_TYPE(SIZE.XAXIS),0.0);
         GKS_STATE_LIST.CURRENT_PATTERN_HEIGHT_VECTOR :=
            (0.0,WC_TYPE(SIZE.YAXIS));

         -- Call to WS_MANAGER with the new pattern size.

         -- Transformation logic for WC to NDC
         -- DR019 next 4 lines
         GKS_INSTR.PATTERN_HEIGHT_VECTOR_SET := (0.0, NDC_TYPE
            ((GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION).
            NDC_FACTORS(1,1)) * NDC_TYPE(SIZE.XAXIS)));

         -- DR019 next 4 lines
         GKS_INSTR.PATTERN_WIDTH_VECTOR_SET := (NDC_TYPE
            ((GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
            (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION).
            NDC_FACTORS(2,2)) * NDC_TYPE(SIZE.YAXIS)), 0.0);

         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when NUMERIC_ERROR =>
            ERROR_LOGGING (ARITHMETIC, "SET_PATTERN_SIZE"); -- Error 308
            raise SYSTEM_ERROR;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN, "SET_PATTERN_SIZE"); -- Error 2501
            raise;

   end SET_PATTERN_SIZE;

   procedure SET_PATTERN_REFERENCE_POINT
      (POINT : in WC.POINT) is

   -- This procedure sets the value of the current pattern reference
   -- point in the GKS_STATE_LIST to the value specified.  Then it calls
   -- the WS_MANAGER to pass it the value.
   --
   -- POINT - Specifies the pattern reference point to be set.

   GKS_INSTR : CGI_SET_PATTERN_REFERENCE_POINT;

   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_GKOP_WSOP_WSAC_SGOP,
                        "SET_PATTERN_REFERENCE_POINT"); --Error 8
         raise STATE_ERROR;

      else

         GKS_STATE_LIST.CURRENT_PATTERN_REFERENCE_POINT := POINT;

         -- Call to WS_MANAGER with the new pattern size.

         -- Transformation logic for WC to NDC
         GKS_INSTR.PATTERN_REFERENCE_POINT_SET:= TRANSFORMATION_MATH
         .WC_TO_NDC(GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
         (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
         .NDC_FACTORS, POINT);

         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when NUMERIC_ERROR =>
            ERROR_LOGGING (ARITHMETIC,
                           "SET_PATTERN_REFERENCE_POINT"); -- Error 308
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,
                           "SET_PATTERN_REFERENCE_POINT"); -- Error 2501
            raise;

   end SET_PATTERN_REFERENCE_POINT;

end SET_PRIMITIVE_ATTRIBUTES_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:SET_INDV_ATTR_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_INDIVIDUAL_ATTRIBUTES_0A - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  set_indv_attr_0a_b.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

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_0A is

-- This is the package body for the procedures to set the indivi-
-- dual 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, 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_LINEWIDTH_SCALE_FACTOR
      (WIDTH : in LINE_WIDTH) is

   -- This procedure sets the value of the current line width
   -- scale factor in the GKS_STATE_LIST and then sends the value
   -- to the WS_MANAGER. This value is used for the display of
   -- subsequent polyline output primitives, created when the
   -- current linewidth scale factor aspect source flag is set
   -- to individual.
   --
   -- WIDTH - Specifies the line width to be set.

   GKS_INSTR : CGI_SET_LINE_WIDTH_SCALE_FACTOR;

   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_GKOP_WSOP_WSAC_SGOP,
                        "SET_LINEWIDTH_SCALE_FACTOR"); -- Error 8
         raise STATE_ERROR;

      else

         GKS_STATE_LIST.CURRENT_LINEWIDTH_SCALE_FACTOR := WIDTH;

         -- Call to WS_MANAGER with the new line width scale factor.

         GKS_INSTR.LINE_WIDTH_SCALE_FACTOR_SET := WIDTH;
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,
                           "SET_LINEWIDTH_SCALE_FACTOR"); -- Error 2501
            raise;

   end SET_LINEWIDTH_SCALE_FACTOR;

   procedure SET_MARKER_SIZE_SCALE_FACTOR
      (SIZE : in MARKER_SIZE) is

   -- This procedure sets the value of the current marker size
   -- scale factor in the GKS_STATE_LIST and then sends the value
   -- to the WS_MANAGER. This value is used for the display of
   -- subsequent polymarker output primitives, created when the
   -- current marker size scale factor aspect source flag is set
   -- to individual.
   --
   -- SIZE - Specifies the marker size to be set.

   GKS_INSTR : CGI_SET_MARKER_SIZE_SCALE_FACTOR;

   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_GKOP_WSOP_WSAC_SGOP,
                        "SET_MARKER_SIZE_SCALE_FACTOR"); -- Error 8
         raise STATE_ERROR;

      else

         GKS_STATE_LIST.CURRENT_MARKER_SIZE_SCALE_FACTOR := SIZE;

         -- Call to WS_MANAGER with the new marker size scale factor.

         GKS_INSTR.MARKER_SIZE_SCALE_FACTOR_SET := SIZE;
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,
                           "SET_MARKER_SIZE_SCALE_FACTOR"); -- Error 2501
            raise;

   end SET_MARKER_SIZE_SCALE_FACTOR;

   procedure SET_TEXT_FONT_AND_PRECISION
      (FONT_PRECISION : in TEXT_FONT_PRECISION) is

   -- This procedure checks that the value of the text font
   -- is not equal to zero.  If it is, then error 75 occurs and
   -- the exception OUTPUT_ATTRIBUTE_ERROR is raised.  Otherwise
   -- this procedure sets the value of the current text font and
   -- precision in the GKS_STATE_LIST and then sends the value
   -- to the WS_MANAGER. This value is used for the display of
   -- subsequent text output primitives, created when the
   -- current text font and precision aspect source flag is set
   -- to individual.
   --
   -- FONT_PRECISION - Specifies the text font and precision to be set.

   GKS_INSTR : CGI_SET_TEXT_FONT_AND_PRECISION;

   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_GKOP_WSOP_WSAC_SGOP,
                        "SET_TEXT_FONT_AND_PRECISION"); -- Error 8
         raise STATE_ERROR;

      elsif FONT_PRECISION.FONT = 0 then
         ERROR_LOGGING (TEXT_FONT_IS_ZERO,
                        "SET_TEXT_FONT_AND_PRECISION"); -- Error 75
         raise OUTPUT_ATTRIBUTE_ERROR;

      else

         GKS_STATE_LIST.CURRENT_TEXT_FONT_AND_PRECISION := FONT_PRECISION;

         -- Call to WS_MANAGER with the new text font and precision value.

         GKS_INSTR.TEXT_FONT_AND_PRECISION_SET := FONT_PRECISION;
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OUTPUT_ATTRIBUTE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,
                           "SET_TEXT_FONT_AND_PRECISION"); -- Error 2501
            raise;

   end SET_TEXT_FONT_AND_PRECISION;

   procedure SET_CHAR_EXPANSION_FACTOR
      (EXPANSION : in CHAR_EXPANSION) is

   -- This procedure sets the value of the current character expan-
   -- sion factor in the GKS_STATE_LIST and then sends the value
   -- to the WS_MANAGER. This value is used for the display of
   -- subsequent text output primitives, created when the
   -- current character expansion factor aspect source flag is set
   -- to individual.
   --
   -- EXPANSION - Specifies the character expansion factor to be set.

   GKS_INSTR : CGI_SET_CHAR_EXPANSION_FACTOR;

   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_GKOP_WSOP_WSAC_SGOP,
                      "SET_CHAR_EXPANSION_FACTOR"); -- Error 8
         raise STATE_ERROR;

      else

         GKS_STATE_LIST.CURRENT_CHAR_EXPANSION_FACTOR := EXPANSION;

         -- Call to WS_MANAGER with the new character expansion factor.

         GKS_INSTR.CHAR_EXPANSION_FACTOR_SET := EXPANSION;
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,
                           "SET_CHAR_EXPANSION_FACTOR"); -- Error 2501
            raise;

   end SET_CHAR_EXPANSION_FACTOR;

   procedure SET_CHAR_SPACING
      (SPACING : in CHAR_SPACING) is

   -- This procedure sets the value of the current character
   -- spacing in the GKS_STATE_LIST and then sends the value
   -- to the WS_MANAGER. This value is used for the display of
   -- subsequent text output primitives, created when the
   -- current character spacing aspect source flag is set
   -- to individual.
   --
   -- SPACING - Specifies the character spacing to be set.

   GKS_INSTR : CGI_SET_CHAR_SPACING;

   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_GKOP_WSOP_WSAC_SGOP,
                        "SET_CHAR_SPACING");      -- Error 8
         raise STATE_ERROR;

      else

         GKS_STATE_LIST.CURRENT_CHAR_SPACING := SPACING;

         -- Call to WS_MANAGER with the new character spacing value.

         GKS_INSTR.CHAR_SPACING_SET := SPACING;
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN, "SET_CHAR_SPACING"); -- Error 2501
            raise;

   end SET_CHAR_SPACING;

   procedure SET_FILL_AREA_STYLE_INDEX
      (INDEX : in STYLE_INDEX) is

   -- This procedure sets the value of the current fill area
   -- style index in the GKS_STATE_LIST and then sends the value
   -- to the WS_MANAGER. This value is used for the display of
   -- subsequent fill area output primitives, created when the
   -- current fill area style index aspect source flag is set
   -- to individual.
   --
   -- INDEX - Specifies the fill area style index to be set.

   GKS_INSTR : CGI_SET_FILL_AREA_STYLE_INDEX;

   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_GKOP_WSOP_WSAC_SGOP,
                        "SET_FILL_AREA_STYLE_INDEX"); -- Error 8
         raise STATE_ERROR;

      elsif INDEX = 0 then
         ERROR_LOGGING (STYLE_INDEX_IS_ZERO,
                        "SET_FILL_AREA_STYLE_INDEX"); -- Error 84
         raise OUTPUT_ATTRIBUTE_ERROR;

      else
         GKS_STATE_LIST.CURRENT_FILL_AREA_STYLE_INDEX := INDEX;

         -- Call to WS_MANAGER with the new fill area style index.

         GKS_INSTR.FILL_AREA_STYLE_INDEX_SET := INDEX;
         WS_MANAGER (GKS_INSTR);
      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OUTPUT_ATTRIBUTE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN,
                           "SET_FILL_AREA_STYLE_INDEX"); -- Error 2501
            raise;

   end SET_FILL_AREA_STYLE_INDEX;

   procedure SET_ASF
      (ASF : in ASF_LIST) is

   -- This procedure sets the values of the following aspect source
   -- flags and then calls the WS_MANAGER to pass it the values:
   --  1) linetype asf
   --  2) linewidth scale factor asf
   --  3) polyline colour index asf
   --  4) marker type asf
   --  5) marker size scale factor asf
   --  6) polymarker colour index asf
   --  7) text font and precision asf
   --  8) character expansion factor asf
   --  9) character spacing asf
   -- 10) text colour index asf
   -- 11) fill area interior style asf
   -- 12) fill area style index asf
   -- 13) fill area colour index asf.
   --
   -- ASF - Specifies all the above mentioned aspect source flags
   --    to be set.

   GKS_INSTR : CGI_SET_ASF;

   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_GKOP_WSOP_WSAC_SGOP,
                         "SET_ASF");               -- Error 8
         raise STATE_ERROR;

      else

         GKS_STATE_LIST.CURRENT_ASPECT_SOURCE_FLAGS := ASF;

         -- Call to WS_MANAGER with the new ASF values.

         GKS_INSTR.ASF_SET := ASF;
         WS_MANAGER (GKS_INSTR);

      end if;

      exception
         when STATE_ERROR =>
            raise;
         when OTHERS =>
            ERROR_LOGGING (UNKNOWN, "SET_ASF");  -- Error 2501
            raise;

   end SET_ASF;

end SET_INDIVIDUAL_ATTRIBUTES_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:EXT_OUT_PRIM_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: EXTENDED_OUTPUT_PRIMITIVES - BODY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  ext_out_prim_b.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with WSM;
with CGI;
with ERROR_ROUTINES;
with GKS_OPERATING_STATE_LIST;
with GKS_ERRORS;
with GKS_STATE_LIST;
with TRANSFORMATION_MATH;

use WSM;
use CGI;
use ERROR_ROUTINES;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;

package body EXTENDED_OUTPUT_PRIMITIVES is

-- This is the package body for the procedures to extend
-- the output primitives to level 0a.
--
-- If an error indicator above 0 occurs, this procedure calls
-- 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 CELL_ARRAY
      (CORNER_1_1  : in WC.POINT;
      CORNER_DX_DY : in WC.POINT;
      CELL         : in COLOUR_MATRICES.MATRIX_OF) is separate;

   procedure GDP_CIRCLE
      (CENTER          : in WC.POINT;
      PERIPHERAL_POINT : in WC.POINT) is separate;

end EXTENDED_OUTPUT_PRIMITIVES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:GDP_CIRCLE_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GDP_CIRCLE
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  gdp_circle_s.ada
-- level: all levels

separate (EXTENDED_OUTPUT_PRIMITIVES)

procedure GDP_CIRCLE
   (CENTER           : in WC.POINT;
    PERIPHERAL_POINT : in WC.POINT) 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.
-- Otherwise, this procedure performs a normalization trans-
-- formation on the world coordinate points passed in and
-- passes the normalized device coordinates that result to the
-- workstation manager to draw a circle.  The workstation manager
-- checks for errors 104 and 105.  If these errors occur then
-- the procedure raises the exception OUTPUT_ATTRIBUTE_ERROR.
--
-- CENTER - Provides the center point of the circle in world coordi-
--    nates.
-- PERIPHERAL_POINT - Provides a peripheral point on the circle in
--    world coordinates.

GKS_INSTR : CGI_CIRCLE;

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, "GDP_CIRCLE");            -- Error 5
      raise STATE_ERROR;

   else

      -- The following logics performs a transformation on the
      -- points from world coordinates to normalized device coordinates.

      GKS_INSTR.CIRCLE_CENTER := TRANSFORMATION_MATH.WC_TO_NDC
         (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
         (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
         .NDC_FACTORS, CENTER);

      GKS_INSTR.CIRCLE_PERIPHERAL_POINT := TRANSFORMATION_MATH.WC_TO_NDC
         (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
         (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
         .NDC_FACTORS, PERIPHERAL_POINT);

      WS_MANAGER (GKS_INSTR);

      if (GKS_INSTR.EI = SOME_WS_CANNOT_GEN_GDP) or    -- Error 104
         (GKS_INSTR.EI = SOME_WS_CANNOT_GEN_XFORM_CLIP_GDP) then
                                                       -- Error 105
         ERROR_LOGGING (GKS_INSTR.EI,"GDP_CIRCLE");
         raise OUTPUT_PRIMITIVE_ERROR;
      end if;

   end if;

   exception
      when STATE_ERROR =>
         raise;
      when OUTPUT_PRIMITIVE_ERROR =>
         raise;
      when NUMERIC_ERROR =>
         ERROR_LOGGING (ARITHMETIC, "GDP_CIRCLE");          -- Error 308
         raise SYSTEM_ERROR;
      when OTHERS =>
         ERROR_LOGGING (UNKNOWN, "GDP_CIRCLE");             -- Error 2501
         raise;

end GDP_CIRCLE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:CELL_AR_S.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CELL_ARRAY
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  cell_ar_s.ada
-- level: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

separate (EXTENDED_OUTPUT_PRIMITIVES)

procedure CELL_ARRAY
   (CORNER_1_1 : in WC.POINT;
   CORNER_DX_DY: in WC.POINT;
   CELL        : in COLOUR_MATRICES.MATRIX_OF) is

-- This procedure 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 procedure raises the exception
-- STATE_ERROR.  Otherwise, this procedure transforms the world
-- coordinates passed in as the cell rectangle corners into
-- normalized device coordinates.  Then it passes these
-- coordinates to the workstation manager and the colour
-- index array to construct the cell array.

-- CORNER_1_1  - Specifies the lower left point of the cell array.
-- CORNER_DX_DY - Specifies the upper right point of the cell array.
-- CELL - Specifies a matrix of colour indices for the cells
--    created in the cell array.

GKS_INSTR : CGI_CELL_ARRAY;

CORNER_DX_1 : WC.POINT;
-- The above type was created to hold the third point calculated
-- from the two passed in.

begin

   -- The following if structure inquires the GKS_OPERATING_STATE_LIST
   -- to check if GKS is in the proper state before proceeding.

   if (CURRENT_OPERATING_STATE /= WSAC) and
      (CURRENT_OPERATING_STATE /= SGOP) then
      ERROR_LOGGING (NOT_WSAC_SGOP, "CELL_ARRAY");  -- Error 5
      raise STATE_ERROR;

   else

      GKS_INSTR.CELL_ARRAY_CORNER_1_1 := TRANSFORMATION_MATH
         .WC_TO_NDC (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
          (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
          .NDC_FACTORS, CORNER_1_1);


      GKS_INSTR.CELL_ARRAY_CORNER_DX_DY := TRANSFORMATION_MATH
         .WC_TO_NDC (GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
         (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
         .NDC_FACTORS, CORNER_DX_DY);

      CORNER_DX_1 := (CORNER_DX_DY.X,CORNER_1_1.Y);

      GKS_INSTR.CELL_ARRAY_CORNER_DX_1 := TRANSFORMATION_MATH
         .WC_TO_NDC(GKS_STATE_LIST.LIST_OF_NORMALIZATION_TRANSFORMATIONS
         (GKS_STATE_LIST.CURRENT_NORMALIZATION_TRANSFORMATION)
         .NDC_FACTORS, CORNER_DX_1);

      GKS_INSTR.CELL_COLOUR_MATRIX := new COLOUR_MATRICES.MATRIX_OF'(CELL);
      WS_MANAGER (GKS_INSTR);

      FREE_COLOUR_MATRIX (GKS_INSTR.CELL_COLOUR_MATRIX);

   end if;

   exception
      when STATE_ERROR =>
         raise;
      when NUMERIC_ERROR =>
         ERROR_LOGGING (ARITHMETIC, "CELL_ARRAY"); -- Error 308
         raise SYSTEM_ERROR;
      when OTHERS =>
         ERROR_LOGGING (UNKNOWN, "CELL_ARRAY");    -- Error 2501
         raise;

end CELL_ARRAY;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--: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:0A:WSR_INQ_WS_DSCR_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_INQ_WS_DESCRIPTION_TABLE_0A
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  DR017  Change pattern to access type.
------------------------------------------------------------------
-- file: WSR_INQ_WS_DSCR_0A.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

with GKS_TYPES;
with CGI;
with WS_DESCRIPTION_TABLE_TYPES;

use GKS_TYPES;
use CGI;

package WSR_INQ_WS_DESCRIPTION_TABLE_0A is

-- The parameter types used in this package are declared in GKS_TYPES
-- and WS_DESCRIPTION_TABLE_TYPES. In each procedure the workstation
-- description table containing the information to be returned
-- is passed in from the workstation driver.

   procedure INQ_WS_CATEGORY
      (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       CATEGORY    : out WS_CATEGORY);

   procedure INQ_WS_CLASS
      (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       CLASS       : out DISPLAY_CLASS);

   procedure INQ_PREDEFINED_POLYLINE_REPRESENTATION
      (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       INDEX       : in POLYLINE_INDEX;
       LINE        : out LINETYPE;
       WIDTH       : out LINE_WIDTH;
       COLOUR      : out COLOUR_INDEX;
       EI          : out ERROR_INDICATOR);

   procedure INQ_PREDEFINED_POLYMARKER_REPRESENTATION
      (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       INDEX       : in POLYMARKER_INDEX;
       MARKER      : out MARKER_TYPE;
       SIZE        : out MARKER_SIZE;
       COLOUR      : out COLOUR_INDEX;
       EI          : out ERROR_INDICATOR);

   procedure INQ_PREDEFINED_TEXT_REPRESENTATION
      (WS_DSCR_TBL   : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       INDEX          : in TEXT_INDEX;
       FONT_PRECISION : out TEXT_FONT_PRECISION;
       EXPANSION      : out CHAR_EXPANSION;
       SPACING        : out CHAR_SPACING;
       COLOUR         : out COLOUR_INDEX;
       EI             : out ERROR_INDICATOR);

   procedure INQ_PREDEFINED_FILL_AREA_REPRESENTATION
      (WS_DSCR_TBL   : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       INDEX         : in FILL_AREA_INDEX;
       INTERIOR      : out INTERIOR_STYLE;
       STYLE         : out STYLE_INDEX;
       COLOUR        : out COLOUR_INDEX;
       EI            : out ERROR_INDICATOR);

   procedure INQ_PATTERN_FACILITIES
      (WS_DSCR_TBL  : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       NUMBER_OF_INDICES : out NATURAL);

   procedure INQ_PREDEFINED_PATTERN_REPRESENTATION
      (WS_DSCR_TBL   : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       INDEX         : in PATTERN_INDEX;
       PATTERN       : out ACCESS_COLOUR_MATRIX_TYPE;
       EI            : out ERROR_INDICATOR);

   procedure INQ_PREDEFINED_COLOUR_REPRESENTATION
      (WS_DSCR_TBL   : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       INDEX         : in COLOUR_INDEX;
       COLOUR        : out COLOUR_REPRESENTATION;
       EI            : out ERROR_INDICATOR);

   procedure INQ_LIST_OF_AVAILABLE_GDP
      (WS_DSCR_TBL   : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       LIST_OF_GDP   : out GDP_IDS.LIST_OF);

   procedure INQ_GDP
      (WS_DSCR_TBL  : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       GDP          : in GDP_ID;
       LIST_OF_ATTRIBUTES_USED : out ATTRIBUTES_USED.LIST_OF;
       EI           : out ERROR_INDICATOR);

end WSR_INQ_WS_DESCRIPTION_TABLE_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_INQ_WS_DSCR_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_INQ_WS_DESCRIPTION_TABLE_0A - BODY
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  DR017  Change pattern to access type.
------------------------------------------------------------------
-- file: WSR_INQ_WS_DSCR_0A_B.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

with GKS_ERRORS;

package body WSR_INQ_WS_DESCRIPTION_TABLE_0A is

-- The following procedures inquire into the specified WS_DSCR_TBL
-- to return the inquired information.
-- GKS_ERRORS declares the error constants used to set the error
-- indicator in some procedures.

   procedure INQ_WS_CATEGORY
      (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       CATEGORY    : out WS_CATEGORY) is separate;

   procedure INQ_WS_CLASS
      (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       CLASS       : out DISPLAY_CLASS) is separate;

   procedure INQ_PREDEFINED_POLYLINE_REPRESENTATION
      (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       INDEX       : in POLYLINE_INDEX;
       LINE        : out LINETYPE;
       WIDTH       : out LINE_WIDTH;
       COLOUR      : out COLOUR_INDEX;
       EI          : out ERROR_INDICATOR) is separate;

   procedure INQ_PREDEFINED_POLYMARKER_REPRESENTATION
      (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       INDEX       : in POLYMARKER_INDEX;
       MARKER      : out MARKER_TYPE;
       SIZE        : out MARKER_SIZE;
       COLOUR      : out COLOUR_INDEX;
       EI          : out ERROR_INDICATOR) is separate;

   procedure INQ_PREDEFINED_TEXT_REPRESENTATION
      (WS_DSCR_TBL   : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       INDEX          : in TEXT_INDEX;
       FONT_PRECISION : out TEXT_FONT_PRECISION;
       EXPANSION      : out CHAR_EXPANSION;
       SPACING        : out CHAR_SPACING;
       COLOUR         : out COLOUR_INDEX;
       EI             : out ERROR_INDICATOR) is separate;

   procedure INQ_PREDEFINED_FILL_AREA_REPRESENTATION
      (WS_DSCR_TBL   : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       INDEX         : in FILL_AREA_INDEX;
       INTERIOR      : out INTERIOR_STYLE;
       STYLE         : out STYLE_INDEX;
       COLOUR        : out COLOUR_INDEX;
       EI            : out ERROR_INDICATOR) is separate;

   procedure INQ_PATTERN_FACILITIES
      (WS_DSCR_TBL  : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       NUMBER_OF_INDICES : out NATURAL) is separate;

   procedure INQ_PREDEFINED_PATTERN_REPRESENTATION
      (WS_DSCR_TBL   : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       INDEX         : in PATTERN_INDEX;
       PATTERN       : out ACCESS_COLOUR_MATRIX_TYPE;
       EI            : out ERROR_INDICATOR) is separate;

   procedure INQ_PREDEFINED_COLOUR_REPRESENTATION
      (WS_DSCR_TBL   : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       INDEX         : in COLOUR_INDEX;
       COLOUR        : out COLOUR_REPRESENTATION;
       EI            : out ERROR_INDICATOR) is separate;

   procedure INQ_LIST_OF_AVAILABLE_GDP
      (WS_DSCR_TBL   : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       LIST_OF_GDP   : out GDP_IDS.LIST_OF) is separate;

   procedure INQ_GDP
      (WS_DSCR_TBL  : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       GDP          : in GDP_ID;
       LIST_OF_ATTRIBUTES_USED : out ATTRIBUTES_USED.LIST_OF;
       EI           : out ERROR_INDICATOR)
             is separate;

end WSR_INQ_WS_DESCRIPTION_TABLE_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_INQ_WS_CATEGORY.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_WS_CATEGORY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  WSR_INQ_WS_CATEGORY.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_INQ_WS_DESCRIPTION_TABLE_0A)

procedure INQ_WS_CATEGORY
   (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
    CATEGORY    : out WS_CATEGORY) is

-- The requested information is retrieved from WS_DSCR_TBL and
-- returned in the specified parameter.
--
-- The parameters in this procedure are used as follows:
-- WS_DSCR_TBL  - the workstation description table being inquired.
-- CATEGORY     - The category of the specified workstation being
--                inquired.

begin

   -- return the inquired category from the workstation
   -- description table.

   CATEGORY := WS_DSCR_TBL.WORKSTATION_CATEGORY;

end INQ_WS_CATEGORY;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_INQ_WS_CLASS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_WS_CLASS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file : WSR_INQ_WS_CLASS.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_INQ_WS_DESCRIPTION_TABLE_0A)

procedure INQ_WS_CLASS
   (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
    CLASS       : out DISPLAY_CLASS) is

-- The requested information is retrieved from WS_DSCR_TBL and
-- returned in the specified parameter.
--
-- The parameters in this procedure are used as follows:
-- WS_DSCR_TBL    - the workstation description table being inquired.
-- CLASS          - the class of workstation being inquired.

begin

   -- return the class from the workstation description table.

   CLASS := WS_DSCR_TBL.DISPLAY_TYPE;

end INQ_WS_CLASS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_INQ_PRE_PLIN_REP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_PREDEFINED_POLYLINE_REPRESENTATION
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR010  Bundle indices converted to natural
------------------------------------------------------------------
-- file:  WSR_INQ_PRE_PLIN_REP.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_INQ_WS_DESCRIPTION_TABLE_0A)

procedure INQ_PREDEFINED_POLYLINE_REPRESENTATION
   (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
    INDEX       : in POLYLINE_INDEX;
    LINE        : out LINETYPE;
    WIDTH       : out LINE_WIDTH;
    COLOUR      : out COLOUR_INDEX;
    EI          : out ERROR_INDICATOR) is

-- The requested information is retrieved from WS_DSCR_TBL and
-- returned in the specified parameters.
--
-- This procedure checks the following errors:
--
-- EI is set to NO_PREDEF_POLYLINE_REP if a representation for
-- the specified polyline index is not predefined on the workstation.
--
-- The parameters in this procedure are used as follows:
--
-- WS_DSCR_TBL   - the workstation description table being inquired.
-- INDEX         - the index specifying the bundle being inquired.
-- LINE          - the line style being inquired from the specified
--                 bundle.
-- WIDTH         - the line width scale factor being inquired.
-- COLOUR        - the line colour being inquired.
-- EI            - An error indicator used for logging errors.

begin

   -- set the error indicator to insure that a successful value
   -- is passed out when no errors occur.
   EI := GKS_ERRORS.SUCCESSFUL;

   -- set the out parameters to default values.
   LINE := LINETYPE'FIRST;
   WIDTH := LINE_WIDTH'FIRST;
   COLOUR := COLOUR_INDEX'FIRST;

   if NATURAL(INDEX) not in
         WS_DSCR_TBL.PREDEFINED_PLIN_BUNDLES'RANGE then

      -- the specified polyline representation has not been predefined
      -- on this workstation.

      EI := GKS_ERRORS.NO_PREDEF_POLYLINE_REP;

   else

      -- Return the line type from the specified bundle in the
      -- specified workstation description table.

      LINE := WS_DSCR_TBL.PREDEFINED_PLIN_BUNDLES(NATURAL(INDEX))
            .L_TYPE;

      -- Return the line width from the specified bundle in the
      -- specified workstation description table.

      WIDTH := WS_DSCR_TBL.PREDEFINED_PLIN_BUNDLES(NATURAL(INDEX))
            .L_WIDTH;

      -- Return the colour index from the specified bundle in the
      -- specified workstation description table.

      COLOUR := WS_DSCR_TBL.PREDEFINED_PLIN_BUNDLES(NATURAL(INDEX))
            .COLOUR;

   end if;

end INQ_PREDEFINED_POLYLINE_REPRESENTATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_INQ_PRE_PMRK_REP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_PREDEFINED_POLYMARKER_REPRESENTATION
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR010 Bundle indices converted to natural
------------------------------------------------------------------
-- file:  WSR_INQ_PRE_PMRK_REP.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_INQ_WS_DESCRIPTION_TABLE_0A)

procedure INQ_PREDEFINED_POLYMARKER_REPRESENTATION
   (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
    INDEX       : in POLYMARKER_INDEX;
    MARKER      : out MARKER_TYPE;
    SIZE        : out MARKER_SIZE;
    COLOUR      : out COLOUR_INDEX;
    EI          : out ERROR_INDICATOR) is

-- The requested information is retrieved from WS_DSCR_TBL and
-- returned in the specified parameters.
--
-- This procedure checks for the following error:
--
-- EI is set to NO_PREDEF_POLYMARKER_REP if a representation for
-- the specified polymarker index has not been predefined on the
-- workstation.
--
-- The parameters in this procedure are used as follows:
-- WS_DSCR_TBL - the workstation description table to inquire.
-- INDEX       - the index of the bundle being inquired.
-- MARKER      - the type of polymarker to inquire.
-- SIZE        - the scale factor to inquire.
-- COLOUR      - the colour of polymarker to inquire.
-- EI          - An error indicator used for logging errors.

begin

   -- set the error indicator to insure that a successful value
   -- is passed out when no errors occur.
   EI := GKS_ERRORS.SUCCESSFUL;

   -- set the out parameters to default values.
   MARKER := MARKER_TYPE'FIRST;
   SIZE   := MARKER_SIZE'FIRST;
   COLOUR := COLOUR_INDEX'FIRST;

   if NATURAL(INDEX) not in
         WS_DSCR_TBL.PREDEFINED_PMRK_BUNDLES'RANGE then

      -- the specified polymarker bundle has not been predefined
      -- on this workstation.

      EI := GKS_ERRORS.NO_PREDEF_POLYMARKER_REP;

   else

      -- Return the marker type from the specified bundle in the
      -- specified WS_DSCR_TBL.

      MARKER := WS_DSCR_TBL.PREDEFINED_PMRK_BUNDLES(NATURAL(INDEX))
            .M_TYPE;

      -- Return the marker size from the specified bundle in the
      -- specified WS_DSCR_TBL.

      SIZE := WS_DSCR_TBL.PREDEFINED_PMRK_BUNDLES(NATURAL(INDEX))
            .M_SIZE;

      -- Return the colour index from the specified bundle in the
      -- specified WS_DSCR_TBL.

      COLOUR := WS_DSCR_TBL.PREDEFINED_PMRK_BUNDLES(NATURAL(INDEX))
            .COLOUR;

   end if;

end INQ_PREDEFINED_POLYMARKER_REPRESENTATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_INQ_PRE_TEXT_REP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_PREDEFINED_TEXT_REPRESENTATION
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR010  Bundle indices converted to natural
------------------------------------------------------------------
-- file:  WSR_INQ_PRE_TEXT_REP.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_INQ_WS_DESCRIPTION_TABLE_0A)

procedure INQ_PREDEFINED_TEXT_REPRESENTATION
   (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
    INDEX       : in TEXT_INDEX;
    FONT_PRECISION : out TEXT_FONT_PRECISION;
    EXPANSION   : out CHAR_EXPANSION;
    SPACING     : out CHAR_SPACING;
    COLOUR      : out COLOUR_INDEX;
    EI          : out ERROR_INDICATOR) is

-- The requested information is retrieved from WS_DSCR_TBL and
-- returned in the specified parameters.
--
-- This procedure checks for the following error:
--
-- EI is set to NO_PREDEF_TEXT_REP if a representation for
-- the specified text index is not predefined on the workstation.
--
-- The following parameters are used:
-- WS_DSCR_TBL       - the workstation description table to inquire.
-- INDEX             - the text bundle index.
-- FONT_PRECISION    - the precision of the text being drawn
--                     (char, stroke, etc).
-- EXPANSION         - the scale factor of the width of
--                     the characters.
-- SPACING           - the scale factor of the space between
--                     characters.
-- COLOUR            - the colour of the text.
-- EI                - the error indicator used for logging errors

begin

   -- set the error indicator to insure that a successful value
   -- is passed out when no errors occur.
   EI := GKS_ERRORS.SUCCESSFUL;

   -- set the out parameters to default values.
   FONT_PRECISION := (TEXT_FONT'FIRST,TEXT_PRECISION'FIRST);
   EXPANSION := CHAR_EXPANSION'FIRST;
   SPACING := CHAR_SPACING'FIRST;
   COLOUR := COLOUR_INDEX'FIRST;

   if NATURAL(INDEX) not in
         WS_DSCR_TBL.PREDEFINED_TEXT_BUNDLES'RANGE then

      -- the specified text bundle has not been predefined on this
      -- workstation.

      EI := GKS_ERRORS.NO_PREDEF_TEXT_REP;

   else

      -- Return the text precision from the specified bundle in the
      -- specified WS_DSCR_TBL.

      FONT_PRECISION := WS_DSCR_TBL
            .PREDEFINED_TEXT_BUNDLES(NATURAL(INDEX)).TEXT_FONT;

      -- Return the character expansion from the specified bundle in
      -- specified WS_DSCR_TBL.

      EXPANSION := WS_DSCR_TBL
            .PREDEFINED_TEXT_BUNDLES(NATURAL(INDEX)).CH_EXPANSION;

      -- Return the character spacing from the specified bundle in
      -- specified WS_DSCR_TBL.

      SPACING := WS_DSCR_TBL
            .PREDEFINED_TEXT_BUNDLES(NATURAL(INDEX)).CH_SPACE;

      -- Return the colour index from the specified bundle in the
      -- specified WS_DSCR_TBL.

      COLOUR := WS_DSCR_TBL
            .PREDEFINED_TEXT_BUNDLES(NATURAL(INDEX)).COLOUR;

   end if;

end INQ_PREDEFINED_TEXT_REPRESENTATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_INQ_PRE_FA_REP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_PREDEFINED_FILL_AREA_REPRESENTATION
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR010  Bundle indices converted to natural
------------------------------------------------------------------
-- file:  WSR_INQ_PRE_FA_REP.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_INQ_WS_DESCRIPTION_TABLE_0A)

procedure INQ_PREDEFINED_FILL_AREA_REPRESENTATION
   (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
    INDEX       : in FILL_AREA_INDEX;
    INTERIOR    : out INTERIOR_STYLE;
    STYLE       : out STYLE_INDEX;
    COLOUR      : out COLOUR_INDEX;
    EI          : out ERROR_INDICATOR) is

-- The requested information is retrieved from WS_DSCR_TBL and
-- returned in the specified parameters.
--
-- This procedure checks for the following error:
--
-- EI is set to WS_NO_PREDEF_FILL_AREA_REP if a representation
-- for the specified fill area index has not been predefined
-- on the workstation.
--
-- The following are parameters used:
-- WS_DSCR_TBL  - the type of workstation being inquired.
-- INDEX        - a record type containing the style
--                fill (hollow, solid, hatch, or pattern).
-- STYLE        - An index value if the style is HATCH
--                or PATTERN.
-- COLOUR       - the colour of the fill.
-- EI           - an error indicator to log any error detected.

begin

   -- set the error indicator to insure that a successful value
   -- is passed out when no errors occur.
   EI := GKS_ERRORS.SUCCESSFUL;

   -- set the out parameters to default values.
   INTERIOR := INTERIOR_STYLE'FIRST;
   STYLE := STYLE_INDEX'FIRST;
   COLOUR := COLOUR_INDEX'FIRST;

   if NATURAL(INDEX) not in WS_DSCR_TBL.PREDEFINED_FA_BUNDLES'RANGE then

      -- the specified fill area bundle has not been predefined
      -- on this workstation.

      EI := GKS_ERRORS.NO_PREDEF_FILL_AREA_REP;

   else

      -- Return the fill area interior style from the specified bundle
      -- in the specified WS_DSCR_TBL.

      INTERIOR := WS_DSCR_TBL
            .PREDEFINED_FA_BUNDLES(NATURAL(INDEX)).INT_STYLE;

      -- Return the fill area style index from the specified bundle
      -- in the specified WS_DSCR_TBL.

      STYLE := WS_DSCR_TBL
             .PREDEFINED_FA_BUNDLES(NATURAL(INDEX)).STYLE;

      -- Return the colour index from the specified bundle in the
      -- in the specified WS_DSCR_TBL.

      COLOUR := WS_DSCR_TBL
            .PREDEFINED_FA_BUNDLES(NATURAL(INDEX)).COLOUR;

   end if;

end INQ_PREDEFINED_FILL_AREA_REPRESENTATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_INQ_PAT_FAC.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_PATTERN_FACILITIES
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  WSR_INQ_PAT_FAC.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_INQ_WS_DESCRIPTION_TABLE_0A)

procedure INQ_PATTERN_FACILITIES
   (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
    NUMBER_OF_INDICES : out NATURAL) is

-- The requested information is retrieved from WS_DSCR_TBL and
-- returned in the specified parameter.
--
-- The parameters of this procedure are used as follows:
-- WS_DSCR_TBL - the workstation description table being inquired.
-- NUMBER_OF_INDICES - the number of predefined pattern indices.

begin

   -- Return the number of pattern indices from the specified bundle
   -- in the specified WS_DSCR_TBL.

   NUMBER_OF_INDICES := WS_DSCR_TBL.PREDEFINED_PATTERN_REP'LENGTH;

end INQ_PATTERN_FACILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_INQ_PRE_PAT_REP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_PREDEFINED_PATTERN_REPRESENTATION
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  DR017  Change pattern to access type.
------------------------------------------------------------------
-- file:  WSR_INQ_PRE_PAT_REP.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_INQ_WS_DESCRIPTION_TABLE_0A)

procedure INQ_PREDEFINED_PATTERN_REPRESENTATION
   (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
    INDEX       : in PATTERN_INDEX;
    PATTERN     : out ACCESS_COLOUR_MATRIX_TYPE;
    EI          : out ERROR_INDICATOR) is

-- The requested information is retrieved from WS_DSCR_TBL and
-- returned in the specified parameter.
--
-- This procedure checks for the following errors:
--
-- EI is set to NO_PREDEF_PATTERN_REP if a representation for
-- the specified pattern index has not been predefined on the
-- workstation.
-- EI is set to PATTERN_STYLE_NOT_ON_WS if the interior style
-- PATTERN is not supported of that workstation.
--
-- The parameters in this procedure are used as follows:
-- WS_DSCR_TBL      - the workstation description table to be inquired.
-- INDEX            - the index into a pattern table.
-- PATTERN          - the two dimensional array of COLOUR_INDICES
--                    defining the pattern.
-- EI               - the error indicator used to log errors.

   function "="(A,B : INTERIOR_STYLES.LIST_OF) return BOOLEAN
         renames INTERIOR_STYLES."=";

begin

   -- set the error indicator to insure that a successful value
   -- is passed out when no errors occur.
   EI := GKS_ERRORS.SUCCESSFUL;

   if WS_DSCR_TBL.LIST_OF_AVAL_INTERIOR_STYLE =
         INTERIOR_STYLES.NULL_LIST then

      -- interior style PATTERN is not supported on this workstation.
      EI := GKS_ERRORS.PATTERN_STYLE_NOT_ON_WS;

   elsif NATURAL(INDEX) not in
         WS_DSCR_TBL.PREDEFINED_PATTERN_REP'RANGE then

      -- the specified pattern representation has not been predefined
      -- on this workstation.

      EI := GKS_ERRORS.NO_PREDEF_PATTERN_REP;

   else

      -- Return the pattern representation from the specified bundle
      -- in the specified WS_DSCR_TBL.

      PATTERN := new COLOUR_MATRICES.MATRIX_OF'(WS_DSCR_TBL
            .PREDEFINED_PATTERN_REP(NATURAL(INDEX)).MATRIX);

   end if;

end INQ_PREDEFINED_PATTERN_REPRESENTATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_INQ_PRE_CLR_REP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_PREDEFINED_COLOUR_REPRESENTATION
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  WSR_INQ_PRE_CLR_REP.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_INQ_WS_DESCRIPTION_TABLE_0A)

procedure INQ_PREDEFINED_COLOUR_REPRESENTATION
   (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
    INDEX       : in COLOUR_INDEX;
    COLOUR      : out COLOUR_REPRESENTATION;
    EI          : out ERROR_INDICATOR) is

-- The requested information is retrieved from WS_DSCR_TBL and
-- returned in the specified parameters.
--
-- The parameters are used as follows:
-- WS_DSCR_TBL - the workstation description table to inquire.
-- INDEX       - the colour index value.
-- COLOUR      - The colour that the COLOUR_INDEX value
--               represents in terms of red, green, and blue
--               intensities.
-- EI          - the error indicator to log any errors.

begin

   -- set the error indicator to insure that a successful value
   -- is passed out when no errors occur.
   EI := GKS_ERRORS.SUCCESSFUL;

   -- set the out parameter to the default value.
   COLOUR := (0.0,0.0,0.0);

   if INDEX not in WS_DSCR_TBL.PREDEFINED_COLOUR_REP'RANGE then

      -- the specified colour table has not been predefined on
      -- this workstation.

      EI := GKS_ERRORS.NO_PREDEF_COLOUR_REP;
   else

      -- Return the colour representation from the specified bundle in the
      -- specified WS_DSCR_TBL.

      COLOUR := WS_DSCR_TBL.PREDEFINED_COLOUR_REP(INDEX);

   end if;

end INQ_PREDEFINED_COLOUR_REPRESENTATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_LST_OF_AVAL_GDP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_LIST_OF_AVAILABLE_GDP
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  WSR_LST_OF_AVAL_GDP.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_INQ_WS_DESCRIPTION_TABLE_0A)

procedure INQ_LIST_OF_AVAILABLE_GDP
   (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
    LIST_OF_GDP : out GDP_IDS.LIST_OF) is

-- The requested information is retrieved from WS_DSCR_TBL and
-- returned in the specified parameters.
--
-- The following parameters are used:
-- WS_DSCR_TBL      - the workstation description table to inquire.
-- LIST_OF_GDP      - gives a list of the GDP's.

begin

   -- Return the list of GDP's available on the specified workstation
   -- type.

   LIST_OF_GDP  := WS_DSCR_TBL.AVAL_GDP;

end INQ_LIST_OF_AVAILABLE_GDP;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_INQ_GDP.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_GDP
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  WSR_INQ_GDP.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_INQ_WS_DESCRIPTION_TABLE_0A)

procedure INQ_GDP
   (WS_DSCR_TBL : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
    GDP         : in GDP_ID;
    LIST_OF_ATTRIBUTES_USED : out ATTRIBUTES_USED.LIST_OF;
    EI          : out ERROR_INDICATOR) is

-- The requested information is retrieved from WS_DSCR_TBL and
-- returned in the specified parameters.
--
-- The following are parameters used:
-- WS_DESCRIPTION_TBL      - the description table to inquire.
-- GDP                     - the GDP being inquired.
-- LIST_OF_ATTRIBUTES_USED - tells whether POLYLINE attributes
--                           were used to generate the GDP, or
--                           POLYMARKER attributes etc.
-- EI                      - error indicator used to log errors.
--
-- The following error is checked:
--
-- EI is set to WS_TYPE_CANNOT_GEN_GDP if the specified workstation
-- type is not able to generate the specified generalized drawing
-- primitive.

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 for the out parameter.
   LIST_OF_ATTRIBUTES_USED := ATTRIBUTES_USED.NULL_LIST;

   if GDP_IDS.IS_IN_LIST(GDP,WS_DSCR_TBL.AVAL_GDP) then

      -- Return the list of attributes used by a specified GDP
      -- on the specified workstation type.

      LIST_OF_ATTRIBUTES_USED := WS_DSCR_TBL.ATTR_USED(GDP);

   else

      -- this workstation type is not able to generate the GDP.
      EI := GKS_ERRORS.WS_TYPE_CANNOT_GEN_GDP;

   end if;

end INQ_GDP;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:GKS_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-- file:  gks_0a.ada
-- level: 0a

-- The following context clauses refer to the logical groups
-- for level 0a.

with EXTENDED_OUTPUT_PRIMITIVES;
with SET_INDIVIDUAL_ATTRIBUTES_0A;
with SET_BUNDLE_INDICES;
with SET_PRIMITIVE_ATTRIBUTES_0A;
with INQ_GKS_DESCRIPTION_TABLE_0A;
with INQ_GKS_STATE_LIST_0A;
with INQ_WS_DESCRIPTION_TABLE_0A;
with INQ_WS_STATE_LIST_0A;
with PIXELS;
--with GKS_METAFILES;

-- 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_BUNDLE_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_0A is

-- This package provides the interface to the applications user.
-- It provides the appropriate operations of both level ma and 0a
-- to give the user the full functionality of level 0a.

   -- Level ma logical groups.

   -- 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;


   -- Level 0a logical function groups

   -- EXTENDED_OUTPUT_PRIMITIVES logical functions
   procedure CELL_ARRAY
      (LOWER_LEFT : in WC.POINT;
      UPPER_RIGHT : in WC.POINT;
      CELL        : in COLOUR_MATRICES.MATRIX_OF)
   renames EXTENDED_OUTPUT_PRIMITIVES.CELL_ARRAY;

   procedure GDP_CIRCLE
      (CENTER    : in WC.POINT;
      PERIPHERAL : in WC.POINT)
   renames EXTENDED_OUTPUT_PRIMITIVES.GDP_CIRCLE;


   -- SET_INDIVIDUAL_ATTRIBUTES_0A logical functions
   procedure SET_LINEWIDTH_SCALE_FACTOR
      (WIDTH : in LINE_WIDTH)
   renames SET_INDIVIDUAL_ATTRIBUTES_0A.SET_LINEWIDTH_SCALE_FACTOR;

   procedure SET_MARKER_SIZE_SCALE_FACTOR
      (SIZE : in MARKER_SIZE)
   renames SET_INDIVIDUAL_ATTRIBUTES_0A.SET_MARKER_SIZE_SCALE_FACTOR;

   procedure SET_TEXT_FONT_AND_PRECISION
      (FONT_PRECISION : in TEXT_FONT_PRECISION)
   renames SET_INDIVIDUAL_ATTRIBUTES_0A.SET_TEXT_FONT_AND_PRECISION;

   procedure SET_CHAR_EXPANSION_FACTOR
      (EXPANSION : in CHAR_EXPANSION)
   renames SET_INDIVIDUAL_ATTRIBUTES_0A.SET_CHAR_EXPANSION_FACTOR;

   procedure SET_CHAR_SPACING
      (SPACING : in CHAR_SPACING)
   renames SET_INDIVIDUAL_ATTRIBUTES_0A.SET_CHAR_SPACING;

   procedure SET_FILL_AREA_STYLE_INDEX
      (INDEX : in STYLE_INDEX)
   renames SET_INDIVIDUAL_ATTRIBUTES_0A.SET_FILL_AREA_STYLE_INDEX;

   procedure SET_ASF
      (ASF : in ASF_LIST)
   renames SET_INDIVIDUAL_ATTRIBUTES_0A.SET_ASF;


   -- SET_BUNDLE_INDICES logical functions
   procedure SET_POLYLINE_INDEX
      (INDEX : in POLYLINE_INDEX)
   renames SET_BUNDLE_INDICES.SET_POLYLINE_INDEX;

   procedure SET_POLYMARKER_INDEX
      (INDEX : in POLYMARKER_INDEX)
   renames SET_BUNDLE_INDICES.SET_POLYMARKER_INDEX;

   procedure SET_TEXT_INDEX
      (INDEX : in TEXT_INDEX)
   renames SET_BUNDLE_INDICES.SET_TEXT_INDEX;

   procedure SET_FILL_AREA_INDEX
      (INDEX : in FILL_AREA_INDEX)
   renames SET_BUNDLE_INDICES.SET_FILL_AREA_INDEX;


   -- SET_PRIMITIVE_ATTRIBUTES_0A logical functions
   procedure SET_TEXT_PATH
      (PATH : in TEXT_PATH)
   renames SET_PRIMITIVE_ATTRIBUTES_0A.SET_TEXT_PATH;

   procedure SET_PATTERN_SIZE
      (SIZE : in WC.SIZE)
   renames SET_PRIMITIVE_ATTRIBUTES_0A.SET_PATTERN_SIZE;

   procedure SET_PATTERN_REFERENCE_POINT
      (POINT : in WC.POINT)
   renames SET_PRIMITIVE_ATTRIBUTES_0A.SET_PATTERN_REFERENCE_POINT;


   -- INQ_GKS_DESCRIPTION_TABLE_0A logical functions
   procedure INQ_LIST_OF_AVAILABLE_WS_TYPES
      (EI   : out ERROR_INDICATOR;
      TYPES : out WS_TYPES.LIST_OF)
   renames INQ_GKS_DESCRIPTION_TABLE_0A.INQ_LIST_OF_AVAILABLE_WS_TYPES;

   procedure INQ_MAX_NORMALIZATION_TRANSFORMATION_NUMBER
      (EI            : out ERROR_INDICATOR;
      TRANSFORMATION : out TRANSFORMATION_NUMBER)
   renames INQ_GKS_DESCRIPTION_TABLE_0A.
           INQ_MAX_NORMALIZATION_TRANSFORMATION_NUMBER;


   -- INQ_GKS_STATE_LIST_0A logical functions
   procedure INQ_OPERATING_STATE_VALUE
      (VALUE : out OPERATING_STATE)
   renames INQ_GKS_STATE_LIST_0A.INQ_OPERATING_STATE_VALUE;

   procedure INQ_SET_OF_OPEN_WS
      (EI : out ERROR_INDICATOR;
      WS  : out WS_IDS.LIST_OF)
   renames INQ_GKS_STATE_LIST_0A.INQ_SET_OF_OPEN_WS;

   procedure INQ_LIST_OF_NORMALIZATION_TRANSFORMATION_NUMBERS
      (EI  : out ERROR_INDICATOR;
      LIST : out TRANSFORMATION_PRIORITY_LIST)


renames INQ_GKS_STATE_LIST_0A.INQ_LIST_OF_NORMALIZATION_TRANSFORMATION_NUMBERS;


   -- INQ_WS_DESCRIPTION_TABLE_0A logical functions
   procedure INQ_WS_CATEGORY
      (WS      : in WS_TYPE;
      EI       : out ERROR_INDICATOR;
      CATEGORY : out WS_CATEGORY)
   renames INQ_WS_DESCRIPTION_TABLE_0A.INQ_WS_CATEGORY;

   procedure INQ_WS_CLASS
      (WS   : in WS_TYPE;
      EI    : out ERROR_INDICATOR;
      CLASS : out DISPLAY_CLASS)
   renames INQ_WS_DESCRIPTION_TABLE_0A.INQ_WS_CLASS;

   procedure INQ_PREDEFINED_POLYLINE_REPRESENTATION
      (WS    : in WS_TYPE;
      INDEX  : in POLYLINE_INDEX;
      EI     : out ERROR_INDICATOR;
      LINE   : out LINETYPE;
      WIDTH  : out LINE_WIDTH;
      COLOUR : out COLOUR_INDEX)
   renames INQ_WS_DESCRIPTION_TABLE_0A.
           INQ_PREDEFINED_POLYLINE_REPRESENTATION;

   procedure INQ_PREDEFINED_POLYMARKER_REPRESENTATION
      (WS    : in WS_TYPE;
      INDEX  : in POLYMARKER_INDEX;
      EI     : out ERROR_INDICATOR;
      MARKER : out MARKER_TYPE;
      SIZE   : out MARKER_SIZE;
      COLOUR : out COLOUR_INDEX)
   renames INQ_WS_DESCRIPTION_TABLE_0A.
           INQ_PREDEFINED_POLYMARKER_REPRESENTATION;

   procedure INQ_PREDEFINED_TEXT_REPRESENTATION
      (WS            : in WS_TYPE;
      INDEX          : in TEXT_INDEX;
      EI             : out ERROR_INDICATOR;
      FONT_PRECISION : out TEXT_FONT_PRECISION;
      EXPANSION      : out CHAR_EXPANSION;
      SPACING        : out CHAR_SPACING;
      COLOUR         : out COLOUR_INDEX)
   renames INQ_WS_DESCRIPTION_TABLE_0A.
           INQ_PREDEFINED_TEXT_REPRESENTATION;

   procedure INQ_PREDEFINED_FILL_AREA_REPRESENTATION
      (WS      : in WS_TYPE;
      INDEX    : in FILL_AREA_INDEX;
      EI       : out ERROR_INDICATOR;
      INTERIOR : out INTERIOR_STYLE;
      STYLE    : out STYLE_INDEX;
      COLOUR   : out COLOUR_INDEX)
   renames INQ_WS_DESCRIPTION_TABLE_0A.
           INQ_PREDEFINED_FILL_AREA_REPRESENTATION;

   procedure INQ_PATTERN_FACILITIES
      (WS               : in WS_TYPE;
      EI                : out ERROR_INDICATOR;
      NUMBER_OF_INDICES : out NATURAL)
   renames INQ_WS_DESCRIPTION_TABLE_0A.INQ_PATTERN_FACILITIES;

   procedure INQ_PREDEFINED_PATTERN_REPRESENTATION
      (WS     : in WS_TYPE;
      INDEX   : in PATTERN_INDEX;
      EI      : out ERROR_INDICATOR;
      LAST_X  : out NATURAL;
      LAST_Y  : out NATURAL;
      PATTERN : out COLOUR_MATRICES.VARIABLE_MATRIX_OF)
   renames INQ_WS_DESCRIPTION_TABLE_0A.
           INQ_PREDEFINED_PATTERN_REPRESENTATION;

   procedure INQ_PREDEFINED_COLOUR_REPRESENTATION
      (WS    : in WS_TYPE;
      INDEX  : in COLOUR_INDEX;
      EI     : out ERROR_INDICATOR;
      COLOUR : out COLOUR_REPRESENTATION)
   renames INQ_WS_DESCRIPTION_TABLE_0A.
           INQ_PREDEFINED_COLOUR_REPRESENTATION;

   procedure INQ_LIST_OF_AVAILABLE_GDP
      (WS         : in WS_TYPE;
      EI          : out ERROR_INDICATOR;
      LIST_OF_GDP : out GDP_IDS.LIST_OF)
   renames INQ_WS_DESCRIPTION_TABLE_0A.INQ_LIST_OF_AVAILABLE_GDP;

   procedure INQ_GDP
      (WS    : in WS_TYPE;
      GDP    : in GDP_ID;
      EI     : out ERROR_INDICATOR;
      LIST_OF_ATTRIBUTES_USED : out ATTRIBUTES_USED.LIST_OF)
   renames INQ_WS_DESCRIPTION_TABLE_0A.INQ_GDP;


   -- INQ_WS_STATE_LIST_0A logical functions
   procedure INQ_WS_STATE
      (WS   : in WS_ID;
      EI    : out ERROR_INDICATOR;
      STATE : out WS_STATE)
   renames INQ_WS_STATE_LIST_0A.INQ_WS_STATE;

   procedure INQ_WS_DEFERRAL_AND_UPDATE_STATES
      (WS          : in WS_ID;
      EI           : out ERROR_INDICATOR;
      DEFERRAL     : out DEFERRAL_MODE;
      REGENERATION : out REGENERATION_MODE;
      DISPLAY      : out DISPLAY_SURFACE_EMPTY;
      FRAME_ACTION : out NEW_FRAME_NECESSARY)
   renames INQ_WS_STATE_LIST_0A.INQ_WS_DEFERRAL_AND_UPDATE_STATES;


   -- GKS_METAFILES logical functions
   --procedure WRITE_ITEM_TO_GKSM
      --(WS  : in WS_ID;
      --ITEM : in GKSM_DATA_RECORD)
   --renames GKS_METAFILES.WRITE_ITEM_TO_GKSM;

   --procedure GET_ITEM_TYPE_FROM_GKSM
      --(WS       : in WS_ID;
      --ITEM_TYPE : out GKSM_ITEM_TYPE)
   --renames GKS_METAFILES.GET_ITEM_TYPE_FROM_GKSM;

   --procedure READ_ITEM_FROM_GKSM
      --(WS  : in WS_ID;
      --ITEM : out GKSM_DATA_RECORD)
   --renames GKS_METAFILES.READ_ITEM_FROM_GKSM;

   --procedure SKIP_ITEM
      --(WS : in WS_ID)
   --renames GKS_METAFILES.SKIP_ITEM;

   --procedure INTERPRET_ITEM
      --(ITEM : in GKSM_DATA_RECORD)
   --renames GKS_METAFILES.INTERPRET_ITEM;


   -- PIXELS logical functions
   procedure INQ_PIXEL_ARRAY_DIMENSIONS
      (WS          : in WS_ID;
      CORNER_1_1   : in WC.POINT;
      CORNER_DX_DY : in WC.POINT;
      EI           : out ERROR_INDICATOR;
      DIMENSIONS   : out RASTER_UNIT_SIZE)
   renames PIXELS.INQ_PIXEL_ARRAY_DIMENSIONS;

   procedure INQ_PIXEL_ARRAY
      (WS            : in WS_ID;
      CORNER         : in WC.POINT;
      DX             : in RASTER_UNITS;
      DY             : in RASTER_UNITS;
      EI             : out ERROR_INDICATOR;
      INVALID_VALUES : out INVALID_VALUES_INDICATOR;
      LAST_X         : out NATURAL;
      LAST_Y         : out NATURAL;
      PIXEL_ARRAY    : out PIXEL_COLOUR_MATRICES.VARIABLE_MATRIX_OF)
   renames PIXELS.INQ_PIXEL_ARRAY;

   procedure INQ_PIXEL
      (WS    : in WS_ID;
      POINT  : in WC.POINT;
      EI     : out ERROR_INDICATOR;
      COLOUR : out PIXEL_COLOUR_INDEX)
   renames PIXELS.INQ_PIXEL;


   -- ERROR_ROUTINES logical functions

   procedure ERROR_LOGGING
      (EI  : in ERROR_INDICATOR;
      NAME : in SUBPROGRAM_NAME)
   renames ERROR_ROUTINES.ERROR_LOGGING;

   procedure EMERGENCY_CLOSE_GKS
   renames ERROR_ROUTINES.EMERGENCY_CLOSE_GKS;

   procedure GET_ERROR
      (EI  : out ERROR_INDICATOR;
      NAME : out VARIABLE_SUBPROGRAM_NAME)
   renames ERROR_ROUTINES.GET_ERROR;

end GKS_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--: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:0A:WS_ST_LST_TYP_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WS_STATE_LIST_TYPES
--  IDENTIFIER: GIMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file:  ws_st_lst_typ_0a.ada
-- level: 0a,1a,2a

with GKS_TYPES;
with WS_TABLE_TYPES;
with OUTPUT_ATTRIBUTES_TYPE;
with CONVERT_NDC_DC;

use GKS_TYPES;

package WS_STATE_LIST_TYPES is

   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 .. 127;
   -- The preceding subtypes were declared so as not to raise a
   -- STORAGE ERROR at execution time.  The upper bounds were chosen
   -- for the present implementation.  CLR_INDEX could be changed
   -- to support a larger colour table for other devices.

   type WS_STATE_LST
         (NUM_POLYLINE_BUNDLES      : PLIN_INDEX := 0;
          NUM_POLYMARKER_BUNDLES    : PMRK_INDEX := 0;
          NUM_TEXT_BUNDLES          : TXT_INDEX  := 0;
          NUM_FILL_AREA_BUNDLES     : FA_INDEX   := 0;
          NUM_PATTERN_TABLES        : PAT_INDEX  := 0;
          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.
      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;

      -- polyline bundles

      SET_OF_PLIN_IDC            : POLYLINE_INDICES.LIST_OF;
      POLYLINE_BUNDLES           : WS_TABLE_TYPES.POLYLINE_BUNDLE_LIST
                                        (1 .. NUM_POLYLINE_BUNDLES);

      -- polymarker bundles

      SET_OF_PMRK_IDC            : POLYMARKER_INDICES.LIST_OF;
      POLYMARKER_BUNDLES         : WS_TABLE_TYPES.POLYMARKER_BUNDLE_LIST
                                        (1 .. NUM_POLYMARKER_BUNDLES);

      -- text bundles

      SET_OF_TEXT_IDC            : TEXT_INDICES.LIST_OF;
      TEXT_BUNDLES               : WS_TABLE_TYPES.TEXT_BUNDLE_LIST
                                        (1 .. NUM_TEXT_BUNDLES);

      -- fill area bundles

      SET_OF_FILL_AREA_IDC       : FILL_AREA_INDICES.LIST_OF;
      FILL_AREA_BUNDLES          : WS_TABLE_TYPES.FILL_AREA_BUNDLE_LIST
                                        (1 .. NUM_FILL_AREA_BUNDLES);

      -- pattern table bundles

      SET_OF_PATTERN_IDC         : PATTERN_INDICES.LIST_OF;
      PATTERN_TABLE              : WS_TABLE_TYPES.PATTERN_TABLE_LIST
                                        (1 .. NUM_PATTERN_TABLES);

      -- 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:0A:WSR_SET_BUNDLE_IDC.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_SET_BUNDLE_INDICES
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_BUNDLE_IDC.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

with GKS_TYPES;
with WS_STATE_LIST_TYPES;

use GKS_TYPES;

package WSR_SET_BUNDLE_INDICES is

-- Each procedure is passed a pointer to the workstation state
-- list which is declared in WS_STATE_LIST_TYPES. GKS_TYPES
-- contains the type declarations of the other parameters.
-- The attribute field in the workstation state list is
-- set in each procedure and effective attributes are updated
-- if they are bundled and the bundle has previously been set.

   procedure SET_POLYLINE_INDEX
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       INDEX         : in POLYLINE_INDEX);

   procedure SET_POLYMARKER_INDEX
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       INDEX         : in POLYMARKER_INDEX);

   procedure SET_TEXT_INDEX
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       INDEX         : in TEXT_INDEX);

   procedure SET_FILL_AREA_INDEX

      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       INDEX         : in FILL_AREA_INDEX);

end WSR_SET_BUNDLE_INDICES;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_BUNDLE_IDC_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_SET_BUNDLE_INDICES - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_BUNDLE_IDC_B.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

package body WSR_SET_BUNDLE_INDICES is

-- The attribute entry in the workstation state list accessed by
-- the pointer WS_STATE_LIST is set to the specified value in
-- each procedure.  If any attribute in the bundle is bundled
-- then the effective value in the workstation state list is also
-- set to the specified value only if the bundle has previously
-- been set.

   procedure SET_POLYLINE_INDEX
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       INDEX         : in POLYLINE_INDEX) is separate;

   procedure SET_POLYMARKER_INDEX
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       INDEX         : in POLYMARKER_INDEX) is separate;

   procedure SET_TEXT_INDEX
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       INDEX         : in TEXT_INDEX) is separate;

   procedure SET_FILL_AREA_INDEX
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       INDEX         : in FILL_AREA_INDEX) is separate;

end WSR_SET_BUNDLE_INDICES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_INDV_ATTR_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_SET_INDIVIDUAL_ATTRIBUTES_0A
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_INDV_ATTR_0A.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

with GKS_TYPES;
with WS_DESCRIPTION_TABLE_TYPES;
with WS_STATE_LIST_TYPES;

use GKS_TYPES;

package WSR_SET_INDIVIDUAL_ATTRIBUTES_0A is

-- Each procedure is passed a pointer to the workstation state
-- list which is declared in WS_STATE_LIST_TYPES. WS_DESCRIPTION_TBL
-- is declared in WS_DESCRIPTION_TABLE_TYPES. GKS_TYPES
-- contains the type declarations of the other parameters.
-- The attribute field in the workstation state list will be
-- set in each procedure and effective attributes will be updated
-- if they are individual.

   procedure SET_LINE_WIDTH_SCALE_FACTOR
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       WIDTH         : in LINE_WIDTH);

   procedure SET_MARKER_SIZE_SCALE_FACTOR
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       SIZE          : in MARKER_SIZE);

   procedure SET_TEXT_FONT_AND_PRECISION
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       WS_DSCR_TBL   : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       FONT_PRECISION : in TEXT_FONT_PRECISION);

   procedure SET_CHAR_EXPANSION_FACTOR
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       EXPANSION     : in CHAR_EXPANSION);

   procedure SET_CHAR_SPACING
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       SPACING       : in CHAR_SPACING);

   procedure SET_FILL_AREA_STYLE_INDEX
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       INDEX         : in STYLE_INDEX);

   procedure SET_ASF
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       ASF           : in ASF_LIST);

end WSR_SET_INDIVIDUAL_ATTRIBUTES_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_INDV_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_SET_INDIVIDUAL_ATTRIBUTES_0A - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_INDV_0A_B.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

package body WSR_SET_INDIVIDUAL_ATTRIBUTES_0A is

-- The attribute entry in the workstation state list accessed by
-- the pointer WS_STATE_LIST is set to the specified value in
-- each procedure.  If the aspect source flag of the attribute
-- being set is individual then the effective value in the
-- workstation state list is also set to the specified value.

   procedure SET_LINE_WIDTH_SCALE_FACTOR
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       WIDTH         : in LINE_WIDTH) is separate;

   procedure SET_MARKER_SIZE_SCALE_FACTOR
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       SIZE          : in MARKER_SIZE) is separate;

   procedure SET_TEXT_FONT_AND_PRECISION
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       WS_DSCR_TBL   : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
       FONT_PRECISION : in TEXT_FONT_PRECISION) is separate;

   procedure SET_CHAR_EXPANSION_FACTOR
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       EXPANSION     : in CHAR_EXPANSION) is separate;

   procedure SET_CHAR_SPACING
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       SPACING       : in CHAR_SPACING) is separate;

   procedure SET_FILL_AREA_STYLE_INDEX
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       INDEX         : in STYLE_INDEX) is separate;

   procedure SET_ASF
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       ASF           : in ASF_LIST) is separate;

end WSR_SET_INDIVIDUAL_ATTRIBUTES_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_PRIM_ATTR_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_SET_PRIMITIVE_ATTRIBUTES_0A
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  #019  06/14/85  "Change SET_PATTERN_SIZE to SET_PATTERN_VECTORS"
------------------------------------------------------------------
-- file: WSR_SET_PRIM_ATTR_0A.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

with GKS_TYPES;
with WS_STATE_LIST_TYPES;

use  GKS_TYPES;

package WSR_SET_PRIMITIVE_ATTRIBUTES_0A is

-- Each procedure is passed a pointer to the workstation state
-- list which is declared in WS_STATE_LIST_TYPES. GKS_TYPES
-- contains the type declarations of the other parameters.
-- The attribute field in the workstation state list is
-- set in each procedure.

   procedure SET_TEXT_PATH
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       PATH          : in TEXT_PATH);

   procedure SET_PATTERN_SIZE
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       PATTERN_HEIGHT_VECTOR  : in NDC.VECTOR;            -- DR019
       PATTERN_WIDTH_VECTOR   : in NDC.VECTOR);           -- DR019

   procedure SET_PATTERN_REFERENCE_POINT
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       POINT         : in NDC.POINT);

end WSR_SET_PRIMITIVE_ATTRIBUTES_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_PRIM_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_SET_PRIMITIVE_ATTRIBUTES_0A - BODY
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  #019  06/14/85  "Change SET_PATTERN_SIZE to SET_PATTERN_VECTORS"
------------------------------------------------------------------
-- file: WSR_SET_PRIM_0A_B.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

package body WSR_SET_PRIMITIVE_ATTRIBUTES_0A is

-- The attribute entry in the workstation state list accessed by
-- the pointer WS_STATE_LIST is set to the specified value in
-- each procedure.

   procedure SET_TEXT_PATH
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       PATH          : in TEXT_PATH) is separate;

   procedure SET_PATTERN_SIZE
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       PATTERN_HEIGHT_VECTOR  : in NDC.VECTOR;            -- DR019
       PATTERN_WIDTH_VECTOR   : in NDC.VECTOR) is separate; -- DR019

   procedure SET_PATTERN_REFERENCE_POINT
      (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       POINT         : in NDC.POINT) is separate;

end WSR_SET_PRIMITIVE_ATTRIBUTES_0A;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_ASF.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_ASF
--  IDENTIFIER: GDMXXX.2(1)
--  DISCREPANCY REPORTS:
--  DR010  Bundle indices converted to natural.
------------------------------------------------------------------
-- file: WSR_SET_ASF.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

with OUTPUT_ATTRIBUTES_TYPE;
with WS_TABLE_TYPES;

separate (WSR_SET_INDIVIDUAL_ATTRIBUTES_0a)

procedure SET_ASF
   (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    ASF           : in ASF_LIST) is

-- The workstation state list is accessed by the pointer
-- WS_STATE_LIST. The aspect source flag record in the workstation
-- state list containing each of the following aspect source flags
-- is set to the specified record value (bundled,individual).
--
-- linetype ASF
-- linewidth scale factor ASF
-- polyline colour index ASF
-- marker type ASF
-- marker size scale factor ASF
-- polymarker colour index ASF
-- text font and precision ASF
-- character spacing ASF
-- character expansion factor ASF
-- text colour index ASF
-- fill area interior style ASF
-- fill area style index ASF
-- fill area colour index ASF
--
-- If the aspect source flag for any attribute is set to
-- bundled then the effective attribute in the workstation
-- state list is set to the bundle value corresponding to the
-- current bundle index.
--
-- The parameters to this procedure are used as follows:
--
-- WS_STATE_LIST - a pointer to the workstation state list.
-- ASF           - the list of aspect source flags being set in the
--                 workstation state list.

   CURRENT_POLYLINE : WS_TABLE_TYPES.POLYLINE_BUNDLE
         renames WS_STATE_LIST
         .POLYLINE_BUNDLES(NATURAL(WS_STATE_LIST.OUTPUT_ATTR
         .CURRENT_POLYLINE_INDEX));

   CURRENT_POLYMARKER : WS_TABLE_TYPES.POLYMARKER_BUNDLE
         renames WS_STATE_LIST
         .POLYMARKER_BUNDLES(NATURAL(WS_STATE_LIST.OUTPUT_ATTR
         .CURRENT_POLYMARKER_INDEX));

   CURRENT_TEXT : WS_TABLE_TYPES.TEXT_BUNDLE
         renames WS_STATE_LIST
         .TEXT_BUNDLES(NATURAL(WS_STATE_LIST.OUTPUT_ATTR
         .CURRENT_TEXT_INDEX));

   CURRENT_FILL_AREA : WS_TABLE_TYPES.FILL_AREA_BUNDLE
         renames WS_STATE_LIST
         .FILL_AREA_BUNDLES(NATURAL(WS_STATE_LIST.OUTPUT_ATTR
         .CURRENT_FILL_AREA_INDEX));

   WS : OUTPUT_ATTRIBUTES_TYPE.OUTPUT_ATTRIBUTES
         renames WS_STATE_LIST.OUTPUT_ATTR;

begin

   -- set the aspect source flags in the workstation state list.
   WS.ASPECT_SOURCE_FLAGS := ASF;

   if ASF.LINETYPE = BUNDLED then
      -- set the effective line type if the line type is bundled
      -- to the value in the current bundle.

      WS_STATE_LIST.EFFECTIVE_POLYLINE_ATTR.L_TYPE :=
            CURRENT_POLYLINE.L_TYPE;
   else
      -- set the effective line type if the line type is individual
      -- to the value in the current individual attribute.

      WS_STATE_LIST.EFFECTIVE_POLYLINE_ATTR.L_TYPE :=
            WS.CURRENT_LINETYPE;
   end if;

   if ASF.LINE_WIDTH = BUNDLED then
      -- set the effective linewidth if the linewidth is bundled
      -- to the value in the current bundle.

      WS_STATE_LIST.EFFECTIVE_POLYLINE_ATTR.L_WIDTH :=
            CURRENT_POLYLINE.L_WIDTH;
   else
      -- set the effective linewidth if the linewidth is individual
      -- to the value in the current individual attribute.

      WS_STATE_LIST.EFFECTIVE_POLYLINE_ATTR.L_WIDTH :=
            WS.CURRENT_LINEWIDTH_SCALE_FACTOR;
   end if;

   if ASF.LINE_COLOUR = BUNDLED then
      -- set the effective polyline colour index if the colour is
      -- bundled to the value in the current bundle.

      WS_STATE_LIST.EFFECTIVE_POLYLINE_ATTR.COLOUR :=
            CURRENT_POLYLINE.COLOUR;
   else
      -- set the effective polyline colour index if the colour is
      -- individual to the value in the current individual attribute.

      WS_STATE_LIST.EFFECTIVE_POLYLINE_ATTR.COLOUR :=
            WS.CURRENT_POLYLINE_COLOUR_INDEX;
   end if;

   if ASF.MARKER_TYPE = BUNDLED then
      -- set the effective marker type if the marker type is bundled
      -- to the value in the current bundle.

      WS_STATE_LIST.EFFECTIVE_POLYMARKER_ATTR.M_TYPE :=
            CURRENT_POLYMARKER.M_TYPE;
   else
      -- set the effective marker type if the marker type is individual
      -- to the value in the current individual attribute.

      WS_STATE_LIST.EFFECTIVE_POLYMARKER_ATTR.M_TYPE :=
            WS.CURRENT_MARKER_TYPE;
   end if;

   if ASF.MARKER_SIZE = BUNDLED then
      -- set the effective marker size scale factor if the marker
      -- size is bundled to the value in the current bundle.

      WS_STATE_LIST.EFFECTIVE_POLYMARKER_ATTR.M_SIZE :=
            CURRENT_POLYMARKER.M_SIZE;
   else
      -- set the effective marker size scale factor if the marker
      -- size is individual to the value in the current individual
      -- attribute.

      WS_STATE_LIST.EFFECTIVE_POLYMARKER_ATTR.M_SIZE :=
            WS.CURRENT_MARKER_SIZE_SCALE_FACTOR;
   end if;

   if ASF.MARKER_COLOUR = BUNDLED then
      -- set the effective polymarker colour index if the colour
      -- index is bundled to the value in the current bundle.

      WS_STATE_LIST.EFFECTIVE_POLYMARKER_ATTR.COLOUR :=
            CURRENT_POLYMARKER.COLOUR;
   else
      -- set the effective polymarker colour index if the colour
      -- index is individual to the value in the individual attribute.

      WS_STATE_LIST.EFFECTIVE_POLYMARKER_ATTR.COLOUR :=
            WS.CURRENT_POLYMARKER_COLOUR_INDEX;
   end if;

   if ASF.TEXT_FONT_PRECISION = BUNDLED then
      -- set the effective text font and precision if the text font
      -- and precision is bundled to the value in the current bundle.

      WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.TEXT_FONT :=
            CURRENT_TEXT.TEXT_FONT;
   else
      -- set the effective text font and precision if the text font
      -- and precision is individual to the value in the current
      -- individual attribute.

      WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.TEXT_FONT :=
            WS.CURRENT_TEXT_FONT_AND_PRECISION;
   end if;

   if ASF.CHAR_EXPANSION = BUNDLED then
      -- set the effective character expansion factor if the character
      -- expansion factor is bundled to the value in the current bundle.

      WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.CH_EXPANSION :=
            CURRENT_TEXT.CH_EXPANSION;
   else
      -- set the effective character expansion factor if the character
      -- expansion factor is individual to the value in the current
      -- individual attribute.

      WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.CH_EXPANSION :=
            WS.CURRENT_CHAR_EXPANSION_FACTOR;
   end if;

   if ASF.CHAR_SPACING = BUNDLED then
      -- set the effective character spacing if the character
      -- spacing is bundled to the value in the current bundle.

      WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.CH_SPACE :=
            CURRENT_TEXT.CH_SPACE;
   else
      -- set the effective character spacing if the character
      -- spacing is individual to the value in the current
      -- individual attribute.

      WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.CH_SPACE :=
            WS.CURRENT_CHAR_SPACING;
   end if;

   if ASF.TEXT_COLOUR = BUNDLED then
      -- set the effective text colour index if the text colour
      -- index is bundled to the value in the current bundle.

      WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.COLO
            CURRENT_TEXT.COLOUR;
   else
      -- set the effective text colour index if the text colour
      -- index is individual to the value in the current
      -- individual attribute.

      WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.COLOUR :=
            WS.CURRENT_TEXT_COLOUR_INDEX;
   end if;

   if ASF.INTERIOR_STYLE = BUNDLED then
      -- set the effective fill area interior style if the fill area
      -- interior style is bundled to the value in the current bundle.

      WS_STATE_LIST.EFFECTIVE_FILL_AREA_ATTR.INT_STYLE :=
            CURRENT_FILL_AREA.INT_STYLE;
   else
      -- set the effective fill area interior style if the fill area
      -- interior style is individual to the value in the current
      -- individual attribute.

      WS_STATE_LIST.EFFECTIVE_FILL_AREA_ATTR.INT_STYLE :=
            WS.CURRENT_FILL_AREA_INTERIOR_STYLE;
   end if;

   if ASF.STYLE_INDEX = BUNDLED then
      -- set the effective fill area style index if the fill area
      -- style index is bundled to the value in the current bundle.

      WS_STATE_LIST.EFFECTIVE_FILL_AREA_ATTR.STYLE :=
            CURRENT_FILL_AREA.STYLE;
   else
      -- set the effective fill area style index if the fill area
      -- style index is individual to the value in the current
      -- individual attribute.

      WS_STATE_LIST.EFFECTIVE_FILL_AREA_ATTR.STYLE :=
            WS.CURRENT_FILL_AREA_STYLE_INDEX;
   end if;

   if ASF.FILL_AREA_COLOUR = BUNDLED then
      -- set the effective fill area colour index if the fill area
      -- colour index is bundled to the value in the current bundle.

      WS_STATE_LIST.EFFECTIVE_FILL_AREA_ATTR.COLOUR :=
            CURRENT_FILL_AREA.COLOUR;
   else
      -- set the effective fill area colour index if the fill area
      -- colour index is individual to the value in the current
      -- individual attribute.

      WS_STATE_LIST.EFFECTIVE_FILL_AREA_ATTR.COLOUR :=
            WS.CURRENT_FILL_AREA_COLOUR_INDEX;
   end if;

end SET_ASF;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_CHAR_EXP_FCT.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_CHAR_EXPANSION_FACTOR
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_CHAR_EXP_FCT.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_SET_INDIVIDUAL_ATTRIBUTES_0a)

procedure SET_CHAR_EXPANSION_FACTOR
   (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    EXPANSION     : in CHAR_EXPANSION) is

-- The workstation state list is accessed by the pointer
-- WS_STATE_LIST. The character expansion factor in the workstation
-- state list is set to the specified value.
-- If the aspect source flag for the character expansion factor is
-- individual then the effective attribute in the workstation
-- state list is also set to the specified value.
--
-- The parameters to this procedure are used as follows:
--
-- WS_STATE_LIST - a pointer to the workstation state list.
-- EXPANSION     - the character expansion factor being set in the
--                 workstation state list.

begin

   -- set the character expansion factor in the workstation state list.
   WS_STATE_LIST.OUTPUT_ATTR.CURRENT_CHAR_EXPANSION_FACTOR :=
         EXPANSION;

   -- set the effective character expansion if the character
   -- expansion is individual.

   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .CHAR_EXPANSION = INDIVIDUAL then
      WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.CH_EXPANSION := EXPANSION;
   end if;

end SET_CHAR_EXPANSION_FACTOR;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_CHAR_SPG.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_CHAR_SPACING
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_CHAR_SPG.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_SET_INDIVIDUAL_ATTRIBUTES_0a)

procedure SET_CHAR_SPACING
   (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    SPACING       : in CHAR_SPACING) is

-- The workstation state list is accessed by the pointer
-- WS_STATE_LIST. The character spacing in the workstation
-- state list is set to the specified value.
-- If the aspect source flag for character spacing is
-- individual then the effective attribute in the workstation
-- state list is also set to the specified value.
--
-- The parameters to this procedure are used as follows:
--
-- WS_STATE_LIST - a pointer to the workstation state list.
-- SPACING       - the character spacing being set in the
--                 workstation state list.

begin

   -- set the character spacing in the workstation state list.
   WS_STATE_LIST.OUTPUT_ATTR.CURRENT_CHAR_SPACING :=
         SPACING;

   -- set the effective character spacing if the character
   -- spacing is individual.

   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .CHAR_SPACING = INDIVIDUAL then
      WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.CH_SPACE := SPACING;
   end if;

end SET_CHAR_SPACING;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_FA_IDX.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_FILL_AREA_INDEX
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR010  Bundle indices converted to natural
------------------------------------------------------------------
-- file: WSR_SET_FA_IDX.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_SET_BUNDLE_INDICES)

procedure SET_FILL_AREA_INDEX
   (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    INDEX         : in FILL_AREA_INDEX) is

-- The workstation state list is accessed by the pointer
-- WS_STATE_LIST. The fill area index in the workstation
-- state list is set to the specified value.
-- If the aspect source flag for any fill area attribute is
-- bundled then the effective attribute in the workstation
-- state list is also set to the bundle value for that attribute.
-- If the specified bundle has not been set previously then
-- the effective attributes are set to the values found in
-- the default bundle (one).
--
-- The parameters to this procedure are used as follows:
--
-- WS_STATE_LIST - a pointer to the workstation state list.
-- INDEX         - the fill area index being set in the workstation
--                 state list.

   DEFAULT_INDEX : constant FILL_AREA_INDEX := 1;
   -- the index value used when the bundle for the specified
   -- index has not previously been set.

   IDX : NATURAL;
   -- a fill area index which holds either the value specified
   -- or the default value.  The type is natural corresponding
   -- to the bundle index type in the workstation state list.

begin

   -- set the fill area index in the workstation state list.
   WS_STATE_LIST.OUTPUT_ATTR.CURRENT_FILL_AREA_INDEX := INDEX;

   if FILL_AREA_INDICES
         .IS_IN_LIST(INDEX,WS_STATE_LIST.SET_OF_FILL_AREA_IDC) then
      -- The bundle for the specified index has previously been
      -- set so update the effective attributes with its values
      -- when the attributes are bundled.

      IDX := NATURAL(INDEX);

   else
      -- The bundle for the specified index has not been previously
      -- set so update the effective attributes with the values
      -- from the default bundle (one) when the attributes are bundled.

      IDX := NATURAL(DEFAULT_INDEX);

   end if;

   -- set the effective interior style when the interior
   -- style is bundled.
   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .INTERIOR_STYLE = BUNDLED then
      WS_STATE_LIST.EFFECTIVE_FILL_AREA_ATTR.INT_STYLE :=
           WS_STATE_LIST.FILL_AREA_BUNDLES(IDX).INT_STYLE;
   end if;

   -- set the effective style index when the style index is bundled.
   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .STYLE_INDEX = BUNDLED then
      WS_STATE_LIST.EFFECTIVE_FILL_AREA_ATTR.STYLE :=
            WS_STATE_LIST.FILL_AREA_BUNDLES(IDX).STYLE;
   end if;

   -- set the effective fill area colour when the colour is bundled.
   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .FILL_AREA_COLOUR = BUNDLED then
      WS_STATE_LIST.EFFECTIVE_FILL_AREA_ATTR.COLOUR :=
            WS_STATE_LIST.FILL_AREA_BUNDLES(IDX).COLOUR;
   end if;

end SET_FILL_AREA_INDEX;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_FA_STY_IDX.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_FILL_AREA_STYLE_INDEX
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_FA_STY_IDX.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_SET_INDIVIDUAL_ATTRIBUTES_0a)

procedure SET_FILL_AREA_STYLE_INDEX
   (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    INDEX         : in STYLE_INDEX) is

-- The workstation state list is accessed by the pointer
-- WS_STATE_LIST. The fill area style index in the workstation
-- state list is set to the specified value.
-- If the aspect source flag for fill area style index is
-- individual then the effective attribute in the workstation
-- state list is also set to the specified value.
--
-- The parameters to this procedure are used as follows:
--
-- WS_STATE_LIST - a pointer to the workstation state list.
-- INDEX         - the fill area style index being set in the
--                 workstation state list.

begin

   -- set the fill area style index in the workstation state list.
   WS_STATE_LIST.OUTPUT_ATTR.CURRENT_FILL_AREA_STYLE_INDEX :=
         INDEX;

   -- set the effective style index if the style index is individual.
   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .STYLE_INDEX = INDIVIDUAL then
      WS_STATE_LIST.EFFECTIVE_FILL_AREA_ATTR.STYLE := INDEX;
   end if;

end SET_FILL_AREA_STYLE_INDEX;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_LINW_SF.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_LINE_WIDTH_SCALE_FACTOR
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_LINW_SF.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_SET_INDIVIDUAL_ATTRIBUTES_0a)

procedure SET_LINE_WIDTH_SCALE_FACTOR
   (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    WIDTH         : in LINE_WIDTH) is

-- The workstation state list is accessed by the pointer
-- WS_STATE_LIST. The linewidth scale factor in the workstation
-- state list is set to the specified value.
-- If the aspect source flag for the linewidth scale factor is
-- individual then the effective attribute in the workstation
-- state list is also set to the specified value.
--
-- The parameters to this procedure are used as follows:
--
-- WS_STATE_LIST - a pointer to the workstation state list.
-- WIDTH         - the line width scale factor being set in the
--                 workstation state list.

begin

   -- set the linewidth scale factor in the workstation state list.
   WS_STATE_LIST.OUTPUT_ATTR.CURRENT_LINEWIDTH_SCALE_FACTOR :=
         WIDTH;

   -- set the effective linewidth if the linewidth is individual.
   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .LINE_WIDTH = INDIVIDUAL then
      WS_STATE_LIST.EFFECTIVE_POLYLINE_ATTR.L_WIDTH := WIDTH;
   end if;

end SET_LINE_WIDTH_SCALE_FACTOR;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_MARK_SZE_SF.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_MARKER_SIZE_SCALE_FACTOR
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_MARK_SZE_SF.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_SET_INDIVIDUAL_ATTRIBUTES_0a)

procedure SET_MARKER_SIZE_SCALE_FACTOR
   (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    SIZE          : in MARKER_SIZE) is

-- The workstation state list is accessed by the pointer
-- WS_STATE_LIST. The marker size scale factor in the workstation
-- state list is set to the specified value.
-- If the aspect source flag for the marker size scale factor is
-- individual then the effective attribute in the workstation
-- state list is also set to the specified value.
--
-- The parameters to this procedure are used as follows:
--
-- WS_STATE_LIST - a pointer to the workstation state list.
-- SIZE          - the marker size scale factor being set in the
--                 workstation state list.

begin

   -- set the marker size in the workstation state list.
   WS_STATE_LIST.OUTPUT_ATTR.CURRENT_MARKER_SIZE_SCALE_FACTOR :=
         SIZE;

   -- set the effective marker size if the marker size is individual.
   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .MARKER_SIZE = INDIVIDUAL then
      WS_STATE_LIST.EFFECTIVE_POLYMARKER_ATTR.M_SIZE := SIZE;
   end if;

end SET_MARKER_SIZE_SCALE_FACTOR;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_PAT_REF_PT.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_PATTERN_REFERENCE_POINT
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_PAT_REF_PT.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_SET_PRIMITIVE_ATTRIBUTES_0a)

procedure SET_PATTERN_REFERENCE_POINT
   (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    POINT         : in NDC.POINT) is

-- The workstation state list is accessed by the pointer
-- WS_STATE_LIST. The pattern reference point field of the
-- workstation state list is set to the specified value in POINT.
--
-- The parameters in this procedure are used as follows:
--
-- WS_STATE_LIST - a pointer to the workstation state list.
-- POINT         - the pattern reference point to be set in the
--                 workstation state list.

begin

   WS_STATE_LIST.OUTPUT_ATTR.CURRENT_PATTERN_REFERENCE_POINT :=
         POINT;

end SET_PATTERN_REFERENCE_POINT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_PAT_SZE.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_PATTERN_SIZE
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  #019  06/14/85  "Change SET_PATTERN_SIZE to SET_PATTERN_VECTORS"
------------------------------------------------------------------
-- file: WSR_SET_PAT_SZE.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_SET_PRIMITIVE_ATTRIBUTES_0a)

procedure SET_PATTERN_SIZE
   (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    PATTERN_HEIGHT_VECTOR : in NDC.VECTOR;                    -- DR019
    PATTERN_WIDTH_VECTOR  : in NDC.VECTOR) is                 -- DR019

-- The workstation state list is accessed by the pointer
-- WS_STATE_LIST. The pattern width vector and pattern
-- height vector fields of the workstation state list
-- are set to the specified values in PATTERN_HEIGHT_VECTOR and -- DR019
-- PATTERN_WIDTH_VECTOR.                                      -- DR019
--
-- The parameters in this procedure are used as follows:
--
-- WS_STATE_LIST - a pointer to the workstation state list.
-- PATTERN_HEIGHT_VECTOR - the pattern height vector to be set -- DR019
--                         in the workstation state list.      -- DR019
-- PATTERN_WIDTH_VECTOR - the pattern width vector to be set   -- DR019
--                        in the workstation state list.       -- DR019


begin

   WS_STATE_LIST.OUTPUT_ATTR.CURRENT_PATTERN_WIDTH_VECTOR :=   -- DR019
         PATTERN_WIDTH_VECTOR;                                 -- DR019
   WS_STATE_LIST.OUTPUT_ATTR.CURRENT_PATTERN_HEIGHT_VECTOR :=  -- DR019
         PATTERN_HEIGHT_VECTOR;                                -- DR019

end SET_PATTERN_SIZE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_PLIN_IDX.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_POLYLINE_INDEX
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR010  Bundle indices converted to natural
------------------------------------------------------------------
-- file: WSR_SET_PLIN_IDX.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_SET_BUNDLE_INDICES)

procedure SET_POLYLINE_INDEX
   (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    INDEX         : in POLYLINE_INDEX) is

-- The workstation state list is accessed by the pointer
-- WS_STATE_LIST. The polyline index in the workstation
-- state list is set to the specified value.
-- If the aspect source flag for any polyline attribute is
-- bundled then the effective attribute in the workstation
-- state list is also set to the bundle value for that attribute.
-- If the specified bundle has not been set previously then
-- the effective attributes are set to the values found in
-- the default bundle (one).
--
-- The parameters to this procedure are used as follows:
--
-- WS_STATE_LIST - a pointer to the workstation state list.
-- INDEX         - the polyline index being set in the workstation
--                 state list.

   DEFAULT_INDEX : constant POLYLINE_INDEX := 1;
   -- the index value used when the bundle for the specified
   -- index has not previously been set.

   IDX : NATURAL;
   -- a polyline index which holds either the value specified
   -- or the default value.  The type is natural corresponding
   -- to the bundle index type in the workstation state list.

begin

   -- set the polyline index in the workstation state list.
   WS_STATE_LIST.OUTPUT_ATTR.CURRENT_POLYLINE_INDEX := INDEX;

   if POLYLINE_INDICES
         .IS_IN_LIST(INDEX,WS_STATE_LIST.SET_OF_PLIN_IDC) then
      -- The bundle for the specified index has previously been
      -- set so update the effective attributes with its values
      -- when the attributes are bundled.

      IDX := NATURAL(INDEX);

   else
      -- The specified bundle has not been previously defined so
      -- set the effective attributes to values from the default
      -- index (one) when bundled.

      IDX := NATURAL(DEFAULT_INDEX);

   end if;

   -- set the effective linetype when the linetype is bundled.
   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .LINETYPE = BUNDLED then
      WS_STATE_LIST.EFFECTIVE_POLYLINE_ATTR.L_TYPE :=
            WS_STATE_LIST.POLYLINE_BUNDLES(IDX).L_TYPE;
   end if;

   -- set the effective linewidth when the linewidth is bundled.
   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .LINE_WIDTH = BUNDLED then
      WS_STATE_LIST.EFFECTIVE_POLYLINE_ATTR.L_WIDTH :=
            WS_STATE_LIST.POLYLINE_BUNDLES(IDX).L_WIDTH;
   end if;

   -- set the effective polyline colour when the colour is bundled.
   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .LINE_COLOUR = BUNDLED then
      WS_STATE_LIST.EFFECTIVE_POLYLINE_ATTR.COLOUR :=
            WS_STATE_LIST.POLYLINE_BUNDLES(IDX).COLOUR;
   end if;

end SET_POLYLINE_INDEX;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_PMRK_IDX.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_POLYMARKER_INDEX
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR010  Bundle indices converted to natural
------------------------------------------------------------------
-- file: WSR_SET_PMRK_IDX.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_SET_BUNDLE_INDICES)

procedure SET_POLYMARKER_INDEX
   (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    INDEX         : in POLYMARKER_INDEX) is

-- The workstation state list is accessed by the pointer
-- WS_STATE_LIST. The polymarker index in the workstation
-- state list is set to the specified value.
-- If the aspect source flag for any polymarker attribute is
-- bundled then the effective attribute in the workstation
-- state list is also set to the bundle value for that attribute.
-- If the specified bundle has not been set previously then
-- the effective attributes are set to the values found in
-- the default bundle (one).
--
-- The parameters to this procedure are used as follows:
--
-- WS_STATE_LIST - a pointer to the workstation state list.
-- INDEX         - the polymarker index being set in the workstation
--                 state list.

   DEFAULT_INDEX : constant POLYMARKER_INDEX :=1;
   -- the index value used when the bundle for the specified
   -- index has not previously been set.

   IDX : NATURAL;
   -- a polymarker index which holds either the value specified
   -- or the default value.  The type is natural corresponding to
   -- the bundle index type in the workstation state list.

begin

   -- set the polymarker index in the workstation state list.
   WS_STATE_LIST.OUTPUT_ATTR.CURRENT_POLYMARKER_INDEX := INDEX;

   if POLYMARKER_INDICES
         .IS_IN_LIST(INDEX,WS_STATE_LIST.SET_OF_PMRK_IDC) then
      -- The bundle for the specified index has previously been
      -- set so update the effective attributes with its values
      -- when the attributes are bundled.

      IDX := NATURAL(INDEX);

   else
      -- The bundle for the specified index has not been previously
      -- set so update the effective attributes with the values
      -- from the default index (one) when attributes are bundled.
      IDX := NATURAL(DEFAULT_INDEX);

   end if;

   -- set the effective marker type when the marker type is bundled.
   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .MARKER_TYPE = BUNDLED then
      WS_STATE_LIST.EFFECTIVE_POLYMARKER_ATTR.M_TYPE :=
            WS_STATE_LIST.POLYMARKER_BUNDLES(IDX).M_TYPE;
   end if;

   -- set the effective marker size when the marker size is bundled.
   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .MARKER_SIZE = BUNDLED then
      WS_STATE_LIST.EFFECTIVE_POLYMARKER_ATTR.M_SIZE :=
            WS_STATE_LIST.POLYMARKER_BUNDLES(IDX).M_SIZE;
   end if;

   -- set the effective polymarker colour when the colour is bundled.
   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .MARKER_COLOUR = BUNDLED then
      WS_STATE_LIST.EFFECTIVE_POLYMARKER_ATTR.COLOUR :=
            WS_STATE_LIST.POLYMARKER_BUNDLES(IDX).COLOUR;
   end if;

end SET_POLYMARKER_INDEX;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_TEXT_IDX.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_TEXT_INDEX
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR010  Bundle indices converted to natural
------------------------------------------------------------------
-- file: WSR_SET_TEXT_IDX.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_SET_BUNDLE_INDICES)

procedure SET_TEXT_INDEX
   (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    INDEX         : in TEXT_INDEX) is

-- The workstation state list is accessed by the pointer
-- WS_STATE_LIST. The text index in the workstation
-- state list is set to the specified value.
-- If the aspect source flag for any text attribute is
-- bundled then the effective attribute in the workstation
-- state list is also set to the bundle value for that attribute.
-- If the specified bundle has not been set previously then
-- the effective attributes are set to the values found in
-- the default bundle (one).
--
-- The parameters to this procedure are used as follows:
--
-- WS_STATE_LIST - a pointer to the workstation state list.
-- INDEX         - the text index being set in the
--                 workstation state list.

   DEFAULT_INDEX : constant TEXT_INDEX := 1;
   -- the index value used when the bundle for the specified
   -- index has not previously been set.

   IDX : NATURAL;
   -- a text index which holds either the value specified
   -- or the default value.  The type is natural corresponding
   -- to the bundle index type in the workstation state list.

begin

   -- set the text index in the workstation state list.
   WS_STATE_LIST.OUTPUT_ATTR.CURRENT_TEXT_INDEX := INDEX;

   if TEXT_INDICES
         .IS_IN_LIST(INDEX,WS_STATE_LIST.SET_OF_TEXT_IDC) then
      -- The bundle for the specified index has previously been
      -- set so update the effective attributes with its values
      -- when the attributes are bundled.

      IDX := NATURAL(INDEX);

   else
      -- The bundle for the specified index has not been previously
      -- set so update the effective attributes with the values
      -- from the default bundle (one) when the attributes are bundled.

      IDX := NATURAL(DEFAULT_INDEX);

   end if;

   -- set the effective text font when the text font is bundled.
   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .TEXT_FONT_PRECISION = BUNDLED then
      WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.TEXT_FONT :=
            WS_STATE_LIST.TEXT_BUNDLES(IDX).TEXT_FONT;
   end if;

   -- set the effective character expansion when the character
   -- expansion is bundled.

   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .CHAR_EXPANSION = BUNDLED then
      WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.CH_EXPANSION :=
            WS_STATE_LIST.TEXT_BUNDLES(IDX).CH_EXPANSION;
   end if;

   -- set the effective character spacing when the character spacing
   -- is bundled.

   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .CHAR_SPACING = BUNDLED then
      WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.CH_SPACE :=
            WS_STATE_LIST.TEXT_BUNDLES(IDX).CH_SPACE;
   end if;

   -- set the effective text colour when the colour is bundled.
   if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
         .TEXT_COLOUR = BUNDLED then
      WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.COLOUR :=
            WS_STATE_LIST.TEXT_BUNDLES(IDX).COLOUR;
   end if;

end SET_TEXT_INDEX;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_TEXT_PATH.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_TEXT_PATH
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_TEXT_PATH.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_SET_PRIMITIVE_ATTRIBUTES_0a)

procedure SET_TEXT_PATH
   (WS_STATE_LIST : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    PATH          : in TEXT_PATH) is

-- The workstation state list is accessed by the pointer
-- WS_STATE_LIST. The attribute field of the workstation
-- state list is set to the specified value.
--
-- The parameters to this procedure are used as follows:
--
-- WS_STATE_LIST - a pointer to the workstation state list.
-- PATH          - the value of the text path being set in the
--                 workstation state list.

begin

   WS_STATE_LIST.OUTPUT_ATTR.CURRENT_TEXT_PATH := PATH;

end SET_TEXT_PATH;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_SET_TXTF_AND_PRC.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: SET_TEXT_FONT_AND_PRECISION
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: WSR_SET_TXTF_AND_PRC.ADA
-- level: 0a,1a,2a,0b,1b,2b,0c,1c,2c

separate (WSR_SET_INDIVIDUAL_ATTRIBUTES_0a)

procedure SET_TEXT_FONT_AND_PRECISION
   (WS_STATE_LIST  : in out WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    WS_DSCR_TBL    : in WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL;
    FONT_PRECISION : in TEXT_FONT_PRECISION) is

-- The workstation state list is accessed by the pointer
-- WS_STATE_LIST. The text font and precision in the workstation
-- state list is set to the specified value if the FONT_PRECISION
-- is defined on this workstation.  Otherwise it is set to the
-- default value.
-- If the aspect source flag for text font and precision is
-- individual then the effective attribute in the workstation
-- state list is also set to the specified value.
--
-- The parameters to this procedure are used as follows:
--
-- WS_STATE_LIST  - a pointer to the workstation state list.
-- WS_DSCR_TBL    - workstation description table containing available
--                - text font and precision.
-- FONT_PRECISION - the text font and precision being set in the
--                  workstation state list.

begin

   if TEXT_FONT_PRECISIONS.IS_IN_LIST
         (FONT_PRECISION,WS_DSCR_TBL.LIST_TEXT_FONT_AND_PRECISION) then
      -- set the text font in the workstation state list to the
      -- specified value.

      WS_STATE_LIST.OUTPUT_ATTR.CURRENT_TEXT_FONT_AND_PRECISION :=
         FONT_PRECISION;

      -- set the effective text font if the text font is individual.
      if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
            .TEXT_FONT_PRECISION = INDIVIDUAL then
         WS_STATE_LIST.EFFECTIVE_TEXT_ATTR.TEXT_FONT := FONT_PRECISION;
      end if;
   else
      -- set the text font in the workstation state list to the
      -- default value (1;STRING_PRECISION).

      WS_STATE_LIST.OUTPUT_ATTR.CURRENT_TEXT_FONT_AND_PRECISION :=
         (1,STRING_PRECISION);

      -- set the effective text font if the text font is individual.
      if WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS
            .TEXT_FONT_PRECISION = INDIVIDUAL then
         WS_STATE_LIST.EFFECTIVE_TEXT_ATTR
               .TEXT_FONT := (1,STRING_PRECISION);
      end if;
   end if;

end SET_TEXT_FONT_AND_PRECISION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--: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: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:0A:LEXI3700_TBLS_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_WS_TABLES
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file : LEXI3700_TBLS_0A.ADA
-- level: 0a

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 for the
-- LEXIDATA 3700 graphic device, and the list of WS state lists that
-- could be initialized from this WS description table.  Also a
-- function for retrieving a pointer to a WS_STATE_LIST from the list
-- is declared with two procedures, one that initialises a WS state list
-- and adds it to the list, and a procedure that will take a WS state
-- list off the the list.

   LEXI3700_WS_DT : WS_DESCRIPTION_TABLE_TYPES.WS_DESCRIPTION_TBL
      (NUM_PREDEFINED_PLIN_BUNDLE       => 5,
       NUM_PREDEFINED_PMRK_BUNDLE       => 5,
       NUM_PREDEFINED_TEXT_BUNDLE       => 5,
       NUM_PREDEFINED_FA_BUNDLE         => 5,
       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:0A:LEXI3700_TBLS_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_WS_TABLES - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file : lexi3700_tbls_0a_b.ada
-- level: 0a

with WS_TABLE_TYPES;
with LEXI3700_CONFIGURATION;
with GKS_CONFIGURATION;

package body LEXI3700_WS_TABLES is

   subtype PRE_PLINE_BUNDLES is WS_TABLE_TYPES.POLYLINE_BUNDLE;
   subtype PRE_PMARK_BUNDLES is WS_TABLE_TYPES.POLYMARKER_BUNDLE;
   subtype PRE_TEXT_BUNDLES is WS_TABLE_TYPES.TEXT_BUNDLE;
   subtype PRE_FILL_AREA_BUNDLES is WS_TABLE_TYPES.FILL_AREA_BUNDLE;
   subtype PRE_COLOUR_REP is GKS_TYPES.COLOUR_REPRESENTATION;

   -- Creates an array of the available line types that are supported.
   LINE_TYPE_LIST : constant LINETYPES.LIST_VALUES := (1,2,3,4);

   -- Creates an array of the available marker types that are supported.
   MARKER_TYPE_LIST : constant MARKER_TYPES.LIST_VALUES := (1,2,3,4,5);

   -- Creates an array of the available interior styles that the
   -- Lexidata supports.
   INTERIOR_STYLE_LIST : constant INTERIOR_STYLES.LIST_VALUES :=
         (SOLID,HOLLOW);

   -- Creates an array of text fonts and precisions that is supported.
   TEXT_FONT_AND_PRECISION_LIST : constant TEXT_FONT_PRECISIONS
         .LIST_VALUES :=
         (1 => TEXT_FONT_PRECISION'
                         (FONT => 1, PRECISION => STRING_PRECISION),
          2 => TEXT_FONT_PRECISION'
                          (FONT => 1, PRECISION => CHAR_PRECISION));

   -- Creates an array of the one GDP that is supported at this time.
   GDP_ID_LIST : constant GDP_IDS.LIST_VALUES := (1 => 1);

   -- A list of attributes used to display the GDP.
   GDP_ATTR_USED_LIST : constant ATTRIBUTES_USED.LIST_VALUES :=
         (1 => POLYLINE_ATTRIBUTES );

   -- The list of workstation state lists that could be initialized
   -- from the LEXI_WS_DT.  Presently the implimentation supports one
   -- workstation of that type.
   type LIST_OF_ST_LST;

   type PTR_TO_LST_OF_WS_ST_LST is access LIST_OF_ST_LST;

   type LIST_OF_ST_LST is record
      NEXT_SL     : PTR_TO_LST_OF_WS_ST_LST;
      WS_ST_LST   : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
   end record;

   LEXI_ST_LSTS : PTR_TO_LST_OF_WS_ST_LST;
   -- Contains the last state list that was added to the list.

   function GET_STATE_LIST_PTR
      (WS_ID : in GKS_TYPES.WS_ID) return
       WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR
   is separate;

   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;

   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;

   -- The workstation category (output, outin, input etc);
   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.
   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 AS SOON AS POSSIBLE.
   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 );

   -- The maximum number of line widths that the device supports will
   -- be used at this level 0a.
   LEXI3700_WS_DT.NUM_AVAILABLE_LWIDTH := LEXI3700_CONFIGURATION
                                           .LEXI_MAXIMUM_LINE_WIDTH;

   LEXI3700_WS_DT.NOMINAL_LWIDTH := DC.MAGNITUDE(LEXI3700_CONFIGURATION
                                    .LEXI_NOMINAL_LINE_WIDTH);

   -- The maximum range of line widths that the device supports is used.
   LEXI3700_WS_DT.RANGE_OF_LWIDTH :=
         (DC.MAGNITUDE(LEXI3700_CONFIGURATION.LEXI_MINIMUM_LINE_WIDTH),
          DC.MAGNITUDE(LEXI3700_CONFIGURATION.LEXI_MAXIMUM_LINE_WIDTH));

   -- One predefined bundle.
   LEXI3700_WS_DT.PREDEFINED_PLIN_BUNDLES := WS_TABLE_TYPES
         .POLYLINE_BUNDLE_LIST'
       (1=> PRE_PLINE_BUNDLES'(L_TYPE => 1, L_WIDTH => 1.0, COLOUR=> 1),
        2=> PRE_PLINE_BUNDLES'(L_TYPE => 2, L_WIDTH => 2.0, COLOUR=> 2),
        3=> PRE_PLINE_BUNDLES'(L_TYPE => 3, L_WIDTH => 3.0, COLOUR=> 3),
        4=> PRE_PLINE_BUNDLES'(L_TYPE => 4, L_WIDTH => 4.0, COLOUR=> 4),
        5=> PRE_PLINE_BUNDLES'(L_TYPE => 1, L_WIDTH =>10.0, COLOUR=> 7));

   -- 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.
   -- On the Lexidata device the polymarkers use text attributes,
   -- therefore they have the same limitations as text.
   LEXI3700_WS_DT.NUM_AVAILABLE_MARKER_SIZES :=
         LEXI3700_CONFIGURATION.LEXI_MAXIMUM_TEXT_SIZE;

   -- 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.
   LEXI3700_WS_DT.RANGE_OF_MARKER_SIZES :=
        (DC.MAGNITUDE (LEXI3700_CONFIGURATION.LEXI_MINIMUM_TEXT_SIZE),
         DC.MAGNITUDE (LEXI3700_CONFIGURATION.LEXI_MAXIMUM_TEXT_SIZE));

   -- Five predefined bundles.
   LEXI3700_WS_DT.PREDEFINED_PMRK_BUNDLES := WS_TABLE_TYPES
         .POLYMARKER_BUNDLE_LIST'
        (1=> PRE_PMARK_BUNDLES'(M_TYPE=>1, M_SIZE=>1.0, COLOUR=>1),
         2=> PRE_PMARK_BUNDLES'(M_TYPE=>2, M_SIZE=>2.0, COLOUR=>2),
         3=> PRE_PMARK_BUNDLES'(M_TYPE=>3, M_SIZE=>5.0, COLOUR=>3),
         4=> PRE_PMARK_BUNDLES'(M_TYPE=>4, M_SIZE=>7.0, COLOUR=>5),
         5=> PRE_PMARK_BUNDLES'(M_TYPE=>5, M_SIZE=>9.0, COLOUR=>7));

   -- 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 our
   -- device doesn't support character expansions.
   LEXI3700_WS_DT.NUM_AVAILABLE_CHAR_EXPANSIONS := 1;

   -- Only one CHAR_EXPANSIONS supported.
   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));

   -- Five predefined text bundle.
   LEXI3700_WS_DT.PREDEFINED_TEXT_BUNDLES := WS_TABLE_TYPES
         .TEXT_BUNDLE_LIST'
        (1=>PRE_TEXT_BUNDLES' (TEXT_FONT=> TEXT_FONT_PRECISION'
                      (FONT=>1,PRECISION=>STRING_PRECISION),
                      CH_EXPANSION => 1.0, CH_SPACE => 1.0, COLOUR =>1),
         2=>PRE_TEXT_BUNDLES' (TEXT_FONT=> TEXT_FONT_PRECISION'
                      (FONT=>1,PRECISION=>CHAR_PRECISION),
                      CH_EXPANSION => 1.0, CH_SPACE =>1.0, COLOUR => 2),
         3=>PRE_TEXT_BUNDLES' (TEXT_FONT=> TEXT_FONT_PRECISION'
                      (FONT=>1,PRECISION=>STRING_PRECISION),
                      CH_EXPANSION => 1.0, CH_SPACE => 1.0, COLOUR =>3),
         4=>PRE_TEXT_BUNDLES' (TEXT_FONT=> TEXT_FONT_PRECISION'
                      (FONT=>1,PRECISION=>CHAR_PRECISION),
                      CH_EXPANSION => 1.0, CH_SPACE => 1.0, COLOUR =>4),
         5=>PRE_TEXT_BUNDLES' (TEXT_FONT=> TEXT_FONT_PRECISION'
                      (FONT=>1,PRECISION=>STRING_PRECISION),
                     CH_EXPANSION => 1.0, CH_SPACE => 1.0, COLOUR =>5));

   -- 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 our implementation does not support HATCH STYLES therefore
   -- the entry is NULL.
   LEXI3700_WS_DT.LIST_OF_AVAL_HATCH_STYLE := HATCH_STYLES.NULL_LIST;

   -- Five predefined fill area bundles.
   LEXI3700_WS_DT.PREDEFINED_FA_BUNDLES := WS_TABLE_TYPES
         .FILL_AREA_BUNDLE_LIST'
      (1=>PRE_FILL_AREA_BUNDLES'(INT_STYLE=>HOLLOW,STYLE=>0,COLOUR=>0),
       2=>PRE_FILL_AREA_BUNDLES'(INT_STYLE=>SOLID ,STYLE=>0,COLOUR=>1),
       3=>PRE_FILL_AREA_BUNDLES'(INT_STYLE=>HOLLOW,STYLE=>0,COLOUR=>2),
       4=>PRE_FILL_AREA_BUNDLES'(INT_STYLE=>SOLID ,STYLE=>0,COLOUR=>4),
       5=>PRE_FILL_AREA_BUNDLES'(INT_STYLE=>SOLID ,STYLE=>0,COLOUR=>7));

   -- Defines a empty pattern matrix.  The following code is commented
   -- out because of the amount of memory needed to to store a pattern
   -- matrix (even an empty matrix).  Since the present implementation
   -- doesn't support patterns there is no need to have all that wasted
   -- space.
-- LEXI3700_WS_DT.PREDEFINED_PATTERN_REP := WS_TABLE_TYPES
--       .PATTERN_TABLE_LIST'
--     (1=>COLOUR_MATRICES.VARIABLE_MATRIX_OF'(MATRIX(0, 0)));

   -- The number of available colours.  The LEXIDATA supports 255
   -- intensities for each colour (red, green, blue).  This would
   -- mean an application programmer can access approximately
   -- sixteen million colours.  We feel that this constitutes a
   -- continuous range 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.AVAL_GDP := GDP_IDS.LIST(GDP_ID_LIST);

   LEXI3700_WS_DT.ATTR_USED(1) :=
         ATTRIBUTES_USED.LIST(GDP_ATTR_USED_LIST);

   -- Defines the maximum numbers of bundles available at this level.
   LEXI3700_WS_DT.MAX_NUM_PLIN_BUNDLE_TBL_ENTRIES := 5;
   LEXI3700_WS_DT.MAX_NUM_PMRK_BUNDLE_TBL_ENTRIES := 5;
   LEXI3700_WS_DT.MAX_NUM_TEXT_BUNDLE_TBL_ENTRIES := 5;
   LEXI3700_WS_DT.MAX_NUM_FA_BUNDLE_TBL_ENTRIES   := 5;
   LEXI3700_WS_DT.MAX_NUM_PATTERN_INDICES         := 0;
   LEXI3700_WS_DT.MAX_NUM_COLOUR_INDICES :=
         NATURAL(LEXI3700_CONFIGURATION.LEXI_MAXIMUM_COLOUR_INDEX);

end LEXI3700_WS_TABLES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--: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:0A:GET_ST_LST_PTR_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: GET_STATE_LIST_PTR
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR024  Editorial comments incorrect and/or missing.
------------------------------------------------------------------
-- file: GET_ST_LST_PTR_0A.ADA
-- level: 0a,1a,2a

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 returns a pointer to the state list specified by
-- a workstation id.
-- The following parameter is used in this function:
-- WS_ID - The workstation id for the specified workstation state list
--         to be returned.

TEMP_SL : PTR_TO_LST_OF_WS_ST_LST;
-- A temporary state list used for for the loop.

begin

   TEMP_SL := LEXI_ST_LSTS;

   while TEMP_SL /= NULL loop

      -- If the WS_ID is equal to the requested WS_ID return the
      -- WS_STATE_LIST.  If not get the next WS_STATE_LIST.

      if TEMP_SL.WS_ST_LST.WORKSTATION_ID = WS_ID then
         return TEMP_SL.WS_ST_LST;

      else
         TEMP_SL := TEMP_SL.NEXT_SL;
      end if;

   end loop;

   -- If no state list is found with the requested id NULL is returned.
   return NULL;

end GET_STATE_LIST_PTR;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:ADD_ST_LST_TO_LST_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: ADD_STATE_LIST_TO_LIST
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: ADD_ST_LST_TO_LST_0A.ADA
-- level: 0a

with WSR_WS_TRANSFORMATION;
with WSR_SET_INDIVIDUAL_ATTRIBUTES_0A;

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


-- The following procedure adds a workstation state list to the list
-- of workstations of the same type.  All of the workstations in the
-- list are initialized from the same workstation description table.
--
-- The following parameters are used in this procedure:
-- WS_ID - The workstation id for the workstation.
-- CONNECT_ID - The connection id for the workstation.
-- WS_TYPE - The type of workstation.
-- ATTRIBUTES - A copy of the output attributes as they appeared in the
--              GKS state list.
-- EI - An error indicator used to trap errors.
--
-- The following set are the five indices for the predefined bundles
-- used to create the "...IDC_LIST's".

PLINE_IDC_LIST     : constant POLYLINE_INDICES.LIST_VALUES :=
                              (1,2,3,4,5);
PMRK_IDC_LIST      : constant POLYMARKER_INDICES.LIST_VALUES :=
                              (1,2,3,4,5);
TEXT_IDC_LIST      : constant TEXT_INDICES.LIST_VALUES :=
                              (1,2,3,4,5);
FILL_AREA_IDC_LIST : constant FILL_AREA_INDICES.LIST_VALUES :=
                              (1,2,3,4,5);
COLOUR_IDC_LIST    : constant COLOUR_INDICES.LIST_VALUES :=
                              (0,1,2,3,4,5,6,7);

begin
  declare
    OLD_LEXI_ST_LST : PTR_TO_LST_OF_WS_ST_LST;
    -- Used as a temporary for linking the lists together.

    begin

      -- Get a new WS_STATE_LIST.

      -- Sets the OLD_LEXI_ST_LST equal to the current state list.
      -- It gets a new state list and links the new state list to the
      -- OLD_LEXI_ST_LST.  The first time a state list is allocated
      -- LEXI_ST_LSTS is NULL, therefore it sets OLD_LEXI_ST_LST to
      -- NULL.  It gets a new state list, and sets the NEXT_ST_LST equal
      -- to OLD_LEXI_ST_LST which is NULL;

      OLD_LEXI_ST_LST := LEXI_ST_LSTS;
      LEXI_ST_LSTS := new LIST_OF_ST_LST;
      LEXI_ST_LSTS.NEXT_SL := OLD_LEXI_ST_LST;

      -- Get a new state list and add it to the list.
      LEXI_ST_LSTS.WS_ST_LST:= new WS_STATE_LIST_TYPES.WS_STATE_LST
            (NUM_POLYLINE_BUNDLES      => WS_STATE_LIST_TYPES.PLIN_INDEX
                   (LEXI3700_WS_DT.MAX_NUM_PLIN_BUNDLE_TBL_ENTRIES),
             NUM_POLYMARKER_BUNDLES    => WS_STATE_LIST_TYPES.PMRK_INDEX
                   (LEXI3700_WS_DT.MAX_NUM_PMRK_BUNDLE_TBL_ENTRIES),
             NUM_TEXT_BUNDLES          => WS_STATE_LIST_TYPES.TXT_INDEX
                   (LEXI3700_WS_DT.MAX_NUM_TEXT_BUNDLE_TBL_ENTRIES),
             NUM_FILL_AREA_BUNDLES     => WS_STATE_LIST_TYPES.FA_INDEX
                   (LEXI3700_WS_DT.MAX_NUM_FA_BUNDLE_TBL_ENTRIES),
             NUM_PATTERN_TABLES        => WS_STATE_LIST_TYPES.PAT_INDEX
                   (LEXI3700_WS_DT.MAX_NUM_PATTERN_INDICES),
             NUM_COLOUR_REPRESENTATION => WS_STATE_LIST_TYPES.CLR_INDEX
                   (LEXI3700_WS_DT.MAX_NUM_COLOUR_INDICES - 1));

      -- Initialize the LEXI_ST_LSTS.WS_ST_LST.

      -- The following are parameters passed in to the procedure.

      LEXI_ST_LSTS.WS_ST_LST.OUTPUT_ATTR       := ATTRIBUTES;
      LEXI_ST_LSTS.WS_ST_LST.WORKSTATION_ID    := WS_ID;
      LEXI_ST_LSTS.WS_ST_LST.CONNECT_ID        := CONNECT_ID;
      LEXI_ST_LSTS.WS_ST_LST.WORKSTATION_TYPE  := WS_TYPE;

      -- The following are initialized from the LEXI3700_WS_DT.

      LEXI_ST_LSTS.WS_ST_LST.WS_DEFERRAL_MODE :=
            LEXI3700_WS_DT.DEFER_MODE;
      LEXI_ST_LSTS.WS_ST_LST.WS_IMPLICIT_REGEN_MODE :=
            LEXI3700_WS_DT.IMPLICIT_REGEN_MODE;

      -- The list of polyline bundles.

      LEXI_ST_LSTS.WS_ST_LST.SET_OF_PLIN_IDC :=
            POLYLINE_INDICES.LIST(PLINE_IDC_LIST);
      LEXI_ST_LSTS.WS_ST_LST.POLYLINE_BUNDLES :=
            LEXI3700_WS_DT.PREDEFINED_PLIN_BUNDLES;

      -- The list of polymarker bundles.

      LEXI_ST_LSTS.WS_ST_LST.SET_OF_PMRK_IDC :=
            POLYMARKER_INDICES.LIST(PMRK_IDC_LIST);
      LEXI_ST_LSTS.WS_ST_LST.POLYMARKER_BUNDLES :=
            LEXI3700_WS_DT.PREDEFINED_PMRK_BUNDLES;

      -- The list of text bundles.

      LEXI_ST_LSTS.WS_ST_LST.SET_OF_TEXT_IDC :=
            TEXT_INDICES.LIST(TEXT_IDC_LIST);
      LEXI_ST_LSTS.WS_ST_LST.TEXT_BUNDLES  :=
            LEXI3700_WS_DT.PREDEFINED_TEXT_BUNDLES;

      -- The list of fill area bundles.

      LEXI_ST_LSTS.WS_ST_LST.SET_OF_FILL_AREA_IDC :=
            FILL_AREA_INDICES.LIST(FILL_AREA_IDC_LIST);
      LEXI_ST_LSTS.WS_ST_LST.FILL_AREA_BUNDLES :=
            LEXI3700_WS_DT.PREDEFINED_FA_BUNDLES;

      -- The colour table.

      LEXI_ST_LSTS.WS_ST_LST.SET_OF_COLOUR_IDC :=
            COLOUR_INDICES.LIST(COLOUR_IDC_LIST);

      LEXI_ST_LSTS.WS_ST_LST.COLOUR_TABLE
           (LEXI3700_WS_DT.PREDEFINED_COLOUR_REP'first ..
            LEXI3700_WS_DT.PREDEFINED_COLOUR_REP'last) :=
            LEXI3700_WS_DT.PREDEFINED_COLOUR_REP;

      -- The following call sets the effective attributes in the ws
      -- state list.  Since the ASF could have been changed before
      -- the workstation was opened the effective attributes are made
      -- up of individual and bundled attributes.

      WSR_SET_INDIVIDUAL_ATTRIBUTES_0A.SET_ASF
            (LEXI_ST_LSTS.WS_ST_LST,
             LEXI_ST_LSTS.WS_ST_LST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS);

      -- 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_LSTS.WS_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_LSTS.WS_ST_LST,
             LEXI_ST_LSTS.WS_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:0A:DEL_ST_LST_FR_LST_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: DELETE_STATE_LIST_FROM_LIST
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR024  Editorial comments incorrect and/or missing.
------------------------------------------------------------------
-- file: DEL_ST_LST_FR_LST_0A.ADA
-- level: 0a,1a,2a

with UNCHECKED_DEALLOCATION;

separate (LEXI3700_WS_TABLES)

procedure DELETE_STATE_LIST_FROM_LIST
   (WS_ID : in GKS_TYPES.WS_ID) is

-- This procedure deletes the state list specified by the WS_ID from
-- the list of workstation state lists.
--
-- The following parameter is used in this procedure:
-- WS_ID - The workstation id for the workstation state list to delete.

-- This procedure deallocates the specified WS state list.
procedure FREE_WS_ST_LST is new UNCHECKED_DEALLOCATION
   (WS_STATE_LIST_TYPES.WS_STATE_LST,
    WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR);

-- This procedure deallocates a componant of the LIST_OF_ST_LST.
procedure FREE_LIST_OF_ST_LST is new UNCHECKED_DEALLOCATION
   (LIST_OF_ST_LST,
    PTR_TO_LST_OF_WS_ST_LST);

PREV_TEMP,
TEMP_SL : PTR_TO_LST_OF_WS_ST_LST := LEXI_ST_LSTS;
--Temporary variables for deleting the state list.

begin

   while TEMP_SL /= NULL loop
      if TEMP_SL.WS_ST_LST.WORKSTATION_ID = WS_ID then

         -- If the temporary is equal to the first element in the list
         -- then the list can just be freed.
         if TEMP_SL = LEXI_ST_LSTS then
            LEXI_ST_LSTS := TEMP_SL.NEXT_SL;
            FREE_WS_ST_LST(TEMP_SL.WS_ST_LST);
            FREE_LIST_OF_ST_LST(TEMP_SL);
            EXIT;
         else
            -- Set the previous state list's 'next' pointer equal to
            -- next state list after the temporary. Then free the state
            -- list.

            PREV_TEMP.NEXT_SL := TEMP_SL.NEXT_SL;
            FREE_WS_ST_LST(TEMP_SL.WS_ST_LST);
            FREE_LIST_OF_ST_LST(TEMP_SL);
            EXIT;
         end if;

      else

         -- Set the temporary state list equal to the previous state
         -- list and get the next state list.

         PREV_TEMP := TEMP_SL;
         TEMP_SL := TEMP_SL.NEXT_SL;
      end if;
   end loop;

end DELETE_STATE_LIST_FROM_LIST;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--: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_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_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: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 values 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: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: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_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:0A:LEXI_UTILITIES_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI_UTILITIES
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: LEXI_UTILITIES.ADA
-- LEVEL : 0a - 2a

with GKS_TYPES;
with LEXI3700_TYPES;
with LEXI3700_WS_TABLES;

use GKS_TYPES;
use LEXI3700_TYPES;

package LEXI_UTILITIES is

-- This package contains utility functions specific to the LEXIDATA 3700

   LARGEST_CLIPPING_RECTANGLE : constant DC.RECTANGLE_LIMITS :=
     (XMIN => DC_TYPE (0.0),
      XMAX => DC_TYPE (LEXI3700_WS_TABLES.LEXI3700_WS_DT.
         MAX_DISPLAY_SURFACE_RASTER_UNITS.X) - DC_TYPE'(1.0),
      YMIN => DC_TYPE (0.0),
      YMAX => DC_TYPE (LEXI3700_WS_TABLES.LEXI3700_WS_DT.
         MAX_DISPLAY_SURFACE_RASTER_UNITS.Y) - DC_TYPE'(1.0));
   -- Contains the number of pixels on the display surface in the X and
   -- Y dimensions.

   type STATUS_OF_POINTS is (ALL_OUTSIDE, ALL_INSIDE, INTERSECTING);
   -- This type is used by CLIP_TO_SCREEN to indicate the relationship
   -- between the points and the clipping rectangle.

   procedure CLIP_TO_SCREEN
      (ORIGINAL_POINTS    : in DC.POINT_ARRAY;
       CLIPPED_POINTS     : out DC.POINT_ARRAY;
       SUMMARY_OF_RESULTS : out STATUS_OF_POINTS;
       CLIPPING_RECTANGLE : in DC.RECTANGLE_LIMITS :=
                            LARGEST_CLIPPING_RECTANGLE);

   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:0A:LEXI_UTILITIES_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI_UTILITIES - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: LEXI_UTILITIES_B.ADA
-- LEVEL : 0a - 2a

package body LEXI_UTILITIES is

   SCREEN_SIZE : constant RASTER_UNIT_SIZE :=  LEXI3700_WS_TABLES.
      LEXI3700_WS_DT.MAX_DISPLAY_SURFACE_RASTER_UNITS;
   -- Contains the number of pixels on the display surface in the X and
   -- Y dimensions. This variable is used by all of the procedures in
   -- this package.

   procedure CLIP_TO_SCREEN
      (ORIGINAL_POINTS    : in DC.POINT_ARRAY;
       CLIPPED_POINTS     : out DC.POINT_ARRAY;
       SUMMARY_OF_RESULTS : out STATUS_OF_POINTS;
       CLIPPING_RECTANGLE : in DC.RECTANGLE_LIMITS :=
           LARGEST_CLIPPING_RECTANGLE)
      is separate;

   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 is
   -- 1 regardless of the indices of the array it received.
   --
   -- POINT_LIST - the list of points in DC to be converted to IDC.

   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

      -- 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.

   begin

      -- 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:0A:WSD_CLIP_TO_SCREEN.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CLIP_TO_SCREEN
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE : WSD_CLIP_TO_SCREEN.ADA
-- LEVELS : 0a - 2a

separate (LEXI_UTILITIES)

procedure CLIP_TO_SCREEN
   (ORIGINAL_POINTS    : in DC.POINT_ARRAY;
    CLIPPED_POINTS     : out DC.POINT_ARRAY;
    SUMMARY_OF_RESULTS : out STATUS_OF_POINTS;
    CLIPPING_RECTANGLE : in DC.RECTANGLE_LIMITS :=
                         LARGEST_CLIPPING_RECTANGLE) is

-- This procedure will clip an arbitrary number of points to the given
-- rectangle. If a point has an X or Y coordinate which is outside of
-- the rectangle, it is clipped to the border. The array of clipped
-- points is the same length as the array of original points. Each point
-- is clipped individually as in polymarker's clip. This procedure also
-- indicates if all the points are outside, inside, or neither.
--
-- ORIGINAL_POINTS    - an array of points to be tested.
-- CLIPPED_POINTS     - the result of clipping the ORIGINAL_POINTS to
--                      the area of the screen. The index to this
--                      array is the same as that of CLIPPED_POINTS.
-- SUMMARY_OF_RESULTS - is ALL_INSIDE if no clipping was done; is
--                      ALL_OUTSIDE if all of the points are to the
--                      left of the screen or if all are to the right
--                      of the screen or all below or above.
-- CLIPPING_RECTANGLE - the four points which define the borders of the
--                      clipping area.

   X_VALUE_OK : BOOLEAN;
   -- Set to True when the X value of a point is on the screen.

   Y_VALUE_OK : BOOLEAN;
   -- Set to True when the Y value of a point is on the screen.

   NUM_POINTS_OUTSIDE_CLIPPING_RECTANGLE : NATURAL;
   -- A counter for the number of exterior points.

   ALL_POINTS_ARE_BELOW : BOOLEAN := TRUE;
   -- This variable is set to TRUE until a point is found which is
   -- not below the clipping rectangle.

   ALL_POINTS_ARE_ABOVE : BOOLEAN := TRUE;
   -- This variable is set to TRUE until a point is found which is
   -- not above the clipping rectangle.

   ALL_POINTS_ARE_TO_THE_RIGHT : BOOLEAN := TRUE;
   -- This variable is set to TRUE until a point is found which is
   -- not to the right of the clipping rectangle.

   ALL_POINTS_ARE_TO_THE_LEFT : BOOLEAN := TRUE;
   -- This variable is set to TRUE until a point is found which is
   -- not to the left of the clipping rectangle.

begin

   -- Initialize the number of interior points to 0.
   NUM_POINTS_OUTSIDE_CLIPPING_RECTANGLE := 0;

   -- Repeat for each of the points in the input array.
   for I in ORIGINAL_POINTS'RANGE loop

      -- If the X coordinate is outside the border of the screen, set
      -- the flag to false and make the clipped point's X coordinate
      -- equal to the border. Otherwise put the original value into
      -- the clipped point.
      if ORIGINAL_POINTS(I).X > CLIPPING_RECTANGLE.XMAX then
         X_VALUE_OK := FALSE;
         CLIPPED_POINTS(I).X := CLIPPING_RECTANGLE.XMAX;
         ALL_POINTS_ARE_TO_THE_LEFT := FALSE;
      elsif ORIGINAL_POINTS(I).X < CLIPPING_RECTANGLE.XMIN then
         X_VALUE_OK := FALSE;
         CLIPPED_POINTS(I).X := CLIPPING_RECTANGLE.XMIN;
         ALL_POINTS_ARE_TO_THE_RIGHT := FALSE;
      else
         X_VALUE_OK := TRUE;
         CLIPPED_POINTS(I).X := ORIGINAL_POINTS(I).X;
         ALL_POINTS_ARE_TO_THE_RIGHT := FALSE;
         ALL_POINTS_ARE_TO_THE_LEFT := FALSE;
      end if;

      -- If the Y coordinate is outside the border of the screen, set
      -- the flag to true and make the clipped point's Y coordinate
      -- equal to the border. Otherwise put the original value into
      -- the clipped point.
      if ORIGINAL_POINTS(I).Y > CLIPPING_RECTANGLE.YMAX then
         Y_VALUE_OK := FALSE;
         CLIPPED_POINTS(I).Y := CLIPPING_RECTANGLE.YMAX;
         ALL_POINTS_ARE_BELOW := FALSE;
      elsif ORIGINAL_POINTS(I).Y < CLIPPING_RECTANGLE.YMIN then
         Y_VALUE_OK := FALSE;
         CLIPPED_POINTS(I).Y := CLIPPING_RECTANGLE.YMIN;
         ALL_POINTS_ARE_ABOVE := FALSE;
      else
         Y_VALUE_OK := TRUE;
         CLIPPED_POINTS(I).Y := ORIGINAL_POINTS(I).Y;
         ALL_POINTS_ARE_ABOVE := FALSE;
         ALL_POINTS_ARE_BELOW := FALSE;
      end if;

      -- If the point is one the screen, increment the number of points
      -- on the screen.
      if not X_VALUE_OK or not Y_VALUE_OK then
         NUM_POINTS_OUTSIDE_CLIPPING_RECTANGLE :=
            NUM_POINTS_OUTSIDE_CLIPPING_RECTANGLE + 1;
      end if;

   end loop;

   -- Calculate the STATUS_OF_THE_POINTS.
   if ALL_POINTS_ARE_ABOVE or ALL_POINTS_ARE_BELOW or
      ALL_POINTS_ARE_TO_THE_RIGHT or ALL_POINTS_ARE_TO_THE_LEFT then

      SUMMARY_OF_RESULTS := ALL_OUTSIDE;

   elsif NUM_POINTS_OUTSIDE_CLIPPING_RECTANGLE = 0 then

      SUMMARY_OF_RESULTS := ALL_INSIDE;

   else

      SUMMARY_OF_RESULTS := INTERSECTING;

   end if;

end CLIP_TO_SCREEN;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--: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: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: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_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:0A:WSD_TEXT_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: TEXT
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: WSD_TEXT_0A.ADA
-- LEVEL: LEVEL 0A

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).
--
-- WS_SL         - is a pointer to the Workstation State List.
-- TEXT_POSITION - contains the position to display text.
-- TEXT_STRING   - contains a string of text to be displayed.

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.

DISPLAY_CHARACTER : BOOLEAN;
-- Determine if the character is within the viewing window.

   function "=" (A, B: LEXI_UTILITIES.STATUS_OF_POINTS) return BOOLEAN
      renames LEXI_UTILITIES."=";

   function IS_CHARACTER_IN (START_POSITION     : DC.POINT;
                             PHYS_CHAR_HT       : DC_TYPE;
                             PHYS_CHAR_WT       : DC_TYPE;
                             CLIPPING_RECTANGLE : DC.RECTANGLE_LIMITS;
                             LEXI_CHAR_ROTATION : LEXI_ROTATE_CODE)
      return BOOLEAN is

   ORIGINAL_POINT : DC.POINT_ARRAY (1 .. 4);
   CLIPPED_POINT  : DC.POINT_ARRAY (1 .. 4);
   CLIP_STATUS    : LEXI_UTILITIES.STATUS_OF_POINTS;
   IS_OUT         : BOOLEAN := true;

   begin
      case LEXI_CHAR_ROTATION is
         when NO_ROTATION =>
            ORIGINAL_POINT (1).X := START_POSITION.X;
            ORIGINAL_POINT (1).Y := START_POSITION.Y;
            ORIGINAL_POINT (2).X := START_POSITION.X + PHYS_CHAR_WT;
            ORIGINAL_POINT (2).Y := START_POSITION.Y;
            ORIGINAL_POINT (3).X := START_POSITION.X;
            ORIGINAL_POINT (3).Y := START_POSITION.Y - PHYS_CHAR_HT;
            ORIGINAL_POINT (4).X := START_POSITION.X + PHYS_CHAR_WT;
            ORIGINAL_POINT (4).Y := START_POSITION.Y - PHYS_CHAR_HT;

         when ROTATION_90 =>
            ORIGINAL_POINT (1).X := START_POSITION.X;
            ORIGINAL_POINT (1).Y := START_POSITION.Y + PHYS_CHAR_WT;
            ORIGINAL_POINT (2).X := START_POSITION.X + PHYS_CHAR_HT;
            ORIGINAL_POINT (2).Y := START_POSITION.Y + PHYS_CHAR_WT;
            ORIGINAL_POINT (3).X := START_POSITION.X;
            ORIGINAL_POINT (3).Y := START_POSITION.Y;
            ORIGINAL_POINT (4).X := START_POSITION.X + PHYS_CHAR_HT;
            ORIGINAL_POINT (4).Y := START_POSITION.Y;

         when ROTATION_180 =>
            ORIGINAL_POINT (1).X := START_POSITION.X - PHYS_CHAR_WT;
            ORIGINAL_POINT (1).Y := START_POSITION.Y + PHYS_CHAR_HT;
            ORIGINAL_POINT (2).X := START_POSITION.X;
            ORIGINAL_POINT (2).Y := START_POSITION.Y + PHYS_CHAR_HT;
            ORIGINAL_POINT (3).X := START_POSITION.X - PHYS_CHAR_WT;
            ORIGINAL_POINT (3).Y := START_POSITION.Y;
            ORIGINAL_POINT (4).X := START_POSITION.X;
            ORIGINAL_POINT (4).Y := START_POSITION.Y;

         when ROTATION_270 =>
            ORIGINAL_POINT (1).X := START_POSITION.X - PHYS_CHAR_HT;
            ORIGINAL_POINT (1).Y := START_POSITION.Y;
            ORIGINAL_POINT (2).X := START_POSITION.X;
            ORIGINAL_POINT (2).Y := START_POSITION.Y;
            ORIGINAL_POINT (3).X := START_POSITION.X - PHYS_CHAR_HT;
            ORIGINAL_POINT (3).Y := START_POSITION.Y - PHYS_CHAR_WT;
            ORIGINAL_POINT (4).X := START_POSITION.X;
            ORIGINAL_POINT (4).Y := START_POSITION.Y - PHYS_CHAR_WT;
      end case;

      LEXI_UTILITIES.CLIP_TO_SCREEN (ORIGINAL_POINT,
                                     CLIPPED_POINT,
                                     CLIP_STATUS,
                                     CLIPPING_RECTANGLE);

      if CLIP_STATUS = LEXI_UTILITIES.ALL_OUTSIDE then
         IS_OUT := false;
      end if;

      return (IS_OUT);
   end IS_CHARACTER_IN;

-- Beginning of main procedure TEXT.

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;

-- Stroke precision code.

   if WS_SL.OUTPUT_ATTR.CURRENT_TEXT_FONT_AND_PRECISION.PRECISION =
      CHAR_PRECISION then
         DISPLAY_CHARACTER := IS_CHARACTER_IN
            (START_POSITION,
             DC_TYPE(
             DC_TYPE(LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_HEIGHT)
               + DC_TYPE
                 (LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_CAP_TOP)
               + DC_TYPE
                 (LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_BASE_BOTTOM))
               * DC_TYPE (LEXI_CHAR_SIZE),
             DC_TYPE (LEXI3700_CONFIGURATION.LEXI_CHARACTER_FONT_WIDTH),
             WS_SL.EFFECTIVE_CLIPPING_RECTANGLE,
             LEXI_CHAR_ROTATION);


      if DISPLAY_CHARACTER = false then
         LAST_VALID := LAST_VALID - 1;
      end if;
   end if;

   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
          -- If text is being displayed, we set the display surface
          -- to not empty. This occurs after the text has been drawn.

          WS_SL.WS_DISPLAY_SURFACE := NOTEMPTY;
       end if;
   end loop;

   if WS_SL.WS_DEFERRAL_MODE = ASAP then
      -- Flush the output buffer on the device if the deferral mode is ASAP
      LEXI3700_OUTPUT_DRIVER.FLUSH;
   end if;

end TEXT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--: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_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: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_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_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_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_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: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: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: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: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: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:0A:LEXI_EXT_PRIM_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_EXTENDED_OUTPUT_PRIMITIVES
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: LEXI_EXT_PRIM_0A.ADA
-- LEVEL: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with GKS_TYPES;
with WS_STATE_LIST_TYPES;
with CGI;

use  GKS_TYPES;
use  CGI;

package LEXI3700_EXTENDED_OUTPUT_PRIMITIVES is

-- This package contains all extended primitives procedures for the
-- Lexidata 3700 output device.
-- If more GDP's are added to the workstation driver, the
-- procedures are placed here.

   procedure CELL_ARRAY
      (WS_SL                    : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       CELL_ARRAY_CORNER_1_1    : NDC.POINT;
       CELL_ARRAY_CORNER_DX_DY  : NDC.POINT;
       CELL_ARRAY_CORNER_DX_1   : NDC.POINT;
       CELL_COLOUR_MATRIX       : ACCESS_COLOUR_MATRIX_TYPE);

   procedure CIRCLE
      (WS_SL                   : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       CIRCLE_CENTER           : NDC.POINT;
       CIRCLE_PERIPHERAL_POINT : NDC.POINT);

end LEXI3700_EXTENDED_OUTPUT_PRIMITIVES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:LEXI_EXT_PRIM_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_EXTENDED_OUTPUT_PRIMITIVES - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: LEXI_EXT_PRIM_0A_B.ADA
-- LEVEL: 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with CONVERT_NDC_DC;
with LEXI3700_TYPES;
with LEXI3700_OUTPUT_DRIVER;
with WSR_UTILITIES;
with LEXI_UTILITIES;

use  LEXI3700_TYPES;

package body LEXI3700_EXTENDED_OUTPUT_PRIMITIVES is

-- This package contains all extended primitives procedures for the
-- Lexidata 3700 output device.
-- If more GDP's are added to the workstation driver, the
-- procedures are placed here.

   procedure CELL_ARRAY
      (WS_SL                    : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       CELL_ARRAY_CORNER_1_1    : NDC.POINT;
       CELL_ARRAY_CORNER_DX_DY  : NDC.POINT;
       CELL_ARRAY_CORNER_DX_1   : NDC.POINT;
       CELL_COLOUR_MATRIX       : ACCESS_COLOUR_MATRIX_TYPE)
      is separate;

   procedure CIRCLE
      (WS_SL                   : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       CIRCLE_CENTER           : NDC.POINT;
       CIRCLE_PERIPHERAL_POINT : NDC.POINT)
      is separate;

end LEXI3700_EXTENDED_OUTPUT_PRIMITIVES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSD_CIRCLE_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CIRCLE
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: WSD_CIRCLE_OA.ADA
-- LEVEL: OA

with SQUARE_ROOT;

separate (LEXI3700_EXTENDED_OUTPUT_PRIMITIVES)

procedure CIRCLE
   (WS_SL                   : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    CIRCLE_CENTER           : NDC.POINT;
    CIRCLE_PERIPHERAL_POINT : NDC.POINT) is

-- The CIRCLE procedure is a GDP and all GDP's have no explicit
-- geometric attributes. Such information may be specified in the
-- GDP data record.
--
-- This procedure calls the IDC procedure in WSD_UTILITIES to
-- convert the NDC points to IDC (INTEGER DEVICE COORDINATES).
--
-- This procedure uses the clipping rectangle to make sure
-- that the circle is within the window/viewport. Arcs are used
-- to perform any required clipping on circles.
--
-- CIRCLE_CENTER        - contains a point defining the center of a
--                        circle.
-- CIRCLE_PERIPHERAL_PT - contains a peripheral point on the circle.
-- WS_SL                - is a pointer to the Workstation State List.

RADIUS : DC_TYPE;
-- RADIUS contains the radius of the circle.

CENTER : LEXI_POINT;
-- CENTER contains the center of the circle.

PERIPHERAL_POINT : LEXI_POINT;
-- contains the perpheral point.

CLIP_FLAG : boolean;
-- CLIP_FLAG tells if clipping is needed on circle.

LINE_WIDTH : INTEGER := INTEGER(WS_SL.EFFECTIVE_POLYLINE_ATTR.L_WIDTH);
-- 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.

DC_CENTER : DC.POINT;
-- Contains the center of the circle in dc.

DC_PERIPHERAL : DC.POINT;
-- Contains the peripheral point of the circle in dc.

XMIN : DC_TYPE :=  WS_SL.EFFECTIVE_CLIPPING_RECTANGLE.XMIN;
-- The minimum X point of the clipping rectangle.

XMAX : DC_TYPE := WS_SL.EFFECTIVE_CLIPPING_RECTANGLE.XMAX;
-- The maximum X point of the clipping rectangle.

YMIN : DC_TYPE := WS_SL.EFFECTIVE_CLIPPING_RECTANGLE.YMIN;
-- The minimum Y point of the clipping rectangle.

YMAX : DC_TYPE := WS_SL.EFFECTIVE_CLIPPING_RECTANGLE.YMAX;
-- The maximum Y point of the clipping rectangle.

MIN_DIS_TO_CLIPPING : DC_TYPE;
-- The distance from the center point to the minimum rectangle point.

MAX_DIS_TO_CLIPPING : DC_TYPE;
-- The distance from the center point to the maximum rectangle point.

procedure CLIP_CIRCLE (CENTER             : LEXI_POINT;
                       LINE_COLOUR        : LEXI_COLOUR_INDEX;
                       CLIPPING_RECTANGLE : DC.RECTANGLE_LIMITS;
                       RADIUS             : DC_TYPE) is separate;

begin

   -- Gets the colour for the circle from polyline attributes
   -- (implementation dependent).  If the effective polyline colour is
   -- not in the list of colours set, colour 1 is used.

   if COLOUR_INDICES.IS_IN_LIST (WS_SL.EFFECTIVE_POLYLINE_ATTR.COLOUR,
         WS_SL.SET_OF_COLOUR_IDC) then

      LINE_COLOUR :=
            LEXI_COLOUR_INDEX(WS_SL.EFFECTIVE_POLYLINE_ATTR.COLOUR);
   else
      LINE_COLOUR := LEXI_COLOUR_INDEX(1);
   end if;

   -- The line width is taken from the polyline attributes
   -- (implementation dependent).  If the line width is greater than
   -- the largest line width supported on the workstation, the largest
   -- line width supported is used.  If the line width is less than the
   -- smallest line width supported, the smallest line width supported
   -- is used.

   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;

   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));

   -- Converts the center point to dc coordinates.
   DC_CENTER := CONVERT_NDC_DC.DC_POINT
        (CIRCLE_CENTER, WS_SL.WS_TRANSFORM);

   -- Converts the peripheral point to dc coordinates.
   DC_PERIPHERAL := CONVERT_NDC_DC.DC_POINT
        (CIRCLE_PERIPHERAL_POINT, WS_SL.WS_TRANSFORM);

   -- Converts the center and peripheral points to IDC coordinates
   -- specific for the device.
   CENTER           := LEXI_UTILITIES.IDC (DC_CENTER);
   PERIPHERAL_POINT := LEXI_UTILITIES.IDC (DC_PERIPHERAL);

   -- Calculate the Radius length.

   RADIUS := DC_TYPE (SQUARE_ROOT.SQRT (FLOAT (((DC_PERIPHERAL.X - DC_CENTER.X)
*
      (DC_PERIPHERAL.X - DC_CENTER.X)) +
      ((DC_PERIPHERAL.Y - DC_CENTER.Y) *
      (DC_PERIPHERAL.Y - DC_CENTER.Y)))));

   -- Calculate the Distance to Clipping values.

   MIN_DIS_TO_CLIPPING := DC_TYPE (SQUARE_ROOT.SQRT (FLOAT (((XMIN - DC_CENTER.X
) *
      (XMIN - DC_CENTER.X)) + ((YMIN - DC_CENTER.Y) *
      (YMIN - DC_CENTER.Y)))));

   MAX_DIS_TO_CLIPPING := DC_TYPE (SQUARE_ROOT.SQRT (FLOAT (((XMAX - DC_CENTER.X
) *
      (XMAX - DC_CENTER.X)) + ((YMAX - DC_CENTER.Y) *
      (YMAX - DC_CENTER.Y)))));

   -- Determine if the circle is completely within the window.

   if DC_CENTER.X + RADIUS <= XMAX and then
      DC_CENTER.X - RADIUS >= XMIN and then
      DC_CENTER.Y - RADIUS >= YMIN and then
      DC_CENTER.Y + RADIUS <= YMAX then

      LEXI3700_OUTPUT_DRIVER.DISPLAY_CIRCLE (CENTER,
                                             LEXI_RADIUS_TYPE(RADIUS),
                                             LINE_COLOUR);

   elsif RADIUS > MIN_DIS_TO_CLIPPING and then
         RADIUS > MAX_DIS_TO_CLIPPING then
            null; -- Done because none of the circle is in the window.

   elsif (DC_CENTER.X + RADIUS > XMAX and DC_CENTER.X - RADIUS > XMAX)
      or else
         (DC_CENTER.X + RADIUS < XMIN and DC_CENTER.X - RADIUS < XMIN)
      or else
         (DC_CENTER.Y + RADIUS > YMAX and DC_CENTER.Y - RADIUS > YMAX)
      or else
         (DC_CENTER.Y + RADIUS < YMIN and DC_CENTER.Y - RADIUS < YMIN)
      then
         null; -- Done because none of the circle is in the window.

   else
      CLIP_CIRCLE (CENTER,
                   LINE_COLOUR,
                   WS_SL.EFFECTIVE_CLIPPING_RECTANGLE,
                   RADIUS);
   end if;

   WS_SL.WS_DISPLAY_SURFACE := NOTEMPTY;

   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 CIRCLE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:CLIP_CIRCLE.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CLIP_CIRCLE
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE  : CLIP_CIRCLE.ADA
-- LEVEL : 0a, 1a, 2a, 0b, 1b, 2b, 0c, 1c, 2c

with GKS_TRIG_LIB;

separate (LEXI3700_EXTENDED_OUTPUT_PRIMITIVES.CIRCLE)

procedure CLIP_CIRCLE (CENTER             : LEXI_POINT;
                       LINE_COLOUR        : LEXI_COLOUR_INDEX;
                       CLIPPING_RECTANGLE : DC.RECTANGLE_LIMITS;
                       RADIUS             : DC_TYPE) is

-- This procedure performs the required clipping for all circles.
--
-- CENTER            - The center point of the circle.
-- LINE_COLOUR       - The color that the circle is to be drawn in.
-- CLIPPING_RECTANGE - The area in which the circle can be seen in,
--                     outside of which requires clipping to be done.
-- RADIUS            - The radius of the circle.

THEATA1        : DC_TYPE := 0.0;
-- One of the two angles used to determine clipping window intersection.

THEATA2        : DC_TYPE;
-- One of the two angles used to determine clipping window intersection.

START_POINT    : LEXI_COUNT_VALUE;
-- The point at which the clipped circle begins

END_POINT      : LEXI_COUNT_VALUE;
-- The point at which the clipped circle stops

PIXELS         : LEXI_COUNT_VALUE;
-- The number of pixels to be used to create the circle segment.

CNT            : DC_TYPE := 0.0;
-- A counter used for calculations.

XVAL1          : DC_TYPE;
-- Radial length value.

XVAL2          : DC_TYPE;
-- Radial length value.

YVAL1          : DC_TYPE;
-- Radial length value.

YVAL2          : DC_TYPE;
-- Radial length value.

DRAW_ARC       : BOOLEAN := false;
-- Flag which indicates that the circle segment (arc) can be drawn.

VALID_POINT    : BOOLEAN := false;
-- Flag which indicates that a point, inside the window, has been found.

I              : DC_TYPE := 0.0;
-- Counter value.

PI             : constant DC_TYPE := 3.141592654;
-- The constant PI, for circle calculations.

PI_180         : constant DC_TYPE := PI / 180.0;
-- The constant PI divided by 180.0, for degree to radian conversions.

PIXEL_RATIO    : constant DC_TYPE := 1.41421; -- 5.66
-- The length to width pixel ratio.

NP180          : constant DC_TYPE := 0.5 * PI;
-- The constant 90.0 * PI / 180.0, used for circle calculations.

INCREM         : DC_TYPE := 0.2;
-- The increment for Theata1 and Theata2.

QUADS          : DC_TYPE;
-- The number of quadrants the circle traverses.

LOWER_LEFT     : LEXI_POINT := LEXI_UTILITIES.IDC
               ((CLIPPING_RECTANGLE.XMIN, CLIPPING_RECTANGLE.YMIN));
-- The lower left corner of the clipping window.

UPPER_RIGHT    : LEXI_POINT := LEXI_UTILITIES.IDC
               ((CLIPPING_RECTANGLE.XMAX, CLIPPING_RECTANGLE.YMAX));
-- The upper right corner of the clipping window.

package CIRCLE_TRIG_LIB is new GKS_TRIG_LIB(DC_TYPE);
use CIRCLE_TRIG_LIB;

begin

-- Remain in loop until the entire circumference is traversed, and all
-- calculations are made.

      while I <= 361.0 loop

      THEATA1 := I * PI_180;
      THEATA2 := (I + INCREM) * PI_180;

      -- Calculate the radial length for Theata1 and Theata2.

      XVAL1 := DC_TYPE(CENTER.X) + RADIUS *
         COS(RADIANS(THEATA1));
      YVAL1 := DC_TYPE(CENTER.Y) - RADIUS *
         SIN(RADIANS(THEATA1));
      XVAL2 := DC_TYPE(CENTER.X) + RADIUS *
         COS(RADIANS(THEATA2));
      YVAL2 := DC_TYPE(CENTER.Y) - RADIUS *
         SIN(RADIANS(THEATA2));

      -- Determine if specified radial point is a valid one.

      if (XVAL1 >= DC_TYPE(LOWER_LEFT.X) and
                   XVAL1 <= DC_TYPE(UPPER_RIGHT.X)) and then
         (YVAL1 <= DC_TYPE(LOWER_LEFT.Y) and
                   YVAL1 >= DC_TYPE(UPPER_RIGHT.Y)) and then
         (XVAL2 >= DC_TYPE(LOWER_LEFT.X) and
                   XVAL2 <= DC_TYPE(UPPER_RIGHT.X)) and then
         (YVAL2 <= DC_TYPE(LOWER_LEFT.Y) and
                   YVAL2 >= DC_TYPE(UPPER_RIGHT.Y)) then

         CNT := CNT + INCREM;
         VALID_POINT := true;
     else
         DRAW_ARC := true;
     end if;

     -- If circumference is completed and valid points were found,
     -- draw them.

     if (DRAW_ARC or I >= 360.0) and VALID_POINT then

         QUADS := DC_TYPE (INTEGER(((I + INCREM + 45.0) / 90.0) - 0.5));

         END_POINT := LEXI_COUNT_VALUE ((((QUADS * PIXEL_RATIO) +
            SIN(RADIANS(((I + INCREM) * PI_180) -
            (QUADS * NP180)))) * RADIUS) + 1.0);

         QUADS := DC_TYPE
            (INTEGER (((I + INCREM - CNT + 45.0) / 90.0) - 0.5));

         START_POINT := LEXI_COUNT_VALUE ((((QUADS * PIXEL_RATIO) +
            SIN(RADIANS(((I + INCREM - CNT) * PI_180) -
            (QUADS * NP180)))) * RADIUS) + 1.0);

         PIXELS := END_POINT - START_POINT;

         -- Call DISPLAY_ARC to draw circle segments in the window.

         LEXI3700_OUTPUT_DRIVER.DISPLAY_ARC
              (CENTER,
               LEXI_RADIUS_TYPE (RADIUS),
               LINE_COLOUR,
               START_POINT,
               PIXELS);

         LEXI3700_OUTPUT_DRIVER.FLUSH;
         CNT := 0.0;
         VALID_POINT := false;
         DRAW_ARC    := false;
      end if;

   I := I + INCREM;

   end loop; -- WHILE LOOP

end CLIP_CIRCLE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSD_CELL_AR_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: CELL_ARRAY
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR042  Cell arrays over-write each other.
------------------------------------------------------------------
-- file: WSD_CELL_AR_0A.ADA
-- level: 0a

with CONVERT_NDC_DC;

separate (LEXI3700_EXTENDED_OUTPUT_PRIMITIVES)

procedure CELL_ARRAY
   (WS_SL                     : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    CELL_ARRAY_CORNER_1_1     : NDC.POINT;
    CELL_ARRAY_CORNER_DX_DY   : NDC.POINT;
    CELL_ARRAY_CORNER_DX_1    : NDC.POINT;
    CELL_COLOUR_MATRIX        : ACCESS_COLOUR_MATRIX_TYPE) is

-- This procedure makes one or more calls to LEXI3700_DRIVER procedures
-- in order to produce the desired results.
--
-- This procedure receives three points in NDC.  It first converts them
-- to DC.  It then computes the fourth point before converting them
-- to IDC coordinates specific to the LEXIDATA.
--
-- The procedure clips to the clipping rectangle in DC coordinates.
-- If the whole CELL_ARRAY is clipped the computation of the cells
-- and scan regions is bypassed and the procedure ends.  If at least
-- some portion of the cell array is within the clipping rectangle
-- it will be displayed.
--
-- If some part of the cell array is to be displayed first it computes
-- the size of the cell array in pixels, then the size of each cell in
-- pixels.  A comparison is made from the original cell array's and the
-- clipped cell array's top left corner.  If the clipped cell array's
-- corner is different and the x or y componant is greater than the
-- original cell array corner the corner has been clipped and at least
-- a part of the first cell will not be displayed.  Because of this,
-- an offset needs to be computed to determine which cell is now the
-- top left corner and what colour it is to be.
--               ________________
--           4__|________ 3     |
--            |_||___|__|       |
--            |_||___|__|       |
--            |_||___|__|       | <-- clipping rectangle
--            |_||___|__|       |
--           1  |  ^     2      |
--              |__|____________|
--                 |
--                 |
--              cell array
--
-- Once the offset is determined as to where to index into the CELL_
-- COLOUR_MATRIX, an array is filled with colour indices and dumped to
-- the device to be displayed.
--
-- WS_SL - is a pointer to the Workstation State List.
-- CELL_ARRAY_CORNER_1_1 - The corner point (referred to as P) which
--                         corresponds with cell 1,1 of the cell colour
--                         matrix.
-- CELL_ARRAY_CORNER_DX_DY - The corner point (referred to as Q) which
--                           corresponds with the dx, dy element of the
--                           cell colour matrix.
-- CELL_ARRAY_CORNER_DX_1 - The corner point which corresponds with
--                          the cell dx,1 of the cell colour matrix.
-- CELL_COLOUR_MATRIX - is an array of pixel colours that are mapped
--                      onto the device display area.

TEMP_CELL_COLOUR_MATRIX : COLOUR_MATRICES.MATRIX_OF
      (1 .. CELL_COLOUR_MATRIX'length(1),
       1 .. CELL_COLOUR_MATRIX'length(2));
-- Stores the colour indices in the proper locations for displaying to
-- the screen.

DC_CELL_ARRAY,
-- Contains the points of the cell array dimensions in DC.

DC_CLIPPED_CELL_ARRAY : DC.POINT_ARRAY(1..4);
-- Contains the points of the clipped cell array in DC. Note the first
-- position in the array is the bottom left corner, the second is the
-- bottom right, third is the top right, and fourth is the top left.

PIXEL_ARRAY_HEIGHT,
PIXEL_ARRAY_WIDTH : INTEGER;
-- The computed height and width of the cell array.

CELL_PIXEL_HEIGHT,
CELL_PIXEL_WIDTH : LEXI_COORDINATE;
-- The computed height and width of a single cell in pixels.

IDC_UPPER_LEFT,
IDC_LOWER_RIGHT : LEXI_POINT;
-- The upper left and lower right corners of the CELL_ARRAY in INTEGER
-- DEVICE COORDINATES specific for the LEXIDATA.

DISPLAY_CELL_ARRAY : LEXI_UTILITIES.STATUS_OF_POINTS;
-- Used to determined if the array was completly clipped.

LINE_WIDTH : LEXI_LINE_WIDTH_TYPE := LEXI_LINE_WIDTH_TYPE'first;
-- An implementation dependent line width used to initialize the device.

LINE_TYPE  : LEXI_LINE_TYPE  := LEXI_LINE_TYPE'first;
-- An implementation dependent linetype used to initialize the device.

INTERIOR_STYLE : LEXI_INTERIOR_STYLE := HOLLOW;
-- An implementation dependent interior style used to initialize
-- the device.

begin
-- The addition to the current logic to support the fact that
-- points P and Q can be any opposite corners.

-- If the x and y of point P is less than the x and y of point Q then
-- point P is in the bottom left corner, and the CELL_COLOUR_MATRIX
-- needs to be adjusted.

if CELL_ARRAY_CORNER_1_1.X < CELL_ARRAY_CORNER_DX_DY.X then
   if CELL_ARRAY_CORNER_1_1.Y < CELL_ARRAY_CORNER_DX_DY.Y then
      DC_CELL_ARRAY(1) := CONVERT_NDC_DC.DC_POINT
            (CELL_ARRAY_CORNER_1_1, WS_SL.WS_TRANSFORM);
      DC_CELL_ARRAY(2) := CONVERT_NDC_DC.DC_POINT
            (CELL_ARRAY_CORNER_DX_1, WS_SL.WS_TRANSFORM);
      DC_CELL_ARRAY(3) := CONVERT_NDC_DC.DC_POINT
            (CELL_ARRAY_CORNER_DX_DY, WS_SL.WS_TRANSFORM);

      -- Compute the fourth point.
      DC_CELL_ARRAY(4) := DC.POINT'(DC_CELL_ARRAY(1).X,
                                    DC_CELL_ARRAY(3).Y);

      -- Fill the TEMP_CELL_COLOUR_MATRIX with the colour indices in
      -- the proper locations depending where point P is.

      for I in CELL_COLOUR_MATRIX'range(1) loop
         for J in CELL_COLOUR_MATRIX'range(2) loop
            TEMP_CELL_COLOUR_MATRIX(I,J) := CELL_COLOUR_MATRIX
                  (I, CELL_COLOUR_MATRIX'last(2) - J + 1);
         end loop;
      end loop;

   else
     -- Point P is in the upper left corner and the CELL_COLOUR_MATRIX
     -- does not need to be adjusted.

      DC_CELL_ARRAY(2) := CONVERT_NDC_DC.DC_POINT
            (CELL_ARRAY_CORNER_DX_DY, WS_SL.WS_TRANSFORM);
      DC_CELL_ARRAY(3) := CONVERT_NDC_DC.DC_POINT
            (CELL_ARRAY_CORNER_DX_1, WS_SL.WS_TRANSFORM);
      DC_CELL_ARRAY(4) := CONVERT_NDC_DC.DC_POINT
            (CELL_ARRAY_CORNER_1_1, WS_SL.WS_TRANSFORM);

      -- Compute the fourth point.
      DC_CELL_ARRAY(1) := DC.POINT'(DC_CELL_ARRAY(4).X,
                                    DC_CELL_ARRAY(2).Y);

      for I in CELL_COLOUR_MATRIX'range(1) loop
         for J in CELL_COLOUR_MATRIX'range(2) loop
            TEMP_CELL_COLOUR_MATRIX(I,J) := CELL_COLOUR_MATRIX(I, J);
         end loop;
      end loop;

   end if;

elsif CELL_ARRAY_CORNER_1_1.Y > CELL_ARRAY_CORNER_DX_DY.Y then

   -- Point P is in the upper right corner.

   DC_CELL_ARRAY(1) := CONVERT_NDC_DC.DC_POINT
         (CELL_ARRAY_CORNER_DX_DY, WS_SL.WS_TRANSFORM);
   DC_CELL_ARRAY(3) := CONVERT_NDC_DC.DC_POINT
         (CELL_ARRAY_CORNER_1_1, WS_SL.WS_TRANSFORM);
   DC_CELL_ARRAY(4) := CONVERT_NDC_DC.DC_POINT
         (CELL_ARRAY_CORNER_DX_1, WS_SL.WS_TRANSFORM);

   -- Compute the fourth point.
   DC_CELL_ARRAY(2) := DC.POINT'(DC_CELL_ARRAY(3).X,
                                 DC_CELL_ARRAY(1).Y);

   for I in CELL_COLOUR_MATRIX'range(1) loop
      for J in CELL_COLOUR_MATRIX'range(2) loop
         TEMP_CELL_COLOUR_MATRIX(I,J) := CELL_COLOUR_MATRIX
               (CELL_COLOUR_MATRIX'last(1) - I + 1, J);
      end loop;
   end loop;

else

   -- Point P is in the lower right corner.

   DC_CELL_ARRAY(1) := CONVERT_NDC_DC.DC_POINT
         (CELL_ARRAY_CORNER_DX_1, WS_SL.WS_TRANSFORM);
   DC_CELL_ARRAY(2) := CONVERT_NDC_DC.DC_POINT
         (CELL_ARRAY_CORNER_1_1, WS_SL.WS_TRANSFORM);
   DC_CELL_ARRAY(4) := CONVERT_NDC_DC.DC_POINT
         (CELL_ARRAY_CORNER_DX_DY, WS_SL.WS_TRANSFORM);

   -- Compute the fourth point.
   DC_CELL_ARRAY(3) := DC.POINT'(DC_CELL_ARRAY(2).X,
                                 DC_CELL_ARRAY(4).Y);

   for I in CELL_COLOUR_MATRIX'range(1) loop
      for J in CELL_COLOUR_MATRIX'range(2) loop
         TEMP_CELL_COLOUR_MATRIX(I,J) := CELL_COLOUR_MATRIX
               (CELL_COLOUR_MATRIX'last(1) - I + 1,
                CELL_COLOUR_MATRIX'last(2) - J + 1);
      end loop;
   end loop;
end if;

   -- Clip the cell array to the EFFECTIVE_CLIPPING_RECTANGLE in DC.
   LEXI_UTILITIES.CLIP_TO_SCREEN
         (DC_CELL_ARRAY,DC_CLIPPED_CELL_ARRAY,DISPLAY_CELL_ARRAY,
          WS_SL.EFFECTIVE_CLIPPING_RECTANGLE);

   if DISPLAY_CELL_ARRAY /= LEXI_UTILITIES.ALL_OUTSIDE then
   -- The CELL_ARRAY was not totally outside the clipping rectangle.
   -- At least part of the CELL_ARRAY will be displayed.

      -- Compute the size of the cell array.
      PIXEL_ARRAY_WIDTH := INTEGER(DC_CELL_ARRAY(3).X) -
                           INTEGER(DC_CELL_ARRAY(4).X) + 1;
      PIXEL_ARRAY_HEIGHT := INTEGER(DC_CELL_ARRAY(4).Y) -
                            INTEGER(DC_CELL_ARRAY(1).Y) + 1;

      -- Compute the size of a cell.
      CELL_PIXEL_WIDTH := CELL_COLOUR_MATRIX'length(1);
      CELL_PIXEL_HEIGHT := CELL_COLOUR_MATRIX'length(2);

      -- Set the device for displaying cells
      LEXI3700_OUTPUT_DRIVER.SET_DISPLAY_PARAMETERS
           (LINE_WIDTH,LINE_TYPE,INTERIOR_STYLE);

      declare
         CLIPPED_IDC_CELL_ARRAY : LEXI_POINTS(1..4) :=
               LEXI_UTILITIES.IDC (DC_CLIPPED_CELL_ARRAY);
         CLIP_LEFT,
         CLIP_TOP : INTEGER;

      begin

         -- Set the rectangle limits for the device to draw to.
         LEXI3700_OUTPUT_DRIVER.SET_RECTANGULAR_LIMIT
               (CLIPPED_IDC_CELL_ARRAY(4),CLIPPED_IDC_CELL_ARRAY(2));

         CLIP_LEFT := abs (INTEGER(DC_CLIPPED_CELL_ARRAY(4).X) -
                      INTEGER(DC_CELL_ARRAY(4).X));
         CLIP_TOP := abs (INTEGER(DC_CLIPPED_CELL_ARRAY(4).Y) -
                     INTEGER(DC_CELL_ARRAY(4).Y));

         declare

            COLOUR_INDICES_ARRAY : LEXI_PIXEL_ARRAY_INDEX
                  (1 .. POSITIVE(CLIPPED_IDC_CELL_ARRAY(3).X -
                   CLIPPED_IDC_CELL_ARRAY(4).X + 1));
            Y_POSITION : NATURAL;
            X_POSITION : NATURAL;
            -- Indices into the TEMP_CELL_COLOUR_MATRIX for displaying.

            function "+" (A,B : LEXI_COORDINATE) return LEXI_COORDINATE
                  renames LEXI3700_TYPES."+";

            function "*" (A,B : LEXI_COORDINATE) return LEXI_COORDINATE
                  renames LEXI3700_TYPES."*";

         begin

            -- The number of time the following loops is equal to the
            -- rows and columns of pixels of the clipped cell array.
            -- The DX and DY are used to compute an offset to index into
            -- the CELL_COLOUR_MATRIX if the cell array was clipped.  If
            -- the cell array wasn't clipped the offset will be zero and
            -- the array will be indexed from its starting position.

            for DY IN 0 .. CLIPPED_IDC_CELL_ARRAY(1).Y -
                  CLIPPED_IDC_CELL_ARRAY(4).Y  loop

               -- The computed offset of the Y componant of the CELL_
               -- COLOUR_MATRIX.  The x is computed each time through
               -- the loop.

               Y_POSITION := TEMP_CELL_COLOUR_MATRIX'first(2) +
                        NATURAL ((CELL_PIXEL_HEIGHT *
                        (DY +  LEXI_COORDINATE(CLIP_TOP))) /
                        LEXI_COORDINATE(PIXEL_ARRAY_HEIGHT));

               for DX in 0 .. CLIPPED_IDC_CELL_ARRAY(3).X -
                        CLIPPED_IDC_CELL_ARRAY(4).X loop

                  X_POSITION := TEMP_CELL_COLOUR_MATRIX'first(1) +
                        NATURAL ((CELL_PIXEL_WIDTH *
                        (DX + LEXI_COORDINATE(CLIP_LEFT))) /
                        LEXI_COORDINATE(PIXEL_ARRAY_WIDTH));

                  COLOUR_INDICES_ARRAY(POSITIVE(DX + 1)) :=
                        LEXI_COLOUR_INDEX
                        (TEMP_CELL_COLOUR_MATRIX
                        (X_POSITION, Y_POSITION));

                  -- Check to see if the colour index requested is set
                  -- on the device, if not an implementation defined
                  -- colour index of 1 is used.

                  if not COLOUR_INDICES.IS_IN_LIST (COLOUR_INDEX
                        (COLOUR_INDICES_ARRAY(POSITIVE(DX + 1))),
                         WS_SL.SET_OF_COLOUR_IDC) then
                     COLOUR_INDICES_ARRAY(POSITIVE(DX + 1)) := 1;
                  end if;

               end loop;

               -- Call the OUTPUT DRIVER to display a row of pixels.
               LEXI3700_OUTPUT_DRIVER.SEQUENTIAL_PIXEL_WRITE
                     (COLOUR_INDICES_ARRAY);

            end loop;
         end;
      end;
   end if;

end CELL_ARRAY;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:LEXI_PIXEL_OPS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_PIXEL_OPERATIONS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: LEXI_PIXEL_OPS.ADA
-- LEVEL: 0A

with GKS_TYPES;
with WS_STATE_LIST_TYPES;
with CGI;

use  CGI;
use  GKS_TYPES;

package LEXI3700_PIXEL_OPERATIONS is

-- This package specifies all procedures that inquire into pixel
-- points on the device.

   procedure INQ_PIXEL_ARRAY_DIMENSIONS
      (WS_SL              : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       PIXEL_CORNER_1_1   : NDC.POINT;
       PIXEL_CORNER_DX_DY : NDC.POINT;
       DIMENSIONS         : out RASTER_UNIT_SIZE);

   procedure INQ_PIXEL_ARRAY
      (WS_SL              : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       PIXEL_ARRAY_CORNER : NDC.POINT;
       DX                 : RASTER_UNITS;
       DY                 : RASTER_UNITS;
       INVALID_VALUES     : out INVALID_VALUES_INDICATOR;
       PIXEL_ARRAY        : out ACCESS_PIXEL_COLOUR_MATRIX_TYPE);

   procedure INQ_PIXEL
      (WS_SL        : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       PIXEL_POINT  : NDC.POINT;
       PIXEL_COLOUR : out PIXEL_COLOUR_INDEX);

end LEXI3700_PIXEL_OPERATIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:LEXI_PIXEL_OPS_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_PIXEL_OPERATIONS - BODY
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: LEXI_PIXEL_OPS_B.ADA
-- LEVEL : 0A

with LEXI3700_OUTPUT_DRIVER;
with LEXI3700_TYPES;
with CONVERT_NDC_DC;
with LEXI_UTILITIES;

use  LEXI3700_TYPES;

package body LEXI3700_PIXEL_OPERATIONS is

   procedure INQ_PIXEL_ARRAY_DIMENSIONS
      (WS_SL              : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       PIXEL_CORNER_1_1   : NDC.POINT;
       PIXEL_CORNER_DX_DY : NDC.POINT;
       DIMENSIONS         : out RASTER_UNIT_SIZE)
      is separate;

   procedure INQ_PIXEL_ARRAY
      (WS_SL              : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       PIXEL_ARRAY_CORNER : NDC.POINT;
       DX                 : RASTER_UNITS;
       DY                 : RASTER_UNITS;
       INVALID_VALUES     : out INVALID_VALUES_INDICATOR;
       PIXEL_ARRAY        : out ACCESS_PIXEL_COLOUR_MATRIX_TYPE)
      is separate;

   procedure INQ_PIXEL
      (WS_SL        : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
       PIXEL_POINT  : NDC.POINT;
       PIXEL_COLOUR : out PIXEL_COLOUR_INDEX) is separate;

end LEXI3700_PIXEL_OPERATIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSD_INQ_PIXEL_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_PIXEL
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR035  Changes to INQ_PIXEL
------------------------------------------------------------------
-- FILE: WSD_INQ_PIXEL_0A.ADA
-- LEVEL: 0A

separate (LEXI3700_PIXEL_OPERATIONS)

procedure INQ_PIXEL
   (WS_SL        : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    PIXEL_POINT  : NDC.POINT;
    PIXEL_COLOUR : out PIXEL_COLOUR_INDEX) is

-- This procedure accepts one point and returns the colour index of the
-- point. If the pixel is not on the display surface, the value -1 is
-- returned.
--
-- WS_SL        - the pointer to the Workstation State List.
-- PIXEL_POINT  - the given point in NDC coordinates.
-- PIXEL_COLOUR - the given pixel's colour index.

   DC_DEVICE_POINT  : DC.POINT_ARRAY (1 .. 1);
   -- The PIXEL_POINT after it is translated into DC coordinates.

   IDC_DEVICE_POINT : LEXI_POINTS(1 .. 1);
   -- The DC_DEVICE_POINT after it is translated into IDC coordinates.

   PIXEL_COLOUR_ARRAY : LEXI_PIXEL_ARRAY_INDEX (1 .. 1);
   -- Holds the colour returned from the device driver.

   IS_ON_DISPLAY_SURFACE : LEXI_UTILITIES.STATUS_OF_POINTS;
   -- This variable is used to test if the point is on the display
   -- surface. It is set to either ALL_OUTSIDE or ALL_INSIDE.

   function "=" (LEFT, RIGHT : in LEXI_UTILITIES.STATUS_OF_POINTS)
      return BOOLEAN
      renames LEXI_UTILITIES."=";

begin

   -- Translate from NDC to DC.
   DC_DEVICE_POINT(1) := CONVERT_NDC_DC.DC_POINT
      (PIXEL_POINT, WS_SL.WS_TRANSFORM);

   -- Test if the point is on the screen before translating into IDC.
   LEXI_UTILITIES.CLIP_TO_SCREEN (DC_DEVICE_POINT, DC_DEVICE_POINT,
      IS_ON_DISPLAY_SURFACE);

   -- One point within the display surface means that it is valid to
   -- inquire the colour.
   if IS_ON_DISPLAY_SURFACE = LEXI_UTILITIES.ALL_INSIDE then

      -- Translate from DC to IDC.
      IDC_DEVICE_POINT :=
         LEXI_UTILITIES.IDC (DC_DEVICE_POINT);

      -- Call the device driver to obtain the colour of the point.
      LEXI3700_OUTPUT_DRIVER.RANDOM_PIXEL_READ
         (IDC_DEVICE_POINT, PIXEL_COLOUR_ARRAY);

      -- Put the colour into the output parameter.
      PIXEL_COLOUR := PIXEL_COLOUR_INDEX (PIXEL_COLOUR_ARRAY(1));

   else

      -- If the point is not on the screen, put a -1 into the output
      -- parameter.
      PIXEL_COLOUR := -1;

   end if;

end INQ_PIXEL;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSD_INQ_PIXEL_AR_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_PIXEL_ARRAY
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  DR035  Changes to INQ_PIXEL
------------------------------------------------------------------
-- FILE: WSD_INQ_PIXEL_AR_0A.ADA
-- LEVEL: 0A

separate (LEXI3700_PIXEL_OPERATIONS)

procedure INQ_PIXEL_ARRAY
   (WS_SL              : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    PIXEL_ARRAY_CORNER : NDC.POINT;
    DX                 : RASTER_UNITS;
    DY                 : RASTER_UNITS;
    INVALID_VALUES     : out INVALID_VALUES_INDICATOR;
    PIXEL_ARRAY        : out ACCESS_PIXEL_COLOUR_MATRIX_TYPE) is

-- This procedure receives a point which maps onto a pixel of the
-- display surface. A rectangle is defined which has the given point
-- as its upper left corner. DX is the width of the rectangle in pixels.
-- DY is the height of the rectangle in pixels.
--
-- The PIXEL_ARRAY returns the colour index associated with each pixel
-- in the rectangle. If a pixel is not on the device surface, the value
-- -1 is assigned to its position in the array and the flag INVALID_
-- VALUES is set to PRESENT.
--
-- This procedure processes through the PIXEL_ARRAY one scan line at a
-- time. If the scan line is above or below the display surface, it is
-- filled with -1's. Otherwise, the scan line is divided into three
-- areas (any of which could be null): the area to the left of the
-- display surface, the area on the display surface, and the area on the
-- right of the display surface. The right and left areas are filled
-- with -1's and the middle portion used when calling the device driver
-- to return the colour indices.
--
-- The case where all of the points are on the display surface is
-- treated as a special case because we believe it is the most
-- common case and because we wanted to eliminate the overhead of
-- handling the portions outside the display surface when they are all
-- null.
--
-- WS_SL              - a pointer to the Workstation State List.
--                      Used for converting from NDC to DC.
-- PIXEL_ARRAY_CORNER - the point at the upper left corner of the
--                      specified rectangle.
-- DX                 - the x dimension of the pixel array.
-- DY                 - the y dimension of the pixel array.
-- INVALID_VALUES     - a flag which indicates with 'PRESENT' or
--                      'ABSENT' if there are any negative ones in the
--                      PIXEL_ARRAY.
-- PIXEL_ARRAY        - returns the indices into the colour lookup
--                      table associated with each of the pixels in the
--                      rectangle.

   DC_CORNER_POINTS : DC.POINT_ARRAY (1 .. 4);
   -- The first value is PIXEL_ARRAY_CORNER and second value is the
   -- corner opposite PIXEL_ARRAY_CORNER. The other two corners of the
   -- rectangle are in the last two positions.

   CLIPPED_DC_CORNER_POINTS : DC.POINT_ARRAY (1 .. 4);
   -- Contains the value of DC_CORNER_POINTS after they have been
   -- clipped to the display surface.

   POINT_STATUS_FLAG : LEXI_UTILITIES.STATUS_OF_POINTS;
   -- Indicates how many corners of the rectangle are within the display
   -- surface.

   IDC_CORNER_POINTS : LEXI_POINTS (1 .. 2);
   -- Contains the value of the first two CLIPPED_DC_CORNER_POINTS after
   -- they have been transformed into the IDC coordinate system.

   TEMP_PIXEL_ARRAY : PIXEL_COLOUR_MATRICES.MATRIX_OF
      (1 .. POSITIVE(DX), 1 .. POSITIVE(DY));
   -- An array which holds the values which are returned in PIXEL_ARRAY.

   function "=" (FIRST, LAST : in LEXI_UTILITIES.STATUS_OF_POINTS)
      return BOOLEAN
      renames LEXI_UTILITIES."=";

begin

   -- Transform PIXEL_ARRAY_CORNER into DC_CORNER_POINTS(1).
   DC_CORNER_POINTS (1) := CONVERT_NDC_DC.DC_POINT
      (PIXEL_ARRAY_CORNER, WS_SL.WS_TRANSFORM);

   -- Put the opposite corner into DC_CORNER_POINTS(2).
   -- The X coordinate increases by DX - 1 because the rectangle goes
   -- to the right.
   DC_CORNER_POINTS(2).X :=
      DC_CORNER_POINTS(1).X + DC_TYPE(DX) - DC_TYPE(1);
   -- The Y coodinate decreases by DY - 1 because the rectangle goes
   -- down.
   DC_CORNER_POINTS(2).Y :=
      DC_CORNER_POINTS(1).Y - DC_TYPE(DY) + DC_TYPE(1);

   -- Put the other two corners of the rectangle into the third and
   -- fourth elements of DC_CORNER_POINTS.
   DC_CORNER_POINTS(3).X := DC_CORNER_POINTS(1).X;
   DC_CORNER_POINTS(3).Y := DC_CORNER_POINTS(2).Y;
   DC_CORNER_POINTS(4).X := DC_CORNER_POINTS(2).X;
   DC_CORNER_POINTS(4).Y := DC_CORNER_POINTS(1).Y;

   -- Clip the DC_CORNER_POINTS to the area of the display surface.
   LEXI_UTILITIES.CLIP_TO_SCREEN (DC_CORNER_POINTS,
      CLIPPED_DC_CORNER_POINTS, POINT_STATUS_FLAG);

   -- Transform the first two of the clipped points into IDC coordinate
   -- space.
   IDC_CORNER_POINTS :=
      LEXI_UTILITIES.IDC (CLIPPED_DC_CORNER_POINTS (1 .. 2));

   -- The case where all of the points are valid is treated as a special
   -- case. It is assumed that this case occurs more often and thus
   -- the code is optimized for it.
   if POINT_STATUS_FLAG = LEXI_UTILITIES.ALL_INSIDE then

      -- Set the flag to indicate that no points are off of the display
      -- surface.
      INVALID_VALUES := ABSENT;

      declare

         SCAN_LINE_POINT_VALUES : LEXI_POINTS (1 .. POSITIVE(DX));
         -- This variable holds the X and Y coordinates of the points
         -- in one scan line.

         SCAN_LINE_COLOUR_INDEX_VALUES :
            LEXI_PIXEL_ARRAY_INDEX (1 .. POSITIVE(DX));
         -- This variable holds the colour indices which are associated
         -- with each of those points.

         subtype X_RANGE is INTEGER range 0 .. INTEGER(DX);
         X_COUNTER : X_RANGE;
         -- X_COUNTER is used to index through the SCAN_LINE_POINT_
         -- VALUES. It corresponds to an index through the range of X
         -- indices in PIXEL_ARRAY.

         subtype Y_RANGE is INTEGER range 0 .. INTEGER(DY);
         Y_COUNTER : Y_RANGE;
         -- Y_COUNTER is used to index through the TEMP_PIXEL_ARRAY.

      begin

         -- Since the X values are the same for each scan line, they
         -- loaded into the scan line array first.
         X_COUNTER := 0;
         for X_VALUE in IDC_CORNER_POINTS(1).X .. IDC_CORNER_POINTS(2).X
            loop
               X_COUNTER := X_COUNTER + 1;
               SCAN_LINE_POINT_VALUES (X_COUNTER).X := X_VALUE;
         end loop;

         -- The index into the TEMP_PIXEL_ARRAY is initialized.
         Y_COUNTER := 0;

         -- This for loop processes on scan line at a time.
         for Y_VALUE in IDC_CORNER_POINTS(1).Y .. IDC_CORNER_POINTS(2).Y
            loop

               -- The Y index is incremented for the next scan line.
               Y_COUNTER := Y_COUNTER + 1;

               -- The Y_VALUE for the current scan line is loaded into
               -- the scan line array.
               for X_COUNTER in 1 .. POSITIVE(DX) loop
                  SCAN_LINE_POINT_VALUES(X_COUNTER).Y := Y_VALUE;
               end loop;

               -- The Lexi Driver is called to obtain the colour index
               -- values for the scan line.
               LEXI3700_OUTPUT_DRIVER.RANDOM_PIXEL_READ
                  (SCAN_LINE_POINT_VALUES,
                   SCAN_LINE_COLOUR_INDEX_VALUES);

               -- The colour index values are loaded into the temporary
               -- array.
               for X_COUNTER in 1 .. POSITIVE(DX) loop
                  TEMP_PIXEL_ARRAY (X_COUNTER, Y_COUNTER) :=
                     PIXEL_COLOUR_INDEX
                     (SCAN_LINE_COLOUR_INDEX_VALUES (X_COUNTER));
               end loop;
         end loop; -- Current scan line finished.
      end; -- Define block;

   --  The entire rectangle is off of the screen.
   elsif POINT_STATUS_FLAG = LEXI_UTILITIES.ALL_OUTSIDE then

      -- Set the flag to indicate that there are points off of the
      -- display surface.
      INVALID_VALUES := PRESENT;

      -- Fill the rectangle with all ones.
      for I in 1 .. POSITIVE(DX) loop
         for J in 1 .. POSITIVE(DY) loop
            TEMP_PIXEL_ARRAY (I,J) := -1;
         end loop;
      end loop;

   -- The rectangle is partially on the screen.
   else
      declare
         subtype Y_RANGE is INTEGER range 0 .. INTEGER(DY);
         subtype X_RANGE is INTEGER range 0 .. INTEGER(DX);
         FRONT_X : X_RANGE;
         -- FRONT_X is the number of pixels in the rectangle which are
         -- off the left edge of the screen.

         END_X : X_RANGE;
         -- END_X is the number of pixels from the left edge of the
         -- rectangle up to and including the rightmost pixel which is
         -- in the rectangle and on the screen.

         FRONT_Y : Y_RANGE;
         -- FRONT_Y is the number of pixels in the rectangle which are
         -- off the top edge of the screen.

         END_Y : Y_RANGE;
         -- END_Y is the number of pixels from the top of the rectangle
         -- up to and including the bottommost pixel which is in the
         -- rectangle and on the screen.

      begin

         -- Set the flag to indicate that there are points off of the
         -- display surface.
         INVALID_VALUES := PRESENT;

         -- When the first corner point is on the screen, FRONT_Y is
         -- zero. When the first corner has been clipped, FRONT_Y is
         -- the number of rows clipped off.
         FRONT_Y := Y_RANGE
            (DC_CORNER_POINTS(1).Y - CLIPPED_DC_CORNER_POINTS(1).Y);

         -- END_Y is the number of pixels from the first corner point to
         -- the clipped second point.
         END_Y := Y_RANGE
            (DC_CORNER_POINTS(1).Y - CLIPPED_DC_CORNER_POINTS(2).Y) + 1;

         -- When the first corner point is on the screen, FRONT_X is
         -- zero. When the first corner has been clipped, FRONT_X is
         -- the number of columns clipped off.
         FRONT_X := X_RANGE
            (CLIPPED_DC_CORNER_POINTS(1).X - DC_CORNER_POINTS(1).X);

         -- END_X is the number of pixels from the first corner point to
         -- the clipped second point.
         END_X := X_RANGE
            (CLIPPED_DC_CORNER_POINTS(2).X - DC_CORNER_POINTS(1).X) + 1;

         declare

            SCAN_LINE_POINT_VALUES : LEXI_POINTS
               (1 .. END_X - FRONT_X);
            -- Contains the X and Y coordinates in IDC of one row from
            -- the intersection of the rectangle and the screen.

            SCAN_LINE_COLOUR_INDEX_VALUES : LEXI_PIXEL_ARRAY_INDEX
               (1 .. END_X - FRONT_X);
            -- Contains the colour indices which correspond to the
            -- preceeding point values.

            X_COUNTER : LEXI_COORDINATE;
            -- Indexes across a scan line in IDC.

            Y_COUNTER : LEXI_COORDINATE;
            -- Indicates a scan line's position in IDC.

            SCAN_LINE_COUNTER : POSITIVE;
            -- Indexes into the SCAN_LINE_COLOUR_INDEX_VALUES beginning
            -- at position 1.

         begin

            -- Fill the rows above the screen with -1's.
            for J in 1 .. FRONT_Y loop
               for I in 1 .. POSITIVE(DX) loop
                  TEMP_PIXEL_ARRAY (I,J) := -1;
               end loop;
            end loop;

            -- Put the X value of the first point in the scan line into
            -- X_COUNTER.
            X_COUNTER := IDC_CORNER_POINTS(1).X;

            -- Fill in the X values of the points in the scan line. They
            -- are the same for each of the rows.

            for I in 1 .. END_X - FRONT_X loop
               SCAN_LINE_POINT_VALUES(I).X := X_COUNTER;
               exit when X_COUNTER = LEXI_COORDINATE'LAST;
               X_COUNTER := X_COUNTER + 1;
            end loop;

            -- Put the Y value of the first scan line into Y_COUNTER.
            Y_COUNTER := IDC_CORNER_POINTS(1).Y;
            -- Repeat for each of the scan lines on the screen.
            for J in FRONT_Y + 1 .. END_Y loop
               -- Put -1's in the portion of the row which is to the
               -- left of the screen.
               for I in 1 .. FRONT_X loop
                  TEMP_PIXEL_ARRAY (I,J) := -1;
               end loop;

               -- Fill the Y coordinates of the scan line with the Y
               -- value for this row.
               for I in 1 .. END_X - FRONT_X loop
                  SCAN_LINE_POINT_VALUES(I).Y := Y_COUNTER;
               end loop;

               -- Increment the Y value for the next row.
               Y_COUNTER := Y_COUNTER + 1;

               -- Call the Device Driver procedure for reading the
               -- colour of the given points.

               LEXI3700_OUTPUT_DRIVER.RANDOM_PIXEL_READ
                  (SCAN_LINE_POINT_VALUES,
                   SCAN_LINE_COLOUR_INDEX_VALUES);

               -- Move the colour values from the Device Driver's output
               -- (indices beginning at one) into the PIXEL_ARRAY
               -- (X indices beginning at FRONT_X + 1).
               SCAN_LINE_COUNTER := 1;
               for I in FRONT_X + 1 .. END_X loop
                  TEMP_PIXEL_ARRAY (I,J) := PIXEL_COLOUR_INDEX
                     (SCAN_LINE_COLOUR_INDEX_VALUES
                      (SCAN_LINE_COUNTER));
                  SCAN_LINE_COUNTER := SCAN_LINE_COUNTER + 1;
               end loop;

               -- Put -1's in the positions to the right of the display
               -- surface.
               for I in END_X + 1 .. POSITIVE(DX) loop
                  TEMP_PIXEL_ARRAY (I,J) := -1;
               end loop;

            end loop; -- for each scan line.

         end; -- declare block;

         -- Put -1's in the rows below the screen.
         for J in END_Y + 1 .. POSITIVE(DY) loop
            for I in 1 .. POSITIVE(DX) loop
               TEMP_PIXEL_ARRAY (I,J) := -1;
            end loop;
         end loop;

      end; -- declare block;
   end if;

   -- Load the temporary array into the output record along with its
   -- dimensions.

   PIXEL_ARRAY := new PIXEL_COLOUR_MATRICES.MATRIX_OF'(TEMP_PIXEL_ARRAY);

end INQ_PIXEL_ARRAY;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSD_INQ_PIXEL_DIM_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: INQ_PIXEL_ARRAY_DIMENSIONS
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- FILE: WSD_INQ_PIXEL_DIM_0A.ADA
-- LEVEL: 0A

separate (LEXI3700_PIXEL_OPERATIONS)

procedure INQ_PIXEL_ARRAY_DIMENSIONS
   (WS_SL              : WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR;
    PIXEL_CORNER_1_1   : NDC.POINT;
    PIXEL_CORNER_DX_DY : NDC.POINT;
    DIMENSIONS         : out RASTER_UNIT_SIZE) is

-- This procedure receives two points which define the corners of a
-- rectangle that is parallel to the coordinate axes. It returns the
-- number of pixels in the rectangle's height and the number of pixels
-- in the rectangle's width.
--
-- The rectangle is mapped from NDC to DC, and the difference between
-- the corner points is taken as the result. Since the range of DC is
-- unconstrained, no clipping is done.
--
-- WS_SL              - a pointer to the Workstation State List.
--                      Used to convert from NDC to DC.
-- PIXEL_CORNER_1_1   - contains an x and y position for one corner of
--                      the rectangle.
-- PIXEL_CORNER_DX_DY - contains the x and y position for the opposite
--                      corner of the rectangle.
-- DIMENSIONS         - returns the height and width of the rectangle
--                      measured in pixels.

   DC_DEVICE_POINTS : DC.POINT_ARRAY (1 .. 2);
   -- contains PIXEL_CORNER_1_1 and PIXEL_CORNER_DX_DY after they are
   -- transformed into DC coordinate space.

begin

  -- Translate both points from NDC to DC.
  DC_DEVICE_POINTS := CONVERT_NDC_DC.DC_POINT_ARRAY
     ((PIXEL_CORNER_1_1, PIXEL_CORNER_DX_DY),
      WS_SL.WS_TRANSFORM);

  -- Return the absolute value of the difference between the points.
  -- The value one is added because the edges of the rectangle are
  -- included in computing their dimensions.
  DIMENSIONS.X := RASTER_UNITS
     (abs (DC_DEVICE_POINTS(1).X - DC_DEVICE_POINTS(2).X) +
      DC_TYPE(1.0));
  DIMENSIONS.Y := RASTER_UNITS
     (abs (DC_DEVICE_POINTS(1).Y - DC_DEVICE_POINTS(2).Y) +
      DC_TYPE(1.0));

end INQ_PIXEL_ARRAY_DIMENSIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:WSR_INQ_WS_ST_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSR_INQ_WS_STATE_LIST_0A
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- File:  WSR_INQ_WS_ST_0A.ADA
-- Level: 0A, 1A, 2A

with GKS_TYPES;
with WS_STATE_LIST_TYPES;

package WSR_INQ_WS_STATE_LIST_0A is

-- Packages GKS_TYPES and WS_STATE_LIST_TYPES provide types and subtypes
-- for subprogram parameters.
-- This package allows inquiries into the workstation's states.

   procedure INQ_WS_DEFERRAL_AND_UPDATE_STATES
      (WS_STATE_LIST         : in out WS_STATE_LIST_TYPES .
                                     WS_STATE_LIST_PTR;
       DEFERRAL              :    out GKS_TYPES . DEFERRAL_MODE;
       REGENERATION_MODE     :    out GKS_TYPES . REGENERATION_MODE;
       DISPLAY_SURFACE_EMPTY :    out GKS_TYPES .
                                      DISPLAY_SURFACE_EMPTY;
       NEW_FRAME_NECESSARY   :    out GKS_TYPES . NEW_FRAME_NECESSARY);

   procedure INQ_WS_STATE
      (WS_STATE_LIST         : in out WS_STATE_LIST_TYPES .
                                     WS_STATE_LIST_PTR;
       STATE                 :    out GKS_TYPES . WS_STATE);

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

package body WSR_INQ_WS_STATE_LIST_0A is

   procedure INQ_WS_DEFERRAL_AND_UPDATE_STATES
      (WS_STATE_LIST         : in out WS_STATE_LIST_TYPES .
                                      WS_STATE_LIST_PTR;
       DEFERRAL              :    out GKS_TYPES . DEFERRAL_MODE;
       REGENERATION_MODE     :    out GKS_TYPES . REGENERATION_MODE;
       DISPLAY_SURFACE_EMPTY :    out GKS_TYPES .
                                      DISPLAY_SURFACE_EMPTY;
       NEW_FRAME_NECESSARY   :    out GKS_TYPES .
                                      NEW_FRAME_NECESSARY) is
   -- This procedure merely returns a group of components from the
   -- Workstation State List passed to it.  Since WS_STATE_LIST_TYPES .
   -- WS_STATE_LIST_PTR is an open data type, this procedure provides
   -- convenience, but no other functionality.
   --
   -- WS_STATE_LIST - A pointer to the workstation state list.
   -- DEFERRAL - Returns one of the four GKS deferral modes, which
   --            controls the possible delay of output functions.
   -- REGENERATION_MODE - Returns one of the two GKS regeneration
   --                     modes, which controls the suppression of
   --                     of implicit regeneration of the whole picture.
   -- DISPLAY_SURFACE_EMPTY - Indicates whether the display surface is
   --                         empty.
   -- NEW_FRAME_NECESSARY - Indicates whether a new frame action is
   --                       necessary at update.


   begin

      DEFERRAL              := WS_STATE_LIST . WS_DEFERRAL_MODE;
      REGENERATION_MODE     := WS_STATE_LIST . WS_IMPLICIT_REGEN_MODE;
      DISPLAY_SURFACE_EMPTY := WS_STATE_LIST . WS_DISPLAY_SURFACE;
      NEW_FRAME_NECESSARY   := WS_STATE_LIST . WS_NEW_FRAME_ACTION;

   end INQ_WS_DEFERRAL_AND_UPDATE_STATES;


   procedure INQ_WS_STATE
      (WS_STATE_LIST         : in out WS_STATE_LIST_TYPES .
                                     WS_STATE_LIST_PTR;
       STATE                 :    out GKS_TYPES . WS_STATE) is
   -- This procedure returns the state of the workstation, which
   -- is ACTIVE or INACTIVE.
   --
   -- WS_STATE_LIST - A pointer to the workstation state list.
   -- STATE - Indicates the state of the workstation.

   begin

      STATE := WS_STATE_LIST . WS_STATE;

   end INQ_WS_STATE;

end WSR_INQ_WS_STATE_LIST_0A;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--:UDD:GKSADACM:CODE:0A:LEXI3700_WSD_0A.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_WSD
--  IDENTIFIER: GDMXXX.1(1)
--  DISCREPANCY REPORTS:
--
------------------------------------------------------------------
-- file: LEXI3700_WSD_0A.ADA
-- level: 0a

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:0A:LEXI3700_WSD_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: LEXI3700_WSD - BODY
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  #019  06/14/85  "Change SET_PATTERN_SIZE to SET_PATTERN_VECTORS"
------------------------------------------------------------------
-- file: LEXI3700_WSD_0A_B.ADA
-- level: 0a

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;

-- Workstation Driver operations for level 0a
with LEXI3700_EXTENDED_OUTPUT_PRIMITIVES;
with LEXI3700_PIXEL_OPERATIONS;

-- Resource operations for level 0a
with WSR_SET_BUNDLE_INDICES;
with WSR_SET_PRIMITIVE_ATTRIBUTES_0A;
with WSR_SET_INDIVIDUAL_ATTRIBUTES_0A;
with WSR_INQ_WS_DESCRIPTION_TABLE_0A;
with WSR_INQ_WS_STATE_LIST_0A;

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);

         -- LEVEL 0a
         -- logical operation "extended_output_primitives"

         when CELL_ARRAY =>
            LEXI3700_EXTENDED_OUTPUT_PRIMITIVES.CELL_ARRAY
                  (WS_SL,
                   INSTR.CELL_ARRAY_CORNER_1_1,
                   INSTR.CELL_ARRAY_CORNER_DX_DY,
                   INSTR.CELL_ARRAY_CORNER_DX_1,
                   INSTR.CELL_COLOUR_MATRIX);

         -- Generalized Drawing Primitives
         when CIRCLE =>
            LEXI3700_EXTENDED_OUTPUT_PRIMITIVES.CIRCLE
                  (WS_SL,
                   INSTR.CIRCLE_CENTER,
                   INSTR.CIRCLE_PERIPHERAL_POINT);

         -- logical operation "set_bundle_indices"

         when SET_POLYLINE_INDEX =>
            WSR_SET_BUNDLE_INDICES.SET_POLYLINE_INDEX
                  (WS_SL,
                   INSTR.POLYLINE_INDEX_SET);
         when SET_POLYMARKER_INDEX =>
            WSR_SET_BUNDLE_INDICES.SET_POLYMARKER_INDEX
                  (WS_SL,
                   INSTR.POLYMARKER_INDEX_SET);
         when SET_TEXT_INDEX =>
            WSR_SET_BUNDLE_INDICES.SET_TEXT_INDEX
                  (WS_SL,
                   INSTR.TEXT_INDEX_SET);
         when SET_FILL_AREA_INDEX =>
            WSR_SET_BUNDLE_INDICES.SET_FILL_AREA_INDEX
                  (WS_SL,
                   INSTR.FILL_AREA_INDEX_SET);

         -- logical operation "set_primitive_attributes_0a"

         when SET_TEXT_PATH =>
            WSR_SET_PRIMITIVE_ATTRIBUTES_0A.SET_TEXT_PATH
                  (WS_SL,
                   INSTR.TEXT_PATH_SET);
         when SET_PATTERN_VECTORS =>                           -- DR019
            WSR_SET_PRIMITIVE_ATTRIBUTES_0A.SET_PATTERN_SIZE
                  (WS_SL,
                   INSTR.PATTERN_HEIGHT_VECTOR_SET,            -- DR019
                   INSTR.PATTERN_WIDTH_VECTOR_SET);            -- DR019
         when SET_PATTERN_REFERENCE_POINT =>
            WSR_SET_PRIMITIVE_ATTRIBUTES_0A.SET_PATTERN_REFERENCE_POINT
                  (WS_SL,
                   INSTR.PATTERN_REFERENCE_POINT_SET);

         -- logical operation "set_individual_attributes_0a"

         when SET_LINE_WIDTH_SCALE_FACTOR =>
            WSR_SET_INDIVIDUAL_ATTRIBUTES_0A.SET_LINE_WIDTH_SCALE_FACTOR
                  (WS_SL,
                   INSTR.LINE_WIDTH_SCALE_FACTOR_SET);
         when SET_MARKER_SIZE_SCALE_FACTOR =>
            WSR_SET_INDIVIDUAL_ATTRIBUTES_0A
                  .SET_MARKER_SIZE_SCALE_FACTOR
                  (WS_SL,
                   INSTR.MARKER_SIZE_SCALE_FACTOR_SET);
         when SET_TEXT_FONT_AND_PRECISION =>
            WSR_SET_INDIVIDUAL_ATTRIBUTES_0A.SET_TEXT_FONT_AND_PRECISION
                  (WS_SL,
                   LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.TEXT_FONT_AND_PRECISION_SET);
         when SET_CHAR_EXPANSION_FACTOR =>
            WSR_SET_INDIVIDUAL_ATTRIBUTES_0A.SET_CHAR_EXPANSION_FACTOR
                  (WS_SL,
                   INSTR.CHAR_EXPANSION_FACTOR_SET);
         when SET_CHAR_SPACING =>
            WSR_SET_INDIVIDUAL_ATTRIBUTES_0A.SET_CHAR_SPACING
                  (WS_SL,
                   INSTR.CHAR_SPACING_SET);
         when SET_FILL_AREA_STYLE_INDEX =>
            WSR_SET_INDIVIDUAL_ATTRIBUTES_0A.SET_FILL_AREA_STYLE_INDEX
                  (WS_SL,
                   INSTR.FILL_AREA_STYLE_INDEX_SET);
         when SET_ASF =>
            WSR_SET_INDIVIDUAL_ATTRIBUTES_0A.SET_ASF
                  (WS_SL,
                   INSTR.ASF_SET);

         -- logical operation "inq_ws_description_table_0a"

         when INQ_WS_CATEGORY =>
            WSR_INQ_WS_DESCRIPTION_TABLE_0A.INQ_WS_CATEGORY
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.WS_CATEGORY_INQ);
         when INQ_WS_CLASS =>
            WSR_INQ_WS_DESCRIPTION_TABLE_0A.INQ_WS_CLASS
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.WS_CLASS_INQ);
         when INQ_PREDEFINED_POLYLINE_REPRESENTATION =>
            WSR_INQ_WS_DESCRIPTION_TABLE_0A
                  .INQ_PREDEFINED_POLYLINE_REPRESENTATION
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.PRE_POLYLINE_INDEX_TO_INQ_PRE_POLYLINE_REP,
                   INSTR.PRE_POLYLINE_TYPE_INQ,
                   INSTR.PRE_POLYLINE_WIDTH_INQ,
                   INSTR.PRE_POLYLINE_COLOUR_INQ,
                   INSTR.EI);
         when INQ_PREDEFINED_POLYMARKER_REPRESENTATION =>
            WSR_INQ_WS_DESCRIPTION_TABLE_0A
                  .INQ_PREDEFINED_POLYMARKER_REPRESENTATION
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.PRE_POLYMARKER_INDEX_TO_INQ_PRE_POLYMARKER_REP,
                   INSTR.PRE_POLYMARKER_TYPE_INQ,
                   INSTR.PRE_POLYMARKER_SIZE_INQ,
                   INSTR.PRE_POLYMARKER_COLOUR_INQ,
                   INSTR.EI);
         when INQ_PREDEFINED_TEXT_REPRESENTATION =>
            WSR_INQ_WS_DESCRIPTION_TABLE_0A
                  .INQ_PREDEFINED_TEXT_REPRESENTATION
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.PRE_TEXT_INDEX_TO_INQ_PRE_TEXT_REP,
                   INSTR.PRE_TEXT_FONT_PRECISION_INQ,
                   INSTR.PRE_TEXT_CHAR_EXPANSION_INQ,
                   INSTR.PRE_TEXT_CHAR_SPACING_INQ,
                   INSTR.PRE_TEXT_COLOUR_INQ,
                   INSTR.EI);
         when INQ_PREDEFINED_FILL_AREA_REPRESENTATION =>
            WSR_INQ_WS_DESCRIPTION_TABLE_0A
                  .INQ_PREDEFINED_FILL_AREA_REPRESENTATION
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.PRE_FILL_AREA_INDEX_TO_INQ_PRE_FILL_AREA_REP,
                   INSTR.PRE_FILL_AREA_INTERIOR_INQ,
                   INSTR.PRE_FILL_AREA_STYLE_INQ,
                   INSTR.PRE_FILL_AREA_COLOUR_INQ,
                   INSTR.EI);
         when INQ_PATTERN_FACILITIES =>
            WSR_INQ_WS_DESCRIPTION_TABLE_0A.INQ_PATTERN_FACILITIES
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.NUMBER_OF_PATTERN_INDICES);
         when INQ_PREDEFINED_PATTERN_REPRESENTATION =>
            WSR_INQ_WS_DESCRIPTION_TABLE_0A
                  .INQ_PREDEFINED_PATTERN_REPRESENTATION
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.PRE_PATTERN_INDEX_TO_INQ_PRE_PATTERN_REP,
                   INSTR.PRE_PATTERN_REP_INQ,
                   INSTR.EI);
         when INQ_PREDEFINED_COLOUR_REPRESENTATION =>
            WSR_INQ_WS_DESCRIPTION_TABLE_0A
                  .INQ_PREDEFINED_COLOUR_REPRESENTATION
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.PRE_COLOUR_INDEX_TO_INQ_PRE_COLOUR_REP,
                   INSTR.PRE_COLOUR_REP_INQ,
                   INSTR.EI);
         when INQ_LIST_OF_AVAILABLE_GDP =>
            WSR_INQ_WS_DESCRIPTION_TABLE_0A.INQ_LIST_OF_AVAILABLE_GDP
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.LIST_OF_GDP_INQ);
         when INQ_GDP =>
            WSR_INQ_WS_DESCRIPTION_TABLE_0A.INQ_GDP
                  (LEXI3700_WS_TABLES.LEXI3700_WS_DT,
                   INSTR.GDP_TO_INQ_GDP,
                   INSTR.LIST_OF_ATTRIBUTES_USED_INQ,
                   INSTR.EI);

         -- logical operation "inq_ws_state_list_0a"

         when INQ_WS_STATE =>
            WSR_INQ_WS_STATE_LIST_0A.INQ_WS_STATE
                  (WS_SL,
                   INSTR.WS_STATE_INQ);
         when INQ_WS_DEFERRAL_AND_UPDATE_STATES =>
            WSR_INQ_WS_STATE_LIST_0A.INQ_WS_DEFERRAL_AND_UPDATE_STATES
                  (WS_SL,
                   INSTR.DEFERRAL_INQ,
                   INSTR.REGENERATION_INQ,
                   INSTR.DISPLAY_INQ,
                   INSTR.FRAME_ACTION_INQ);

         -- logical operation "pixels"

         when INQ_PIXEL_ARRAY_DIMENSIONS =>
            LEXI3700_PIXEL_OPERATIONS.INQ_PIXEL_ARRAY_DIMENSIONS
                  (WS_SL,
                   INSTR.PIXEL_ARRAY_CORNER_1_1_INQ,
                   INSTR.PIXEL_ARRAY_CORNER_DX_DY_INQ,
                   INSTR.DIMENSIONS_INQ);
         when INQ_PIXEL_ARRAY =>
            LEXI3700_PIXEL_OPERATIONS.INQ_PIXEL_ARRAY
                  (WS_SL,
                   INSTR.PIXEL_ARRAY_CORNER_INQ,
                   INSTR.DX_INQ,
                   INSTR.DY_INQ,
                   INSTR.INVALID_VALUES_INQ,
                   INSTR.PIXEL_ARRAY_INQ);
         when INQ_PIXEL =>
            LEXI3700_PIXEL_OPERATIONS.INQ_PIXEL
                  (WS_SL,
                   INSTR.PIXEL_POINT_INQ,
                   INSTR.PIXEL_COLOUR_INQ);

      end case;

   end LEXI3700_WSD;

end LEXI3700_WSD;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--: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:0A:WSM_0A_B.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
------------------------------------------------------------------
--
--  NAME: WSM - BODY
--  IDENTIFIER: GDMXXX.1(2)
--  DISCREPANCY REPORTS:
--  #019  06/14/85  "Change SET_PATTERN_SIZE to SET_PATTERN_VECTORS"
------------------------------------------------------------------
-- file:  wsm_0a_b.ada
-- level: 0a

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
                  (CGI_OPEN_WS_OPERATIONS.OPEN_DICTIONARY,
                   INSTR.WS_TO_OPEN,
                   INSTR.TYPE_OF_WS_OPEN);
            WS_COMMUNICATION.XMIT(INSTR,INSTR.WS_TO_OPEN);
            if  INSTR.EI = GKS_ERRORS.SUCCESSFUL then
               -- Add workstation id to list of open workstations
               WS_IDS.ADD_TO_LIST(INSTR.WS_TO_OPEN,
                     LIST_OF_OPEN_WS);
            else
               -- remove ws id entry from open dictionary
               CGI_OPEN_WS_OPERATIONS.OPEN_WS.PURGE
                     (CGI_OPEN_WS_OPERATIONS.OPEN_DICTIONARY,
                      INSTR.WS_TO_OPEN);
            end if;
         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);

         -- LEVEL 0a

         -- logical operation "inq_ws_description_table_0a"

         when INQ_WS_CATEGORY =>
            WS_COMMUNICATION.XMIT_TYPE(INSTR,
                  INSTR.WS_TO_INQ_CATEGORY);
         when INQ_WS_CLASS =>
            WS_COMMUNICATION.XMIT_TYPE(INSTR,
                  INSTR.WS_TO_INQ_CLASS);
         when INQ_PREDEFINED_POLYLINE_REPRESENTATION =>
            WS_COMMUNICATION.XMIT_TYPE(INSTR,
                  INSTR.WS_TO_INQ_PRE_POLYLINE_REP);
         when INQ_PREDEFINED_POLYMARKER_REPRESENTATION =>
            WS_COMMUNICATION.XMIT_TYPE(INSTR,
                  INSTR.WS_TO_INQ_PRE_POLYMARKER_REP);
         when INQ_PR