--***********************************************************************
--									*
--									*
--   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 TEXT_IO; use TEXT_IO;

separate(GRAPHICS_WINDOW_MANAGER)
    procedure CREATE_THE_WINDOW is
    begin
	-- Specify all the non-default attributes for the window
	--
	Window_Masks :=
	    (Ev_Mask | Back_Pixel | Colormap => True,
	     others => False);

	SWA.Ev_Mask :=
	    (--KEY_PRESS|KEY_RELEASE|
	     --BUTTON_PRESS|BUTTON_RELEASE|
	     --POINTER_MOTION|EXPOSURE => TRUE,
             Key_Press => True,
	     others => False);

	SWA.Background_Pixel := X_White_Pixel_Of_Screen (SCREEN);
	SWA.Colormap         := COLORMAP;

	--  Choose the size of the window as a large square
	declare
	    W : INTEGER := INTEGER(WIDTH);
	    H : INTEGER := INTEGER(HEIGHT);
	    M : INTEGER := (W*BOOLEAN'pos(W<H) + H*BOOLEAN'pos(W>=H))/2;
	begin
	    GW.Width    := Dimension (M);
	    GW.Height   := Dimension (M);
	end;

	-- Show what was chosen
	if DEBUGGING then
	    PUT_LINE("GW.WIDTH =>" & INTEGER'image(INTEGER(GW.WIDTH )));
	    PUT_LINE("GW.HEIGHT=>" & INTEGER'image(INTEGER(GW.HEIGHT)));
	end if;

	-- Create the window
	GW.WINDOW := X_Create_Window
                       (Display, X_Root_Window_Of_Screen (SCREEN),
                        0, 0, GW.Width, GW.Height, 0, Depth, Input_Output,
                        Visual, Window_Masks, SWA);

	GW.PIXMAP := X_Create_Pixmap
                       (Display, GW.Window, GW.Width, GW.Height, Depth);
		
	-- Create graphics contexts
	--
	declare
	    function GET_COLORMAP_INDEX(
		COLOR_NAME : STRING) return Pixel is

		SCREEN_DEF  : X_Color;
		EXACT_DEF   : X_Color;
		ALT	    : STRING(1..80);
		LAST	    : NATURAL;
	    begin
		X_Alloc_Named_Color (DISPLAY, COLORMAP, COLOR_NAME,
		    SCREEN_DEF, EXACT_DEF);
		return SCREEN_DEF.Pix;
	    exception
		when X_Color_Error =>
		    PUT_LINE("No " & COLOR_NAME & " available, substitute: ");
		    GET_LINE(ALT, LAST);
		    return GET_COLORMAP_INDEX(ALT(1..LAST));
	    end;

	    procedure CREATE_GC(
		COLOR	: COLORS.COLOR;
		NAME	: STRING) is
		GC_VALUES : X_GC_Values;
	    begin
		GC_VALUES.GX_Function	:= GX_COPY;
		GC_VALUES.FOREGROUND	:= GET_COLORMAP_INDEX(NAME);
		GC_VALUES.BACKGROUND	:= X_Black_Pixel_Of_Screen (SCREEN);

		if DEBUGGING then
		    PUT_LINE(NAME & " => CREATE_GC(");
		    PUT("  PLANE_MASK => (" &
                        Integer'Image (Integer (GC_VALUES.PLANE_MASK)) &
                        ")");
		    PUT_LINE("  FOREGROUND =>" &
		        Pixel'image(GC_VALUES.FOREGROUND));
		    PUT_LINE(")");
		end if;

		GW.GCs(COLOR) := X_Create_GC (Display => Display,
                                              Drawable => GW.WINDOW,
			                      Valuemask => (GC_Function |
                                                            GC_Foreground |
                                                            GC_Background => True,
					    others=>FALSE),
			VALUES		=> GC_VALUES);
	    end;
	begin
	    CREATE_GC(Color_1, "red");
	    CREATE_GC(Color_2, "navy blue");
	    CREATE_GC(Color_3, "yellow");
	    CREATE_GC(Color_4, "green");
	    CREATE_GC(Color_5, "blue");
	    CREATE_GC(Color_6, "grey");
	    CREATE_GC(Color_Interior, "black");
	    CREATE_GC(Color_Background, "white");
	end;

	ERASE;

   end;