unit GvTag;

{ Graphics Vision 2.20 List Tagger,
  Copr. 1998 Matthias K"oppe
}

{$A+,B-,F+,G+,I-,O+,P-,Q-,R-,S-,T-,V+,X+}

interface

uses Objects, Drivers, Views, GvViews;

type
  PListTagger = ^TListTagger;
  TListTagger = object(TObject)
    Viewer: PListViewer;
    constructor Init(AViewer: PListViewer);
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure ClearTags; virtual;
    function Taggable(Item: Integer): Boolean; virtual; {pseudo-abstract}
    function Tagged(Item: Integer): Boolean; virtual; {abstract}
    procedure Toggle(Item: Integer);
    procedure SetTag(Item: Integer; Enable: Boolean); virtual; {abstract}
  end;

  { This TListTagger descendant stores all tags in a byte set.
  }
  PListTaggerWithSet = ^TListTaggerWithSet;
  TListTaggerWithSet = object(TListTagger)
    TagSet: set of Byte;
    function Tagged(Item: Integer): Boolean; virtual;
    procedure SetTag(Item: Integer; Enable: Boolean); virtual;
  end;

implementation

{$ifdef Windows}
uses WinGr;
{$endif}

constructor TListTagger.Init(AViewer: PListViewer);
begin
  inherited Init;
  Viewer := AViewer
end;

procedure TListTagger.HandleEvent(var Event: TEvent);
var
  I: Integer;

  procedure TagRange(I: Integer);
  var
    PointedTagged: Boolean;
  begin
    PointedTagged := Tagged(I);
    while I > Viewer^.Focused do
    begin
      if Taggable(I)
      then begin
        SetTag(I, not PointedTagged);
        Viewer^.DrawItem(I)
      end;
      Dec(I);
    end;
    while I <= Viewer^.Focused do
    begin
      if Taggable(I)
      then begin
        SetTag(I, not PointedTagged);
        Viewer^.DrawItem(I)
      end;
      Inc(I);
    end;
  end;

  procedure CheckedFocus(NewFocused: Integer);
  begin
    if NewFocused < 0 then NewFocused := 0 else
    if NewFocused >= Viewer^.Range then NewFocused := Viewer^.Range - 1;
    if GetShiftState and (kbLeftShift + kbRightShift) <> 0
    then TagRange(NewFocused);
    Viewer^.FocusItem(NewFocused)
  end;

  function Pointed(Mouse: TPoint): Integer;
  var
    I: Integer;
    R: TRect;
  begin
    Viewer^.MakeLocal(Mouse, Mouse);
    For I := Viewer^.TopItem to Viewer^.TopItem + Viewer^.GetPageSize
      + (Viewer^.Flags and lfPartialLines) * Viewer^.NumCols do
    begin
      Viewer^.GetItemRect(I, R);
      If R.Contains(Mouse) then Begin
	Pointed := I;
	Exit;
      End;
    End;
    Pointed := -1
  end;

begin
  if (Event.What = evMouseDown)
     and (GetShiftState and kbCtrlShift <> 0)
  then begin
    I := Pointed(Event.Where);
    if I >= 0
    then begin
      if Taggable(I)
      then begin
        Toggle(I);
        Viewer^.DrawItem(I)
      end
    end
    { No clear-event }
  end;
  if (Event.What = evMouseDown)
     and (GetShiftState and (kbLeftShift+kbRightShift) <> 0)
  then begin
    I := Pointed(Event.Where);
    if I >= 0
    then TagRange(I)
  end;

  if Event.What = evKeyDown then
  begin
    I := Viewer^.GetPageSize;
    case Event.KeyCode of
      kbIns:
	if Viewer^.Range > 0 then
	begin
          if Taggable(Viewer^.Focused)
          then begin
	    Toggle(Viewer^.Focused);
	    if Viewer^.Focused < Viewer^.Range-1
	    then Viewer^.FocusItem(Viewer^.Focused + 1) {will redraw F-item }
            else Viewer^.DrawItem(Viewer^.Focused);
          end
          else Exit;
	end;
      kbGrayPlus:
        For i := 0 to Viewer^.Range-1 do
          if Taggable(i) then SetTag(i, true);
      kbGrayMinus:
        For i := 0 to Viewer^.Range-1 do
          if Taggable(i) then SetTag(i, false);
      { Following stolen from TListViewer.HandleEvent }
      kbUp:
        If Viewer^.Focused>0 then CheckedFocus(Viewer^.Focused-1);
      kbDown:
        If Viewer^.Focused<Viewer^.Range-1 then CheckedFocus(Viewer^.Focused+1);
      kbLeft:
	if Viewer^.NumCols <> 1
	then CheckedFocus(Viewer^.Focused - Viewer^.GetNumRows);
      kbRight:
	if Viewer^.NumCols <> 1
	then CheckedFocus(Viewer^.Focused + Viewer^.GetNumRows);
      kbHome:
	CheckedFocus(Viewer^.TopItem);
      kbEnd:
	CheckedFocus(Viewer^.TopItem+I);
      kbPgUp:
	CheckedFocus(Viewer^.Focused - I - 1);
      kbPgDn:
	CheckedFocus(Viewer^.Focused + I+1);
      kbCtrlPgUp:
	CheckedFocus(0);
      kbCtrlPgDn:
	CheckedFocus(Viewer^.Range-1);
      else Exit;
    end;
    Viewer^.ClearEvent (Event);
  End;

  if Event.What = evBroadcast then
  begin
    case Event.Command of
      cmListItemSelected :
	if Event.InfoPtr = @Self
        then begin
	  if Viewer^.Range > 0 then
	  begin
	    if Taggable(Viewer^.Focused)
	    then begin
	      Toggle(Viewer^.Focused);
	      if Viewer^.Focused < Viewer^.Range - 1
	      then Viewer^.FocusItem(Viewer^.Focused + 1) {will redraw F-item }
              else Viewer^.DrawItem(Viewer^.Focused);
	      Viewer^.ClearEvent(Event);
	    end
	  end;
        end;
    end; { case }
  end;
end;

procedure TListTagger.ClearTags;
var
  i: Integer;
begin
  For i := 0 to Viewer^.Range - 1 do
  begin
    if Tagged(i)
    then begin
      SetTag(i, false);
      Viewer^.DrawItem(i)
    end
  end
end;

procedure TListTagger.Toggle(Item: Integer);
begin
  SetTag(Item, not Tagged(Item))
end;

function TListTagger.Taggable(Item: Integer): Boolean;
begin
  Taggable := true
end;

function TListTagger.Tagged(Item: Integer): Boolean;
begin
  Abstract
end;

procedure TListTagger.SetTag(Item: Integer; Enable: Boolean);
begin
  Abstract
end;

function TListTaggerWithSet.Tagged(Item: Integer): Boolean;
begin
  Tagged := Item in TagSet
end;

procedure TListTaggerWithSet.SetTag(Item: Integer; Enable: Boolean);
begin
  if Enable
  then Include(TagSet, Item)
  else Exclude(TagSet, Item)
end;

end.
