PROGRAM GENFON; { Konverze binarniho souboru *.EXE do souboru fontu - pouzitelne POUZE s obsahem EPROM s firmwarem DATACOOP DCD PRT-42G }
{ (C) LZR Soft, 1991 }
CONST
 DEFNME	='DK:DCD42G ';
 EXTINP	='EXE';
 EXTOUT	='FON';
 DOT	='*';
 XMEZ	=71;
VAR
 PRV,DRU,
 LEN,ADR,
 PAGE,L	:INTEGER;
 ZNAK   :CHAR;
 JMENO	:ARRAY [0..9] OF CHAR;
 POLE	:ARRAY [0..XMEZ,0..8] OF CHAR;
 INF	:FILE OF CHAR;
 OUF	: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
  WRITE(OUF,CHR(ZBYT));
 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:=' ' 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;
 PROCEDURE DUMPIK;
 VAR J,K,STCHR:INTEGER;
 BEGIN
 WRITE(OUF,' ');
 FOR STCHR:=0 TO 6 DO
  BEGIN
  SMERTT:=TRUE;
  WRITE('	',CHR(13),'Adresa: ',PREVOD(ADR,16,TRUE),'H	');
  SMERTT:=FALSE;
  WRITE(OUF,PREVOD(ADR,16,TRUE),': ');
  PRV:=STCHR*10;
  FOR J:=1 TO 9 DO POLE[PRV,J-1]:=CHR(J+48);
  PRV:=PRV+1;
  FOR J:=0 TO 9 DO
   BEGIN
   ZNAK:=PREVOD(VYBERZNAK,2,FALSE);
   PRV:=PRV+1;
   END;
  PRV:=STCHR*10+1;
  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]:=' ';
  WRITE(OUF,PREVOD((VYBERZNAK AND 376B),16,FALSE));
  END;
 PRV:=PRV+9;
 FOR J:=1 TO 9 DO POLE[PRV,J-1]:=CHR(J+48);
 WRITELN(OUF);
 FOR J:=1 TO 7 DO WRITE(OUF,'#123456789');
 WRITELN(OUF,'#');
 FOR K:=0 TO 8 DO
  BEGIN
  FOR J:=0 TO XMEZ-1 DO
   WRITE(OUF,POLE[J,K]);
  WRITELN(OUF);
  END;
 FOR J:=1 TO 7 DO WRITE(OUF,'#123456789');
 WRITELN(OUF,'#');
 END;

BEGIN
IF ADR>2240 THEN WRITELN(OUF,CHR(12));
PAGE:=PAGE+1;
WRITELN(OUF,'Page ',PAGE:2,' of ',JMENO,'.',EXTOUT);
WRITELN(OUF);
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*6;
 REWRITE(OUF,JMENO,EXTOUT,L);
 IF (L<1) THEN
  WRITELN('Neni misto vystupni soubor           : ',PJMEN,EXTOUT)
 ELSE
  BEGIN
  WRITELN(OUF,CHR(27),'[4w',CHR(27),'[2z',CHR(27),'[96t',
             'FONT dump from ',JMENO,'.',EXTINP,' to ',JMENO,'.',EXTOUT);
  PAGE:=0;
  ADR:=0;
  REPEAT
   ZNAK:=CHR(VYBERZNAK);
  UNTIL ADR=2240;
  REPEAT
   ONEPAGE;
  UNTIL ADR>4086;
  REPEAT
   ZNAK:=CHR(VYBERZNAK);
  UNTIL ADR=6336;
  REPEAT
   ONEPAGE;
  UNTIL ADR>8180;
  WRITELN(OUF);
  WRITELN(OUF,'END of ',JMENO,'.',EXTOUT);
  WRITE(OUF,CHR(12));
  CLOSE(OUF);
  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('Generuje se vystupni soubor          : ',PJMEN,EXTOUT);
WRITELN;
TVARY;
WRITELN;
WRITELN(CHR(10),'Konec prace. (C) 1991, LZR Soft, POLDI Kladno');
END.
{----------------------------------------------------------------------------}