Codecs.Mod 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773
  1. MODULE Codecs; (** AUTHOR "TF"; PURPOSE "CODEC repository"; *)
  2. IMPORT
  3. Streams, Commands, Files, SoundDevices, Raster, Modules, Strings, Configuration, Unzip, Texts, Archives;
  4. CONST
  5. ResFailed* = -1;
  6. ResOk* = 0;
  7. ResSeekInexact* = 1;
  8. ImgFmtBW* = 0;
  9. ImgFmtGrey* = 1;
  10. ImgFmtRGB* = 2;
  11. ImgFmtRGBA* = 3;
  12. STError* = -1; (* e.g. when requested stream does not exist *)
  13. STUnknown* = 0;
  14. STAudio* = 1;
  15. STVideo* = 2;
  16. STImage* = 3;
  17. SeekByte* = 0;
  18. SeekSample* = 1;
  19. SeekKeySample* = 2;
  20. SeekFrame* = 3;
  21. SeekKeyFrame* = 4;
  22. TYPE
  23. AVStreamInfo* = RECORD
  24. streamType* : LONGINT;
  25. seekability* : SET;
  26. contentType* : ARRAY 16 OF CHAR;
  27. length* : LONGINT;
  28. frames* : LONGINT;
  29. rate*: LONGINT;
  30. END;
  31. FileInputStream* = OBJECT(Streams.Reader)
  32. VAR
  33. r : Files.Rider;
  34. f* : Files.File;
  35. streamInfo*: AVStreamInfo;
  36. PROCEDURE Receive(VAR buf: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len: LONGINT; VAR res: WORD);
  37. BEGIN
  38. f.ReadBytes(r, buf, ofs, size);
  39. len := size - r.res;
  40. IF len >= min THEN res := Streams.Ok ELSE res := Streams.EOF (* end of file *) END
  41. END Receive;
  42. PROCEDURE &InitFileReader*(f : Files.File; pos: LONGINT);
  43. BEGIN
  44. InitReader(SELF.Receive, 4096);
  45. SELF.f := f;
  46. f.Set(r, pos);
  47. streamInfo.seekability := {SeekByte};
  48. END InitFileReader;
  49. PROCEDURE CanSetPos*(): BOOLEAN;
  50. BEGIN
  51. RETURN TRUE;
  52. END CanSetPos;
  53. PROCEDURE SetPos*(pos : Streams.Position);
  54. BEGIN
  55. f.Set(r, pos);
  56. Reset;
  57. received := pos;
  58. END SetPos;
  59. END FileInputStream;
  60. AVDemultiplexer* = OBJECT
  61. (** open the demultiplexer on an input stream *)
  62. PROCEDURE Open*(in : Streams.Reader; VAR res : WORD);
  63. END Open;
  64. PROCEDURE GetNumberOfStreams*() : LONGINT;
  65. BEGIN
  66. RETURN 0
  67. END GetNumberOfStreams;
  68. PROCEDURE GetStreamType*(streamNr : LONGINT): LONGINT;
  69. BEGIN
  70. RETURN -1;
  71. END GetStreamType;
  72. PROCEDURE GetStreamInfo*(streamNr : LONGINT): AVStreamInfo;
  73. END GetStreamInfo;
  74. (* get stream streamNr *)
  75. PROCEDURE GetStream*(streamNr: LONGINT): DemuxStream;
  76. END GetStream;
  77. (* read data from streamNr, store it into buffer buf starting at offset ofs, store size bytes if possible, block if not read min bytes at least. Return number of read bytes in len and return code res *)
  78. (* this procedure should not be directly called - it is called by the DemuxStream object! *)
  79. PROCEDURE GetData*(streamNr : LONGINT; VAR buf: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len: LONGINT; VAR res: WORD);
  80. END GetData;
  81. (* seek the streamNr to position pos (defined bz seekType), res = 0 if Ok, otherwise an error number *)
  82. (* this procedure should not be directly called - it is called by the DemuxStream object! *)
  83. PROCEDURE SetStreamPos*(streamNr : LONGINT; seekType : LONGINT; pos : LONGINT; VAR itemSize : LONGINT; VAR res : WORD);
  84. END SetStreamPos;
  85. END AVDemultiplexer;
  86. DemuxStream* = OBJECT(Streams.Reader)
  87. VAR
  88. demultiplexer* : AVDemultiplexer;
  89. streamNr* : LONGINT;
  90. streamInfo* : AVStreamInfo;
  91. PROCEDURE& Open*(demultiplexer : AVDemultiplexer; streamNr : LONGINT);
  92. BEGIN
  93. SELF.demultiplexer := demultiplexer;
  94. SELF.streamNr := streamNr;
  95. InitReader(Receive, 4096)
  96. END Open;
  97. PROCEDURE Receive(VAR buf: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len: LONGINT; VAR res: WORD);
  98. BEGIN
  99. demultiplexer.GetData(streamNr, buf, ofs, size, min, len, res)
  100. END Receive;
  101. PROCEDURE SetPos*(pos : Streams.Position);
  102. VAR seekType, itemSize: LONGINT; res: WORD;
  103. BEGIN
  104. seekType := SeekByte;
  105. demultiplexer.SetStreamPos(streamNr, seekType, pos, itemSize, res);
  106. Reset
  107. END SetPos;
  108. (* seek the streamNr to position pos with seekType. itemSize contains the size of the element seeked to, if known and applicable; res = 0 if Ok, otherwise an error number *)
  109. PROCEDURE SetPosX*(seekType : LONGINT; pos : LONGINT; VAR itemSize : LONGINT; VAR res : WORD);
  110. BEGIN
  111. demultiplexer.SetStreamPos(streamNr, seekType, pos, itemSize, res);
  112. Reset
  113. END SetPosX;
  114. END DemuxStream;
  115. AudioDecoder* = OBJECT
  116. (* open the decoder on a file *)
  117. PROCEDURE Open*(in : Streams.Reader; VAR res : WORD);
  118. END Open;
  119. PROCEDURE HasMoreData*():BOOLEAN;
  120. END HasMoreData;
  121. PROCEDURE GetAudioInfo*(VAR nofChannels, samplesPerSecond, bitsPerSample : LONGINT);
  122. END GetAudioInfo;
  123. PROCEDURE SetAudioInfo*(nofChannels, samplesPerSecond, bitsPerSample : LONGINT);
  124. END SetAudioInfo;
  125. PROCEDURE CanSeek*() : BOOLEAN;
  126. BEGIN RETURN FALSE
  127. END CanSeek;
  128. PROCEDURE GetCurrentSample*() : LONGINT;
  129. BEGIN HALT(301); RETURN 0
  130. END GetCurrentSample;
  131. PROCEDURE GetTotalSamples*() : LONGINT;
  132. BEGIN HALT(301); RETURN 0
  133. END GetTotalSamples;
  134. PROCEDURE GetCurrentTime*() : LONGINT;
  135. BEGIN HALT(301); RETURN 0
  136. END GetCurrentTime;
  137. PROCEDURE SetStreamLength*(length : LONGINT);
  138. END SetStreamLength;
  139. PROCEDURE SeekSample*(sample: LONGINT; goKeySample : BOOLEAN; VAR res : WORD);
  140. END SeekSample;
  141. PROCEDURE SeekMillisecond*(millisecond : LONGINT; goKeySample : BOOLEAN; VAR res : WORD);
  142. END SeekMillisecond;
  143. (** Prepare the next audio bytes not yet filled into a buffer *)
  144. PROCEDURE Next*;
  145. END Next;
  146. PROCEDURE FillBuffer*(buffer : SoundDevices.Buffer);
  147. END FillBuffer;
  148. END AudioDecoder;
  149. AudioEncoder* = OBJECT
  150. (* open the encoder *)
  151. PROCEDURE Open*(out : Streams.Writer; sRate, sRes, nofCh: LONGINT; VAR res : WORD);
  152. END Open;
  153. PROCEDURE Write*(buffer : SoundDevices.Buffer; VAR res : WORD);
  154. END Write;
  155. PROCEDURE Close*(VAR res : WORD);
  156. END Close;
  157. END AudioEncoder;
  158. VideoDecoder* = OBJECT
  159. (* open the decoder on a file *)
  160. PROCEDURE Open*(in : Streams.Reader; VAR res : WORD);
  161. END Open;
  162. PROCEDURE HasMoreData*():BOOLEAN;
  163. END HasMoreData;
  164. PROCEDURE GetVideoInfo*(VAR width, height, millisecondsPerFrame : LONGINT);
  165. END GetVideoInfo;
  166. PROCEDURE CanSeek*() : BOOLEAN;
  167. BEGIN RETURN FALSE
  168. END CanSeek;
  169. PROCEDURE GetCurrentFrame*() : LONGINT;
  170. END GetCurrentFrame;
  171. PROCEDURE GetCurrentTime*() : LONGINT;
  172. END GetCurrentTime;
  173. PROCEDURE SeekFrame*(frame : LONGINT; goKeyFrame : BOOLEAN; VAR res : WORD);
  174. END SeekFrame;
  175. PROCEDURE SeekMillisecond*(millisecond : LONGINT; goKeyFrame : BOOLEAN; VAR res : WORD);
  176. END SeekMillisecond;
  177. (** Prepare the next frame *)
  178. PROCEDURE Next*;
  179. END Next;
  180. PROCEDURE Render*(img : Raster.Image);
  181. END Render;
  182. END VideoDecoder;
  183. VideoEncoder* = OBJECT
  184. (* open the encoder *)
  185. PROCEDURE Open*(out : Streams.Writer; VAR res : WORD);
  186. END Open;
  187. PROCEDURE Write*(img : Raster.Image);
  188. END Write;
  189. PROCEDURE Close*(VAR res : WORD);
  190. END Close;
  191. END VideoEncoder;
  192. ImageDecoder* = OBJECT
  193. (* open the decoder on an InputStream *)
  194. PROCEDURE Open*(in : Streams.Reader; VAR res : WORD);
  195. END Open;
  196. PROCEDURE GetImageInfo*(VAR width, height, format, maxProgressionLevel : LONGINT);
  197. END GetImageInfo;
  198. (** Render will read and decode the image data up to progrssionLevel.
  199. If the progressionLevel is lower than a previously rendered progressionLevel,
  200. the new level can be ignored by the decoder. If no progressionLevel is set with
  201. SetProgressionLevel, the level is assumed to be maxProgressionLevel of the image,
  202. which corresponds to best image quality.
  203. *)
  204. PROCEDURE SetProgressionLevel*(progressionLevel: LONGINT);
  205. END SetProgressionLevel;
  206. (* return the image in Raster format that best matches the format *)
  207. PROCEDURE GetNativeImage*(VAR img : Raster.Image);
  208. END GetNativeImage;
  209. (* renders the image into the given Raster.Image at the given progressionLevel *)
  210. PROCEDURE Render*(img : Raster.Image);
  211. END Render;
  212. END ImageDecoder;
  213. ImageEncoder* = OBJECT
  214. (* open the encoder on a stream*)
  215. PROCEDURE Open*(out : Streams.Writer);
  216. END Open;
  217. PROCEDURE SetQuality*(quality : LONGINT);
  218. END SetQuality;
  219. PROCEDURE WriteImage*(img : Raster.Image; VAR res : WORD);
  220. END WriteImage;
  221. END ImageEncoder;
  222. TextDecoder* = OBJECT
  223. (* open the decoder on an InputStream *)
  224. PROCEDURE Open*(in : Streams.Reader; VAR res : WORD);
  225. END Open;
  226. PROCEDURE GetText*() : Texts.Text;
  227. BEGIN
  228. HALT(301); RETURN NIL
  229. END GetText;
  230. END TextDecoder;
  231. TextEncoder* = OBJECT
  232. (* open the encoder on a stream*)
  233. PROCEDURE Open*(out : Streams.Writer);
  234. END Open;
  235. PROCEDURE WriteText*(text : Texts.Text; VAR res : WORD);
  236. END WriteText;
  237. END TextEncoder;
  238. CryptoDecoder* = OBJECT
  239. PROCEDURE Open*(in: Streams.Reader; VAR res: WORD);
  240. END Open;
  241. PROCEDURE GetReader*(): Streams.Reader;
  242. END GetReader;
  243. END CryptoDecoder;
  244. CryptoEncoder* = OBJECT
  245. PROCEDURE Open*(out: Streams.Writer);
  246. END Open;
  247. PROCEDURE GetWriter*(): Streams.Writer;
  248. END GetWriter;
  249. END CryptoEncoder;
  250. (****** Animations *)
  251. CONST
  252. (** ImageDescriptor.disposeMode *)
  253. Unspecified* = 0;
  254. DoNotDispose* = 1;
  255. RestoreToBackground* = 2;
  256. RestoreToPrevious* = 3;
  257. (** ImageDescriptor.flags *)
  258. WaitForUserInput* = 0;
  259. TYPE
  260. ImageDescriptor* = OBJECT
  261. VAR
  262. left*, top*, width*, height* : LONGINT;
  263. image* : Raster.Image;
  264. delayTime* : LONGINT; (* in milliseconds *)
  265. disposeMode* : LONGINT;
  266. flags* : SET;
  267. previous*, next* : ImageDescriptor;
  268. PROCEDURE &Init*;
  269. BEGIN
  270. left := 0; top := 0; width := 0; height := 0;
  271. image := NIL;
  272. delayTime := 20; disposeMode := Unspecified;
  273. flags := {};
  274. previous := NIL; next := NIL;
  275. END Init;
  276. END ImageDescriptor;
  277. ImageSequence* = RECORD
  278. width*, height* : LONGINT;
  279. bgColor* : LONGINT;
  280. images* : ImageDescriptor;
  281. END;
  282. AnimationDecoder* = OBJECT
  283. (* open the decoder on an InputStream *)
  284. PROCEDURE Open*(in : Streams.Reader; VAR res : WORD);
  285. END Open;
  286. PROCEDURE GetImageSequence*(VAR sequence : ImageSequence; VAR res : WORD);
  287. END GetImageSequence;
  288. END AnimationDecoder;
  289. TYPE
  290. DemuxFactory = PROCEDURE () : AVDemultiplexer;
  291. AudioDecoderFactory = PROCEDURE () : AudioDecoder;
  292. AudioEncoderFactory = PROCEDURE () : AudioEncoder;
  293. VideoDecoderFactory = PROCEDURE () : VideoDecoder;
  294. VideoEncoderFactory = PROCEDURE () : VideoEncoder;
  295. ImageDecoderFactory = PROCEDURE () : ImageDecoder;
  296. ImageEncoderFactory = PROCEDURE () : ImageEncoder;
  297. TextDecoderFactory = PROCEDURE () : TextDecoder;
  298. TextEncoderFactory = PROCEDURE () : TextEncoder;
  299. CryptoDecoderFactory = PROCEDURE () : CryptoDecoder;
  300. CryptoEncoderFactory = PROCEDURE () : CryptoEncoder;
  301. AnimationDecoderFactory = PROCEDURE () : AnimationDecoder;
  302. PROCEDURE GetDemuxFactoryName(CONST name : ARRAY OF CHAR; VAR module , procedure : Modules.Name; VAR res : WORD);
  303. VAR config, factoryName, msg : ARRAY 128 OF CHAR;
  304. BEGIN
  305. res := ResFailed;
  306. config := "Codecs.Demultiplexer."; Strings.Append(config, name);
  307. Configuration.Get(config, factoryName, res);
  308. IF (res = Configuration.Ok) THEN
  309. Commands.Split(factoryName, module, procedure, res, msg);
  310. END
  311. END GetDemuxFactoryName;
  312. PROCEDURE GetDecoderFactoryName(CONST type, name : ARRAY OF CHAR; VAR module, procedure : Modules.Name; VAR res : WORD);
  313. VAR config, factoryName, msg : ARRAY 128 OF CHAR;
  314. BEGIN
  315. res := ResFailed;
  316. config := "Codecs.Decoder."; Strings.Append(config, type); Strings.Append(config, ".");
  317. Strings.Append(config, name);
  318. Configuration.Get(config, factoryName, res);
  319. IF (res = Configuration.Ok) THEN
  320. Commands.Split(factoryName, module, procedure, res, msg);
  321. END
  322. END GetDecoderFactoryName;
  323. PROCEDURE GetEncoderFactoryName(CONST type, name : ARRAY OF CHAR; VAR module, procedure : Modules.Name; VAR res : WORD);
  324. VAR config, factoryName, msg : ARRAY 128 OF CHAR;
  325. BEGIN
  326. res := ResFailed;
  327. config := "Codecs.Encoder."; Strings.Append(config, type); Strings.Append(config, ".");
  328. Strings.Append(config, name);
  329. Configuration.Get(config, factoryName, res);
  330. IF (res = Configuration.Ok) THEN
  331. Commands.Split(factoryName, module, procedure, res, msg);
  332. END
  333. END GetEncoderFactoryName;
  334. (** Return a registered demultiplexer e.g. "AVI" *)
  335. PROCEDURE GetDemultiplexer*(CONST name : ARRAY OF CHAR) : AVDemultiplexer;
  336. VAR
  337. demux : AVDemultiplexer; factory : DemuxFactory;
  338. moduleName, procedureName : Modules.Name; res : WORD;
  339. BEGIN
  340. demux := NIL;
  341. GetDemuxFactoryName(name, moduleName, procedureName, res);
  342. IF (res = ResOk) THEN
  343. GETPROCEDURE(moduleName, procedureName, factory);
  344. IF (factory # NIL) THEN
  345. demux := factory();
  346. END;
  347. END;
  348. RETURN demux;
  349. END GetDemultiplexer;
  350. (** Return a registered image decoder e.g. "JP2", "BMP", "PNG" *)
  351. PROCEDURE GetImageDecoder*(CONST name : ARRAY OF CHAR) : ImageDecoder;
  352. VAR
  353. decoder : ImageDecoder; factory : ImageDecoderFactory;
  354. moduleName, procedureName : Modules.Name; res : WORD;
  355. BEGIN
  356. decoder := NIL;
  357. GetDecoderFactoryName("Image", name, moduleName, procedureName, res);
  358. IF (res = ResOk) THEN
  359. GETPROCEDURE(moduleName, procedureName, factory);
  360. IF (factory # NIL) THEN
  361. decoder := factory();
  362. END;
  363. END;
  364. RETURN decoder;
  365. END GetImageDecoder;
  366. (** Return a registered image decoder e.g. "BMP" *)
  367. PROCEDURE GetImageEncoder*(CONST name : ARRAY OF CHAR) : ImageEncoder;
  368. VAR
  369. encoder : ImageEncoder; factory : ImageEncoderFactory;
  370. moduleName, procedureName : Modules.Name; res : WORD;
  371. BEGIN
  372. encoder := NIL;
  373. GetEncoderFactoryName("Image", name, moduleName, procedureName, res);
  374. IF (res = ResOk) THEN
  375. GETPROCEDURE(moduleName, procedureName, factory);
  376. IF (factory # NIL) THEN
  377. encoder := factory();
  378. END;
  379. END;
  380. RETURN encoder;
  381. END GetImageEncoder;
  382. (** Return a registered video decoder. The decoder name is typically a FourCC code e.g. "DivX" *)
  383. PROCEDURE GetVideoDecoder*(CONST name : ARRAY OF CHAR) : VideoDecoder;
  384. VAR
  385. decoder : VideoDecoder; factory : VideoDecoderFactory;
  386. moduleName, procedureName : Modules.Name; res : WORD;
  387. BEGIN
  388. decoder := NIL;
  389. GetDecoderFactoryName("Video", name, moduleName, procedureName, res);
  390. IF (res = ResOk) THEN
  391. GETPROCEDURE(moduleName, procedureName, factory);
  392. IF (factory # NIL) THEN
  393. decoder := factory();
  394. END;
  395. END;
  396. RETURN decoder;
  397. END GetVideoDecoder;
  398. (** Return a registered video encoder *)
  399. PROCEDURE GetVideoEncoder*(CONST name : ARRAY OF CHAR) : VideoEncoder;
  400. VAR
  401. encoder : VideoEncoder; factory : VideoEncoderFactory;
  402. moduleName, procedureName : Modules.Name; res : WORD;
  403. BEGIN
  404. encoder := NIL;
  405. GetEncoderFactoryName("Video", name, moduleName, procedureName, res);
  406. IF (res = ResOk) THEN
  407. GETPROCEDURE(moduleName, procedureName, factory);
  408. IF (factory # NIL) THEN
  409. encoder := factory();
  410. END;
  411. END;
  412. RETURN encoder;
  413. END GetVideoEncoder;
  414. (** Return a registered audio decoder e.g. "MP3" *)
  415. PROCEDURE GetAudioDecoder*(CONST name : ARRAY OF CHAR) : AudioDecoder;
  416. VAR
  417. decoder : AudioDecoder; factory : AudioDecoderFactory;
  418. moduleName, procedureName : Modules.Name; res : WORD;
  419. BEGIN
  420. decoder := NIL;
  421. GetDecoderFactoryName("Audio", name, moduleName, procedureName, res);
  422. IF (res = ResOk) THEN
  423. GETPROCEDURE(moduleName, procedureName, factory);
  424. IF (factory # NIL) THEN
  425. decoder := factory();
  426. END;
  427. END;
  428. RETURN decoder;
  429. END GetAudioDecoder;
  430. (** Return a registered audio encoder e.g. "WAV" *)
  431. PROCEDURE GetAudioEncoder*(CONST name : ARRAY OF CHAR) : AudioEncoder;
  432. VAR
  433. encoder : AudioEncoder; factory : AudioEncoderFactory;
  434. moduleName, procedureName : Modules.Name; res : WORD;
  435. BEGIN
  436. encoder := NIL;
  437. GetEncoderFactoryName("Audio", name, moduleName, procedureName, res);
  438. IF (res = ResOk) THEN
  439. GETPROCEDURE(moduleName, procedureName, factory);
  440. IF (factory # NIL) THEN
  441. encoder := factory();
  442. END;
  443. END;
  444. RETURN encoder;
  445. END GetAudioEncoder;
  446. (** Return a registered text decoder e.g. "UTF-8" *)
  447. PROCEDURE GetTextDecoder*(CONST name : ARRAY OF CHAR) : TextDecoder;
  448. VAR
  449. decoder : TextDecoder; factory : TextDecoderFactory;
  450. moduleName, procedureName : Modules.Name; res : WORD;
  451. BEGIN
  452. decoder := NIL;
  453. GetDecoderFactoryName("Text", name, moduleName, procedureName, res);
  454. IF (res = ResOk) THEN
  455. GETPROCEDURE(moduleName, procedureName, factory);
  456. IF (factory # NIL) THEN
  457. decoder := factory();
  458. END;
  459. END;
  460. RETURN decoder;
  461. END GetTextDecoder;
  462. (** Return a registered text encoder e.g. "Oberon" *)
  463. PROCEDURE GetTextEncoder*(CONST name : ARRAY OF CHAR) : TextEncoder;
  464. VAR
  465. encoder : TextEncoder; factory : TextEncoderFactory;
  466. moduleName, procedureName : Modules.Name; res : WORD;
  467. BEGIN
  468. encoder := NIL;
  469. GetEncoderFactoryName("Text", name, moduleName, procedureName, res);
  470. IF (res = ResOk) THEN
  471. GETPROCEDURE(moduleName, procedureName, factory);
  472. IF (factory # NIL) THEN
  473. encoder := factory();
  474. END;
  475. END;
  476. RETURN encoder;
  477. END GetTextEncoder;
  478. (** Return a registered crypto decoder *)
  479. PROCEDURE GetCryptoDecoder*(CONST name : ARRAY OF CHAR) : CryptoDecoder;
  480. VAR
  481. decoder : CryptoDecoder; factory : CryptoDecoderFactory;
  482. moduleName, procedureName : Modules.Name; res : WORD;
  483. BEGIN
  484. decoder := NIL;
  485. GetDecoderFactoryName("Crypto", name, moduleName, procedureName, res);
  486. IF (res = ResOk) THEN
  487. GETPROCEDURE(moduleName, procedureName, factory);
  488. IF (factory # NIL) THEN
  489. decoder := factory();
  490. END;
  491. END;
  492. RETURN decoder;
  493. END GetCryptoDecoder;
  494. (** Return a registered crypto encoder *)
  495. PROCEDURE GetCryptoEncoder*(CONST name : ARRAY OF CHAR) : CryptoEncoder;
  496. VAR
  497. encoder : CryptoEncoder; factory : CryptoEncoderFactory;
  498. moduleName, procedureName : Modules.Name; res : WORD;
  499. BEGIN
  500. encoder := NIL;
  501. GetEncoderFactoryName("Crypto", name, moduleName, procedureName, res);
  502. IF (res = ResOk) THEN
  503. GETPROCEDURE(moduleName, procedureName, factory);
  504. IF (factory # NIL) THEN
  505. encoder := factory();
  506. END;
  507. END;
  508. RETURN encoder;
  509. END GetCryptoEncoder;
  510. (** Return a registered animation decoder e.g. "GIF", "ANI" *)
  511. PROCEDURE GetAnimationDecoder*(CONST name : ARRAY OF CHAR) : AnimationDecoder;
  512. VAR
  513. decoder : AnimationDecoder; factory : AnimationDecoderFactory;
  514. moduleName, procedureName : Modules.Name; res : WORD;
  515. BEGIN
  516. decoder := NIL;
  517. GetDecoderFactoryName("Animation", name, moduleName, procedureName, res);
  518. IF (res = ResOk) THEN
  519. GETPROCEDURE(moduleName, procedureName, factory);
  520. IF (factory # NIL) THEN
  521. decoder := factory();
  522. END;
  523. END;
  524. RETURN decoder;
  525. END GetAnimationDecoder;
  526. PROCEDURE SplitName*(CONST name : ARRAY OF CHAR; VAR protocol, filename : ARRAY OF CHAR);
  527. VAR pos, i : SIZE;
  528. BEGIN
  529. pos := Strings.Pos("://", name);
  530. IF pos >= 0 THEN
  531. FOR i := 0 TO pos - 1 DO protocol[i] := name[i] END;
  532. protocol[pos] := 0X;
  533. INC(pos, 3); i := 0; WHILE name[pos] # 0X DO filename[i] := name[pos]; INC(pos); INC(i) END;
  534. filename[i] := 0X
  535. ELSE
  536. COPY("", protocol);
  537. COPY(name, filename)
  538. END
  539. END SplitName;
  540. PROCEDURE JoinName*(CONST protocol, filename : ARRAY OF CHAR; VAR name : ARRAY OF CHAR);
  541. BEGIN
  542. IF (protocol # "") THEN
  543. Strings.Concat(protocol, "://", name); Strings.Concat(name, filename, name);
  544. ELSE
  545. COPY(filename, name);
  546. END;
  547. END JoinName;
  548. PROCEDURE OpenInputStream*(CONST name : ARRAY OF CHAR) : Streams.Reader;
  549. VAR f : Files.File;
  550. is : FileInputStream;
  551. inpStream : Streams.Reader;
  552. r : Streams.Receiver;
  553. tp, protocol, filename : ARRAY 1024 OF CHAR;
  554. zf : Unzip.ZipFile;
  555. entry : Unzip.Entry;
  556. archive : Archives.Archive;
  557. res : WORD;
  558. BEGIN
  559. SplitName(name, protocol, filename);
  560. COPY(protocol, tp); Strings.LowerCase(tp);
  561. IF protocol = "" THEN
  562. f := Files.Old(filename);
  563. IF f = NIL THEN RETURN NIL END;
  564. NEW(is, f, 0);
  565. RETURN is
  566. ELSIF Strings.Match("*.zip", tp) THEN
  567. f := Files.Old(protocol);
  568. IF f = NIL THEN RETURN NIL END;
  569. NEW(zf, f, res);
  570. IF res = 0 THEN
  571. entry := zf.FindEntry(filename);
  572. IF entry # NIL THEN
  573. zf.OpenReceiver(r, entry, res);
  574. IF res = 0 THEN
  575. NEW(inpStream, r, 1024);
  576. RETURN inpStream
  577. ELSE RETURN NIL
  578. END
  579. ELSE RETURN NIL
  580. END
  581. ELSE RETURN NIL
  582. END
  583. ELSIF Strings.Match("*.skin", tp) THEN
  584. archive := Archives.Old(protocol, "skin");
  585. IF archive = NIL THEN
  586. RETURN NIL
  587. ELSE
  588. archive.Acquire; r := archive.OpenReceiver(filename); archive.Release;
  589. IF r = NIL THEN
  590. RETURN NIL
  591. ELSE
  592. NEW(inpStream, r, 1024);
  593. RETURN inpStream
  594. END
  595. END
  596. ELSIF Strings.Match("*.tar", tp) OR Strings.Match("*.rep", tp) THEN
  597. archive := Archives.Old(protocol, "tar");
  598. IF archive = NIL THEN
  599. RETURN NIL
  600. ELSE
  601. archive.Acquire; r := archive.OpenReceiver(filename); archive.Release;
  602. IF r = NIL THEN
  603. RETURN NIL
  604. ELSE
  605. NEW(inpStream, r, 1024);
  606. RETURN inpStream
  607. END
  608. END
  609. END;
  610. RETURN NIL
  611. END OpenInputStream;
  612. PROCEDURE OpenOutputStream*(CONST name : ARRAY OF CHAR) : Streams.Writer;
  613. VAR
  614. file : Files.File; w : Files.Writer;
  615. writer : Streams.Writer;
  616. sender : Streams.Sender;
  617. tp, protocol, filename : ARRAY 1024 OF CHAR;
  618. archive : Archives.Archive;
  619. BEGIN
  620. writer := NIL;
  621. SplitName(name, protocol, filename);
  622. COPY(protocol, tp); Strings.LowerCase(tp);
  623. IF protocol = "" THEN
  624. file := Files.New(filename);
  625. IF file # NIL THEN
  626. Files.Register(file);
  627. NEW(w, file, 0); writer := w;
  628. END
  629. ELSIF Strings.Match("*.skin", tp) THEN
  630. archive := Archives.Old(protocol, "skin");
  631. IF archive = NIL THEN archive := Archives.New(protocol, "skin"); END;
  632. IF archive # NIL THEN
  633. archive.Acquire; sender := archive.OpenSender(filename); archive.Release;
  634. IF sender # NIL THEN
  635. NEW(writer, sender, 1024);
  636. END
  637. END
  638. ELSIF Strings.Match("*.tar", tp) OR Strings.Match("*.rep", tp) THEN
  639. archive := Archives.Old(protocol, "tar");
  640. IF archive = NIL THEN archive := Archives.New(protocol, "tar"); END;
  641. IF archive # NIL THEN
  642. archive.Acquire; sender := archive.OpenSender(filename); archive.Release;
  643. IF sender # NIL THEN
  644. NEW(writer, sender, 1024);
  645. END
  646. END
  647. END;
  648. RETURN writer;
  649. END OpenOutputStream;
  650. END Codecs.
  651. --------------------------
  652. System.Free Codecs~