program mitmikro3;         { Datei-Version mit Zeilen-Lesen/Schreiben }
const nul: char = #0;
      esc: char = #27;
      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);
const ack: char = #6;
      etx: char = #3;
      cr: char = #13;
var ch: char;
    name: string[12];

procedure senden;
var ch: char;
    zeile: string[255];
    datei: text;
    lg,i: integer;
begin
assign(datei,name);
{$I-} reset(datei) {$I+};
if IOresult<>0 then writeln('Datei ',name,' nicht gefunden.')
else
  begin
  while not eof(datei) and not KeyPressed do
    begin
    repeat until (getch=ack) or KeyPressed;  { Warten auf Empfaenger }
    write('.');               { zeigt an, dass Uebertragung laeuft }
    readln(datei,zeile);      { naechste Zeile uebertragen }
    lg:=length(zeile);
    for i:=1 to lg do
      begin
      ch:=copy(zeile,i,1);
      if ch in [' '..'~'] then putch(ch);
      end;
    putch(cr);
    end;
  repeat until (getch=ack) or KeyPressed;
  putch(etx); putch(cr);      { Abschluss }
  close(datei);
  end;
end; { senden }

procedure empfangen;
var datei: text;
    zeile: string[255];
    lg,i: integer;
begin
assign(datei,name); rewrite(datei);
repeat
  write('.');        { zeigt an, dass Uebertragung laeuft }
  putch(ack);        { 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 copy(zeile,1,1)<>etx then                { zeilenweise ausgeben }
    begin
    writeln(datei,copy(zeile,1,lg-1));
    end;
until (copy(zeile,1,1)=etx) or Keypressed;
close(datei);
if KeyPressed then erase(datei)
              else writeln('Datei ',name,' auf Diskette.');
end; { empfangen }

begin  { transfer }
repeat
  writeln;
  write('S(enden)  E(mpfangen)  O(nline)  Q(uit) ');
  read(Kbd,ch); writeln(ch);
  ch:=UpCase(ch);
until ch in ['S','E','O','Q'];
if ch='Q' then fertig:=true
else if ch='O' then begin end  { Weiter im Dialog }
else
  begin
  writeln('Zuerst den Sender starten');
  write('Dateiname = '); readln(name);
  if ch='S' then senden
            else empfangen
  end;
end; { transfer }

begin    { mitmikro }
ClrScr;
writeln('MITMIKRO - ins Menue mit ESC');
fertig:=false; msg:=true;
repeat
  if msg then
    begin
    writeln; writeln('Online...');
    msg:=false;
    end;
  ch:=getch;
  if ch<>nul then
    begin
    LowVideo; write(ch); HighVideo;
    end;
  if KeyPressed then
  begin
    read(Kbd,ch);
    if ch=esc then
      begin
      transfer(fertig);
      msg:=true;
      end
    else
      begin
      write(ch);
      putch(ch);
      end;
  end;
until fertig;
writeln; writeln('MITMIKRO - Ende');
end.

