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 of
21 the library.
22 14 Jan 2003.
23
24 Added function Make_ID.
25 14 Jan 2003.
26
27 Update for AmigaOS 3.9.
28 Changed start code for unit.
29 01 Feb 2003.
30
31 Changed cardinal > longword.
32 09 Feb 2003.
33
34 nils.sjoholm@mailbox.swipnet.se Nils Sjoholm
35 }
36 {$PACKRECORDS 2}
37
38 unit iffparse;
39
40 INTERFACE
41
42 uses exec, clipboard, utility;
43
44
45 const
46
47 IFFPARSENAME : PChar = 'iffparse.library';
48
49 {
50 * Struct associated with an active IFF stream.
51 * "iff_Stream" is a value used by the client's read/write/seek functions -
52 * it will not be accessed by the library itself and can have any value
53 * (could even be a pointer or a BPTR).
54 }
55 Type
56 pIFFHandle = ^tIFFHandle;
57 tIFFHandle = record
58 iff_Stream,
59 iff_Flags : ULONG;
60 iff_Depth : LONGINT; { Depth of context stack. }
61 { There are private fields hiding here. }
62 END;
63
64 {
65 * Bit masks for "iff_Flags" field.
66 }
67 CONST
68 IFFF_READ = 0; { read mode - default }
69 IFFF_WRITE = 1; { write mode }
70 IFFF_RWBITS = (IFFF_READ + IFFF_WRITE); { read/write bits }
71 IFFF_FSEEK = 2; { forward seek only }
72 IFFF_RSEEK = 4; { random seek }
73 IFFF_RESERVED = $FFFF0000; { Don't touch these bits. }
74
75 {
76 * When the library calls your stream handler, you'll be passed a pointer
77 * to this structure as the "message packet".
78 }
79 Type
80 pIFFStreamCmd = ^tIFFStreamCmd;
81 tIFFStreamCmd = record
82 sc_Command : Longint; { Operation to be performed (IFFCMD_) }
83 sc_Buf : Pointer; { Pointer to data buffer }
84 sc_NBytes : Longint; { Number of bytes to be affected }
85 END;
86 {
87 * A node associated with a context on the iff_Stack. Each node
88 * represents a chunk, the stack representing the current nesting
89 * of chunks in the open IFF file. Each context node has associated
90 * local context items in the (private) LocalItems list. The ID, type,
91 * size and scan values describe the chunk associated with this node.
92 }
93 pContextNode = ^tContextNode;
94 tContextNode = record
95 cn_Node : tMinNode;
96 cn_ID,
97 cn_Type,
98 cn_Size, { Size of this chunk }
99 cn_Scan : Longint; { # of bytes read/written so far }
100 { There are private fields hiding here. }
101 END;
102
103 {
104 * Local context items live in the ContextNode's. Each class is identified
105 * by its lci_Ident code and has a (private) purge vector for when the
106 * parent context node is popped.
107 }
108 pLocalContextItem = ^tLocalContextItem;
109 tLocalContextItem = record
110 lci_Node : tMinNode;
111 lci_ID,
112 lci_Type,
113 lci_Ident : ULONG;
114 { There are private fields hiding here. }
115 END;
116
117 {
118 * StoredProperty: a local context item containing the data stored
119 * from a previously encountered property chunk.
120 }
121 pStoredProperty = ^tStoredProperty;
122 tStoredProperty = Record
123 sp_Size : Longint;
124 sp_Data : Pointer;
125 END;
126
127 {
128 * Collection Item: the actual node in the collection list at which
129 * client will look. The next pointers cross context boundaries so
130 * that the complete list is accessable.
131 }
132 pCollectionItem = ^tCollectionItem;
133 tCollectionItem = record
134 ci_Next : pCollectionItem;
135 ci_Size : Longint;
136 ci_Data : Pointer;
137 END;
138
139 {
140 * Structure returned by OpenClipboard(). You may do CMD_POSTs and such
141 * using this structure. However, once you call OpenIFF(), you may not
142 * do any more of your own I/O to the clipboard until you call CloseIFF().
143 }
144 pClipboardHandle = ^tClipBoardHandle;
145 tClipboardHandle = record
146 cbh_Req : tIOClipReq;
147 cbh_CBport,
148 cbh_SatisfyPort : tMsgPort;
149 END;
150
151 {
152 * IFF return codes. Most functions return either zero for success or
153 * one of these codes. The exceptions are the read/write functions which
154 * return positive values for number of bytes or records read or written,
155 * or a negative error code. Some of these codes are not errors per sae,
156 * but valid conditions such as EOF or EOC (End of Chunk).
157 }
158 CONST
159 IFFERR_EOF = -1 ; { Reached logical END of file }
160 IFFERR_EOC = -2 ; { About to leave context }
161 IFFERR_NOSCOPE = -3 ; { No valid scope for property }
162 IFFERR_NOMEM = -4 ; { Internal memory alloc failed}
163 IFFERR_READ = -5 ; { Stream read error }
164 IFFERR_WRITE = -6 ; { Stream write error }
165 IFFERR_SEEK = -7 ; { Stream seek error }
166 IFFERR_MANGLED = -8 ; { Data in file is corrupt }
167 IFFERR_SYNTAX = -9 ; { IFF syntax error }
168 IFFERR_NOTIFF = -10; { Not an IFF file }
169 IFFERR_NOHOOK = -11; { No call-back hook provided }
170 IFF_RETURN2CLIENT = -12; { Client handler normal return}
171
172 {
173 MAKE_ID(a,b,c,d) \
174 ((ULONG) (a)<<24 | (ULONG) (b)<<16 | (ULONG) (c)<<8 | (ULONG) (d))
175 }
176 {
177 * Universal IFF identifiers.
178 }
179 ID_FORM = 1179603533;
180 ID_LIST = 1279873876;
181 ID_CAT = 1128354848;
182 ID_PROP = 1347571536;
183 ID_NULL = 538976288;
184
185 {
186 * Ident codes for universally recognized local context items.
187 }
188 IFFLCI_PROP = 1886547824;
189 IFFLCI_COLLECTION = 1668246636;
190 IFFLCI_ENTRYHANDLER = 1701734500;
191 IFFLCI_EXITHANDLER = 1702389860;
192
193
194 {
195 * Control modes for ParseIFF() function.
196 }
197 IFFPARSE_SCAN = 0;
198 IFFPARSE_STEP = 1;
199 IFFPARSE_RAWSTEP = 2;
200
201 {
202 * Control modes for StoreLocalItem().
203 }
204 IFFSLI_ROOT = 1; { Store in default context }
205 IFFSLI_TOP = 2; { Store in current context }
206 IFFSLI_PROP = 3; { Store in topmost FORM OR LIST }
207
208 {
209 * "Flag" for writing functions. If you pass this value in as a size
210 * to PushChunk() when writing a file, the parser will figure out the
211 * size of the chunk for you. (Chunk sizes >= 2**31 are forbidden by the
212 * IFF specification, so this works.)
213 }
214 IFFSIZE_UNKNOWN = -1;
215
216 {
217 * Possible call-back command values. (Using 0 as the value for IFFCMD_INIT
218 * was, in retrospect, probably a bad idea.)
219 }
220 IFFCMD_INIT = 0; { Prepare the stream for a session }
221 IFFCMD_CLEANUP = 1; { Terminate stream session }
222 IFFCMD_READ = 2; { Read bytes from stream }
223 IFFCMD_WRITE = 3; { Write bytes to stream }
224 IFFCMD_SEEK = 4; { Seek on stream }
225 IFFCMD_ENTRY = 5; { You just entered a new context }
226 IFFCMD_EXIT = 6; { You're about to leave a context }
227 IFFCMD_PURGELCI= 7; { Purge a LocalContextItem }
228
229 { Backward compatibility. Don't use these in new code. }
230 IFFSCC_INIT = IFFCMD_INIT;
231 IFFSCC_CLEANUP = IFFCMD_CLEANUP;
232 IFFSCC_READ = IFFCMD_READ;
233 IFFSCC_WRITE = IFFCMD_WRITE;
234 IFFSCC_SEEK = IFFCMD_SEEK;
235
236 VAR IFFParseBase : pLibrary = nil;
237
AllocIFFnull238 FUNCTION AllocIFF : pIFFHandle; syscall IFFParseBase 030;
AllocLocalItemnull239 FUNCTION AllocLocalItem(typ : LONGINT location 'd0'; id : LONGINT location 'd1'; ident : LONGINT location 'd2'; dataSize : LONGINT location 'd3') : pLocalContextItem; syscall IFFParseBase 186;
240 PROCEDURE CloseClipboard(clipHandle : pClipboardHandle location 'a0'); syscall IFFParseBase 252;
241 PROCEDURE CloseIFF(iff : pIFFHandle location 'a0'); syscall IFFParseBase 048;
CollectionChunknull242 FUNCTION CollectionChunk(iff : pIFFHandle location 'a0'; typ : LONGINT location 'd0'; id : LONGINT location 'd1') : LONGINT; syscall IFFParseBase 138;
CollectionChunksnull243 FUNCTION CollectionChunks(iff : pIFFHandle location 'a0'; const propArray : pLONGINT location 'a1'; numPairs : LONGINT location 'd0') : LONGINT; syscall IFFParseBase 144;
CurrentChunknull244 FUNCTION CurrentChunk(const iff : pIFFHandle location 'a0') : pContextNode; syscall IFFParseBase 174;
EntryHandlernull245 FUNCTION EntryHandler(iff : pIFFHandle location 'a0'; typ : LONGINT location 'd0'; id : LONGINT location 'd1'; position : LONGINT location 'd2'; handler : pHook location 'a1'; obj : POINTER location 'a2') : LONGINT; syscall IFFParseBase 102;
ExitHandlernull246 FUNCTION ExitHandler(iff : pIFFHandle location 'a0'; typ : LONGINT location 'd0'; id : LONGINT location 'd1'; position : LONGINT location 'd2'; handler : pHook location 'a1'; obj : POINTER location 'a2') : LONGINT; syscall IFFParseBase 108;
FindCollectionnull247 FUNCTION FindCollection(const iff : pIFFHandle location 'a0'; typ : LONGINT location 'd0'; id : LONGINT location 'd1') : pCollectionItem; syscall IFFParseBase 162;
FindLocalItemnull248 FUNCTION FindLocalItem(const iff : pIFFHandle location 'a0'; typ : LONGINT location 'd0'; id : LONGINT location 'd1'; ident : LONGINT location 'd2') : pLocalContextItem; syscall IFFParseBase 210;
FindPropnull249 FUNCTION FindProp(const iff : pIFFHandle location 'a0'; typ : LONGINT location 'd0'; id : LONGINT location 'd1') : pStoredProperty; syscall IFFParseBase 156;
FindPropContextnull250 FUNCTION FindPropContext(const iff : pIFFHandle location 'a0') : pContextNode; syscall IFFParseBase 168;
251 PROCEDURE FreeIFF(iff : pIFFHandle location 'a0'); syscall IFFParseBase 054;
252 PROCEDURE FreeLocalItem(localItem : pLocalContextItem location 'a0'); syscall IFFParseBase 204;
GoodIDnull253 FUNCTION GoodID(id : LONGINT location 'd0') : LONGINT; syscall IFFParseBase 258;
GoodTypenull254 FUNCTION GoodType(typ : LONGINT location 'd0') : LONGINT; syscall IFFParseBase 264;
IDtoStrnull255 FUNCTION IDtoStr(id : LONGINT location 'd0'; buf : pCHAR location 'a0') : pCHAR; syscall IFFParseBase 270;
256 PROCEDURE InitIFF(iff : pIFFHandle location 'a0'; flags : LONGINT location 'd0'; const streamHook : pHook location 'a1'); syscall IFFParseBase 228;
257 PROCEDURE InitIFFasClip(iff : pIFFHandle location 'a0'); syscall IFFParseBase 240;
258 PROCEDURE InitIFFasDOS(iff : pIFFHandle location 'a0'); syscall IFFParseBase 234;
LocalItemDatanull259 FUNCTION LocalItemData(const localItem : pLocalContextItem location 'a0') : POINTER; syscall IFFParseBase 192;
OpenClipboardnull260 FUNCTION OpenClipboard(unitNumber : LONGINT location 'd0') : pClipboardHandle; syscall IFFParseBase 246;
OpenIFFnull261 FUNCTION OpenIFF(iff : pIFFHandle location 'a0'; rwMode : LONGINT location 'd0') : LONGINT; syscall IFFParseBase 036;
ParentChunknull262 FUNCTION ParentChunk(const contextNode : pContextNode location 'a0') : pContextNode; syscall IFFParseBase 180;
ParseIFFnull263 FUNCTION ParseIFF(iff : pIFFHandle location 'a0'; control : LONGINT location 'd0') : LONGINT; syscall IFFParseBase 042;
PopChunknull264 FUNCTION PopChunk(iff : pIFFHandle location 'a0') : LONGINT; syscall IFFParseBase 090;
PropChunknull265 FUNCTION PropChunk(iff : pIFFHandle location 'a0'; typ : LONGINT location 'd0'; id : LONGINT location 'd1') : LONGINT; syscall IFFParseBase 114;
PropChunksnull266 FUNCTION PropChunks(iff : pIFFHandle location 'a0'; const propArray : pLONGINT location 'a1'; numPairs : LONGINT location 'd0') : LONGINT; syscall IFFParseBase 120;
PushChunknull267 FUNCTION PushChunk(iff : pIFFHandle location 'a0'; typ : LONGINT location 'd0'; id : LONGINT location 'd1'; size : LONGINT location 'd2') : LONGINT; syscall IFFParseBase 084;
ReadChunkBytesnull268 FUNCTION ReadChunkBytes(iff : pIFFHandle location 'a0'; buf : POINTER location 'a1'; numBytes : LONGINT location 'd0') : LONGINT; syscall IFFParseBase 060;
ReadChunkRecordsnull269 FUNCTION ReadChunkRecords(iff : pIFFHandle location 'a0'; buf : POINTER location 'a1'; bytesPerRecord : LONGINT location 'd0'; numRecords : LONGINT location 'd1') : LONGINT; syscall IFFParseBase 072;
270 PROCEDURE SetLocalItemPurge(localItem : pLocalContextItem location 'a0'; const purgeHook : pHook location 'a1'); syscall IFFParseBase 198;
StopChunknull271 FUNCTION StopChunk(iff : pIFFHandle location 'a0'; typ : LONGINT location 'd0'; id : LONGINT location 'd1') : LONGINT; syscall IFFParseBase 126;
StopChunksnull272 FUNCTION StopChunks(iff : pIFFHandle location 'a0'; const propArray : pLONGINT location 'a1'; numPairs : LONGINT location 'd0') : LONGINT; syscall IFFParseBase 132;
StopOnExitnull273 FUNCTION StopOnExit(iff : pIFFHandle location 'a0'; typ : LONGINT location 'd0'; id : LONGINT location 'd1') : LONGINT; syscall IFFParseBase 150;
274 PROCEDURE StoreItemInContext(iff : pIFFHandle location 'a0'; localItem : pLocalContextItem location 'a1'; contextNode : pContextNode location 'a2'); syscall IFFParseBase 222;
StoreLocalItemnull275 FUNCTION StoreLocalItem(iff : pIFFHandle location 'a0'; localItem : pLocalContextItem location 'a1'; position : LONGINT location 'd0') : LONGINT; syscall IFFParseBase 216;
WriteChunkBytesnull276 FUNCTION WriteChunkBytes(iff : pIFFHandle location 'a0'; const buf : POINTER location 'a1'; numBytes : LONGINT location 'd0') : LONGINT; syscall IFFParseBase 066;
WriteChunkRecordsnull277 FUNCTION WriteChunkRecords(iff : pIFFHandle location 'a0'; const buf : POINTER location 'a1'; bytesPerRecord : LONGINT location 'd0'; numRecords : LONGINT location 'd1') : LONGINT; syscall IFFParseBase 078;
278
Make_IDnull279 Function Make_ID(str : String) : LONGINT;
280
281 IMPLEMENTATION
282
Make_IDnull283 Function Make_ID(str : String) : LONGINT;
284 begin
285 Make_ID := (LONGINT(Ord(Str[1])) shl 24) or
286 (LONGINT(Ord(Str[2])) shl 16 ) or
287 (LONGINT(Ord(Str[3])) shl 8 ) or (LONGINT(Ord(Str[4])));
288 end;
289
290 const
291 { Change VERSION and LIBVERSION to proper values }
292 VERSION : string[2] = '0';
293 LIBVERSION : longword = 0;
294
295 initialization
296 IFFParseBase := OpenLibrary(IFFPARSENAME,LIBVERSION);
297 finalization
298 if Assigned(IFFParseBase) then
299 CloseLibrary(IFFParseBase);
300 END. (* UNIT IFFPARSE *)
301
302
303
304
305
306