(*  VERSION 0003  *)
program PROPORTIONAL_SCHRIFT; (* fuer GP300 *)

const z_max=255;

type tfile=file of char;
     pstring = ^string;

var str_ptr : pstring;
    src : tfile;
    terminal : text;
    schrift: integer;
    seite, name : string;
(* Zeilenverwaltung *)
    seite_nr, zeile_nr : integer  (* Seiten- und Zeilenzaehler *);
    ch : char                     (* gelesenes Zeichen *);
    p_zeile,old_p_zeile : boolean (* letzte Zeile war proportional *);
(* Zeilenpuffer *)
    zlang : integer;
    zc : array [1..z_max] of char;

external function @cmd:pstring;
external procedure init_flags (var schrift: integer);
external procedure drucke_zeile(prop,blockende:boolean);
external procedure s_open_drucker (schrift: integer);
external procedure s_close_drucker;
external procedure lo(ch:char);
external procedure fkt1_Q;


procedure get_char;
begin
  if eof(src) then
    begin
      ch:=chr($1A);
    end
  else
    begin
      ch:=src^;
      get(src);
    end;
end;


procedure get_zeile;
begin
  zlang:=0;
  while (zlang<255) and ((ord(ch)& $7F)<>$0D) and (ch<>chr($0C)) do
    begin
      if ch=chr($11) then
        fkt1_Q; (* ^Q mu~ druckerspezifisch behandelt werden *)
                (* ^Q mu~ ein druckbares (Steuer-) Zeichen ... *)
                (* ... in CH zur}ckgeben *)
      if (ch<>chr($0C)) and ((ord(ch)& $7F)<>$0D) then
        begin
          zlang := succ(zlang);
          zc[zlang] := ch;
          get_char;
        end;
    end;
end;


procedure str_int(var s:string; z:integer);
var i:integer;
begin (* wandlung von Integer in String *)
  for i:=5 downto 2 do
    begin
      s[i]:= chr((z mod 10)+ord('0'));
      z := z div 10;
    end;
  s[1]:=chr(z+ord('0'));
  i:=1;
  while (s[i]='0') and (i<5) do
    i:=i+1;
  s := copy(s,i,6-i);
  s[0]:=chr(6-i);
end (* S[..] enth{lt nur die Ziffern der Zahl Z (keine Leerzeichen) *);


procedure warte_auf_taste;
var c:char;
begin
  write(terminal,'Druckstop   (Returntaste dr}cken)');
  read(c);
  write(terminal,chr($0D),'                                 ',chr($0D));
end;


procedure neue_seite;
begin
  seite_nr:=succ(seite_nr);
  zeile_nr:=0;
  str_int(seite,seite_nr);
end;


begin (* HP Proportionalschrift *)
  str_ptr := @cmd (* PTR auf CP/M-Parameter *);
  name := str_ptr^;
  if length(name)<=1 then name:='B:P.PRO';
  assign (terminal,'CON:');
  reset(terminal);
  writeln('Proportionaldruck f}r GP 300');
  assign (src,name);
  reset(src);
  if ioresult=255 then
    writeln(name,' l{~t sich nicht er|ffnen')
  else
    begin
          init_flags (schrift);
          s_open_drucker (schrift);
          writeln(name,' wird gedruckt : ');
          old_p_zeile := false;
          seite_nr:=1;
          zeile_nr:=1;
          get_char;
          while ch<>chr($1A) do
            begin
              write(terminal,'Seite: ',seite);
              str_int(name,zeile_nr);
              write(terminal,'  Zeile: ',name,chr($0D));
              get_zeile (* CH = Zeilenvorschubszeichen *);
              p_zeile := (ch=chr($8D));
              drucke_zeile(p_zeile or old_p_zeile, 
                           (not p_zeile)and old_p_zeile);
              old_p_zeile := p_zeile;
              if ch=chr($0C) then
                begin
                  neue_seite;
                  lo(ch);
                end;
              repeat
                get_char;
                if (ord(ch)& $7F)=$0A then
                  begin
                    if ch=chr($8A) then
                      neue_seite;
                    zeile_nr:= succ(zeile_nr);
                    lo(chr($0A));
                  end;
              until (ord(ch)& $7F)<>$0A;
            end (*while*);
          s_close_drucker;
  end (* lesen *);
end (* HP *).
