------------------------------------------------------------------------------- -- -- -- 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: -- June 20, 1998 begin of history -- 3 Mar 2002 H.-F. Vogt: replace System.Unsigned_Types by Interfaces.C-- types -- ------------------------------------------------------------------------------- with Text_IO, String_List, X_Command_Line, X_Strings, X_Lib.Tasking, X_Toolkit.Shell, Xpm_Lib, Ada.Unchecked_Conversion, Interfaces.C.Strings; use Text_IO, String_List, X_Lib, X_Toolkit, Xpm_Lib, Interfaces.C.Strings; procedure Xpminfo is Version : constant String := "1.1"; Data : String_List.Element_Access_List; Appshell : Widget; App_Con : Xt_App_Context; Display : X_Lib.Display_Pointer; Screen : X_Lib.Screen_Pointer; Root_Win : X_Lib.Drawable_ID; Pix : X_Lib.Pixmap_ID; Mask : X_Lib.Pixmap_ID; Attr : Xpm_Attributes; function To_Unsigned is new Ada.Unchecked_Conversion (X_Lib.XID, Interfaces.C.unsigned); function To_Unsigned is new Ada.Unchecked_Conversion (X_Lib.Display_Pointer, Interfaces.C.unsigned); function To_Unsigned is new Ada.Unchecked_Conversion (X_Lib.Screen_Pointer, Interfaces.C.unsigned); type Unsigned_Mask is mod 2**17; --Xpm_Attr_Valuemask'Size; function To_Unsigned is new Ada.Unchecked_Conversion (Xpm_Attr_Valuemask, Unsigned_Mask); package Int_Io is new Text_Io.Integer_Io (Integer); use Int_Io; package Mod_Io is new Text_Io.Modular_Io (Interfaces.C.unsigned); package Dimension_Io is new Text_Io.Modular_Io (X_Lib.Dimension); use Dimension_Io; procedure Print_Color (Col : in Xpm_Color) is use X_Strings; begin if Col.Str /= Null_X_String then Text_Io.Put (" String: '" & To_String (Col.Str) & "'"); end if; if Col.Symbolic /= Null_X_String then Text_Io.Put (" Symbolic: " & To_String (Col.Symbolic)); end if; if Col.M_Color /= Null_X_String then Text_Io.Put (" Mono: " & To_String (Col.M_Color)); end if; if Col.G4_Color /= Null_X_String then Text_Io.Put (" Grey4: " & To_String (Col.G4_Color)); end if; if Col.G_Color /= Null_X_String then Text_Io.Put (" Grey: " & To_String (Col.G_Color)); end if; if Col.C_Color /= Null_X_String then Text_Io.Put (" Color: " & To_String (Col.C_Color)); end if; Text_Io.New_Line; Text_Io.Flush; end Print_Color; procedure Print_Info is begin Set_Output (Standard_Error); New_Line; Put_Line ("Xpminfo V." & Version & " -- (c)1996,1997 Hans-Frieder Vogt"); Put_Line ("informs about XPM pixmap file internals"); New_Line; Set_Output (Standard_Output); end Print_Info; procedure Print_Usage is begin Set_Output (Standard_Error); New_Line; Put_Line (" Usage:"); Put_Line (" Xpminfo Xpm-File"); New_Line; Set_Output (Standard_Output); end Print_Usage; begin Print_Info; X_Lib.Tasking.Resource.Seize; Xt_App_Initialize (Appshell, App_Con, "XpmInfo"); if X_Command_Line.Argument_Count < 1 then Put_Line (Standard_Error, "Xpminfo: ERROR: not enough parameters"); Print_Usage; return; else begin Xpm_Lib.Xpm_Read_File_To_Data (X_Command_Line.Argument (1), Data); exception when Xpm_Lib.Xpm_Error_Open_Failed => Put_Line (Standard_Error, "Xpminfo: ERROR: Couldn't open file <" & X_Command_Line.Argument (1) & ">"); return; when Xpm_Lib.Xpm_Error_File_Invalid => Put_Line (Standard_Error, "Xpminfo: ERROR: Are you sure the file <" & X_Command_Line.Argument (1) & "> is a xpm file?"); return; when Xpm_Lib.Xpm_Error_No_Memory => Put_Line (Standard_Error, "Xpminfo: ERROR: Not enough memory"); return; when others => raise; end; end if; Display := Xt_Display (Appshell); Screen := Xt_Screen (Appshell); Root_Win := X_Root_Window_Of_Screen (Screen); Attr.Depth := 0; Attr.X_Hotspot := 0; Attr.Y_Hotspot := 0; Attr.Cpp := 0; Attr.Value_Mask := (Color_Table => True, others => False); -- for debugging purposes Put ("Valuemask: "); Mod_Io.Put (Interfaces.C.Unsigned (To_Unsigned (Attr.Value_Mask)), Base => 2); New_Line; Flush; Xpm_Create_Pixmap_From_Data (Display, Root_Win, Data, Pix, Mask, Attr); Put ("Valuemask: "); Mod_Io.Put (Interfaces.C.Unsigned (To_Unsigned (Attr.Value_Mask)), Base => 2); New_Line; Flush; -- now output details of pixmap Put ("Size: "); Put (Attr.Width, Width => 0); Put (" x "); Put (Attr.Height, Width => 0); New_Line; Flush; if Attr.Value_Mask.Hotspot then Put ("Hotspot: "); Mod_Io.Put (Interfaces.C.Unsigned (Attr.X_Hotspot)); Put (", "); Mod_Io.Put (Interfaces.C.Unsigned (Attr.Y_Hotspot)); New_Line; else Put_Line ("No Hotspot!"); end if; Flush; if Attr.Value_Mask.Chars_Per_Pixel then Put ("Characters Per Pixel: "); Put (Attr.Cpp, Width => 0); New_Line; else Put_Line ("No Information on Characters Per Pixel!"); end if; Flush; if Attr.Color_Table /= null then Put_Line ("Color Table: " & Integer'Image (Integer (Attr.Color_Table'First)) & ".." & Integer'Image (Integer (Attr.Color_Table'Last))); Flush; for I in Attr.Color_Table'Range loop Put ("No. "); Put (I, Width => 3); Put (": "); Print_Color (Attr.Color_Table (I)); end loop; else Put_Line ("No Color Table Although Ordered!"); end if; New_Line; Put_Line ("Pixmap File Contents:"); for I in 1 .. String_List.Length (Data) loop declare Line : constant String := String_List.Element (Data, I); begin Put_Line ("""" & Line & """"); end; end loop; New_Line; end Xpminfo;