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     Added overlay functions for Pchar->Strings, functions
19     and procedures.
20     14 Jul 2000.
21 
22     Removed amigaoverlays, use smartlink instead.
23     05 Nov 2002.
24 
25     Added the defines use_amiga_smartlink and
26     use_auto_openlib. Implemented autoopening of
27     the library.
28     14 Jan 2003.
29 
30     Update for AmigaOS 3.9.
31     A lof of new const and a record.
32     Functions added.
33          FUNCTION DupDiskObjectA
34          FUNCTION IconControlA
35          PROCEDURE DrawIconStateA
36          FUNCTION GetIconRectangleA
37          FUNCTION NewDiskObject
38          FUNCTION GetIconTagList
39          FUNCTION PutIconTagList
40          FUNCTION LayoutIconA
41          PROCEDURE ChangeToSelectedIconColor
42     plus overlay for
43          FUNCTION GetIconTagList;
44          FUNCTION PutIconTagList
45     Changed start code for unit.
46     02 Feb 2003.
47 
48     Changed cardinal > longword.
49     09 Feb 2003.
50 
51     nils.sjoholm@mailbox.swipnet.se
52 }
53 
54 unit icon;
55 
56 INTERFACE
57 
58 
59 uses exec, workbench,utility,amigados,agraphics,intuition,datatypes;
60 
61     const
62     ICONA_Dummy = TAG_USER + $9000;
63   {                                                                           }
64   { Error reporting (LONG  )  }
65      ICONA_ErrorCode = ICONA_Dummy + 1;
66 
67   { Points to the tag item that caused the error (struct TagItem   ).  }
68      ICONA_ErrorTagItem = ICONA_Dummy + 75;
69   {                                                                           }
70   { Global options for IconControlA()  }
71 
72   { Screen to use for remapping Workbench icons to (struct Screen  )  }
73      ICONCTRLA_SetGlobalScreen = ICONA_Dummy + 2;
74      ICONCTRLA_GetGlobalScreen = ICONA_Dummy + 3;
75 
76   { Icon color remapping precision; defaults to PRECISION_ICON (LONG)  }
77      ICONCTRLA_SetGlobalPrecision = ICONA_Dummy + 4;
78      ICONCTRLA_GetGlobalPrecision = ICONA_Dummy + 5;
79 
80   { Icon frame size dimensions (struct Rectangle  )  }
81      ICONCTRLA_SetGlobalEmbossRect = ICONA_Dummy + 6;
82      ICONCTRLA_GetGlobalEmbossRect = ICONA_Dummy + 7;
83 
84   { Render image without frame (BOOL)  }
85      ICONCTRLA_SetGlobalFrameless = ICONA_Dummy + 8;
86      ICONCTRLA_GetGlobalFrameless = ICONA_Dummy + 9;
87 
88   { Enable NewIcons support (BOOL)  }
89      ICONCTRLA_SetGlobalNewIconsSupport = ICONA_Dummy + 10;
90      ICONCTRLA_GetGlobalNewIconsSupport = ICONA_Dummy + 11;
91 
92   { Enable color icon support (BOOL)  }
93      ICONCTRLA_SetGlobalColorIconSupport = ICONA_Dummy + 77;
94      ICONCTRLA_GetGlobalColorIconSupport = ICONA_Dummy + 78;
95 
96   { Set/Get the hook to be called when identifying a file (struct Hook  )  }
97      ICONCTRLA_SetGlobalIdentifyHook = ICONA_Dummy + 12;
98      ICONCTRLA_GetGlobalIdentifyHook = ICONA_Dummy + 13;
99 
100   { Set/get the maximum length of a file/drawer name supported
101      by icon.library (LONG).
102     }
103      ICONCTRLA_SetGlobalMaxNameLength = ICONA_Dummy + 67;
104      ICONCTRLA_GetGlobalMaxNameLength = ICONA_Dummy + 68;
105 
106   {**************************************************************************}
107   { Per icon local options for IconControlA()  }
108 
109   { Get the icon rendering masks (PLANEPTR)  }
110      ICONCTRLA_GetImageMask1 = ICONA_Dummy + 14;
111      ICONCTRLA_GetImageMask2 = ICONA_Dummy + 15;
112 
113   { Transparent image color; set to -1 if opaque  }
114      ICONCTRLA_SetTransparentColor1 = ICONA_Dummy + 16;
115      ICONCTRLA_GetTransparentColor1 = ICONA_Dummy + 17;
116      ICONCTRLA_SetTransparentColor2 = ICONA_Dummy + 18;
117      ICONCTRLA_GetTransparentColor2 = ICONA_Dummy + 19;
118 
119   { Image color palette (struct ColorRegister  )  }
120      ICONCTRLA_SetPalette1 = ICONA_Dummy + 20;
121      ICONCTRLA_GetPalette1 = ICONA_Dummy + 21;
122      ICONCTRLA_SetPalette2 = ICONA_Dummy + 22;
123      ICONCTRLA_GetPalette2 = ICONA_Dummy + 23;
124 
125   { Size of image color palette (LONG)  }
126      ICONCTRLA_SetPaletteSize1 = ICONA_Dummy + 24;
127      ICONCTRLA_GetPaletteSize1 = ICONA_Dummy + 25;
128      ICONCTRLA_SetPaletteSize2 = ICONA_Dummy + 26;
129      ICONCTRLA_GetPaletteSize2 = ICONA_Dummy + 27;
130 
131   { Image data; one by per pixel (UBYTE  )  }
132      ICONCTRLA_SetImageData1 = ICONA_Dummy + 28;
133      ICONCTRLA_GetImageData1 = ICONA_Dummy + 29;
134      ICONCTRLA_SetImageData2 = ICONA_Dummy + 30;
135      ICONCTRLA_GetImageData2 = ICONA_Dummy + 31;
136 
137   { Render image without frame (BOOL)  }
138      ICONCTRLA_SetFrameless = ICONA_Dummy + 32;
139      ICONCTRLA_GetFrameless = ICONA_Dummy + 33;
140 
141   { Enable NewIcons support (BOOL)  }
142      ICONCTRLA_SetNewIconsSupport = ICONA_Dummy + 34;
143      ICONCTRLA_GetNewIconsSupport = ICONA_Dummy + 35;
144 
145   { Icon aspect ratio (UBYTE  )  }
146      ICONCTRLA_SetAspectRatio = ICONA_Dummy + 36;
147      ICONCTRLA_GetAspectRatio = ICONA_Dummy + 37;
148 
149   { Icon dimensions; valid only for palette mapped icon images (LONG)  }
150      ICONCTRLA_SetWidth = ICONA_Dummy + 38;
151      ICONCTRLA_GetWidth = ICONA_Dummy + 39;
152      ICONCTRLA_SetHeight = ICONA_Dummy + 40;
153      ICONCTRLA_GetHeight = ICONA_Dummy + 41;
154 
155   { Check whether the icon is palette mapped (LONG  ).  }
156      ICONCTRLA_IsPaletteMapped = ICONA_Dummy + 42;
157 
158   { Get the screen the icon is attached to (struct Screen   ).  }
159      ICONCTRLA_GetScreen = ICONA_Dummy + 43;
160 
161   { Check whether the icon has a real select image (LONG  ).  }
162      ICONCTRLA_HasRealImage2 = ICONA_Dummy + 44;
163 
164   { Check whether the icon is of the NewIcon type (LONG  ).  }
165      ICONCTRLA_IsNewIcon = ICONA_Dummy + 79;
166 
167   { Check whether this icon was allocated by icon.library
168      or if consists solely of a statically allocated
169      struct DiskObject. (LONG  ).
170     }
171      ICONCTRLA_IsNativeIcon = ICONA_Dummy + 80;
172 
173   {**************************************************************************}
174 
175   { Icon aspect ratio is not known.  }
176      ICON_ASPECT_RATIO_UNKNOWN = 0;
177 
178 { Tags for use with GetIconTagList() }
179 
180 { Default icon type to retrieve (LONG) }
181      ICONGETA_GetDefaultType    = ICONA_Dummy+45;
182 
183 { Retrieve default icon for the given name (STRPTR) }
184        ICONGETA_GetDefaultName = ICONA_Dummy + 46;
185 
186     { Return a default icon if the requested icon
187        file cannot be found (BOOL).
188       }
189        ICONGETA_FailIfUnavailable = ICONA_Dummy + 47;
190 
191     { If possible, retrieve a palette mapped icon (BOOL).  }
192        ICONGETA_GetPaletteMappedIcon = ICONA_Dummy + 48;
193 
194     { Set if the icon returned is a default icon (BOOL  ).  }
195        ICONGETA_IsDefaultIcon = ICONA_Dummy + 49;
196 
197     { Remap the icon to the default screen, if possible (BOOL).  }
198        ICONGETA_RemapIcon = ICONA_Dummy + 50;
199 
200     { Generate icon image masks (BOOL).  }
201        ICONGETA_GenerateImageMasks = ICONA_Dummy + 51;
202 
203     { Label text to be assigned to the icon (STRPTR).  }
204        ICONGETA_Label = ICONA_Dummy + 52;
205 
206     { Screen to remap the icon to (struct Screen  ).  }
207        ICONGETA_Screen = ICONA_Dummy + 69;
208 
209     {**************************************************************************}
210 
211     { Tags for use with PutIconTagList()  }
212 
213     { Notify Workbench of the icon being written (BOOL)  }
214        ICONPUTA_NotifyWorkbench = ICONA_Dummy + 53;
215 
216     { Store icon as the default for this type (LONG)  }
217        ICONPUTA_PutDefaultType = ICONA_Dummy + 54;
218 
219     { Store icon as a default for the given name (STRPTR)  }
220        ICONPUTA_PutDefaultName = ICONA_Dummy + 55;
221 
222     { When storing a palette mapped icon, don't save the
223        the original planar icon image with the file. Replace
224        it with a tiny replacement image.
225       }
226        ICONPUTA_DropPlanarIconImage = ICONA_Dummy + 56;
227 
228     { Don't write the chunky icon image data to disk.  }
229        ICONPUTA_DropChunkyIconImage = ICONA_Dummy + 57;
230 
231     { Don't write the NewIcons tool types to disk.  }
232        ICONPUTA_DropNewIconToolTypes = ICONA_Dummy + 58;
233 
234     { If this tag is enabled, the writer will examine the
235        icon image data to find out whether it can compress
236        it more efficiently. This may take extra time and
237        is not generally recommended.
238       }
239        ICONPUTA_OptimizeImageSpace = ICONA_Dummy + 59;
240 
241     { Don't write the entire icon file back to disk,
242        only change the do->do_CurrentX/do->do_CurrentY
243        members.
244       }
245        ICONPUTA_OnlyUpdatePosition = ICONA_Dummy + 72;
246 
247     { Before writing a palette mapped icon back to disk,
248        icon.library will make sure that the original
249        planar image data is stored in the file. If you
250        don't want that to happen, set this option to
251        FALSE. This will allow you to change the planar icon
252        image data written back to disk.
253       }
254       ICONPUTA_PreserveOldIconImages = ICONA_Dummy + 84;
255 
256 {**************************************************************************}
257 
258 { For use with the file identification hook. }
259 
260           type
261        PIconIdentifyMsg = ^tIconIdentifyMsg;
262        tIconIdentifyMsg = record
263             { Libraries that are already opened for your use. }
264             iim_SysBase : PLibrary;
265             iim_DOSBase : PLibrary;
266             iim_UtilityBase : PLibrary;
267             iim_IconBase : PLibrary;
268 
269             { File context information. }
270             iim_FileLock : BPTR;           { Lock on the object to return an icon for. }
271             iim_ParentLock : BPTR;         { Lock on the object's parent directory, if available. }
272             iim_FIB : PFileInfoBlock;      { Already initialized for you. }
273             iim_FileHandle : BPTR;         { If non-NULL, pointer to the file to examine,
274                                                  * positioned right at the first byte, ready
275                                                  * for you to use.
276                                                  }
277             iim_Tags : PTagItem;           { Tags passed to GetIconTagList(). }
278          end;
279 
280 {**************************************************************************}
281 
282     { Tags for use with DupDiskObjectA()  }
283 
284     const
285     { Duplicate do_DrawerData  }
286        ICONDUPA_DuplicateDrawerData = ICONA_Dummy + 60;
287 
288     { Duplicate the Image structures.  }
289        ICONDUPA_DuplicateImages = ICONA_Dummy + 61;
290 
291     { Duplicate the image data (Image->ImageData) itself.  }
292        ICONDUPA_DuplicateImageData = ICONA_Dummy + 62;
293 
294     { Duplicate the default tool.  }
295        ICONDUPA_DuplicateDefaultTool = ICONA_Dummy + 63;
296 
297     { Duplicate the tool types list.  }
298        ICONDUPA_DuplicateToolTypes = ICONA_Dummy + 64;
299 
300     { Duplicate the tool window.  }
301        ICONDUPA_DuplicateToolWindow = ICONA_Dummy + 65;
302 
303     { If the icon to be duplicated is in fact a palette mapped
304        icon which has never been set up to be displayed on the
305        screen, turn the duplicate into that palette mapped icon.
306       }
307        ICONDUPA_ActivateImageData = ICONA_Dummy + 82;
308 
309 {**************************************************************************}
310 
311     { Tags for use with DrawIconStateA() and GetIconRectangleA().  }
312 
313     { Drawing information to use (struct DrawInfo  ).  }
314        ICONDRAWA_DrawInfo = ICONA_Dummy + 66;
315 
316     { Draw the icon without the surrounding frame (BOOL).  }
317        ICONDRAWA_Frameless = ICONA_Dummy + 70;
318 
319     { Erase the background before drawing a frameless icon (BOOL).  }
320        ICONDRAWA_EraseBackground = ICONA_Dummy + 71;
321 
322     { Draw the icon without the surrounding border and frame (BOOL).  }
323        ICONDRAWA_Borderless = ICONA_Dummy + 83;
324 
325     { The icon to be drawn refers to a linked object (BOOL).  }
326        ICONDRAWA_IsLink = ICONA_Dummy + 89;
327 
328 {**************************************************************************}
329 
330     { Reserved tags; don't use!  }
331        ICONA_Reserved1 = ICONA_Dummy + 73;
332        ICONA_Reserved2 = ICONA_Dummy + 74;
333        ICONA_Reserved3 = ICONA_Dummy + 76;
334        ICONA_Reserved4 = ICONA_Dummy + 81;
335        ICONA_Reserved5 = ICONA_Dummy + 85;
336        ICONA_Reserved6 = ICONA_Dummy + 86;
337        ICONA_Reserved7 = ICONA_Dummy + 87;
338        ICONA_Reserved8 = ICONA_Dummy + 88;
339     {                                                                           }
340        ICONA_LAST_TAG = ICONA_Dummy + 89;
341 
342 {**************************************************************************}
343 
344 
345 Const
346 
347     ICONNAME    : PChar = 'icon.library';
348 
349 VAR IconBase : pLibrary = nil;
350 
AddFreeListnull351 FUNCTION AddFreeList(freelist : pFreeList location 'a0'; const mem : POINTER location 'a1'; size : ULONG location 'a2') : LongBool; syscall IconBase 072;
BumpRevisionnull352 FUNCTION BumpRevision(newname : pCHAR location 'a0'; const oldname : pCHAR location 'a1') : pCHAR; syscall IconBase 108;
DeleteDiskObjectnull353 FUNCTION DeleteDiskObject(const name : pCHAR location 'a0') : LongBool; syscall IconBase 138;
FindToolTypenull354 FUNCTION FindToolType(const toolTypeArray : POINTER location 'a0'; const typeName : pCHAR location 'a1') : pCHAR; syscall IconBase 096;
355 PROCEDURE FreeDiskObject(diskobj : pDiskObject location 'a0'); syscall IconBase 090;
356 PROCEDURE FreeFreeList(freelist : pFreeList location 'a0'); syscall IconBase 054;
GetDefDiskObjectnull357 FUNCTION GetDefDiskObject(typ : LONGINT location 'd0') : pDiskObject; syscall IconBase 120;
GetDiskObjectnull358 FUNCTION GetDiskObject(const name : pCHAR location 'a0') : pDiskObject; syscall IconBase 078;
GetDiskObjectNewnull359 FUNCTION GetDiskObjectNew(const name : pCHAR location 'a0') : pDiskObject; syscall IconBase 132;
MatchToolValuenull360 FUNCTION MatchToolValue(const typeString : pCHAR location 'a0'; const value : pCHAR location 'a1') : LongBool; syscall IconBase 102;
PutDefDiskObjectnull361 FUNCTION PutDefDiskObject(const diskObject : pDiskObject location 'a0') : LongBool; syscall IconBase 126;
PutDiskObjectnull362 FUNCTION PutDiskObject(const name : pCHAR location 'a0'; const diskobj : pDiskObject location 'a1') : LongBool; syscall IconBase 084;
363 
364 { version 44 }
DupDiskObjectAnull365 FUNCTION DupDiskObjectA(CONST diskObject : pDiskObject location 'a0'; CONST tags : pTagItem location 'a1') : pDiskObject; syscall IconBase 150;
IconControlAnull366 FUNCTION IconControlA(icon : pDiskObject location 'a0'; CONST tags : pTagItem location 'a1') : longword; syscall IconBase 156;
367 PROCEDURE DrawIconStateA(rp : pRastPort location 'a0'; CONST icon : pDiskObject location 'a1'; CONST label_ : pCHAR location 'a2'; leftOffset : LONGINT location 'd0'; topOffset : LONGINT location 'd1'; state : longword location 'd2'; CONST tags : pTagItem location 'a3'); syscall IconBase 162;
GetIconRectangleAnull368 FUNCTION GetIconRectangleA(rp : pRastPort location 'a0'; CONST icon : pDiskObject location 'a1'; CONST label_ : pCHAR location 'a2'; rect : pRectangle location 'a3'; CONST tags : pTagItem location 'a4') : LongBool; syscall IconBase 168;
NewDiskObjectnull369 FUNCTION NewDiskObject(type_ : LONGINT location 'd0') : pDiskObject; syscall IconBase 174;
GetIconTagListnull370 FUNCTION GetIconTagList(CONST name : pCHAR location 'a0'; CONST tags : pTagItem location 'a1') : pDiskObject; syscall IconBase 180;
PutIconTagListnull371 FUNCTION PutIconTagList(CONST name : pCHAR location 'a0'; CONST icon : pDiskObject location 'a1'; CONST tags : pTagItem location 'a2') : LongBool; syscall IconBase 186;
LayoutIconAnull372 FUNCTION LayoutIconA(icon : pDiskObject location 'a0'; screen : pScreen location 'a1'; tags : pTagItem location 'a2') : LongBool; syscall IconBase 192;
373 PROCEDURE ChangeToSelectedIconColor(cr : pColorRegister location 'a0'); syscall IconBase 198;
374 
375 { overlay }
BumpRevisionnull376 FUNCTION BumpRevision(newname : pCHar; const oldname : RawByteString) : pCHAR;
DeleteDiskObjectnull377 FUNCTION DeleteDiskObject(const name : RawByteString) : BOOLEAN;
FindToolTypenull378 FUNCTION FindToolType(const toolTypeArray : POINTER;const typeName : RawByteString) : pCHAR;
GetDiskObjectnull379 FUNCTION GetDiskObject(const name : RawByteString) : pDiskObject;
GetDiskObjectNewnull380 FUNCTION GetDiskObjectNew(const name : RawByteString) : pDiskObject;
MatchToolValuenull381 FUNCTION MatchToolValue(const typeString : RawByteString;const value : pCHAR) : BOOLEAN;
MatchToolValuenull382 FUNCTION MatchToolValue(const typeString : pCHAR;const value : RawByteString) : BOOLEAN;
MatchToolValuenull383 FUNCTION MatchToolValue(const typeString : RawByteString;const value : RawByteString) : BOOLEAN;
PutDiskObjectnull384 FUNCTION PutDiskObject(const name : RawByteString;const diskobj : pDiskObject) : BOOLEAN;
385 
386 { version 44 overlay}
GetIconTagListnull387 FUNCTION GetIconTagList(CONST name : RawByteString; CONST tags : pTagItem) : pDiskObject;
PutIconTagListnull388 FUNCTION PutIconTagList(CONST name : RawByteString; CONST icon : pDiskObject; CONST tags : pTagItem) : BOOLEAN;
389 
390 {macros}
PACK_ICON_ASPECT_RATIOnull391 function PACK_ICON_ASPECT_RATIO(num,den : longint) : longint;
392 
393 IMPLEMENTATION
394 
PACK_ICON_ASPECT_RATIOnull395 function PACK_ICON_ASPECT_RATIO(num,den : longint) : longint;
396 begin
397     PACK_ICON_ASPECT_RATIO:=(num shl 4) or den;
398 end;
399 
400 
BumpRevisionnull401 FUNCTION BumpRevision(newname : pCHar;const oldname : RawByteString) : pCHAR;
402 begin
403       BumpRevision := BumpRevision(newname,PChar(oldname));
404 end;
405 
DeleteDiskObjectnull406 FUNCTION DeleteDiskObject(const name : RawByteString) : BOOLEAN;
407 begin
408       DeleteDiskObject := DeleteDiskObject(PChar(name));
409 end;
410 
FindToolTypenull411 FUNCTION FindToolType(const toolTypeArray : POINTER;const typeName : RawByteString) : pCHAR;
412 begin
413       FindToolType := FindToolType(toolTypeArray,PChar(typeName));
414 end;
415 
GetDiskObjectnull416 FUNCTION GetDiskObject(const name : RawByteString) : pDiskObject;
417 begin
418       GetDiskObject := GetDiskObject(PChar(name));
419 end;
420 
GetDiskObjectNewnull421 FUNCTION GetDiskObjectNew(const name : RawByteString) : pDiskObject;
422 begin
423       GetDiskObjectNew := GetDiskObjectNew(PChar(name));
424 end;
425 
MatchToolValuenull426 FUNCTION MatchToolValue(const typeString : RawByteString;const value : pCHAR) : BOOLEAN;
427 begin
428        MatchToolValue := MatchToolValue(PChar(typeString),value);
429 end;
430 
MatchToolValuenull431 FUNCTION MatchToolValue(const typeString : pCHAR;const value : RawByteString) : BOOLEAN;
432 begin
433        MatchToolValue := MatchToolValue(typeString,PChar(value));
434 end;
435 
MatchToolValuenull436 FUNCTION MatchToolValue(const typeString : RawByteString;const value : RawByteString) : BOOLEAN;
437 begin
438        MatchToolValue := MatchToolValue(PChar(typeString),PChar(value));
439 end;
440 
PutDiskObjectnull441 FUNCTION PutDiskObject(const name : RawByteString;const diskobj : pDiskObject) : BOOLEAN;
442 begin
443        PutDiskObject := PutDiskObject(PChar(name),diskobj);
444 end;
445 
GetIconTagListnull446 FUNCTION GetIconTagList(CONST name : RawByteString; CONST tags : pTagItem) : pDiskObject;
447 begin
448        GetIconTagList := GetIconTagList(PChar(name),tags);
449 end;
450 
PutIconTagListnull451 FUNCTION PutIconTagList(CONST name : RawByteString; CONST icon : pDiskObject; CONST tags : pTagItem) : BOOLEAN;
452 begin
453        PutIconTagList := PutIconTagList(PChar(name),icon,tags);
454 end;
455 
456 const
457     { Change VERSION and LIBVERSION to proper values }
458     VERSION : string[2] = '0';
459     LIBVERSION : longword = 0;
460 
461 initialization
462   IconBase := OpenLibrary(ICONNAME,LIBVERSION);
463 finalization
464   if Assigned(IconBase) then
465     CloseLibrary(IconBase);
466 END. (* UNIT ICON *)
467 
468 
469 
470 
471