(*  VERSION 0015  *)
module M_druck_zeile;
type t_flag = record
                fett : boolean;           (* ^B , Fettdruck *)
                doppel : boolean;         (* ^D , Doppeldruck *)
                control_p : boolean;      (* ^P , ?  *)
                unter,o_unter : boolean;  (* ^S , Unterstreichen *)
                hoch : boolean;           (* ^T , Hochstellen *)
                tief : boolean;           (* ^V , Tiefstellen *)
                durch : boolean;          (* ^X , Durchstreichen *)
                farbe : boolean;          (*(^Y , Druckfarbe)    *)
                tel_aktiv : integer;
                (* augenblicklicher Schreibschritt *)
                schrift : integer;        (* Schriftart *)
                old_schrift : integer;    (* vorhergehende Schriftart *)
                shift : boolean;          (* ^Y , Code unter/ueber $80 *)
                min_breite : integer;     (* mindeste Breite eines Blanks *)
              end;

     tdurchlauf = (durch_norm,durch_doppel,durch_fett);


var dr : t_flag;
    d  : t_flag;
(* Raender des zu formatierenden Blocks *)
    rand_links : integer;           (* linker Rand des Blocks *)
    rand_rechts: integer;           (* Rechter Rand des Blocks *)
(* Anzahl ... je Zeile *)
    anz_wort : integer;             (* Wortenden *)
    anz_satz : integer;             (* Satzenden *)
    anz_zeichen : integer;          (* Zeichen *)
(* Anzahl Einheiten des Blocks bei ... *)
    tel_z_norm : integer;           (* ... Normalschrift *)
    tel_z_prop : integer;           (* ... Proportionalschrift *)
    tel_anz_einf : integer;         (* Anzahl Einheiten einfuegen *)
(* Anzahl zusaetzlicher Einheiten hinter ...*)
    zu_einf : integer;              (* ... Wort- oder Satzenden *)
    zu_zeichen : integer;           (* ... Zeichen *)

    p_wort : integer;               (* Pointer auf Wortenden *)
    p_satz : integer;               (* Pointer auf Satzenden *)

    pzu : record        (* Pointer auf zusaetzliche Einheiten *)
            satz : record (* fuer Satzenden *)
                     links,rechts: integer;
                   end;
            wort : record (* fuer Wortenden *)
                     links,rechts : integer;
                   end;
          end;
    muss: record        (* zusaetzliches Ueberdrucken wegen ... *)
            doppel, fett : boolean;
          end;
    merker_unter : boolean;      (* Merker fuer mehrzeiliges Unterstreichen *)
    zeichenbreite : integer;     (* fuer augenblickliches Zeichen *)
    old_zeichenbreite : integer; (* fuer vorhergehendes Zeichen *)
    breite : array [1..5] of integer; (* Breiten der Leerzeichen *)



    tel_normal : external integer; (* Einheiten *)
    tel_anders : external integer; (* Einheiten *)
(* Zeilenpuffer *)
    zlang : external integer;
    zc : external array [1..255] of char;
    zc_ptr : integer;
    ch : external char;



    external procedure s_druc_hoch;

    external procedure s_druc_tief;

    external procedure s_positioniere(var tel:integer;schrift:integer);

    external procedure set_step_size(anz:integer);

    external procedure s_ein_unter;

    external procedure s_aus_unter;

    external procedure s_ein_fett;

    external procedure s_aus_fett;

    external procedure s_dr_shift(shift:boolean);

    external procedure s_dr_1b;

    external procedure s_dr_1c;

    external procedure s_dr_1d;

    external procedure s_dr_1e;

    external procedure s_dr_1f;

    external procedure dru_backstep(zeichenbreite,schrift:integer);

    external function pstab(ch:char) : integer;

    external procedure warte_auf_taste;

    external procedure lo(ch:char);


procedure dru_hochstellen;
begin
  dr.hoch := not dr.hoch;
  if dr.hoch then
    s_druc_hoch
  else
    s_druc_tief;
end;


procedure dru_tiefstellen;
begin
  dr.tief := not dr.tief;
  if dr.tief then
    s_druc_tief
  else
    s_druc_hoch;
end;


procedure druc_blank (tel:integer);
begin
  tel_anz_einf := tel_anz_einf + tel;
end;


