Liren Large Software Subsidy 9/09.iso/l/l048/1.ddi/WINDOWS.SYS

Text File | 1986-03-20 | 15.3 KB | 541 lines

(***********************************************************)
(*                                                         *)
(*                TURBO GRAPHIX version 1.06A              *)
(*                                                         *)
(*                   Windowing system for                  *)
(*                IBM Color/Graphics Adapter               *)
(*                and Hercules Graphics Card               *)
(*                  Module version  1.06A                  *)
(*                                                         *)
(*                  Copyright (C) 1985 by                  *)
(*                  BORLAND International                  *)
(*                                                         *)
(***********************************************************)

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

procedure MoveVer1(VStep : 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 Window[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 Window[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, FromBase, I, XLen, Y : integer;
begin
  if Delta <> 0 then
  begin
    Direction := 1;
    if Delta < 0 then
      Direction := -1;
    with Window[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 Window[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 : integer;

begin
  if (X1 < 0) or (Y1 < 0) then
    Error(17, 3)
  else
    begin
      with Window[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 Window[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
  W := Window[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; { 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 then
    Error(12, 5)
  else
    begin
      Read(PictureFile, Sec1[0]);
      Move(Sec1, W, SizeOf(W));
      SecPtr := SizeOf(W);
      Second := false;
      Window[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) : integer;
var
  Ws : integer;
begin
  Ws := -1;
  if not (Win in [1..MaxWindowsGlb]) then
    Error(13, 2)
  else
    with Window[Win] do
    begin
      Ws := (Y2 - Y1 + 1) * (X2 - X1 + 1);
      if Drawn then
        Ws := Ws + HeaderSizeGlb * (X2 - X1 + 1);
      Ws := (Ws + $03FF) and $FC00;
    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
  I, XLen, Y, Y0, Y9, A : integer;
  M : real;

begin
  if not (Win in [1..MaxWindowsGlb]) then
    Error(15, 2)
  else
    begin
      if Stack[Win].Contents <> nil then
        ClearWindowStack(Win);
      M := MaxAvail;
      if M < 0 then
        M := M + 65536.0;
      if WindowSize(Win) > 16.0 * M then
        Error(15, 6)
      else
        with Stack[Win], W do
        begin
          W := Window[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 (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[Win] do
                  Move(Mem[Seg(Contents^):Ofs(Contents^) + A],
                       Mem[GrafBase:Y + X1], XLen);
                A := A + XLen;
              end;
              Window[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 : integer;
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);
      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, Ws : integer;
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);
              end
            else
              Contents := nil;
          Close(WindowFile);
        end
      else
        Error(21, 5);
    end
  else
    Error(21, 5);
end; { LoadWindowStack }

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

procedure InvertWindow;
var
  I, J, B : integer;
begin
  with Window[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/$8B/$1E/X1RefGlb/$8B/$0E/X2RefGlb/$8B/$16/GrafBase/
            $1E/$8E/$DA/$29/$D9/$41/$01/$C3/$F6/$17/$43/$E2/$FB/$1F);
   end;
   with Window[WindowNdxGlb] do
     if Drawn then
       if Top then
         Y1RefGlb := Y1RefGlb + HeaderSizeGlb
       else
         Y2RefGlb := Y2RefGlb - HeaderSizeGlb;
end; { InvertWindow }