iffparse.pas 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924
  1. {
  2. This file is part of the Free Pascal run time library.
  3. A file in Amiga system run time library.
  4. Copyright (c) 1998-2003 by Nils Sjoholm
  5. member of the Amiga RTL development team.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {
  13. History:
  14. Added the defines use_amiga_smartlink and
  15. use_auto_openlib. Implemented autoopening of
  16. the library.
  17. 14 Jan 2003.
  18. Added function Make_ID.
  19. 14 Jan 2003.
  20. Update for AmigaOS 3.9.
  21. Changed start code for unit.
  22. 01 Feb 2003.
  23. Changed cardinal > longword.
  24. 09 Feb 2003.
  25. [email protected] Nils Sjoholm
  26. }
  27. {$I useamigasmartlink.inc}
  28. {$ifdef use_amiga_smartlink}
  29. {$smartlink on}
  30. {$endif use_amiga_smartlink}
  31. unit iffparse;
  32. INTERFACE
  33. uses exec, clipboard, utility;
  34. const
  35. IFFPARSENAME : PChar = 'iffparse.library';
  36. {
  37. * Struct associated with an active IFF stream.
  38. * "iff_Stream" is a value used by the client's read/write/seek functions -
  39. * it will not be accessed by the library itself and can have any value
  40. * (could even be a pointer or a BPTR).
  41. }
  42. Type
  43. pIFFHandle = ^tIFFHandle;
  44. tIFFHandle = record
  45. iff_Stream,
  46. iff_Flags : ULONG;
  47. iff_Depth : LONGINT; { Depth of context stack. }
  48. { There are private fields hiding here. }
  49. END;
  50. {
  51. * Bit masks for "iff_Flags" field.
  52. }
  53. CONST
  54. IFFF_READ = 0; { read mode - default }
  55. IFFF_WRITE = 1; { write mode }
  56. IFFF_RWBITS = (IFFF_READ + IFFF_WRITE); { read/write bits }
  57. IFFF_FSEEK = 2; { forward seek only }
  58. IFFF_RSEEK = 4; { random seek }
  59. IFFF_RESERVED = $FFFF0000; { Don't touch these bits. }
  60. {
  61. * When the library calls your stream handler, you'll be passed a pointer
  62. * to this structure as the "message packet".
  63. }
  64. Type
  65. pIFFStreamCmd = ^tIFFStreamCmd;
  66. tIFFStreamCmd = record
  67. sc_Command : Longint; { Operation to be performed (IFFCMD_) }
  68. sc_Buf : Pointer; { Pointer to data buffer }
  69. sc_NBytes : Longint; { Number of bytes to be affected }
  70. END;
  71. {
  72. * A node associated with a context on the iff_Stack. Each node
  73. * represents a chunk, the stack representing the current nesting
  74. * of chunks in the open IFF file. Each context node has associated
  75. * local context items in the (private) LocalItems list. The ID, type,
  76. * size and scan values describe the chunk associated with this node.
  77. }
  78. pContextNode = ^tContextNode;
  79. tContextNode = record
  80. cn_Node : tMinNode;
  81. cn_ID,
  82. cn_Type,
  83. cn_Size, { Size of this chunk }
  84. cn_Scan : Longint; { # of bytes read/written so far }
  85. { There are private fields hiding here. }
  86. END;
  87. {
  88. * Local context items live in the ContextNode's. Each class is identified
  89. * by its lci_Ident code and has a (private) purge vector for when the
  90. * parent context node is popped.
  91. }
  92. pLocalContextItem = ^tLocalContextItem;
  93. tLocalContextItem = record
  94. lci_Node : tMinNode;
  95. lci_ID,
  96. lci_Type,
  97. lci_Ident : ULONG;
  98. { There are private fields hiding here. }
  99. END;
  100. {
  101. * StoredProperty: a local context item containing the data stored
  102. * from a previously encountered property chunk.
  103. }
  104. pStoredProperty = ^tStoredProperty;
  105. tStoredProperty = Record
  106. sp_Size : Longint;
  107. sp_Data : Pointer;
  108. END;
  109. {
  110. * Collection Item: the actual node in the collection list at which
  111. * client will look. The next pointers cross context boundaries so
  112. * that the complete list is accessable.
  113. }
  114. pCollectionItem = ^tCollectionItem;
  115. tCollectionItem = record
  116. ci_Next : pCollectionItem;
  117. ci_Size : Longint;
  118. ci_Data : Pointer;
  119. END;
  120. {
  121. * Structure returned by OpenClipboard(). You may do CMD_POSTs and such
  122. * using this structure. However, once you call OpenIFF(), you may not
  123. * do any more of your own I/O to the clipboard until you call CloseIFF().
  124. }
  125. pClipboardHandle = ^tClipBoardHandle;
  126. tClipboardHandle = record
  127. cbh_Req : tIOClipReq;
  128. cbh_CBport,
  129. cbh_SatisfyPort : tMsgPort;
  130. END;
  131. {
  132. * IFF return codes. Most functions return either zero for success or
  133. * one of these codes. The exceptions are the read/write functions which
  134. * return positive values for number of bytes or records read or written,
  135. * or a negative error code. Some of these codes are not errors per sae,
  136. * but valid conditions such as EOF or EOC (End of Chunk).
  137. }
  138. CONST
  139. IFFERR_EOF = -1 ; { Reached logical END of file }
  140. IFFERR_EOC = -2 ; { About to leave context }
  141. IFFERR_NOSCOPE = -3 ; { No valid scope for property }
  142. IFFERR_NOMEM = -4 ; { Internal memory alloc failed}
  143. IFFERR_READ = -5 ; { Stream read error }
  144. IFFERR_WRITE = -6 ; { Stream write error }
  145. IFFERR_SEEK = -7 ; { Stream seek error }
  146. IFFERR_MANGLED = -8 ; { Data in file is corrupt }
  147. IFFERR_SYNTAX = -9 ; { IFF syntax error }
  148. IFFERR_NOTIFF = -10; { Not an IFF file }
  149. IFFERR_NOHOOK = -11; { No call-back hook provided }
  150. IFF_RETURN2CLIENT = -12; { Client handler normal return}
  151. {
  152. MAKE_ID(a,b,c,d) \
  153. ((ULONG) (a)<<24 | (ULONG) (b)<<16 | (ULONG) (c)<<8 | (ULONG) (d))
  154. }
  155. {
  156. * Universal IFF identifiers.
  157. }
  158. ID_FORM = 1179603533;
  159. ID_LIST = 1279873876;
  160. ID_CAT = 1128354848;
  161. ID_PROP = 1347571536;
  162. ID_NULL = 538976288;
  163. {
  164. * Ident codes for universally recognized local context items.
  165. }
  166. IFFLCI_PROP = 1886547824;
  167. IFFLCI_COLLECTION = 1668246636;
  168. IFFLCI_ENTRYHANDLER = 1701734500;
  169. IFFLCI_EXITHANDLER = 1702389860;
  170. {
  171. * Control modes for ParseIFF() function.
  172. }
  173. IFFPARSE_SCAN = 0;
  174. IFFPARSE_STEP = 1;
  175. IFFPARSE_RAWSTEP = 2;
  176. {
  177. * Control modes for StoreLocalItem().
  178. }
  179. IFFSLI_ROOT = 1; { Store in default context }
  180. IFFSLI_TOP = 2; { Store in current context }
  181. IFFSLI_PROP = 3; { Store in topmost FORM OR LIST }
  182. {
  183. * "Flag" for writing functions. If you pass this value in as a size
  184. * to PushChunk() when writing a file, the parser will figure out the
  185. * size of the chunk for you. (Chunk sizes >= 2**31 are forbidden by the
  186. * IFF specification, so this works.)
  187. }
  188. IFFSIZE_UNKNOWN = -1;
  189. {
  190. * Possible call-back command values. (Using 0 as the value for IFFCMD_INIT
  191. * was, in retrospect, probably a bad idea.)
  192. }
  193. IFFCMD_INIT = 0; { Prepare the stream for a session }
  194. IFFCMD_CLEANUP = 1; { Terminate stream session }
  195. IFFCMD_READ = 2; { Read bytes from stream }
  196. IFFCMD_WRITE = 3; { Write bytes to stream }
  197. IFFCMD_SEEK = 4; { Seek on stream }
  198. IFFCMD_ENTRY = 5; { You just entered a new context }
  199. IFFCMD_EXIT = 6; { You're about to leave a context }
  200. IFFCMD_PURGELCI= 7; { Purge a LocalContextItem }
  201. { Backward compatibility. Don't use these in new code. }
  202. IFFSCC_INIT = IFFCMD_INIT;
  203. IFFSCC_CLEANUP = IFFCMD_CLEANUP;
  204. IFFSCC_READ = IFFCMD_READ;
  205. IFFSCC_WRITE = IFFCMD_WRITE;
  206. IFFSCC_SEEK = IFFCMD_SEEK;
  207. VAR IFFParseBase : pLibrary;
  208. FUNCTION AllocIFF : pIFFHandle;
  209. FUNCTION AllocLocalItem(typ : LONGINT; id : LONGINT; ident : LONGINT; dataSize : LONGINT) : pLocalContextItem;
  210. PROCEDURE CloseClipboard(clipHandle : pClipboardHandle);
  211. PROCEDURE CloseIFF(iff : pIFFHandle);
  212. FUNCTION CollectionChunk(iff : pIFFHandle; typ : LONGINT; id : LONGINT) : LONGINT;
  213. FUNCTION CollectionChunks(iff : pIFFHandle;const propArray : pLONGINT; numPairs : LONGINT) : LONGINT;
  214. FUNCTION CurrentChunk(const iff : pIFFHandle) : pContextNode;
  215. FUNCTION EntryHandler(iff : pIFFHandle; typ : LONGINT; id : LONGINT; position : LONGINT; handler : pHook; obj : POINTER) : LONGINT;
  216. FUNCTION ExitHandler(iff : pIFFHandle; typ : LONGINT; id : LONGINT; position : LONGINT; handler : pHook; obj : POINTER) : LONGINT;
  217. FUNCTION FindCollection(const iff : pIFFHandle; typ : LONGINT; id : LONGINT) : pCollectionItem;
  218. FUNCTION FindLocalItem(const iff : pIFFHandle; typ : LONGINT; id : LONGINT; ident : LONGINT) : pLocalContextItem;
  219. FUNCTION FindProp(const iff : pIFFHandle; typ : LONGINT; id : LONGINT) : pStoredProperty;
  220. FUNCTION FindPropContext(const iff : pIFFHandle) : pContextNode;
  221. PROCEDURE FreeIFF(iff : pIFFHandle);
  222. PROCEDURE FreeLocalItem(localItem : pLocalContextItem);
  223. FUNCTION GoodID(id : LONGINT) : LONGINT;
  224. FUNCTION GoodType(typ : LONGINT) : LONGINT;
  225. FUNCTION IDtoStr(id : LONGINT; buf : pCHAR) : pCHAR;
  226. PROCEDURE InitIFF(iff : pIFFHandle; flags : LONGINT;const streamHook : pHook);
  227. PROCEDURE InitIFFasClip(iff : pIFFHandle);
  228. PROCEDURE InitIFFasDOS(iff : pIFFHandle);
  229. FUNCTION LocalItemData(const localItem : pLocalContextItem) : POINTER;
  230. FUNCTION OpenClipboard(unitNumber : LONGINT) : pClipboardHandle;
  231. FUNCTION OpenIFF(iff : pIFFHandle; rwMode : LONGINT) : LONGINT;
  232. FUNCTION ParentChunk(const contextNode : pContextNode) : pContextNode;
  233. FUNCTION ParseIFF(iff : pIFFHandle; control : LONGINT) : LONGINT;
  234. FUNCTION PopChunk(iff : pIFFHandle) : LONGINT;
  235. FUNCTION PropChunk(iff : pIFFHandle; typ : LONGINT; id : LONGINT) : LONGINT;
  236. FUNCTION PropChunks(iff : pIFFHandle;const propArray : pLONGINT; numPairs : LONGINT) : LONGINT;
  237. FUNCTION PushChunk(iff : pIFFHandle; typ : LONGINT; id : LONGINT; size : LONGINT) : LONGINT;
  238. FUNCTION ReadChunkBytes(iff : pIFFHandle; buf : POINTER; numBytes : LONGINT) : LONGINT;
  239. FUNCTION ReadChunkRecords(iff : pIFFHandle; buf : POINTER; bytesPerRecord : LONGINT; numRecords : LONGINT) : LONGINT;
  240. PROCEDURE SetLocalItemPurge(localItem : pLocalContextItem;const purgeHook : pHook);
  241. FUNCTION StopChunk(iff : pIFFHandle; typ : LONGINT; id : LONGINT) : LONGINT;
  242. FUNCTION StopChunks(iff : pIFFHandle;const propArray : pLONGINT; numPairs : LONGINT) : LONGINT;
  243. FUNCTION StopOnExit(iff : pIFFHandle; typ : LONGINT; id : LONGINT) : LONGINT;
  244. PROCEDURE StoreItemInContext(iff : pIFFHandle; localItem : pLocalContextItem; contextNode : pContextNode);
  245. FUNCTION StoreLocalItem(iff : pIFFHandle; localItem : pLocalContextItem; position : LONGINT) : LONGINT;
  246. FUNCTION WriteChunkBytes(iff : pIFFHandle;const buf : POINTER; numBytes : LONGINT) : LONGINT;
  247. FUNCTION WriteChunkRecords(iff : pIFFHandle;const buf : POINTER; bytesPerRecord : LONGINT; numRecords : LONGINT) : LONGINT;
  248. Function Make_ID(str : String) : LONGINT;
  249. {Here we read how to compile this unit}
  250. {You can remove this include and use a define instead}
  251. {$I useautoopenlib.inc}
  252. {$ifdef use_init_openlib}
  253. procedure InitIFFPARSELibrary;
  254. {$endif use_init_openlib}
  255. {This is a variable that knows how the unit is compiled}
  256. var
  257. IFFPARSEIsCompiledHow : longint;
  258. IMPLEMENTATION
  259. uses
  260. {$ifndef dont_use_openlib}
  261. msgbox;
  262. {$endif dont_use_openlib}
  263. FUNCTION AllocIFF : pIFFHandle;
  264. BEGIN
  265. ASM
  266. MOVE.L A6,-(A7)
  267. MOVEA.L IFFParseBase,A6
  268. JSR -030(A6)
  269. MOVEA.L (A7)+,A6
  270. MOVE.L D0,@RESULT
  271. END;
  272. END;
  273. FUNCTION AllocLocalItem(typ : LONGINT; id : LONGINT; ident : LONGINT; dataSize : LONGINT) : pLocalContextItem;
  274. BEGIN
  275. ASM
  276. MOVE.L A6,-(A7)
  277. MOVE.L typ,D0
  278. MOVE.L id,D1
  279. MOVE.L ident,D2
  280. MOVE.L dataSize,D3
  281. MOVEA.L IFFParseBase,A6
  282. JSR -186(A6)
  283. MOVEA.L (A7)+,A6
  284. MOVE.L D0,@RESULT
  285. END;
  286. END;
  287. PROCEDURE CloseClipboard(clipHandle : pClipboardHandle);
  288. BEGIN
  289. ASM
  290. MOVE.L A6,-(A7)
  291. MOVEA.L clipHandle,A0
  292. MOVEA.L IFFParseBase,A6
  293. JSR -252(A6)
  294. MOVEA.L (A7)+,A6
  295. END;
  296. END;
  297. PROCEDURE CloseIFF(iff : pIFFHandle);
  298. BEGIN
  299. ASM
  300. MOVE.L A6,-(A7)
  301. MOVEA.L iff,A0
  302. MOVEA.L IFFParseBase,A6
  303. JSR -048(A6)
  304. MOVEA.L (A7)+,A6
  305. END;
  306. END;
  307. FUNCTION CollectionChunk(iff : pIFFHandle; typ : LONGINT; id : LONGINT) : LONGINT;
  308. BEGIN
  309. ASM
  310. MOVE.L A6,-(A7)
  311. MOVEA.L iff,A0
  312. MOVE.L typ,D0
  313. MOVE.L id,D1
  314. MOVEA.L IFFParseBase,A6
  315. JSR -138(A6)
  316. MOVEA.L (A7)+,A6
  317. MOVE.L D0,@RESULT
  318. END;
  319. END;
  320. FUNCTION CollectionChunks(iff : pIFFHandle;const propArray : pLONGINT; numPairs : LONGINT) : LONGINT;
  321. BEGIN
  322. ASM
  323. MOVE.L A6,-(A7)
  324. MOVEA.L iff,A0
  325. MOVEA.L propArray,A1
  326. MOVE.L numPairs,D0
  327. MOVEA.L IFFParseBase,A6
  328. JSR -144(A6)
  329. MOVEA.L (A7)+,A6
  330. MOVE.L D0,@RESULT
  331. END;
  332. END;
  333. FUNCTION CurrentChunk(const iff : pIFFHandle) : pContextNode;
  334. BEGIN
  335. ASM
  336. MOVE.L A6,-(A7)
  337. MOVEA.L iff,A0
  338. MOVEA.L IFFParseBase,A6
  339. JSR -174(A6)
  340. MOVEA.L (A7)+,A6
  341. MOVE.L D0,@RESULT
  342. END;
  343. END;
  344. FUNCTION EntryHandler(iff : pIFFHandle; typ : LONGINT; id : LONGINT; position : LONGINT; handler : pHook; obj : POINTER) : LONGINT;
  345. BEGIN
  346. ASM
  347. MOVE.L A6,-(A7)
  348. MOVEA.L iff,A0
  349. MOVE.L typ,D0
  350. MOVE.L id,D1
  351. MOVE.L position,D2
  352. MOVEA.L handler,A1
  353. MOVEA.L obj,A2
  354. MOVEA.L IFFParseBase,A6
  355. JSR -102(A6)
  356. MOVEA.L (A7)+,A6
  357. MOVE.L D0,@RESULT
  358. END;
  359. END;
  360. FUNCTION ExitHandler(iff : pIFFHandle; typ : LONGINT; id : LONGINT; position : LONGINT; handler : pHook; obj : POINTER) : LONGINT;
  361. BEGIN
  362. ASM
  363. MOVE.L A6,-(A7)
  364. MOVEA.L iff,A0
  365. MOVE.L typ,D0
  366. MOVE.L id,D1
  367. MOVE.L position,D2
  368. MOVEA.L handler,A1
  369. MOVEA.L obj,A2
  370. MOVEA.L IFFParseBase,A6
  371. JSR -108(A6)
  372. MOVEA.L (A7)+,A6
  373. MOVE.L D0,@RESULT
  374. END;
  375. END;
  376. FUNCTION FindCollection(const iff : pIFFHandle; typ : LONGINT; id : LONGINT) : pCollectionItem;
  377. BEGIN
  378. ASM
  379. MOVE.L A6,-(A7)
  380. MOVEA.L iff,A0
  381. MOVE.L typ,D0
  382. MOVE.L id,D1
  383. MOVEA.L IFFParseBase,A6
  384. JSR -162(A6)
  385. MOVEA.L (A7)+,A6
  386. MOVE.L D0,@RESULT
  387. END;
  388. END;
  389. FUNCTION FindLocalItem(const iff : pIFFHandle; typ : LONGINT; id : LONGINT; ident : LONGINT) : pLocalContextItem;
  390. BEGIN
  391. ASM
  392. MOVE.L A6,-(A7)
  393. MOVEA.L iff,A0
  394. MOVE.L typ,D0
  395. MOVE.L id,D1
  396. MOVE.L ident,D2
  397. MOVEA.L IFFParseBase,A6
  398. JSR -210(A6)
  399. MOVEA.L (A7)+,A6
  400. MOVE.L D0,@RESULT
  401. END;
  402. END;
  403. FUNCTION FindProp(const iff : pIFFHandle; typ : LONGINT; id : LONGINT) : pStoredProperty;
  404. BEGIN
  405. ASM
  406. MOVE.L A6,-(A7)
  407. MOVEA.L iff,A0
  408. MOVE.L typ,D0
  409. MOVE.L id,D1
  410. MOVEA.L IFFParseBase,A6
  411. JSR -156(A6)
  412. MOVEA.L (A7)+,A6
  413. MOVE.L D0,@RESULT
  414. END;
  415. END;
  416. FUNCTION FindPropContext(const iff : pIFFHandle) : pContextNode;
  417. BEGIN
  418. ASM
  419. MOVE.L A6,-(A7)
  420. MOVEA.L iff,A0
  421. MOVEA.L IFFParseBase,A6
  422. JSR -168(A6)
  423. MOVEA.L (A7)+,A6
  424. MOVE.L D0,@RESULT
  425. END;
  426. END;
  427. PROCEDURE FreeIFF(iff : pIFFHandle);
  428. BEGIN
  429. ASM
  430. MOVE.L A6,-(A7)
  431. MOVEA.L iff,A0
  432. MOVEA.L IFFParseBase,A6
  433. JSR -054(A6)
  434. MOVEA.L (A7)+,A6
  435. END;
  436. END;
  437. PROCEDURE FreeLocalItem(localItem : pLocalContextItem);
  438. BEGIN
  439. ASM
  440. MOVE.L A6,-(A7)
  441. MOVEA.L localItem,A0
  442. MOVEA.L IFFParseBase,A6
  443. JSR -204(A6)
  444. MOVEA.L (A7)+,A6
  445. END;
  446. END;
  447. FUNCTION GoodID(id : LONGINT) : LONGINT;
  448. BEGIN
  449. ASM
  450. MOVE.L A6,-(A7)
  451. MOVE.L id,D0
  452. MOVEA.L IFFParseBase,A6
  453. JSR -258(A6)
  454. MOVEA.L (A7)+,A6
  455. MOVE.L D0,@RESULT
  456. END;
  457. END;
  458. FUNCTION GoodType(typ : LONGINT) : LONGINT;
  459. BEGIN
  460. ASM
  461. MOVE.L A6,-(A7)
  462. MOVE.L typ,D0
  463. MOVEA.L IFFParseBase,A6
  464. JSR -264(A6)
  465. MOVEA.L (A7)+,A6
  466. MOVE.L D0,@RESULT
  467. END;
  468. END;
  469. FUNCTION IDtoStr(id : LONGINT; buf : pCHAR) : pCHAR;
  470. BEGIN
  471. ASM
  472. MOVE.L A6,-(A7)
  473. MOVE.L id,D0
  474. MOVEA.L buf,A0
  475. MOVEA.L IFFParseBase,A6
  476. JSR -270(A6)
  477. MOVEA.L (A7)+,A6
  478. MOVE.L D0,@RESULT
  479. END;
  480. END;
  481. PROCEDURE InitIFF(iff : pIFFHandle; flags : LONGINT;const streamHook : pHook);
  482. BEGIN
  483. ASM
  484. MOVE.L A6,-(A7)
  485. MOVEA.L iff,A0
  486. MOVE.L flags,D0
  487. MOVEA.L streamHook,A1
  488. MOVEA.L IFFParseBase,A6
  489. JSR -228(A6)
  490. MOVEA.L (A7)+,A6
  491. END;
  492. END;
  493. PROCEDURE InitIFFasClip(iff : pIFFHandle);
  494. BEGIN
  495. ASM
  496. MOVE.L A6,-(A7)
  497. MOVEA.L iff,A0
  498. MOVEA.L IFFParseBase,A6
  499. JSR -240(A6)
  500. MOVEA.L (A7)+,A6
  501. END;
  502. END;
  503. PROCEDURE InitIFFasDOS(iff : pIFFHandle);
  504. BEGIN
  505. ASM
  506. MOVE.L A6,-(A7)
  507. MOVEA.L iff,A0
  508. MOVEA.L IFFParseBase,A6
  509. JSR -234(A6)
  510. MOVEA.L (A7)+,A6
  511. END;
  512. END;
  513. FUNCTION LocalItemData(const localItem : pLocalContextItem) : POINTER;
  514. BEGIN
  515. ASM
  516. MOVE.L A6,-(A7)
  517. MOVEA.L localItem,A0
  518. MOVEA.L IFFParseBase,A6
  519. JSR -192(A6)
  520. MOVEA.L (A7)+,A6
  521. MOVE.L D0,@RESULT
  522. END;
  523. END;
  524. FUNCTION OpenClipboard(unitNumber : LONGINT) : pClipboardHandle;
  525. BEGIN
  526. ASM
  527. MOVE.L A6,-(A7)
  528. MOVE.L unitNumber,D0
  529. MOVEA.L IFFParseBase,A6
  530. JSR -246(A6)
  531. MOVEA.L (A7)+,A6
  532. MOVE.L D0,@RESULT
  533. END;
  534. END;
  535. FUNCTION OpenIFF(iff : pIFFHandle; rwMode : LONGINT) : LONGINT;
  536. BEGIN
  537. ASM
  538. MOVE.L A6,-(A7)
  539. MOVEA.L iff,A0
  540. MOVE.L rwMode,D0
  541. MOVEA.L IFFParseBase,A6
  542. JSR -036(A6)
  543. MOVEA.L (A7)+,A6
  544. MOVE.L D0,@RESULT
  545. END;
  546. END;
  547. FUNCTION ParentChunk(const contextNode : pContextNode) : pContextNode;
  548. BEGIN
  549. ASM
  550. MOVE.L A6,-(A7)
  551. MOVEA.L contextNode,A0
  552. MOVEA.L IFFParseBase,A6
  553. JSR -180(A6)
  554. MOVEA.L (A7)+,A6
  555. MOVE.L D0,@RESULT
  556. END;
  557. END;
  558. FUNCTION ParseIFF(iff : pIFFHandle; control : LONGINT) : LONGINT;
  559. BEGIN
  560. ASM
  561. MOVE.L A6,-(A7)
  562. MOVEA.L iff,A0
  563. MOVE.L control,D0
  564. MOVEA.L IFFParseBase,A6
  565. JSR -042(A6)
  566. MOVEA.L (A7)+,A6
  567. MOVE.L D0,@RESULT
  568. END;
  569. END;
  570. FUNCTION PopChunk(iff : pIFFHandle) : LONGINT;
  571. BEGIN
  572. ASM
  573. MOVE.L A6,-(A7)
  574. MOVEA.L iff,A0
  575. MOVEA.L IFFParseBase,A6
  576. JSR -090(A6)
  577. MOVEA.L (A7)+,A6
  578. MOVE.L D0,@RESULT
  579. END;
  580. END;
  581. FUNCTION PropChunk(iff : pIFFHandle; typ : LONGINT; id : LONGINT) : LONGINT;
  582. BEGIN
  583. ASM
  584. MOVE.L A6,-(A7)
  585. MOVEA.L iff,A0
  586. MOVE.L typ,D0
  587. MOVE.L id,D1
  588. MOVEA.L IFFParseBase,A6
  589. JSR -114(A6)
  590. MOVEA.L (A7)+,A6
  591. MOVE.L D0,@RESULT
  592. END;
  593. END;
  594. FUNCTION PropChunks(iff : pIFFHandle;const propArray : pLONGINT; numPairs : LONGINT) : LONGINT;
  595. BEGIN
  596. ASM
  597. MOVE.L A6,-(A7)
  598. MOVEA.L iff,A0
  599. MOVEA.L propArray,A1
  600. MOVE.L numPairs,D0
  601. MOVEA.L IFFParseBase,A6
  602. JSR -120(A6)
  603. MOVEA.L (A7)+,A6
  604. MOVE.L D0,@RESULT
  605. END;
  606. END;
  607. FUNCTION PushChunk(iff : pIFFHandle; typ : LONGINT; id : LONGINT; size : LONGINT) : LONGINT;
  608. BEGIN
  609. ASM
  610. MOVE.L A6,-(A7)
  611. MOVEA.L iff,A0
  612. MOVE.L typ,D0
  613. MOVE.L id,D1
  614. MOVE.L size,D2
  615. MOVEA.L IFFParseBase,A6
  616. JSR -084(A6)
  617. MOVEA.L (A7)+,A6
  618. MOVE.L D0,@RESULT
  619. END;
  620. END;
  621. FUNCTION ReadChunkBytes(iff : pIFFHandle; buf : POINTER; numBytes : LONGINT) : LONGINT;
  622. BEGIN
  623. ASM
  624. MOVE.L A6,-(A7)
  625. MOVEA.L iff,A0
  626. MOVEA.L buf,A1
  627. MOVE.L numBytes,D0
  628. MOVEA.L IFFParseBase,A6
  629. JSR -060(A6)
  630. MOVEA.L (A7)+,A6
  631. MOVE.L D0,@RESULT
  632. END;
  633. END;
  634. FUNCTION ReadChunkRecords(iff : pIFFHandle; buf : POINTER; bytesPerRecord : LONGINT; numRecords : LONGINT) : LONGINT;
  635. BEGIN
  636. ASM
  637. MOVE.L A6,-(A7)
  638. MOVEA.L iff,A0
  639. MOVEA.L buf,A1
  640. MOVE.L bytesPerRecord,D0
  641. MOVE.L numRecords,D1
  642. MOVEA.L IFFParseBase,A6
  643. JSR -072(A6)
  644. MOVEA.L (A7)+,A6
  645. MOVE.L D0,@RESULT
  646. END;
  647. END;
  648. PROCEDURE SetLocalItemPurge(localItem : pLocalContextItem;const purgeHook : pHook);
  649. BEGIN
  650. ASM
  651. MOVE.L A6,-(A7)
  652. MOVEA.L localItem,A0
  653. MOVEA.L purgeHook,A1
  654. MOVEA.L IFFParseBase,A6
  655. JSR -198(A6)
  656. MOVEA.L (A7)+,A6
  657. END;
  658. END;
  659. FUNCTION StopChunk(iff : pIFFHandle; typ : LONGINT; id : LONGINT) : LONGINT;
  660. BEGIN
  661. ASM
  662. MOVE.L A6,-(A7)
  663. MOVEA.L iff,A0
  664. MOVE.L typ,D0
  665. MOVE.L id,D1
  666. MOVEA.L IFFParseBase,A6
  667. JSR -126(A6)
  668. MOVEA.L (A7)+,A6
  669. MOVE.L D0,@RESULT
  670. END;
  671. END;
  672. FUNCTION StopChunks(iff : pIFFHandle; const propArray : pLONGINT; numPairs : LONGINT) : LONGINT;
  673. BEGIN
  674. ASM
  675. MOVE.L A6,-(A7)
  676. MOVEA.L iff,A0
  677. MOVEA.L propArray,A1
  678. MOVE.L numPairs,D0
  679. MOVEA.L IFFParseBase,A6
  680. JSR -132(A6)
  681. MOVEA.L (A7)+,A6
  682. MOVE.L D0,@RESULT
  683. END;
  684. END;
  685. FUNCTION StopOnExit(iff : pIFFHandle; typ : LONGINT; id : LONGINT) : LONGINT;
  686. BEGIN
  687. ASM
  688. MOVE.L A6,-(A7)
  689. MOVEA.L iff,A0
  690. MOVE.L typ,D0
  691. MOVE.L id,D1
  692. MOVEA.L IFFParseBase,A6
  693. JSR -150(A6)
  694. MOVEA.L (A7)+,A6
  695. MOVE.L D0,@RESULT
  696. END;
  697. END;
  698. PROCEDURE StoreItemInContext(iff : pIFFHandle; localItem : pLocalContextItem; contextNode : pContextNode);
  699. BEGIN
  700. ASM
  701. MOVE.L A6,-(A7)
  702. MOVEA.L iff,A0
  703. MOVEA.L localItem,A1
  704. MOVEA.L contextNode,A2
  705. MOVEA.L IFFParseBase,A6
  706. JSR -222(A6)
  707. MOVEA.L (A7)+,A6
  708. END;
  709. END;
  710. FUNCTION StoreLocalItem(iff : pIFFHandle; localItem : pLocalContextItem; position : LONGINT) : LONGINT;
  711. BEGIN
  712. ASM
  713. MOVE.L A6,-(A7)
  714. MOVEA.L iff,A0
  715. MOVEA.L localItem,A1
  716. MOVE.L position,D0
  717. MOVEA.L IFFParseBase,A6
  718. JSR -216(A6)
  719. MOVEA.L (A7)+,A6
  720. MOVE.L D0,@RESULT
  721. END;
  722. END;
  723. FUNCTION WriteChunkBytes(iff : pIFFHandle;const buf : POINTER; numBytes : LONGINT) : LONGINT;
  724. BEGIN
  725. ASM
  726. MOVE.L A6,-(A7)
  727. MOVEA.L iff,A0
  728. MOVEA.L buf,A1
  729. MOVE.L numBytes,D0
  730. MOVEA.L IFFParseBase,A6
  731. JSR -066(A6)
  732. MOVEA.L (A7)+,A6
  733. MOVE.L D0,@RESULT
  734. END;
  735. END;
  736. FUNCTION WriteChunkRecords(iff : pIFFHandle;const buf : POINTER; bytesPerRecord : LONGINT; numRecords : LONGINT) : LONGINT;
  737. BEGIN
  738. ASM
  739. MOVE.L A6,-(A7)
  740. MOVEA.L iff,A0
  741. MOVEA.L buf,A1
  742. MOVE.L bytesPerRecord,D0
  743. MOVE.L numRecords,D1
  744. MOVEA.L IFFParseBase,A6
  745. JSR -078(A6)
  746. MOVEA.L (A7)+,A6
  747. MOVE.L D0,@RESULT
  748. END;
  749. END;
  750. Function Make_ID(str : String) : LONGINT;
  751. begin
  752. Make_ID := (LONGINT(Ord(Str[1])) shl 24) or
  753. (LONGINT(Ord(Str[2])) shl 16 ) or
  754. (LONGINT(Ord(Str[3])) shl 8 ) or (LONGINT(Ord(Str[4])));
  755. end;
  756. const
  757. { Change VERSION and LIBVERSION to proper values }
  758. VERSION : string[2] = '0';
  759. LIBVERSION : longword = 0;
  760. {$ifdef use_init_openlib}
  761. {$Info Compiling initopening of iffparse.library}
  762. {$Info don't forget to use InitIFFPARSELibrary in the beginning of your program}
  763. var
  764. iffparse_exit : Pointer;
  765. procedure CloseiffparseLibrary;
  766. begin
  767. ExitProc := iffparse_exit;
  768. if IFFParseBase <> nil then begin
  769. CloseLibrary(IFFParseBase);
  770. IFFParseBase := nil;
  771. end;
  772. end;
  773. procedure InitIFFPARSELibrary;
  774. begin
  775. IFFParseBase := nil;
  776. IFFParseBase := OpenLibrary(IFFPARSENAME,LIBVERSION);
  777. if IFFParseBase <> nil then begin
  778. iffparse_exit := ExitProc;
  779. ExitProc := @CloseiffparseLibrary;
  780. end else begin
  781. MessageBox('FPC Pascal Error',
  782. 'Can''t open iffparse.library version ' + VERSION + #10 +
  783. 'Deallocating resources and closing down',
  784. 'Oops');
  785. halt(20);
  786. end;
  787. end;
  788. begin
  789. IFFPARSEIsCompiledHow := 2;
  790. {$endif use_init_openlib}
  791. {$ifdef use_auto_openlib}
  792. {$Info Compiling autoopening of iffparse.library}
  793. var
  794. iffparse_exit : Pointer;
  795. procedure CloseiffparseLibrary;
  796. begin
  797. ExitProc := iffparse_exit;
  798. if IFFParseBase <> nil then begin
  799. CloseLibrary(IFFParseBase);
  800. IFFParseBase := nil;
  801. end;
  802. end;
  803. begin
  804. IFFParseBase := nil;
  805. IFFParseBase := OpenLibrary(IFFPARSENAME,LIBVERSION);
  806. if IFFParseBase <> nil then begin
  807. iffparse_exit := ExitProc;
  808. ExitProc := @CloseiffparseLibrary;
  809. IFFPARSEIsCompiledHow := 1;
  810. end else begin
  811. MessageBox('FPC Pascal Error',
  812. 'Can''t open iffparse.library version ' + VERSION + #10 +
  813. 'Deallocating resources and closing down',
  814. 'Oops');
  815. halt(20);
  816. end;
  817. {$endif use_auto_openlib}
  818. {$ifdef dont_use_openlib}
  819. begin
  820. IFFPARSEIsCompiledHow := 3;
  821. {$Warning No autoopening of iffparse.library compiled}
  822. {$Warning Make sure you open iffparse.library yourself}
  823. {$endif dont_use_openlib}
  824. END. (* UNIT IFFPARSE *)