procedure druc_zeichen (ch:char);
begin
  with dr do
    begin
      if o_unter<>unter then
        begin
          if unter then
            begin
              s_positioniere(tel_anz_einf,schrift);
              s_ein_unter;
            end
          else
            s_aus_unter;
          o_unter := unter;
        end;
      if ch=' ' then
        druc_blank(pstab(' '))
      else
        begin
          s_positioniere(tel_anz_einf,schrift);
          lo(ch);
        end;
    end (*with dr *);
end;


function satz_ende_zeichen(ch:char) : boolean;
(* Diese Routine prueft, ob das Zeichen CH ein Satz-Ende-Zeichen ist *)
var i : integer;
    f : boolean;
    t : string[8];
begin
  t := '!,.:;?';  (* normale Satzzeichen *)
  ch := chr( (ord(ch)-$80)& $FF ); (* zu pruefendes Zeichen *)
  f := false;
  for i:=1 to length(t) do
    f := f or (t[i]=ch);
  satz_ende_zeichen := f;
end;


procedure dru_zeichen (ch:char; tel:integer;
                       durchlauf:tdurchlauf; prop:boolean);
var tel_vor,tel_nach : integer;
begin
  with dr do
    begin
      if prop then
        (* kein statischer Vor- oder Nachspann *)
      else
        begin
          tel_vor:=(tel_aktiv - tel) div 2; (* Vorspann *)
          tel_nach:=tel_aktiv -(tel + tel_vor); (* Nachspann *)
          druc_blank(tel_vor);
        end (* if prop *);
      case durchlauf of
        durch_norm: druc_zeichen(ch);
        durch_doppel: if doppel then
                        druc_zeichen(ch)
                      else
                        druc_blank(tel);
        durch_fett: if fett then
                      druc_zeichen(ch)
                    else
                      druc_blank(tel);
      end;
      if prop then
        begin (* dynamischer Nachspann *)
          druc_blank(zu_zeichen);
          if ch>chr($80) then
            begin
              druc_blank(zu_einf);
              if satz_ende_zeichen(ch) then
                begin
                  p_satz := succ(p_satz);
                  if pzu.satz.links >= p_satz then
                    druc_blank(1);
                  if p_satz >= pzu.satz.rechts then
                    druc_blank(1);
                end
              else (* normales Wortende *)
                begin
                  p_wort := succ(p_wort);
                  if pzu.wort.links >= p_wort then
                                druc_blank(1);
                  if p_wort >= pzu.wort.rechts then
                        druc_blank(1);
                end (* if satzendezeichen *);
            end (* if ch *);
        end
      else
        begin (* Nachspann *)
          druc_blank(tel_nach);
        end (* if prop *);
    end (*with dr *);
end;


procedure dr_zeichen(ch:char; durchlauf:tdurchlauf; prop:boolean);
var chl:char;
begin
  chl:=ch & chr($7F);
  with dr do
    begin
      zeichenbreite := pstab(chl);
      if chl<=' ' then
        begin
          case ord(chl) of
            $01: tel_aktiv := tel_anders;
            $02: fett := not fett;
            $03: warte_auf_taste;
            $04: doppel := not doppel;
            $08: dru_backspace(old_zeichenbreite,schrift);
            $0E: tel_aktiv := tel_normal;
            $13: unter := not unter;
            $14: dru_hochstellen;
            $16: dru_tiefstellen;
            $18: (* durchstreichen ist nicht implementiert *);
            $19: begin
                   shift := not shift; (* statt Unterstreichen *)
                   s_dr_shift(dr.shift);
                   if (schrift=2) and shift then
                     begin
                       um_schrift(3);
                       s_dr_1d; (* von latein nach grieschich *)
                     end;
                   if (old_schrift=2) and not shift then
                     begin
                       um_schrift(2); (* von grieschich nach latein *)
                       s_dr_1e;
                     end;
                 end;
            $1B: begin
                   um_schrift(5);
                   s_dr_1b; (* Sonderfunktionen *)
                 end;
            $1C: begin
                   um_schrift(4);
                   s_dr_1c;
                 end;
            $1D: begin
                   um_schrift(3);
                   s_dr_1d;
                 end;
            $1E: begin
                   um_schrift(2);
                   s_dr_1e;
                 end;
            $1F: begin
                   um_schrift(1);
                   s_dr_1f;
                 end;
            $06,$20: dru_zeichen(' ',pstab(' '),durchlauf,prop);
          end (* case *);
        end
      else (* if chl *)
        begin
          if merker_unter then 
            begin
              if (durchlauf=durch_norm) then unter:= not unter;
              merker_unter:=false;
            end;
          dru_zeichen(ch,zeichenbreite,durchlauf,prop);
        end (* if ch *);
      old_zeichenbreite := zeichenbreite;
    end (* with dr *);
