Difference between revisions of "Ttengine.library"

From Freepascal Amiga wiki
Jump to navigation Jump to search
(→‎Example: ( insert example title ): Example 10: Rendering bitmap)
(→‎Example: ( insert example title ): Example 11: Rendering text on background picture)
Line 2,250: Line 2,250:
 
</source>
 
</source>
  
−
=== Example: ( insert example title ) ===
+
=== Example: Rendering text on background picture ===
  
−
There's no example available.
+
Example that shows how to render text on a background picture.
  
 +
Note that this example uses unit aros_datatypes. I've put together a fast quick 'n' dirty datatype.library header unit as there wasn't one available for AROS (yet), but i haven't posted this unit, ergo the example will be useless for most.
  
 
<!-- When available, insert link to original source-code [http://link] -->
 
<!-- When available, insert link to original source-code [http://link] -->
  
 
<source lang="pascal">
 
<source lang="pascal">
 +
program background;
 +
 +
{$MODE OBJFPC}{$H+}
 +
 +
(*
 +
  Pascalized version of background.c, part of ttengine library examples
 +
*)
 +
 +
Uses
 +
  exec,
 +
  amigados,
 +
  agraphics,
 +
  intuition,
 +
  asl,
 +
  aros_datatypes,
 +
  aros_ttengine,
 +
  sysutils;
 +
 +
 +
Type
 +
  SWORD = SmallInt;
 +
 +
 +
Function SetAndTest(var a: Pointer; b: Pointer): boolean; inline;
 +
begin
 +
  a := b;
 +
  result := (a <> nil);
 +
end;
 +
 +
 +
 +
Var
 +
  PicBitMap : PBitMap;
 +
  Picture  : PObject_;
 +
 +
 +
 +
function get_font_name(aslbase: pLibrary): STRPTR;
 +
var
 +
  freq      : PFileRequester;
 +
  name      : STRPTR = nil;
 +
  namelen  : ULONG;
 +
begin
 +
  freq := AllocAslRequest(ASL_FileRequest, [TAG_END]);
 +
  if (freq <> nil) then
 +
  begin
 +
    if AslRequest(freq,
 +
    [
 +
      LongInt(ASLFR_TitleText      ), pchar('Select TrueType font'),
 +
      LongInt(ASLFR_InitialDrawer  ), pchar('FONTS:'),
 +
      LongInt(ASLFR_DoPatterns    ), TRUE,
 +
      LongInt(ASLFR_InitialPattern ), pchar('#?.ttf'),
 +
      LongInt(ASLFR_RejectIcons    ), TRUE,
 +
      TAG_END
 +
    ]) then
 +
    begin
 +
      namelen := strlen(freq^.rf_File) + strlen(freq^.rf_Dir) + 4;
 +
     
 +
      name := AllocVec(namelen + 1, MEMF_ANY or MEMF_CLEAR);
 +
      if (name <> nil) then
 +
      begin
 +
        strlcopy(name, freq^.rf_dir, namelen);
 +
        AddPart(name, freq^.rf_File, namelen);
 +
        // writeln('name = ', name);
 +
      end;
 +
    end;
 +
    FreeAslRequest(freq);
 +
  end;
 +
  result := name;
 +
end;
 +
 +
 +
 +
procedure free_font_name(name: STRPTR);
 +
begin
 +
  if (name <> nil) then FreeVec(name);
 +
end;
 +
 +
 +
 +
procedure ctext(w: PWindow; text: STRPTR; y: ULONG);
 +
var
 +
  t1, b1 : UWORD;
 +
  rp : PRastPort;
 +
begin
 +
  rp := w^.RPort;
 +
 
 +
  t1 := strlen(text);
 +
  b1 := TT_TextLength(rp, text, t1);
 +
  GfxMove(rp, ((448 - b1) shr 1) + w^.BorderLeft, y);
 +
  TT_text(rp, text, t1);
 +
end;
 +
 +
 +
 +
function init(): Boolean;
 +
begin
 +
  if (GfxBase      = nil) then exit(false);
 +
  if (IntuitionBase = nil) then exit(false);
 +
  if (ASLBase      = nil) then exit(false);
 +
  if (TTEngineBase  = nil) then exit(false);
 +
  if (DataTypesBase = nil) then exit(false);
 +
  result := true;
 +
end;
 +
 +
 +
 +
procedure cleanup();
 +
begin
 +
  (*
 +
    if (DataTypesBase) CloseLibrary(DataTypesBase);
 +
    if (TTEngineBase) CloseLibrary(TTEngineBase);
 +
    if (AslBase) CloseLibrary(AslBase);
 +
    if (IntuitionBase) CloseLibrary(IntuitionBase);
 +
    if (GfxBase) CloseLibrary(GfxBase);
 +
    return;
 +
  *)
 +
end;
 +
 +
 +
 +
procedure load_picture(w: PWindow);
 +
begin
 +
  Picture := NewDTObject(pchar('PROGDIR:picture'),
 +
  [
 +
    (DTA_GroupID)    , GID_PICTURE,
 +
    (PDTA_Remap)    , LTRUE,
 +
    (PDTA_DestMode)  , PMODE_V43,
 +
    (PDTA_Screen)    , ULONG(w^.WScreen),
 +
    TAG_END
 +
  ]);
 +
  if (picture <> nil) then
 +
  begin
 +
    //DoDTMethod(Picture, nil, nil, [DTM_PROCLAYOUT, Nil, DTSIF_NEWSIZE]);
 +
    DoDTMethod(Picture, nil, nil, [DTM_PROCLAYOUT, 0, DTSIF_NEWSIZE]);   
 +
    GetDTAttrs(Picture, [PDTA_DestBitMap, ULONG(@PicBitMap), TAG_END]);
 +
  end;
 +
end;
 +
 +
 +
 +
Function Main: Integer;
 +
var
 +
  win      : PWindow;
 +
  fontname  : STRPTR;
 +
  font      : APTR;
 +
var
 +
  sigmask,
 +
  signals,
 +
  pen      : ULONG;
 +
  running  : boolean; 
 +
  rp        : PRastPort;
 +
  cnt      : SWORD;
 +
  r, g, b,
 +
  icl      : ULONG; 
 +
  imsg      : PIntuiMessage;
 +
begin
 +
  if (init()) then
 +
  begin
 +
    fontname := get_font_name(AslBase);
 +
   
 +
    If (FontName <> nil) then
 +
    begin
 +
      win := OpenWindowTags(nil,
 +
      [
 +
              LongInt(WA_Top)        , 25,
 +
              LongInt(WA_Left)      , 0,
 +
              LongInt(WA_InnerWidth) , 448,
 +
              LongInt(WA_InnerHeight), 262,
 +
              LongInt(WA_CloseGadget), LTRUE,
 +
              LongInt(WA_DragBar)    , LTRUE,
 +
              LongInt(WA_DepthGadget), LTRUE,
 +
              LongInt(WA_Activate)  , LTRUE,
 +
              LongInt(WA_IDCMP)      , (IDCMP_CLOSEWINDOW or IDCMP_INTUITICKS),
 +
              LongInt(WA_Title)      , pchar('TTEngine font picture demo'),
 +
              TAG_END
 +
      ]);
 +
 +
      If (win <> nil) then
 +
      begin
 +
        running := true;
 +
        rp := win^.RPort;
 +
        cnt := 0;
 +
        r := 0; g := $7FFFFFFF; b := $FFFFFFFF;
 +
 +
        load_picture(win);
 +
 +
        font := TT_OpenFont(
 +
        [
 +
          TT_FontFile, ULONG(fontname),
 +
          TT_FontSize, 26,
 +
          TAG_END       
 +
        ]);
 +
       
 +
        if (font <> nil) then
 +
        begin
 +
          SetDrMd(rp, JAM1);
 +
 +
          if (TT_SetFont(rp, font) <> 0) then
 +
          begin
 +
            sigmask := SIGBREAKF_CTRL_C or (1 shl win^.UserPort^.mp_SigBit);
 +
            while (running) do
 +
            begin
 +
              signals := Wait(sigmask);
 +
              if ((signals and SIGBREAKF_CTRL_C) <> 0) then running := FALSE;
 +
              if ((signals and (1 shl win^.UserPort^.mp_SigBit)) <> 0) then
 +
              begin
 +
                while SetAndTest(imsg, GetMsg(win^.UserPort)) do
 +
                begin
 +
                  icl := imsg^.IClass;
 +
                  ReplyMsg(pMessage(imsg));
 +
                 
 +
                  if (icl = IDCMP_CLOSEWINDOW) then running := false;
 +
                  if running = false then writeln('running states is false');
 +
 +
                  if (icl = IDCMP_INTUITICKS) then
 +
                  begin
 +
                    inc(cnt);
 +
                    if (cnt > 9) then
 +
                    begin
 +
                      if (PicBitMap <> nil)
 +
                      then BltBitMapRastPort(PicBitMap, 0, 0, rp, win^.BorderLeft, win^.BorderTop, 448, 262, $C0);
 +
 +
                      cnt := 0;
 +
                      r := r + $0817736F;
 +
                      g := g + $0A27E836;
 +
                      b := b + $0C3A47D4;
 +
 +
                      //pen := ObtainBestPen(win^.WScreen^.ViewPort.ColorMap, r, g, b, [TAG_END]);
 +
                      //pen := ObtainBestPen(win^.WScreen^.ViewPort.ColorMap, r, g, b, [TAG_END, TAG_END]);
 +
                      pen := ObtainBestPenA(win^.WScreen^.ViewPort.ColorMap, r, g, b, nil);
 +
 +
                      SetAPen(rp, pen);
 +
                   
 +
                      TT_SetAttrs(rp,
 +
                      [
 +
                        LongInt(TT_Window)  , ULONG(win),
 +
                        LongInt(TT_Antialias), TT_Antialias_On,
 +
                        TT_Transparency      , 0,
 +
                        TAG_END
 +
                      ]);
 +
 +
                      ctext(win, 'You can see here how the text is', 40);
 +
                      ctext(win, 'smoothed on background picture.', 66);
 +
                     
 +
                      TT_SetAttrs(rp,
 +
                      [
 +
                        TT_Antialias, TT_Antialias_Off,
 +
                        TAG_END
 +
                      ]);
 +
                     
 +
                      ctext(win, 'This text is not smoothed', 102);
 +
                      ctext(win, 'The difference is clearly', 128);
 +
                      ctext(win, 'visible.', 154);
 +
                     
 +
                      TT_SetAttrs(rp,
 +
                      [
 +
                        TT_Antialias, TT_Antialias_On,
 +
                        TT_Transparency, 64,
 +
                        TAG_END
 +
                      ]);
 +
                     
 +
                      ctext(win, 'transparent text (75%)', 190);
 +
                     
 +
                      TT_SetAttrs(rp,
 +
                      [
 +
                        TT_Transparency, 128,
 +
                        TAG_END
 +
                      ]);
 +
                     
 +
                      ctext(win, 'transparent text (50%)', 216);
 +
                     
 +
                      TT_SetAttrs(rp,
 +
                      [
 +
                        TT_Transparency, 192,
 +
                        TAG_END
 +
                      ]);
 +
                     
 +
                      ctext(win, 'transparent text (25%)', 242);
 +
                     
 +
                      ReleasePen(win^.WScreen^.ViewPort.ColorMap, pen);
 +
                    end;
 +
                  end;
 +
                  //imsg := PIntuiMessage(GetMsg(win^.UserPort));
 +
                end;  // while imsg
 +
              end;
 +
            end; // while running
 +
          end
 +
          else writeln('TT_Setfont() failed.');
 +
 +
          TT_CloseFont(font);
 +
        end
 +
        else writeln('Font open failed.');
 +
 +
        TT_DoneRastPort(rp);
 +
        CloseWindow(win);
 +
      end
 +
      else writeln('Window open failed.');
 +
      free_font_name(fontname);
 +
    end
 +
    else writeln('Fontname (requester) open failed');
 +
  end
 +
  else writeln('initialization failed');
 +
 +
  cleanup;
 +
  result := 0;
 +
end;
 +
 +
 +
 +
begin
 +
  writeln('enter');
 +
  exitcode := Main;
 +
  writeln('leave');
 +
end.
 +
 
</source>
 
</source>
−
 
  
 
=== Example: ( insert example title ) ===
 
=== Example: ( insert example title ) ===

Revision as of 07:45, 18 October 2014

TTEngine is a AmigaOS friendly TrueType render engine library which can open a TrueType font by itself and renders high quality glyphs directly.


Description

TTEngine can render text directly into an AmigaOS rastport using FreeType font(s) and is also available for AROS [1]

The render engine of the library is based on FreeType2 project [2].

The library expands FreeType functionality making usage of TrueType fonts easy and comfortable. Below you can find key features:

  • renders whole strings (not single glyphs) with kerning.
  • antialiasing to any (not neccesarily uniform color) background.
  • system compatible output to any (including planar) RastPort.
  • supports JAM1. JAM2, INVERSVID, COMPLEMENT RastPort modes.
  • supports 8-bit to Unicode mapping with "ENV:ttfcodepage" table
  • compatible with ttf.library.
  • allows for direct 16-bit Unicode string rendering.
  • easy to use, taglist based API almost identical to graphics.library font API.
  • efficient system-wide glyph cache system.

For more information, please refer to the official SDK.


Usage

The TTEngine library uses its own caching system and uses a special crafted ttengine.database (the latter keeps track of the truetype font(s) that the end-user has configured in his/her system).

Be aware that some of the example are designed in such a way that they depend on a proper truetype configuration.

To configure your truetype fonts, please use TTManager first. In practise that seems to boil down to adding and configuring your fonts and needing a restart of the the OS before changes taking place.

Do note, that creation of the caching file and font database are not mandatory. It simply depends on which functionality enduser's code relies.

For more information about the caching system and the font database, please refer to the official SDK.


Examples

Example: Display family-list font information

This example will display information in the shell about the truetype-fonts available (read: configured) in the system.

Please note, that in order for this example to work correctly that it is required to configure truetype fonts first by using the accompanied font manager from the archive.

( Original c-source code is available in the distribution archive of ttengine ) 

program familylist;

{$MODE OBJFPC}{$H+}

(*
  Pascalized version of familylist.c, part of ttengine library examples
  Only works correctly when env:ttengine.database is present
*)

Uses
  exec,
  utility,
  aros_ttengine;



Function SetAndTest(var a: Pointer; b: Pointer): boolean;
begin
  a := b;
  result := (a <> nil);
end;



Function Main: Integer;
var
  family_list : PSTRPTR;
  p           : PSTRPTR;
begin
  if (TTEngineBase <> nil) then
  begin
    Writeln('Listing all available font families:');
    writeln('-------------------------------------');

    If SetAndTest(family_list, TT_ObtainFamilyListA(nil)) then
    begin
      p := family_list;
      while (p^ <> nil) do
      begin
        writeln(p^);
        inc(p);
      end;
      TT_FreeFamilyList(family_list);
    end;
  
    writeln;
    writeln('Listing monospaced font families:');
    writeln('-------------------------------------');

    if SetAndTest(family_list, TT_ObtainFamilyList([TTRQ_FixedWidthOnly, LTRUE, TAG_END])) then
    begin
      p := family_list;
      while (p^ <> nil) do
      begin
        writeln(p^);
        inc(p);
      end;
      TT_FreeFamilyList(family_list);
    end;
    // CloseLibrary(TTEngineBase);
  end;
  result := 0;
end;


begin
  writeln('enter');
  exitcode := Main;
  writeln('leave');
end.


Example: Engine test

An example of testing the engine.

Amongst others, it shows how to setup the ttengine system, render text, how to apply individual attributes and even includes a case of rendering an UTF-16 encoded text.

Please note, that in order for this example to work correctly that it is required to configure truetype fonts first by using the accompanied font manager from the archive.

( Original c-source code is available in the distribution archive of ttengine ) 

program test;

{$MODE OBJFPC}{$H+}

(*
  Pascalized version of plain test.c, part of ttengine library examples
  Only works correctly when env:ttengine.database is present
*)

Uses
  exec,
  amigados,
  agraphics,
  utility,
  intuition,
  asl,
  aros_ttengine,
  sysutils;



Type
  TMatrix = record
    xx : ULONG;
    xy : ULONG;
    yx : ULONG;
    yy : ULONG;
  end;


var
  tx : Pwidechar = (#$FEFF'Test 16-bit '#$03a3' Unicode string.'#$0000);
  // added litle extra test -> feff03a3 = sigma


Function Main: Integer;
var
  win       : PWindow;
//  fontname  : STRPTR;
  font      : APTR;
var
  fontattrs : PTagItem;
  requester : APTR;
  sigmask, 
  signals   : ULONG;
  running   : boolean = TRUE;  
  rp        : PRastPort;
  tmt       : TMatrix = (xx: $00010000; xy: $00000000; yx: $00000000; yy: $00008000);
  red, 
  grn, 
  blu       : ULONG;
  imsg      : PIntuiMessage;
  
begin
  if (GfxBase <> nil) then
  begin
    if (AOS_utilitybase <> nil) then
    begin
      if (IntuitionBase <> nil) then
      begin
        if (TTEngineBase <> nil) then
        begin
          requester := TT_AllocRequest();
          writeln(format('requester = $%p', [requester]));

          fontattrs :=  TT_Request(requester,
          [
            TTRQ_DoSizes   , LFALSE,
            TTRQ_DoWeight  , LTRUE,
            TTRQ_DoStyle   , LTRUE,
            TTRQ_DoPreview , LTRUE,
            TAG_END
          ]);
          if (fontattrs <> nil) then
          begin
            win := OpenWindowTags(nil,
            [
              LongInt(WA_Top)        , 25,
              LongInt(WA_Left)       , 0,
              LongInt(WA_Width)      , 640,
              LongInt(WA_Height)     , 350,
              LongInt(WA_CloseGadget), LTRUE,
              LongInt(WA_DragBar)    , LTRUE,
              LongInt(WA_DepthGadget), LTRUE,
              LongInt(WA_IDCMP)      , IDCMP_CLOSEWINDOW,
              LongInt(WA_Title)      , pchar('ttengine.library test'),
              TAG_END
            ]);
            If (win <> nil) then
            begin
              running := true;
              rp := win^.RPort;              
//// 1
              font := TT_OpenFont(
              [
                TT_FamilyTable  , GetTagData(TT_FamilyTable, ULONG(Nil), fontattrs),
                TT_FontStyle    , GetTagData(TT_FontStyle, 0, fontattrs),
                TT_FontWeight   , GetTagData(TT_FontWeight, TT_FontWeight_Normal, fontattrs),
                TT_FontSize     , 24,
                // TT_FontTransform, (ULONG)&tmt,
                TAG_END
              ]);
              if (font <> nil) then
              begin
                if (TT_SetFont(rp, font) <> 0) then
                begin
                  TT_SetAttrs(rp,
                  [
                    TT_Window, ULONG(win),
                    TAG_END
                  ]);

                  SetAPen(rp, 2);
                  SetDrMd(rp, JAM1);
                  GfxMove(rp, 10, 50);
                  TT_Text(rp, pchar('This is a text printed with TT_Text()."'), 38);

                  TT_SetAttrs(rp,
                  [
                    TT_Antialias , TT_Antialias_Off,
                    TT_Encoding  , TT_Encoding_UTF16,
                    TAG_END
                  ]);

                  SetDrMd(rp, JAM2);
                  SetBPen(rp, 3);
                  GfxMove(rp, 10, 74);
                  TT_Text(rp, tx, 28);
                end
                else Writeln('TT_SetFont() failed.');
                TT_CloseFont(font);
              end
              else Writeln('Font open failed.');
//// 2
              font := TT_OpenFont(
              [
                TT_FamilyTable  , GetTagData(TT_FamilyTable, ULONG(Nil), fontattrs),
                TT_FontStyle    , GetTagData(TT_FontStyle, 0, fontattrs),
                TT_FontWeight   , GetTagData(TT_FontWeight, TT_FontWeight_Normal, fontattrs),
                TT_FontSize     , 36,
                TAG_END
              ]);
              if (font <> nil) then
              begin
                if (TT_SetFont(rp, font) <> 0) then
                begin
                  TT_SetAttrs(rp,
                  [
                    TT_Encoding  , TT_Encoding_Default,
                    TT_Antialias , TT_Antialias_On,
                    TT_Window    , ULONG(win),
                    TAG_END
                  ]);

                  SetAPen(rp, 1);
                  SetBPen(rp, 2);
                  
                  SetDrMd(rp, JAM2);
                  GfxMove(rp, 10, 120);
                  TT_Text(rp, pchar('Antialias with 36 points size.'), 30);
                end
                else Writeln('TT_SetFont() failed.');
                TT_CloseFont(font);
              end
              else Writeln('Font open failed.');
//// 3
              font := TT_OpenFont(
              [
                TT_FamilyTable  , GetTagData(TT_FamilyTable, ULONG(Nil), fontattrs),
                TT_FontStyle    , GetTagData(TT_FontStyle, 0, fontattrs),
                TT_FontWeight   , GetTagData(TT_FontWeight, TT_FontWeight_Normal, fontattrs),
                TT_FontSize     , 16,
                TAG_END
              ]);
              if (font <> nil) then
              begin
                if (TT_SetFont(rp, font) <> 0) then
                begin
                  TT_SetAttrs(rp,
                  [
                    TT_Encoding  , TT_Encoding_Default,
                    TT_Antialias , TT_Antialias_On,
                    TT_Window    , ULONG(win),
                    TAG_END
                  ]);

                  SetAPen(rp, 1);
                  SetDrMd(rp, JAM1);
                  GfxMove(rp, 10, 140);
                  TT_Text(rp, pchar('Antialias with 16 points size.'), 30);

                  SetAPen(rp, 2);
                  GfxMove(rp, 10, 156);
                  TT_Text(rp, pchar('Antialias with 16 points size.'), 30);
                  
                  SetAPen(rp, 3);
                  GfxMove(rp, 10, 172);
                  TT_Text(rp, pchar('Antialias with 16 points size.'), 30);
                  
                end
                else Writeln('TT_SetFont() failed.');
                TT_CloseFont(font);
              end
              else Writeln('Font open failed.');
//// 4
              //* antialias on different backgrounds */
              font := TT_OpenFont(
              [
                TT_FamilyTable  , GetTagData(TT_FamilyTable, ULONG(Nil), fontattrs),
                TT_FontStyle    , GetTagData(TT_FontStyle, 0, fontattrs),
                TT_FontWeight   , GetTagData(TT_FontWeight, TT_FontWeight_Normal, fontattrs),
                TT_FontSize     , 24,
                TAG_END
              ]);
              if (font <> nil) then
              begin
                //red := ObtainBestPen(win^.WScreen^.ViewPort.ColorMap, $FFFFFFFF, 0        ,         0, [TAG_END]);
                //grn := ObtainBestPen(win^.WScreen^.ViewPort.ColorMap, 0        , $FFFFFFFF,         0, [TAG_END]);
                //blu := ObtainBestPen(win^.WScreen^.ViewPort.ColorMap, 0        , 0        , $FFFFFFFF, [TAG_END]);

                red := ObtainBestPenA(win^.WScreen^.ViewPort.ColorMap, $FFFFFFFF, 0        ,         0, nil);
                grn := ObtainBestPenA(win^.WScreen^.ViewPort.ColorMap, 0        , $FFFFFFFF,         0, nil);
                blu := ObtainBestPenA(win^.WScreen^.ViewPort.ColorMap, 0        , 0        , $FFFFFFFF, nil);


                if (TT_SetFont(rp, font) <> 0) then
                begin
                  TT_SetAttrs(rp,
                  [
                    TT_Encoding  , TT_Encoding_Default,
                    TT_Antialias , TT_Antialias_On,
                    TT_Window    , ULONG(win),
                    TAG_END
                  ]);

                  SetDrMd(rp, JAM2);

                  TT_SetAttrs(rp, [TT_Background, $0000FF00, TT_Foreground, $00FF0000, TAG_END]);
                  GfxMove(rp, 10, 200);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $000000FF, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $00000000, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $00FFFFFF, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  
                  TT_SetAttrs(rp, [TT_Background, $00FF0000, TT_Foreground, $0000FF00, TAG_END]);
                  GfxMove(rp, 10, 224);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $000000FF, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $00000000, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $00FFFFFF, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  
                  TT_SetAttrs(rp, [TT_Background, $000000FF, TT_Foreground, $00FF0000, TAG_END]);
                  GfxMove(rp, 10, 248);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $0000FF00, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $00000000, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $00FFFFFF, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  
                  TT_SetAttrs(rp, [TT_Background, $0000000, TT_Foreground, $00FF0000, TAG_END]);
                  GfxMove(rp, 10, 272);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $00000FF, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $0000FF00, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $00FFFFFF, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  
                  TT_SetAttrs(rp, [TT_Background, $00FFFFFF, TT_Foreground, $00FF0000, TAG_END]);
                  GfxMove(rp, 10, 296);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $000000FF, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $00000000, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                  TT_SetAttrs(rp, [TT_Foreground, $0000FF00, TAG_END]);
                  TT_Text(rp, PChar('Smooth47'), 8);
                end
                else Writeln('TT_SetFont() failed.');

                ReleasePen(win^.WScreen^.ViewPort.ColorMap, red);
                ReleasePen(win^.WScreen^.ViewPort.ColorMap, grn);
                ReleasePen(win^.WScreen^.ViewPort.ColorMap, blu);

                TT_CloseFont(font);
              end
              else Writeln('Font open failed.');

              sigmask := SIGBREAKF_CTRL_C or (1 shl win^.UserPort^.mp_SigBit);
              while (running) do
              begin
                signals := Wait(sigmask);
                if ((signals or SIGBREAKF_CTRL_C) <> 0) then running := FALSE;
                if ((signals and (1 shl win^.UserPort^.mp_SigBit)) <> 0) then
                begin
                  imsg := PIntuiMessage(GetMsg(win^.UserPort));
                  while (imsg <> nil) do
                  begin
                    if (imsg^.IClass = IDCMP_CLOSEWINDOW) then running := false;
                    ReplyMsg(pMessage(imsg));
                    imsg := PIntuiMessage(GetMsg(win^.UserPort));
                  end;
                end;
              end;  // while running

              TT_DoneRastPort(win^.RPort);
              CloseWindow(win);
            end
            else writeln('OpenWindowTags() failed.');
          end;
          TT_FreeRequest(requester);
          // CloseLibrary(TTEngineBase);
        end;
        // CloseLibrary(IntuitionBase);
      end
      // CloseLibrary(UtilityBase);
    end;
    // CloseLibrary(GfxBase);
  end;

  result := 0;
end;



begin
  writeln('enter');
  exitcode := Main;
  writeln('leave');
end.


Example: Render names of selected font

Example that let user select a true-type font using an asl requester and renders the name of the family, subfamily and name of the font on an intuition window using its rastport. 


program names;

{$MODE OBJFPC}{$H+}

(*
  Pascalized version of names.c, part of ttengine library examples
*)

Uses
  exec,
  amigados,
  agraphics,
  intuition,
  asl,
  aros_ttengine,
  sysutils;



function get_font_name(aslbase: pLibrary): STRPTR;
var
  freq      : PFileRequester;
  name      : STRPTR;
  namelen   : ULONG;
begin
  freq := AllocAslRequest(ASL_FileRequest, [TAG_END]);
  if (freq <> nil) then
  begin
    if AslRequest(freq,
    [
      LongInt(ASLFR_TitleText      ), pchar('Select TrueType font'),
      LongInt(ASLFR_InitialDrawer  ), pchar('FONTS:'),
      LongInt(ASLFR_DoPatterns     ), LTRUE,
      LongInt(ASLFR_InitialPattern ), pchar('#?.ttf'),
      LongInt(ASLFR_RejectIcons    ), LTRUE,
      TAG_END
    ]) then
    begin
      namelen := strlen(freq^.rf_File) + strlen(freq^.rf_Dir) + 4;
      
      name := AllocVec(namelen + 1, MEMF_ANY or MEMF_CLEAR);
      if (name <> nil) then
      begin
        strlcopy(name, freq^.rf_dir, namelen);
        AddPart(name, freq^.rf_File, namelen);
       // writeln('name = ', name);
      end;
    end;
    FreeAslRequest(freq);
  end;
  result := name;
end;



procedure free_font_name(name: STRPTR);
begin
  if (name <> nil) then FreeVec(name);
end;



Function Main: Integer;
var
  win       : PWindow;
  fontname  : STRPTR;
  font      : APTR;
var  
  sigmask, 
  signals   : ULONG;
  running   : boolean;
  rp        : PRastPort;

  family, 
  subfamily, 
  fullname  : STRPTR;
  
  imsg      : PIntuiMessage;  
begin
  if (GfxBase <> nil) then
  begin
    if (IntuitionBase <> nil) then
    begin
      if (AslBase <> nil) then
      begin
        fontname := get_font_name(AslBase);
        if (fontname <> nil) then
        begin
          if (TTEngineBase <> nil) then
          begin
            win := OpenWindowTags(nil,
            [
              LongInt(WA_Top)        , 25,
              LongInt(WA_Left)       , 0,
              LongInt(WA_Width)      , 400,
              LongInt(WA_Height)     , 100,
              LongInt(WA_CloseGadget), LTRUE,
              LongInt(WA_DragBar)    , LTRUE,
              LongInt(WA_DepthGadget), LTRUE,
              LongInt(WA_IDCMP)      , IDCMP_CLOSEWINDOW,
              LongInt(WA_Title)      , pchar('TTEngine font names'),
              TAG_END
            ]);
            If (win <> nil) then
            begin
              running := true;
              rp := win^.RPort;

              font := TT_OpenFont(
              [
                TT_FontFile, fontname,
                TT_FontSize, 18,
                TAG_END
              ]);
              if (font <> nil) then
              begin
                free_font_name(fontname);

                If (TT_SetFont(rp, font) <> 0) then
                begin
                  TT_SetAttrs(rp,
                  [
                    TT_Window     , win,
                    TT_Encoding   , TT_Encoding_Default,
                    TT_Antialias  , TT_Antialias_On,
                    TAG_END                  
                  ]);

                  TT_GetAttrs(rp,
                  [
                    TT_FamilyName    , ULONG(@family),
                    TT_SubFamilyName , ULONG(@subfamily),
                    TT_FontName      , ULONG(@fullname),
                    TAG_END                  
                  ]);

                  SetAPen(rp, 1);
                  SetDrMd(rp, JAM1);

                  GfxMove(rp, 10, 36);
                  TT_Text(rp, family, strlen(family));
                  GfxMove(rp, 10, 54);
                  TT_Text(rp, subfamily, strlen(subfamily));
                  GfxMove(rp, 10, 72);
                  TT_Text(rp, fullname, strlen(fullname));
                end
                else Writeln('TT_SetFont() failed.');
                TT_CloseFont(font);
              end
              else writeln('Font open failed.');

              sigmask := SIGBREAKF_CTRL_C or (1 shl win^.UserPort^.mp_SigBit);
              while (running) do
              begin
                signals := Wait(sigmask);
                if ((signals or SIGBREAKF_CTRL_C) <> 0) then running := FALSE;
                if ((signals and (1 shl win^.UserPort^.mp_SigBit)) <> 0) then
                begin
                  imsg := PIntuiMessage(GetMsg(win^.UserPort));
                  while (imsg <> nil) do
                  begin
                    if (imsg^.IClass = IDCMP_CLOSEWINDOW) then running := false;
                    ReplyMsg(pMessage(imsg));
                    imsg := PIntuiMessage(GetMsg(win^.UserPort));
                  end;
                end;
              end;  // while running

              TT_DoneRastPort(win^.RPort);
              CloseWindow(win);
            end
            else writeln('OpenWindowTags() failed.');
            // CloseLibrary(TTEngineBase);
          end
          else writeln('opening ttengine.library failed');
          // free_font_name(fontname);
        end;
        // CloseLibrary(AslBase);
      end;
      // CloseLibrary(IntuitionBase);
    end;
    // CloseLibrary(GfxBase);
  end;

  result := 0;
end;



begin
  writeln('enter');
  exitcode := Main;
  writeln('leave');
end.

Example: Multiple fonts

Examples that let user select four different fonts using an asl requester and renders some text in an intuition's window rastport in each individual selected font-type. 


program morefonts;

{$MODE OBJFPC}{$H+}

(*
  Pascalized version of morefonts.c, part of ttengine library examples
*)

Uses
  exec,
  amigados,
  agraphics,
  intuition,
  asl,
  aros_ttengine,
  sysutils;



Type
  SWORD = SmallInt;



function get_font_name(aslbase: pLibrary; num: ULONG): STRPTR;
var
  freq      : PFileRequester;
  name      : STRPTR = nil;
  title     : pchar;
  namelen   : ULONG;
begin
  title := pchar(Format('Select %d TrueType font',[num]));
  
  freq := AllocAslRequest(ASL_FileRequest, [TAG_END]);
  if (freq <> nil) then
  begin
    if AslRequest(freq,
    [
      LongInt(ASLFR_TitleText      ), pchar('haha'),
      LongInt(ASLFR_InitialDrawer  ), pchar('FONTS:'),
      LongInt(ASLFR_DoPatterns     ), LTRUE,
      LongInt(ASLFR_InitialPattern ), pchar('#?.ttf'),
      LongInt(ASLFR_RejectIcons    ), LTRUE,
      TAG_END
    ]) then
    begin
      namelen := strlen(freq^.rf_File) + strlen(freq^.rf_Dir) + 4;
      
      name := AllocVec(namelen + 1, MEMF_ANY or MEMF_CLEAR);
      if (name <> nil) then
      begin
        strlcopy(name, freq^.rf_dir, namelen);
        AddPart(name, freq^.rf_File, namelen);
        //  writeln('name = ', name);
      end;
    end;
    FreeAslRequest(freq);
  end;
  result := name;
end;



procedure free_font_name(name: STRPTR);
begin
  if (name <> nil) then FreeVec(name);
end;



Var
  fontname : STRPTR;


Const
  NFN       = 4;



Function Main: Integer;
var
  win       : PWindow;
  fonts     : Array [0..NFN-1] of APTR;
  i         : SWORD;
  sigmask, 
  signals   : ULONG;
  running   : boolean = TRUE;  
var  
  rp        : PRastPort;
  imsg      : PIntuiMessage;
begin
  if (GfxBase <> nil) then
  begin
    if (IntuitionBase <> nil) then
    begin
      if (AslBase <> nil) then
      begin
        if (TTEngineBase <> nil) then
        begin
          win := OpenWindowTags(nil,
            [
              LongInt(WA_Top)        , 25,
              LongInt(WA_Left)       , 0,
              LongInt(WA_Width)      , 550,
              LongInt(WA_Height)     , 150,
              LongInt(WA_CloseGadget), LTRUE,
              LongInt(WA_DragBar)    , LTRUE,
              LongInt(WA_DepthGadget), LTRUE,
              LongInt(WA_IDCMP)      , IDCMP_CLOSEWINDOW,
              LongInt(WA_Title)      , pchar('TTEngine test - 4 fonts at once'),
              TAG_END
            ]);
          If (win <> nil) then
          begin
            rp := win^.RPort;              
              
            for i := 1 to NFN do
            begin
              fontname := get_font_name(AslBase, i);
                
              fonts[i-1] := TT_OpenFont(
              [
                TT_FontFile, ULONG(fontname),
                TT_FontSize, 18,
                TAG_END
              ]);
              if not (fonts[i-1] <> nil) then
              begin
                WriteLn('TT_OpenFont failed!');
              end
              else writeln(format('Font %d @ $%p',[i, fonts[i-1]]));
              free_font_name(fontname);
            end;

            SetDrMd(rp, JAM1);
            SetAPen(rp, 2);
            TT_SetAttrs(rp, [TT_Window, ULONG(win)]);

            for i := 1 to NFN do
            begin
              Writeln(format('Font %d at @ $%p', [i, Fonts[i-1]]));

              If (TT_SetFont(rp, fonts[i-1]) <> 0) then
              begin
                GfxMove(rp, 10, 20 + i * 18);
                TT_Text(rp, pchar('Text rendered with one of four TrueType fonts.'), 46);
              end;
            end;

            for i := 1 to NFN do if (fonts[i-1] <> nil) then TT_CloseFont(fonts[i - 1]);

            sigmask := SIGBREAKF_CTRL_C or (1 shl win^.UserPort^.mp_SigBit);
            while (running) do
            begin
              signals := Wait(sigmask);
              if ((signals and SIGBREAKF_CTRL_C) <> 0) then running := FALSE;
              if ((signals and (1 shl win^.UserPort^.mp_SigBit)) <> 0) then
              begin
                imsg := PIntuiMessage(GetMsg(win^.UserPort));
                while (imsg <> nil) do
                begin
                  if (imsg^.IClass = IDCMP_CLOSEWINDOW) then running := false;
                  ReplyMsg(pMessage(imsg));
                  imsg := PIntuiMessage(GetMsg(win^.UserPort));
                end;
              end;
            end;  // while running

            TT_DoneRastPort(win^.RPort);
            CloseWindow(win);
          end
          else writeln('OpenWindowTags() failed.');
            // CloseLibrary(TTEngineBase);
        end;
        // CloseLibrary(AslBase);
      end;
      // CloseLibrary(IntuitionBase);
    end;
    // CloseLibrary(GfxBase);
  end;

  result := 0;
end;



begin
  writeln('enter');
  exitcode := Main;
  writeln('leave');
end.

Example: Rendering and pixel-length

Example that let user select font using asl requester and renders text into windows rastport. Additionally a line is drawn beneath rendered text to show the length of the text in pixels. 


program txlen;

{$MODE OBJFPC}{$H+}

(*
  Pascalized version of txlen.c, part of ttengine library examples
*)

Uses
  exec,
  amigados,
  agraphics,
  intuition,
  asl,
  aros_ttengine,
  SysUtils;
  


function get_font_name(aslbase: pLibrary): STRPTR;
var
  freq      : PFileRequester;
  name      : STRPTR;
  namelen   : ULONG;
begin
  freq := AllocAslRequest(ASL_FileRequest, [TAG_END]);
  if (freq <> nil) then
  begin
    if AslRequest(freq,
    [
      LongInt(ASLFR_TitleText      ), pchar('Select TrueType font'),
      LongInt(ASLFR_InitialDrawer  ), pchar('FONTS:'),
      LongInt(ASLFR_DoPatterns     ), LTRUE,
      LongInt(ASLFR_InitialPattern ), pchar('#?.ttf'),
      LongInt(ASLFR_RejectIcons    ), LTRUE,
      TAG_END
    ]) then
    begin
      namelen := strlen(freq^.rf_File) + strlen(freq^.rf_Dir) + 4;
      
      name := AllocVec(namelen + 1, MEMF_ANY or MEMF_CLEAR);
      if (name <> nil) then
      begin
        strlcopy(name, freq^.rf_dir, namelen);
        AddPart(name, freq^.rf_File, namelen);
        // writeln('name = ', name);
      end;
    end;
    FreeAslRequest(freq);
  end;
  result := name;
end;



procedure free_font_name(name: STRPTR);
begin
  if (name <> nil) then FreeVec(name);
end;



procedure measured_text(text: STRPTR; y: UWORD; rp: PRastPort);
var
  te        : TTextExtent;
  len       : UWORD;
  pixlen    : ULONG;
begin
  len := strlen(text);
  pixlen := TT_TextLength(rp, text, len);

  SetAPen(rp, 2);
  GfxMove(rp, 10, y);
  Draw(rp, 10, y + 7);
  GfxMove(rp, 10, y + 5);
  Draw(rp, 10 + pixlen, y + 5);
  GfxMove(rp, 10 + pixlen, y);
  Draw(rp, 10 + pixlen, y + 7);

  SetAPen(rp, 1);
  GfxMove(rp, 10, y);
  TT_Text(rp, text, len);
end;



Function Main: Integer;
var
  win       : PWindow;
  fontname  : STRPTR;
var  
  sigmask, 
  signals   : ULONG;
  running   : boolean;
  rp        : PRastPort;
  font      : APTR;
  
  imsg      : PIntuiMessage;
begin
  if (GfxBase <> nil) then
  begin
    if (IntuitionBase <> nil) then
    begin
      if (AslBase <> nil) then
      begin
        fontname := get_font_name(AslBase);
        if (fontname <> nil) then
        begin
          if (TTEngineBase <> nil) then
          begin
            win := OpenWindowTags(nil,
            [
              LongInt(WA_Top)        , 25,
              LongInt(WA_Left)       , 0,
              LongInt(WA_Width)      , 640,
              LongInt(WA_Height)     , 210,
              LongInt(WA_CloseGadget), LTRUE,
              LongInt(WA_DragBar)    , LTRUE,
              LongInt(WA_DepthGadget), LTRUE,
              LongInt(WA_IDCMP)      , IDCMP_CLOSEWINDOW,
              LongInt(WA_Title)      , pchar('TT_TextLength() test'),
              TAG_END
            ]);
            If (win <> nil) then
            begin
              running := true;
              rp := win^.RPort;

              font := TT_OpenFont(
              [
                TT_FontFile, ULONG(fontname),
                TT_FontSize, 18,
                TT_ScaleX  , $3FA28F5C,
                TAG_END
              ]);
              if (font <> nil) then
              begin
                If (TT_SetFont(rp, font) <> 0) then
                begin
                  TT_SetAttrs(rp,
                  [
                    TT_Window     , ULONG(win),
                    TAG_END                  
                  ]);
                
                  SetDrMd(rp, JAM1);

                  measured_text('TT_TextLength() example', 45, rp);
                  measured_text('White lines shows text length in pixels as computed by the function.', 70, rp);
                  measured_text('Note that TT_TextLength() returns only "pen advance".', 95, rp);
                  measured_text('Use TT_TextExtent() if you want to get precise bounding box.', 120, rp);
                end
                else Writeln('TT_SetFont() failed.');
                TT_CloseFont(font);

              end
              else writeln('Font open failed.');

              sigmask := SIGBREAKF_CTRL_C or (1 shl win^.UserPort^.mp_SigBit);

              while (running) do
              begin
                signals := Wait(sigmask);
                if ((signals and SIGBREAKF_CTRL_C) <> 0) then running := FALSE;
                if ((signals and (1 shl win^.UserPort^.mp_SigBit)) <> 0) then
                begin
                  imsg := PIntuiMessage(GetMsg(win^.UserPort));
                  while (imsg <> nil) do
                  begin
                    if (imsg^.IClass = IDCMP_CLOSEWINDOW) then running := false;
                    ReplyMsg(pMessage(imsg));
                    imsg := PIntuiMessage(GetMsg(win^.UserPort));
                  end;
                end;
              end;  // while running

              TT_DoneRastPort(win^.RPort);
              CloseWindow(win);
            end
            else writeln('failed to open window');
            // CloseLibrary(TTEngineBase);
          end
          else writeln('failed to open ttengine library');
          free_font_name(fontname);
        end;
        // CloseLibrary(AslBase);
      end;
      // CloseLibrary(IntuitionBase);
    end;
    // CloseLibrary(GfxBase);
  end;

  result := 0;
end;



begin
  writeln('enter');
  exitcode := Main;
  writeln('leave');
end.

Example: Rendering and precise measurements

Example that renders some text in user selected font and shows how to measure the dimensions of the rendered text more precisely. 


program txex;

{$MODE OBJFPC}{$H+}

(*
  Pascalized version of txex.c, part of ttengine library examples
*)

Uses
  exec,
  amigados,
  agraphics,
  intuition,
  asl,
  aros_ttengine,
  sysutils;


Type
  SWord = SmallInt;



function get_font_name(aslbase: pLibrary): STRPTR;
var
  freq      : PFileRequester;
  name      : STRPTR;
  namelen   : ULONG;
begin
  freq := AllocAslRequest(ASL_FileRequest, [TAG_END]);
  if (freq <> nil) then
  begin
    if AslRequest(freq,
    [
      LongInt(ASLFR_TitleText      ), pchar('Select TrueType font'),
      LongInt(ASLFR_InitialDrawer  ), pchar('FONTS:'),
      LongInt(ASLFR_DoPatterns     ), TRUE,
      LongInt(ASLFR_InitialPattern ), pchar('#?.ttf'),
      LongInt(ASLFR_RejectIcons    ), TRUE,
      TAG_END
    ]) then
    begin
      namelen := strlen(freq^.rf_File) + strlen(freq^.rf_Dir) + 4;
      
      name := AllocVec(namelen + 1, MEMF_ANY or MEMF_CLEAR);
      if (name <> nil) then
      begin
        strlcopy(name, freq^.rf_dir, namelen);
        AddPart(name, freq^.rf_File, namelen);
        // writeln('name = ', name);
      end;
    end;
    FreeAslRequest(freq);
  end;
  result := name;
end;



procedure free_font_name(name: STRPTR);
begin
  if (name <> nil) then FreeVec(name);
end;



procedure framed_text(text: STRPTR; y: SWORD; rp: PRastPort);
var
  te    : TTextExtent;
  len   : UWORD;
begin
  len := strlen(text);

  TT_TextExtent(rp, text, len, @te);

  SetAPen(rp, 2);
  GfxMove(rp, 10 + te.te_Extent.MinX, y + te.te_Extent.MaxY);
  Draw(rp, 10 + te.te_Extent.MinX, y + te.te_Extent.MinY);
  Draw(rp, 10 + te.te_Extent.MaxX, y + te.te_Extent.MinY);
  Draw(rp, 10 + te.te_Extent.MaxX, y + te.te_Extent.MaxY);
  Draw(rp, 10 + te.te_Extent.MinX, y + te.te_Extent.MaxY);

  SetAPen(rp, 1);
  GfxMove(rp, 10, y);
  TT_Text(rp, text, len);
end;



Function Main: Integer;
var
  win       : PWindow;
  fontname  : STRPTR;
  font      : APTR;
var
  sigmask, 
  signals   : ULONG;
  running   : boolean;
  rp        : PRastPort;  
  imsg      : PIntuiMessage;
begin
  if (GfxBase <> nil) then
  begin
    if (IntuitionBase <> nil) then
    begin
      if (AslBase <> nil) then
      begin
        fontname := get_font_name(AslBase);
        if (fontname <> nil) then
        begin
          if (TTEngineBase <> nil) then
          begin
            win := OpenWindowTags(nil,
            [
              LongInt(WA_Top)        , 25,
              LongInt(WA_Left)       , 0,
              LongInt(WA_Width)      , 640,
              LongInt(WA_Height)     , 210,
              LongInt(WA_CloseGadget), LTRUE,
              LongInt(WA_DragBar)    , LTRUE,
              LongInt(WA_DepthGadget), LTRUE,
              LongInt(WA_IDCMP)      , IDCMP_CLOSEWINDOW,
              LongInt(WA_Title)      , pchar('TT_TextExtent() test'),
              TAG_END
            ]);
            If (win <> nil) then
            begin
              running := true;
              rp := win^.RPort;

              font := TT_OpenFont(
              [
                TT_FontFile, ULONG(fontname),
                TT_FontSize, 31,
                TT_FontStyle, TT_FontStyle_Italic,
                TAG_END
              ]);
              if (font <> nil) then
              begin
                If (TT_SetFont(rp, font) <> 0) then
                begin
                  TT_SetAttrs(rp,
                  [
                    TT_Window     , ULONG(win),
                    TT_Antialias  , TT_Antialias_On,
                    TAG_END
                  ]);
                
                  SetDrMd(rp, JAM1);

                  framed_text('TT_TextExtent() example', 46, rp);
                  framed_text('Vjgq2837!^²³_&##,.P', 92, rp);
                  framed_text('Frame should tightly enclose the text.', 138, rp);
                end
                else Writeln('TT_SetFont() failed.');
                TT_CloseFont(font);
              end
              else writeln('Font open failed.');

              sigmask := SIGBREAKF_CTRL_C or (1 shl win^.UserPort^.mp_SigBit);
              while (running) do
              begin
                signals := Wait(sigmask);
                if ((signals and SIGBREAKF_CTRL_C) <> 0) then running := FALSE;
                if ((signals and (1 shl win^.UserPort^.mp_SigBit)) <> 0) then
                begin
                  imsg := PIntuiMessage(GetMsg(win^.UserPort));
                  while (imsg <> nil) do
                  begin
                    if (imsg^.IClass = IDCMP_CLOSEWINDOW) then running := false;
                    ReplyMsg(pMessage(imsg));
                    imsg := PIntuiMessage(GetMsg(win^.UserPort));
                  end;
                end;
              end;

              TT_DoneRastPort(win^.RPort);
              CloseWindow(win);
            end
            else writeln('failed to open window');
            // CloseLibrary(TTEngineBase);
          end
          else writeln('failed to open ttengine library');
          free_font_name(fontname);
        end;
        // CloseLibrary(AslBase);
      end;
      // CloseLibrary(IntuitionBase);
    end;
    // CloseLibrary(GfxBase);
  end;

  result := 0;
end;



begin
  writeln('enter');
  exitcode := Main;
  writeln('leave');
end.

Example: Render text into a box

Example that shows how fit text render into boxed dimensions. 


program txfit;

{$MODE OBJFPC}{$H+}

(*
  Pascalized version of txfit.c, part of ttengine library examples
*)

Uses
  exec,
  amigados,
  agraphics,
  intuition,
  asl,
  aros_ttengine,
  sysutils;


Type
  SWORD = SmallInt;


Var
  red   : ULONG;


function get_font_name(aslbase: pLibrary): STRPTR;
var
  freq      : PFileRequester;
  name      : STRPTR;
  namelen   : ULONG;
begin
  freq := AllocAslRequest(ASL_FileRequest, [TAG_END]);
  if (freq <> nil) then
  begin
    if AslRequest(freq,
    [
      LongInt(ASLFR_TitleText      ), pchar('Select TrueType font'),
      LongInt(ASLFR_InitialDrawer  ), pchar('FONTS:'),
      LongInt(ASLFR_DoPatterns     ), LTRUE,
      LongInt(ASLFR_InitialPattern ), pchar('#?.ttf'),
      LongInt(ASLFR_RejectIcons    ), LTRUE,
      TAG_END
    ]) then
    begin
      namelen := strlen(freq^.rf_File) + strlen(freq^.rf_Dir) + 4;
      
      name := AllocVec(namelen + 1, MEMF_ANY or MEMF_CLEAR);
      if (name <> nil) then
      begin
        strlcopy(name, freq^.rf_dir, namelen);
        AddPart(name, freq^.rf_File, namelen);
        // writeln('name = ', name);
      end;
    end;
    FreeAslRequest(freq);
  end;
  result := name;
end;



procedure free_font_name(name: STRPTR);
begin
  if (name <> nil) then FreeVec(name);
end;



procedure fitted_text(text: STRPTR; y: UWORD; rp: PRastPort; cte: PTextExtent);
var
  te        : TTextExtent;
  len       : UWORD;
  pixlen, 
  to_draw   : ULONG;
begin  
  //* draw constraint frame */

  SetAPen(rp, Red);
  GfxMove(rp, 20 + cte^.te_Extent.MinX, y + cte^.te_Extent.MinY);
  Draw(rp, 20 + cte^.te_Extent.MaxX, y + cte^.te_Extent.MinY);
  Draw(rp, 20 + cte^.te_Extent.MaxX, y + cte^.te_Extent.MaxY);
  Draw(rp, 20 + cte^.te_Extent.MinX, y + cte^.te_Extent.MaxY);
  Draw(rp, 20 + cte^.te_Extent.MinX, y + cte^.te_Extent.MinY);

  //* draw text bounding box */

  len := strlen(text);
  to_draw := TT_TextFit(rp, text, len, @te, cte, 1, 0, 0);

  SetAPen(rp, 2);
  GfxMove(rp, 20 + te.te_Extent.MinX, y + te.te_Extent.MinY);
  Draw(rp, 20 + te.te_Extent.MaxX, y + te.te_Extent.MinY);
  Draw(rp, 20 + te.te_Extent.MaxX, y + te.te_Extent.MaxY);
  Draw(rp, 20 + te.te_Extent.MinX, y + te.te_Extent.MaxY);
  Draw(rp, 20 + te.te_Extent.MinX, y + te.te_Extent.MinY);

  //* draw the text itself */

  SetAPen(rp, 1);
  GfxMove(rp, 20, y);
  TT_Text(rp, text, to_draw);
end;



Function Main: Integer;
var
  win       : PWindow;
  fontname  : STRPTR;
var  
  signals,
  sigmask   : ULONG;
  running   : boolean;
  rp        : PRastPort;    
  font      : APTR;
  cte       : TTextExtent;
  i         : SWORD;
  imsg      : PIntuiMessage;
begin
  if (GfxBase <> nil) then
  begin
    if (IntuitionBase <> nil) then
    begin
      if (AslBase <> nil) then
      begin
        fontname := get_font_name(AslBase);
        if (fontname <> nil) then
        begin
          if (TTEngineBase <> nil) then
          begin
            win := OpenWindowTags(nil,
            [
              LongInt(WA_Top)        , 25,
              LongInt(WA_Left)       , 0,
              LongInt(WA_Width)      , 640,
              LongInt(WA_Height)     , 210,
              LongInt(WA_CloseGadget), LTRUE,
              LongInt(WA_DragBar)    , LTRUE,
              LongInt(WA_DepthGadget), LTRUE,
              LongInt(WA_IDCMP)      , IDCMP_CLOSEWINDOW,
              LongInt(WA_Title)      , pchar('TT_TextFit() test'),
              TAG_END
            ]);
            If (win <> nil) then
            begin
              running := true;
              rp := win^.RPort;

              Red := ObtainBestPen(win^.WScreen^.ViewPort.ColorMap,
                              201, 0, 0, [LongInt(OBP_Precision), PRECISION_IMAGE, TAG_END]);

              font := TT_OpenFont(
              [
                TT_FontFile, ULONG(fontname),
                TT_FontSize, 16,
                TAG_END
              ]);
              if (font <> nil) then
              begin
                cte.te_Width        := 32767;
                cte.te_Height       := 32767;
                cte.te_Extent.MinX  := -10;
                cte.te_Extent.MinY  := -20;
                cte.te_Extent.MaxX  := 600;
                cte.te_Extent.MaxY  := 20;

                If (TT_SetFont(rp, font) <> 0) then
                begin
                  TT_SetAttrs(rp,
                  [
                    TT_Window     , ULONG(win),
                    TT_Antialias  , TT_Antialias_On,
                    TAG_END
                  ]);

                  SetDrMd(rp, JAM1);
                  for i := 0 to 100-1 do
                  begin
                    fitted_text('TT_TextFit() example shows how the text is fitted into constraining rectangle.', 45, rp, @cte);
                    cte.te_Extent.MaxX := cte.te_Extent.MaxX - 5;
                    DOSDelay(10);
                    EraseRect(rp, win^.BorderLeft, win^.BorderTop,
                              win^.Width - win^.BorderRight, win^.Height - win^.BorderBottom);
                  end;
                end
                else Writeln('TT_SetFont() failed.');
                TT_CloseFont(font);
              end
              else writeln('Font open failed.');

              sigmask := SIGBREAKF_CTRL_C or (1 shl win^.UserPort^.mp_SigBit);

              while (running) do
              begin
                signals := Wait(sigmask);
                if ((signals and SIGBREAKF_CTRL_C) <> 0) then running := FALSE;
                if ((signals and (1 shl win^.UserPort^.mp_SigBit)) <> 0) then
                begin
                  imsg := PIntuiMessage(GetMsg(win^.UserPort));
                  while (imsg <> nil) do
                  begin
                    if (imsg^.IClass = IDCMP_CLOSEWINDOW) then running := false;
                    ReplyMsg(pMessage(imsg));
                    imsg := PIntuiMessage(GetMsg(win^.UserPort));
                  end;
                end;
              end;

              ReleasePen(win^.WScreen^.ViewPort.ColorMap, Red);
              TT_DoneRastPort(win^.RPort);
              CloseWindow(win);
            end
            else writeln('failed to open window');
            // CloseLibrary(TTEngineBase);
          end
          else writeln('failed to open ttengine library');
          free_font_name(fontname);
        end;
        // CloseLibrary(AslBase);
      end;
      // CloseLibrary(IntuitionBase);
    end;
    // CloseLibrary(GfxBase);
  end;

  result := 0;
end;



begin
  writeln('enter');
  exitcode := Main;
  writeln('leave');
end.

Example: Render custom encoded text

Example that shows how to render a font using custom encoded text. 


program custenc;

{$MODE OBJFPC}{$H+}

(*
  Pascalized version of custenc.c, part of ttengine library examples
*)

Uses
  exec,
  amigados,
  agraphics,
  intuition,
  asl,
  aros_ttengine,
  sysutils;


Type
  PUWORD    = ^Word;


Var
  CustomEncodingTable : Array[0..256-1] of UWORD;



function get_font_name(aslbase: pLibrary): STRPTR;
var
  freq      : PFileRequester;
  name      : STRPTR;
  namelen   : ULONG;
begin
  freq := AllocAslRequest(ASL_FileRequest, [TAG_END]);
  if (freq <> nil) then
  begin
    if AslRequest(freq,
    [
      LongInt(ASLFR_TitleText      ), pchar('Select TrueType font'),
      LongInt(ASLFR_InitialDrawer  ), pchar('FONTS:'),
      LongInt(ASLFR_DoPatterns     ), TRUE,
      LongInt(ASLFR_InitialPattern ), pchar('#?.ttf'),
      LongInt(ASLFR_RejectIcons    ), TRUE,
      TAG_END
    ]) then
    begin
      namelen := strlen(freq^.rf_File) + strlen(freq^.rf_Dir) + 4;
      
      name := AllocVec(namelen + 1, MEMF_ANY or MEMF_CLEAR);
      if (name <> nil) then
      begin
        strlcopy(name, freq^.rf_dir, namelen);
        AddPart(name, freq^.rf_File, namelen);
        // writeln('name = ', name);
      end;
    end;
    FreeAslRequest(freq);
  end;
  result := name;
end;



procedure free_font_name(name: STRPTR);
begin
  if (name <> nil) then FreeVec(name);
end;



procedure fill_table(table: PUWORD);
var i: word;
begin
  for i := 0 to pred(256) do
  begin
    CustomEncodingTable[i] := i xor $0015;
  end;
end;



Function Main: Integer;
var
  win       : PWindow;
  fontname  : STRPTR;
  font      : APTR;
Var  
  imsg      : PIntuiMessage;
  rp        : PRastPort;
  sigmask, 
  signals   : ULONG;               // ULONG sigmask, signals;
  running   : boolean;
begin
  if (GfxBase <> nil) then
  begin
    if (IntuitionBase <> nil) then
    begin
      if (AslBase <> nil) then
      begin
        fontname := get_font_name(AslBase);
        if (fontname <> nil) then
        begin
          if (TTEngineBase <> nil) then
          begin
            writeln('filling table');
            fill_table(CustomEncodingTable);
            writeln('trying to open window');
            win := OpenWindowTags(nil,
            [
              LongInt(WA_Top)        , 25,
              LongInt(WA_Left)       , 0,
              LongInt(WA_Width)      , 640,
              LongInt(WA_Height)     , 210,
              LongInt(WA_CloseGadget), TRUE,
              LongInt(WA_DragBar)    , TRUE,
              LongInt(WA_DepthGadget), TRUE,
              LongInt(WA_IDCMP)      , IDCMP_CLOSEWINDOW,
              LongInt(WA_Title)      , pchar('Custom encoding test'),
              TAG_END
            ]);
            If (win <> nil) then
            begin
              running := true;
              rp := win^.RPort;
              font := TT_OpenFont(
              [
                TT_FontFile, fontname,
                TT_FontSize, 18,
                TAG_END
              ]);
              if (font <> nil) then
              begin
                If (TT_SetFont(rp, font) <> 0) then
                begin
                  TT_SetAttrs(rp,
                  [
                    TT_Window     , win,
                    TT_Antialias  , TT_Antialias_On,
                    TT_Encoding   , TT_Encoding_ISO8859_1,
                    TAG_END                  
                  ]);
                
                  SetDrMd(rp, JAM1);
                  SetAPen(rp, 1);
                  
                  //* alphabet in ISO-8859-1 */
                  GfxMove(rp, 10, 40);
                  TT_Text (rp, pchar('ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz'), 53);
                  
                  //* turn our weird encoding on, also set some Unicode encoding */
                  //* just to check if custom overrides it as it should */                  

                  TT_SetAttrs(rp,
                  [
                    TT_CustomEncoding , ULONG(@CustomEncodingTable),
                    TT_Encoding       , TT_Encoding_UTF32_BE,              //* will be overriden */
                    TAG_END
                  ]);
                  
                  GfxMove(rp, 10, 58);
                  TT_Text(rp, pchar('ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz'), 54);
                end
                else Writeln('TT_SetFont() failed.');
                TT_CloseFont(font);
              end
              else writeln('Font open failed.');

              sigmask := SIGBREAKF_CTRL_C or (1 shl win^.UserPort^.mp_SigBit);
              while (running) do
              begin
                signals := Wait(sigmask);
                if ((signals or SIGBREAKF_CTRL_C) <> 0) then running := FALSE;
                if ((signals and (1 shl win^.UserPort^.mp_SigBit)) <> 0) then
                begin
                  imsg := PIntuiMessage(GetMsg(win^.UserPort));
                  while (imsg <> nil) do
                  begin
                    if (imsg^.IClass = IDCMP_CLOSEWINDOW) then running := false;
                    ReplyMsg(pMessage(imsg));
                    imsg := PIntuiMessage(GetMsg(win^.UserPort));
                  end;
                end;
              end;

              TT_DoneRastPort(win^.RPort);
              CloseWindow(win);
            end
            else writeln('failed to open window');
            // CloseLibrary(TTEngineBase);
          end
          else writeln('failed to open ttengine library');
          free_font_name(fontname);
        end;
        // CloseLibrary(AslBase);
      end;
      // CloseLibrary(IntuitionBase);
    end;
    // CloseLibrary(GfxBase);
  end;

  result := 0;
end;



begin
  writeln('enter');
  exitcode := Main;
  writeln('leave');
end.

Example: Measure speed of different render-attributes and draw-modes

Title says it all :-) 


program speed;

{$MODE OBJFPC}{$H+}

(*
  Pascalized version of speed.c, part of ttengine library examples
*)

Uses
  exec,
  amigados,
  intuition,
  agraphics,
  aros_ttengine,
  asl,
  timer,
  math,
  sysutils;


Type
  SWord = SmallInt;
  SLong = LongInt;


Var
  EClock : SLONG;



function get_font_name(aslbase: pLibrary): STRPTR;
var
  freq      : PFileRequester;
  name      : STRPTR;
  namelen   : ULONG;
begin
  freq := AllocAslRequest(ASL_FileRequest, [TAG_END]);
  if (freq <> nil) then
  begin
    if AslRequest(freq,
    [
      LongInt(ASLFR_TitleText      ), pchar('Select TrueType font'),
      LongInt(ASLFR_InitialDrawer  ), pchar('FONTS:'),
      LongInt(ASLFR_DoPatterns     ), LTRUE,
      LongInt(ASLFR_InitialPattern ), pchar('#?.ttf'),
      LongInt(ASLFR_RejectIcons    ), LTRUE,
      TAG_END
    ]) then
    begin
      namelen := strlen(freq^.rf_File) + strlen(freq^.rf_Dir) + 4;
      
      name := AllocVec(namelen + 1, MEMF_ANY or MEMF_CLEAR);
      if (name <> nil) then
      begin
        strlcopy(name, freq^.rf_dir, namelen);
        AddPart(name, freq^.rf_File, namelen);
        // writeln('name = ', name);
      end;
    end;
    FreeAslRequest(freq);
  end;
  result := name;
end;



procedure free_font_name(name: STRPTR);
begin
  if (name <> nil) then FreeVec(name);
end;



procedure test_loop(rp: PRastPort);
var
  a, b: SWORD;
  {$IFDEF AROS}
  start, stop: Ttimeval;
  {$ELSE}
  start, stop: TEclockVal;
  {$ENDIF}
  speed: SLONG;
begin
  forbid;

  {$IFDEF AROS}
  GetSysTime(@start);
  {$ELSE}
  ReadEClock(@start);
  {$ENDIF}
  a := 10;
  while (a < 410) do
  begin
    SetAPen(rp, a shr 3);
    SetBPen(rp, not(a shr 3));
    b := 40;
    while (b < 440) do
    begin
      GfxMove(rp, a, b);
      TT_Text(rp, pchar('speed test'), 10);
      b := b + 16;
    end;
    a := a + 10;
  end;
  
  {$IFDEF AROS}
  GetSysTime(@stop);
  {$ELSE}
  ReadEClock(@stop);
  {$ENDIF}
  
  Permit();

  {$IFDEF AROS}
  SubTime(@stop, @start);
  speed := Round((10000.0 / ((stop.tv_secs) + (stop.tv_micro / 1000000.0))));
  {$ELSE}
  if (stop.ev_lo < start.ev_lo) 
  then stop.ev_lo := not (start.ev_lo - stop.ev_lo);
  else stop.ev_lo := stop.ev_lo - start.ev_lo;
  speed = IEEESPFix(IEEESPDiv(IEEESPMul(IEEESPFlt(10000), IEEESPFlt(EClock)), IEEESPFlt(stop.ev_lo)));
  {$ENDIF}

  Writeln(format('%d glyphs per second.', [speed]));
end;



var
   MathIeeeSingBasBase : pointer;



Function Main: Integer;
var
  win       : PWindow;
  fontname  : STRPTR;
  font      : APTR;
var
  sigmask, 
  signals   : ULONG;
  running   : boolean;
  rp        : PRastPort;
  req       : Ttimerequest;
  ev        : TEClockVal;
  imsg      : PIntuiMessage;
begin
  if (GfxBase <> nil) then
  begin
    if (IntuitionBase <> nil) then
    begin
      if (AslBase <> nil) then
      begin
        fontname := get_font_name(AslBase);
        if (fontname <> nil) then
        begin
          if (TTEngineBase <> nil) then
          begin
            win := OpenWindowTags(nil,
            [
              LongInt(WA_Top)        , 25,
              LongInt(WA_Left)       , 0,
              LongInt(WA_Width)      , 640,
              LongInt(WA_Height)     , 480,
              LongInt(WA_CloseGadget), LTRUE,
              LongInt(WA_DragBar)    , LTRUE,
              LongInt(WA_DepthGadget), LTRUE,
              LongInt(WA_IDCMP)      , IDCMP_CLOSEWINDOW,
              LongInt(WA_Title)      , pchar('ttengine library speed test'),
              TAG_END
            ]);
            If (win <> nil) then
            begin
              running := true;

              rp := win^.RPort;
              font := TT_OpenFont(
              [
                TT_FontFile, ULONG(fontname),
                TT_FontSize, 16,
                TAG_END
              ]);
              if font <> nil then
              begin
                MathIeeeSingBasBase := OpenLibrary('mathieeesingbas.library', 37);
              
                if (MathIeeeSingBasBase <> nil) then
                begin

				  {$IFDEF AROS}
				  req.tr_node.io_Message.mn_Length := sizeof(req);
                  if (OpenDevice ('timer.device', UNIT_VBLANK, PIORequest(@req), 0) = 0) then
				  {$ELSE}
                  if (OpenDevice ('timer.device', UNIT_ECLOCK, PIORequest(@req), 0) = 0) then
				  {$ENDIF}
                  begin

                    TimerBase := PLibrary(req.tr_node.io_Device);
                    EClock := ReadEClock(@ev);

                    Writeln(format('E clock will be used for measurements, frequency is %d Hz.', [EClock]));

                    If (TT_SetFont(rp, font) <> 0) then
                    begin
                      TT_SetAttrs(rp,
                      [
                        TT_Window     , win,
                        TT_Antialias  , TT_Antialias_Off,
                        TAG_END                  
                      ]);

                      SetDrMd(rp, JAM1);
                      writeln('Antialias: OFF, mode: JAM1');
                      test_loop(rp);
                      EraseRect(rp, win^.BorderLeft, win^.BorderTop, win^.Width - win^.BorderRight - 1, win^.Height - win^.BorderBottom - 1);

                      TT_SetAttrs(rp, [TT_Antialias  , TT_Antialias_On, TAG_END]);
                      writeln('Antialias: ON, mode: JAM1');
                      test_loop(rp);
                      EraseRect(rp, win^.BorderLeft, win^.BorderTop, win^.Width - win^.BorderRight - 1, win^.Height - win^.BorderBottom - 1);

                      SetDrMd(rp, JAM2);
                      writeln('Antialias: ON, mode: JAM2');
                      test_loop(rp);
                      EraseRect(rp, win^.BorderLeft, win^.BorderTop, win^.Width - win^.BorderRight - 1, win^.Height - win^.BorderBottom - 1);

                      TT_SetAttrs(rp, [TT_Antialias  , TT_Antialias_Off, TAG_END]);
                      writeln('Antialias: OFF, mode: JAM2');
                      test_loop(rp);
                      EraseRect(rp, win^.BorderLeft, win^.BorderTop, win^.Width - win^.BorderRight - 1, win^.Height - win^.BorderBottom - 1);
                    end
                    else Writeln('TT_SetFont() failed.');
                    CloseDevice(PIORequest(@req));
                  end;
                  CloseLibrary(MathIeeeSingBasBase);
                end;
                TT_CloseFont(font);
              end
              else writeln('Font open failed.');

              sigmask := SIGBREAKF_CTRL_C or (1 shl win^.UserPort^.mp_SigBit);
              while (running) do
              begin
                signals := Wait(sigmask);
                if ((signals or SIGBREAKF_CTRL_C) <> 0) then running := FALSE;
                if ((signals and (1 shl win^.UserPort^.mp_SigBit)) <> 0) then
                begin
                  imsg := PIntuiMessage(GetMsg(win^.UserPort));
                  while (imsg <> nil) do
                  begin
                    if (imsg^.IClass = IDCMP_CLOSEWINDOW) then running := false;
                    ReplyMsg(pMessage(imsg));
                    imsg := PIntuiMessage(GetMsg(win^.UserPort));
                  end;
                end;
              end;  // while running

              TT_DoneRastPort(win^.RPort);
              CloseWindow(win);
            end
            else writeln('failed to open window');
            // CloseLibrary(TTEngineBase);
          end
          else writeln('failed to open ttengine library');
          free_font_name(fontname);
        end;
        // CloseLibrary(AslBase);
      end;
      // CloseLibrary(IntuitionBase);
    end;
    // CloseLibrary(GfxBase);
  end;

  result := 0;
end;



begin
  writeln('enter');
  exitcode := Main;
  writeln('leave');
end.

Example: Rendering bitmap

Example that shows how to let ttengine render text into a bitmap for post processing. The bitmap is shown using cybergraphics functionality. 


program postprocess;

{$MODE OBJFPC}{$H+}

(*
  Pascalized version of postprocess.c, part of ttengine library examples
*)

Uses
  exec,
  amigados,
  agraphics,
  intuition,
  asl,
  aros_ttengine,
  cybergraphics,  
  sysutils;


Type
  SWORD = SmallInt;



function get_font_name(aslbase: pLibrary): STRPTR;
var
  freq      : PFileRequester;
  name      : STRPTR;
  namelen   : ULONG;
begin
  freq := AllocAslRequest(ASL_FileRequest, [TAG_END]);
  if (freq <> nil) then
  begin
    if AslRequest(freq,
    [
      LongInt(ASLFR_TitleText      ), pchar('Select TrueType font'),
      LongInt(ASLFR_InitialDrawer  ), pchar('FONTS:'),
      LongInt(ASLFR_DoPatterns     ), TRUE,
      LongInt(ASLFR_InitialPattern ), pchar('#?.ttf'),
      LongInt(ASLFR_RejectIcons    ), TRUE,
      TAG_END
    ]) then
    begin
      namelen := strlen(freq^.rf_File) + strlen(freq^.rf_Dir) + 4;
      
      name := AllocVec(namelen + 1, MEMF_ANY or MEMF_CLEAR);
      if (name <> nil) then
      begin
        strlcopy(name, freq^.rf_dir, namelen);
        AddPart(name, freq^.rf_File, namelen);
        // writeln('name = ', name);
      end;
    end;
    FreeAslRequest(freq);
  end;
  result := name;
end;



procedure free_font_name(name: STRPTR);
begin
  if (name <> nil) then FreeVec(name);
end;



Function Main: Integer;
var
  win       : PWindow;
  fontname  : STRPTR;
  font      : APTR;
var  
  px        : PTT_Pixmap;
  signals, 
  sigmask   : ULONG;
  running   : boolean;
  xi, yi    : SWORD;
  imsg      : PIntuiMessage;
begin
  if (GfxBase <> nil) then
  begin
    if (IntuitionBase <> nil) then
    begin
      if (AslBase <> nil) then
      begin
        fontname := get_font_name(AslBase);
        if (fontname <> nil) then
        begin
          if (TTEngineBase <> nil) then
          begin
            font := TT_OpenFont(
            [
              TT_FontFile, ULONG(fontname),
              TT_FontSize, 20,
              TAG_END
            ]);
            if (font <> nil) then
            begin
              px := TT_GetPixmap(font, pchar('Postprocessed pixmap'), 20,
              [
                TT_Antialias, TT_Antialias_On,
                TAG_END
              ]);
              if (px <> nil) then
              begin
                writeln(format('Pixmap $%p, %d x %d', [px, px^.ttp_Width, px^.ttp_Height]));

                win := OpenWindowTags(nil,
                [
                  LongInt(WA_Top)        , 25,
                  LongInt(WA_Left)       , 0,
                  LongInt(WA_InnerWidth) , px^.ttp_Width * 3,
                  LongInt(WA_InnerHeight), px^.ttp_Height * 3,
                  LongInt(WA_CloseGadget), LTRUE,
                  LongInt(WA_DragBar)    , LTRUE,
                  LongInt(WA_DepthGadget), LTRUE,
                  LongInt(WA_IDCMP)      , IDCMP_CLOSEWINDOW,
                  LongInt(WA_Title)      , pchar('Postprocessing demo'),
                  TAG_END
                ]);
                If (win <> nil) then
                begin
                  running := TRUE;

                  //* rendering processed pixelmap, it will be magnified */
                  //* with factor 3 */
                  if (CyberGfxBase <> nil) then
                  begin
                  
                    for xi := 0 to (px^.ttp_Width -1) do
                    begin
                      for yi := 0 to (px^.ttp_Height-1) 
                      do FillPixelArray(win^.RPort, win^.BorderLeft + xi * 3, win^.BorderTop + yi * 3, 3, 3,
                                               px^.ttp_Data^[xi + yi * px^.ttp_Width] * $00010101);
                    end;
                    // CloseLibrary(CyberGfxBase);                  
                  end
                  else Writeln('Program requires CyberGraphX or Picasso96');

                  sigmask := SIGBREAKF_CTRL_C or (1 shl win^.UserPort^.mp_SigBit);
                  while (running) do
                  begin
                    signals := Wait(sigmask);
                    if ((signals or SIGBREAKF_CTRL_C) <> 0) then running := FALSE;
                    if ((signals and (1 shl win^.UserPort^.mp_SigBit)) <> 0) then
                    begin
                      imsg := PIntuiMessage(GetMsg(win^.UserPort));
                      while (imsg <> nil) do
                      begin
                        if (imsg^.IClass = IDCMP_CLOSEWINDOW) then running := false;
                        ReplyMsg(pMessage(imsg));
                        imsg := PIntuiMessage(GetMsg(win^.UserPort));
                      end;
                    end;
                  end;  // while running

                  CloseWindow(win);
                end
                else writeln('failed to open window');
                TT_FreePixMap(px);
              end;
            end
            else writeln('Font open failed.');
            CloseLibrary(TTEngineBase);
          end
          else writeln('failed to open ttengine library');
          free_font_name(fontname);
        end;
        // CloseLibrary(AslBase);
      end;
      // CloseLibrary(IntuitionBase);
    end;
    // CloseLibrary(GfxBase);
  end;

  result := 0;
end;
                               


begin
  writeln('enter');
  exitcode := Main;
  writeln('leave');
end.

Example: Rendering text on background picture

Example that shows how to render text on a background picture.

Note that this example uses unit aros_datatypes. I've put together a fast quick 'n' dirty datatype.library header unit as there wasn't one available for AROS (yet), but i haven't posted this unit, ergo the example will be useless for most. 


program background;

{$MODE OBJFPC}{$H+}

(*
  Pascalized version of background.c, part of ttengine library examples
*)

Uses
  exec,
  amigados,
  agraphics,
  intuition,
  asl,
  aros_datatypes,
  aros_ttengine,
  sysutils;


Type
  SWORD = SmallInt;


Function SetAndTest(var a: Pointer; b: Pointer): boolean; inline;
begin
  a := b;
  result := (a <> nil);
end;



Var
  PicBitMap : PBitMap;
  Picture   : PObject_;



function get_font_name(aslbase: pLibrary): STRPTR;
var
  freq      : PFileRequester;
  name      : STRPTR = nil;
  namelen   : ULONG;
begin
  freq := AllocAslRequest(ASL_FileRequest, [TAG_END]);
  if (freq <> nil) then
  begin
    if AslRequest(freq,
    [
      LongInt(ASLFR_TitleText      ), pchar('Select TrueType font'),
      LongInt(ASLFR_InitialDrawer  ), pchar('FONTS:'),
      LongInt(ASLFR_DoPatterns     ), TRUE,
      LongInt(ASLFR_InitialPattern ), pchar('#?.ttf'),
      LongInt(ASLFR_RejectIcons    ), TRUE,
      TAG_END
    ]) then
    begin
      namelen := strlen(freq^.rf_File) + strlen(freq^.rf_Dir) + 4;
      
      name := AllocVec(namelen + 1, MEMF_ANY or MEMF_CLEAR);
      if (name <> nil) then
      begin
        strlcopy(name, freq^.rf_dir, namelen);
        AddPart(name, freq^.rf_File, namelen);
        // writeln('name = ', name);
      end;
    end;
    FreeAslRequest(freq);
  end;
  result := name;
end;



procedure free_font_name(name: STRPTR);
begin
  if (name <> nil) then FreeVec(name);
end;



procedure ctext(w: PWindow; text: STRPTR; y: ULONG);
var
  t1, b1 : UWORD;
  rp : PRastPort;
begin
  rp := w^.RPort;
  
  t1 := strlen(text);
  b1 := TT_TextLength(rp, text, t1);
  GfxMove(rp, ((448 - b1) shr 1) + w^.BorderLeft, y);
  TT_text(rp, text, t1);
end;



function init(): Boolean;
begin
  if (GfxBase       = nil) then exit(false);
  if (IntuitionBase = nil) then exit(false);
  if (ASLBase       = nil) then exit(false);
  if (TTEngineBase  = nil) then exit(false);
  if (DataTypesBase = nil) then exit(false);
  result := true;
end;



procedure cleanup();
begin
  (*
    if (DataTypesBase) CloseLibrary(DataTypesBase);
    if (TTEngineBase) CloseLibrary(TTEngineBase);
    if (AslBase) CloseLibrary(AslBase);
    if (IntuitionBase) CloseLibrary(IntuitionBase);
    if (GfxBase) CloseLibrary(GfxBase);
    return;
  *)
end;



procedure load_picture(w: PWindow);
begin
  Picture := NewDTObject(pchar('PROGDIR:picture'),
  [
    (DTA_GroupID)    , GID_PICTURE,
    (PDTA_Remap)     , LTRUE,
    (PDTA_DestMode)  , PMODE_V43,
    (PDTA_Screen)    , ULONG(w^.WScreen),
    TAG_END
  ]);
  if (picture <> nil) then
  begin
    //DoDTMethod(Picture, nil, nil, [DTM_PROCLAYOUT, Nil, DTSIF_NEWSIZE]);
    DoDTMethod(Picture, nil, nil, [DTM_PROCLAYOUT, 0, DTSIF_NEWSIZE]);    
    GetDTAttrs(Picture, [PDTA_DestBitMap, ULONG(@PicBitMap), TAG_END]);
  end;
end;



Function Main: Integer;
var
  win       : PWindow;
  fontname  : STRPTR;
  font      : APTR;
var
  sigmask, 
  signals, 
  pen       : ULONG;
  running   : boolean;  
  rp        : PRastPort;
  cnt       : SWORD;
  r, g, b, 
  icl       : ULONG;  
  imsg      : PIntuiMessage;
begin
  if (init()) then
  begin
    fontname := get_font_name(AslBase);
    
    If (FontName <> nil) then
    begin
      win := OpenWindowTags(nil,
      [
              LongInt(WA_Top)        , 25,
              LongInt(WA_Left)       , 0,
              LongInt(WA_InnerWidth) , 448,
              LongInt(WA_InnerHeight), 262,
              LongInt(WA_CloseGadget), LTRUE,
              LongInt(WA_DragBar)    , LTRUE,
              LongInt(WA_DepthGadget), LTRUE,
              LongInt(WA_Activate)   , LTRUE,
              LongInt(WA_IDCMP)      , (IDCMP_CLOSEWINDOW or IDCMP_INTUITICKS),
              LongInt(WA_Title)      , pchar('TTEngine font picture demo'),
              TAG_END
      ]);

      If (win <> nil) then
      begin
        running := true;
        rp := win^.RPort;
        cnt := 0;
        r := 0; g := $7FFFFFFF; b := $FFFFFFFF;

        load_picture(win);

        font := TT_OpenFont(
        [
          TT_FontFile, ULONG(fontname),
          TT_FontSize, 26,
          TAG_END        
        ]);
        
        if (font <> nil) then
        begin
          SetDrMd(rp, JAM1);

          if (TT_SetFont(rp, font) <> 0) then
          begin
            sigmask := SIGBREAKF_CTRL_C or (1 shl win^.UserPort^.mp_SigBit);
            while (running) do
            begin
              signals := Wait(sigmask);
              if ((signals and SIGBREAKF_CTRL_C) <> 0) then running := FALSE;
              if ((signals and (1 shl win^.UserPort^.mp_SigBit)) <> 0) then
              begin
                while SetAndTest(imsg, GetMsg(win^.UserPort)) do
                begin
                  icl := imsg^.IClass;
                  ReplyMsg(pMessage(imsg));
                  
                  if (icl = IDCMP_CLOSEWINDOW) then running := false;
                  if running = false then writeln('running states is false');

                  if (icl = IDCMP_INTUITICKS) then
                  begin
                    inc(cnt);
                    if (cnt > 9) then
                    begin
                      if (PicBitMap <> nil) 
                      then BltBitMapRastPort(PicBitMap, 0, 0, rp, win^.BorderLeft, win^.BorderTop, 448, 262, $C0);

                      cnt := 0;
                      r := r + $0817736F;
                      g := g + $0A27E836;
                      b := b + $0C3A47D4;

                      //pen := ObtainBestPen(win^.WScreen^.ViewPort.ColorMap, r, g, b, [TAG_END]);
                      //pen := ObtainBestPen(win^.WScreen^.ViewPort.ColorMap, r, g, b, [TAG_END, TAG_END]);
                      pen := ObtainBestPenA(win^.WScreen^.ViewPort.ColorMap, r, g, b, nil);

                      SetAPen(rp, pen);
                    
                      TT_SetAttrs(rp, 
                      [
                        LongInt(TT_Window)   , ULONG(win),
                        LongInt(TT_Antialias), TT_Antialias_On,
                        TT_Transparency      , 0,
                        TAG_END
                      ]);

                      ctext(win, 'You can see here how the text is', 40);
                      ctext(win, 'smoothed on background picture.', 66);
                      
                      TT_SetAttrs(rp,
                      [
                        TT_Antialias, TT_Antialias_Off,
                        TAG_END
                      ]);
                      
                      ctext(win, 'This text is not smoothed', 102);
                      ctext(win, 'The difference is clearly', 128);
                      ctext(win, 'visible.', 154);
                      
                      TT_SetAttrs(rp,
                      [
                        TT_Antialias, TT_Antialias_On,
                        TT_Transparency, 64,
                        TAG_END
                      ]);
                      
                      ctext(win, 'transparent text (75%)', 190);
                      
                      TT_SetAttrs(rp,
                      [
                        TT_Transparency, 128,
                        TAG_END
                      ]);
                      
                      ctext(win, 'transparent text (50%)', 216);
                      
                      TT_SetAttrs(rp,
                      [
                        TT_Transparency, 192,
                        TAG_END
                      ]);
                      
                      ctext(win, 'transparent text (25%)', 242);
                      
                      ReleasePen(win^.WScreen^.ViewPort.ColorMap, pen);
                    end;
                  end;
                  //imsg := PIntuiMessage(GetMsg(win^.UserPort));
                end;  // while imsg
              end;
            end; // while running
          end
          else writeln('TT_Setfont() failed.');

          TT_CloseFont(font);
        end
        else writeln('Font open failed.');

        TT_DoneRastPort(rp);
        CloseWindow(win);
      end
      else writeln('Window open failed.');
      free_font_name(fontname);
    end
    else writeln('Fontname (requester) open failed');
  end
  else writeln('initialization failed');

  cleanup;
  result := 0;
end;



begin
  writeln('enter');
  exitcode := Main;
  writeln('leave');
end.

Example: ( insert example title )

There's no example available.


The unit

Please note that this unit uses Experimental_Tags. 

unit aros_ttengine;

{$MODE OBJFPC}{$H+}

{
  ttengine.library
}

interface

uses
  exec, agraphics,
  sysutils;  { for PByteArray }


type
//  pvoid             = pointer;  
//  STRPTR            = pchar;
  PSTRPTR           = ^STRPTR;

//
//  ttengine-7.2-aros-i386\Developer\include\libraries\ttengine.h
//  
Const
  TTENGINENAME                  = 'ttengine.library';
  TTENGINEVERSION               = 7;
  TTENGINEMINVERSION            = 6;


  //* Tags */

  //* Tags applicability legend: */
  //* O - TT_OpenFont() */
  //* G - TT_GetAttrs() */
  //* S - TT_SetAttrs() */
  //* P - TT_GetPixmap() */

  //* ---- name -------------------- value ----- applicability */

  TT_FontFile                   = $6EDA0000;    //* OG.. */
        
  TT_FontStyle                  = $6EDA0001;    //* OG.. */
        
  TT_FontStyle_Regular          = 0;
  TT_FontStyle_Italic           = 1;
        
  TT_FamilyTable                = $6EDA0002;    //* O... */
  TT_FontSize                   = $6EDA0003;    //* OG.. */
        
  TT_FontWeight                 = $6EDA0004;    //* OG.. */
        
  TT_FontWeight_Normal          = 400;
  TT_FontWeight_Bold            = 700;
        
  TT_ColorMap                   = $6EDA0005;    //* O... */
  TT_Screen                     = $6EDA0006;    //* O... */
  TT_Window                     = $6EDA0007;    //* O... */
  TT_FontAscender               = $6EDA0008;    //* .G.. */
  TT_FontDescender              = $6EDA0009;    //* .G.. */
        
  TT_Antialias                  = $6EDA000F;    //* .GSP */
        
  TT_Antialias_Auto             = 0;
  TT_Antialias_Off              = 1;
  TT_Antialias_On               = 2;
        
  TT_Encoding                   = $6EDA0010;    //* .GSP */

  //* All encoding numbers (excluding TT_Encoding_Default) are equal to IANA */
  //* registered encoding numbers                                            */

  TT_Encoding_Default           =   0;          //* use ENV:ttfcodepage or ISO-8859-1 if not found */
  TT_Encoding_ISO8859_1         =   4;          //* Western Europe and US */
  TT_Encoding_ISO8859_2         =   5;          //* Eastern Europe */
  TT_Encoding_ISO8859_3         =   6;
  TT_Encoding_ISO8859_4         =   7;
  TT_Encoding_ISO8859_5         =   8;
  TT_Encoding_ISO8859_6         =   9;
  TT_Encoding_ISO8859_7         =  10;
  TT_Encoding_ISO8859_8         =  11;
  TT_Encoding_ISO8859_9         =  12;
  TT_Encoding_ISO8859_10        =  13;
  TT_Encoding_ISO8859_11        =  14;
  TT_Encoding_ISO8859_13        =  109;
  TT_Encoding_ISO8859_14        =  110;
  TT_Encoding_ISO8859_15        =  111;
  TT_Encoding_ISO8859_16        =  112;
  TT_Encoding_UTF16_BE          = 1013;
  TT_Encoding_UTF32_BE          = 1018;
  TT_Encoding_UTF8              =  106;
  TT_Encoding_UTF16_LE          = 1014;
  TT_Encoding_UTF32_LE          = 1019;
  TT_Encoding_UTF16             = 1015;
  TT_Encoding_UTF32             = 1017;


  TT_FontName                   = $6EDA0011;    //* .G.. */
  TT_FamilyName                 = $6EDA0012;    //* .G.. */
  TT_SubfamilyName              = $6EDA0013;    //* .G.. */
  TT_Transparency               = $6EDA0014;    //* .GS.  from 0 to 255 */
  TT_ScaleX                     = $6EDA0015;    //* O.SP  16.16 scaled integer */

  TT_SoftStyle                  = $6EDA0017;    //* ..SP (V5) */


  TT_SoftStyle_None             = $0000;
  TT_SoftStyle_Underlined       = $0001;
  TT_SoftStyle_DblUnderlined    = $0002;
  TT_SoftStyle_Overstriked      = $0004;
  TT_SoftStyle_DblOverstriked   = $0008;
  
  
  TT_Foreground                 = $6EDA0018;    //* ..S.  foreground RGB value*/
  
  TT_Foreground_UseRastPort     = $FFFFFFFF;
  
  TT_Background                 = $6EDA0019;    //* ..S.  background RGB value*/
  
  TT_Background_UseRastPort     = $FFFFFFFF;
  
  TT_FontMaxTop                 = $6EDA001E;    //* .G.. */
  TT_FontMaxBottom              = $6EDA001F;    //* .G.. */
  TT_FontDesignHeight           = $6EDA0020;    //* .G.. */
  TT_FontRealAscender           = $6EDA0021;    //* .G.. */
  TT_FontRealDescender          = $6EDA0022;    //* .G.. */
  TT_FontAccentedAscender       = $6EDA0023;    //* .G.. */
  TT_CustomEncoding             = $6EDA0024;    //* ..SP */
  TT_Gamma                      = $6EDA0025;    //* .GS. */  /* gettable from V7.2 */
        
  TT_FontBaseline               = TT_FontMaxTop;//* V6.7 */
        
  TT_FontFixedWidth             = $6EDA0026;    //* OG.. */  /* V6.7 */
  TT_FontHeight                 = $6EDA0027;    //* .G.. */  /* V6.7 */
  TT_FontWidth                  = $6EDA0028;    //* .G.. */  /* V6.7 */
  TT_DiskFontMetrics            = $6EDA0029;    //* ..SP */  /* V6.7 */
  TT_ForceFixedWidth            = $6EDA0030;    //* ..SP */  /* V7.2 */

Type
  //* Structure returned by TT_GetPixmap() (V5)*/
  PTT_Pixmap = ^TT_Pixmap;
  TT_Pixmap = record
    ttp_Size    : ULONG;                        //* size of the structure includung this field */
    ttp_Width   : ULONG;                        //* number of rows */
    ttp_Height  : ULONG;                        //* also equal to bytes per row */
    ttp_Data    : PByteArray;                   // PUBYTE //* grayscale pixmap data */ 
  end;
  
Const
  //* font requester attributes (V6) */
                                                //* type,             default value     */
  TTRQ_Window                   = $6EDA2000;    //* struct Window*,   NULL              */
  TTRQ_PubScreenName            = $6EDA2001;    //* STRPTR,           NULL [Workbench]  */
  TTRQ_Screen                   = $6EDA2002;    //* struct Screen*,   NULL              */
  TTRQ_SleepWindow              = $6EDA2003;    //* BOOL,             FALSE             */
  TTRQ_TitleText                = $6EDA2004;    //* STRPTR,           "Select TrueType font" or localized */
  TTRQ_PositiveText             = $6EDA2005;    //* STRPTR,           "OK" or localized */
  TTRQ_NegativeText             = $6EDA2006;    //* STRPTR,           "Cancel" or localized */
  TTRQ_InitialLeftEdge          = $6EDA2007;    //* WORD,             centered on screen */
  TTRQ_InitialTopEdge           = $6EDA2008;    //* WORD,             centered on screen */
  TTRQ_InitialWidth             = $6EDA2009;    //* WORD,             max(200, 25% of sceeen width) */
  TTRQ_InitialHeight            = $6EDA200A;    //* WORD,             max(200, 50% of screen height) */
  TTRQ_DoSizes                  = $6EDA200B;    //* BOOL,             TRUE              */
  TTRQ_DoWeight                 = $6EDA200C;    //* BOOL,             FALSE             */
  TTRQ_DoStyle                  = $6EDA200D;    //* BOOL,             FALSE             */
  TTRQ_Activate                 = $6EDA200E;    //* BOOL,             TRUE              */
  TTRQ_InitialSize              = $6EDA200F;    //* LONG,             0 [no size]       */
  TTRQ_InitialName              = $6EDA2010;    //* STRPTR,           NULL [no name]    */
  TTRQ_InitialStyle             = $6EDA2011;    //* LONG,             TT_FontStyle_Regular */
  TTRQ_DoPreview                = $6EDA2012;    //* BOOL,             FALSE             */
  TTRQ_FixedWidthOnly           = $6EDA2013;    //* BOOL,             FALSE             */  
  
  
//
//  ttengine-7.2-aros-i386\Developer\include_aros\clib\ttengine_protos.h
//  
  
var
  TTEngineBase : pLibrary;

  Function  TT_OpenFontA(taglist: PTagItem): APTR;                              syscall TTEngineBase 5;
  Function  TT_SetFont(rp: PRastPort; font: APTR): BOOL;                        syscall TTEngineBase 6;
  procedure TT_CloseFont(font: APTR);                                           syscall TTEngineBase 7;
  procedure TT_Text(rp: PRastPort; string_: APTR; count: ULONG);                syscall TTEngineBase 8;
  Function  TT_SetAttrsA(rp: PRastPort; taglist: PTagItem): ULONG;              syscall TTEngineBase 9;
  Function  TT_GetAttrsA(rp: PRastPort; taglist: PTagItem): ULONG;              syscall TTEngineBase 10;
  Function  TT_TextLength(rp: PRastPort; string_: APTR; count: ULONG): ULONG;   syscall TTEngineBase 11;
  Procedure TT_TextExtent(rp: PRastPort; string_: APTR; count: WORD; te: PTextExtent); syscall TTEngineBase 12;
  Function  TT_TextFit(rp: PRastPort; string_: APTR; count: UWORD; te: PTextExtent; tec: PTextExtent; dir: WORD; cwidth: UWORD; cheight: UWORD): ULONG; syscall TTEngineBase 13;

  //*--- functions in V5 or higher ---*/
  Function  TT_GetPixmapA(font: APTR; string_: APTR; count: ULONG; taglist: PTagItem): PTT_Pixmap; syscall TTEngineBase 14;
  Procedure TT_FreePixmap(pixmap: PTT_Pixmap);                                  syscall TTEngineBase 15;
  Procedure TT_DoneRastPort(rp: PRastPort);                                     syscall TTEngineBase 16;
  
  //*--- functions in V6 or higher ---*/
  Function  TT_AllocRequest: APTR;                                              syscall TTEngineBase 17;
  Function  TT_RequestA(request: APTR; taglist: PTagItem): PTagItem;            syscall TTEngineBase 18;
  Procedure TT_FreeRequest(request: APTR);                                      syscall TTEngineBase 19;
  
  //*--- functions in V7 or higher ---*/
  Function  TT_ObtainFamilyListA(taglist: PTagItem): PSTRPTR;                   syscall TTEngineBase 20;
  Procedure TT_FreeFamilyList(list: PSTRPTR);                                   syscall TTEngineBase 21;


  { Pascal varargs versions }
  Function  TT_OpenFont(const Tags: array of const): APTR;
  Function  TT_SetAttrs(rp: PRastPort; const Tags: array of const): ULONG;
  Function  TT_GetAttrs(rp: PRastPort; const Tags: array of const): ULONG;
  Function  TT_GetPixmap(font: APTR; string_: APTR; count: ULONG; const Tags: array of const): PTT_Pixmap;
  Function  TT_Request(request: APTR; const Tags: array of const): PTagItem;
  Function  TT_ObtainFamilyList(const Tags: array of const): PSTRPTR;
  


implementation



Uses
  aros_modern_Tags;


//
//  ttengine-7.2-aros-i386\Developer\include_aros\defines\ttengine.h
//  


Function  TT_OpenFont(const Tags: array of const): APTR;
Var TagItems: TArosTags;
begin
  //TagItems := 0;
  TagItems.Add(Tags);
  Result := TT_OpenFontA(TagItems);
  //TagItems := 0;  
end;


Function  TT_SetAttrs(rp: PRastPort; const Tags: array of const): ULONG;
Var TagItems: TArosTags;
begin
  //TagItems := 0;
  TagItems.Add(Tags);
  Result := TT_SetAttrsA(rp, TagItems);
  //TagItems := 0;
end;


Function  TT_GetAttrs(rp: PRastPort; const Tags: array of const): ULONG;
Var TagItems: TArosTags;
begin
  //TagItems := 0;
  TagItems.Add(Tags);
  Result := TT_GetAttrsA(rp, TagItems);
  //TagItems := 0;
end;


Function  TT_GetPixmap(font: APTR; string_: APTR; count: ULONG; const Tags: array of const): PTT_Pixmap;
Var TagItems: TArosTags;
begin
  //TagItems := 0;
  TagItems.Add(Tags);
  Result := TT_GetPixmapA(font, string_, count, TagItems);
  //TagItems := 0;
end;


Function  TT_Request(request: APTR; const Tags: array of const): PTagItem;
Var TagItems: TArosTags;
begin
  //TagItems := 0;
  TagItems.Add(Tags);
  Result := TT_RequestA(request, TagItems);
  //TagItems := 0;
end;


Function  TT_ObtainFamilyList(const Tags: array of const): PSTRPTR;
Var TagItems: TArosTags;
begin
  //TagItems := 0;
  TagItems.Add(Tags);
  Result := TT_ObtainFamilyListA(TagItems);
  //TagItems := 0;  
end;



Initialization
  TTEngineBase := OpenLibrary(TTENGINENAME, TTENGINEVERSION);


finalization
  CloseLibrary(TTEngineBase);

end.


Unit documentation

Currently there's no Free Pascal specific documentation available for this unit. Please consult the original SDK.

Retrieved from "http://fpcamigawiki.alb42.de/index.php?title=Ttengine.library&oldid=290"