PROGRAM NEWDOC; { Kontrola tabulek znaku v binarnim souboru .CIL - pouzitelne POUZE s obsahem EPROM s firmwarem DATACOOP DCD PRT-42G }
{ (C) LZR Soft, 1991 }
CONST
 DEFNME	='DK:DCD42G ';
 EXTINP	='CIL';
 EXTOUT	='DOC';
 EXTOU1	='DOL';
 EXTOU2	='DOR';
TYPE
 JMENAPREDLOH=ARRAY[1..29] OF CHAR;
VAR
 LEN,ADR,
 PAGE	:INTEGER;
 TABULKAZNAKU
	:ARRAY [0..127] OF INTEGER;
 JMENO	:ARRAY [0..9] OF CHAR;
 POLE	:ARRAY [127..266] OF JMENAPREDLOH;
 INF	:FILE OF CHAR;
 OUF1,
 OUF2	:FILE OF TEXT;
 SMERTT	:BOOLEAN;
{----------------------------------------------------------------------------}
FUNCTION PJMEN:CHAR;
VAR I:INTEGER;
BEGIN
FOR I:=0 TO 9 DO IF JMENO[I]>' ' THEN WRITE(JMENO[I]);
PJMEN:='.';
END;
{----------------------------------------------------------------------------}
FUNCTION PREVOD(NUM:INTEGER;FORM:BOOLEAN):CHAR;
VAR
 ZAKL,CIS:INTEGER;
 PREV:REAL;
 PROCEDURE DIGIT(CO:REAL);
 VAR
  ZBYT:INTEGER;
  DELI:REAL;
 BEGIN
 CIS:=CIS-1;
  DELI:=TRUNC(CO/ZAKL);
 ZBYT:=ROUND(CO-DELI*ZAKL);
 IF CIS>0 THEN DIGIT(DELI);
 IF ZBYT<10 THEN ZBYT:=ZBYT+48
            ELSE ZBYT:=ZBYT+55;
 IF SMERTT THEN
  WRITE(CHR(ZBYT))
 ELSE
  IF ODD(PAGE) THEN
   WRITE(OUF1,CHR(ZBYT))
  ELSE
   WRITE(OUF2,CHR(ZBYT));
 END;
BEGIN
ZAKL:=16;CIS:=04;
IF NOT(FORM) THEN CIS:=(CIS+1) DIV 2;
PREV:=NUM;
IF NUM<0 THEN PREV:=65536.0+PREV;
DIGIT(PREV);
PREVOD:=' ';
END;
{----------------------------------------------------------------------------}
FUNCTION ASC(CON:CHAR):INTEGER;
VAR I:INTEGER;
BEGIN
 I:=ORD(CON);
 IF I<0 THEN I:=256+I;
 ASC:=I
END;
{----------------------------------------------------------------------------}
FUNCTION VYBERZNAK:INTEGER;
VAR ZN:CHAR;
BEGIN
ZN:=INF^;
IF ADR<(LEN*512) THEN GET(INF);
VYBERZNAK:=ASC(ZN);
IF (ADR MOD 32)=0 THEN
 BEGIN
 SMERTT:=TRUE;
 WRITE('	',CHR(13),'Adresa:',PREVOD(ADR,TRUE),'H	');
 SMERTT:=FALSE;
 END;
ADR:=ADR+1;
END;
{----------------------------------------------------------------------------}
PROCEDURE ONEPAGE(OFFSET,CHARSET:INTEGER);
VAR DELKA,I,J,K:INTEGER;
BEGIN
IF PAGE>0 THEN
 IF ODD(PAGE) THEN
  WRITE(OUF1,CHR(12))
 ELSE
  WRITE(OUF2,CHR(12));
PAGE:=PAGE+1;
IF ODD(PAGE) THEN
 BEGIN
 WRITELN(OUF1);
 WRITELN(OUF1,'Page ',PAGE:2,' of ',JMENO,'.',EXTOUT);
 WRITELN(OUF1);
 WRITELN(OUF1,'Character set ',CHARSET:1);
 WRITELN(OUF1);
 END
