PROGRAM BINFON; { Konverze binarniho souboru *.NEW do souboru fontu - pouzitelne POUZE s obsahem EPROM s firmwarem DATACOOP DCD PRT-42G }
{ (C) LZR Soft, 1991 }
CONST
 DEFNME	='DK:DCD42G ';
 EXTINP	='NEW';
 EXTOUT ='BIN';
 EXTOUTL='LIC';
 EXTOUTR='RUB';
 DOT	='@';
 XMEZ	=82;
VAR
 PRV,DRU,
 LEN,ADR,
 TABLECODE,
 PAGE,L	:INTEGER;
 ZNAK   :CHAR;
 JMENO	:ARRAY [0..9] OF CHAR;
 POLE	:ARRAY [0..XMEZ,0..8] OF CHAR;
 INF	:FILE OF CHAR;
 OUFL,
 OUFR	: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,ZAKL:INTEGER;FORM:BOOLEAN):CHAR;
VAR
 CIS:INTEGER;
 ZN:CHAR;
 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 ZAKL=2 THEN
  BEGIN
  IF ZBYT=48 THEN POLE[PRV,DRU]:=' ' ELSE POLE[PRV,DRU]:=DOT;
  DRU:=DRU-1;
  END
 ELSE
  IF SMERTT THEN
   WRITE(CHR(ZBYT))
  ELSE
   BEGIN
   IF ODD(PAGE) THEN
    WRITE(OUFL,CHR(ZBYT))
   ELSE
    WRITE(OUFR,CHR(ZBYT));
   END;
 END;
BEGIN
DRU:=7;
CASE ZAKL OF
  2:BEGIN CIS:=16;ZN:='B' END;
  8:BEGIN CIS:=06;ZN:='Q' END;
 10:BEGIN CIS:=05;ZN:='T' END;
 16:BEGIN CIS:=04;ZN:='H' END;
ELSE
    BEGIN CIS:=20-ZAKL;ZN:='\' END
END;
IF NOT(FORM) THEN CIS:=(CIS+1) DIV 2;
PREV:=NUM;
IF NUM<0 THEN PREV:=65536.0+PREV;
DIGIT(PREV);
PREVOD:=ZN;
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<8190 THEN GET(INF);
VYBERZNAK:=ASC(ZN);
ADR:=ADR+1;
END;
{----------------------------------------------------------------------------}
PROCEDURE ONEPAGE;
VAR J,K,STCHR:INTEGER;
 PROCEDURE DUMPIK;
 BEGIN
 FOR STCHR:=0 TO 6 DO
  BEGIN
  SMERTT:=TRUE;
  WRITE('	',CHR(13),'Adresa: ',PREVOD(ADR,16,TRUE),
        ' kod: ',PREVOD(TABLECODE,16,FALSE),CHR(9),CHR(9));
  SMERTT:=FALSE;
  IF ODD(PAGE) THEN
   WRITE(OUFL,PREVOD(TABLECODE,16,FALSE),' : ',TABLECODE:3,'   ')
  ELSE
   WRITE(OUFR,PREVOD(TABLECODE,16,FALSE),' : ',TABLECODE:3,'   ');
  TABLECODE:=TABLECODE+1;
  PRV:=STCHR*12;
  FOR J:=0 TO 9 DO
   BEGIN
   ZNAK:=PREVOD(VYBERZNAK,2,FALSE);
   PRV:=PRV+1;
   END;
  PRV:=STCHR*12;
  FOR J:=0 TO 7 DO
   BEGIN
   POLE[PRV+J,8]:=POLE[PRV+9,J];
   END;
  IF (ASC(INF^) MOD 2)=1 THEN POLE[PRV+8,8]:=DOT ELSE POLE[PRV+8,8]:=' ';
  ZNAK:=CHR(VYBERZNAK);
  PRV:=PRV+9;
  FOR J:=1 TO 9 DO POLE[PRV,J-1]:=' ';
  END;
 IF ODD(PAGE) THEN
  BEGIN
  WRITELN(OUFL);
  WRITELN(OUFL);
  FOR K:=0 TO 8 DO
   BEGIN
   FOR J:=0 TO XMEZ-1 DO
    WRITE(OUFL,POLE[J,K]);
   WRITELN(OUFL);
   END;
  WRITELN(OUFL);
  END
 ELSE
  BEGIN
  WRITELN(OUFR);
  WRITELN(OUFR);
  FOR K:=0 TO 8 DO
   BEGIN
   FOR J:=0 TO XMEZ-1 DO
    WRITE(OUFR,POLE[J,K]);
   WRITELN(OUFR);
   END;
  WRITELN(OUFR);
  END;
 END;

