(*  VERSION 0012  *)
module SPEZIFISCH;
(* druckerspezifisch Proceduren fuer GP 300 *)

var old_step_size: char;
    dest : file of char;
    result : integer;


    ch : external char;

    external procedure get_char;
    (* naechstes Zeichen aus Quelle lesen *)



procedure s_open_drucker (schrift:integer);
const boot = 0;
begin
  assign(dest,'LST:');
  rewrite(dest);
  if ioresult=255 then
    begin
      writeln('Drucker kann nicht er|ffnet werden');
      inline("JMP / BOOT ); (* zurueck ins Betriebssystem *)
    end;
  old_step_size:= ' ' (* als erstes Schrittweiter erzwingen *);
  set_step_size('5');
  begin  (* Drucker initialisieren *)
    csi;
    lo(chr(schrift+ord('0')));
    lo(';');
    lo('4'); (* proportional *)
    lo(chr($78));
    lo(chr($0F)); (* Shift in *)
  end;
end;





procedure lo(ch:char);
begin
  dest^ := ch & chr($7F) ;
  put(dest);
end;


procedure s_close_drucker;
begin
  csi;
  lo('2'); (* Gothic *)
  lo(';');
  lo('1'); (* 10 Zeichen/Zoll *)
  lo(chr($78));
  lo(chr($0F)); (* Shift in *)
  set_step_size('0'); (* Standard-Leerzeichenbreite einstellen *)
  lo(chr($0D)); (* Zeilenanfang *)
  close (dest, result);
end;


procedure fkt1_Q;
var t: string;
begin (* Funktion1-Sequenz in Quelledatei erkannt *)
  t := '';
  repeat
    get_char;
    if ch=chr($17) then (* ^W=Funktion2 *)
      ch := chr($78); (* character pitch and font load *)
    t := concat(t,ch);
  until (ch<' ') or (ch>'Z') ;
  if t[length(t)]=chr($78) then
    begin
      ch := chr($1F - (ord(t[1])-ord('1')) );
      (* T[1]='1'..'5', CH=$1F..$1B *)
    end
  else
    begin (* Control-Sequenz kann nicht bearbeitet werden *)
      get_char;
    end; (* if 78 *)
end;


procedure csi;
begin
  lo(chr($1B));
  lo(chr($5B));
end;


procedure s_positioniere(var tel:integer;schrift:integer);
(* Positioniert Druckkopf fuer naechstes Zeichen *)
var t: string;
    i: integer;
    h: integer;
begin
  if (schrift=2) or (schrift=3) or (schrift=5) then
    begin
      while tel >= 72 do
        begin
          set_step_size('1');
          lo(' ');
          tel := tel-72;
        end;
      if tel>=60 then
        begin (* 5 Leerzeichen mit 2*6 Einheiten *)
          set_step_size('4');
          lo(' ');
          lo(' ');
          lo(' ');
          lo(' ');
          lo(' ');
          tel := tel-60;
        end
      else
        if tel>=48 then
          begin (* 2 Leerzeichen mit 4*6 Einheiten *)
            set_step_size('3');
            lo(' ');
            lo(' ');
            tel := tel-48;
          end
      else
        if tel>=36 then
          begin (* 1 Leerzeichen mit 6*6 Einheiten *)
            set_step_size('2');
            lo(' ');
            tel := tel-36;
          end;

      if tel=24 then
        begin (* 1 Leerzeichen mit 4*6 Einheiten *)
          set_step_size('3');
          lo(' ');
          tel := tel-24;
        end
      else
        if tel=12 then
          begin (* 1 Leerzeichen mit 2*6 Einheiten *)
            set_step_size('4');
            lo(' ');
            tel := tel-12;
          end
      else
        if tel>=6 then
          begin
            set_step_size('5');
            while tel>=6 do
              begin
                lo(' ');
                tel := tel-6;
              end;
          end;
    end (* Schrift2 *)
  else
    begin
      if schrift=4 then
        begin
          if tel>= 48 then
            begin
              set_step_size('1');
              while tel >= 48 do
                begin
                  lo(' ');
                  tel := tel-48;
                end;
            end;
          if tel>=8 then
            begin
              set_step_size('4');
              while tel>=8 do
                begin
                  lo(' ');
                  tel := tel-8;
                end;
            end;
        end (* Schrift 4 *)
      else
        begin (* Schrift 1 *)
          if tel>=60 then
            begin
              set_step_size('1');
              while tel >= 60 do
                begin
                  lo(' ');
                  tel := tel-60;
                end;
            end;
          if tel>=10 then
            begin
              set_step_size('4');
              while tel>=10 do
                begin
                  lo(' ');
                  tel := tel-10;
                end;
            end;
        end; (* Schrift 1 *)
    end; (* else Schrift 2 *)
end (* s_positioniere *);


procedure dru_backstep(tel,schrift:integer);
begin
  if (schrift=2) or (schrift=3) or (schrift=5) then
    begin
      set_step_size('5');
      while tel>0 do
        begin
          lo(chr($08));
          tel := tel-6;
        end;
    end
  else
    if schrift=4 then
      begin
        set_step_size('4');
        while tel>0 do
          begin
            lo(chr($08));
            tel := tel-8;
          end;
      end
  else (* Schrift 1 *)
    begin
      set_step_size('4');
      while tel>0 do
        begin
          lo(chr($08));
          tel := tel-10;
        end;
    end;
end;


procedure set_step_size(ch:char);
begin (* L{nge f}r folgende Leerzeichen setzen *)
  if old_step_size <> ch then
    begin
      old_step_size := ch;
      csi;
      lo(ch);
      lo(chr($79));
    end; (* if *)
end;


procedure s_druc_hoch; (* halbe Zeile hochstellen *)
begin
  lo(chr($1B));
  lo(chr($4C)); (* partial line up *)
  lo(chr($1B));
  lo(chr($4D)); (* reverse line feed *)
  lo(chr($0A)); (* line feed *)
end;


procedure s_druc_tief; (* halbe Zeile tiefstellen *)
begin
  lo(chr($1B));
  lo(chr($4B)); (* partial line down *)
end;


procedure s_ein_unter; (* Unterstreichen einschalten *)
begin
  csi;
  lo('4');
  lo(chr($6D));
end;


procedure s_aus_unter; (* Unterstreichen asschalten *)
begin
  csi;
  lo('0');
  lo(chr($6D));
end;


procedure s_ein_fett; (* Fett einschalten *)
begin
  set_step_size('6');
  lo(' ');
end;


procedure s_aus_fett; (* Fett ausschalten *)
begin
  (* nichts *)
end;


procedure s_dr_shift (shift:boolean);
begin
  if shift then
    lo(chr($0E))
  else
    lo(chr($0F));
end;


procedure s_dr_1b;
begin
  csi;
  lo('5');
  lo(';');
  lo('4');
  lo(chr($78));
end;


procedure s_dr_1c;
begin
  csi;
  lo('4');
  lo(';');
  lo('3');
  lo(chr($78));
end;


procedure s_dr_1d;
begin
  csi;
  lo('3');
  lo(';');
  lo('4');
  lo(chr($78));
end;


procedure s_dr_1e;
begin
  csi;
  lo('2');
  lo(';');
  lo('4');
  lo(chr($78));
end;



procedure s_dr_1f;
begin
  csi;
  lo('1');
  lo(';');
  lo('2');
  lo(chr($78));
end;



modend.