ELSE
 BEGIN
 WRITELN(OUF2);
 WRITELN(OUF2,'Page ',PAGE:2,' of ',JMENO,'.',EXTOUT);
 WRITELN(OUF2);
 WRITELN(OUF2,'Character set ',CHARSET:1);
 WRITELN(OUF2);
 END;
FOR J:=0 TO 63 DO
 BEGIN
 FOR K:=0 TO 1 DO
  BEGIN
  I:=J+OFFSET+K*64;
  IF ODD(PAGE) THEN
   WRITE(OUF1,I:3,'/',PREVOD(I,FALSE),'=',TABULKAZNAKU[J+K*64]:4,'/',
              PREVOD(TABULKAZNAKU[J+K*64],FALSE),'= ')
  ELSE
   WRITE(OUF2,I:3,'/',PREVOD(I,FALSE),'=',TABULKAZNAKU[J+K*64]:4,'/',
              PREVOD(TABULKAZNAKU[J+K*64],FALSE),'= ');
  CASE TABULKAZNAKU[J+K*64] OF
   00:TABULKAZNAKU[J+K*64]:=256;
   10:TABULKAZNAKU[J+K*64]:=257;
   12:TABULKAZNAKU[J+K*64]:=258;
   13:TABULKAZNAKU[J+K*64]:=259;
   14:TABULKAZNAKU[J+K*64]:=260;
   17:TABULKAZNAKU[J+K*64]:=261;
   19:TABULKAZNAKU[J+K*64]:=262;
   20:TABULKAZNAKU[J+K*64]:=263;
   24:TABULKAZNAKU[J+K*64]:=264;
   27:TABULKAZNAKU[J+K*64]:=265;
   32:TABULKAZNAKU[J+K*64]:=266;
  END;{CASE}
  IF TABULKAZNAKU[J+K*64]<33 THEN
   BEGIN
   IF ODD(PAGE) THEN
    WRITE(OUF1,'^',CHR(I+64))
   ELSE
    WRITE(OUF2,'^',CHR(I+64));
   IF K=0 THEN
    IF ODD(PAGE) THEN
      WRITE(OUF1,'                           ')
     ELSE
      WRITE(OUF2,'                           ');
   END
  ELSE
   IF TABULKAZNAKU[J+K*64]<127 THEN
    BEGIN
    IF ODD(PAGE) THEN
     WRITE(OUF1,CHR(TABULKAZNAKU[J+K*64]))
    ELSE
     WRITE(OUF2,CHR(TABULKAZNAKU[J+K*64]));
    IF K=0 THEN
     IF ODD(PAGE) THEN
      WRITE(OUF1,'                            ')
     ELSE
      WRITE(OUF2,'                            ');
    END
   ELSE
    BEGIN
    DELKA:=29;
    IF K=1 THEN
     WHILE (DELKA>1) AND (POLE[TABULKAZNAKU[J+K*64],DELKA]=' ') DO
      DELKA:=DELKA-1;
    FOR I:=1 TO DELKA DO
     IF ODD(PAGE) THEN
      WRITE(OUF1,POLE[TABULKAZNAKU[J+K*64],I])
     ELSE
      WRITE(OUF2,POLE[TABULKAZNAKU[J+K*64],I]);
    END;
  END;
 IF ODD(PAGE) THEN
  WRITELN(OUF1)
 ELSE
  WRITELN(OUF2);
 END;
END;

PROCEDURE ONETABLE(CHARSET:INTEGER);
VAR I:INTEGER;
BEGIN
FOR I:=0 TO 127 DO TABULKAZNAKU[I]:=VYBERZNAK;
ONEPAGE(0,CHARSET);
FOR I:=0 TO 127 DO TABULKAZNAKU[I]:=VYBERZNAK;
ONEPAGE(128,CHARSET);
END;
{-----------------------------------------------------------------------}
PROCEDURE TABULKY;
VAR M:INTEGER;
BEGIN
RESET(INF,JMENO,EXTINP,LEN);
IF (LEN<1) THEN
 WRITELN('Nenalezen vstupni soubor                 : ',PJMEN,EXTINP)
