1. -- 
  2. -- Copyright (c) 2012 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. with Ada.Unchecked_Conversion; 
  10. with Allegro.Bitmaps;                   use Allegro.Bitmaps; 
  11. with Allegro.Palettes;                  use Allegro.Palettes; 
  12.  
  13. -- Allegro 4.4.2 - Fonts 
  14. package Allegro.Fonts is 
  15.  
  16.     type Font is private; 
  17.     type A_Font is access all Font; 
  18.  
  19.     type A_Font_Load_Callback is 
  20.         access function( filename : String; 
  21.                          pal      : A_RGB; 
  22.                          param    : Address ) return A_Font; 
  23.  
  24.     ---------------------------------------------------------------------------- 
  25.  
  26.     procedure Destroy_Font( f : in out A_Font ); 
  27.  
  28.     function Extract_Font_Range( f : not null A_Font; first, last : Integer ) return A_Font; 
  29.  
  30.     function Get_Font_Range_Begin( f : not null A_Font; rang : Integer ) return Integer; 
  31.  
  32.     function Get_Font_Range_End( f : not null A_Font; rang : Integer ) return Integer; 
  33.  
  34.     function Get_Font_Ranges( f : not null A_Font ) return Integer; 
  35.  
  36.     function Grab_Font_From_Bitmap( bmp : not null A_Bitmap ) return A_Font; 
  37.  
  38.     function Is_Color_Font( f : not null A_Font ) return Integer; 
  39.  
  40.     function Is_Compatible_Font( f1, f2 : not null A_Font ) return A_Font; 
  41.  
  42.     function Is_Mono_Font( f : not null A_Font ) return Integer; 
  43.  
  44.     function Load_Bios_Font( filename : String; pal : A_RGB; param : Address ) return A_Font; 
  45.  
  46.     function Load_Bitmap_Font( filename : String; pal : A_RGB; param : Address ) return A_Font; 
  47.  
  48.     function Load_Dat_Font( filename : String; pal : A_RGB; param : Address ) return A_Font; 
  49.  
  50.     function Load_Font( filename : String; pal : A_RGB; param : Address ) return A_Font; 
  51.  
  52.     function Load_Grx_Font( filename : String; pal : A_RGB; param : Address ) return A_Font; 
  53.  
  54.     function Load_Grx_Or_Bios_Font( filename : String; pal : A_RGB; param : Address ) return A_Font; 
  55.  
  56.     function Load_Txt_Font( filename : String; pal : A_RGB; param : Address ) return A_Font; 
  57.  
  58.     procedure Make_Trans_Font( f : not null A_Font ); 
  59.  
  60.     function Merge_Fonts( f1, f2 : not null A_Font ) return A_Font; 
  61.  
  62.     procedure Register_Font_File_Type( ext : String; load : A_Font_Load_Callback ); 
  63.  
  64.     function Transpose_Font( f : not null A_Font; drange : Integer ) return Integer; 
  65.  
  66.     function To_A_Font is new Ada.Unchecked_Conversion( Address, A_Font ); 
  67.  
  68. private 
  69.  
  70.     type Font_Vtable is 
  71.         record 
  72.             font_height          : Address; 
  73.             char_length          : Address; 
  74.             text_length          : Address; 
  75.             render_char          : Address; 
  76.             render               : Address; 
  77.             destroy              : Address; 
  78.             get_font_ranges      : Address; 
  79.             get_font_range_begin : Address; 
  80.             get_font_range_end   : Address; 
  81.             extract_font_range   : Address; 
  82.             merge_fonts          : Address; 
  83.             transpose_font       : Address; 
  84.        end record; 
  85.     pragma Convention( C, Font_Vtable ); 
  86.     type A_Font_Vtable is access all Font_Vtable; 
  87.  
  88.     type Font is 
  89.         record 
  90.             data   : Address; 
  91.             height : Integer; 
  92.             vtable : A_Font_Vtable; 
  93.         end record; 
  94.     pragma Convention( C, Font ); 
  95.  
  96.     ---------------------------------------------------------------------------- 
  97.  
  98.     pragma Convention( C, A_Font_Load_Callback ); 
  99.  
  100.     pragma Import( C, Extract_Font_Range, "extract_font_range" ); 
  101.     pragma Import( C, Get_Font_Range_Begin, "get_font_range_begin" ); 
  102.     pragma Import( C, Get_Font_Range_End, "get_font_range_end" ); 
  103.     pragma Import( C, Get_Font_Ranges, "get_font_ranges" ); 
  104.     pragma Import( C, Grab_Font_From_Bitmap, "grab_font_from_bitmap" ); 
  105.     pragma Import( C, Is_Color_Font, "is_color_font" ); 
  106.     pragma Import( C, Is_Compatible_Font, "is_compatible_font" ); 
  107.     pragma Import( C, Is_Mono_Font, "is_mono_font" ); 
  108.     pragma Import( C, Make_Trans_Font, "make_trans_font" ); 
  109.     pragma Import( C, Merge_Fonts, "merge_fonts" ); 
  110.     pragma Import( C, Transpose_Font, "transpose_font" ); 
  111.  
  112. end Allegro.Fonts;