program xfer;
{ Programm zum Daten-Transfer ueber die serielle Schnittstelle
  zur LSI 11 von U.Ranft, MHH Biometrie. Dort heisst das Programm
  ebenfalls xfer. Es muss ein "verdrehtes" Kabel benutzt werden.
  Folgendes Handshaking wird benutzt (aus der Sicht
  des ELZET80):

- Senden von Records mit fester Laenge (80 Zeichen)
  1. Warten auf das erste CR
  2. CR LF bl bl bl bl (4 Blanks) senden
  3. Ctrl-R Ctrl-R CR als Bestaetigung empfangen
  4. CR LF bl bl bl bl <80er Record> CR LF bl bl bl bl senden und weiter bei 3.
     bzw. CR LF bl bl bl bl Ctrl-T Ctrl-T <72 Zeichen> CR F bl bl bl bl
          fuer Transfer-Ende senden

- Empfangen von Records variabler Laenge (bis CR)
  1. Warten auf das erste CR
  2. <6 bel.Zeichen> Ctrl-R Ctrl-R <6 bel.Zeichen> senden
  3. Record beliebiger Laenge bis CR empfangen und weiter bei 2.
     bzw. Ctrl-T Ctrl-T fuer Transfer-Ende empfangen

  A.Herrmann
}
const vers:  string[12] = 'Version 1.1 ';
      dat:   string[8] = '28.01.85';
const nul:   char = #0;
      lf:    char = #10;
      cr:    char = #13;
      ctrlr: char = #18;
      ctrlt: char = #20;
      esc:   char = #27;
      blank: char = #32;
const sioc:  byte = 6;  { SIO-A Control }
      siod:  byte = 4;  { SIO-A Data }

var ch: char;
    fertig,msg: boolean;

function getch: char;  { holt ein Zeichen von SIO-A }
var status: byte;
begin
  status:=port[sioc];
  if status and 1 = 1 then getch:=chr(port[siod])
  else getch:=nul;
end; { getch }

procedure putch(ch: char);  { sendet ein Zeichen ueber SIO-A }
var status: byte;
begin
  repeat
    status:=port[sioc];
  until status and 4 = 4;
  port[siod]:=ord(ch);
end; { putch }

procedure transfer(var fertig: boolean);
var ch: char;
    name: string[12];
    abort: boolean;

procedure sndack;            { sende CR LF bl bl bl bl }
var i: integer;
begin
putch(cr); putch(lf);
for i:=1 to 4 do
  putch(blank);
{writeln('ack');}
end; { sndack }

procedure senden;
label skip,exit;
const rlgth: integer = 80;   { feste Record-Laenge }
var ch: char;
    zeile: string[255];
    datei: text;
    rcnt: integer;           { Record-Zaehler }
    lg,i: integer;

begin
abort:=false;
assign(datei,name);
{$I-} reset(datei) {$I+};
if IOresult<>0 then writeln('Datei ',name,' nicht gefunden.')
else
  begin
  writeln('Ich warte auf CR...');
  repeat until (getch=cr) or KeyPressed;  { Warten auf Empfaenger }
  if KeyPressed then
    begin
    abort:=true; goto exit;               {---------------> Exit }
    end;
  sndack;                                 { Bestaetigung senden }
  rcnt:=0;
  repeat until (getch=cr) or KeyPressed;  { Warten auf Empfaenger }
  repeat
    if KeyPressed then
      begin
      read(kbd,ch);
      if ch=chr(3) then
        begin
        abort:=true; goto exit;               {---------------> Exit }
        end;
      end;
    sndack;                                 { Bestaetigung senden }
{    if not eof(datei) then}
     begin
skip: readln(datei,zeile);      { naechste Zeile uebertragen }
     lg:=length(zeile);
     if (lg>0) then
       begin
       ch:=copy(zeile,1,1);
       if (ch='#') then goto skip;
       for i:=1 to lg do
         begin
         ch:=copy(zeile,i,1);
         if ch in [' '..'~'] then putch(ch);
         end;
       end;
     for i:=lg+1 to rlgth do
        putch(blank);
      rcnt:=rcnt+1;
      write(cr,rcnt,'. Record');
      {WRITELN(ZEILE);}
      sndack;                                 { Bestaetigung senden }
      repeat until (getch=cr) or KeyPressed;  { Warten auf Empfaenger }
    end
  until eof(datei);
exit:   sndack;
  putch(ctrlt); putch(ctrlt);
  for i:=3 to rlgth do
    putch(blank);
  sndack;                                 { Bestaetigung senden }
  close(datei);
  writeln;
  if abort then write('Abbruch! - Datei ',name,' unvollstaendig')
           else write('Datei ',name);
  writeln(' gesendet.');
  end;
end; { senden }

procedure empfangen;
label exit;
var datei: text;
    zeile: string[255];
    rcnt: integer;
    lg,i: integer;
begin
assign(datei,name); rewrite(datei);
writeln('Ich warte auf CR...');
repeat until (getch=cr) or KeyPressed;  { Warten auf Empfaenger }
if KeyPressed then
  begin
  abort:=true; goto exit;               {---------------> Exit }
  end;
rcnt:=0;
repeat
  sndack; putch(ctrlr); putch(ctrlr); sndack;  { Aufforderung zum Senden }
  lg:=0;
  repeat
    repeat ch:=getch until (ch<>nul) or KeyPressed;   { empfangen }
    lg:=lg+1; insert(ch,zeile,lg);                    { zwischenspeichern }
  until (ch=cr) or KeyPressed;
  if KeyPressed then
    begin
    abort:=true; goto exit;               {---------------> Exit }
    end;
  if (copy(zeile,1,1)<>ctrlt) and (copy(zeile,2,1)<>ctrlt) then
    writeln(datei,copy(zeile,1,lg-1));                { zeilenweise ausgeben }
  rcnt:=rcnt+1;
  write(cr,rcnt,'.Record');
until (copy(zeile,1,1)=ctrlt) and (copy(zeile,2,1)<>ctrlt);
exit: close(datei);
writeln;
if abort then write('Abbruch!  Datei ',name,' unvollstaendig')
         else write('Datei ',name);
writeln(' auf Diskette.');
end; { empfangen }

begin  { transfer }
repeat
  writeln;
  write('xfer - S(enden)  E(mpfangen)  Q(uit) ');
  read(Kbd,ch);
  ch:=UpCase(ch); writeln(ch);
until ch in ['S','E','Q'];
if ch='Q' then fertig:=true
else
  begin
  write('Dateiname = '); readln(name);
  if ch='S' then senden
            else empfangen
  end;
end; { transfer }

begin    { xfer }
ClrScr;
writeln('xfer - ',vers,' vom ',dat); writeln;
writeln('Erst den ELZET auf Empfang, dann die LSI auf Senden!'); writeln;
fertig:=false;
repeat
  transfer(fertig);
until fertig;
writeln; writeln('xfer - Ende');
end.

