unit Annotation;
{
[Annotation] [1.5]
Delphi 2005
September 2008

LICENSE

The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
"http://www.mozilla.org/MPL/"

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is "[annotation.pas]".

The Initial Developer of the Original Code is Martin Holmes (Victoria,
BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2006-8 Martin Holmes
and the University of Victoria Computing and Media Centre. The code was 
co-developed for university and personal projects, and rights are shared
by Martin Holmes and the University of Victoria. All Rights Reserved.
}

{
Written by Martin Holmes, 2006-2008.

This unit contains classes for handling annotations attached to an image. The
basic idea is that a TIMTAnnotation object contains information about the
annotation area on the image, the textual data associated with it, and the
AnnotationCategory to which it is assigned. If an annotation is "switched on",
then it creates a TPositionedLayer on the image, and interfaces with it
where necessary through a RubberbandLayer. If it's "switched off", the
TPositionedLayer is deleted from the image, but its position/display information
is retained in the TIMTAnnotation object so it can be recreated if required.

The TIMTAnnotation can write out its positional data as a facsimile <zone> node, with
the Category field expressed as a class attribute. It can write out its textual
data as a TEI div, linked either by @facs or @corresp to the <zone>.

The TIMTAnnList object contains the list of TIMTAnnotationObjects associated
with the document. It can sort them in various ways.


Dependencies:

XDOM_4_1 (Dieter Köhler)

Graphics32 (graphics32.org)

}
interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   XDOM_4_1, GR32, GR32_Image, GR32_Layers, AnnotationCategories, jclUnicode,
   IMTDocGlobals, StringFunctions, XMLUtilities;

//Method pointer for assigning a method from the TAnnCatList so that the TIMTAnnList
//can get info from it.

type TGetTranscriptionalFromCatIDProc = function(CatID: WideString): Boolean of Object;

type
  TIMTAnnotation = class
  private
    fXmlID: WideString;
    fAnnTitle: WideString;
    fAnnText: WideString;
    fCategoryID: WideString;
    fLeft: single;
    fTop: single;
    fWidth: single;
    fHeight: single;
    fShowing: Boolean;
    fModified: Boolean;
    fPositionedLayer: TPositionedLayer;  //pointer to an instantiated layer if there is one
    function GetCenterPoint: TPoint;
    function GetBottom: single;
    function GetRight: single;
    procedure SetXmlID(const Value: WideString);
    procedure SetBottom(const Value: single);
    procedure SetHeight(const Value: single);
    procedure SetLeft(const Value: single);
    procedure SetRight(const Value: single);
    procedure SetTop(const Value: single);
    procedure SetWidth(const Value: single);
    procedure SetShowing(const Value: Boolean);
    procedure SetCategoryID(const Value: WideString);
    procedure SetAnnText(const Value: WideString);
    procedure SetAnnTitle(const Value: WideString);
    function GetPositionedLayer: TPositionedLayer;
    procedure SetPositionedLayer(const Value: TPositionedLayer);
  public

    constructor Create;
    destructor Destroy; override;
{    function ReportRectTag(id: WideString; IncludeNS: Boolean): WideString;//Reports the area as an SVG <rect> tag
    function ReportDivTag(LinkedID, TypeString: WideString): WideString; }
    function WriteAttsToRectElement(RectEl: TDomElement; DomDoc: TDomDocument): Boolean;
    function ReadAttsFromRectElement(RectEl: TDomElement): Boolean;
    function WriteToDivElement(DivEl: TDomElement; DomDoc: TDomDocument): Boolean;
    function ReadFromDivElement(DivEl: TDomElement): Boolean;
    function CopySelf(TargetAnn: TIMTAnnotation): Boolean;

    const DefaultContent = WideString('<p>[Annotation detail]</p>');

  published
    property XmlID: WideString read fXmlID write SetXmlID;
    property AnnTitle: WideString read fAnnTitle write SetAnnTitle;
    property AnnText: WideString read fAnnText write SetAnnText;

    property CenterPoint: TPoint read GetCenterPoint;

    property Left: single read fLeft write SetLeft;
    property Top: single read fTop write SetTop;
    property Width: single read fWidth write SetWidth;
    property Height: single read fHeight write SetHeight;
    property Right: single read GetRight write SetRight;
    property Bottom: single read GetBottom write SetBottom;

    property Showing: Boolean read fShowing write SetShowing default True;

    property CategoryID: WideString read fCategoryID write SetCategoryID;

    property PositionedLayer: TPositionedLayer read GetPositionedLayer write SetPositionedLayer;

    property Modified: Boolean read fModified write fModified default False;
  end;

type
  TIMTAnnList = class(TList)
  private
    fModified: Boolean;
    fGetTranscriptionalFromCatIDProc: TGetTranscriptionalFromCatIDProc;
    function GetXmlID(Index: integer): WideString;
    procedure SetXmlID(Index: integer; const Value: WideString);
    function GetCategoryID(Index: integer): WideString;
    procedure SetCategoryID(Index: integer; const Value: WideString);
    function GetAnnTitle(Index: integer): WideString;
    procedure SetAnnTitle(Index: integer; const Value: WideString);
    function GetAnnText(Index: integer): WideString;
    procedure SetAnnText(Index: integer; const Value: WideString);
    function GetShowing(Index: integer): Boolean;
    procedure SetShowing(Index: integer; const Value: Boolean);
    function GetBottom(Index: integer): single;
    function GetHeight(Index: integer): single;
    function GetLeft(Index: integer): single;
    function GetRight(Index: integer): single;
    function GetTop(Index: integer): single;
    function GetWidth(Index: integer): single;
    function GetCenterPoint(Index: integer): TPoint;
    procedure SetBottom(Index: integer; const Value: single);
    procedure SetHeight(Index: integer; const Value: single);
    procedure SetLeft(Index: integer; const Value: single);
    procedure SetRight(Index: integer; const Value: single);
    procedure SetTop(Index: integer; const Value: single);
    procedure SetWidth(Index: integer; const Value: single);
    function GetBoundsRect(Index: integer): TFloatRect;
    procedure SetBoundsRect(Index: integer; const Value: TFloatRect);
    procedure SetModified(const Value: Boolean);
    function GetPositionedLayer(Index: integer): TPositionedLayer;
    procedure SetPositionedLayer(Index: integer; const Value: TPositionedLayer);

  public
    constructor Create(GetTranscriptionalProc: TGetTranscriptionalFromCatIDProc);
    function IndexInRange(Index: integer): Boolean;
    function IDIsUnique(TheID: WideString; Index: integer): Boolean;
    function AddAnnotation: integer;
    function DeleteAnnotation(Index: integer): Boolean;
    function SwapPositions(Ann1, Ann2: integer): Boolean;
    procedure Empty;

    procedure CategoryChanged(OldCatID, NewCatID: WideString);

    function ReadFromDomElements(AnnWrapperEl, FacsEl: TDomElement; ClearFirst: Boolean): Boolean;
    function WriteDivsToDomElement(El: TDomElement; DomDoc: TDomDocument): Boolean;
    function WriteRectsToDomElement(El: TDomElement; DomDoc: TDomDocument): Boolean;

    function CloneAnnotation(SourceAnn, TargetAnn: integer): Boolean;

    property XmlID[Index: integer]: WideString read GetXmlID write SetXmlID;
    property CategoryID[Index: integer]: WideString read GetCategoryID write SetCategoryID;
    property AnnTitle[Index: integer]: WideString read GetAnnTitle write SetAnnTitle;
    property AnnText[Index: integer]: WideString read GetAnnText write SetAnnText;
    property Showing[Index: integer]: Boolean read GetShowing write SetShowing;
    property Left[Index: integer]: single read GetLeft write SetLeft;
    property Top[Index: integer]: single read GetTop write SetTop;
    property Width[Index: integer]: single read GetWidth write SetWidth;
    property Height[Index: integer]: single read GetHeight write SetHeight;
    property Right[Index: integer]: single read GetRight write SetRight;
    property Bottom[Index: integer]: single read GetBottom write SetBottom;
    property BoundsRect[Index: integer]: TFloatRect read GetBoundsRect write SetBoundsRect;
    property CenterPoint[Index: integer]: TPoint read GetCenterPoint;
    property PositionedLayer[Index: integer]: TPositionedLayer read
                  GetPositionedLayer write SetPositionedLayer;
  published
    property Modified: Boolean read fModified write SetModified default False;
  end;

implementation



{ TIMTAnnotation }

function TIMTAnnotation.GetCenterPoint: TPoint;
begin
  Result.X := Round(fLeft + (fWidth/2));
  Result.Y := Round(fTop + (fHeight/2));
end;

constructor TIMTAnnotation.Create;
begin
  AnnTitle := '[Annotation title]';
  //AnnText := '<p>[Annotation detail]</p>';
  AnnText := '<p>' + DefaultContent + '</p>';
  fCategoryID := 'Category_undefined';
  fPositionedLayer := nil;
  fLeft := 0;
  fTop := 0;
  fWidth := 0;
  fHeight := 0;
  Modified := False;
end;

procedure TIMTAnnotation.SetXmlID(const Value: WideString);
var
NewValue: WideString;

begin
  NewValue := WideTrim(Value);
  if fXmlID <> NewValue then
    begin
      fXmlID := NewValue;
      Modified := True;
    end;
end;

function TIMTAnnotation.GetRight: single;
begin
  Result := fLeft + fWidth;
end;

procedure TIMTAnnotation.SetRight(const Value: single);
var
NewWidth: single;

begin
  NewWidth := Value - fLeft;
  SetWidth(NewWidth);
end;

procedure TIMTAnnotation.SetWidth(const Value: single);
begin
  fWidth := Value;
end;

function TIMTAnnotation.GetBottom: single;
begin
  Result := fTop + fHeight;
end;

procedure TIMTAnnotation.SetBottom(const Value: single);
var
NewHeight: single;

begin
  NewHeight := Value - fTop;
  Height := NewHeight;
end;

procedure TIMTAnnotation.SetTop(const Value: single);
begin
  if fTop <> Value then
    begin
      fTop := Value;
      Modified := True;
    end;
end;

procedure TIMTAnnotation.SetHeight(const Value: single);
begin
  if fHeight <> Value then
    begin
      fHeight := Value;
      Modified := True;
    end;
end;

procedure TIMTAnnotation.SetLeft(const Value: single);
begin
  if fLeft <> Value then
    begin
      fLeft := Value;
      Modified := True;
    end;
end;

procedure TIMTAnnotation.SetAnnText(const Value: WideString);
var
NewValue: WideString;

begin
  NewValue := WideTrim(Value);
  if fAnnText <> NewValue then
    begin
      fAnnText := NewValue;
      Modified := True;
    end;
end;

procedure TIMTAnnotation.SetAnnTitle(const Value: WideString);
var
NewValue: WideString;

begin
  NewValue := WideTrim(Value);
  if fAnnTitle <> NewValue then
    begin
      fAnnTitle := NewValue;
      Modified := True;
    end;
end;

procedure TIMTAnnotation.SetShowing(const Value: Boolean);
begin
  if fShowing <> Value then
    begin
      if fPositionedLayer <> nil then
        begin
          if Value = True then
            begin
              TPositionedLayer(fPositionedLayer).LayerOptions :=
                  LOB_VISIBLE or LOB_MOUSE_EVENTS or LOB_NO_UPDATE;
            end
          else
            begin
              TPositionedLayer(fPositionedLayer).LayerOptions := LOB_NO_UPDATE or LOB_NO_CAPTURE;
//The following should be redundant, but seems to make behaviour more consistent!
              TPositionedLayer(fPositionedLayer).Visible := False;
            end;
          TPositionedLayer(fPositionedLayer).Update;
{The above turns out not to be enough when the ImgView32 Repaint is set to optimizer,
because it defers repainting until some screen change triggers it. We need to make sure
that a repaint occurs in order to make the layers appear or disappear.}
          TImgView32(TPositionedLayer(fPositionedLayer).LayerCollection.Owner).Invalidate;
        end;
      fShowing := Value;
      Modified := True;
    end;
end;

procedure TIMTAnnotation.SetCategoryID(const Value: WideString);
begin
  if fCategoryID <> Value then
  begin
    fCategoryID := Value;
//If there's an associated TPositionedLayer, it should be invalidated so
//that any changes in its paint features are updated
    if Showing and (PositionedLayer <> nil) then
      TPositionedLayer(PositionedLayer).Update;
    Modified := True;
  end;
end;


function TIMTAnnotation.GetPositionedLayer: TPositionedLayer;
begin
  Result := fPositionedLayer;
end;

procedure TIMTAnnotation.SetPositionedLayer(const Value: TPositionedLayer);
begin
  if Value <> fPositionedLayer then
    begin
      fPositionedLayer := Value;
      Modified := True;
    end;
end;

function TIMTAnnotation.WriteAttsToRectElement(RectEl: TDomElement;
  DomDoc: TDomDocument): Boolean;

begin
//Updated for 1.7
  Result := False;
  try
    if (RectEl <> nil) and (DomDoc <> nil) then
      begin
//This line new for 1.8
        RectEl.SetAttribute('xml:id', XmlID);
        RectEl.SetAttribute('rendition', CategoryID);
        RectEl.SetAttribute('ulx', IntToStr(Round(Left)));
        RectEl.SetAttribute('uly', IntToStr(Round(Top)));
        RectEl.SetAttribute('lrx', IntToStr(Round(Width) + Round(Left)));
        RectEl.SetAttribute('lry', IntToStr(Round(Height) + Round(Top)));
        Case Showing of
          True: RectEl.SetAttribute('rend', 'visible');
          False: RectEl.SetAttribute('rend', 'hidden');
        end;
        Result := True;
      end;
  except
    Exit;
  end;
end;

function TIMTAnnotation.ReadAttsFromRectElement(RectEl: TDomElement): Boolean;
begin
//Updated for 1.7
  Result := False;
  try
    if RectEl <> nil then
      begin
  //This line new for 1.8
        XmlID := RectEl.GetAttributeLiteralValue('xml:id');
        CategoryID := RectEl.GetAttributeLiteralValue('rendition');
        Left := StrToInt(RectEl.GetAttributeLiteralValue('ulx'));
        Top := StrToInt(RectEl.GetAttributeLiteralValue('uly'));
        Width := StrToInt(RectEl.GetAttributeLiteralValue('lrx')) - Left;
        Height := StrToInt(RectEl.GetAttributeLiteralValue('lry')) - Top;
        if RectEl.GetAttributeLiteralValue('rend') = 'hidden' then
          Showing := False
        else
          Showing := True;
        Result := True;
      end;
  except
    Exit;
  end;
end;

function TIMTAnnotation.ReadFromDivElement(DivEl: TDomElement): Boolean;
var
DomImpl: TDomImplementation;
DomToXMLParser: TDomToXMLParser;
TitleEl, TextEl: TDomNode;
i: integer;
wsTemp: WideString;
wsTempAnnText: WideString;

begin
  Result := False;
  if DivEl = nil then
    Exit;
  try
    DomImpl := TDomImplementation.Create(nil);
    try
      DomToXMLParser := TDomToXMLParser.Create(nil);
      try
        DomToXMLParser.IncludeXmlDecl := False;
        DomToXMLParser.UseByteOrderMark := [];
        DomToXMLParser.DOMImpl := DomImpl;
        AnnTitle := '';
        if DivEl.GetElementsByTagName('head').Length > 0 then
          begin
            TitleEl := DivEl.GetElementsByTagName('head').Item(0);

            {Fixed version, for 1.8.2.0. This is rather a crude hack, but
             it seems to be the only way to get mixed content to read back
             in correctly, without losing spaces at the end of text nodes.}
            DomToXMLParser.WriteToWideString(TitleEl, wsTemp);
            if wsTemp[1] = WideChar($feff) then
                          Delete(wsTemp, 1, 1);
            //Now we have to remove the bracketing <head> </head> tags.
            Delete(wsTemp, 1, Pos('>', wsTemp));
            Delete(wsTemp, Length(wsTemp)-8, 7);

            AnnTitle := wsTemp;
            
            {Original version, changed after 1.8.1.9. This has a bug which
             causes spaces to be lost at the end of every text node in
             mixed content.}
            {if TitleEl.ChildNodes.Length > 0 then
              for i := 0 to TitleEl.ChildNodes.Length-1 do
                begin
                  DomToXMLParser.WriteToWideString(TitleEl.ChildNodes.Item(i), wsTemp);
                  if wsTemp[1] = WideChar($feff) then
                      Delete(wsTemp, 1, 1);
                  AnnTitle := AnnTitle + wsTemp;
                end;}


          end;
        AnnText := '';
        wsTempAnnText := '';
        if DivEl.GetElementsByTagName('div').Length > 0 then
          begin
            TextEl := DivEl.GetElementsByTagName('div').Item(0);
            if TextEl.ChildNodes.Length > 0 then
              for i := 0 to TextEl.ChildNodes.Length-1 do
{Perhaps we should restrict content to element nodes here -- if so, uncomment the following line.
On the other hand, we may want to allow e.g. comment elements but disallow text elements
(which are disallowed by the schema).}
                if TextEl.ChildNodes.Item(i).nodeType = ntText_Node then
                  begin
                    wsTempAnnText := wsTempAnnText + WNormalizeReturns(TDomText(TextEl.ChildNodes.Item(i)).nodeValue);
                    //ShowMessage(WAllCharsToJSUnicode(WNormalizeReturns(TDomText(TextEl.ChildNodes.Item(i)).nodeValue)));
                  end
                else
                  begin
                    DomToXMLParser.WriteToWideString(TextEl.ChildNodes.Item(i), wsTemp);
{Annoying bug in XDOM prepends a bloody byte-order mark all the time. }
                    if wsTemp[1] = WideChar($feff) then
                      Delete(wsTemp, 1, 1);
                    wsTempAnnText := wsTempAnnText + wsTemp;
                  end;
            AnnText := wsTempAnnText;
          end;
      finally
        FreeAndNil(DomToXMLParser);
      end;
    finally
      FreeAndNil(DomImpl);
    end;
    Result := True;
  except
    Exit;
  end;
end;

function TIMTAnnotation.WriteToDivElement(DivEl: TDomElement;
  DomDoc: TDomDocument): Boolean;
var
XMLToDomParser: TXMLToDomParser;
NewHeadNode, NewDivNode: TDomNode;
begin
//Both elements being created here may well have lots of embedded
//markup, so they need to be treated carefully.
  Result := False;
  if DivEl = nil then
    Exit;

  try

    XMLToDomParser := TXMLToDomParser.Create(nil);
    try
      XMLToDomParser.DOMImpl := DomDoc.DomImplementation;
      NewHeadNode := TDomDocumentFragment.Create(DomDoc);
//Update to XDOM 3.2 broke this code.
      {NewHeadNode := XMLToDomParser.ParseWideString('<head>' +
                                    WideTrim(AnnTitle) + '</head>',
                                    '', '', NewHeadNode);}
      NewHeadNode := ufrmXMLUtilities.ParseWideStringToDomNode(
                                    '<?xml version="1.0" ?>' + #13#10 +
                                    '<head>' +
                                    WideTrim(AnnTitle) + '</head>',
                                    DomDoc.DomImplementation,
                                    DomDoc);
      if NewHeadNode <> nil then
        DivEl.AppendChild(NewHeadNode);
      NewDivNode := TDomDocumentFragment.Create(DomDoc);
      {NewDivNode := XMLToDomParser.ParseWideString('<div>' +
                                    WideTrim(AnnText) + '</div>',
                                    '', '', NewDivNode);}
      NewDivNode := ufrmXMLUtilities.ParseWideStringToDomNode(
                                    '<?xml version="1.0" ?>' + #13#10 +
                                    '<div>' +
                                    WideTrim(AnnText) + '</div>',
                                    DomDoc.DomImplementation,
                                    DomDoc);
      if NewDivNode <> nil then
        DivEl.AppendChild(NewDivNode);
    finally
      FreeAndNil(XMLToDomParser);
    end;
    Result := True;
  except
    Exit;
  end;
end;

destructor TIMTAnnotation.Destroy;
var
Index: integer;

begin
//Try to destroy the layer if it exists
  if fPositionedLayer <> nil then
    begin
      Index := TPositionedLayer(fPositionedLayer).Index;
      if TPositionedLayer(fPositionedLayer).LayerCollection <> nil then
        if Index > -1 then
          if Index < TPositionedLayer(fPositionedLayer).LayerCollection.Count then
            TPositionedLayer(fPositionedLayer).LayerCollection.Delete(Index);
    end;
end;

function TIMTAnnotation.CopySelf(TargetAnn: TIMTAnnotation): Boolean;
begin
  Result := False;
  try
    if TargetAnn <> nil then
      begin
        TargetAnn.AnnTitle := AnnTitle;
        TargetAnn.AnnText := AnnText;
//Offset the position, to distinguish the clone from the original
        TargetAnn.Left := Left + (Round(Width / 3));
        TargetAnn.Top := Top + (Round(Height / 3));
        TargetAnn.Width := Width;
        TargetAnn.Height := Height;
        TargetAnn.CategoryID := CategoryID;
        TargetAnn.Showing := Showing;
        Result := True;
      end;
  except        //Returning false is OK
  end;
end;

{ TIMTAnnList }

function TIMTAnnList.GetAnnTitle(Index: integer): WideString;
begin
  Result := '';
  if IndexInRange(Index) then
    Result := TIMTAnnotation(List[Index]).AnnTitle;
end;

function TIMTAnnList.GetAnnText(Index: integer): WideString;
begin
  Result := '';
  if IndexInRange(Index) then
    Result := TIMTAnnotation(List[Index]).AnnText;
end;

function TIMTAnnList.GetXmlID(Index: integer): WideString;
begin
  Result := '';
  if IndexInRange(Index) then
    Result := TIMTAnnotation(List[Index]).XmlID;
end;

procedure TIMTAnnList.SetXMLID(Index: integer; const Value: WideString);
var
NewID: WideString;
i: integer;

begin
  if not IndexInRange(Index) then
    Exit;
  NewID := WideTrim(Value);
//Enforce compliance with xml:id
  ufrmXMLUtilities.MakeXMLNCName(NewID);
  i := 1;
//Make sure it's unique. This will not invalidate it as xml:id.
 while not (IDIsUnique(NewID, Index)) do
    begin
      inc(i);
      NewID := WideTrim(Value) + '_' + IntToStr(i);
    end;

  TIMTAnnotation(List[Index]).XmlId := NewID;
end;

function TIMTAnnList.IDIsUnique(TheID: WideString; Index: integer): Boolean;
var
i: integer;

begin
  Result := True; //default
  if IndexInRange(Index) then
    for i := 0 to Count-1 do
      if (Index <> i) and (TheID = XmlID[i]) then
        Result := False;
end;

function TIMTAnnList.GetCategoryID(Index: integer): WideString;
begin
  Result := '';
  if IndexInRange(Index) then
    Result := TIMTAnnotation(List[Index]).CategoryID;
end;

function TIMTAnnList.IndexInRange(Index: integer): Boolean;
begin
  Result := ((Index > -1) and (Index < Count));
end;

procedure TIMTAnnList.SetAnnTitle(Index: integer; const Value: WideString);
begin
  if IndexInRange(Index) then
    begin
      TIMTAnnotation(List[Index]).AnnTitle := Value;
      Modified := Modified or TIMTAnnotation(List[Index]).Modified;
    end;
end;

procedure TIMTAnnList.SetAnnText(Index: integer; const Value: WideString);
begin
  if IndexInRange(Index) then
    begin
      TIMTAnnotation(List[Index]).AnnText := Value;
      Modified := Modified or TIMTAnnotation(List[Index]).Modified;
    end;
end;

procedure TIMTAnnList.SetCategoryID(Index: integer; const Value: WideString);
begin
  if IndexInRange(Index) then
    begin
      TIMTAnnotation(List[Index]).CategoryID := Value;
      Modified := Modified or TIMTAnnotation(List[Index]).Modified;
    end;
end;

function TIMTAnnList.GetShowing(Index: integer): Boolean;
begin
  Result := True;
  if IndexInRange(Index) then
    Result := TIMTAnnotation(List[Index]).Showing;
end;

procedure TIMTAnnList.SetShowing(Index: integer; const Value: Boolean);
begin
  if IndexInRange(Index) then
    begin
      TIMTAnnotation(List[Index]).Showing := Value;
      Modified := Modified or TIMTAnnotation(List[Index]).Modified;
    end;
end;

function TIMTAnnList.GetRight(Index: integer): single;
begin
  Result := 100;
  if IndexInRange(Index) then
    Result := TIMTAnnotation(List[Index]).Right;
end;

procedure TIMTAnnList.SetRight(Index: integer; const Value: single);
begin
  if IndexInRange(Index) then
    begin
      TIMTAnnotation(List[Index]).Right := Value;
      Modified := Modified or TIMTAnnotation(List[Index]).Modified;
    end;
end;

function TIMTAnnList.GetWidth(Index: integer): single;
begin
  Result := 100;
  if IndexInRange(Index) then
    Result := TIMTAnnotation(List[Index]).Width;
end;

function TIMTAnnList.GetCenterPoint(Index: integer): TPoint;
begin
  Result := Point(0,0); //fallback default
  if IndexInRange(Index) then
    Result := TIMTAnnotation(List[Index]).CenterPoint;
end;

procedure TIMTAnnList.SetWidth(Index: integer; const Value: single);
begin
  if IndexInRange(Index) then
    begin
      TIMTAnnotation(List[Index]).Width := Value;
      Modified := Modified or TIMTAnnotation(List[Index]).Modified;
    end;
end;

function TIMTAnnList.GetBottom(Index: integer): single;
begin
  Result := 100;
  if IndexInRange(Index) then
    Result := TIMTAnnotation(List[Index]).Bottom;
end;

procedure TIMTAnnList.SetBottom(Index: integer; const Value: single);
begin
  if IndexInRange(Index) then
    begin
      TIMTAnnotation(List[Index]).Bottom := Value;
      Modified := Modified or TIMTAnnotation(List[Index]).Modified;
    end;
end;

function TIMTAnnList.GetTop(Index: integer): single;
begin
  Result := 0;
  if IndexInRange(Index) then
    Result := TIMTAnnotation(List[Index]).Top;
end;

procedure TIMTAnnList.SetTop(Index: integer; const Value: single);
begin
  if IndexInRange(Index) then
    begin
      TIMTAnnotation(List[Index]).Top := Value;
      Modified := Modified or TIMTAnnotation(List[Index]).Modified;
    end;
end;

function TIMTAnnList.GetHeight(Index: integer): single;
begin
  Result := 100;
  if IndexInRange(Index) then
    Result := TIMTAnnotation(List[Index]).Height;
end;

procedure TIMTAnnList.SetHeight(Index: integer; const Value: single);
begin
  if IndexInRange(Index) then
    begin
      TIMTAnnotation(List[Index]).Height := Value;
      Modified := Modified or TIMTAnnotation(List[Index]).Modified;
    end;
end;

function TIMTAnnList.GetLeft(Index: integer): single;
begin
  Result := 0;
  if IndexInRange(Index) then
    Result := TIMTAnnotation(List[Index]).Left;
end;

procedure TIMTAnnList.SetLeft(Index: integer; const Value: single);
begin
  if IndexInRange(Index) then
    begin
      TIMTAnnotation(List[Index]).Left := Value;
      Modified := Modified or TIMTAnnotation(List[Index]).Modified;
    end;
end;

function TIMTAnnList.GetBoundsRect(Index: integer): TFloatRect;
begin
  Result := FloatRect(0,0,100,100);
  if IndexInRange(Index) then
    Result := FloatRect(TIMTAnnotation(List[Index]).Left,
                     TIMTAnnotation(List[Index]).Top,
                     TIMTAnnotation(List[Index]).Right,
                     TIMTAnnotation(List[Index]).Bottom);
end;

procedure TIMTAnnList.SetBoundsRect(Index: integer; const Value: TFloatRect);
begin
  if IndexInRange(Index) then
    begin
      TIMTAnnotation(List[Index]).Left := Value.Left;
      TIMTAnnotation(List[Index]).Top := Value.Top;
      TIMTAnnotation(List[Index]).Width := Value.Right - Value.Left;
      TIMTAnnotation(List[Index]).Height := Value.Bottom - Value.Top;
      Modified := Modified or TIMTAnnotation(List[Index]).Modified;
    end;
end;

function TIMTAnnList.GetPositionedLayer(Index: integer): TPositionedLayer;
begin
  Result := nil;//default
  if IndexInRange(Index) then
    Result := TIMTAnnotation(List[Index]).PositionedLayer;
end;

procedure TIMTAnnList.SetPositionedLayer(Index: integer;
  const Value: TPositionedLayer);
begin
  if IndexInRange(Index) then
    begin
      TIMTAnnotation(List[Index]).PositionedLayer := Value;
      Modified := Modified or TIMTAnnotation(List[Index]).Modified;
    end;
end;

procedure TIMTAnnList.SetModified(const Value: Boolean);
var
i: integer;

begin
//If setting Modified to false for the whole list, we must set it
//to false for all the list items.
  if Value = False then
    if Count > 0 then
      for i := 0 to Count-1 do
        TIMTAnnotation(List[i]).Modified := False;
  fModified := Value;
end;

function TIMTAnnList.AddAnnotation: integer;
var
Ann: TIMTAnnotation;
NewID: WideString;
i: integer;

begin
  Ann := TIMTAnnotation.Create;
  Add(Ann);
//Give this annotation a unique id
  NewID := 'imtArea_' + IntToStr(Count-1);
  i := Count;
//Make sure it's unique. This will not invalidate it as xml:id.
 while not (IDIsUnique(NewID, Count-1)) do
    begin
      inc(i);
      NewID := 'imtArea_' + '_' + IntToStr(i);
    end;
  XmlID[Count-1] := NewID;
  Result := Count-1;
  Modified := True;
end;

function TIMTAnnList.DeleteAnnotation(Index: integer): Boolean;
var
i: integer;

begin
  Result := False;
  if IndexInRange(Index) then
    begin

      FreeAndNil(TIMTAnnotation(List[Index]));
      Delete(Index);
//Renumber any tags in positioned layers
      if Index <= Count-1 then
        for i := Index to Count-1 do
          if TIMTAnnotation(List[i]).PositionedLayer <> nil then
            TPositionedLayer(TIMTAnnotation(List[i]).PositionedLayer).Tag := i;
      Modified := True;
    end;
end;

procedure TIMTAnnList.Empty;
var
i: integer;

begin
  if Count > 0 then
    for i := Count-1 downto 0 do
      DeleteAnnotation(i);
  Clear;
end;

//This function creates each of the individual annotation div elements and adds
//them to the wrapper div, adding an n attribute which will link
//each to the zone elements defining the areas.
function TIMTAnnList.WriteDivsToDomElement(El: TDomElement;
  DomDoc: TDomDocument): Boolean;
var
i: integer;
DivEl: TDomElement;
LinkingAtt: WideString;

begin
  Result := False;
  if El = nil then
    Exit;
  if Count > 0 then
    try
      for i := 0 to Count-1 do
        begin
          DivEl := TDomElement.Create(DomDoc, 'div');
          //This line changed for 1.8; now using explicit xml:ids
          //DivEl.SetAttribute('facs', imtAreaPrefix + IntToStr(i));
          LinkingAtt := 'facs'; //Default
          if Assigned(fGetTranscriptionalFromCatIDProc) then
            if fGetTranscriptionalFromCatIDProc(TIMTAnnotation(List[i]).CategoryID) = False then
              LinkingAtt := 'corresp';
          DivEl.SetAttribute(LinkingAtt, '#' + TIMTAnnotation(List[i]).XmlID);
          DivEl.SetAttribute('type', imtAnnType);
          TIMTAnnotation(List[i]).WriteToDivElement(DivEl, DomDoc);
          El.AppendChild(DivEl);
        end;

      Result := True;
    except
//Returning false is fine
    end;
end;

//This function creates each of the rect elements, giving it an id attribute
//which links it to the associated annotation div, and then calls the
//individual write function for each item to fill the other attributes.
function TIMTAnnList.WriteRectsToDomElement(El: TDomElement;
  DomDoc: TDomDocument): Boolean;
var
i: integer;
RectEl: TDomElement;

begin
  Result := False;
  if El = nil then
    Exit;
  if Count > 0 then
    try
      for i := 0 to Count-1 do
        begin
          RectEl := TDomElement.Create(DomDoc, 'zone');
//New for 1.8: id is now one of the attributes it already has, so it's written there.
//          RectEl.SetAttribute('xml:id', IMTAreaPrefix + IntToStr(i));
          TIMTAnnotation(List[i]).WriteAttsToRectElement(RectEl, DomDoc);
          El.AppendChild(RectEl);
        end;

      Result := True;
    except
//Returning false is fine
    end;
end;

function TIMTAnnList.ReadFromDomElements(AnnWrapperEl, FacsEl: TDomElement;
                                         ClearFirst: Boolean): Boolean;
var
TotalRects, TotalDivs, i, j: integer;
CurrId: WideString;
CurrRect, CurrDiv: TDomElement;
CurrAnn: integer;
AttrPointer: WideString;

begin
  Result := False;
  try
    if ClearFirst then Empty;
    TotalRects := FacsEl.GetElementsByTagName('zone').Length;
    TotalDivs := AnnWrapperEl.GetElementsByTagName('div').Length;
    if TotalRects > 0 then
      for i := 0 to TotalRects-1 do
        begin
          CurrRect := TDomElement(FacsEl.GetElementsByTagName('zone').Item(i));
          CurrId := CurrRect.GetAttributeNormalizedValue('xml:id');
          CurrAnn := AddAnnotation;

          if Length(CurrId) > 0 then
            begin
  //New Ann reads from rect element
              TIMTAnnotation(List[CurrAnn]).ReadAttsFromRectElement(CurrRect);

  //Iterate through annotation divs to find matching div
              if TotalDivs > 0 then
                for j := 0 to TotalDivs-1 do
  //If found, Ann element reads data from that div
                  begin
                    CurrDiv := TDomElement(AnnWrapperEl.GetElementsByTagName('div').Item(j));
  //                  if CurrDiv.GetAttributeNormalizedValue('facs') = CurrId then
  //New for 1.8: strip off the hash in the @facs, and check for the @corresp attribute
                    AttrPointer := CurrDiv.GetAttributeNormalizedValue('facs');
                    if Length(AttrPointer) < 2 then
                      AttrPointer := CurrDiv.GetAttributeNormalizedValue('corresp');
                    if Length(AttrPointer) > 1 then
                      begin
                        if AttrPointer[1] = WideChar('#') then
                          AttrPointer := Copy(AttrPointer, 2, Length(AttrPointer) - 1);
                        if AttrPointer = CurrId then
                          begin
                            TIMTAnnotation(List[CurrAnn]).ReadFromDivElement(CurrDiv);
                            Break;
                          end;
                      end;
                  end;
            end;
        end;
    Result := True;
  except
//Returning false is enough
  end;
end;

function TIMTAnnList.SwapPositions(Ann1, Ann2: integer): Boolean;
begin
  Result := False; //default
  if not (IndexInRange(Ann1) and IndexInRange(Ann2)) then Exit;

  try
//Swap the items
    Exchange(Ann1, Ann2);
//If there are layers showing, reset their tags
    if TIMTAnnotation(List[Ann1]).fPositionedLayer <> nil then
      TPositionedLayer(TIMTAnnotation(List[Ann1]).fPositionedLayer).Tag := Ann1;

    if TIMTAnnotation(List[Ann2]).fPositionedLayer <> nil then
      TPositionedLayer(TIMTAnnotation(List[Ann2]).fPositionedLayer).Tag := Ann2;

    Result := True;
  except
//Just return false
  end;
end;

procedure TIMTAnnList.CategoryChanged(OldCatID, NewCatID: WideString);
var
i: integer;

begin
//Iterate through the list making changes and triggering repaints where needed
  if Count > 0 then
    for i := 0 to Count-1 do
      if CategoryID[i] = OldCatID then
        begin
          CategoryID[i] := NewCatID;
          if PositionedLayer[i] <> nil then
            TPositionedLayer(PositionedLayer[i]).Update;
        end;
end;

function TIMTAnnList.CloneAnnotation(SourceAnn, TargetAnn: integer): Boolean;
begin
  Result := False;
  try
    if IndexInRange(SourceAnn) then
      if IndexInRange(TargetAnn) then
        Result := TIMTAnnotation(List[SourceAnn]).CopySelf(TIMTAnnotation(List[TargetAnn]));
  except //returning false is OK
  end;
end;

constructor TIMTAnnList.Create(
  GetTranscriptionalProc: TGetTranscriptionalFromCatIDProc);
begin
  inherited Create;
  if Assigned(GetTranscriptionalProc) then
    fGetTranscriptionalFromCatIDProc := GetTranscriptionalProc
  else
    fGetTranscriptionalFromCatIDProc := nil;
end;

end.