ELSE
 BEGIN
 M:=100;
 REWRITE(OUF1,JMENO,EXTOU1,M);
 IF (M<1) THEN
  WRITELN('Neni misto vystupni soubor               : ',PJMEN,EXTOU1)
 ELSE
  BEGIN
  M:=100;
  REWRITE(OUF2,JMENO,EXTOU2,M);
  IF (M<1) THEN
   WRITELN('Neni misto vystupni soubor               : ',PJMEN,EXTOU2)
  ELSE
   BEGIN
  WRITE(OUF1,CHR(27),'[4w',CHR(27),'[2z',CHR(27),'[96t',CHR(13),
  'Character set table from ',JMENO,'.',EXTINP,' to ',JMENO,'.',EXTOUT);
  PAGE:=0;
  ADR:=0;
  SMERTT:=FALSE;
  REPEAT
   M:=VYBERZNAK;
  UNTIL ADR=12000B;	{ 1400H - 0 001 010 000 000 000B }
  FOR M:=0 TO 3 DO ONETABLE(M);
  WRITELN(OUF2);
  WRITELN(OUF2,'END of ',JMENO,'.',EXTOUT);
  WRITE(OUF2,CHR(12));
  CLOSE(OUF1);
  CLOSE(OUF2);
   END;
  END;
 CLOSE(INF);
 END;
END;
{----------------------------------------------------------------------------}
BEGIN
WRITELN('Kontrola tabulek znaku v binarnim souboru');
WRITELN('=========================================');
WRITE('Jmeno binarniho souboru [',DEFNME,'.',EXTINP,'] : ');
READLN(JMENO);IF JMENO='          ' THEN JMENO:=DEFNME;
FOR LEN:=0 TO 8 DO
 IF (JMENO[LEN]=':') AND (JMENO[LEN+1]=' ') THEN JMENO:=DEFNME;
WRITELN;
WRITELN('Je pouzit vstupni soubor                 : ',PJMEN,EXTINP);
WRITELN('Generuji se vystupni soubory             : ',PJMEN,EXTOU1);
WRITELN('                                         : ',PJMEN,EXTOU2);
WRITELN;
POLE[127]:='copyright                    ';
POLE[128]:='registred trademark          ';
POLE[129]:='A s carkou                   ';
POLE[130]:='prehlasovane A               ';
POLE[131]:='C s hackem                   ';
POLE[132]:='D s hackem                   ';
POLE[133]:='E s carkou                   ';
POLE[134]:='E s hackem                   ';
POLE[135]:='I s carkou                   ';
POLE[136]:='mekke L                      ';
POLE[137]:='N s hackem                   ';
POLE[138]:='R s hackem                   ';
POLE[139]:='R s carkou                   ';
POLE[140]:='T s hackem                   ';
POLE[141]:='U s carkou                   ';
POLE[142]:='U s krouzkem                 ';
POLE[143]:='prehlasovane U               ';
POLE[144]:='Y s carkou                   ';
POLE[145]:='a s carkou                   ';
POLE[146]:='prehlasovane a               ';
POLE[147]:='c s hackem                   ';
POLE[148]:='d s hackem                   ';
POLE[149]:='e s carkou                   ';
POLE[150]:='e s hackem                   ';
POLE[151]:='i s carkou                   ';
POLE[152]:='mekke l                      ';
POLE[153]:='n s hackem                   ';
POLE[154]:='O a o s carkou               ';
POLE[155]:='prehlasovane O a o           ';
POLE[156]:='O a o s ^                    ';
POLE[157]:='r s hackem                   ';
POLE[158]:='r s carkou                   ';
POLE[159]:='S a s s hackem               ';
POLE[160]:='t s hackem                   ';
POLE[161]:='u s carkou                   ';
POLE[162]:='u s krouzkem                 ';
POLE[163]:='prehlasovane u               ';
POLE[164]:='y s carkou                   ';
POLE[165]:='Z a z s hackem               ';
POLE[166]:='Libra                        ';
POLE[167]:='alfa                         ';
POLE[168]:='beta                         ';
POLE[169]:='recke pi                     ';
POLE[170]:='omega                        ';
POLE[171]:='suma                         ';
POLE[172]:='recke mikro                  ';
POLE[173]:='Pt                           ';
POLE[174]:='paragraf                     ';
POLE[175]:='1/2                          ';
POLE[176]:='1/4                          ';
POLE[177]:='prumer                       ';
POLE[178]:='odmocnina                    ';
POLE[179]:='priblizne                    ';
POLE[180]:='nerovna se                   ';
POLE[181]:='plus minus                   ';
POLE[182]:='umocneni na 2                ';
POLE[183]:='hacek                        ';
POLE[184]:='carka                        ';
POLE[185]:='krouzek/stupne               ';
POLE[186]:='prehlaska                    ';
POLE[187]:='dvouvlnovka                  ';
POLE[188]:='sipka vpravo                 ';
POLE[189]:='sipka vlevo                  ';
POLE[190]:='sipka dolu                   ';
POLE[191]:='sipka nahoru                 ';
POLE[192]:='plny ctverec                 ';
POLE[193]:='zaludy                       ';
POLE[194]:='listy                        ';
POLE[195]:='srdce                        ';
POLE[196]:='piky                         ';
POLE[197]:='plne kolecko                 ';
POLE[198]:='prazdne kolecko              ';
POLE[199]:='ufoun                        ';
POLE[240]:='tvrda mezera                 ';
POLE[241]:='cara od poloviny vlevo       ';
POLE[242]:='cara od poloviny vpravo      ';
POLE[243]:='vodorovna cara               ';
POLE[244]:='cara od poloviny vzhuru      ';
POLE[245]:='pravy dolni roh              ';
POLE[246]:='levy dolni roh               ';
POLE[247]:='svisle T nahoru              ';
POLE[248]:='cara od poloviny dolu        ';
POLE[249]:='pravy horni roh              ';
POLE[250]:='levy horni roh               ';
POLE[251]:='svisle T dolu                ';
POLE[252]:='svisla cara                  ';
POLE[253]:='leve T                       ';
POLE[254]:='prave T                      ';
POLE[255]:='kriz                         ';
POLE[256]:='NUL prazdny znak             ';
POLE[257]:='LF dalsi radka               ';
POLE[258]:='FF nova stranka              ';
POLE[259]:='CR navrat na zacatek radky   ';
POLE[260]:='SO rusky registr             ';
POLE[261]:='DC1 ridici znak 1            ';
POLE[262]:='DC3 ridici znak 3            ';
POLE[263]:='DC4 ridici znak 4            ';
POLE[264]:='CAN smazani bafru tiskarny   ';
POLE[265]:='ESC                          ';
POLE[266]:='mezera                       ';

