Liren Large Software Subsidy 9/09.iso/l/l045/2.ddi/GWINDOW.PAS

Pascal/Delphi Source File | 1987-12-23 | 16.6 KB | 590 lines

(********************************************************************)
(*                         GRAPHIX TOOLBOX 4.0                      *)
(*       Copyright (c) 1985, 87 by  Borland International, Inc.     *)
(********************************************************************)
unit GWindow;

interface

{$I Float.inc}  { Determines what type Float means. }

uses
  Dos, Crt, GDriver, GKernel;

procedure MoveVer(Delta : integer; FillOut : boolean);

procedure MoveHor(Delta : integer; FillOut : boolean);

procedure CopyWindow(From, Tu : byte; X1, Y1 : integer);

procedure SaveWindow(N : integer; FileName : WrkString);

procedure LoadWindow(N, Xpos, Ypos : integer; FileName : WrkString);

function WindowSize(Win : integer) : word;

procedure ClearWindowStack(Win : integer);

procedure StoreWindow(Win : integer);

procedure RestoreWindow(Win, DeltaX, DeltaY : integer);

procedure SaveWindowStack(FileName : WrkString);

procedure LoadWindowStack(FileName : WrkString);

procedure ResetWindowStack;

procedure InvertWindow;

implementation

procedure MoveVer{(Delta : integer; FillOut : boolean)};
var
  Direction, Outer, XLen : integer;
  FromBase, From, Tu : word;

procedure MoveVer1(VStep : integer);
var
  I : integer;
begin
  XLen := X2RefGlb - X1RefGlb + 1;
  if Direction = -1 then
    for I := Y1RefGlb to Y2RefGlb do
    begin
      if I > 0 then
      begin
        From := BaseAddress(I);
        Tu := BaseAddress(I - VStep);
        Move(Mem[GrafBase:From + X1RefGlb], Mem[GrafBase:Tu + X1RefGlb], XLen);
      end;
    end
  else
    for I := Y2RefGlb downto Y1RefGlb do
      if I < YMaxGlb then
        begin
          From := BaseAddress(I);
          Tu := BaseAddress(I + VStep);
          Move(Mem[GrafBase:From + X1RefGlb], Mem[GrafBase:Tu + X1RefGlb], XLen);
        end;
  if not RamScreenGlb then
    FillOut := false;
  if not FillOut then
    if Direction = -1 then
      for I := Y2RefGlb downto Y2RefGlb - VStep + 1 do
        FillChar(Mem[GrafBase:BaseAddress(I) + X1RefGlb], XLen, not ColorGlb)
    else
      for I := Y1RefGlb to Y1RefGlb + VStep - 1 do
         FillChar(Mem[GrafBase:BaseAddress(I) + X1RefGlb], XLen, not ColorGlb)
  else
    begin
      if GrafBase = HardwareGrafBase then
        FromBase := Seg(ScreenGlb^)
      else
        FromBase:=HardwareGrafBase;
      if Direction = -1 then
        for I := Y2RefGlb downto Y2RefGlb - VStep + 1 do
          Move(Mem[FromBase:BaseAddress(I) + X1RefGlb],
               Mem[GrafBase:BaseAddress(I) + X1RefGlb], XLen)
      else
        for I := Y1RefGlb to Y1RefGlb + VStep - 1 do
          Move(Mem[FromBase:BaseAddress(I) + X1RefGlb],
               Mem[GrafBase:BaseAddress(I) + X1RefGlb], XLen);
    end;
  ReDefineWindow(WindowNdxGlb, X1RefGlb, Y1RefGlb + VStep * Direction,
                 X2RefGlb, Y2RefGlb + VStep * Direction);
  SelectWindow(WindowNdxGlb);
end; { MoveVer1 }

