PROGRAM PortCapture;
{written by Frank Riemenscheider
            Postfach 730309
            3000 Hannover 71}

USES DOS, PORTCRT;

{$M 6000, 0, 0}
{$L a:tsr.obj}

VAR Buffer   : array[0..79] of word;  {Bildschirmspeicher}
    help : word;
    grazahl : byte;     {Anzahl gespeicherte Grafiken}

PROCEDURE TsrInst(Prozoff : word; Taste : word; Speicher : word) ; external ;
FUNCTION TestInst : boolean ; external ;
PROCEDURE TsrUnInst; external;

{----- SaveZeile: sichert die erste Bildschirmzeile -----}

PROCEDURE SaveZeile;
VAR spalte : byte;                   { die aktuelle bearbeitete Spalte }
BEGIN
  FOR spalte := 0 to 79 DO BEGIN
    Buffer[spalte] := Memw[$B000:2*spalte];
  END;
END;

{----- HolZeile : Restauriert erste Bildschirmzeile -----}

PROCEDURE HolZeile;
VAR spalte : byte;                   { die aktuelle bearbeitete Spalte }
reg : registers;
BEGIN
  FOR spalte := 0 to 79 DO BEGIN
    Memw[$B000:2*spalte] := Buffer[spalte];
  END;
  reg.ah := $12;       {Screen Refresh}
  Intr(97,reg);
END;

{------ TSR - Procedur muá NEAR sein  ------}

{$F-}
PROCEDURE Tsr;
VAR Spalte,i,j,k,
    Zeile,sploop,zloop  : byte;
    name : string;
    groesse : char;
    f : file;
    buf : array[0..82] of byte;
    flag : boolean;
    adresse,result : integer;
    reg : registers;
CONST
 header1 : array[0..18] of byte = (10,5,1,1,0,0,0,0,239,0,63,0,
                                   240,0,64,0,0,0,0);
 header2 : array[0..5] of byte = (1,1,30,0,1,0);
 sp : array[0..1] of byte = (39,79);
 ze : array[0..1] of byte = (7,24);
BEGIN
  reg.ah := $0E;
  reg.al := 0;        {Modus holen (Text/Grafik)}
  Intr(97,reg);
  IF (reg.dl and 128) = 0 THEN BEGIN
    SaveZeile;                           {Textmodus}
    Zeile := WhereY;
    Spalte := WhereX;
    GotoXY(0,0);
    write('******** Filename : <        > ********');
    GotoXY(21,0);
    readln(name);
    name := copy(name,1,12);
    IF Copy(name,length(name)-3,1) <> '.' THEN BEGIN
      name := copy(name,1,8);
      name := name + '.txt';
    END;
    GotoXY(0,0);
    write('* Format: <1> 40x8 <2> 80x25 <0> Ende *');
    Repeat
      Repeat
      Until Keypressed;
      groesse := ReadKey;
    Until ((groesse = '1') or (groesse = '2') or (groesse = '0'));
    HolZeile;
    IF groesse <> '0' THEN BEGIN
      flag := false;
      Assign(f,name);
      Rewrite(f,1);
      IF IOresult = 0 THEN BEGIN
        zloop := ze[ord(groesse)-49];
        sploop := sp[ord(groesse)-49];
        FOR i:= 0 to zloop DO BEGIN
          FOR j:= 0 to sploop DO BEGIN
            buf[j] := Mem[$B000:i*160+2*j];
          END;
          buf[sploop+1] := 13;
          buf[sploop+2] := 10;
          blockwrite(f,buf[0],sploop+3,result);
        END;
        close(f);
        IF ((IOresult =0) and (result = (sploop+3))) THEN flag := true;
      END;
      IF NOT flag THEN BEGIN
        GotoXY(0,0);
        write('** Fehler beim Speichern der Daten ! **');
        groesse := ReadKey;
        HolZeile;
      END;
    END;
    GotoXY(Spalte,Zeile);
  END
  ELSE BEGIN                      {Grafikmodus}
    sound(1200,20);
    str(grazahl,name);
    name := 'Grafik'+name+'.pcx';
    Assign(f,name);
    Rewrite(f,1);
    IF IOresult = 0 THEN BEGIN
      blockwrite(f,header1,19,result);
      FOR i:= 0 to 44 DO BEGIN
         buf[i] := 255;
      END;
      blockwrite(f,buf[0],45,result);
      blockwrite(f,header2,6,result);
      blockwrite(f,buf[0],58,result);
      FOR i:= 0 to 63 DO BEGIN
        adresse := i*30;
        FOR j:= 0 to 29 DO BEGIN
          buf[j*2] := $C1;
          buf[j*2+1] := Mem[$B000:adresse+j];
        END;
        blockwrite(f,buf[0],60,result);
      END;
      close(f);
      IF ((IOresult =0) and (result = 60)) THEN BEGIN
        sound(1200,30);
        inc (grazahl);
      END
      ELSE BEGIN
        sound(700,30);
      END;
    END;
  END;
END;

{-----------              HAUPTPROGRAMM             ---------------}

BEGIN
  grazahl := 0;
  IF (TestInst) THEN        {Programm installiert?}
    BEGIN
      ClrScr;
      writeln('Port-Capture wurde reinstalliert.');
      TsrUnInst;          {Ja, Programm reinstallieren}
    END
  ELSE                    {Nein, Programm installieren}
    BEGIN
      ClrScr;
      writeln('****** P O R T  -  C A P T U R E ******');
      writeln('* Das Foto-Programm fr den Portfolio *');
      writeln('* (C)opyright 1990 by Markt & Technik *');
      writeln('*   written by Frank Riemenschneider  *');
      writeln('*   Port-Capture wurde installiert.   *');
      writeln('* Aufruf mit <LEFTSHIFT>+<RIGHTSHIFT> *');
      write('***************************************');
      help := Seg(HeapPtr^)-PrefixSeg +1;   {Ben”tiger Speicherplatz}
      TsrInst(Ofs(Tsr),1+2,help);
    END;
END.