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