{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                  抓图文件支持单元                       ***}
{***************************************************************}
{$O+,F+,X+,I-}
Unit FCutGra;
Interface
Uses
  Dos;

Procedure PaintCutGra(Name:PathStr);
Procedure GetCutGra(Name:PathStr);
Implementation
Uses
  FVesa;

Type
  CrtcRegsType=array[0..$18] of Byte;
  PalRegsType=array[0..16] of Byte;
  DacRegsType=array[1..256*3] of byte;
  CutFileHeader=record
   VickySign:array[0..4] of Byte;
   Vision:Word;
   VideoMode:Word;
   Pal:PalRegsType;
   Dac:DacRegsType;
   Reserved:array[0..99] of Byte;
  end;

var
  Head:CutFileHeader;

Procedure GetCrtcRegs(var Reg:CrtcRegsType);
var
  i:Integer;
begin
  for i:=0 to $18 do
  begin
    Port[$3D4]:=i;
    Reg[i]:=Port[$3D5];
  end;
end;

Procedure SetCrtcRegs(var Reg:CrtcRegsType);
var
  i:Integer;
begin
  for i:=0 to $18 do
  begin
    Port[$3D4]:=i;
    Port[$3D5]:=Reg[i];
  end;
end;

Procedure GetPalRegs(var Pal:PalRegsType);
var
  R:Registers;
begin
  R.AX:=$1009;
  R.ES:=Seg(Pal);
  R.DX:=Ofs(Pal);
  Intr($10,R);
end;

Procedure SetPalRegs(var Pal:PalRegsType);
var
  R:Registers;
begin
  R.AX:=$1002;
  R.ES:=Seg(Pal);
  R.DX:=Ofs(Pal);
  Intr($10,R);
end;

Procedure GetDacRegs(var Dac:DacRegsType);
var
  R:Registers;
begin
  R.AX:=$1017;
  R.BX:=0;
  R.CX:=256;
  R.ES:=Seg(Dac);
  R.DX:=Ofs(Dac);
  Intr($10,R);
end;

Procedure SetDacRegs(var Dac:DacRegsType);
var
  R:Registers;
begin
  R.AX:=$1012;
  R.BX:=0;
  R.CX:=256;
  R.ES:=Seg(Dac);
  R.DX:=Ofs(Dac);
  Intr($10,R);
end;

Procedure SelectWPlane(n:Integer);
begin
  Port[$3C4]:=$02;
  Port[$3C5]:=1 shl n;
end;

Procedure PaintCutGra(Name:PathStr);
var
  Fp:file;
  Result:Word;
  VideoMode:Word;
  VideoMemSize:Longint;
  P:Pointer;
  Procedure Paint12h;
  var i:Integer;
  begin
    GetMem(P,VideoMemSize);
    for i:=0 to 3 do
    begin
      SelectWPlane(i);
      BlockRead(Fp,P^,VideoMemSize,Result);
      Move(P^,Ptr($A000,0)^,VideoMemSize);
    end;
    FreeMem(P,VideoMemSize);
  end;
  Procedure Paint13h;
  begin
    GetMem(P,$8000);
    BlockRead(Fp,P^,$8000,Result);
    Move(P^,Ptr($A000,0)^,$8000);
    BlockRead(Fp,P^,$8000,Result);
    Move(P^,Ptr($A000,$8000)^,$8000);
    FreeMem(P,$8000);
  end;
  Procedure PaintVESA101h;
  var
    i:Integer;
    Page,OldPage:Integer;
    Last:Word;
  begin
    OldPage:=GetPageVESA;
    Page:=VideoMemSize div $10000;
    Last:=VideoMemSize mod $10000;
    GetMem(P,$8000);
    for i:=0 to Page-1 do
    begin
      SelectPageVESA(i);
      BlockRead(Fp,P^,$8000,Result);
      Move(P^,Ptr($A000,0)^,$8000);
      BlockRead(Fp,P^,$8000,Result);
      Move(P^,Ptr($A000,$8000)^,$8000);
    end;
    FreeMem(P,$8000);
    if Last>0 then
    begin
      GetMem(P,Last);
      SelectPageVESA(Page);
      BlockRead(Fp,P^,Last,Result);
      Move(P^,Ptr($A000,0)^,Last);
      FreeMem(P,Last);
    end;
    SelectPageVESA(OldPage);
  end;

var
  i:Integer;
