data2inc.pp 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891
  1. {
  2. Copyright (c) 1999-2000 by Peter Vreman (msg2inc) and
  3. Marco van de Voort (data2inc)
  4. Placed under LGPL (See the file COPYING.FPC, included in this
  5. distribution, for details about the copyright)
  6. E-Mail Marco : [email protected]
  7. Homepage Marco: www.stack.nl/~marcov/xtdlib.htm
  8. Data2Inc is a heavily modified version of msg2inc.pp which compiles the
  9. inputfile to include files containing array of char( or byte) typed
  10. constants.
  11. (e.g. CONST xxx : ARRAY[0..xxx] OF CHAR =( aa,bb,cc,dd,ee); ,
  12. or the same but ARRAY OF BYTE )
  13. Two types of input file are allowed:
  14. 1 A special kind of textfile. Records start with '!'name and all following
  15. non empty and non comment (starting with '#',':' or '%') lines until
  16. the next line starting with '!' or EOF are the data. Data are either
  17. plain text (with \xxx ordinal constants) lines or a kinbd of
  18. Basic DATA command (these lines start with DATA).
  19. See demo.txt included with this package for a commented example.
  20. 2 (special parameter -b)
  21. An arbitrary binary file can get converted to constants. In this mode
  22. only one constant per include file is possible.
  23. This program is distributed in the hope that it will be useful,
  24. but WITHOUT ANY WARRANTY; without even the implied warranty of
  25. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  26. **********************************************************************}
  27. program data2inc;
  28. uses strings;
  29. CONST
  30. version='1.00';
  31. maxbufsize = 1024*1024; { 1 mb buffer }
  32. type
  33. TOutputMode=(OutByte,OutChar,OutString);
  34. {*****************************************************************************
  35. Simple service routines. These are copied from EPasStr.
  36. *****************************************************************************}
  37. TYPE CHARSET=SET OF CHAR;
  38. FUNCTION NextCharPos(CONST S : String;C:CHAR;Count:LONGINT):LONGINT;
  39. VAR I,J:LONGINT;
  40. BEGIN
  41. I:=ORD(S[0]);
  42. IF I=0 THEN
  43. J:=0
  44. ELSE
  45. BEGIN
  46. J:=Count;
  47. IF J>I THEN
  48. BEGIN
  49. NextCharPos:=0;
  50. EXIT
  51. END;
  52. WHILE (S[J]<>C) AND (J<=I) DO INC(J);
  53. IF (J>I) THEN
  54. J:=0;
  55. END;
  56. NextCharPos:=J;
  57. END;
  58. FUNCTION NextCharPosSet(CONST S : String;CONST C:CHARSET;Count:LONGINT):LONGINT;
  59. VAR I,J:LONGINT;
  60. BEGIN
  61. I:=Length(S);
  62. IF I=0 THEN
  63. J:=0
  64. ELSE
  65. BEGIN
  66. J:=Count;
  67. IF J>I THEN
  68. BEGIN
  69. NextCharPosSet:=0;
  70. EXIT;
  71. END;
  72. WHILE (j<=i) AND (NOT (S[J] IN C)) DO INC(J);
  73. IF (J>I) THEN
  74. J:=0; // NOT found.
  75. END;
  76. NextCharPosSet:=J;
  77. END;
  78. PROCEDURE RTrim(VAR P : String;Ch:Char);
  79. VAR I,J : LONGINT;
  80. BEGIN
  81. I:=ORD(P[0]); { Keeping length in local data eases optimalisations}
  82. IF (I>0) THEN
  83. BEGIN
  84. J:=I;
  85. WHILE (P[J]=Ch) AND (J>0) DO DEC(J);
  86. IF J<>I THEN
  87. Delete(P,J+1,I-J+1);
  88. END;
  89. END;
  90. PROCEDURE UpperCase(VAR S : String);
  91. VAR L,I : LONGINT;
  92. BEGIN
  93. L:=Length(S);
  94. IF L>0 THEN
  95. FOR I:=1 TO L DO
  96. IF (S[I]>CHR(96)) AND (S[I]<CHR(123)) THEN
  97. S[I]:=CHR(ORD(S[I])-32);
  98. END;
  99. PROCEDURE LTrim(VAR P : String;Ch:Char);
  100. VAR I,J : LONGINT;
  101. BEGIN
  102. I:=ORD(P[0]); { Keeping length in local data eases optimalisations}
  103. IF (I>0) THEN
  104. BEGIN
  105. J:=1;
  106. WHILE (P[J]=Ch) AND (J<=I) DO INC(J);
  107. IF J>1 THEN
  108. Delete(P,1,J-1);
  109. END;
  110. END;
  111. {*****************************************************************************
  112. Parsing helpers
  113. *****************************************************************************}
  114. FUNCTION XlatString(Var S : String):BOOLEAN;
  115. {replaces \xxx in string S with #x, and \\ with \ (escaped)
  116. which can reduce size of string.
  117. Returns false when an error in the line exists}
  118. Function GetNumber(Position:LONGINT):LONGINT;
  119. VAR C,
  120. Value,
  121. I : LONGINT;
  122. BEGIN
  123. I:=0; Value:=0;
  124. WHILE I<3 DO
  125. BEGIN
  126. C:=ORD(S[Position+I]);
  127. IF (C>47) AND (C<56) THEN
  128. C:=C-48
  129. ELSE
  130. BEGIN
  131. GetNumber:=-1;
  132. EXIT;
  133. END;
  134. IF I=0 THEN
  135. C:=C SHL 6;
  136. IF I=1 THEN
  137. C:=C SHL 3;
  138. Value:=Value + C;
  139. INC(I);
  140. END;
  141. GetNumber:=Value;
  142. END;
  143. VAR S2:String;
  144. A,B : LONGINT;
  145. Value : LONGINT;
  146. BEGIN
  147. A:=1; B:=1;
  148. WHILE A<=Length(S) DO
  149. BEGIN
  150. IF S[A]='\' THEN
  151. IF S[A+1]='\' THEN
  152. BEGIN
  153. S2[B]:='\';
  154. INC (A,2); INC(B);
  155. END
  156. ELSE
  157. BEGIN
  158. Value:=GetNumber(A+1);
  159. IF Value=-1 THEN
  160. BEGIN
  161. XlatString:=FALSE;
  162. EXIT;
  163. END;
  164. S2[B]:=CHR(Value);
  165. INC(B); INC(A,4);
  166. END
  167. ELSE
  168. BEGIN
  169. S2[B]:=S[A];
  170. INC (A);
  171. INC (B);
  172. END;
  173. END;
  174. S2[0]:=CHR(B-1);
  175. S:=S2;
  176. XlatString:=TRUE;
  177. END;
  178. {Global equates}
  179. VAR
  180. Inname, { Name of input file }
  181. OutName, { Name of output (.inc) file }
  182. BinConstName : string; { (-b only) commandline name of constant }
  183. OutputMode : TOutputMode; { Output mode (char,byte,string) }
  184. I_Binary : BOOLEAN; { TRUE is binary input, FALSE textual }
  185. MsgTxt : pchar; { Temporary storage of data }
  186. msgsize : longint; { Bytes used in MsgTxt }
  187. C : CHAR;
  188. {*****************************************************************************
  189. WriteCharFile
  190. *****************************************************************************}
  191. {Dump the contents of MsgTxt (msgsize bytes) to file T (which has been opened),
  192. using CONSTNAME as the name of the ARRAY OF CHAR constant}
  193. procedure WriteCharFile(var t:text;constname:string);
  194. function createconst(b:byte):string;
  195. {decides whether to use the #xxx code or 'c' style for each char}
  196. begin
  197. if (b in [32..127]) and (b<>39) then
  198. createconst:=''''+chr(b)+''''
  199. else
  200. createconst:='#'+chr(b div 100+48)+chr((b mod 100) div 10+48)+chr(b mod 10+48)
  201. end;
  202. var
  203. cidx,i : longint;
  204. p : PCHAR;
  205. begin
  206. Writeln('Writing constant: ',constname,' to file '#39,outname,#39);
  207. {Open textfile}
  208. write(t,'const ',constname,' : array[0..'); Writeln(t,msgsize-1,'] of char=(');
  209. p:=msgtxt;
  210. cidx:=0;
  211. for i:=0 to msgsize-1 do
  212. begin
  213. if cidx=15 then
  214. begin
  215. if cidx>0 then
  216. writeln(t,',')
  217. else
  218. writeln(t,'');
  219. write(t,' ');
  220. cidx:=0;
  221. end
  222. else
  223. IF cidx>0 THEN
  224. write(t,',')
  225. ELSE
  226. Write(T,' ');
  227. write(t,createconst(ord(p^)));
  228. inc(cidx);
  229. inc(p);
  230. end;
  231. writeln(t,');');
  232. Writeln(T);
  233. end;
  234. {*****************************************************************************
  235. WriteByteFile
  236. *****************************************************************************}
  237. {Dump the contents of MsgTxt (msgsize bytes) to file T (which has been opened),
  238. using CONSTNAME as the name of the ARRAY OF BYTE constant}
  239. procedure WriteByteFile(var t:text;constname:string);
  240. function createconst(b:byte):string;
  241. {Translates byte B to a $xx hex constant}
  242. VAR l : Byte;
  243. begin
  244. createconst[1]:='$'; createconst[0]:=#3;
  245. l:=ORD(B SHR 4) +48;
  246. IF l>57 THEN
  247. l:=L+7;
  248. createconst[2]:=CHR(l);
  249. l:=ORD(B and 15) +48;
  250. IF l>57 THEN
  251. INC(L,7);
  252. createconst[3]:=CHR(l);
  253. end;
  254. var
  255. cidx,i : longint;
  256. p : pchar;
  257. begin
  258. Writeln('Writing constant: ',constname,' to file '#39,outname,#39);
  259. {Open textfile}
  260. write(t,'const ',constname,' : array[0..'); Writeln(t,msgsize-1,'] of byte=(');
  261. p:=msgtxt;
  262. cidx:=0;
  263. for i:=0 to msgsize-1 do
  264. begin
  265. if cidx=15 then
  266. begin
  267. if cidx>0 then
  268. writeln(t,',')
  269. else
  270. writeln(t,'');
  271. write(t,' ');
  272. cidx:=0;
  273. end
  274. else
  275. IF cidx>0 THEN
  276. write(t,',')
  277. ELSE
  278. Write(T,' ');
  279. write(t,createconst(ord(p^)));
  280. inc(cidx);
  281. inc(p);
  282. end;
  283. writeln(t,');');
  284. Writeln(T);
  285. end;
  286. {*****************************************************************************
  287. WriteStringFile
  288. *****************************************************************************}
  289. procedure WriteStringFile(var t:text;constname:string);
  290. const
  291. maxslen=240; { to overcome aligning problems }
  292. function l0(l:longint):string;
  293. var
  294. s : string[16];
  295. begin
  296. str(l,s);
  297. while (length(s)<5) do
  298. s:='0'+s;
  299. l0:=s;
  300. end;
  301. var
  302. slen,
  303. len,i : longint;
  304. p : pchar;
  305. start,
  306. quote : boolean;
  307. begin
  308. Writeln('Writing constant: ',constname,' to file '#39,outname,#39);
  309. {Open textfile}
  310. writeln(t,'{$ifdef Delphi}');
  311. writeln(t,'const '+constname+' : array[0..',(msgsize-1) div maxslen,'] of string[',maxslen,']=(');
  312. writeln(t,'{$else Delphi}');
  313. writeln(t,'const '+constname+' : array[0..',(msgsize-1) div maxslen,',1..',maxslen,'] of char=(');
  314. write(t,'{$endif Delphi}');
  315. {Parse buffer in msgbuf and create indexs}
  316. p:=msgtxt;
  317. slen:=0;
  318. len:=0;
  319. quote:=false;
  320. start:=true;
  321. for i:=1 to msgsize do
  322. begin
  323. if slen>=maxslen then
  324. begin
  325. if quote then
  326. begin
  327. write(t,'''');
  328. quote:=false;
  329. end;
  330. write(t,',');
  331. slen:=0;
  332. inc(len);
  333. end;
  334. if (len>70) or (start) then
  335. begin
  336. if quote then
  337. begin
  338. write(t,'''');
  339. quote:=false;
  340. end;
  341. if slen>0 then
  342. writeln(t,'+')
  343. else
  344. writeln(t);
  345. len:=0;
  346. start:=false;
  347. end;
  348. if (len=0) then
  349. write(t,' ');
  350. if (ord(p^)>=32) and (p^<>#39) then
  351. begin
  352. if not quote then
  353. begin
  354. write(t,'''');
  355. quote:=true;
  356. inc(len);
  357. end;
  358. write(t,p^);
  359. inc(len);
  360. end
  361. else
  362. begin
  363. if quote then
  364. begin
  365. write(t,'''');
  366. inc(len);
  367. quote:=false;
  368. end;
  369. write(t,'#'+chr(ord(p^) div 100+48)+chr((ord(p^) mod 100) div 10+48)+chr(ord(p^) mod 10+48));
  370. inc(len,3);
  371. end;
  372. { start a new line when a #0 or #10 is found }
  373. if p^ in [#0,#10] then
  374. start:=true;
  375. inc(slen);
  376. inc(p);
  377. end;
  378. if quote then
  379. write(t,'''');
  380. writeln(t,'');
  381. writeln(t,');');
  382. end;
  383. {*****************************************************************************
  384. Parser
  385. *****************************************************************************}
  386. FUNCTION SpecialItem(S : String):LONGINT;
  387. { This procedure finds the next comma, (or the end of the string)
  388. but comma's within single or double quotes should be ignored.
  389. Single quotes within double quotes and vice versa are also ignored.}
  390. VAR DataItem : LONGINT;
  391. CONST xFcl : CHARSET = [',',#39,'"'];
  392. BEGIN
  393. DataItem:=0;
  394. REPEAT
  395. DataItem:=NextCharPosSet(S,xFcl,DataItem+1); {Find first " ' or ,}
  396. IF (DataItem<>0) AND ((S[DataItem]='"') OR (S[DataItem]=#39)) THEN { (double)Quote found?}
  397. DataItem:=NextCharPos(S,S[DataItem],DataItem+1); { then find other one}
  398. UNTIL (DataItem=0) OR (S[DataItem]=',');
  399. IF DataItem=0 THEN {Last data field of this line?}
  400. DataItem:=Length(S);
  401. SpecialItem:=DataItem;
  402. END;
  403. { Handles reading and processing of a textual file}
  404. procedure DoFile;
  405. var
  406. Infile,
  407. Outfile : text; {in and output textfiles}
  408. line, DataItem, {line number, position in DATA line}
  409. I1,I2, {4 temporary counters}
  410. I3,I4 : longint;
  411. s,S1 : string; {S is string after reading, S1 is temporary string or
  412. current DATA-item being processed }
  413. VarName : String; { Variable name of constant to be written}
  414. PROCEDURE ParseError;
  415. {Extremely simple errorhandler}
  416. BEGIN
  417. Writeln('Error in line : ',Line, ' Somewhere near :',#39,S1,#39);
  418. Close(InfIle); Close(Outfile);
  419. HALT;
  420. END;
  421. PROCEDURE FixDec;
  422. { Reads decimal value starting at S1[1].
  423. Value in I3, number of digits found in I1}
  424. var I1,I2,i3 : longint;
  425. BEGIN
  426. I1:=1;
  427. WHILE ((S1[I1]>#47) AND (S1[I1]<#58)) AND (I1<=Length(S1)) DO
  428. INC(I1);
  429. DEC(I1);
  430. IF I1=0 THEN
  431. ParseError;
  432. I3:=0;
  433. FOR I2:=1 TO I1 DO
  434. I3:=(I3*10)+ ORD(S1[I2])-48;
  435. {Calc no of bytes(1,2 or 4) required from no of digits found}
  436. IF (I1<3) THEN
  437. I2:=1
  438. ELSE
  439. IF (I1=3) AND (I3<256) THEN
  440. I2:=1
  441. ELSE
  442. BEGIN
  443. IF I1<5 THEN
  444. I2:=2
  445. ELSE
  446. IF (I1=5) AND (i3<65536) THEN
  447. I2:=2
  448. ELSE
  449. I2:=4;
  450. END;
  451. END;
  452. PROCEDURE DoChar;
  453. { Reads a #xxx constant at S1[1], and puts it in msgtxt array.
  454. Deletes #xxx constant from S1}
  455. BEGIN
  456. Delete(S1,1,1);
  457. FixDec;
  458. msgtxt[Msgsize]:=CHR(I3);
  459. inc(msgsize);
  460. Delete(S1,1,I1);
  461. END;
  462. PROCEDURE DoQuote;
  463. { Reads a quoted text-string ('xxx' or "xxx"). Quotechar is in S1[1]
  464. (always ' or "), any char except the quotechar is allowed between two
  465. quotechars.
  466. Deletes quoted textstring incl quotes from S1}
  467. VAR
  468. C : Char;
  469. BEGIN
  470. C:=S1[1];
  471. Delete(S1,1,1);
  472. I1:=Pos(C,S1); {Find other quote}
  473. IF I1=0 THEN
  474. ParseError; {Quotes have to be matched}
  475. Dec(I1);
  476. IF I1<>0 THEN
  477. BEGIN
  478. Move(S1[1],Msgtxt[Msgsize],I1);
  479. INC(msgsize,I1);
  480. END;
  481. Delete(S1,1,I1+1);
  482. LTrim(S1,' ');
  483. END;
  484. PROCEDURE FixHex(base2:LONGINT);
  485. { Reads a base 2,8 or 16 constant from S1.
  486. Parameter = 2Log of base (1,3 or 4 corresponding to base 2,8 and 16)
  487. Constant is processed, the number of digits estimated (1,2 or 4 bytes) and
  488. the value is appended to msgtxt accordingly}
  489. BEGIN
  490. I3:=0;
  491. I2:=1;
  492. WHILE (S1[I2] IN ['0'..'9','A'..'F','a'..'f']) AND (I2<=Length(S1)) DO
  493. BEGIN
  494. IF (S1[I2]>#47) AND (S1[I2]<#58) THEN
  495. I3:=(I3 SHL base2)+ ORD(S1[I2])-48
  496. ELSE
  497. IF (S1[I2]>#64) AND (S1[I2]<#71) THEN
  498. I3:=(I3 SHL base2)+ ORD(S1[I2])-55
  499. ELSE
  500. IF (S1[I2]>#96) AND (S1[I2]<#103) THEN
  501. I3:=(I3 SHL base2)+ ORD(S1[I2])-87
  502. ELSE
  503. ParseError;
  504. INC(I2);
  505. END;
  506. DEC(I2);
  507. CASE Base2 OF
  508. 4 : BEGIN
  509. I4:=(I2 SHR 1);
  510. IF ODD(I2) THEN
  511. INC(I4);
  512. IF I4=3 THEN I4:=4
  513. END;
  514. 3 : I4:=(I2*3 DIV 8)+1;
  515. 1 : BEGIN
  516. IF I2<9 THEN
  517. I4:=1
  518. ELSE
  519. IF I2<17 THEN
  520. I4:=2
  521. ELSE
  522. I4:=4;
  523. END;
  524. ELSE
  525. BEGIN
  526. Writeln(' severe internal error ');
  527. ParseError;
  528. END; {else}
  529. END; {Case}
  530. move(I3,msgtxt[Msgsize],i4);
  531. inc(msgsize,i4);
  532. END;
  533. PROCEDURE DoTextual;
  534. { processes aggregates of textual data like 'xxx'+#39"2143124"+'1234'#123}
  535. BEGIN
  536. REPEAT
  537. CASE S1[1] OF
  538. '#' : DoChar;
  539. '"',#39 : DoQuote; {Should I support octal codes here?}
  540. ELSE
  541. ParseError;
  542. END;
  543. LTrim(S1,' ');
  544. IF (S1[1]='+') THEN
  545. Delete(S1,1,1);
  546. LTrim(S1,' ');
  547. UNTIL Length(S1)=0;
  548. END;
  549. PROCEDURE FlushMsgTxt; {Flush MsgTxt array}
  550. BEGIN
  551. IF msgsize>0 THEN {In memory? Then flush}
  552. BEGIN
  553. case outputmode of
  554. OutByte :
  555. WriteByteFile(outfile,Varname);
  556. OutChar :
  557. WriteCharFile(outfile,varname);
  558. OutString :
  559. WriteStringFile(outfile,varname);
  560. end;
  561. msgsize:=0;
  562. END;
  563. END;
  564. {Actual DoFile}
  565. begin
  566. Getmem(msgtxt,maxbufsize);
  567. Writeln('processing file : ',inname);
  568. {Read the message file}
  569. assign(infile,inname);
  570. {$I-}
  571. reset(infile);
  572. {$I+}
  573. if ioresult<>0 then
  574. begin
  575. WriteLn('file '+inname+' not found');
  576. exit;
  577. end;
  578. {Create output file}
  579. assign (outfile,outname);
  580. rewrite(outfile);
  581. msgsize:=0;
  582. Line:=0;
  583. while not eof(infile) do
  584. begin
  585. readln(infile,s); {Read a line}
  586. INC(Line);
  587. S1:=Copy(S,1,5);
  588. Uppercase(S1);
  589. IF S1='DATA ' THEN {DATA keyword?}
  590. BEGIN
  591. Delete(S,1,5);
  592. REPEAT
  593. DataItem:=SpecialItem(S); {Yes. Determine size of DATA field.}
  594. IF DataItem<>0 THEN
  595. BEGIN
  596. I1:=DataItem;
  597. IF DataItem=Length(S) THEN
  598. INC(i1); {DataItem fix for last field}
  599. S1:=Copy(S,1,I1-1); { copy field to S1}
  600. Delete(S,1,I1); {Delete field from S}
  601. LTrim(S1,' ');
  602. RTrim(S1,' ');
  603. LTrim(S,' ');
  604. CASE S1[1] OF {Select field type}
  605. #39,'"','#' : DoTextual; { handles textual aggregates
  606. e.g. #124"142"#123'sdgf''ads'}
  607. '$' : BEGIN {Handle $xxxx hex codes}
  608. Delete(S1,1,1);
  609. RTrim(S1,' ');
  610. IF Length(S1)>0 THEN
  611. FixHex(4)
  612. ELSE
  613. ParseError;
  614. END;
  615. '0'..'9' : BEGIN { handles 0x124,124124,124124H,234h,666o,353d,24b}
  616. IF (Length(S1)>1) AND (S1[2]='x') THEN {C style 0xABCD hex}
  617. BEGIN
  618. Delete(S1,1,2);
  619. FixHex(4);
  620. END
  621. ELSE {other types (HP notation suffix h,o,d and b (and upcase versions,
  622. and no suffix) }
  623. BEGIN
  624. CASE S1[Length(S1)] OF
  625. 'H','h' : FixHex(4); {Hex}
  626. 'o','O' : FixHex(3); {octal}
  627. 'B','b' : BEGIN {Binary}
  628. DEC(S1[0]); {avoid 'b' char being treated as
  629. hex B }
  630. FixHex(1);
  631. END;
  632. '0'..'9','d','D' : BEGIN {decimal versions}
  633. FixDec; {Fixdec is safe for trailing chars}
  634. {I1 =no of digits, I3=value, I2= no bytes needed}
  635. move(I3,msgtxt[Msgsize],i2);
  636. inc(msgsize,i2)
  637. END
  638. ELSE
  639. ParseError; {otherwise wrong suffix}
  640. END {Nested case}
  641. END; { IF S1[2]='x'}
  642. END; { '0'..'9'}
  643. '%' : BEGIN {%101010 binary constants}
  644. Delete(S1,1,1);
  645. FixHex(1);
  646. END;
  647. '\' : BEGIN {\xxx octal constants}
  648. Delete(S1,1,1);
  649. FixHex(3);
  650. END;
  651. END; {Case}
  652. END; {IF <>0}
  653. UNTIL {(DataItem:=Length(S)) OR} (DataItem=0); {parse until String is empty}
  654. END {S1='DATA'}
  655. ELSE
  656. BEGIN {Non DATA line}
  657. IF (Length(S)<>0) AND NOT (S[1] IN ['#',';','%']) THEN
  658. BEGIN
  659. C:=S[1];
  660. IF NOT XlatString(S) THEN {Expand \xxx octal constants}
  661. BEGIN
  662. Writeln('Some error with a \xxx constant or a stale (unescaped) backslash');
  663. ParseError;
  664. END;
  665. IF C='!' THEN { New variable}
  666. BEGIN
  667. FlushMsgTxt;
  668. I1:=1;
  669. OutputMode:=OutChar;
  670. IF S[2]='$' THEN {Flag for ARRAY OF BYTE?}
  671. BEGIN
  672. INC(I1);
  673. OutputMode:=OutByte;
  674. END;
  675. Delete(S,1,I1);
  676. VarName:=S;
  677. END
  678. ELSE
  679. BEGIN {Normal line}
  680. i1:=Length(S);
  681. move(s[1],msgtxt[Msgsize],i1);
  682. inc(msgsize,i1);
  683. END;
  684. END;
  685. END;
  686. end;
  687. close(infile);
  688. FlushMsgTxt; {Flush variable if msgtxt is occupied}
  689. Close(Outfile);
  690. end;
  691. {*****************************************************************************
  692. Binary File
  693. *****************************************************************************}
  694. procedure DoBinary;
  695. var
  696. Infile : File;
  697. Outfile : text;
  698. i : longint;
  699. begin
  700. Writeln('processing file : ',inname);
  701. { Read the file }
  702. assign(infile,inname);
  703. {$I-}
  704. reset(infile,1);
  705. {$I+}
  706. if ioresult<>0 then
  707. begin
  708. WriteLn('file '+inname+' not found');
  709. exit;
  710. end;
  711. { First parse the file and count bytes needed }
  712. msgsize:=FileSize(InFile);
  713. Getmem(msgtxt,msgsize);
  714. BlockRead(InFile,msgTxt[0],msgsize,i);
  715. close(infile);
  716. IF I<>msgsize THEN
  717. BEGIN
  718. Writeln('Error while reading file',inName);
  719. HALT(1);
  720. END;
  721. { Output }
  722. assign (outfile,outname);
  723. rewrite(outfile);
  724. case outputmode of
  725. OutByte :
  726. WriteByteFile(outfile,BinconstName);
  727. OutChar :
  728. WriteCharFile(outfile,BinconstName);
  729. OutString :
  730. WriteStringFile(outfile,BinconstName);
  731. end;
  732. Close(Outfile);
  733. end;
  734. {*****************************************************************************
  735. Main Program
  736. *****************************************************************************}
  737. procedure getpara;
  738. var
  739. ch : char;
  740. para : string;
  741. files,i : word;
  742. procedure helpscreen;
  743. begin
  744. writeln('usage : data2inc [Options] <msgfile> [incfile] [constname]');
  745. Writeln(' The constname parameter is only valid in combination');
  746. writeln(' with -b, otherwise the constname must be specified in the inputfile');
  747. Writeln;
  748. writeln('<Options> can be :');
  749. writeln(' -B File to read is binary.');
  750. writeln(' -A array of byte output (default is array of char)');
  751. writeln(' -S array of string output');
  752. writeln(' -V Show version');
  753. writeln(' -? or -H This HelpScreen');
  754. writeln;
  755. Writeln(' See data2inc.exm for a demonstration source');
  756. halt(1);
  757. end;
  758. begin
  759. I_binary:=FALSE;
  760. OutputMode:=OutChar;
  761. FIles:=0;
  762. for i:=1to paramcount do
  763. begin
  764. para:=paramstr(i);
  765. if (para[1]='-') then
  766. begin
  767. ch:=upcase(para[2]);
  768. delete(para,1,2);
  769. case ch of
  770. 'B' : I_Binary:=TRUE;
  771. 'A' : OutputMode:=OutByte;
  772. 'S' : OutputMode:=OutString;
  773. 'V' : begin
  774. Writeln('Data2Inc ',version,' (C) 1999 Peter Vreman and Marco van de Voort');
  775. Writeln;
  776. Halt;
  777. end;
  778. '?','H' : Helpscreen;
  779. end;
  780. end
  781. else
  782. begin
  783. inc(Files);
  784. if Files>3 then
  785. HelpScreen;
  786. case Files of
  787. 1 : InName:=Para;
  788. 2 : OutName:=Para;
  789. 3 : BinConstName:=Para;
  790. end;
  791. end;
  792. END;
  793. if (FIles<3) AND I_Binary then
  794. HelpScreen;
  795. IF Files<2 THEN
  796. HelpScreen;
  797. end;
  798. begin
  799. GetPara;
  800. IF I_Binary THEN
  801. DoBinary
  802. ELSE
  803. DoFile;
  804. end.