POLE[200]:='znak z generatoru DLL!!!     ';
POLE[224]:=POLE[240];
POLE[209]:=POLE[200];
POLE[225]:=POLE[241];
POLE[210]:=POLE[200];
POLE[226]:=POLE[242];
POLE[211]:=POLE[200];
POLE[227]:=POLE[243];
POLE[212]:=POLE[200];
POLE[228]:=POLE[244];
POLE[229]:=POLE[245];
POLE[213]:=POLE[200];
POLE[214]:=POLE[200];
POLE[230]:=POLE[246];
POLE[215]:=POLE[200];
POLE[231]:=POLE[247];

POLE[200]:=POLE[200];
POLE[216]:=POLE[200];
POLE[232]:=POLE[248];
POLE[201]:=POLE[200];
POLE[217]:=POLE[200];
POLE[233]:=POLE[249];
POLE[202]:=POLE[200];
POLE[218]:=POLE[200];
POLE[234]:=POLE[250];
POLE[203]:=POLE[200];
POLE[219]:=POLE[200];
POLE[235]:=POLE[251];
POLE[204]:=POLE[200];
POLE[220]:=POLE[200];
POLE[236]:=POLE[252];
POLE[205]:=POLE[200];
POLE[221]:=POLE[200];
POLE[237]:=POLE[253];
POLE[206]:=POLE[200];
POLE[222]:=POLE[200];
POLE[238]:=POLE[254];
POLE[207]:=POLE[200];
POLE[223]:=POLE[255];
POLE[239]:=POLE[255];
TABULKY;
WRITELN;
WRITELN(CHR(10),'Konec prace. (C) 1991, LZR Soft, POLDI Kladno');
END.
{----------------------------------------------------------------------------}