1 { 2 This file is part of the Free Pascal run time library. 3 4 A file in Amiga system run time library. 5 Copyright (c) 1998-2003 by Nils Sjoholm 6 member of the Amiga RTL development team. 7 8 See the file COPYING.FPC, included in this distribution, 9 for details about the copyright. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 14 15 **********************************************************************} 16 { 17 History: 18 19 Added the defines use_amiga_smartlink and 20 use_auto_openlib. Implemented autoopening 21 of the library. 22 13 Jan 2003. 23 24 Update for AmigaOS 3.9. 25 FUNCTION GetDiskFontCtrl 26 PROCEDURE SetDiskFontCtrlA 27 Varargs for SetDiskFontCtrl is in 28 systemvartags. 29 Changed startup for library. 30 01 Feb 2003. 31 32 Changed cardinal > longword. 33 09 Feb 2003. 34 35 nils.sjoholm@mailbox.swipnet.se Nils Sjoholm 36 } 37 {$PACKRECORDS 2} 38 39 unit diskfont; 40 41 INTERFACE 42 43 uses exec, agraphics,utility; 44 45 Const 46 47 MAXFONTPATH = 256; 48 49 Type 50 51 pFontContents = ^tFontContents; 52 tFontContents = record 53 fc_FileName : Array [0..MAXFONTPATH-1] of Char; 54 fc_YSize : Word; 55 fc_Style : Byte; 56 fc_Flags : Byte; 57 end; 58 59 60 pTFontContents = ^tTFontContents; 61 tTFontContents = record 62 tfc_FileName : Array[0..MAXFONTPATH-3] of Char; 63 tfc_TagCount : Word; 64 65 tfc_YSize : Word; 66 tfc_Style, 67 tfc_Flags : Byte; 68 END; 69 70 71 Const 72 73 FCH_ID = $0f00; 74 TFCH_ID = $0f02; 75 OFCH_ID = $0f03; 76 77 78 79 Type 80 81 pFontContentsHeader = ^tFontContentsHeader; 82 tFontContentsHeader = record 83 fch_FileID : Word; 84 fch_NumEntries : Word; 85 end; 86 87 Const 88 89 DFH_ID = $0f80; 90 MAXFONTNAME = 32; 91 92 Type 93 94 pDiskFontHeader = ^tDiskFontHeader; 95 tDiskFontHeader = record 96 dfh_DF : tNode; 97 dfh_FileID : Word; 98 dfh_Revision : Word; 99 dfh_Segment : Longint; 100 dfh_Name : Array [0..MAXFONTNAME-1] of Char; 101 dfh_TF : tTextFont; 102 end; 103 104 Const 105 106 AFB_MEMORY = 0; 107 AFF_MEMORY = 1; 108 AFB_DISK = 1; 109 AFF_DISK = 2; 110 AFB_SCALED = 2; 111 AFF_SCALED = $0004; 112 AFB_BITMAP = 3; 113 AFF_BITMAP = $0008; 114 AFB_TAGGED = 16; 115 AFF_TAGGED = $10000; 116 117 118 Type 119 120 pAvailFonts = ^tAvailFonts; 121 tAvailFonts = record 122 af_Type : Word; 123 af_Attr : tTextAttr; 124 end; 125 126 pTAvailFonts = ^tTAvailFonts; 127 tTAvailFonts = record 128 taf_Type : Word; 129 taf_Attr : tTTextAttr; 130 END; 131 132 pAvailFontsHeader = ^tAvailFontsHeader; 133 tAvailFontsHeader = record 134 afh_NumEntries : Word; 135 end; 136 137 const 138 DISKFONTNAME : PChar = 'diskfont.library'; 139 140 VAR DiskfontBase : pLibrary = nil; 141 AvailFontsnull142FUNCTION AvailFonts(buffer : pCHAR location 'a0'; bufBytes : LONGINT location 'd0'; flags : LONGINT location 'd1') : LONGINT; syscall DiskfontBase 036; 143 PROCEDURE DisposeFontContents(fontContentsHeader : pFontContentsHeader location 'a1'); syscall DiskfontBase 048; NewFontContentsnull144FUNCTION NewFontContents(fontsLock : BPTR location 'a0'; fontName : pCHAR location 'a1') : pFontContentsHeader; syscall DiskfontBase 042; NewScaledDiskFontnull145FUNCTION NewScaledDiskFont(sourceFont : pTextFont location 'a0'; destTextAttr : pTextAttr location 'a1') : pDiskFontHeader; syscall DiskfontBase 054; OpenDiskFontnull146FUNCTION OpenDiskFont(textAttr : pTextAttr location 'a0') : pTextFont; syscall DiskfontBase 030; GetDiskFontCtrlnull147FUNCTION GetDiskFontCtrl(tagid : LONGINT location 'd0') : LONGINT; syscall DiskfontBase 060; 148 PROCEDURE SetDiskFontCtrlA(taglist : pTagItem location 'a0'); syscall DiskfontBase 066; 149 150 IMPLEMENTATION 151 152 const 153 { Change VERSION and LIBVERSION to proper values } 154 VERSION : string[2] = '0'; 155 LIBVERSION : longword = 0; 156 157 initialization 158 DiskfontBase := OpenLibrary(DISKFONTNAME,LIBVERSION); 159 finalization 160 if Assigned(DiskfontBase) then 161 CloseLibrary(DiskfontBase); 162 END. (* UNIT DISKFONT *) 163 164 165 166 167