unit ATSynEdit_Carets; {$mode objfpc}{$H+} interface uses Classes, SysUtils, ATStringProc; type TATPosRelation = (cRelateBefore, cRelateInside, cRelateAfter); procedure SwapInt(var n1, n2: integer); function IsPosSorted(X1, Y1, X2, Y2: integer; AllowEq: boolean): boolean; function IsPosInRange(X, Y, X1, Y1, X2, Y2: integer): TATPosRelation; type { TATCaretItem } TATCaretItem = class public PosX, PosY, //caret blinking pos EndX, EndY: integer; //end of selection or -1 CoordX, CoordY: integer; //screen coords CoordColumn: integer; //saved CoordX to use in keys Up/Down cmd procedure SelectToPoint(AX, AY: integer); procedure GetRange(out AX1, AY1, AX2, AY2: integer; out ASel: boolean); procedure GetSelLines(out AFrom, ATo: integer; AllowNoSel: boolean=false); end; type TATCaretEdge = ( cEdgeTop, cEdgeBottom, cEdgeLeft, cEdgeRight ); type { TATCarets } TATCarets = class private FList: TList; FManyAllowed: boolean; FOneLine: boolean; function GetItem(N: integer): TATCaretItem; procedure DeleteDups; function IsJoinNeeded(N1, N2: integer; out OutPosX, OutPosY, OutEndX, OutEndY: integer): boolean; public constructor Create; virtual; destructor Destroy; override; procedure Clear; procedure Delete(N: integer); function Count: integer; function IsIndexValid(N: integer): boolean; property Items[N: integer]: TATCaretItem read GetItem; default; procedure Add(APosX, APosY: integer); procedure Add(XFrom, YFrom, XTo, YTo: integer); procedure Sort; procedure Assign(Obj: TATCarets); function IndexOfPosXY(APosX, APosY: integer; AUseEndXY: boolean= false): integer; function IndexOfPosYAvg(APosY: integer): integer; function IndexOfLeftRight(ALeft: boolean): integer; function IsLineListed(APosY: integer): boolean; function IsSelection: boolean; function IsPosSelected(AX, AY: integer): boolean; function CaretAtEdge(AEdge: TATCaretEdge): TPoint; function DebugText: string; property ManyAllowed: boolean read FManyAllowed write FManyAllowed; property OneLine: boolean read FOneLine write FOneLine; function SaveToArray: TATPointArray; procedure LoadFromArray(const L: TATPointArray); procedure UpdateColumnCoord(ASaveColumn: boolean); procedure UpdateIncorrectPositions(AMaxLine: integer); end; implementation uses Math{%H-}; function IsPosSorted(X1, Y1, X2, Y2: integer; AllowEq: boolean): boolean; begin if Y1<>Y2 then Result:= Y10) then Dec(ATo); end; procedure TATCaretItem.SelectToPoint(AX, AY: integer); begin if EndX<0 then EndX:= PosX; if EndY<0 then EndY:= PosY; PosX:= AX; PosY:= AY; end; { TATCarets } function TATCarets.GetItem(N: integer): TATCaretItem; begin if IsIndexValid(N) then Result:= TATCaretItem(FList[N]) else Result:= nil; end; constructor TATCarets.Create; begin inherited; FList:= TList.Create; FManyAllowed:= true; FOneLine:= false; end; destructor TATCarets.Destroy; begin Clear; FreeAndNil(FList); inherited; end; procedure TATCarets.Clear; var i: integer; begin for i:= FList.Count-1 downto 0 do Delete(i); end; procedure TATCarets.Delete(N: integer); begin if IsIndexValid(N) then begin TObject(FList[N]).Free; FList.Delete(N); end; end; function TATCarets.Count: integer; begin Result:= FList.Count; end; function TATCarets.IsIndexValid(N: integer): boolean; begin Result:= (N>=0) and (N=1) then Exit; if FOneLine then APosY:= 0; Item:= TATCaretItem.Create; Item.PosX:= APosX; Item.PosY:= APosY; Item.EndX:= -1; Item.EndY:= -1; FList.Add(Item); end; function _ListCaretsCompare(Item1, Item2: Pointer): Integer; var Obj1, Obj2: TATCaretItem; begin Obj1:= TATCaretItem(Item1); Obj2:= TATCaretItem(Item2); Result:= Obj1.PosY-Obj2.PosY; if Result=0 then Result:= Obj1.PosX-Obj2.PosX; end; procedure TATCarets.Sort; begin FList.Sort(@_ListCaretsCompare); DeleteDups; end; procedure TATCarets.DeleteDups; var i: integer; Item1, Item2: TATCaretItem; OutPosX, OutPosY, OutEndX, OutEndY: integer; begin for i:= Count-1 downto 1 do begin Item1:= GetItem(i); Item2:= GetItem(i-1); if (Item1.PosY=Item2.PosY) and (Item1.PosX=Item2.PosX) then Delete(i); if IsJoinNeeded(i, i-1, OutPosX, OutPosY, OutEndX, OutEndY) then begin Delete(i); Item2.PosX:= OutPosX; Item2.PosY:= OutPosY; Item2.EndX:= OutEndX; Item2.EndY:= OutEndY; end; end; end; procedure TATCarets.Assign(Obj: TATCarets); var i: integer; begin Clear; for i:= 0 to Obj.Count-1 do begin Add(0, 0); with Items[Count-1] do begin PosX:= Obj[i].PosX; PosY:= Obj[i].PosY; EndX:= Obj[i].EndX; EndY:= Obj[i].EndY; end; end; end; function TATCarets.IndexOfPosXY(APosX, APosY: integer; AUseEndXY: boolean = false): integer; var iStart, i: integer; Item: TATCaretItem; XUse, YUse: integer; begin Result:= -1; iStart:= 0; //todo--fix for case called from TimerScrollTick, dont work for cScrollUp //iStart:= IndexOfPosYAvg(APosY); //if iStart<0 then Exit; for i:= iStart to Count-1 do begin Item:= Items[i]; if AUseEndXY and (Item.EndY>=0) then begin XUse:= Item.EndX; YUse:= Item.EndY; end else begin XUse:= Item.PosX; YUse:= Item.PosY; end; if (YUse>APosY) then Break; if (XUse=APosX) and (YUse=APosY) then begin Result:= i; Break end; end; end; //todo-- binary search function TATCarets.IndexOfPosYAvg(APosY: integer): integer; var i: integer; begin Result:= -1; for i:= 0 to FList.Count-1 do if TATCaretItem(FList[i]).PosY>=APosY then begin Result:= i; Exit end; end; function TATCarets.IndexOfLeftRight(ALeft: boolean): integer; var Item: TATCaretItem; i, NPos: integer; Upd: boolean; begin Result:= -1; if Count>0 then NPos:= Items[0].PosX; for i:= 0 to Count-1 do begin Item:= Items[i]; if ALeft then Upd:= Item.PosX<=NPos else Upd:= Item.PosX>=NPos; if Upd then begin Result:= i; NPos:= Item.PosX; end; end; end; function TATCarets.IsLineListed(APosY: integer): boolean; var i: integer; Item: TATCaretItem; begin Result:= false; for i:= 0 to FList.Count-1 do begin Item:= TATCaretItem(FList[i]); if Item.PosY=APosY then begin Result:= true; Exit end; end; end; function TATCarets.IsSelection: boolean; var Item: TATCaretItem; i: integer; begin Result:= false; for i:= 0 to Count-1 do begin Item:= Items[i]; if (Item.EndX<0) or (Item.EndY<0) then Continue; if (Item.PosX<>Item.EndX) or (Item.PosY<>Item.EndY) then begin Result:= true; Exit end; end; end; function TATCarets.IsPosSelected(AX, AY: integer): boolean; var X1, Y1, X2, Y2: integer; bSel: boolean; i: integer; begin Result:= false; for i:= 0 to Count-1 do begin Items[i].GetRange(X1, Y1, X2, Y2, bSel); if not bSel then Continue; //carets sorted: can stop if Y1>AY then Exit; if IsPosInRange(AX, AY, X1, Y1, X2, Y2)=cRelateInside then begin Result:= true; Break end; end; end; function TATCarets.CaretAtEdge(AEdge: TATCaretEdge): TPoint; var N: integer; begin Result:= Point(0, 0); case AEdge of cEdgeTop: N:= 0; cEdgeBottom: N:= Count-1; cEdgeLeft: N:= IndexOfLeftRight(true); cEdgeRight: N:= IndexOfLeftRight(false); end; if IsIndexValid(N) then with Items[N] do Result:= Point(PosX, PosY); end; function TATCarets.IsJoinNeeded(N1, N2: integer; out OutPosX, OutPosY, OutEndX, OutEndY: integer): boolean; var Item1, Item2: TATCaretItem; XMin1, XMin2, YMin1, YMin2, XMax1, XMax2, YMax1, YMax2: integer; Sel1, Sel2: boolean; begin Result:= false; if not IsIndexValid(N1) then Exit; if not IsIndexValid(N2) then Exit; Item1:= Items[N1]; Item2:= Items[N2]; Item1.GetRange(XMin1, YMin1, XMax1, YMax1, Sel1); Item2.GetRange(XMin2, YMin2, XMax2, YMax2, Sel2); //caret1 w/out selection inside caret2 selection? if not Sel1 and not Sel2 then Exit; if not Sel1 then begin Result:= IsPosInRange(Item1.PosX, Item1.PosY, XMin2, YMin2, XMax2, YMax2)=cRelateInside; if Result then begin OutPosX:= Item2.PosX; OutPosY:= Item2.PosY; OutEndX:= Item2.EndX; OutEndY:= Item2.EndY; end; Exit end; if not Sel2 then begin Result:= IsPosInRange(Item2.PosX, Item2.PosY, XMin1, YMin1, XMax1, YMax1)=cRelateInside; if Result then begin OutPosX:= Item1.PosX; OutPosY:= Item1.PosY; OutEndX:= Item1.EndX; OutEndY:= Item1.EndY; end; Exit end; //calc join-result, needed only for Result=true //minimal point GetPositionMinOrMax(XMin1, YMin1, XMin2, YMin2, false, OutPosX, OutPosY); //maximal point GetPositionMinOrMax(XMax1, YMax1, XMax2, YMax2, true, OutEndX, OutEndY); //swap points? if not IsPosSorted(Item1.PosX, Item1.PosY, Item1.EndX, Item1.EndY, false) then begin SwapInt(OutPosX, OutEndX); SwapInt(OutPosY, OutEndY); end; if IsPosSorted(XMax1, YMax1, XMin2, YMin2, false) then Exit; //ranges not overlap [x1, y1]...[x2, y2] if IsPosSorted(XMax2, YMax2, XMin1, YMin1, false) then Exit; //ranges not overlap [x2, y2]...[x1, y1] Result:= true; //ranges overlap end; function TATCarets.DebugText: string; var i: integer; begin Result:= ''; for i:= 0 to Count-1 do with Items[i] do Result:= Result+Format('caret[%d] pos %d:%d end %d:%d', [ i, posy, posx, endy, endx ])+sLineBreak; end; function TATCarets.SaveToArray: TATPointArray; var Item: TATCaretItem; i: integer; begin SetLength(Result, Count*2); for i:= 0 to Count-1 do begin Item:= Items[i]; Result[i*2].X:= Item.PosX; Result[i*2].Y:= Item.PosY; Result[i*2+1].X:= Item.EndX; Result[i*2+1].Y:= Item.EndY; end; end; procedure TATCarets.LoadFromArray(const L: TATPointArray); var i: integer; Item: TATCaretItem; begin Clear; for i:= 0 to Length(L) div 2 - 1 do begin Add(0, 0); Item:= Items[Count-1]; Item.PosX:= L[i*2].X; Item.PosY:= L[i*2].Y; Item.EndX:= L[i*2+1].X; Item.EndY:= L[i*2+1].Y; end; end; procedure TATCarets.Add(XFrom, YFrom, XTo, YTo: integer); begin if (XFrom=XTo) and (YFrom=YTo) then Exit; Add(0, 0); with Items[Count-1] do begin PosX:= XTo; PosY:= YTo; EndX:= XFrom; EndY:= YFrom; end; end; procedure TATCarets.UpdateColumnCoord(ASaveColumn: boolean); var i: integer; Caret: TATCaretItem; begin for i:= 0 to Count-1 do begin Caret:= Items[i]; if ASaveColumn then begin if Caret.CoordColumn=0 then Caret.CoordColumn:= Caret.CoordX; end else Caret.CoordColumn:= 0 end; end; procedure TATCarets.UpdateIncorrectPositions(AMaxLine: integer); var i: integer; Caret: TATCaretItem; begin for i:= 0 to Count-1 do begin Caret:= Items[i]; if Caret.PosY>AMaxLine then Caret.PosY:= AMaxLine; if Caret.EndY>AMaxLine then Caret.EndY:= AMaxLine; end; end; end.