------------------------------------------------------------------------------- -- -- -- Ada Interface to the X Window System and Motif(tm)/Lesstif -- -- Copyright (c) 1996-2000 Hans-Frieder Vogt -- -- -- -- This program is free software; you can redistribute it and/or modify -- -- it under the terms of the GNU General Public License as published by -- -- the Free Software Foundation; either version 2 of the License, or -- -- (at your option) any later version. -- -- -- -- This program is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- See the GNU General Public License for more details. -- -- -- -- You should have received a copy of the GNU General Public License -- -- along with this program; if not, write to the -- -- Free Software Foundation, Inc., -- -- 59 Temple Place - Suite 330, -- -- Boston, MA 02111-1307, USA. -- -- -- -- -- -- X Window System is copyrighted by the X Consortium -- -- Motif(tm) is copyrighted by the Open Software Foundation, Inc. -- -- -- -- -- ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- -- -- HISTORY: -- adapted 25.1.98 to adabindx 0.5 -- 3 Mar 2002 H.-F. Vogt: replace System.Unsigned_Types by Interfaces.C-- types -- ------------------------------------------------------------------------------- with -- X_Lib.Tasking, X_Lib.Property, Text_Io, Unchecked_Conversion, Interfaces.C.Pointers, X_Strings, Bubble_Sort; use X_Lib, Text_Io, Interfaces.C; procedure Display_Info is Display : Display_Pointer; Screen : Screen_Pointer; Window : Window_ID; Vinfo : X_Visual_Info; Num_Screens : Screen_Number; Def_Screen : Screen_Number; -- Conversion routines function XID_To_Int is new Unchecked_Conversion (Visual_ID, unsigned_long); function XID_To_Int is new Unchecked_Conversion (Colormap_ID, unsigned_long); -- output routines package Int_Io is new Text_Io.Integer_Io (Integer); package Uns_Io is new Text_Io.Modular_Io (unsigned_long); use Int_Io, Uns_Io; -- sort routine procedure Atom_Sort is new Bubble_Sort (Natural, Atom, Atom_Array); procedure Print_Info (Visual : in X_Visual_Info) is begin Put (" visualID: "); Put (Xid_To_Int (Visual.VisualID), Base => 16, Width => 8); New_Line; Put (" class: "); Put_Line (Visual_Class'Image (Visual.Class)); Put (" depth: "); Put (Integer (Visual.Depth), Width => 2); New_Line; Put (" colormap entries: "); Put (Integer (Visual.Colormap_Size), Width => 4); New_Line; Put (" red, green, blue masks: "); Put (unsigned_long (Visual.Red_Mask), Base => 16, Width => 8); Put (" "); Put (unsigned_long (Visual.Green_Mask), Base => 16, Width => 8); Put (" "); Put (unsigned_long (Visual.Blue_Mask), Base => 16, Width => 8); New_Line; Put (" significant bits per rgb: "); Put (unsigned_long (Visual.Bits_Per_RGB), Width => 2); New_Line; end Print_Info; begin -- X_Lib.Tasking.Resource.Seize; Display := X_Open_Display; Put_Line ("----- D I S P L A Y I N F O for Display " & X_Display_String (Display) & " -----"); Put ("X Protocol Version: "); Put (X_Protocol_Version (Display), Width => 2); Put (" Revision: "); Put (X_Protocol_Revision (Display), Width => 2); New_Line; Put_Line ("Vendor: " & X_Server_Vendor (Display)); Put ("Release: "); Put (X_Vendor_Release (Display)); New_Line; New_Line; Flush; Put_Line ("Supported Pixmap Formats:"); declare Formats : constant X_Pixmap_Format_Values_Array := X_List_Pixmap_Formats (Display); begin for Num in Formats'Range loop Put (Num); Put (" Depth: "); Put (Natural (Formats (Num).Depth), Width => 2); Put (", BPP: "); Put (unsigned_long (Formats (Num).Bits_Per_Pixel), Width => 2); Put (", Pad: "); Put (unsigned_long (Formats (Num).Scanline_Pad), Width => 2); New_Line; end loop; end; Flush; Num_Screens := X_Screen_Count (Display); Put_Line ("Number of Screens: " & Screen_Number'Image (Num_Screens)); Flush; Def_Screen := X_Default_Screen (Display); for Scr in 0 .. Num_Screens-1 loop Put (" Screen " & Screen_Number'Image (Scr)); if Scr = Def_Screen then Put (" (default screen)"); end if; Put_Line (":"); Put_Line (" Size: " & Integer'Image (X_Display_Width (Display, Scr)) & "x" & Integer'Image (X_Display_Height (Display, Scr)) & " (" & Integer'Image (X_Display_Width_MM (Display, Scr)) & "mm x " & Integer'Image (X_Display_Height_MM (Display, Scr)) & "mm)"); Put_Line (" Screen Cells: " & Integer'Image (X_Display_Cells (Display, Scr))); Put_Line (" Screen Planes: " & Integer'Image (X_Display_Planes (Display, Scr))); Screen := X_Screen_Of_Display (Display, Scr); Put_Line (" Backing Store : " & Backing_Store'Image (X_Does_Backing_Store (Screen))); if X_Does_Save_Unders (Screen) then Put_Line (" Does Save Unders"); else Put_Line (" Does NOT Save Unders"); end if; Window := X_Root_Window (Display, Scr); declare Depth_Arry : constant Color_Depth_Array := X_List_Depths (Display, Scr); begin Put_Line (" Number of Depths for this Screen: " & Integer'Image (Depth_Arry'Length)); Put (" "); for I in Depth_Arry'Range loop Put (Integer (Depth_Arry (I)), Width => 2); Put (" "); end loop; New_Line; end; Flush; Vinfo.Screen := Scr; Flush; declare Mask : X_Visual_Info_Mask := (Screen => True, others => False); Vinfo_F : constant X_Visual_Info_Array := X_Get_Visual_Info (Display, Mask, Vinfo); begin Put (" Number of Visuals for this Screen: "); Put (Long_Integer'Image (Long_Integer (Vinfo_F'Length))); New_Line; for Num in Vinfo_F'Range loop Put_Line (" Visual " & Integer'Image (Num) & ":"); Print_Info (Vinfo_F (Num)); end loop; end; Flush; Put_Line (" Colormaps:"); declare Maps : constant Colormap_ID_Array := X_List_Installed_Colormaps (Display, Window); begin for Num in Maps'Range loop Put (Num); Put (": "); Put (Xid_To_Int (Maps (Num)), Base => 16, Width => 8); New_Line; end loop; end; Flush; Put_Line (" Atoms:"); declare Atoms : Atom_Array := X_List_Properties (Display, Window); begin Atom_Sort (Atoms); for Num in Atoms'Range loop Int_Io.Put (Num); Put (": "); Put (X_Lib.Property.X_Get_Atom_Name (Display, Atoms (Num)) & " ("); Put (Integer (Atoms (Num)), Width => 0); Put (")"); New_Line; end loop; end; Flush; end loop; end Display_Info;