Difference between revisions of "Ttengine.library"
(Added initial content) |
(→Usage: wrong person was being addressed, corrected.) |
||
(12 intermediate revisions by the same user not shown) | |||
Line 30: | Line 30: | ||
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''. | 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 | + | Do note, that creation of the caching file and font database are not mandatory. It simply depends on which functionality programmer's code relies. |
For more information about the caching system and the font database, please refer to the official SDK. | For more information about the caching system and the font database, please refer to the official SDK. | ||
− | |||
== Examples == | == Examples == | ||
Line 473: | Line 472: | ||
− | === Example: ( | + | === 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. | ||
+ | |||
+ | ( Original c-source code is available in the distribution archive of ttengine ) | ||
+ | |||
+ | <source lang="pascal"> | ||
+ | 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. | ||
+ | </source> | ||
+ | |||
+ | |||
+ | === 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. | ||
+ | |||
+ | ( Original c-source code is available in the distribution archive of ttengine ) | ||
<source lang="pascal"> | <source lang="pascal"> | ||
+ | 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. | ||
</source> | </source> | ||
+ | |||
+ | === 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. | ||
+ | |||
+ | ( Original c-source code is available in the distribution archive of ttengine ) | ||
+ | |||
+ | <source lang="pascal"> | ||
+ | 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. | ||
+ | </source> | ||
+ | |||
+ | |||
+ | === 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. | ||
+ | |||
+ | ( Original c-source code is available in the distribution archive of ttengine ) | ||
+ | |||
+ | <source lang="pascal"> | ||
+ | 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. | ||
+ | </source> | ||
+ | |||
+ | |||
+ | === Example: Render text into a box === | ||
+ | |||
+ | Example that shows how fit text render into boxed dimensions. | ||
+ | |||
+ | ( Original c-source code is available in the distribution archive of ttengine ) | ||
+ | |||
+ | <source lang="pascal"> | ||
+ | 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. | ||
+ | </source> | ||
+ | |||
+ | |||
+ | === Example: Render custom encoded text === | ||
+ | |||
+ | Example that shows how to render a font using custom encoded text. | ||
+ | |||
+ | ( Original c-source code is available in the distribution archive of ttengine ) | ||
+ | |||
+ | <source lang="pascal"> | ||
+ | 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. | ||
+ | </source> | ||
+ | |||
+ | |||
+ | === Example: Measure speed of different render-attributes and draw-modes === | ||
+ | |||
+ | Title says it all :-) | ||
+ | |||
+ | ( Original c-source code is available in the distribution archive of ttengine ) | ||
+ | |||
+ | <source lang="pascal"> | ||
+ | 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. | ||
+ | </source> | ||
+ | |||
+ | |||
+ | === 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. | ||
+ | |||
+ | ( Original c-source code is available in the distribution archive of ttengine ) | ||
+ | |||
+ | <source lang="pascal"> | ||
+ | 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. | ||
+ | </source> | ||
+ | |||
+ | |||
+ | === 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. | ||
+ | |||
+ | ( Original c-source code is available in the distribution archive of ttengine ) | ||
+ | |||
+ | <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> | ||
+ | |||
+ | |||
+ | === Example: Render using different draw-modes === | ||
+ | |||
+ | This examples show text rendering using several different drawmodes. | ||
+ | |||
+ | ( Original c-source code is available in the distribution archive of ttengine ) | ||
+ | |||
+ | <source lang="pascal"> | ||
+ | program drawmodes; | ||
+ | |||
+ | {$MODE OBJFPC}{$H+} | ||
+ | |||
+ | (* | ||
+ | Pascalized version of drawmodes.c, part of ttengine library examples | ||
+ | *) | ||
+ | |||
+ | Uses | ||
+ | exec, | ||
+ | amigados, | ||
+ | layers, | ||
+ | agraphics, | ||
+ | intuition, | ||
+ | asl, | ||
+ | aros_ttengine, | ||
+ | sysutils; | ||
+ | |||
+ | |||
+ | Type | ||
+ | SWord = SmallInt; | ||
+ | SLong = LongInt; | ||
+ | |||
+ | |||
+ | Function SetAndTest(var a: Pointer; b: Pointer): boolean; | ||
+ | begin | ||
+ | a := b; | ||
+ | result := (a <> nil); | ||
+ | end; | ||
+ | |||
+ | |||
+ | var | ||
+ | BPen1, BPen2, FPen, MPen : ULONG; | ||
+ | WinWidth, WinHeight : SWORD; | ||
+ | |||
+ | |||
+ | |||
+ | 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 ), 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 drawbg(win: PWindow); | ||
+ | var | ||
+ | x, y : SWORD; | ||
+ | dark : boolean; | ||
+ | rp : PRastPort; | ||
+ | rg, org : PRegion; | ||
+ | rc : TRectangle; | ||
+ | begin | ||
+ | rp := win^.RPort; | ||
+ | If SetAndTest(rg, NewRegion) then | ||
+ | begin | ||
+ | rc.MinX := win^.BorderLeft; | ||
+ | rc.MinY := win^.BorderTop; | ||
+ | rc.MaxX := win^.Width - win^.BorderRight - 1; | ||
+ | rc.MaxY := win^.Height - win^.BorderBottom - 1; | ||
+ | |||
+ | if (OrRectRegion(rg, @rc)) then | ||
+ | begin | ||
+ | org := InstallClipRegion(win^.RPort^.Layer, rg); | ||
+ | |||
+ | x := 0; | ||
+ | while (x < WinWidth) do | ||
+ | begin | ||
+ | if (x mod 20 <> 0) then dark := true else dark := false; | ||
+ | y := 0; | ||
+ | |||
+ | while (y < WinHeight) do | ||
+ | begin | ||
+ | if dark | ||
+ | then SetAPen(win^.RPort, BPen1) | ||
+ | else SetAPen(win^.RPort, BPen2); | ||
+ | |||
+ | RectFill( win^.RPort, | ||
+ | x + win^.BorderLeft , y + win^.BorderTop, | ||
+ | x + win^.BorderLeft + 9, y + win^.BorderTop + 9); | ||
+ | dark := not(dark); | ||
+ | y := y + 10; | ||
+ | end; // while y | ||
+ | x := x + 10; | ||
+ | end; // while x; | ||
+ | end; // if OrRectRegion | ||
+ | |||
+ | InstallClipRegion(win^.RPort^.Layer, org); | ||
+ | DisposeRegion(rg); | ||
+ | end; | ||
+ | end; | ||
+ | |||
+ | |||
+ | |||
+ | procedure drawtexts(w: PWindow); | ||
+ | var | ||
+ | x, deltax, ascend: SLONG; | ||
+ | rp : PRastPort; | ||
+ | begin | ||
+ | rp := w^.RPort; | ||
+ | deltax := (WinWidth - 30 shr 2) + 6; | ||
+ | x := w^.BorderLeft + 6; | ||
+ | |||
+ | TT_GetAttrs(rp, [TT_FontAscender, ULONG(@ascend), TAG_END]); | ||
+ | // SetAPen(rp, FPen); | ||
+ | // SetBPen(rp, MPen); | ||
+ | TT_SetAttrs(rp, [TT_Window, ULONG(w), TAG_END]); | ||
+ | |||
+ | SetDrMd(rp, JAM1); | ||
+ | GfxMove(rp, x, w^.BorderTop + 6 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | x := x + deltax; | ||
+ | |||
+ | SetDrMd(rp, JAM1 or INVERSVID); | ||
+ | GfxMove(rp, x, w^.BorderTop + 6 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | x := x + deltax; | ||
+ | |||
+ | SetDrMd(rp, JAM1 or COMPLEMENT); | ||
+ | GfxMove(rp, x, w^.BorderTop + 6 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | // Move(rp, x, w->BorderTop + 6 + ascend); | ||
+ | // TT_Text(rp, "Sample", 6); | ||
+ | x := x + deltax; | ||
+ | |||
+ | SetDrMd(rp, JAM1 or INVERSVID or COMPLEMENT); | ||
+ | GfxMove(rp, x, w^.BorderTop + 6 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | x := w^.BorderLeft + 6; | ||
+ | |||
+ | SetDrMd(rp, JAM2); | ||
+ | GfxMove(rp, x, w^.BorderTop + 60 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | x := x + deltax; | ||
+ | |||
+ | SetDrMd(rp, JAM2 or INVERSVID); | ||
+ | GfxMove(rp, x, w^.BorderTop + 60 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | x := x + deltax; | ||
+ | |||
+ | SetDrMd(rp, JAM2 or COMPLEMENT); | ||
+ | GfxMove(rp, x, w^.BorderTop + 60 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | x := x + deltax; | ||
+ | |||
+ | SetDrMd(rp, JAM2 or INVERSVID or COMPLEMENT); | ||
+ | GfxMove(rp, x, w^.BorderTop + 60 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | x := w^.BorderLeft + 6; | ||
+ | |||
+ | TT_SetAttrs(rp, [TT_Transparency, 128, TAG_END]); | ||
+ | |||
+ | SetDrMd(rp, JAM1); | ||
+ | GfxMove(rp, x, w^.BorderTop + 114 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | x := x + deltax; | ||
+ | |||
+ | SetDrMd(rp, JAM1 or INVERSVID); | ||
+ | GfxMove(rp, x, w^.BorderTop + 114 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | x := x + deltax; | ||
+ | |||
+ | SetDrMd(rp, JAM1 or COMPLEMENT); | ||
+ | GfxMove(rp, x, w^.BorderTop + 114 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | x := x + deltax; | ||
+ | |||
+ | SetDrMd(rp, JAM1 or INVERSVID or COMPLEMENT); | ||
+ | GfxMove(rp, x, w^.BorderTop + 114 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | x := w^.BorderLeft + 6; | ||
+ | |||
+ | SetDrMd(rp, JAM2); | ||
+ | GfxMove(rp, x, w^.BorderTop + 168 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | x := x + deltax; | ||
+ | |||
+ | SetDrMd(rp, JAM2 or INVERSVID); | ||
+ | GfxMove(rp, x, w^.BorderTop + 168 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | x := x + deltax; | ||
+ | |||
+ | SetDrMd(rp, JAM2 or COMPLEMENT); | ||
+ | GfxMove(rp, x, w^.BorderTop + 168 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | x := x + deltax; | ||
+ | |||
+ | SetDrMd(rp, JAM2 or INVERSVID or COMPLEMENT); | ||
+ | GfxMove(rp, x, w^.BorderTop + 168 + ascend); | ||
+ | TT_Text(rp, PChar('Sample'), 6); | ||
+ | end; | ||
+ | |||
+ | |||
+ | |||
+ | procedure get_window_size(s: PScreen; font: APTR); | ||
+ | var | ||
+ | W: SLong; | ||
+ | begin | ||
+ | WinWidth := 0; | ||
+ | WinHeight := 222; | ||
+ | |||
+ | if (TT_SetFont(@s^.RastPort, Font) <> 0) then | ||
+ | begin | ||
+ | w := TT_TextLength(@s^.RastPort, pchar('Sample'), 6); | ||
+ | WinWidth := (w shl 2) + 30; | ||
+ | end; | ||
+ | end; | ||
+ | |||
+ | |||
+ | |||
+ | procedure loop(w: PWindow); | ||
+ | var | ||
+ | sigmask, | ||
+ | signals : ULONG; | ||
+ | running : boolean; | ||
+ | imsg : PIntuiMessage; | ||
+ | begin | ||
+ | running := true; | ||
+ | |||
+ | sigmask := SIGBREAKF_CTRL_C or (1 shl w^.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 w^.UserPort^.mp_SigBit)) <> 0) then | ||
+ | begin | ||
+ | while SetAndTest(imsg, GetMsg(w^.UserPort)) do | ||
+ | begin | ||
+ | if (imsg^.IClass = IDCMP_CLOSEWINDOW) then running := FALSE; | ||
+ | ReplyMsg(PMessage(imsg)); | ||
+ | end; | ||
+ | end; | ||
+ | end; // while running | ||
+ | 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 (LayersBase = nil) then exit(false); | ||
+ | result := true; | ||
+ | end; | ||
+ | |||
+ | |||
+ | |||
+ | procedure cleanup(); | ||
+ | begin | ||
+ | (* | ||
+ | if (GfxBase) CloseLibrary(GfxBase); | ||
+ | if (IntuitionBase) CloseLibrary(IntuitionBase); | ||
+ | if (AslBase) CloseLibrary(AslBase); | ||
+ | if (TTEngineBase) CloseLibrary(TTEngineBase); | ||
+ | if (LayersBase) CloseLibrary(LayersBase); | ||
+ | *) | ||
+ | end; | ||
+ | |||
+ | |||
+ | |||
+ | Function Main: Integer; | ||
+ | var | ||
+ | win : PWindow; | ||
+ | fontname : STRPTR; | ||
+ | font : APTR; | ||
+ | s : PScreen; | ||
+ | var | ||
+ | rp : PRastPort; | ||
+ | begin | ||
+ | if (init) then | ||
+ | begin | ||
+ | fontname := get_font_name(AslBase); | ||
+ | If (FontName <> nil) then | ||
+ | begin | ||
+ | s := LockPubScreen(nil); | ||
+ | if (s <> nil) then | ||
+ | begin | ||
+ | font := TT_OpenFont( | ||
+ | [ | ||
+ | TT_FontFile, ULONG(fontname), | ||
+ | TT_FontSize, 48, | ||
+ | TAG_END | ||
+ | ]); | ||
+ | if (font <> nil) then | ||
+ | begin | ||
+ | free_font_name(fontname); | ||
+ | get_window_size(s, font); | ||
+ | |||
+ | win := OpenWindowTags(nil, | ||
+ | [ | ||
+ | LongInt(WA_Top) , 25, | ||
+ | LongInt(WA_Left) , 0, | ||
+ | LongInt(WA_InnerWidth) , WinWidth, | ||
+ | LongInt(WA_InnerHeight), WinHeight, | ||
+ | LongInt(WA_CloseGadget), LTRUE, | ||
+ | LongInt(WA_DragBar) , LTRUE, | ||
+ | LongInt(WA_DepthGadget), LTRUE, | ||
+ | LongInt(WA_Activate) , LTRUE, | ||
+ | LongInt(WA_IDCMP) , (IDCMP_CLOSEWINDOW), | ||
+ | LongInt(WA_Title) , pchar('TTEngine drawmodes'), | ||
+ | LongInt(WA_ScreenTitle), pchar('TTEngine demo'), | ||
+ | TAG_END, TAG_END | ||
+ | ]); | ||
+ | If (win <> nil) then | ||
+ | begin | ||
+ | rp := win^.RPort; | ||
+ | |||
+ | // BPen1 := ObtainBestPen(win^.WScreen^.ViewPort.ColorMap, | ||
+ | // $D0D0D0D0, $B5B5B5B5, $B5B5B5B5, [TAG_END]); | ||
+ | BPen1 := ObtainBestPenA(win^.WScreen^.ViewPort.ColorMap, | ||
+ | $D0D0D0D0, $B5B5B5B5, $B5B5B5B5, nil); | ||
+ | |||
+ | |||
+ | drawbg(win); | ||
+ | |||
+ | // BPen2 := ObtainBestPen(win^.WScreen^.ViewPort.ColorMap, | ||
+ | // $61616161, $91919191, $61616161, [TAG_END]); | ||
+ | BPen2 := ObtainBestPenA(win^.WScreen^.ViewPort.ColorMap, | ||
+ | $61616161, $91919191, $61616161, nil); | ||
+ | |||
+ | |||
+ | drawbg(win); | ||
+ | |||
+ | // FPen = ObtainBestPen(win->WScreen->ViewPort.ColorMap, | ||
+ | // 0xFFFFFFFF, 0xD0D0D0D0, 0x00000000, TAG_END); | ||
+ | |||
+ | // MPen = ObtainBestPen(win->WScreen->ViewPort.ColorMap, | ||
+ | // 0x00000000, 0x4C4C4C4C, 0x80808080, TAG_END); | ||
+ | |||
+ | drawbg(win); | ||
+ | |||
+ | if (TT_SetFont(win^.RPort, font) <> 0) then | ||
+ | begin | ||
+ | TT_SetAttrs(rp, | ||
+ | [ | ||
+ | TT_Window , ULONG(win), | ||
+ | TT_Encoding , TT_Encoding_Default, | ||
+ | TT_Antialias , TT_Antialias_On, | ||
+ | TT_Foreground, $00FFD000, | ||
+ | TT_Background, $00004C80, | ||
+ | TAG_END | ||
+ | ]); | ||
+ | |||
+ | drawtexts(win); | ||
+ | loop(win); | ||
+ | end | ||
+ | else Writeln('TT_SetFont() failed.'); | ||
+ | |||
+ | ReleasePen(win^.WScreen^.ViewPort.ColorMap, BPen1); | ||
+ | ReleasePen(win^.WScreen^.ViewPort.ColorMap, BPen2); | ||
+ | // ReleasePen(win->WScreen->ViewPort.ColorMap, MPen); | ||
+ | // ReleasePen(win->WScreen->ViewPort.ColorMap, FPen); | ||
+ | TT_DoneRastPort(rp); | ||
+ | CloseWindow(win); | ||
+ | end; | ||
+ | TT_CloseFont(font); | ||
+ | end | ||
+ | else writeln('Font open failed.'); | ||
+ | |||
+ | UnlockPubScreen(nil, s); | ||
+ | end; | ||
+ | end; | ||
+ | end; | ||
+ | cleanup; | ||
+ | result := 0; | ||
+ | end; | ||
+ | |||
+ | |||
+ | |||
+ | begin | ||
+ | writeln('enter'); | ||
+ | exitcode := Main; | ||
+ | writeln('leave'); | ||
+ | end. | ||
+ | </source> | ||
== The unit == | == The unit == |
Latest revision as of 08:00, 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 programmer'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.
( Original c-source code is available in the distribution archive of ttengine )
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.
( Original c-source code is available in the distribution archive of ttengine )
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.
( Original c-source code is available in the distribution archive of ttengine )
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.
( Original c-source code is available in the distribution archive of ttengine )
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.
( Original c-source code is available in the distribution archive of ttengine )
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.
( Original c-source code is available in the distribution archive of ttengine )
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 :-)
( Original c-source code is available in the distribution archive of ttengine )
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.
( Original c-source code is available in the distribution archive of ttengine )
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.
( Original c-source code is available in the distribution archive of ttengine )
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: Render using different draw-modes
This examples show text rendering using several different drawmodes.
( Original c-source code is available in the distribution archive of ttengine )
program drawmodes;
{$MODE OBJFPC}{$H+}
(*
Pascalized version of drawmodes.c, part of ttengine library examples
*)
Uses
exec,
amigados,
layers,
agraphics,
intuition,
asl,
aros_ttengine,
sysutils;
Type
SWord = SmallInt;
SLong = LongInt;
Function SetAndTest(var a: Pointer; b: Pointer): boolean;
begin
a := b;
result := (a <> nil);
end;
var
BPen1, BPen2, FPen, MPen : ULONG;
WinWidth, WinHeight : SWORD;
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 ), 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 drawbg(win: PWindow);
var
x, y : SWORD;
dark : boolean;
rp : PRastPort;
rg, org : PRegion;
rc : TRectangle;
begin
rp := win^.RPort;
If SetAndTest(rg, NewRegion) then
begin
rc.MinX := win^.BorderLeft;
rc.MinY := win^.BorderTop;
rc.MaxX := win^.Width - win^.BorderRight - 1;
rc.MaxY := win^.Height - win^.BorderBottom - 1;
if (OrRectRegion(rg, @rc)) then
begin
org := InstallClipRegion(win^.RPort^.Layer, rg);
x := 0;
while (x < WinWidth) do
begin
if (x mod 20 <> 0) then dark := true else dark := false;
y := 0;
while (y < WinHeight) do
begin
if dark
then SetAPen(win^.RPort, BPen1)
else SetAPen(win^.RPort, BPen2);
RectFill( win^.RPort,
x + win^.BorderLeft , y + win^.BorderTop,
x + win^.BorderLeft + 9, y + win^.BorderTop + 9);
dark := not(dark);
y := y + 10;
end; // while y
x := x + 10;
end; // while x;
end; // if OrRectRegion
InstallClipRegion(win^.RPort^.Layer, org);
DisposeRegion(rg);
end;
end;
procedure drawtexts(w: PWindow);
var
x, deltax, ascend: SLONG;
rp : PRastPort;
begin
rp := w^.RPort;
deltax := (WinWidth - 30 shr 2) + 6;
x := w^.BorderLeft + 6;
TT_GetAttrs(rp, [TT_FontAscender, ULONG(@ascend), TAG_END]);
// SetAPen(rp, FPen);
// SetBPen(rp, MPen);
TT_SetAttrs(rp, [TT_Window, ULONG(w), TAG_END]);
SetDrMd(rp, JAM1);
GfxMove(rp, x, w^.BorderTop + 6 + ascend);
TT_Text(rp, PChar('Sample'), 6);
x := x + deltax;
SetDrMd(rp, JAM1 or INVERSVID);
GfxMove(rp, x, w^.BorderTop + 6 + ascend);
TT_Text(rp, PChar('Sample'), 6);
x := x + deltax;
SetDrMd(rp, JAM1 or COMPLEMENT);
GfxMove(rp, x, w^.BorderTop + 6 + ascend);
TT_Text(rp, PChar('Sample'), 6);
// Move(rp, x, w->BorderTop + 6 + ascend);
// TT_Text(rp, "Sample", 6);
x := x + deltax;
SetDrMd(rp, JAM1 or INVERSVID or COMPLEMENT);
GfxMove(rp, x, w^.BorderTop + 6 + ascend);
TT_Text(rp, PChar('Sample'), 6);
x := w^.BorderLeft + 6;
SetDrMd(rp, JAM2);
GfxMove(rp, x, w^.BorderTop + 60 + ascend);
TT_Text(rp, PChar('Sample'), 6);
x := x + deltax;
SetDrMd(rp, JAM2 or INVERSVID);
GfxMove(rp, x, w^.BorderTop + 60 + ascend);
TT_Text(rp, PChar('Sample'), 6);
x := x + deltax;
SetDrMd(rp, JAM2 or COMPLEMENT);
GfxMove(rp, x, w^.BorderTop + 60 + ascend);
TT_Text(rp, PChar('Sample'), 6);
x := x + deltax;
SetDrMd(rp, JAM2 or INVERSVID or COMPLEMENT);
GfxMove(rp, x, w^.BorderTop + 60 + ascend);
TT_Text(rp, PChar('Sample'), 6);
x := w^.BorderLeft + 6;
TT_SetAttrs(rp, [TT_Transparency, 128, TAG_END]);
SetDrMd(rp, JAM1);
GfxMove(rp, x, w^.BorderTop + 114 + ascend);
TT_Text(rp, PChar('Sample'), 6);
x := x + deltax;
SetDrMd(rp, JAM1 or INVERSVID);
GfxMove(rp, x, w^.BorderTop + 114 + ascend);
TT_Text(rp, PChar('Sample'), 6);
x := x + deltax;
SetDrMd(rp, JAM1 or COMPLEMENT);
GfxMove(rp, x, w^.BorderTop + 114 + ascend);
TT_Text(rp, PChar('Sample'), 6);
x := x + deltax;
SetDrMd(rp, JAM1 or INVERSVID or COMPLEMENT);
GfxMove(rp, x, w^.BorderTop + 114 + ascend);
TT_Text(rp, PChar('Sample'), 6);
x := w^.BorderLeft + 6;
SetDrMd(rp, JAM2);
GfxMove(rp, x, w^.BorderTop + 168 + ascend);
TT_Text(rp, PChar('Sample'), 6);
x := x + deltax;
SetDrMd(rp, JAM2 or INVERSVID);
GfxMove(rp, x, w^.BorderTop + 168 + ascend);
TT_Text(rp, PChar('Sample'), 6);
x := x + deltax;
SetDrMd(rp, JAM2 or COMPLEMENT);
GfxMove(rp, x, w^.BorderTop + 168 + ascend);
TT_Text(rp, PChar('Sample'), 6);
x := x + deltax;
SetDrMd(rp, JAM2 or INVERSVID or COMPLEMENT);
GfxMove(rp, x, w^.BorderTop + 168 + ascend);
TT_Text(rp, PChar('Sample'), 6);
end;
procedure get_window_size(s: PScreen; font: APTR);
var
W: SLong;
begin
WinWidth := 0;
WinHeight := 222;
if (TT_SetFont(@s^.RastPort, Font) <> 0) then
begin
w := TT_TextLength(@s^.RastPort, pchar('Sample'), 6);
WinWidth := (w shl 2) + 30;
end;
end;
procedure loop(w: PWindow);
var
sigmask,
signals : ULONG;
running : boolean;
imsg : PIntuiMessage;
begin
running := true;
sigmask := SIGBREAKF_CTRL_C or (1 shl w^.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 w^.UserPort^.mp_SigBit)) <> 0) then
begin
while SetAndTest(imsg, GetMsg(w^.UserPort)) do
begin
if (imsg^.IClass = IDCMP_CLOSEWINDOW) then running := FALSE;
ReplyMsg(PMessage(imsg));
end;
end;
end; // while running
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 (LayersBase = nil) then exit(false);
result := true;
end;
procedure cleanup();
begin
(*
if (GfxBase) CloseLibrary(GfxBase);
if (IntuitionBase) CloseLibrary(IntuitionBase);
if (AslBase) CloseLibrary(AslBase);
if (TTEngineBase) CloseLibrary(TTEngineBase);
if (LayersBase) CloseLibrary(LayersBase);
*)
end;
Function Main: Integer;
var
win : PWindow;
fontname : STRPTR;
font : APTR;
s : PScreen;
var
rp : PRastPort;
begin
if (init) then
begin
fontname := get_font_name(AslBase);
If (FontName <> nil) then
begin
s := LockPubScreen(nil);
if (s <> nil) then
begin
font := TT_OpenFont(
[
TT_FontFile, ULONG(fontname),
TT_FontSize, 48,
TAG_END
]);
if (font <> nil) then
begin
free_font_name(fontname);
get_window_size(s, font);
win := OpenWindowTags(nil,
[
LongInt(WA_Top) , 25,
LongInt(WA_Left) , 0,
LongInt(WA_InnerWidth) , WinWidth,
LongInt(WA_InnerHeight), WinHeight,
LongInt(WA_CloseGadget), LTRUE,
LongInt(WA_DragBar) , LTRUE,
LongInt(WA_DepthGadget), LTRUE,
LongInt(WA_Activate) , LTRUE,
LongInt(WA_IDCMP) , (IDCMP_CLOSEWINDOW),
LongInt(WA_Title) , pchar('TTEngine drawmodes'),
LongInt(WA_ScreenTitle), pchar('TTEngine demo'),
TAG_END, TAG_END
]);
If (win <> nil) then
begin
rp := win^.RPort;
// BPen1 := ObtainBestPen(win^.WScreen^.ViewPort.ColorMap,
// $D0D0D0D0, $B5B5B5B5, $B5B5B5B5, [TAG_END]);
BPen1 := ObtainBestPenA(win^.WScreen^.ViewPort.ColorMap,
$D0D0D0D0, $B5B5B5B5, $B5B5B5B5, nil);
drawbg(win);
// BPen2 := ObtainBestPen(win^.WScreen^.ViewPort.ColorMap,
// $61616161, $91919191, $61616161, [TAG_END]);
BPen2 := ObtainBestPenA(win^.WScreen^.ViewPort.ColorMap,
$61616161, $91919191, $61616161, nil);
drawbg(win);
// FPen = ObtainBestPen(win->WScreen->ViewPort.ColorMap,
// 0xFFFFFFFF, 0xD0D0D0D0, 0x00000000, TAG_END);
// MPen = ObtainBestPen(win->WScreen->ViewPort.ColorMap,
// 0x00000000, 0x4C4C4C4C, 0x80808080, TAG_END);
drawbg(win);
if (TT_SetFont(win^.RPort, font) <> 0) then
begin
TT_SetAttrs(rp,
[
TT_Window , ULONG(win),
TT_Encoding , TT_Encoding_Default,
TT_Antialias , TT_Antialias_On,
TT_Foreground, $00FFD000,
TT_Background, $00004C80,
TAG_END
]);
drawtexts(win);
loop(win);
end
else Writeln('TT_SetFont() failed.');
ReleasePen(win^.WScreen^.ViewPort.ColorMap, BPen1);
ReleasePen(win^.WScreen^.ViewPort.ColorMap, BPen2);
// ReleasePen(win->WScreen->ViewPort.ColorMap, MPen);
// ReleasePen(win->WScreen->ViewPort.ColorMap, FPen);
TT_DoneRastPort(rp);
CloseWindow(win);
end;
TT_CloseFont(font);
end
else writeln('Font open failed.');
UnlockPubScreen(nil, s);
end;
end;
end;
cleanup;
result := 0;
end;
begin
writeln('enter');
exitcode := Main;
writeln('leave');
end.
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.