{ Unit GvViews: gvisrect.pas include
  Graphics Vision Visibility Detection & Drawing Support,
  Rectangle-list implementation.
  Copyright 1994,1997 Matthias K”ppe.
}

{$ifdef gvisible_v1}
{$i gvisshap.pas}
{$else}

{ Rect-list handling, adapted from GvViews ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
}

function NextAvailable(var List: PVRect): PRect;
var
  P: PVRect;
Begin
  If (List = nil) or (List^.Count >= maxRect) then Begin
    New(P);
    with P^ do Begin
      Count := 0;
      Next := List
    End;
    List := P
  End;
  with List^ do
    NextAvailable := @R[Count]
End;

procedure InsNewRect(var List: PVRect; var Rect: TRect);
Begin
  NextAvailable(List)^ := Rect;
  Inc(List^.Count)
End;

procedure DoSubtractRect(var List: PVRect; Rect: PRect;
  R1: TRect);
var
  NewR, R2: TRect;
  atNewR: PRect;
  IsNewRect: Boolean;
Begin
  R2 := Rect^;
  If (R1.B.X <= R2.A.X) or (R1.B.Y <= R2.A.Y) or
     (R1.A.X >= R2.B.X) or (R1.A.Y >= R2.B.Y) or (R2.A.X = R2.B.X) or
     (R2.A.Y = R2.B.Y) then Exit;

  Rect^.Assign(0, 0, 0, 0);
  IsNewRect := false;
  atNewR := @NewR;

  If R1.A.X > R2.A.X then Begin

{$ifdef FPK}
    NewR.Assign(R2.A.X, Max(R1.A.Y, R2.A.Y),
      R1.A.X, Min(R1.B.Y, R2.B.Y));
{$else}
    asm
	les	di, atNewR
	cld

	mov	ax, R2.A.X
	stosw

	mov	ax, R1.A.Y
	mov	dx, R2.A.Y
	cmp	ax, dx
	jg	@@1
	mov	ax, dx
@@1:	stosw

	mov	ax, R1.A.X
	stosw

	mov	ax, R1.B.Y
	mov	dx, R2.B.Y
	cmp	ax, dx
	jl	@@2
	mov	ax, dx
@@2:	stosw
    end;
{$endif}
    Rect^ := NewR;
    Rect := NextAvailable(List);
    IsNewRect := true;
  End;
  If R1.A.Y > R2.A.Y then Begin
{$ifdef FPK}
    NewR.Assign(R2.A.X, R2.A.Y, R2.B.X, R1.A.Y);
{$else}
    asm
	les	di, atNewR
	cld

	mov	ax, R2.A.X
	stosw
	mov	ax, R2.A.Y
	stosw
	mov	ax, R2.B.X
	stosw
	mov	ax, R1.A.Y
	stosw
    end;
{$endif}
    Rect^ := NewR;
    If IsNewRect then Inc(List^.Count);
    Rect := NextAvailable(List);
    IsNewRect := true
  End;
  If R1.B.X < R2.B.X then Begin
{$ifdef FPK}
    NewR.Assign(R1.B.X, Max(R1.A.Y, R2.A.Y),
      R2.B.X, Min(R1.B.Y, R2.B.Y));
{$else}
    asm
	les	di, atNewR
	cld

	mov	ax, R1.B.X
	stosw

	mov	ax, R1.A.Y
	mov	dx, R2.A.Y
	cmp	ax, dx
	jg	@@3
	mov	ax, dx
@@3:	stosw

	mov	ax, R2.B.X
	stosw

	mov	ax, R1.B.Y
	mov	dx, R2.B.Y
	cmp	ax, dx
	jl	@@4
	mov	ax, dx
@@4:	stosw
    end;
{$endif}
    Rect^ := NewR;
    If IsNewRect then Inc(List^.Count);
    Rect := NextAvailable(List);
    IsNewRect := true
  End;
  If R1.B.Y < R2.B.Y then Begin
{$ifdef FPK}
    NewR.Assign(R2.A.X, R1.B.Y, R2.B.X, R2.B.Y);
{$else}
    asm
	les	di, atNewR
	cld

	mov	ax, R2.A.X
	stosw
	mov	ax, R1.B.Y
	stosw
	mov	ax, R2.B.X
	stosw
	mov	ax, R2.B.Y
	stosw
    end;
{$endif}
    Rect^ := NewR;
    If IsNewRect then Inc(List^.Count)
  End;
