-- Copyright (c),  Digital Equipment Corporation, 1992, 1993, 1994.
-- Redistribution and use in source and binary forms are permitted
-- provided that the copyright notice as indicated in box below 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 the specific
-- prior written permission.
--
-- All other rights reserved.
--
-- THIS SOFTWARE IS PROVIDED ''AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
-- WARRANTIES, INCLUDING, WITHOUT LIMITATION, IMPLIED WARRANTIES OF
-- NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
-- Digital assumes no responsibility AT ALL for the use or reliability
-- of this software.
--
-- +------------------------------------------------------------------------+
-- | USE, DUPLICATION OR DISCLOSURE BY THE U.S. GOVERNMENT IS SUBJECT TO    |
-- | RESTRICTIONS AS SET FORTH IN SUBPARAGRAPH (c) (1) (ii) OF              |
-- | DFARS 252.227-7013, OR IN FAR 52.227-14 ALT. II, AS APPLICABLE.        |
-- |                                                                        |
-- +------------------------------------------------------------------------+
--
-- A great deal has been published concerning graphic bindings,
-- including, for example:
--
--                      Implementation of the Core Graphics System GKS
--                      in a Distributed Graphics Environment
--                      Proc. Int. Conf. Interactive Techniques in CAD,
--                      Bologna (1978), 249-254.
--
--                      Constructing User Interfaces based on Logical
--                      Input Devices.
--                      IEEE, Computers (Nov 82), 62-68.
--
--                      GKS in C.
--                      Proc. Eurographics '82,
--                      North-Holland (1982) 359-370.
--
--                      Computer Graphics Programming
--                      G. Enderle, K. Kansy, G. Pfaff
--                      Springer-Verlag
--                      Berlin, Heidelberg, New York
--                      1984
--

with SYSTEM;
with X_FOREIGN_BODIES;
package body X_LIB_SUPPORT is

    function CONSTANT_FUNCTION return T is
    begin
	return VALUE;
    end;

    package body DERIVED_QUARK_PKG is

	procedure CHECK(V : VECTOR_OF_QUARK_TYPE) is
	begin
	    for I in V'range loop
		if V(I) = NUL then
		    raise CONSTRAINT_ERROR;
		end if;
	    end loop;
	end;
	
	procedure CHECK(L : LIST_TYPE) is
	begin
	    for I in L'first..L'last-1 loop
		if L(I) = NUL then
		    raise CONSTRAINT_ERROR;
		end if;
	    end loop;
	    if L(L'last) /= NUL then raise CONSTRAINT_ERROR; end if;
	end;

	function "+"(V : VECTOR_OF_QUARK_TYPE) return LIST_TYPE is
	begin
	    CHECK(V);
	    return LIST_TYPE(V) & NUL;
	end;

	function "+"(L : LIST_TYPE) return VECTOR_OF_QUARK_TYPE is
	begin
	    CHECK(L);
	    return VECTOR_OF_QUARK_TYPE(L(L'first..L'last-1));
	end;

	function TO_LIST(A : ACCESS_LIST_TYPE) return LIST_TYPE is
	begin
	    if A = null then
		return (1..1=>NUL);
	    else
		for LAST in A'range loop
		    if A(LAST) = NUL then
			return A(A'first..LAST);
		    end if;
		end loop;
	    end if;
	end;

	function TO_VECTOR_OF_QUARK(A : ACCESS_LIST_TYPE) return VECTOR_OF_QUARK_TYPE is
	begin
	    if A = null then
		return (1..0=>NUL);
	    else
		return VECTOR_OF_QUARK_TYPE(A(1..LENGTH(A)));
	    end if;
	end;

	function LENGTH(L : LIST_TYPE)          return NATURAL is
	begin
	    CHECK(L);
	    return L'length - 1;
	end;

	function LENGTH(A : ACCESS_LIST_TYPE)   return NATURAL is
	begin
	    if A = null then
		return 0;
	    else
		for LAST in A'range loop
		    if A(LAST) = NUL then
			return LAST-1;
		    end if;
		end loop;
	    end if;
	end;

	function INDEX(L : LIST_TYPE ; N : POSITIVE) return QUARK_TYPE is
	begin
	    if N > LENGTH(L) then raise CONSTRAINT_ERROR; end if;
	    return L(N);
	end;

	function INDEX(A : ACCESS_LIST_TYPE; N : POSITIVE) return QUARK_TYPE is
	begin
	    if N > LENGTH(A) then raise CONSTRAINT_ERROR; end if;
	    return A(N);
	end;

    end;

end X_LIB_SUPPORT;