1. with Allegro.Bitmaps;                   use Allegro.Bitmaps; 
  2. with Allegro.Truecolor;                 use Allegro.Truecolor; 
  3. with System;                            use System; 
  4.  
  5. package Alfont is 
  6.  
  7.     -- An AlFont instance represents a font loaded by the AlFont API and able to 
  8.     -- be used to render strings to bitmaps. 
  9.     type Alfont_Font is private; 
  10.     type A_Alfont_Font is access all Alfont_Font; 
  11.  
  12.     type Size_Array is array (Natural range <>) of Integer; 
  13.     pragma Convention( C, Size_Array ); 
  14.     type A_Size_Array is access all Size_Array; 
  15.  
  16.     STYLE_STANDARD   : constant := 0;     -- Standard style font 
  17.     STYLE_ITALIC     : constant := 1;     -- Italic style font 
  18.     STYLE_BOLD       : constant := 2;     -- Bold style font 
  19.     STYLE_BOLDITALIC : constant := 3;     -- BoldItalic style font 
  20.  
  21.     ALFONT_OK        : constant := 0; 
  22.     ALFONT_ERROR     : constant := -1; 
  23.  
  24.     ---------------------------------------------------------------------------- 
  25.  
  26.     -- Returns the copyright tag for AllegroFont. 
  27.     function Alfont_Copyright return String; 
  28.  
  29.     -- Returns a string describing the library version in the form 
  30.     -- "LibraryName dotted.version" 
  31.     function Alfont_Version return String; 
  32.  
  33.     --  Initializes AllegroFont. Remember to call alfont_exit() when you 
  34.     --  are done with it! Nobody will do it automatically for you. 
  35.     -- 
  36.     -- return values: 
  37.     --  ALFONT_OK on success. 
  38.     --  Other value ( != 0 ) on error. 
  39.     function Alfont_Init return Integer; 
  40.  
  41.     --  Deinitializes AllegroFont and its resources (fonts included). 
  42.     --  It is important to call it before you exit. 
  43.     procedure Alfont_Exit; 
  44.  
  45.     --  Loads a font from a the following formats (thanks to FreeType 2): 
  46.     --      TrueType fonts (and collections) 
  47.     --      Type 1 fonts 
  48.     --      CID-keyed Type 1 fonts 
  49.     --      CFF fonts 
  50.     --      OpenType fonts (both TrueType and CFF variants) 
  51.     --      SFNT-based bitmap fonts 
  52.     --      X11 PCF fonts 
  53.     --      Windows FNT fonts 
  54.     --  Note the scalable fonts by default get loaded with a size of 8 pixels 
  55.     --  height. 
  56.     --  Use alfont_set_font_size() to change the font size. 
  57.     -- 
  58.     -- return values: 
  59.     --  NULL if there ocurred an error. 
  60.     --  Other value ( != NULL ) otherwise. 
  61.     function Load_Font( filepathname : String ) return A_Alfont_Font; 
  62.     pragma Precondition( filepathname'Length > 0 ); 
  63.  
  64.     --  Same as alfont_load_font only that instead of loading it from a file 
  65.     --  it loads it directly from memory. The lib will create its own copy 
  66.     --  of this buffer, so you are free to deallocate it once this function 
  67.     --  has been called. 
  68.     function Load_Font_From_Mem( data : Address; data_len : Natural ) return A_Alfont_Font; 
  69.     pragma Precondition( data /= Null_Address ); 
  70.  
  71.     --  Destroys the font. Note this function check if the 'f' pointer is 
  72.     --  pointing to NULL, so for example this: 
  73.     --     ALFONT_FONT *f = NULL; 
  74.     --     alfont_destroy_font(f); 
  75.     --  won't crash the program. 
  76.     procedure Destroy_Font( f : in out A_Alfont_Font ); 
  77.     pragma Postcondition( f = null ); 
  78.  
  79.     --  Since AllegroFont can use scalable fonts (for example TrueType) 
  80.     --  this sets the size of the font. This should also work with multiple 
  81.     --  fixed sized fonts. 
  82.     --  Note changing the size of a font makes it to "reload" the internal 
  83.     --  glyphs of it, which is *slow*, so if you want to use many sizes 
  84.     --  of the same font very regularly, better create several instances 
  85.     --  of it. 
  86.     -- 
  87.     -- return values: 
  88.     --  ALFONT_ERROR if there ocurred an error (for example if the font is not scalable). 
  89.     --  ALFONT_OK otherwise. 
  90.     function Set_Font_Size( f : not null A_Alfont_Font; h : Positive ) return Integer; 
  91.  
  92.     --  Returns the selected font height. 
  93.     function Get_Font_Height( f : not null A_Alfont_Font ) return Positive; 
  94.  
  95.     --  Return TRUE or FALSE, dependant on if the font is fixed (there is 
  96.     --  a range of sizes where to choose from) or scalable (any size can be 
  97.     --  used, well, or almost) 
  98.     function Is_Scalable_Font( f : not null A_Alfont_Font ) return Boolean; 
  99.     function Is_Fixed_Font( f : not null A_Alfont_Font ) return Boolean; 
  100.  
  101.     --  Sets the selected font as fixed width. 
  102.     procedure Set_Font_Fixed_Width( f : not null A_Alfont_Font; fixed_width : Boolean ); 
  103.  
  104.     --  Returns an array with the available fixed heights, being the last item 
  105.     --  this array -1. 
  106.     --  In case of calling this function for a scalable font you will get an 
  107.     --  array of just one element, being it -1 
  108.     --  If you have doubts on how to access the information because pointers 
  109.     --  scare you, you just have to do: 
  110.     -- 
  111.     --    const int *my_font_sizes; 
  112.     --    my_font_sizes = alfont_get_available_fixed_sizes(my_font); 
  113.     --    /* first size */ 
  114.     --    int first_h = my_font_sizes[0]; 
  115.     --    /* second */ 
  116.     --    int second_h = my_font_sizes[1]; 
  117.     -- 
  118.     --  and so until my_font_sizes[x] is -1 
  119.     -- 
  120.     --  Regarding the Ada interface, the array returned from this function must 
  121.     --  be deleted by the caller. In the case of a scalable font, null will be 
  122.     --  returned. 
  123.     function Get_Available_Fixed_Sizes( f : not null A_Alfont_Font ) return A_Size_Array; 
  124.  
  125.     --  Returns the number of available fixed sizes, or -1 if a scalable font 
  126.     --  is passed. 
  127.     function Get_Nof_Available_Fixed_Sizes( f : not null A_Alfont_Font ) return Integer; 
  128.  
  129.     --  Returns the character extra spacing, this is, an int number 
  130.     --  that will be added to the space between characters, being the 
  131.     --  min of it '0'. 
  132.     function Get_Char_Extra_Spacing( f : not null A_Alfont_Font ) return Natural; 
  133.  
  134.     --  Sets the character extra spacing, this is, an int number 
  135.     --  that will be added to the space between characters, being the 
  136.     --  min of it '0'. 
  137.     procedure Set_Char_Extra_Spacing( f : not null A_Alfont_Font; spacing : Natural ); 
  138.  
  139.     --  Sets the language for the selected font. 
  140.     --  You can visit the language string in the header "alfont.h" or see 
  141.     --  "language_strings.txt" 
  142.     procedure Set_Language( f : not null A_Alfont_Font; language : String ); 
  143.     pragma Precondition( language'Length > 0 ); 
  144.  
  145.     --  Returns the language of the selected font. 
  146.     function Get_Language( f : not null A_Alfont_Font ) return String; 
  147.  
  148.     --  Sets the convert type for the selected font. 
  149.     --  You can set the type as "No Switch",AlFont won't convert the string. 
  150.     --  Or you can set the type as "TYPE_MULTIBYTE",AlFont will convert the 
  151.     --  string as multibyte string(Local Code). 
  152.     --  Or you can set the type as "TYPE_WIDECHAR",AlFont will convert the 
  153.     --  string as widechar string(Unicode Code). 
  154.     procedure Set_Convert( f : not null A_Alfont_Font; typ : Integer ); 
  155.  
  156.     --  Returns the convert type of the selected font. 
  157.     function Get_Convert( f : not null A_Alfont_Font ) return Integer; 
  158.  
  159.     --  Sets the selected font style as Standard,Italic,Bold or BoldItalic style font. 
  160.     procedure Set_Font_Style( f : not null A_Alfont_Font; style : Integer ); 
  161.  
  162.     --  Returns the style of the selected font. 
  163.     function Get_Font_Style( f : not null A_Alfont_Font ) return Integer; 
  164.  
  165.     --  Sets the selected font with underline. 
  166.     procedure Set_Font_Underline( f : not null A_Alfont_Font; underline : Boolean ); 
  167.  
  168.     --  Returns if the selected font have been set as underline. 
  169.     function Get_Font_Underline( f : not null A_Alfont_Font ) return Boolean; 
  170.  
  171.     --  Extends the right underline for the selected font. 
  172.     procedure Set_Font_Underline_Right( f : not null A_Alfont_Font; underline_right : Boolean ); 
  173.  
  174.     --  Returns if the selected font have been set as extend right underline. 
  175.     function Get_Font_Underline_Right( f : not null A_Alfont_Font ) return Boolean; 
  176.  
  177.     --  Extends the left underline for the selected font. 
  178.     procedure Set_Font_Underline_Left( f : not null A_Alfont_Font; underline_left : Boolean ); 
  179.  
  180.     --  Returns if the selected font have been set as extend left underline. 
  181.     function Get_Font_Underline_Left( f : not null A_Alfont_Font ) return Boolean; 
  182.  
  183.     --  Sets the background for the selected font.(TRUE/FALSE) 
  184.     procedure Set_Font_Background( f : not null A_Alfont_Font; background : Boolean ); 
  185.  
  186.     --  Returns if the selected font have been set to show the background color. 
  187.     function Get_Font_Background( f : not null A_Alfont_Font ) return Boolean; 
  188.  
  189.     --  Sets the transparency for the selected font.(0-255) 
  190.     procedure Set_Font_Transparency( f : not null A_Alfont_Font; transparency : Integer ); 
  191.     pragma Precondition( transparency >= 0 ); 
  192.     pragma Precondition( transparency <= 255 ); 
  193.  
  194.     --  Returns the transparency of the selected font. 
  195.     function Get_Font_Transparency( f : not null A_Alfont_Font ) return Integer; 
  196.  
  197.     --  Autofix the shortcutted character while trying to convert ASCII encoding 
  198.     --  format to Unicode encoding format. The shortcutted character will be 
  199.     --  appended to the next string. After the shortcutted character showed with 
  200.     --  the next string, the shortcutted character value will be set as 0. 
  201.     --  The function will be useful for double-byte characters. 
  202.     procedure Set_Autofix( f : not null A_Alfont_Font; autofix : Boolean ); 
  203.  
  204.     --  Returns if the selected font have been set as autofix. 
  205.     function Get_Autofix( f : not null A_Alfont_Font ) return Boolean; 
  206.  
  207.     --  Sets the shortcutted character value. 
  208.     --  The shortcutted character will be showed in the front of the next string. 
  209.     procedure Set_Precedingchar( f : not null A_Alfont_Font; precedingchar : Integer ); 
  210.  
  211.     --  Returns the shortcutted character value that will be appended to the next string. 
  212.     --  If there are not the shortcutted character that will be appended to the next string, 
  213.     --  the return value of the alfont_get_precedingchar function will be 0. 
  214.     function Get_Precedingchar( f : not null A_Alfont_Font ) return Integer; 
  215.  
  216.     --  Returns the character pointed to by `s' in the current encoding format. 
  217.     --  int alfont_ugetc(ALFONT_FONT *f, const char *s); 
  218.  
  219.     --  Returns the character pointered by `s' in the current encoding format, 
  220.     --  and advances the pointer to the next character after the one just returned. 
  221.     --  int alfont_ugetx(ALFONT_FONT *f, char **s); 
  222.  
  223.     --  Returns the character pointered by `s' in the current encoding format, 
  224.     --  and advances the pointer to the next character after the one just returned. 
  225.     --  int alfont_ugetxc(ALFONT_FONT *f, const char **s); 
  226.  
  227.     --  Gets the converted string pointered by `s' in the current encoding format. 
  228.     --  void alfont_get_string(ALFONT_FONT *f, const char *s , char **out); 
  229.  
  230.     --  Adds the outline width of the top for the selected font. 
  231.     --  The height of the selected font is the max restriction. 
  232.     procedure Set_Font_Outline_Top( f : not null A_Alfont_Font; w : Natural ); 
  233.  
  234.     --  Returns the top outline width of the selected font. 
  235.     function Get_Font_Outline_Top( f : not null A_Alfont_Font ) return Natural; 
  236.  
  237.     --  Adds the outline width of the bottom for the selected font. 
  238.     --  The height of the selected font is the max restriction. 
  239.     procedure Set_Font_Outline_Bottom( f : not null A_Alfont_Font; w : Natural ); 
  240.  
  241.     --  Returns the bottom outline width of the selected font. 
  242.     function Get_Font_Outline_Bottom( f : not null A_Alfont_Font ) return Natural; 
  243.  
  244.     --  Adds the outline width of the left for the selected font. 
  245.     --  The width of the selected font is the max restriction. 
  246.     procedure Set_Font_Outline_Left( f : not null A_Alfont_Font; w : Natural ); 
  247.  
  248.     --  Returns the left outline width of the selected font. 
  249.     function Get_Font_Outline_Left( f : not null A_Alfont_Font ) return Natural; 
  250.  
  251.     --  Adds the outline width of the right for the selected font. 
  252.     --  The width of the selected font is the max restriction. 
  253.     procedure Set_Font_Outline_Right( f : not null A_Alfont_Font; w : Natural ); 
  254.  
  255.     --  Returns the right outline width of the selected font. 
  256.     function Get_Font_Outline_Right( f : not null A_Alfont_Font ) return Natural; 
  257.  
  258.     --  Sets the outline color for the selected font. 
  259.     procedure Set_Font_Outline_Color( f : not null A_Alfont_Font; c : Integer ); 
  260.  
  261.     --  Returns the outline color of the selected font. 
  262.     function Get_Font_Outline_Color( f : not null A_Alfont_Font ) return Integer; 
  263.  
  264.     --  Sets the selected font as hollow.(TRUE/FALSE) 
  265.     procedure Set_Font_Outline_Hollow( f : not null A_Alfont_Font; hollow : Boolean ); 
  266.  
  267.     --  Returns if the selected font have been set as hollow. 
  268.     function Get_Font_Outline_Hollow( f : not null A_Alfont_Font ) return Boolean; 
  269.  
  270.     --  Returns the length of the string. 
  271.     function Text_Count( f : not null A_Alfont_Font; str : String ) return Natural; 
  272.  
  273.     --  Returns TRUE if unicode conversion is required or FALSE otherwise, 
  274.     --  that is the string contains only character values less than 128. 
  275.     function Need_Uconvert( f : not null A_Alfont_Font; str : String ) return Boolean; 
  276.  
  277.     --  For the following procedures... 
  278.     -- 
  279.     --  See allegro ones. The only difference is the suffix "_aa" that means 
  280.     --  antialiased. Bear in mind antialiased operations are a lot slower than 
  281.     --  monochrome ones. Also some old font formats, like PCF do not support 
  282.     --  antialiasing. 
  283.     --  Notice also the "_ex" suffix that adds a 'backg' parameter, which is the 
  284.     --  background color, avoiding that way the use of alfont_textmode(). 
  285.  
  286.     --  In fact, the speed from faster to slower are (being 100% the speed 
  287.     --  of the fastest one): 
  288.  
  289.     --  Bliting over screen: 
  290.     --    Monochrome, transparent textmode   (100%) 
  291.     --    Monochrome, opaque textmode        (63%) 
  292.     --    Antialiased, opaque textmode       (53%) 
  293.     --    Antialiased, transparent textmode  (6%) 
  294.  
  295.     --  Blitting over memory bitmap: 
  296.     --    Monochrome, transparent textmode   (91%) 
  297.     --    Monochrome, opaque textmode        (50%) 
  298.     --    Antialiased, opaque textmode       (47%) 
  299.     --    Antialiased, transparent textmode  (20%) 
  300.  
  301.     --  being the Antialiased opaque mode a lot faster than the Antialiased 
  302.     --  transparent mode (since this last one uses allegro blenders). That's 
  303.     --  also the reason of why this last one works A LOT better over memory 
  304.     --  bitmaps (implies read operations). 
  305.  
  306.     --  Sets text drawing mode. The previous mode is returned. 
  307.     function Text_Mode( mode : Integer ) return Integer; 
  308.  
  309.     procedure Textout_aa(    bmp : not null A_Bitmap; f : not null A_Alfont_Font; s : String; x, y : Integer; color : Color_Type ); 
  310.     procedure Textout(       bmp : not null A_Bitmap; f : not null A_Alfont_Font; s : String; x, y : Integer; color : Color_Type ); 
  311.     procedure Textout_aa_ex( bmp : not null A_Bitmap; f : not null A_Alfont_Font; s : String; x, y : Integer; color : Color_Type; backg : Integer ); 
  312.     procedure Textout_ex(    bmp : not null A_Bitmap; f : not null A_Alfont_Font; s : String; x, y : Integer; color : Color_Type; backg : Integer ); 
  313.  
  314.     procedure Textout_Centre_aa(    bmp : not null A_Bitmap; f : not null A_Alfont_Font; s : String; x, y : Integer; color : Color_Type ); 
  315.     procedure Textout_Centre(       bmp : not null A_Bitmap; f : not null A_Alfont_Font; s : String; x, y : Integer; color : Color_Type ); 
  316.     procedure Textout_Centre_aa_ex( bmp : not null A_Bitmap; f : not null A_Alfont_Font; s : String; x, y : Integer; color : Color_Type; backg : Integer ); 
  317.     procedure Textout_Centre_ex(    bmp : not null A_Bitmap; f : not null A_Alfont_Font; s : String; x, y : Integer; color : Color_Type; backg : Integer ); 
  318.  
  319.     procedure Textout_Right_aa(    bmp : not null A_Bitmap; f : not null A_Alfont_Font; s : String; x, y : Integer; color : Color_Type ); 
  320.     procedure Textout_Right(       bmp : not null A_Bitmap; f : not null A_Alfont_Font; s : String; x, y : Integer; color : Color_Type ); 
  321.     procedure Textout_Right_aa_ex( bmp : not null A_Bitmap; f : not null A_Alfont_Font; s : String; x, y : Integer; color : Color_Type; backg : Integer ); 
  322.     procedure Textout_Right_ex(    bmp : not null A_Bitmap; f : not null A_Alfont_Font; s : String; x, y : Integer; color : Color_Type; backg : Integer ); 
  323.  
  324.     function Text_Height( f : not null A_Alfont_Font ) return Natural; 
  325.     function Text_Length( f : not null A_Alfont_Font; str : String ) return Natural; 
  326.  
  327. private 
  328.  
  329.     type Alfont_Font is null record; 
  330.     pragma Convention( C, Alfont_Font ); 
  331.  
  332.     ---------------------------------------------------------------------------- 
  333.  
  334.     pragma Import( C, Alfont_Init,             "alfont_init" ); 
  335.     pragma Import( C, Alfont_Exit,             "alfont_exit" ); 
  336.     pragma Import( C, Load_Font_From_Mem,      "alfont_load_font_from_mem" ); 
  337.     pragma Import( C, Set_Font_Size,           "alfont_set_font_size" ); 
  338.     pragma Import( C, Get_Font_Height,         "alfont_get_font_height" ); 
  339.     pragma Import( C, Get_Nof_Available_Fixed_Sizes, "alfont_get_nof_available_fixed_sizes" ); 
  340.     pragma Import( C, Get_Char_Extra_Spacing,  "alfont_get_char_extra_spacing" ); 
  341.     pragma Import( C, Set_Char_Extra_Spacing,  "alfont_set_char_extra_spacing" ); 
  342.     pragma Import( C, Set_Convert,             "alfont_set_convert" ); 
  343.     pragma Import( C, Get_Convert,             "alfont_get_convert" ); 
  344.     pragma Import( C, Set_Font_Style,          "alfont_set_font_style" ); 
  345.     pragma Import( C, Get_Font_Style,          "alfont_get_font_style" ); 
  346.     pragma Import( C, Set_Font_Transparency,   "alfont_set_font_transparency" ); 
  347.     pragma Import( C, Get_Font_Transparency,   "alfont_get_font_transparency" ); 
  348.     pragma Import( C, Set_Precedingchar,       "alfont_set_precedingchar" ); 
  349.     pragma Import( C, Get_Precedingchar,       "alfont_get_precedingchar" ); 
  350.     pragma Import( C, Set_Font_Outline_Top,    "alfont_set_font_outline_top" ); 
  351.     pragma Import( C, Get_Font_Outline_Top,    "alfont_get_font_outline_top" ); 
  352.     pragma Import( C, Set_Font_Outline_Bottom, "alfont_set_font_outline_bottom" ); 
  353.     pragma Import( C, Get_Font_Outline_Bottom, "alfont_get_font_outline_bottom" ); 
  354.     pragma Import( C, Set_Font_Outline_Left,   "alfont_set_font_outline_left" ); 
  355.     pragma Import( C, Get_Font_Outline_Left,   "alfont_get_font_outline_left" ); 
  356.     pragma Import( C, Set_Font_Outline_Right,  "alfont_set_font_outline_right" ); 
  357.     pragma Import( C, Get_Font_Outline_Right,  "alfont_get_font_outline_right" ); 
  358.     pragma Import( C, Set_Font_Outline_Color,  "alfont_set_font_outline_color" ); 
  359.     pragma Import( C, Get_Font_Outline_Color,  "alfont_get_font_outline_color" ); 
  360.     pragma Import( C, Text_Mode,               "alfont_text_mode" ); 
  361.     pragma Import( C, Text_Height,             "alfont_text_height" ); 
  362.  
  363. end Alfont;