end (* dr_zeichen *);


procedure um_schrift(i:integer);
begin (* Schrift umschalten *)
  with dr do
    begin
      old_schrift:=schrift;
      schrift:=i;
      min_breite:=breite[i];
    end;
end;


procedure um_shift;
begin
  with dr do
    begin
      shift := not shift (* statt Farbenwechsel *);
      if (schrift=2) and shift then
        um_schrift(3); (* von latein nach grieschich *)
      if (old_schrift=2) and not shift then
        um_schrift(2); (* von grieschich nach latein *)
    end;
end;


procedure teil1; (* Raender suchen *)
var i, j : integer;
    last_leer : boolean;
    ch : char;
begin
      rand_links := 0;
      rand_rechts := 0;
      i:=zlang;
      while (i>=1) and (rand_rechts=0) do
        begin
          if (zc[i] & chr($7F)) > ' ' then  rand_rechts:=i;
          i:=pred(i);
        end;        
      i:=1; j:=0; last_leer:=true;
      while (i<rand_rechts) and (rand_links=0) do
        begin
          ch := zc[i];
          if last_leer then if (ch & chr($7F)) > ' ' then  j:=i;
          last_leer := (ch & chr($7F))=' ';
          if ch > chr($A0) then  rand_links := j;
          i:=succ(i);
        end;
      if rand_links=0 then rand_links:= j;
end (* teil1 *);


procedure teil2; (* Wort- und Satzenden zaehlen *)
var i: integer;
begin
      anz_satz := 0;
      anz_wort := 0;
      for i:=rand_links to rand_rechts-1 do (* letztes Zeichen zaehlt nicht *)
        begin
          if zc[i]>chr($A0) then
            begin
              if satzendezeichen(zc[i]) then
                anz_satz := succ(anz_satz)
              else
                anz_wort := succ(anz_wort);
            end;
        end; (* for i *)
end (* teil2 *);


procedure teil3; (* normale und proportionale Breite feststellen *)
var i: integer;
begin
  dr := d;
  with dr do
    begin
      muss.doppel := doppel;
      muss.fett := fett;
      for i:=1 to rand_links-1 do
        begin
          ch:=zc[i];
          if ch=chr($01) then tel_aktiv:= tel_anders;
          if ch=chr($02) then muss.fett:= true;
          if ch=chr($04) then muss.doppel:= true;
          if ch=chr($0E) then tel_aktiv:= tel_normal;
          if ch=chr($19) then um_shift; (* statt Unterstreichen *)
          if ch=chr($1B) then um_schrift(5); (* Sonderfunktionen *)
          if ch=chr($1C) then um_schrift(4);
          if ch=chr($1D) then um_schrift(3);
          if ch=chr($1E) then um_schrift(2);
          if ch=chr($1F) then um_schrift(1);
        end;
      tel_z_norm := 0;
      tel_z_prop := 0;
      anz_zeichen := 0;
      for i:=rand_links to rand_rechts do
        begin
          ch := zc[i];
          zeichenbreite := pstab(ch);
          if ch = chr($08) then
                      zeichenbreite := - old_zeichenbreite;
          if zeichenbreite<>0 then
            begin (* druckbares Zeichen *)
              if zeichenbreite<0 then
                tel_z_norm := tel_z_norm-tel_aktiv
              else
                tel_z_norm := tel_z_norm+tel_aktiv;
            end; (* if <>0 *)
          if ch<>chr($A0) then
            begin
              tel_z_prop := tel_z_prop+zeichenbreite;
              old_zeichenbreite := zeichenbreite;
              if ch<' ' then
                case ord(ch) of
                  $01: tel_aktiv := tel_anders;
                  $02: muss.fett := true;
                  $04: muss.doppel := true;
                  $06: anz_zeichen := succ(anz_zeichen);
                  $08: anz_zeichen := pred(pred(anz_zeichen));
                  $0E: tel_aktiv := tel_normal;
                  $19: um_shift; (* statt Unterstreichen *)
                  $1B: um_schrift(5); (* Sonderfunktionen *)
                  $1C: um_schrift(4);
                  $1D: um_schrift(3);
                  $1E: um_schrift(2);
                  $1F: um_schrift(1);
                end (* case *)
              else
                anz_zeichen := succ(anz_zeichen);
            end; (* if <>$A0 *)
        end; (*for i *)
    end; (* with dr, tel_zeile *)
