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