End;

procedure SubtractRect(var List: PVRect; var Rect: TRect);
var
  P: PVRect;
  i: Integer;
Begin
  P := List;
  while P <> nil do Begin
    For i := 0 to P^.Count - 1 do
      DoSubtractRect(List, @P^.R[i], Rect);
    P := P^.Next
  End
End;

{ A ForEachRect implementation *MUST* not call the action proc with an
  empty rectangle.
  The action proc must be near-encoded.
}
{$ifdef FPK}
procedure ForEachRect(List: PVRect; Action: pointer);
var
  i: Integer;
begin
  while List <> nil do
  begin
    For i := 0 to List^.Count-1 do
      if not List^.R[i].Empty
      then CallPointerLocal(Action, PreviousFramePointer,
	     @List^.R[i]);
    List := List^.Next
  end;
end;
{$else}
procedure ForEachRect(List: PVRect; Action: pointer); near; external;

{$L gvisible.obj   (gvisible.asm) }
{$endif}

procedure ClipList(List: PVRect; var Clip: TRect); {$ifndef FPK}near;{$endif}

 procedure Intersect(var Rect: TRect);
 Begin
   Rect.Intersect(Clip)
 End;

Begin
  ForEachRect(List, @Intersect)
End;

function IntersectLists(List1, List2: PVRect): PVRect;
var
  List: PVRect;

 procedure IntersectList1(var Rect1: TRect); {$ifndef FPK}near;{$endif}

  procedure IntersectList2(var Rect2: TRect); {$ifndef FPK}near;{$endif}
  var
    R: TRect;
  Begin
    R := Rect1;
    R.Intersect(Rect2);
    If not R.Empty then InsNewRect(List, R)
  End;

 Begin
   ForEachRect(List2, @IntersectList2)
 End;

Begin
  List := nil;
  ForEachRect(List1, @IntersectList1);
  IntersectLists := List
End;

function IntersectListDelta(List: PVRect; Delta: TPoint): PVRect;
var
  IList: PVRect;

 procedure DoIntersectDelta(var Rect: TRect); {$ifndef FPK}near;{$endif}
 var
   R: TRect;
 Begin
   R := Rect;
   R.Move(Delta.x, Delta.y);
   R.Intersect(Rect);
   If not R.Empty then InsNewRect(IList, R)
 End;

Begin
  IList := nil;
  ForEachRect(List, @DoIntersectDelta);
  IntersectListDelta := IList
End;

procedure MoveList(List: PVRect; Delta: TPoint);

 procedure DoMove(var Rect: TRect); {$ifndef FPK}near;{$endif}
 Begin
   Rect.Move(Delta.X, Delta.Y)
 End;

Begin
  ForEachRect(List, @DoMove)
End;

{$endif}

procedure FreeRectList(List: PVRect);
var
  Next: PVRect;
Begin
  while List <> nil do Begin
    Next := List^.Next;
    Dispose(List);
    List := Next
  End
End;

{ Operations using ForEachRect ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
}

{ UniteList stores the bounding rectangle into Bounds, and returns the
  rectangle count.
}
function UniteList(List: PVRect; var Bounds: TRect): Integer;
var
  Cnt: Integer;

	procedure DoUnite(var Rect: TRect); {$ifndef FPK}near;{$endif}
	begin
	  Inc(Cnt);
	  If Bounds.Empty
	  then Bounds := Rect
	  else Bounds.Union(Rect)
	end;

Begin
  Bounds.Assign(0, 0, 0, 0);
  Cnt := 0;
  ForEachRect(List, @DoUnite);
  UniteList := Cnt
End;

function EmptyVis(Vis: PVis): Boolean;
var
  R: TRect;
begin
  if Vis = nil
  then EmptyVis := true
  else EmptyVis := (UniteList(PRectVis(Vis)^.List, R) = 0) or R.Empty;
end;

procedure SubtractList(var List: PVRect; Sub: PVRect);

 procedure Subtract(var Rect: TRect); {$ifndef FPK}near;{$endif}
 Begin
   SubtractRect(List, Rect)
 End;

Begin
  ForEachRect(Sub, @Subtract)
End;

