--***********************************************************************
--									*
--									*
--   This software was written by Bevin Brett, of Digital Equipment	*
--   Corporation.							*
--									*
--   Digital assumes no responsibility AT ALL for the use or reliability*
--   of this software.							*
--									*
--   Redistribution and use in source and binary forms are permitted	*
--   provided that the above copyright notice and this paragraph are	*
--   duplicated in all such forms and that any documentation,		*
--   advertising materials, and other materials related to such		*
--   distribution and use acknowledge that the software was developed	*
--   by Digital Equipment Corporation. The name of Digital Equipment	*
--   Corporation may not be used to endorse or promote products derived	*
--   from this software without specific prior written permission.	*
--									*
--   THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR	*
--   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED	*
--   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.*
--									*
--***********************************************************************

-- modified for use with Adabindx 10.8.1997
-- Hans-Frieder Vogt (vogt@ilaws6.luftfahrt.uni-stuttgart.de)

with Ada.Numerics.Generic_Elementary_Functions;
package body DIGITS_VECTOR is

    package SOME_FLOAT_MATH_LIB is
       new Ada.Numerics.Generic_Elementary_Functions (SOME_FLOAT);

    function "+"(RIGHT : VECTOR) return VECTOR is
    begin
	return RIGHT;
    end;

    function "-"(RIGHT : VECTOR) return VECTOR is
    begin
	return (-RIGHT.I, -RIGHT.J, -RIGHT.K);
    end;

    function "+"(LEFT,RIGHT : VECTOR) return VECTOR is
    begin
	return (LEFT.I+RIGHT.I, LEFT.J+RIGHT.J, LEFT.K+RIGHT.K);
    end;

    function "-"(LEFT,RIGHT : VECTOR) return VECTOR is
    begin
	return (LEFT.I-RIGHT.I, LEFT.J-RIGHT.J, LEFT.K-RIGHT.K);
    end;

    function "*"(LEFT,RIGHT : VECTOR) return VECTOR is	    -- cross product
	A1 : constant SOME_FLOAT := LEFT.I;
	A2 : constant SOME_FLOAT := LEFT.J;
	A3 : constant SOME_FLOAT := LEFT.K;
	B1 : constant SOME_FLOAT := RIGHT.I;
	B2 : constant SOME_FLOAT := RIGHT.J;
	B3 : constant SOME_FLOAT := RIGHT.K;
    begin
	return (SOME_FLOAT(A2*B3)-SOME_FLOAT(A3*B2),
		SOME_FLOAT(A3*B1)-SOME_FLOAT(A1*B3),
		SOME_FLOAT(A1*B2)-SOME_FLOAT(A2*B1));
    end;

    function "&"(LEFT,RIGHT : VECTOR) return SOME_FLOAT is  -- dot product
    begin
	return SOME_FLOAT(LEFT.I*RIGHT.I)
	     + SOME_FLOAT(LEFT.J*RIGHT.J)
	     + SOME_FLOAT(LEFT.K*RIGHT.K);
    end;

    function "*"(LEFT : VECTOR;     RIGHT : INTEGER)	return VECTOR is
	R : constant SCALE_TYPE := SCALE_TYPE(RIGHT);
    begin
	return (LEFT.I*R, LEFT.J*R, LEFT.K*R);
    end;

    function "*"(LEFT : INTEGER;    RIGHT : VECTOR)	return VECTOR is
	L : constant SCALE_TYPE := SCALE_TYPE(LEFT);
    begin
	return (RIGHT.I*L, RIGHT.J*L, RIGHT.K*L);
    end;

    function "*"(LEFT : VECTOR;     RIGHT : SCALE_TYPE) return VECTOR is
    begin
	return (LEFT.I*RIGHT, LEFT.J*RIGHT, LEFT.K*RIGHT);
    end;

    function "*"(LEFT : SCALE_TYPE; RIGHT : VECTOR)	return VECTOR is
    begin
	return (RIGHT.I*LEFT, RIGHT.J*LEFT, RIGHT.K*LEFT);
    end;

    function "/"(LEFT : VECTOR;     RIGHT : SCALE_TYPE)	return VECTOR is
	IR : constant SCALE_TYPE := 1.0/RIGHT;
    begin
	return (LEFT.I*IR, LEFT.J*IR, LEFT.K*IR);
    end;

    function LENGTH(RIGHT : VECTOR) return SOME_FLOAT is
    begin
	return SOME_FLOAT_MATH_LIB.SQRT(RIGHT.I**2+RIGHT.J**2+RIGHT.K**2);
    end;

    function TO_UNIT_VECTOR(RIGHT : VECTOR) return VECTOR is
	L : constant SCALE_TYPE := 1.0/SCALE_TYPE(LENGTH(RIGHT));
    begin
	return (RIGHT.I*L, RIGHT.J*L, RIGHT.K*L);
    end;

    procedure ADD	(LEFT : VECTOR;     RIGHT : in VECTOR;
	NON_OVERLAPPING_RESULT : out VECTOR) is
    begin
	NON_OVERLAPPING_RESULT.I := RIGHT.I + LEFT.I;
	NON_OVERLAPPING_RESULT.J := RIGHT.J + LEFT.J;
	NON_OVERLAPPING_RESULT.K := RIGHT.K + LEFT.K;
    end;

    procedure ADD	(LEFT : VECTOR;     RIGHT : in out VECTOR) is
    begin
	RIGHT.I := RIGHT.I + LEFT.I;
	RIGHT.J := RIGHT.J + LEFT.J;
	RIGHT.K := RIGHT.K + LEFT.K;
    end;

    procedure SUBTRACT	(LEFT : VECTOR;     RIGHT : in out VECTOR) is
    begin
	RIGHT.I := RIGHT.I - LEFT.I;
	RIGHT.J := RIGHT.J - LEFT.J;
	RIGHT.K := RIGHT.K - LEFT.K;
    end;

    procedure MULTIPLY	(LEFT : INTEGER;    RIGHT : in out VECTOR) is
	L : constant SCALE_TYPE := SCALE_TYPE(LEFT);
    begin
	RIGHT.I := RIGHT.I * L;
	RIGHT.J := RIGHT.J * L;
	RIGHT.K := RIGHT.K * L;
    end;

    procedure MULTIPLY	(LEFT : SCALE_TYPE; RIGHT : in out VECTOR) is
    begin
	RIGHT.I := RIGHT.I * LEFT;
	RIGHT.J := RIGHT.J * LEFT;
	RIGHT.K := RIGHT.K * LEFT;
    end;

    procedure DIVIDE	(LEFT : SCALE_TYPE;    RIGHT : in out VECTOR) is
	IL : constant SCALE_TYPE := 1.0/LEFT;
    begin
	RIGHT.I := RIGHT.I * IL;
	RIGHT.J := RIGHT.J * IL;
	RIGHT.K := RIGHT.K * IL;
    end;

    procedure CROSS	(LEFT : VECTOR;     RIGHT : in out VECTOR) is
	A1 : constant SOME_FLOAT := LEFT.I;
	A2 : constant SOME_FLOAT := LEFT.J;
	A3 : constant SOME_FLOAT := LEFT.K;
	B1 : constant SOME_FLOAT := RIGHT.I;
	B2 : constant SOME_FLOAT := RIGHT.J;
	B3 : constant SOME_FLOAT := RIGHT.K;
    begin
	RIGHT.I := SOME_FLOAT(A2*B3)-SOME_FLOAT(A3*B2);
	RIGHT.J := SOME_FLOAT(A3*B1)-SOME_FLOAT(A1*B3);
	RIGHT.K := SOME_FLOAT(A1*B2)-SOME_FLOAT(A2*B1);
    end;

    procedure MAKE_UNIT_VECTOR(LEFT : VECTOR; RIGHT : out VECTOR) is
	L : constant SOME_FLOAT := LENGTH(LEFT);
    begin
	RIGHT.I := SOME_FLOAT(LEFT.I/L);
	RIGHT.J := SOME_FLOAT(LEFT.J/L);
	RIGHT.K := SOME_FLOAT(LEFT.K/L);
    end;

    procedure MAKE_UNIT_VECTOR(RIGHT : in out VECTOR) is
    begin
	MULTIPLY(1.0/SCALE_TYPE(LENGTH(RIGHT)),RIGHT);
    end;

    procedure PROJECT	(ORIGIN 	: VECTOR;
			 I,J,K		: UNIT_VECTOR;
			 FROM		: VECTOR;
			 PROJECTION_I,
			 PROJECTION_J,
			 PROJECTION_K	: out SOME_FLOAT) is
	V : constant VECTOR := FROM-ORIGIN;
    begin
	PROJECTION_I := V&I;
	PROJECTION_J := V&J;
	PROJECTION_K := V&K;
    end;

    procedure PROJECT_SAME_ORIGIN(
			 I,J,K		: UNIT_VECTOR;
			 FROM		: VECTOR;
			 PROJECTION_I,
			 PROJECTION_J,
			 PROJECTION_K	: out SOME_FLOAT) is
    begin
	PROJECTION_I := FROM&I;
	PROJECTION_J := FROM&J;
	PROJECTION_K := FROM&K;
    end;

end;