begin
  Assign(Fp,Name);
  {$i-}Reset(Fp,1);{$i+}
  if IoResult<>0 then Exit;
  BlockRead(Fp,Head,Sizeof(CutFileHeader),Result);
  if (Head.VickySign[0]<>Byte('V')) or
     (Head.VickySign[1]<>Byte('i')) or
     (Head.VickySign[2]<>Byte('c')) or
     (Head.VickySign[3]<>Byte('k')) or
     (Head.VickySign[4]<>Byte('y')) or
     (Head.Vision<>$0001) then
  begin
    {$i-}Close(Fp);{$i+}
    Exit;
  end;
  VideoMode:=GetVideoMode;
  if VideoMode<>Head.VideoMode then
  SetVideoMode(Head.VideoMode);
  SetPalRegs(Head.Pal);
  SetDacRegs(Head.Dac);
  for i:=0 to $18 do
  begin
    Port[$3D4]:=i;
    Port[$3D5]:=Head.Reserved[i];
  end;
  case Head.VideoMode of
  $0D:begin VideoMemSize:=40*200;Paint12h;end;
  $0E:begin VideoMemSize:=80*200;Paint12h;end;
  $10:begin VideoMemSize:=80*350;Paint12h;end;
  $12:begin VideoMemSize:=80*480;Paint12h;end;
  $13:Paint13h;
  $100:begin VideoMemSize:=640*400;PaintVESA101h;end;
  $101:begin VideoMemSize:=640*480;PaintVESA101h;end;
  $103:begin VideoMemSize:=800*600;PaintVESA101h;end;
  $105:begin VideoMemSize:=1024*768;PaintVESA101h;end;
  end;
  {$i-}Close(Fp);{$i+}
end;

Procedure GetCutGra(Name:PathStr);
var
  Fp:file;
  Result:Word;
  VideoMode:Word;
  VideoMemSize:Longint;
  OldPage:Integer;

  Procedure Cut12h;
  var i:Integer;
  begin
    for i:=0 to 3 do
    begin
      Port[$3CE]:=$04;
      Port[$3CF]:=i;
      BlockWrite(Fp,Ptr($A000,0)^,VideoMemSize,Result);
    end;
  end;
  Procedure Cut13h;
  begin
    BlockWrite(Fp,Ptr($A000,0)^,$8000,Result);
    BlockWrite(Fp,Ptr($A000,$8000)^,$8000,Result);
  end;
  Procedure CutVESA101h;
  var
    i:Integer;
    Page:Integer;
    Last:Word;
  begin
    GetPageVESA;
    Page:=VideoMemSize div $10000;
    Last:=VideoMemSize mod $10000;
    for i:=0 to Page do
    begin
      SelectPageVESA(i);
      if i<Page then
      begin
        BlockWrite(Fp,Ptr($A000,0)^,$8000,Result);
        BlockWrite(Fp,Ptr($A000,$8000)^,$8000,Result);
      end else if Last>0 then
        BlockWrite(Fp,Ptr($A000,0)^,Last,Result);
    end;
    SelectPageVESA(OldPage);
  end;

var
  i:Integer;
begin
  VideoMode:=GetVideoMode;
  if (VideoMode<>$0D)and(VideoMode<>$0E)and
     (VideoMode<>$10)and(VideoMode<>$12)and
     (VideoMode<>$13)and(VideoMode<>$100)and
     (VideoMode<>$101)and(VideoMode<>$103)and
     (VideoMode<>$105) then Exit;
  Assign(Fp,Name);
  {$i-}ReWrite(Fp,1);{$i+}
  if IoResult<>0 then Exit;
  Head.VickySign[0]:=Byte('V');
  Head.VickySign[1]:=Byte('i');
  Head.VickySign[2]:=Byte('c');
  Head.VickySign[3]:=Byte('k');
  Head.VickySign[4]:=Byte('y');
  Head.Vision:=$0001;
  Head.VideoMode:=GetVideoMode;
  GetPalRegs(Head.Pal);
  GetDacRegs(Head.Dac);
  FillChar(Head.Reserved,100,0);
  for i:=0 to $18 do
  begin
    Port[$3D4]:=i;
    Head.Reserved[i]:=Port[$3D5];
  end;
  BlockWrite(Fp,Head,Sizeof(CutFileHeader),Result);
  case VideoMode of
  $0D:begin VideoMemSize:=40*200;Cut12h;end;
  $0E:begin VideoMemSize:=80*200;Cut12h;end;
  $10:begin VideoMemSize:=80*350;Cut12h;end;
  $12:begin VideoMemSize:=80*480;Cut12h;end;
  $13:Cut13h;
  $100:begin VideoMemSize:=640*400;CutVESA101h;end;
  $101:begin VideoMemSize:=640*480;CutVESA101h;end;
  $103:begin VideoMemSize:=800*600;CutVESA101h;end;
  $105:begin VideoMemSize:=1024*768;CutVESA101h;end;
 end;
 {$i-}Close(Fp);{$i+}
end;

end.