begin { MoveVer }
  if Delta <> 0 then
  begin
    Direction := 1;
    if Delta < 0 then
      Direction := -1;
    with GrafWindow[WindowNdxGlb] do
    if Drawn then
      if Top then
        Y1RefGlb := Y1RefGlb - HeaderSizeGlb
      else
        Y2RefGlb := Y2RefGlb + HeaderSizeGlb;
    if (Y1RefGlb + Delta < 0) or (Y2RefGlb + Delta > YMaxGlb) then
      Error(23, 7)
    else
      begin
        for Outer := 1 to abs(Delta) div VStepGlb do
          MoveVer1(VStepGlb);
        if abs(Delta) mod VStepGlb <> 0 then
          MoveVer1(abs(Delta) mod VStepGlb);
      end;
    with GrafWindow[WindowNdxGlb] do
      if Drawn then
        if Top then
          Y1RefGlb := Y1RefGlb + HeaderSizeGlb
        else
          Y2RefGlb := Y2RefGlb - HeaderSizeGlb;
  end;
end; { MoveVer }

procedure MoveHor{(Delta : integer; FillOut : boolean)};
var
  Direction, Outer, XLen : integer;
  I : integer;
  FromBase, Y : word;
begin
  if Delta <> 0 then
  begin
    Direction := 1;
    if Delta < 0 then
      Direction := -1;
    with GrafWindow[WindowNdxGlb] do
    if Drawn then
      if Top then
        Y1RefGlb := Y1RefGlb - HeaderSizeGlb
      else
        Y2RefGlb := Y2RefGlb + HeaderSizeGlb;
    if (X1RefGlb+Delta < 0) or (X2RefGlb+Delta > XMaxGlb) then
      Error(24, 7)
    else
      begin
        for Outer := 1 to abs(Delta) do
        begin
          XLen := X2RefGlb - X1RefGlb + 1;
          for I := Y1RefGlb to Y2RefGlb do
          begin
            Y := BaseAddress(I);
            Move(Mem[GrafBase:Y + X1RefGlb],
                 Mem[GrafBase:Y + X1RefGlb + Direction], XLen);
            if not RamScreenGlb then
              FillOut := false;
            if not FillOut then
              if Direction < 0 then
                Mem[GrafBase:Y + X2RefGlb] := (not ColorGlb) and $FF
              else
                { prevents range check errors }
                Mem[GrafBase:Y + X1RefGlb] := (not ColorGlb) and $FF
              else
                begin
                  if GrafBase = HardwareGrafBase then
                    FromBase := Seg(ScreenGlb^)
                  else
                    FromBase := HardwareGrafBase;
                  if Direction = -1 then
                    Mem[GrafBase:Y + X2RefGlb] := Mem[FromBase:Y + X2RefGlb]
                  else
                    Mem[GrafBase:Y + X1RefGlb] := Mem[FromBase:Y + X1RefGlb];
                end;
          end;
          ReDefineWindow(WindowNdxGlb, X1RefGlb + Direction, Y1RefGlb,
                         X2RefGlb + Direction, Y2RefGlb);
          SelectWindow(WindowNdxGlb);
        end;
      end;
      with GrafWindow[WindowNdxGlb] do
      if Drawn then
        if Top then
          Y1RefGlb := Y1RefGlb + HeaderSizeGlb
        else
          Y2RefGlb := Y2RefGlb - HeaderSizeGlb;
  end;
end; { MoveHor }

procedure CopyWindow{(From, Tu : byte; X1, Y1 : integer)};
var
  XLen, YLen : integer;
  FromBase, ToBase, I : word;

