2
0

iffparse.pas 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2014 by Free Pascal development team
  4. iffparse.library functions
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit iffparse;
  12. interface
  13. {$mode objfpc}
  14. uses exec, clipboard, utility;
  15. const
  16. IFFPARSENAME : PChar = 'iffparse.library';
  17. {
  18. * Struct associated with an active IFF stream.
  19. * "iff_Stream" is a value used by the client's read/write/seek functions -
  20. * it will not be accessed by the library itself and can have any value
  21. * (could even be a pointer or a BPTR).
  22. }
  23. Type
  24. PIFFHandle = ^TIFFHandle;
  25. TIFFHandle = record
  26. iff_Stream,
  27. iff_Flags : LongWord;
  28. iff_Depth : LongInt; { Depth of context stack. }
  29. { There are private fields hiding here. }
  30. end;
  31. {
  32. * Bit masks for "iff_Flags" field.
  33. }
  34. const
  35. IFFF_READ = 0; { read mode - default }
  36. IFFF_WRITE = 1; { write mode }
  37. IFFF_RWBITS = (IFFF_READ + IFFF_WRITE); { read/write bits }
  38. IFFF_FSEEK = 2; { forward seek only }
  39. IFFF_RSEEK = 4; { random seek }
  40. IFFF_RESERVED = $FFFF0000; { Don't touch these bits. }
  41. {
  42. * When the library calls your stream handler, you'll be passed a Pointer
  43. * to this structure as the "message packet".
  44. }
  45. type
  46. PIFFStreamCmd = ^TIFFStreamCmd;
  47. TIFFStreamCmd = record
  48. sc_Command : LongInt; { Operation to be performed (IFFCMD_) }
  49. sc_Buf : Pointer; { Pointer to data buffer }
  50. sc_NBytes : LongInt; { Number of bytes to be affected }
  51. end;
  52. {
  53. * A node associated with a context on the iff_Stack. Each node
  54. * represents a chunk, the stack representing the current nesting
  55. * of chunks in the open IFF file. Each context node has associated
  56. * local context items in the (private) LocalItems list. The ID, type,
  57. * size and scan values describe the chunk associated with this node.
  58. }
  59. PContextNode = ^TContextNode;
  60. TContextNode = record
  61. cn_Node : TMinNode;
  62. cn_ID,
  63. cn_Type,
  64. cn_Size, { Size of this chunk }
  65. cn_Scan : LongInt; { # of bytes read/written so far }
  66. { There are private fields hiding here. }
  67. end;
  68. {
  69. * Local context items live in the ContextNode's. Each class is identified
  70. * by its lci_Ident code and has a (private) purge vector for when the
  71. * parent context node is popped.
  72. }
  73. PLocalContextItem = ^TLocalContextItem;
  74. TLocalContextItem = record
  75. lci_Node : TMinNode;
  76. lci_ID,
  77. lci_Type,
  78. lci_Ident : LongWord;
  79. { There are private fields hiding here. }
  80. end;
  81. {
  82. * StoredProperty: a local context item containing the data stored
  83. * from a previously encountered property chunk.
  84. }
  85. PStoredProperty = ^TStoredProperty;
  86. TStoredProperty = record
  87. sp_Size : LongInt;
  88. sp_Data : Pointer;
  89. end;
  90. {
  91. * Collection Item: the actual node in the collection list at which
  92. * client will look. The next pointers cross context boundaries so
  93. * that the complete list is accessable.
  94. }
  95. PCollectionItem = ^TCollectionItem;
  96. TCollectionItem = record
  97. ci_Next : PCollectionItem;
  98. ci_Size : LongInt;
  99. ci_Data : Pointer;
  100. end;
  101. {
  102. * Structure returned by OpenClipboard(). You may do CMD_POSTs and such
  103. * using this structure. However, once you call OpenIFF(), you may not
  104. * do any more of your own I/O to the clipboard until you call CloseIFF().
  105. }
  106. PClipboardHandle = ^TClipBoardHandle;
  107. TClipboardHandle = record
  108. cbh_Req : TIOClipReq;
  109. cbh_CBport,
  110. cbh_SatisfyPort : TMsgPort;
  111. end;
  112. {
  113. * IFF return codes. Most functions return either zero for success or
  114. * one of these codes. The exceptions are the read/write functions which
  115. * return positive values for number of bytes or records read or written,
  116. * or a negative error code. Some of these codes are not errors per sae,
  117. * but valid conditions such as EOF or EOC (end of Chunk).
  118. }
  119. const
  120. IFFERR_EOF = -1 ; { Reached logical end of file }
  121. IFFERR_EOC = -2 ; { About to leave context }
  122. IFFERR_NOSCOPE = -3 ; { No valid scope for property }
  123. IFFERR_NOMEM = -4 ; { Internal memory alloc failed}
  124. IFFERR_READ = -5 ; { Stream read error }
  125. IFFERR_WRITE = -6 ; { Stream write error }
  126. IFFERR_SEEK = -7 ; { Stream seek error }
  127. IFFERR_MANGLED = -8 ; { Data in file is corrupt }
  128. IFFERR_SYNTAX = -9 ; { IFF syntax error }
  129. IFFERR_NOTIFF = -10; { Not an IFF file }
  130. IFFERR_NOHOOK = -11; { No call-back hook provided }
  131. IFF_RETURN2CLIENT = -12; { Client handler normal return}
  132. {
  133. MAKE_ID(a,b,c,d) \
  134. ((LongWord) (a)<<24 | (LongWord) (b)<<16 | (LongWord) (c)<<8 | (LongWord) (d))
  135. }
  136. {
  137. * Universal IFF identifiers.
  138. }
  139. ID_FORM = 1179603533;
  140. ID_LIST = 1279873876;
  141. ID_CAT = 1128354848;
  142. ID_PROP = 1347571536;
  143. ID_NULL = 538976288;
  144. {
  145. * Ident codes for universally recognized local context items.
  146. }
  147. IFFLCI_PROP = 1886547824;
  148. IFFLCI_COLLECTION = 1668246636;
  149. IFFLCI_ENTRYHANDLER = 1701734500;
  150. IFFLCI_EXITHANDLER = 1702389860;
  151. {
  152. * Control modes for ParseIFF() function.
  153. }
  154. IFFPARSE_SCAN = 0;
  155. IFFPARSE_STEP = 1;
  156. IFFPARSE_RAWSTEP = 2;
  157. {
  158. * Control modes for StoreLocalItem().
  159. }
  160. IFFSLI_ROOT = 1; { Store in default context }
  161. IFFSLI_TOP = 2; { Store in current context }
  162. IFFSLI_PROP = 3; { Store in topmost FORM OR LIST }
  163. {
  164. * "Flag" for writing functions. If you pass this value in as a size
  165. * to PushChunk() when writing a file, the parser will figure out the
  166. * size of the chunk for you. (Chunk sizes >= 2**31 are forbidden by the
  167. * IFF specification, so this works.)
  168. }
  169. IFFSIZE_UNKNOWN = -1;
  170. {
  171. * Possible call-back command values. (Using 0 as the value for IFFCMD_INIT
  172. * was, in retrospect, probably a bad idea.)
  173. }
  174. IFFCMD_INIT = 0; { Prepare the stream for a session }
  175. IFFCMD_CLEANUP = 1; { Terminate stream session }
  176. IFFCMD_READ = 2; { Read bytes from stream }
  177. IFFCMD_WRITE = 3; { Write bytes to stream }
  178. IFFCMD_SEEK = 4; { Seek on stream }
  179. IFFCMD_ENTRY = 5; { You just entered a new context }
  180. IFFCMD_EXIT = 6; { You're about to leave a context }
  181. IFFCMD_PURGELCI= 7; { Purge a LocalContextItem }
  182. { Backward compatibility. Don't use these in new code. }
  183. IFFSCC_INIT = IFFCMD_INIT;
  184. IFFSCC_CLEANUP = IFFCMD_CLEANUP;
  185. IFFSCC_READ = IFFCMD_READ;
  186. IFFSCC_WRITE = IFFCMD_WRITE;
  187. IFFSCC_SEEK = IFFCMD_SEEK;
  188. var IFFParseBase: PLibrary;
  189. function AllocIFF: PIFFHandle; syscall IFFParseBase 5;
  190. function AllocLocalItem(Typ: LongInt; Id: LongInt; Ident: LongInt; DataSize: LongInt): PLocalContextItem; syscall IFFParseBase 31;
  191. procedure CloseClipboard(ClipHandle: PClipboardHandle); syscall IFFParseBase 42;
  192. procedure CloseIFF(Iff: PIFFHandle); syscall IFFParseBase 8;
  193. function CollectionChunk(Iff: PIFFHandle; Typ: LongInt; Id: LongInt): LongInt; syscall IFFParseBase 23;
  194. function CollectionChunks(Iff : PIFFHandle;const PropArray: PLongInt; NumPairs: LongInt): LongInt; syscall IFFParseBase 24;
  195. function CurrentChunk(const Iff: PIFFHandle): PContextNode; syscall IFFParseBase 29;
  196. function EntryHandler(Iff: PIFFHandle; Typ: LongInt; Id: LongInt; Position: LongInt; Handler: PHook; Obj: Pointer): LongInt; syscall IFFParseBase 17;
  197. function ExitHandler(Iff: PIFFHandle; Typ: LongInt; Id: LongInt; Position: LongInt; Handler: PHook; Obj: Pointer): LongInt; syscall IFFParseBase 18;
  198. function FindCollection(const Iff: PIFFHandle; Typ: LongInt; Id: LongInt): PCollectionItem; syscall IFFParseBase 27;
  199. function FindLocalItem(const Iff: PIFFHandle; Typ: LongInt; Id: LongInt; Ident: LongInt): PLocalContextItem; syscall IFFParseBase 35;
  200. function FindProp(const Iff: PIFFHandle; Typ: LongInt; Id: LongInt): PStoredProperty; syscall IFFParseBase 26;
  201. function FindPropContext(const Iff: PIFFHandle): PContextNode; syscall IFFParseBase 28;
  202. procedure FreeIFF(Iff: PIFFHandle); syscall IFFParseBase 9;
  203. procedure FreeLocalItem(LocalItem: PLocalContextItem); syscall IFFParseBase 34;
  204. function GoodID(Id: LongInt): LongInt; syscall IFFParseBase 43;
  205. function GoodType(Typ: LongInt): LongInt; syscall IFFParseBase 44;
  206. function IDtoStr(Id: LongInt; Buf: PChar): PChar; syscall IFFParseBase 45;
  207. procedure InitIFF(Iff: PIFFHandle; Flags: LongInt;const StreamHook: PHook); syscall IFFParseBase 38;
  208. procedure InitIFFasClip(Iff: PIFFHandle); syscall IFFParseBase 40;
  209. procedure InitIFFasDOS(Iff: PIFFHandle); syscall IFFParseBase 39;
  210. function LocalItemData(const LocalItem: PLocalContextItem): Pointer; syscall IFFParseBase 32;
  211. function OpenClipboard(unitNumber: LongInt): PClipboardHandle; syscall IFFParseBase 41;
  212. function OpenIFF(Iff: PIFFHandle; rwMode: LongInt): LongInt; syscall IFFParseBase 6;
  213. function ParentChunk(const contextNode: PContextNode): PContextNode; syscall IFFParseBase 30;
  214. function ParseIFF(Iff: PIFFHandle; control: LongInt): LongInt; syscall IFFParseBase 7;
  215. function PopChunk(Iff: PIFFHandle): LongInt; syscall IFFParseBase 15;
  216. function PropChunk(Iff: PIFFHandle; Typ: LongInt; Id: LongInt): LongInt; syscall IFFParseBase 19;
  217. function PropChunks(Iff: PIFFHandle;const PropArray: PLongInt; NumPairs: LongInt): LongInt; syscall IFFParseBase 20;
  218. function PushChunk(Iff: PIFFHandle; Typ: LongInt; Id: LongInt; size: LongInt): LongInt; syscall IFFParseBase 14;
  219. function ReadChunkBytes(Iff: PIFFHandle; Buf: Pointer; numBytes: LongInt): LongInt; syscall IFFParseBase 10;
  220. function ReadChunkRecords(Iff: PIFFHandle; Buf: Pointer; bytesPerRecord: LongInt; numRecords: LongInt): LongInt; syscall IFFParseBase 12;
  221. procedure SetLocalItemPurge(LocalItem: PLocalContextItem;const purgeHook: PHook); syscall IFFParseBase 33;
  222. function StopChunk(Iff: PIFFHandle; Typ: LongInt; Id: LongInt): LongInt; syscall IFFParseBase 21;
  223. function StopChunks(Iff: PIFFHandle;const PropArray: PLongInt; NumPairs: LongInt): LongInt; syscall IFFParseBase 22;
  224. function StopOnExit(Iff: PIFFHandle; Typ: LongInt; Id: LongInt): LongInt; syscall IFFParseBase 25;
  225. procedure StoreItemInContext(Iff: PIFFHandle; LocalItem: PLocalContextItem; contextNode: PContextNode); syscall IFFParseBase 37;
  226. function StoreLocalItem(Iff: PIFFHandle; LocalItem: PLocalContextItem; Position: LongInt): LongInt; syscall IFFParseBase 36;
  227. function WriteChunkBytes(Iff: PIFFHandle;const Buf: Pointer; NumBytes: LongInt): LongInt; syscall IFFParseBase 11;
  228. function WriteChunkRecords(Iff: PIFFHandle;const Buf: Pointer; BytesPerRecord: LongInt; NumRecords: LongInt): LongInt; syscall IFFParseBase 13;
  229. function Make_ID(str: String): LongInt;
  230. implementation
  231. function Make_ID(str: String): LongInt;
  232. begin
  233. Make_ID:= (LongInt(Ord(Str[1])) shl 24) or
  234. (LongInt(Ord(Str[2])) shl 16 ) or
  235. (LongInt(Ord(Str[3])) shl 8 ) or (LongInt(Ord(Str[4])));
  236. end;
  237. initialization
  238. IFFParseBase := OpenLibrary(IFFPARSENAME, 0);
  239. finalization
  240. CloseLibrary(IFFParseBase);
  241. end. (* UNIT IFFPARSE *)