Program zdruck;
{ (c) 1991 by H.-J. Schloįarek }
uses crt,printer,dos;
var
     Table1 : array[0..255,0..15] of byte;
     datei:text;zname,dname:string[80];z:integer;
     drucksatz:array[0..255] of byte;
     daten:file of byte;dsatz:string;
     seitenlaenge,x,y,i,fehler:integer;ch:char;
procedure hilfe;
begin
clrscr;
writeln('Zdruck druckt Text mit selbsterstellten Zeichen!');
writeln('Aufrufen mit zdruck <Datei mit den Zeichen> <Textdatei>');
writeln('Weiter mit Return!');
readln;
halt(0);
end;
procedure meldung(mz,mx,my:integer;melde:string);
begin
z:=mz;inc(z);
if z <=1 then
clrscr;
gotoxy(mx,my);Write(melde);
end;
procedure zeichen_lesen;
var
   i,ii:integer;
begin
   clrscr;
   assign(daten,zname);
   {$I-} reset(daten); {$I+}
   if ioresult <> 0 then
     begin
      meldung(0,1,1,'Datei '+zname+ 'nicht im gleichen Verzeichnis wie zdruck!');
      meldung(1,1,2,'Bitte berprfen und Programm neu starten!');
      meldung(2,1,3,'Weiter mit Return!');
      readln;halt(0);
     end;
   for i:=0 to 255 do
     for ii:=0 to 15 do
   read(daten,table1[i,ii]);
   close(daten);
end;
Procedure seite_loeschen;
var i : integer;
begin
  for i := 0 to 255 do
        drucksatz[i] := 32;
end;
procedure drucker_ini;
var
   regs:registers;
begin
   regs.ah:=1; regs.dx:=0; intr($17,regs);
end;
procedure drucker_test;
var
   regs:registers;
   ch:char;
begin
   regs.ah:=$2; regs.dx:=0; intr($17,regs);
   if (regs.ah and 16) = 0 then
     begin
      meldung(0,1,1,'Drucker nicht betriebsbereit!');
      meldung(1,1,2,'Bitte berprfen!');
      meldung(2,1,3,'Wenn fertig fr Drucken Taste "J"');
      meldung(3,1,4,'Wenn Sie unterbrechen wollen drcken Sie "E"!');
      ch:=' ';
    repeat
    ch:=upcase(readkey);
    until ch in ['J','E'];
    if ch = 'J' then
       drucker_ini
    else
    begin clrscr; halt(0); end;
    end else drucker_ini;
end;

Procedure Druckseite;
var i,ii: integer;
begin
  write(lst,#27,'1');
  for i := 1 to length(dsatz) do
   begin
     write(lst,#27,'K',chr(8)+chr(0));
      for ii := 0 to 7 do
       write(lst,chr(table1[drucksatz[i],ii]));
    end;
   write(lst,chr(10));
  for i := 1 to length(dsatz) do
   begin
     write(lst,#27,'K',chr(8)+chr(0));
      for ii := 8 to 15 do
       write(lst,chr(table1[drucksatz[i],ii]));
    end;
   writeln(lst);
   writeln(lst,#27,#0);
end;

Procedure zeichen_druck(Druckzeile:string);
var i : integer;
begin
  for i := 0 to length(Druckzeile) do
     drucksatz[i] := ord(Druckzeile[i]);
end;

procedure datei_lesen;
begin
 assign(datei,dname);
 {$I-} reset(datei); {$I+}
 If ioresult <> 0 then
     begin
     meldung(0,1,2,'Dateifehler, neu eingeben!');
     meldung(1,1,3,'Weiter mit Returntaste!');
     readln;halt(0);
     end;
  while NOT EOF(datei) do
        begin
        dsatz:='';
        readln(datei,dsatz);
        zeichen_druck(dsatz);
        druckseite;
        end;
   close(datei);
end;
begin
   if paramcount > 2 then hilfe;
   if (paramcount = 0) or (paramcount = 1) then hilfe;
   if paramcount = 2 Then
    begin
     drucker_test;
     zname:=paramstr(1);dname:=paramstr(2);
     zeichen_lesen;datei_lesen;
    end;
  write(lst,#27,'@');
end.