begin
  if (X1 < 0) or (Y1 < 0) then
    Error(17, 3)
  else
    begin
      with GrafWindow[WindowNdxGlb] do
        if Drawn then
          if Top then
            Y1RefGlb := Y1RefGlb - HeaderSizeGlb
          else
            Y2RefGlb := Y2RefGlb + HeaderSizeGlb;
      if From = 2 then
        FromBase := Seg(ScreenGlb^)
      else
        FromBase := HardwareGrafBase;
      if Tu = 2 then
        ToBase := Seg(ScreenGlb^)
      else
        ToBase := HardwareGrafBase;
      XLen := X2RefGlb - X1RefGlb;
      YLen := Y2RefGlb - Y1RefGlb;
      if X1 + XLen > XMaxGlb then
        XLen := XMaxGlb - X1;
      if Y1 + YLen > YMaxGlb then
        YLen := YMaxGlb - Y1;
      XLen := XLen + 1;
      for I := 0 to YLen do
        Move(Mem[FromBase:BaseAddress(Y1RefGlb + I) + X1RefGlb],
             Mem[ToBase:BaseAddress(Y1 + I) + X1], XLen);
      with GrafWindow[WindowNdxGlb] do
        if Drawn then
          if Top then
            Y1RefGlb := Y1RefGlb + HeaderSizeGlb
          else
            Y2RefGlb := Y2RefGlb - HeaderSizeGlb;
    end;
end; { CopyWindow }

procedure SaveWindow{(N : integer; FileName : WrkString)};
type
  Sector = array[0..127] of byte;
var
  I, J, SecPtr, Xlen : integer;
  W : WindowType;
  PictureFile : file of Sector;
  Sec1 : array[0..1] of Sector;

begin
  if not (N in [1..MaxWindowGlb]) then
    Error(25, 2)
  else if (FileName = '') then
    Error(25, 5)
  else
    begin
      W := GrafWindow[N];
      Assign(PictureFile, FileName);
      {$I-} Rewrite(PictureFile); {$I+}
      if IOresult <> 0 then
        Error(25, 5)
      else
        begin
          Move(W, Sec1, SizeOf(W));
          SecPtr := SizeOf(W);
          with W do
          begin
            if Drawn then
              if Top then
                Y1 := Y1 - HeaderSizeGlb
              else
                Y2 := Y2 + HeaderSizeGlb;
            Xlen := X2 - X1 + 1;
            for I := Y1 to Y2 do
            begin
              Move(Mem[GrafBase:BaseAddress(I) + X1], Sec1[0, SecPtr], Xlen);
              SecPtr := SecPtr + Xlen;
              if SecPtr > 127 then
              begin
                Write(PictureFile, Sec1[0]);
                Move(Sec1[1], Sec1[0], 128);
                SecPtr := SecPtr - 128;
              end;
            end;
            if SecPtr <> 0 then
              Write(PictureFile, Sec1[0]);
          end;
          Close(PictureFile);
        end;
    end;
end; { SaveWindow }

procedure LoadWindow{(N, Xpos, Ypos : integer; FileName : WrkString)};
type
  Sector = array[0..127] of byte;
var
  I, SecPtr, Xlen : integer;
  W : WindowType;
  PictureFile : file of Sector;
  Sec1 : array[0..1] of Sector;
  Second : boolean;

begin
  Assign(PictureFile, FileName);
  {$I-} Reset(PictureFile); {$I+}
  if (IOresult <> 0) or (FileName = '') then
    Error(12, 5)
  else
    begin
      Read(PictureFile, Sec1[0]);
      Move(Sec1, W, SizeOf(W));
      SecPtr := SizeOf(W);
      Second := false;
      GrafWindow[N] := W;
      with W do
      begin
        if Drawn then
          if Top then
            Y1 := Y1 - HeaderSizeGlb
          else
            Y2 := Y2 + HeaderSizeGlb;
        Xlen := X2 - X1 + 1;
        if Xpos >= 0 then
        begin
          X2 := Xpos + X2 - X1;
          X1 := Xpos;
        end;
        if Ypos >= 0 then
        begin
          Y2 := Ypos + Y2 - Y1;
          Y1 := Ypos;
        end;
        if (X1 < 0) or (Y1 < 0) or (X2 > XMaxGlb) or (Y2 > YMaxGlb) then
          Error(12, 3)
        else
          begin
            for I := Y1 to Y2 do
            begin
              if (SecPtr + Xlen > 127) and
                  not Second and not EOF(PictureFile) then
              begin
                Read(PictureFile, Sec1[1]);
                Second := true;
              end;
              Move(Sec1[0, SecPtr], Mem[GrafBase:BaseAddress(I) + X1], Xlen);
              SecPtr := SecPtr + Xlen;
              if SecPtr > 127 then
              begin
                Move(Sec1[1], Sec1[0], 128);
                SecPtr := SecPtr - 128;
                Second := false;
              end;
            end;
          end;
      end;
      Close(PictureFile);
    end;