{ Visibility detection by rectangle-oriented operations ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

  These routines use the abstract operations defined precedingly, such that
  they need not be modified if there is a more efficient rectangle-oriented
  data structure available.
}

function NewVis(var Bounds: TRect): PVis;
var
  Vis: PRectVis;
Begin
  New(Vis);
  with Vis^ do Begin
    TheBounds := Bounds;
    List := nil;
    Trans := nil;
    CurTrans := 0;
    DrawMode := 0;
    InsNewRect(List, Bounds)
  End;
  NewVis := PVis(Vis)
End;

procedure SubtractRegion(Vis: PVis; var Bounds: TRect);
Begin
  If (Vis <> nil) and DoesIntersect(PRectVis(Vis)^.TheBounds, Bounds)
  then SubtractRect(PRectVis(Vis)^.List, Bounds)
End;

procedure ClipVis(Vis: PVis; var Clip: TRect);
Begin
  If Vis <> nil then
  {with PRectVis(Vis)^ do}
  begin
    PRectVis(Vis)^.TheBounds.Intersect(Clip);
    ClipList(PRectVis(Vis)^.List, Clip)
  end
End;

function IntersectVis(Vis1, Vis2: PVis): PVis;
var
  Vis: PRectVis;
Begin
  IntersectVis := nil;
  If (Vis1 = nil) or (Vis2 = nil) then Exit;
  If not DoesIntersect(PRectVis(Vis1)^.TheBounds, PRectVis(Vis2)^.TheBounds)
  then Exit;
  New(Vis);
  with Vis^ do Begin
    TheBounds := PRectVis(Vis1)^.TheBounds;
    TheBounds.Intersect(PRectVis(Vis2)^.TheBounds);
    List := IntersectLists(PRectVis(Vis1)^.List, PRectVis(Vis2)^.List);
    Trans := JoinViewCollections(PRectVis(Vis1)^.Trans, PRectVis(Vis2)^.Trans);
    CurTrans := 0;
    DrawMode := 0
  End;
  IntersectVis := PVis(Vis)
End;

function IntersectDelta(Vis: PVis; Delta: TPoint): PVis;
var
  aVis: PRectVis;
Begin
  IntersectDelta := nil;
  If Vis = nil then Exit;
  New(aVis);
  with aVis^ do Begin
    TheBounds := PRectVis(Vis)^.TheBounds;
    List := IntersectListDelta(PRectVis(Vis)^.List, Delta);
    Trans := CopyViewCollection(PRectVis(Vis)^.Trans);
    CurTrans := PRectVis(Vis)^.CurTrans;
    DrawMode := 0
  End;
  IntersectDelta := PVis(aVis)
End;

procedure SubtractVis(Vis, SubVis: PVis);
Begin
  If (Vis = nil) or (SubVis = nil) then Exit;
  SubtractList(PRectVis(Vis)^.List, PRectVis(SubVis)^.List)
End;

procedure MoveVis(Vis: PVis; Delta: TPoint);
Begin
  If Vis = nil then Exit;
  with PRectVis(Vis)^ do Begin
    PRectVis(Vis)^.TheBounds.Move(Delta.x, Delta.y);
    MoveList(List, Delta)
  End
End;

function RawCopyVis(Vis: PVis): PVis;
var
  Copy: PRectVis;
  Cur: PPVRect;
  Src: PVRect;
begin
  RawCopyVis := nil;
  If Vis = nil then Exit;
  New(Copy);
  Copy^ := PRectVis(Vis)^;
  Copy^.Trans := nil;
  Copy^.CurTrans := -1; {indicate raw}
  Cur := @Copy^.List;
  while Cur^ <> nil do
  begin
    Src := Cur^;
    New(Cur^);
    Cur^^ := Src^;
    Cur := @Src^.Next
  end;
  RawCopyVis := Copy
end;

procedure FreeVis(Vis: PVis);
Begin
  If Vis = nil then Exit;
  with PRectVis(Vis)^ do
  begin
    FreeRectList(List);
    If Trans <> nil
    then Dispose(Trans, Done)
  end;
  Dispose(PRectVis(Vis))
End;

{ Sorting ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
}