BEGIN
FOR K:=0 TO 8 DO FOR J:=0 TO XMEZ-1 DO POLE[J,K]:=' ';
IF ADR>2240 THEN
 IF ODD(PAGE) THEN
  WRITE(OUFL,CHR(12))
 ELSE
  WRITE(OUFR,CHR(12));
PAGE:=PAGE+1;
IF ODD(PAGE) THEN
 BEGIN
 WRITELN(OUFL);
 WRITELN(OUFL,'Page ',PAGE:2,' of ',JMENO,'.',EXTOUT);
 WRITELN(OUFL);
 END
ELSE
 BEGIN
 WRITELN(OUFR);
 WRITELN(OUFR,'Page ',PAGE:2,' of ',JMENO,'.',EXTOUT);
 WRITELN(OUFR);
 END;
FOR L:=1 TO 7 DO 
 IF NOT((ADR<4300B) OR		{ 08C0H - 0 000 100 011 000 000B }
       ((ADR>7767B) AND		{ 0FF7H - 0 000 111 111 110 111B }
       (ADR<14300B)) OR		{ 18C0H - 0 001 100 011 000 000B }
       (ADR>17767B)) THEN	{ 1FF7H - 0 001 111 111 110 111B }
  DUMPIK;
END;

PROCEDURE TVARY;
VAR M:INTEGER;
BEGIN
RESET(INF,JMENO,EXTINP,LEN);
IF (LEN<1) THEN
 WRITELN('Nenalezen vstupni soubor             : ',PJMEN,EXTINP)
ELSE
 BEGIN
 L:=LEN*3;
 REWRITE(OUFL,JMENO,EXTOUTL,L);
 IF (L<1) THEN
  WRITELN('Neni misto vystupni soubor           : ',PJMEN,EXTOUTL)
 ELSE
  BEGIN
  L:=LEN*3;
  REWRITE(OUFR,JMENO,EXTOUTR,L);
  IF (L<1) THEN
   WRITELN('Neni misto vystupni soubor           : ',PJMEN,EXTOUTR)
  ELSE
   BEGIN
   WRITE(OUFL,CHR(27),'[4w',CHR(27),'[2z',CHR(27),'[96t',
               'CHAR dump from ',JMENO,'.',EXTINP,' to ',JMENO,'.',EXTOUT);
   PAGE:=0;
   ADR:=0;
   REPEAT
    ZNAK:=CHR(VYBERZNAK);
   UNTIL ADR=2240;
   TABLECODE:=32;
   REPEAT
    ONEPAGE;
   UNTIL ADR>4086;
   REPEAT
    ZNAK:=CHR(VYBERZNAK);
   UNTIL ADR=6336;
   TABLECODE:=32;
   REPEAT
    ONEPAGE;
   UNTIL ADR>8180;
   IF ODD(PAGE) THEN
    BEGIN
    WRITELN(OUFL);
    WRITELN(OUFL,'END of ',JMENO,'.',EXTOUT);
    WRITE(OUFL,CHR(12));
    END
   ELSE
    BEGIN
    WRITELN(OUFR);
    WRITELN(OUFR,'END of ',JMENO,'.',EXTOUT);
    WRITE(OUFR,CHR(12));
    END;
   CLOSE(OUFL);
   CLOSE(OUFR);
   END;
  END;
 CLOSE(INF);
 END;
END;
{----------------------------------------------------------------------------}
BEGIN
WRITELN('Prevod dat z EPROM tiskarny DATACOOP DCD PRT42G do souboru fontu');
WRITELN('================================================================');
WRITE('Jmeno EPROM souboru [',DEFNME,'.',EXTINP,'] : ');
READLN(JMENO);IF JMENO='          ' THEN JMENO:=DEFNME;
FOR L:=0 TO 8 DO IF (JMENO[L]=':') AND (JMENO[L+1]=' ') THEN JMENO:=DEFNME;
WRITELN;
WRITELN('Je pouzit vstupni soubor             : ',PJMEN,EXTINP);
WRITELN('Generuji se vystupni soubory         : ',PJMEN,EXTOUTL);
WRITELN('                                     : ',PJMEN,EXTOUTR);
WRITELN;
TVARY;
WRITELN;
WRITELN(CHR(10),'Konec prace. (C) 1991, LZR Soft, POLDI Kladno');
END.
{----------------------------------------------------------------------------}