end; { LoadWindow }

function WindowSize{(Win : integer) : word};
var
  Ws : integer;
begin
  Ws := 0;
  if not (Win in [1..MaxWindowsGlb]) then
    Error(13, 2)
  else
    with GrafWindow[Win] do
    begin
      Ws := (Y2 - Y1 + 1) * (X2 - X1 + 1);
      if Drawn then
        Ws := Ws + HeaderSizeGlb * (X2 - X1 + 1);
    end;
  WindowSize := Ws;
end; { WindowSize }

procedure ClearWindowStack{(Win : integer)};
begin
  if not (Win in [1..MaxWindowsGlb]) then
    Error(14, 2)
  else
    with Stack[Win], W do
    begin
      if (Contents <> nil) then
        FreeMem(Contents, Size);
      Contents := nil;
      Size := 0;
    end;
end; { ClearWindowStack }

procedure StoreWindow{(Win : integer)};
var
  XLen, Y0, Y9, A : integer;
  I, Y : word;

begin
  if not (Win in [1..MaxWindowsGlb]) then
    Error(15, 2)
  else
    begin
      if Stack[Win].Contents <> nil then
        ClearWindowStack(Win);
      if WindowSize(Win) > MaxAvail then
        Error(15, 6)
      else
        with Stack[Win], W do
        begin
          W := GrafWindow[Win];
          Size := WindowSize(Win);
          GetMem(Contents, Size);
          with W do
          begin
            Y0 := Y1;
            Y9 := Y2;
            if Drawn then
              if Top then
                Y0 := Y0 - HeaderSizeGlb
              else
                Y9 := Y9 + HeaderSizeGlb;
            XLen := X2 - X1 + 1;
            A := 0;
            for I := Y0 to Y9 do
            begin
              Y := BaseAddress(I);
              Move(Mem[GrafBase:Y + X1],
                   Mem[Seg(Contents^):Ofs(Contents^) + A], XLen);
              A := A + XLen;
            end;
          end;
        end;
    end;
end; { StoreWindow }

procedure RestoreWindow{(Win, DeltaX, DeltaY : integer)};
var
  I, XLen, Y, Y0, Y9, A : integer;
  W1 : WindowType;
begin
  if not (abs(Win) in [1..MaxWindowsGlb]) then
    Error(16, 2)
  else
    with Stack[abs(Win)] do
    begin
      W1 := W;
      if Contents = nil then
        Error(16, 2)
      else
        with W1 do
        begin
          X1 := X1 + DeltaX;
          X2 := X2 + DeltaX;
          Y1 := Y1 + DeltaY;
          Y2 := Y2 + DeltaY;
          if (X1 >= 0) and (X1 <= XMaxGlb) and (X2 >= 0) and (X2 <= XMaxGlb) and
             (Y1 >= 0) and (Y1 <= YMaxGlb) and (Y2 >= 0) and (Y2 <= YMaxGlb) then
            begin
              XLen := X2 - X1 + 1;
              A := 0;
              Y0 := Y1;
              Y9 := Y2;
              if Drawn then
                if Top then
                  Y0 := Y0 - HeaderSizeGlb
                else
                  Y9 := Y9 + HeaderSizeGlb;
              for I := Y0 to Y9 do
              begin
                Y := BaseAddress(I);
                with Stack[Abs(Win)] do
                  Move(Mem[Seg(Contents^):Ofs(Contents^) + A],
                       Mem[GrafBase:Y + X1], XLen);
                A := A + XLen;
              end;
              GrafWindow[Abs(Win)] := W1;
              if Win < 0 then
                ClearWindowStack(abs(Win));
              if Win = WindowNdxGlb then
                SelectWindow(Win);
            end
          else
            Error(16, 3);
        end;
    end;