procedure SortRect(var Dst: PVRect; Src: PVRect; Delta: TPoint);
var
  clear: Boolean;

	procedure Test(var Rect: TRect); {$ifndef FPK}near;{$endif}
	var
	  Copy: TRect;
	  Moved: TRect;
	  Result: Boolean;

		procedure DoesOverlap(var Obj: TRect); {$ifndef FPK}near;{$endif}
		begin
		  Result := Result or DoesIntersect(Moved, Obj)
		end;

	begin
	  clear := false;
	  Copy := Rect;
	  {$ifdef FPK}
	  Rect.Assign(0, 0, 0, 0);
	  {$else}
	  FillChar(Rect, SizeOf(Rect), 0);
	  {$endif}
	  Moved := Copy;
	  Moved.Move(Delta.x, Delta.y);
	  Result := false;
	  ForEachRect(Src, @DoesOverlap);
	  If not Result
	  then InsNewRect(Dst, Copy)
	  else Rect := Copy
	end;

begin
  repeat
    clear := true;
    ForEachRect(Src, @Test)
  until clear;
end;

function SortVis(Vis: PVis; Delta: TPoint): PVis;
var
  sorted: PRectVis;
begin
  {$ifdef gvisible_v1}
  SortVis := Vis
  {$else}
  New(sorted);
  with sorted^ do
  begin
    TheBounds := PRectVis(Vis)^.TheBounds;
    List := nil;
    DrawMode := 0;
    Trans := PRectVis(Vis)^.Trans;
    CurTrans := PRectVis(Vis)^.CurTrans;
    PRectVis(Vis)^.Trans := nil
  end;
  SortRect(sorted^.List, PRectVis(Vis)^.List, Delta);
  FreeVis(Vis);
  SortVis := sorted
  {$endif}
end;

{ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
}

function BeginDraw(Vis: PVis; Origin: TPoint;
  This: PGView; Modifying: Boolean): Boolean;
var
  Bounds: TRect;
  Options: Word;

 function PrepMeta(Size: Word): Boolean;
 Begin
   with PRectVis(Vis)^ do Begin
     MetaBuf := GetBuffer(Size);
     PrepMeta := MetaBuf <> nil
   End
 End;

 function PrepVga: Boolean;
 Begin
   if Modifying or (This^.State and sfTransparent <> 0)
   then begin
     with Bounds do
       SetCriticalArea(A.x, A.y, B.x, B.y);
     HideMouse;
     PrepVga := PrepBuf(Bounds, pbCopy, PRectVis(Vis)^.VgaBuf);
     ShowMouse;
     SetCriticalArea(0, 0, 0, 0)
   end
   else
     PrepVga := PrepBuf(Bounds, pbNone, PRectVis(Vis)^.VgaBuf);
 End;

Begin
  BeginDraw := true;
  Inc(This^.ViewLock);
  If This^.ViewLock <> 1 then Exit;
  SourcePage := 2;
  DestPage := 2;
  MetaError := 0;

  If Vis = nil
  then begin
    SetClipRect(0, 0, 0, 0);
    MetaClipRect := ClipRect;
    Exit
  end;

  Options := This^.Options and GlobalOptions;
  
  with PRectVis(Vis)^ do Begin
    case UniteList(PRectVis(Vis)^.List, Bounds) of
      0:
	Begin
	  SetClipRect(0, 0, 0, 0);
	  MetaClipRect := ClipRect;
	  PRectVis(Vis)^.DrawMode := 0;
	  Exit
	End;
      1:
	begin
	  If (Modifying or (This^.State and sfTransparent = 0)) and
	     (Options and ofBuffer <> 0) and
	     ((Options and ofBufferOne <> 0) or HasTrans(Vis)) and
	     PrepVga
	  then Begin
	    SetDrawOrigin(Origin.x + DrawOrigin.x, Origin.y + DrawOrigin.y);
	    MetaClipRect := ClipRect;
	    DrawTransBack(Vis, This);
	    PRectVis(Vis)^.DrawMode := 1;
	    Exit
	  End
	  else Begin
	    TheBounds := Bounds; { maybe tighter bounds }
	    Dec(This^.ViewLock);
	    If Modifying or (This^.State and sfTransparent <> 0)
	    then HideTrans(Vis, This);
	    Inc(This^.ViewLock);
	    SetDrawOriginP(Origin);
	    SetClipRectR(Bounds);
	    MetaClipRect := ClipRect;
	    with Bounds do SetCriticalArea(A.x, A.y, B.x, B.y);
	    HideMouse;
	    PRectVis(Vis)^.DrawMode := 3;
	    Exit
	  End;
	End
    End;

    If (Modifying or (This^.State and sfTransparent = 0)) and
       (Options and ofBuffer <> 0) and PrepVga
    then Begin
      SetDrawOrigin(Origin.x + DrawOrigin.x, Origin.y + DrawOrigin.y);
      MetaClipRect := ClipRect;
      DrawTransBack(Vis, This);
      PRectVis(Vis)^.DrawMode := 1;
      Exit
    End;

    Dec(This^.ViewLock);
    If Modifying or (This^.State and sfTransparent <> 0)
    then HideTrans(Vis, This);
    Inc(This^.ViewLock);

    SetDrawOriginP(Origin);

  {$ifndef FPK}
    If (Options and ofMetaFile <> 0) and PrepMeta($4000)
    then Begin
      SetBuffer(MetaBuf);
      SetMetaState(ms_Record);
      SetClipRectR(Bounds);
      MetaClipRect := ClipRect;
      SetCriticalArea(0, 0, 0, 0);
      PRectVis(Vis)^.DrawMode := 2;
      Exit
    End
  {$endif}
  End;
  BeginDraw := false;
  SetClipRect(0, 0, 0, 0);
  MetaClipRect := ClipRect;
  This^.ViewLock := 0;
