------------------------------------------------------------------
--
--  NAME: SET_PRIMITIVE_ATTRIBUTES_MA - BODY
--  DISCREPANCY REPORTS:
--  
------------------------------------------------------------------
-- file:  set_prim_attr_ma_b.ada
-- levels: all levels

with WSM;
with CGI_SUBTYPES_A;
with ERROR_HANDLING;
with GKS_OPERATING_STATE_LIST;
with GKS_ERRORS;
with GKS_STATE_LIST;
with TRANSFORMATION_MATH;
with SQUARE_ROOT;
with GKS_ERROR_STATE_LIST;

use WSM;
use CGI_SUBTYPES_A;
use GKS_OPERATING_STATE_LIST;
use GKS_ERRORS;
use GKS_ERROR_STATE_LIST;

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 ERROR_HANDLING is called.
--
-- If an error indicator 8 occurs, these procedures call the
-- ERROR_HANDLING procedure with the error indicator and
-- the name of the procedure.

   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
      --  Check the GKS_ERROR_STATE_LIST to see that the ERROR_STATE
      --  is not ON before continuing.
      if GKS_ERROR_STATE_LIST.ERROR_STATE = ON then
         return;
      end if;


      -- 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
         GKS_ERROR_STATE_LIST.ERROR_STATE := ON;
         ERROR_HANDLING (NOT_GKOP_WSOP_WSAC_SGOP,
                        "SET_CHAR_HEIGHT");        -- Error 8
         GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
      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 GKS_ERROR =>
            GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
            raise;
         when NUMERIC_ERROR | CONSTRAINT_ERROR =>
            begin
               GKS_ERROR_STATE_LIST.ERROR_STATE := ON;
               ERROR_HANDLING (ARITHMETIC, "SET_CHAR_HEIGHT"); -- Error 308
               GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
            exception
               when OTHERS =>
                  GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
                  raise;
            end;
         when OTHERS =>
            begin
               GKS_ERROR_STATE_LIST.ERROR_STATE := ON;
               ERROR_HANDLING (UNKNOWN, "SET_CHAR_HEIGHT");  -- Error 2501
               GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
            exception
               when OTHERS =>
                  GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
                  raise;
            end;

   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, the procedure
   -- ERROR_HANDLING is called.
   --
   -- 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
      --  Check the GKS_ERROR_STATE_LIST to see that the ERROR_STATE
      --  is not ON before continuing.
      if GKS_ERROR_STATE_LIST.ERROR_STATE = ON then
         return;
      end if;


      -- 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
         GKS_ERROR_STATE_LIST.ERROR_STATE := ON;
         ERROR_HANDLING (NOT_GKOP_WSOP_WSAC_SGOP,
                        "SET_CHAR_UP_VECTOR");        -- Error 8
         GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;

      elsif (CHAR_UP_VECTOR.X = 0.0) and
            (CHAR_UP_VECTOR.Y = 0.0) then
         GKS_ERROR_STATE_LIST.ERROR_STATE := ON;
         ERROR_HANDLING (CHAR_UP_VECTOR_IS_ZERO,
                        "SET_CHAR_UP_VECTOR");        -- Error 79
         GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;

      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 GKS_ERROR =>
            GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
            raise;
         when NUMERIC_ERROR | CONSTRAINT_ERROR =>
            begin
               GKS_ERROR_STATE_LIST.ERROR_STATE := ON;
               ERROR_HANDLING(ARITHMETIC,"SET_CHAR_UP_VECTOR"); -- Error 308
               GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
            exception
               when OTHERS =>
                  GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
                  raise;
            end;
         when OTHERS =>
            begin
               GKS_ERROR_STATE_LIST.ERROR_STATE := ON;
               ERROR_HANDLING(UNKNOWN, "SET_CHAR_UP_VECTOR");  -- Error 2501
               GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
            exception
               when OTHERS =>
                  GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
                  raise;
            end;

   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
      --  Check the GKS_ERROR_STATE_LIST to see that the ERROR_STATE
      --  is not ON before continuing.
      if GKS_ERROR_STATE_LIST.ERROR_STATE = ON then
         return;
      end if;


      -- 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
         GKS_ERROR_STATE_LIST.ERROR_STATE := ON;
         ERROR_HANDLING (NOT_GKOP_WSOP_WSAC_SGOP,
                        "SET_TEXT_ALIGNMENT");      -- Error 8
         GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
      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 GKS_ERROR =>
            GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
            raise;
         when OTHERS =>
            begin
               GKS_ERROR_STATE_LIST.ERROR_STATE := ON;
               ERROR_HANDLING (UNKNOWN, "SET_TEXT_ALIGNMENT"); -- Error 2501
               GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
            exception
               when OTHERS =>
                  GKS_ERROR_STATE_LIST.ERROR_STATE := OFF;
                  raise;
            end;

   end SET_TEXT_ALIGNMENT;

end SET_PRIMITIVE_ATTRIBUTES_MA ;