data2inc.pp 22 KB

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