End;

function EndDraw(Vis: PVis; This: PGView): Boolean;

 procedure PasteDraw(var Rect: TRect); {$ifndef FPK}near;{$endif}
 Begin
   with Rect do SetCriticalArea(A.x, A.y, B.x, B.y);
   with PRectVis(Vis)^ do
     PasteRect(Rect, PRectVis(Vis)^.VgaBuf);
 End;

{$ifndef FPK}
 procedure MetaDraw(var Rect: TRect); {$ifndef FPK}near;{$endif}
 Begin
   MetaClipRect := Rect;
   with Rect do SetCriticalArea(A.x, A.y, B.x, B.y);
   with PRectVis(Vis)^ do
     DrawBuffer(MetaBuf)
 End;
{$endif FPK}

Begin
  EndDraw := false;
  If This^.ViewLock = 1 then
  If Vis <> nil then
  with PRectVis(Vis)^ do
  begin
    case PRectVis(Vis)^.DrawMode of
      1:
	Begin
	  DrawTrans(Vis, This);
	  EndBufDraw;
	  SetCriticalArea(0, 0, 0, 0);
	  HideMouse;
	  ForEachRect(PRectVis(Vis)^.List, @PasteDraw);
	  ShowMouse;
	  ReleaseBuf(PRectVis(Vis)^.VgaBuf)
	End;
{$ifndef FPK}
      2:
	Begin
	  SetMetaState(ms_Draw + ms_Execute + ms_BGI);
	  If not MetaFunctions or (MetaError <> 0)
	  then Begin
	    FreeBuffer(MetaBuf);
	    This^.Options := This^.Options and not ofMetaFile;
	    Exit
	  End;
	  MetaOrigin.X := 0; MetaOrigin.Y := 0;
	  SetCriticalArea(0, 0, 0, 0);
	  HideMouse;
	  ForEachRect(List, @MetaDraw);
	  ShowMouse;
	  SetMetaState(ms_Draw + ms_BGI);
	  FreeBuffer(MetaBuf)
	End;
{$endif FPK}
      3:
	begin
{$ifdef Linux}
	  if IndirectGraphics then begin
	    { We have a mode in which no direct graphic operations are
	     supported, for instance 16-color planar or 256-color planar. }
	    UpdatePhysicalScreen(TheBounds);
	  end;
{$endif}
	  ShowMouse;
	end;
      0:
	FreeBacks(Vis, This);
    end;
    If PRectVis(Vis)^.DrawMode >= 2 then ShowTrans(Vis, This);
    PRectVis(Vis)^.DrawMode := 0
  end;
  Dec(This^.ViewLock);
  If This^.ViewLock < 0 then This^.ViewLock := 0;
  EndDraw := true
End;

procedure SubtractHiddenSources(Vis: PVis; Delta: TPoint; This: PGView);
{ nothing to subtract }
begin
end;