end; { RestoreWindow }

procedure SaveWindowStack{(FileName : WrkString)};
var
  WindowFile : file;
  PointerFile : file of WindowType;
  I, NumWritten : word;
begin
  Assign(WindowFile, FileName + '.stk');
  {$I-} Rewrite(WindowFile); {$I+}
  if IOresult <> 0 then
    Error(26, 5)
  else
    begin
      for I := 1 to MaxWindowsGlb do
      with Stack[I], W do
        if Contents <> nil then
          BlockWrite(WindowFile, Contents^, Size shr 7, NumWritten);
      Close(WindowFile);
      Assign(PointerFile, FileName + '.Ptr');
      {$I-} Rewrite(PointerFile); {$I+}
      if IOresult <> 0 then
        Error(26, 5)
      else
        begin
          for I := 1 to MaxWindowsGlb do
            Write(PointerFile, Stack[I].W);
          Close(PointerFile);
        end;
    end;
end; { SaveWindowStack }

procedure LoadWindowStack{(FileName : WrkString)};
var
  WindowFile : file;
  PointerFile : file of WindowType;
  I, NumRead : word;

begin
  Assign(PointerFile, FileName + '.Ptr');
  {$I-} Reset(PointerFile); {$I+}
  if IOresult = 0 then
    begin
      for I := 1 to MaxWindowsGlb do
        Read(PointerFile, Stack[I].W);
      Close(PointerFile);
      Assign(WindowFile, FileName + '.stk');
      {$I-} Reset(WindowFile); {$I+}
      if IOresult = 0 then
        begin
          for I := 1 to MaxWindowsGlb do
          with Stack[I], W do
            if Size <> 0 then
              begin
                GetMem(Contents, Size);
                BlockRead(WindowFile, Contents^, Size shr 7, NumRead);
              end
            else
              Contents := nil;
          Close(WindowFile);
        end
      else
        Error(21, 5);
    end
  else
    Error(21, 5);
end; { LoadWindowStack }

procedure ResetWindowStack;
var
  I : word;
begin
  for I := 1 to MaxWindowsGlb do
    ClearWindowStack(I);
end; { ResetWindowStack }

procedure InvertWindow;
var
  I, B : word;
begin
  with GrafWindow[WindowNdxGlb] do
    if Drawn then
      if Top then
        Y1RefGlb := Y1RefGlb - HeaderSizeGlb
      else
        Y2RefGlb := Y2RefGlb + HeaderSizeGlb;
   for I := Y1RefGlb to Y2RefGlb do
   begin
     B := BaseAddress(I);
     inline($8B/$86/B/        {          MOV   AX,[B]         }
            $8B/$1E/X1RefGlb/ {          MOV   BX,[X1RefGlb]  }
            $8B/$0E/X2RefGlb/ {          MOV   CX,[X2RefGlb]  }
            $8B/$16/GrafBase/ {          MOV   DX,[GrafBase]  }
            $1E/              {          PUSH  DS             }
            $8E/$DA/          {          MOV   DS,DX          }
            $29/$D9/          {          SUB   CX,BX          }
            $41/              {          INC   CX             }
            $01/$C3/          {          ADD   BX,AX          }
            $F6/$17/          { InvByte: NOT   BYTE PTR [BX]  }
            $43/              {          INC   BX             }
            $E2/$FB/          {          LOOP  InvByte        }
            $1F);             {          POP   DS             }
   end;
   with GrafWindow[WindowNdxGlb] do
     if Drawn then
       if Top then
         Y1RefGlb := Y1RefGlb + HeaderSizeGlb
       else
         Y2RefGlb := Y2RefGlb - HeaderSizeGlb;
end; { InvertWindow }

end. { GWindow }