PROGRAM DUMPBMP;
{$M $800,0,0 }   { 2K stack, no heap }
{ This program is a BMP DUMPER !}
uses Crt, Dos;
const TITLE:ARRAY[1..54] OF BYTE=
  (66,77,54,254,0,0,0,0,0,0,54,4,0,0,40,0,0,0,64,1,0,0,200,0,0,0,1,0,8,0,0,0,0,0,0,250,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
var
  KbdIntVec : Procedure;
  f1:File;
  next_file,next_pom:string;
  i,next_number:integer;
  Control,Color,Count,RR,GG,BB,XX:Byte;

{$F+}
procedure Keyclick; interrupt;
label next;
begin
  if Port[$60] = 41 then
    { Only click when key is pressed }
    begin
    Control:=Port[$61];
    Port[$61]:=Control or $80;
    Port[$61]:=Control; { Regeneracja sterownika }
    Sound(5000);
    next_file  :='00000001.bmp';
    next_number:=1;

next:
    Assign(f1,next_file);
    {$I-} Reset(f1); {$I+}
    if IOResult=0 then begin
      Close(f1);
      Inc(next_number);
      Str(next_number,next_pom);
      for i:=0 to Length(next_pom)-1 do next_file[9-Length(next_pom)+i]:=next_pom[i+1];
      goto next;
    end;
    Rewrite(f1,1);
    BlockWrite(f1,TITLE,54);
    XX:=0;
    for Count:=0 to 255 do begin
    asm
      mov dx,3c7h
      mov al,Count
      out dx,al
      mov dx,3c9h
      in  al,dx
      mov RR,al
      in  al,dx
      mov GG,al
      in  al,dx
      mov BB,al
    end;
    RR:=RR SHL 2;
    GG:=GG SHL 2;
    BB:=BB SHL 2;
    BlockWrite(f1,BB,1);
    BlockWrite(f1,GG,1);
    BlockWrite(f1,RR,1);
    BlockWrite(f1,XX,1);
    end;
    for i:=199 downto 0 do BlockWrite(f1,Mem[$A000:$0000+i*320],320);
    Delay(1);
    Nosound;
    Close(f1);
    end;
  inline ($9C); { PUSHF -- Push flags }
  { Call old ISR using saved vector }
  KbdIntVec;
end;
{$F-}
begin
  { Insert ISR into keyboard chain }
  Color:=TextAttr;
  TextColor(YELLOW);Writeln('BMP Dumper.');
  TextColor(LIGHTRED);Writeln('Press [`] to dump screen.');
  TextColor(Color);Writeln;
  GetIntVec($8,@KbdIntVec);
  SetIntVec($8,Addr(Keyclick));
  Keep(0); { Terminate, stay resident }
end.