end (* teil3 *);


procedure teil4 (Blockende : boolean); 
          (* feststellen, wo zusaetzliche Einheiten hinkommen *)
var in_space, hi : integer;
begin
  dr:=d;
  with dr do
    begin
      in_space := tel_z_norm - tel_z_prop;
      if in_space<0 then
        in_space:=0;
      (* zusaetzliche Einheiten an jedes Zeichen anhaengen *)
      zu_zeichen := 0;
      zu_einf := 0;
      if schrift=2 then
        begin
          if tel_aktiv=tel_normal then
            hi:=min_breite+min_breite (* max 2 Einheiten einf}gen *)
          else
            hi:=min_breite;
        end;
      while (in_space>=(anz_zeichen-1)*min_breite) and (zu_zeichen<hi) do
        begin
          in_space := in_space- (anz_zeichen-1)*min_breite;
          zu_zeichen := zu_zeichen + min_breite;
          if in_space >= (anz_wort+anz_satz) then
            begin
              in_space := in_space-(anz_wort+anz_satz);
              zu_einf := succ(zu_einf);
            end;
        end (* while in_space *);
      hi:=anz_wort+anz_satz + anz_wort+anz_satz;
      if blockende then
        if in_space>=hi then  in_space:=hi  else  in_space:=0;
      (* zusaetzliche Einheiten an Wort- und Satzenden anhaengen *)
      if anz_wort+anz_satz>0 then
        begin
          while in_space >= (anz_wort+anz_satz) do
            begin
              in_space := in_space-(anz_wort+anz_satz);
              zu_einf := succ(zu_einf);
            end (* while in_space *);
        end; (* if *)
      (* in_space < (anz_wort+anz_satz) *)
      if in_space<anz_satz then
        begin
          pzu.satz.links := in_space div 2;
          pzu.satz.rechts := anz_satz-(in_space-pzu.satz.links)+1;
          in_space := 0;
        end
      else
        begin (* mehr Einheiten zu vergeben, als Satzzeichen vorhanden *)
          pzu.satz.links := anz_satz; (* alle links *)
          pzu.satz.rechts := anz_satz+1; (* keine rechts *)
          in_space := in_space-anz_satz;
        end; (* if <anz_satz *)
      (* in_space < anz_wort *)
      pzu.wort.links := in_space div 2;
      pzu.wort.rechts := anz_wort-(in_space-pzu.wort.links)+1;
    end (* with dr *)
end (* teil4 *);


procedure drucke_zeile (prop,blockende : boolean);
var i: integer;
    wiederholen : tdurchlauf;
begin
  teil1; (* Raender suchen *)
  if prop then
    begin
      teil2; (* Wort- und Satzenden zaehlen *)
      teil3; (* normale und proportionale Breite feststellen *)
      teil4 (blockende); 
             (* feststellen, wo die zusaetzlichen Einheiten hinkommen *)
    end;
  for wiederholen:=durch_norm to durch_fett do
    begin
      if (wiederholen=durch_norm) or
         ((wiederholen=durch_doppel) and muss.doppel) or
        ((wiederholen=durch_fett  ) and muss.fett  )     then
        begin (* eine Zeile drucken; ev. nur ueberdrucken *)
          dr := d;
          p_wort:=0;
          p_satz:=0;
          tel_anz_einf:=0;
          old_zeichenbreite := dr.tel_aktiv;
          if wiederholen=durch_fett then
            s_ein_fett;
          for i:=1 to rand_links-1 do
              dr_zeichen (zc[i], wiederholen, false);
          for i:=rand_links to zlang do
            begin
              ch:=zc[i];
              if ch<>chr($A0) then
                dr_zeichen(ch,wiederholen,prop or blockende);
             end; (* for *)
          if wiederholen=durch_fett then
            s_aus_fett;
          merker_unter:=dr.unter;
          if dr.unter then
            begin
              dr.unter:= false;
            end;
          druc_zeichen(chr($0D));
        end; (* if *)
    end; (* for wiederholen *)
  d := dr; (* Parameter fuer naechste Zeile merken *)
end (* drucke_zeile *);


modend.
