1. with Allegro_Ids;                       use Allegro_Ids; 
  2. with Interfaces;                        use Interfaces; 
  3. with System;                            use System; 
  4.  
  5. -- Allegro 4.4.2 - System routines 
  6. package Allegro is 
  7.     pragma Elaborate_Body; 
  8.  
  9.     type A_Close_Button_Procedure is 
  10.         access procedure; 
  11.  
  12.     type A_Integer is access all Integer; 
  13.  
  14.     type    CPU_Family_Type is private; 
  15.     type    CPU_Model_Type is private; 
  16.     subtype CPU_Capabilities_Type is Unsigned_32; 
  17.  
  18.     type OS_Type_Type is private; 
  19.  
  20.     --------------------------------------------------------------------------- 
  21.  
  22.     CPU_ID       : constant CPU_Capabilities_Type; 
  23.     CPU_FPU      : constant CPU_Capabilities_Type; 
  24.     CPU_MMX      : constant CPU_Capabilities_Type; 
  25.     CPU_MMXPLUS  : constant CPU_Capabilities_Type; 
  26.     CPU_SSE      : constant CPU_Capabilities_Type; 
  27.     CPU_SSE2     : constant CPU_Capabilities_Type; 
  28.     CPU_3DNOW    : constant CPU_Capabilities_Type; 
  29.     CPU_ENH3DNOW : constant CPU_Capabilities_Type; 
  30.     CPU_CMOV     : constant CPU_Capabilities_Type; 
  31.     CPU_AMD64    : constant CPU_Capabilities_Type; 
  32.     CPU_IA64     : constant CPU_Capabilities_Type; 
  33.     CPU_SSE3     : constant CPU_Capabilities_Type; 
  34.  
  35.     CPU_FAMILY_UNKNOWN  : constant CPU_Family_Type; 
  36.     CPU_FAMILY_I386     : constant CPU_Family_Type; 
  37.     CPU_FAMILY_I486     : constant CPU_Family_Type; 
  38.     CPU_FAMILY_I586     : constant CPU_Family_Type; 
  39.     CPU_FAMILY_I686     : constant CPU_Family_Type; 
  40.     CPU_FAMILY_ITANIUM  : constant CPU_Family_Type; 
  41.     CPU_FAMILY_EXTENDED : constant CPU_Family_Type; 
  42.  
  43.     -- CPU models - PC 
  44.     -- 486 
  45.     CPU_MODEL_I486DX              : constant CPU_Model_Type; 
  46.     CPU_MODEL_I486DX50            : constant CPU_Model_Type; 
  47.     CPU_MODEL_I486SX              : constant CPU_Model_Type; 
  48.     CPU_MODEL_I487SX              : constant CPU_Model_Type; 
  49.     CPU_MODEL_I486SL              : constant CPU_Model_Type; 
  50.     CPU_MODEL_I486SX2             : constant CPU_Model_Type; 
  51.     CPU_MODEL_I486DX2             : constant CPU_Model_Type; 
  52.     CPU_MODEL_I486DX4             : constant CPU_Model_Type; 
  53.  
  54.     -- Intel/586 
  55.     CPU_MODEL_PENTIUM             : constant CPU_Model_Type; 
  56.     CPU_MODEL_PENTIUMP54C         : constant CPU_Model_Type; 
  57.     CPU_MODEL_PENTIUMOVERDRIVE    : constant CPU_Model_Type; 
  58.     CPU_MODEL_PENTIUMOVERDRIVEDX4 : constant CPU_Model_Type; 
  59.     CPU_MODEL_CYRIX               : constant CPU_Model_Type; 
  60.     CPU_MODEL_UNKNOWN             : constant CPU_Model_Type; 
  61.  
  62.     -- AMD/586 
  63.     CPU_MODEL_K5                  : constant CPU_Model_Type; 
  64.     CPU_MODEL_K6                  : constant CPU_Model_Type; 
  65.  
  66.     -- Intel/686 
  67.     CPU_MODEL_PENTIUMPROA          : constant CPU_Model_Type; 
  68.     CPU_MODEL_PENTIUMPRO           : constant CPU_Model_Type; 
  69.     CPU_MODEL_PENTIUMIIKLAMATH     : constant CPU_Model_Type; 
  70.     CPU_MODEL_PENTIUMII            : constant CPU_Model_Type; 
  71.     CPU_MODEL_CELERON              : constant CPU_Model_Type; 
  72.     CPU_MODEL_PENTIUMIIIKATMAI     : constant CPU_Model_Type; 
  73.     CPU_MODEL_PENTIUMIIICOPPERMINE : constant CPU_Model_Type; 
  74.     CPU_MODEL_PENTIUMIIIMOBILE     : constant CPU_Model_Type; 
  75.  
  76.     -- AMD/686 
  77.     CPU_MODEL_ATHLON               : constant CPU_Model_Type; 
  78.     CPU_MODEL_DURON                : constant CPU_Model_Type; 
  79.  
  80.     -- Information when CPU_Family is CPU_FAMILY_EXTENDED 
  81.     CPU_MODEL_PENTIUMIV            : constant CPU_Model_Type; 
  82.     CPU_MODEL_XEON                 : constant CPU_Model_Type; 
  83.     CPU_MODEL_ATHLON64             : constant CPU_Model_Type; 
  84.     CPU_MODEL_OPTERON              : constant CPU_Model_Type; 
  85.  
  86.     OSTYPE_UNKNOWN  : constant OS_Type_Type; 
  87.     OSTYPE_WIN3     : constant OS_Type_Type; 
  88.     OSTYPE_WIN95    : constant OS_Type_Type; 
  89.     OSTYPE_WIN98    : constant OS_Type_Type; 
  90.     OSTYPE_WINME    : constant OS_Type_Type; 
  91.     OSTYPE_WINNT    : constant OS_Type_Type; 
  92.     OSTYPE_WIN2000  : constant OS_Type_Type; 
  93.     OSTYPE_WINXP    : constant OS_Type_Type; 
  94.     OSTYPE_WIN2003  : constant OS_Type_Type; 
  95.     OSTYPE_WINVISTA : constant OS_Type_Type; 
  96.     OSTYPE_WIN7     : constant OS_Type_Type; 
  97.     OSTYPE_OS2      : constant OS_Type_Type; 
  98.     OSTYPE_WARP     : constant OS_Type_Type; 
  99.     OSTYPE_DOSEMU   : constant OS_Type_Type; 
  100.     OSTYPE_OPENDOS  : constant OS_Type_Type; 
  101.     OSTYPE_LINUX    : constant OS_Type_Type; 
  102.     OSTYPE_SUNOS    : constant OS_Type_Type; 
  103.     OSTYPE_FREEBSD  : constant OS_Type_Type; 
  104.     OSTYPE_NETBSD   : constant OS_Type_Type; 
  105.     OSTYPE_OPENBSD  : constant OS_Type_Type; 
  106.     OSTYPE_IRIX     : constant OS_Type_Type; 
  107.     OSTYPE_DARWIN   : constant OS_Type_Type; 
  108.     OSTYPE_QNX      : constant OS_Type_Type; 
  109.     OSTYPE_UNIX     : constant OS_Type_Type; 
  110.     OSTYPE_BEOS     : constant OS_Type_Type; 
  111.     OSTYPE_MACOS    : constant OS_Type_Type; 
  112.     OSTYPE_MACOSX   : constant OS_Type_Type; 
  113.  
  114.     ---------------------------------------------------------------------------- 
  115.  
  116.     procedure Allegro_Date( day, month, year : out Positive ); 
  117.  
  118.     procedure Allegro_Exit; 
  119.  
  120.     function Allegro_Error return String; 
  121.  
  122.     function Allegro_Id return String; 
  123.  
  124.     -- Binding only: Returns a copyright tag for Allegro. 
  125.     function Allegro_Copyright return String; 
  126.  
  127.     function Allegro_Initialize return Integer; 
  128.  
  129.     -- Initializes Allegro with SYSTEM_NONE for command line applications 
  130.     function Allegro_Initialize_Cmdline return Integer; 
  131.  
  132.     procedure Allegro_Message( message : String ); 
  133.  
  134.     procedure Allegro_Version( major, minor, wip : out Integer ); 
  135.  
  136.     procedure Check_CPU; 
  137.  
  138.     function CPU_Capabilities return CPU_Capabilities_Type; 
  139.     function CPU_Family return CPU_Family_Type; 
  140.     function CPU_Model return CPU_Model_Type; 
  141.     function CPU_Vendor return String; 
  142.  
  143.     function Desktop_Color_Depth return Natural; 
  144.  
  145.     procedure Desktop_Resolution( width, 
  146.                                   height  : out Natural; 
  147.                                   success : out Boolean ); 
  148.  
  149.     function Install_Allegro( system_id  : Integer; 
  150.                               errno_ptr  : Address; 
  151.                               atexit_ptr : Address ) return Integer; 
  152.  
  153.     function Is_OS_Multitasking return Boolean; 
  154.  
  155.     function OS_Type return OS_Type_Type; 
  156.     function OS_Version return Integer; 
  157.     function OS_Revision return Integer; 
  158.  
  159.     function Set_Close_Button_Callback( handle : A_Close_Button_Procedure ) return Integer; 
  160.  
  161.     procedure Set_Window_Title( name : String ); 
  162.  
  163.     function To_String( capabilities : CPU_Capabilities_Type ) return String; 
  164.  
  165.     function To_String( family : CPU_Family_Type ) return String; 
  166.  
  167.     function To_String( family : CPU_Family_Type; 
  168.                         model  : CPU_Model_Type ) return String; 
  169.  
  170.     function To_String( os : OS_Type_Type ) return String; 
  171.  
  172. private 
  173.  
  174.     type CPU_Family_Type is new Unsigned_32; 
  175.  
  176.     type CPU_Model_Type is new Unsigned_32; 
  177.  
  178.     type OS_Type_Type is new AL_ID; 
  179.  
  180.     ---------------------------------------------------------------------------- 
  181.  
  182.     CPU_ID       : constant CPU_Capabilities_Type := 16#0001#; 
  183.     CPU_FPU      : constant CPU_Capabilities_Type := 16#0002#; 
  184.     CPU_MMX      : constant CPU_Capabilities_Type := 16#0004#; 
  185.     CPU_MMXPLUS  : constant CPU_Capabilities_Type := 16#0008#; 
  186.     CPU_SSE      : constant CPU_Capabilities_Type := 16#0010#; 
  187.     CPU_SSE2     : constant CPU_Capabilities_Type := 16#0020#; 
  188.     CPU_3DNOW    : constant CPU_Capabilities_Type := 16#0040#; 
  189.     CPU_ENH3DNOW : constant CPU_Capabilities_Type := 16#0080#; 
  190.     CPU_CMOV     : constant CPU_Capabilities_Type := 16#0100#; 
  191.     CPU_AMD64    : constant CPU_Capabilities_Type := 16#0200#; 
  192.     CPU_IA64     : constant CPU_Capabilities_Type := 16#0400#; 
  193.     CPU_SSE3     : constant CPU_Capabilities_Type := 16#0800#; 
  194.  
  195.     CPU_FAMILY_UNKNOWN  : constant CPU_Family_Type :=  0; 
  196.     CPU_FAMILY_I386     : constant CPU_Family_Type :=  3; 
  197.     CPU_FAMILY_I486     : constant CPU_Family_Type :=  4; 
  198.     CPU_FAMILY_I586     : constant CPU_Family_Type :=  5; 
  199.     CPU_FAMILY_I686     : constant CPU_Family_Type :=  6; 
  200.     CPU_FAMILY_ITANIUM  : constant CPU_Family_Type :=  7; 
  201.     CPU_FAMILY_EXTENDED : constant CPU_Family_Type := 15; 
  202.  
  203.     CPU_MODEL_I486DX               : constant CPU_Model_Type := 0; 
  204.     CPU_MODEL_I486DX50             : constant CPU_Model_Type := 1; 
  205.     CPU_MODEL_I486SX               : constant CPU_Model_Type := 2; 
  206.     CPU_MODEL_I487SX               : constant CPU_Model_Type := 3; 
  207.     CPU_MODEL_I486SL               : constant CPU_Model_Type := 4; 
  208.     CPU_MODEL_I486SX2              : constant CPU_Model_Type := 5; 
  209.     CPU_MODEL_I486DX2              : constant CPU_Model_Type := 7; 
  210.     CPU_MODEL_I486DX4              : constant CPU_Model_Type := 8; 
  211.  
  212.     CPU_MODEL_PENTIUM              : constant CPU_Model_Type :=  1; 
  213.     CPU_MODEL_PENTIUMP54C          : constant CPU_Model_Type :=  2; 
  214.     CPU_MODEL_PENTIUMOVERDRIVE     : constant CPU_Model_Type :=  3; 
  215.     CPU_MODEL_PENTIUMOVERDRIVEDX4  : constant CPU_Model_Type :=  4; 
  216.     CPU_MODEL_CYRIX                : constant CPU_Model_Type := 14; 
  217.     CPU_MODEL_UNKNOWN              : constant CPU_Model_Type := 15; 
  218.  
  219.     CPU_MODEL_K5                   : constant CPU_Model_Type := 0; 
  220.     CPU_MODEL_K6                   : constant CPU_Model_Type := 6; 
  221.  
  222.     CPU_MODEL_PENTIUMPROA          : constant CPU_Model_Type := 0; 
  223.     CPU_MODEL_PENTIUMPRO           : constant CPU_Model_Type := 1; 
  224.     CPU_MODEL_PENTIUMIIKLAMATH     : constant CPU_Model_Type := 3; 
  225.     CPU_MODEL_PENTIUMII            : constant CPU_Model_Type := 5; 
  226.     CPU_MODEL_CELERON              : constant CPU_Model_Type := 6; 
  227.     CPU_MODEL_PENTIUMIIIKATMAI     : constant CPU_Model_Type := 7; 
  228.     CPU_MODEL_PENTIUMIIICOPPERMINE : constant CPU_Model_Type := 8; 
  229.     CPU_MODEL_PENTIUMIIIMOBILE     : constant CPU_Model_Type := 9; 
  230.  
  231.     CPU_MODEL_ATHLON               : constant CPU_Model_Type := 2; 
  232.     CPU_MODEL_DURON                : constant CPU_Model_Type := 3; 
  233.  
  234.     CPU_MODEL_PENTIUMIV            : constant CPU_Model_Type := 0; 
  235.     CPU_MODEL_XEON                 : constant CPU_Model_Type := 2; 
  236.     CPU_MODEL_ATHLON64             : constant CPU_Model_Type := 4; 
  237.     CPU_MODEL_OPTERON              : constant CPU_Model_Type := 5; 
  238.  
  239.     OSTYPE_UNKNOWN  : constant OS_Type_Type := OS_Type_Type(AL_ID_NONE); 
  240.     OSTYPE_WIN3     : constant OS_Type_Type := To_AL_ID('W','I','N','3'); 
  241.     OSTYPE_WIN95    : constant OS_Type_Type := To_AL_ID('W','9','5',' '); 
  242.     OSTYPE_WIN98    : constant OS_Type_Type := To_AL_ID('W','9','8',' '); 
  243.     OSTYPE_WINME    : constant OS_Type_Type := To_AL_ID('W','M','E',' '); 
  244.     OSTYPE_WINNT    : constant OS_Type_Type := To_AL_ID('W','N','T',' '); 
  245.     OSTYPE_WIN2000  : constant OS_Type_Type := To_AL_ID('W','2','K',' '); 
  246.     OSTYPE_WINXP    : constant OS_Type_Type := To_AL_ID('W','X','P',' '); 
  247.     OSTYPE_WIN2003  : constant OS_Type_Type := To_AL_ID('W','2','K','3'); 
  248.     OSTYPE_WINVISTA : constant OS_Type_Type := To_AL_ID('W','V','S','T'); 
  249.     OSTYPE_WIN7     : constant OS_Type_Type := To_AL_ID('W','I','N','7'); 
  250.     OSTYPE_OS2      : constant OS_Type_Type := To_AL_ID('O','S','2',' '); 
  251.     OSTYPE_WARP     : constant OS_Type_Type := To_AL_ID('W','A','R','P'); 
  252.     OSTYPE_DOSEMU   : constant OS_Type_Type := To_AL_ID('D','E','M','U'); 
  253.     OSTYPE_OPENDOS  : constant OS_Type_Type := To_AL_ID('O','D','O','S'); 
  254.     OSTYPE_LINUX    : constant OS_Type_Type := To_AL_ID('T','U','X',' '); 
  255.     OSTYPE_SUNOS    : constant OS_Type_Type := To_AL_ID('S','U','N',' '); 
  256.     OSTYPE_FREEBSD  : constant OS_Type_Type := To_AL_ID('F','B','S','D'); 
  257.     OSTYPE_NETBSD   : constant OS_Type_Type := To_AL_ID('N','B','S','D'); 
  258.     OSTYPE_OPENBSD  : constant OS_Type_Type := To_AL_ID('O','B','S','D'); 
  259.     OSTYPE_IRIX     : constant OS_Type_Type := To_AL_ID('I','R','I','X'); 
  260.     OSTYPE_DARWIN   : constant OS_Type_Type := To_AL_ID('D','A','R','W'); 
  261.     OSTYPE_QNX      : constant OS_Type_Type := To_AL_ID('Q','N','X',' '); 
  262.     OSTYPE_UNIX     : constant OS_Type_Type := To_AL_ID('U','N','I','X'); 
  263.     OSTYPE_BEOS     : constant OS_Type_Type := To_AL_ID('B','E','O','S'); 
  264.     OSTYPE_MACOS    : constant OS_Type_Type := To_AL_ID('M','A','C',' '); 
  265.     OSTYPE_MACOSX   : constant OS_Type_Type := To_AL_ID('M','A','C','X'); 
  266.  
  267.     ---------------------------------------------------------------------------- 
  268.  
  269.     pragma Convention( C, A_Close_Button_Procedure ); 
  270.  
  271.     pragma Import( C, Allegro_Initialize, "allegro_initialize" ); 
  272.     pragma Import( C, Allegro_Initialize_Cmdline, "allegro_initialize_cmdline" ); 
  273.     pragma Import( C, Allegro_Exit, "allegro_exit" ); 
  274.     pragma Import( C, Check_CPU, "check_cpu" ); 
  275.     pragma Import( C, CPU_Capabilities, "get_cpu_capabilities" ); 
  276.     pragma Import( C, CPU_Family, "get_cpu_family" ); 
  277.     pragma Import( C, CPU_Model, "get_cpu_model" ); 
  278.     pragma Import( C, Desktop_Color_Depth, "desktop_color_depth" ); 
  279.     pragma Import( C, Install_Allegro, "install_allegro" ); 
  280.     pragma Import( C, OS_Revision, "get_os_revision" ); 
  281.     pragma Import( C, OS_Type, "get_os_type" ); 
  282.     pragma Import( C, OS_Version, "get_os_version" ); 
  283.     pragma Import( C, Set_Close_Button_Callback, "set_close_button_callback" ); 
  284.  
  285. end Allegro;