customdrawn-cocoa: Starts implementing text measurement

git-svn-id: trunk@33917 -

lcl/interfaces/customdrawn/cocoagdiobjects.pas

@@ -97,6 +97,7 @@ type
     Size  : Integer;
     Style : TCocoaFontStyle;
     Antialiased: Boolean;
+    constructor CreateDefault;
   end;
 
   { TCocoaBitmap }
@@ -139,11 +140,57 @@ type
     property Height: Integer read FHeight;
   end;
 
+  { TCocoaTextLayout }
+
+  TCocoaTextLayout = class(TObject)
+  public
+    constructor Create; virtual; abstract;
+    procedure SetFont(AFont: TCocoaFont); virtual; abstract;
+    procedure SetText(UTF8Text: PChar; ByteSize: Integer); virtual; abstract;
+    function GetSize: TSize; virtual; abstract;
+
+    procedure Draw(cg: CGContextRef; X, Y: Integer; DX: PInteger); virtual; abstract;
+  end;
+  TCocoaTextLayoutClass = class of TCocoaTextLayout;
+
+  { TASTUITextLayout }
+
+  // legacy layout used for Mac OS X 10.4
+  TASTUITextLayout = class(TCocoaTextLayout)
+  private
+    fBuffer     : WideString;
+    fUTF8       : String;
+    FDX         : PIntegerArray;
+
+    FLayout     : ATSUTextLayout;
+    FStyle      : ATSUStyle;
+
+    FTextBefore : ATSUTextMeasurement;
+    FTextAfter  : ATSUTextMeasurement;
+    FAscent     : ATSUTextMeasurement;
+    FDescent    : ATSUTextMeasurement;
+
+    FValidSize  : Boolean;
+    procedure RecountSize;
+    procedure DoJustify(iLineRef: ATSULineRef; var Handled: Boolean);
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+    procedure SetFont(AFont: TCocoaFont); override;
+    procedure SetText(UTF8Text: PChar; ByteSize: Integer); override;
+    function GetSize: TSize; override;
+    procedure Draw(cg: CGContextRef; X, Y: Integer; DX: PInteger); override;
+  end;
+
+  { TCoreTextLayout }
+
+  //TCoreTextLayout = class(TCocoaTextLayout);
+
   { TCocoaContext }
 
   TCocoaContext = class(TObject)
   private
-    //fText    : TCocoaTextLayout;
+    fText    : TCocoaTextLayout;
     fBrush   : TCocoaBrush;
     fPen     : TCocoaPen;
     fFont    : TCocoaFont;
@@ -212,6 +259,11 @@ begin
   Result := ABitmap <> 0;
 end;
 
+constructor TCocoaFont.CreateDefault;
+begin
+  inherited Create({False});
+end;
+
 { TCocoaBitmap }
 
 type
@@ -363,6 +415,235 @@ begin
   end;
 end;
 
+{ TASTUITextLayout }
+
+function IntToFix(i: integer): Integer; inline;
+begin
+  Result:=i shl 16;
+end;
+
+function FixToInt(f: Integer): Integer; inline;
+begin
+  Result:=Round(Fix2X(F));
+end;
+
+procedure TASTUITextLayout.RecountSize;
+begin
+  ATSUGetUnjustifiedBounds(FLayout, kATSUFromTextBeginning, kATSUToTextEnd,
+    FTextBefore, FTextAfter, FAscent, FDescent);
+end;
+
+constructor TASTUITextLayout.Create;
+begin
+  // create text layout
+  ATSUCreateTextLayout(FLayout);
+  SetText(#0, 1);
+  ATSUSetTextLayoutRefCon(FLayout, URefCon(Self));
+
+  ATSUCreateStyle(FStyle);
+
+  // allow font substitution for exotic glyphs
+  ATSUSetTransientFontMatching(FLayout, True);
+end;
+
+destructor TASTUITextLayout.Destroy;
+begin
+  ATSUDisposeTextLayout(FLayout);
+  ATSUDisposeStyle(FStyle);
+  inherited Destroy;
+end;
+
+const
+  DefaultFont = 'Lucida Grande';
+  DefaultSize = 13;
+
+function FindATSUFontID(const FontName: String): ATSUFontID;
+var
+  fn  : String;
+begin
+  Result := 0;
+  if SysUtils.CompareText(FontName, 'default')=0 then fn:=DefaultFont else fn:=FontName;
+  if (fn <> '') then
+    ATSUFindFontFromName(@fn[1], Length(fn),
+        kFontFullName, kFontMacintoshPlatform, kFontRomanScript,
+        kFontEnglishLanguage, Result);
+end;
+
+procedure TASTUITextLayout.SetFont(AFont:TCocoaFont);
+var
+  Attr: ATSUAttributeTag;
+  M: ATSUTextMeasurement;
+  O: ATSStyleRenderingOptions;
+  B: Boolean;
+  S: ByteCount;
+  A: ATSUAttributeValuePtr;
+  ID: ATSUFontID;
+const
+  ATSStyleRenderingOption: array [Boolean] of ATSStyleRenderingOptions =
+    (kATSStyleNoAntiAliasing, kATSStyleApplyAntiAliasing);
+begin
+  if not Assigned(AFont) then Exit;
+
+  ID := FindATSUFontID(AFont.Name);
+
+  if ID <> 0 then
+  begin
+    Attr := kATSUFontTag;
+    A := @ID;
+    S := SizeOf(ID);
+    ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
+  end;
+
+  Attr := kATSUSizeTag;
+  M := IntToFix(Abs(AFont.Size));
+  A := @M;
+  S := SizeOf(M);
+  ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
+
+  S := SizeOf(B);
+  Attr := kATSUQDBoldfaceTag;
+  B := cfs_Bold in AFont.Style;
+  A := @B;
+  ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
+
+  Attr := kATSUQDItalicTag;
+  B := cfs_Italic in AFont.Style;
+  A := @B;
+  ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
+
+  Attr := kATSUQDUnderlineTag;
+  B := cfs_Underline in AFont.Style;
+  A := @B;
+  ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
+
+  Attr := kATSUStyleStrikeThroughTag;
+  B := cfs_Strikeout in AFont.Style;
+  A := @B;
+  ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
+
+  Attr := kATSUStyleRenderingOptionsTag;
+  O := ATSStyleRenderingOption[AFont.Antialiased];
+  A := @O;
+  S := SizeOf(O);
+  ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
+
+  FValidSize:=False;
+end;
+
+procedure TASTUITextLayout.SetText(UTF8Text: PChar; ByteSize: Integer);
+begin
+  if (ByteSize=length(fUTF8)) and (fUTF8<>'') and
+    (CompareChar(UTF8Text^, fUTF8[1], ByteSize)=0) then Exit; // same buffer, nothing to change!
+
+  SetLength(fUTF8, ByteSize);
+  if ByteSize>0 then
+    System.Move(UTF8Text^, fUTF8[1], ByteSize)
+  else
+    fUTF8:='';
+
+  fBuffer:=UTF8Decode(fUTF8);
+  if fBuffer='' then fBuffer:=#0;
+  ATSUSetTextPointerLocation(FLayout, @fBuffer[1], 0, length(fBuffer), length(fBuffer));
+  ATSUSetRunStyle(FLayout, FStyle, kATSUFromTextBeginning, kATSUToTextEnd);
+
+  FValidSize:=False;
+end;
+
+function TASTUITextLayout.GetSize:TSize;
+begin
+  if not FValidSize then RecountSize;
+  Result.cx := FixToInt(FTextAfter - FTextBefore);
+  Result.cy := FixToInt(FDescent + FAscent);
+end;
+
+var
+  ATSUDirectUPP : ATSUDirectLayoutOperationOverrideUPP = nil; //NewATSUDirectLayoutOperationOverrideUPP(@ATSUCallback)
+
+function ATSUCallback(iCurrentOperation: ATSULayoutOperationSelector; iLineRef: ATSULineRef; iRefCon: UInt32; iOperationCallbackParameterPtr: UnivPtr;
+  var oCallbackStatus: ATSULayoutOperationCallbackStatus ): OSStatus; {$ifdef DARWIN}mwpascal;{$endif}
+var
+  Buffer  : TASTUITextLayout;
+  Handled : Boolean;
+begin
+  Result := noErr;
+  Buffer := TASTUITextLayout(iRefCon);
+  oCallbackStatus:=kATSULayoutOperationCallbackStatusHandled;
+
+  if Assigned(Buffer) then
+    Buffer.DoJustify(iLineRef, Handled);
+end;
+
+procedure TASTUITextLayout.DoJustify(iLineRef: ATSULineRef; var Handled: Boolean);
+type
+	ATSLayoutRecord1 = packed record
+		glyphID: ATSGlyphRef;
+		flags: ATSGlyphInfoFlags;
+		originalOffset: ByteCount;
+		realPos: Fixed;
+	end;
+
+type
+  TATSLayoutRecordArray = array [Word] of ATSLayoutRecord1;
+  PATSLayoutRecordArray = ^TATSLayoutRecordArray;
+var
+  i, ofs  : Integer;
+  Layouts   : PATSLayoutRecordArray;
+  LayCount  : ItemCount;
+begin
+  if not Assigned(FDX) then Exit;
+  Laycount:=0;
+  ATSUDirectGetLayoutDataArrayPtrFromLineRef( iLineRef,
+    kATSUDirectDataLayoutRecordATSLayoutRecordVersion1, true, @Layouts, Laycount);
+  if Assigned(Layouts) and (Laycount>0) then
+  begin
+    ofs:=0;
+    for i:=0 to LayCount-1 do
+    begin
+      Layouts^[i].realPos:=Long2Fix(ofs);
+      inc(ofs, FDX^[i]);
+    end;
+  end;
+  ATSUDirectReleaseLayoutDataArrayPtr(iLineRef, kATSUDirectDataLayoutRecordATSLayoutRecordCurrent, @Layouts );
+  Handled:=True;
+end;
+
+
+procedure TASTUITextLayout.Draw(cg:CGContextRef;X,Y:Integer;DX:PInteger);
+var
+  MX, MY    : Integer;
+
+  Tag       : ATSUAttributeTag;
+  Size      : ByteCount;
+  Value     : ATSUAttributeValuePtr;
+  OverSpec  : ATSULayoutOperationOverrideSpecifier;
+begin
+  if not Assigned(cg) then Exit;
+  if not FValidSize then RecountSize;
+
+  MX:=0;
+  MY:=0;
+  Tag := kATSUCGContextTag;
+  Size := sizeOf(CGContextRef);
+  Value := @cg;
+  ATSUSetLayoutControls(FLayout, 1, @Tag, @Size, @Value);
+
+  Tag := kATSULayoutOperationOverrideTag;
+  Size := sizeof (ATSULayoutOperationOverrideSpecifier);
+  Value := @OverSpec;
+  FillChar(OverSpec, sizeof(OverSpec), 0);
+  if Assigned(Dx) then begin
+    FDX := PIntegerArray(Dx);
+    OverSpec.operationSelector := kATSULayoutOperationPostLayoutAdjustment;
+    if not Assigned(ATSUDirectUPP) then ATSUDirectUPP:=NewATSUDirectLayoutOperationOverrideUPP(@ATSUCallback);
+    OverSpec.overrideUPP := ATSUDirectUPP;
+  end else
+    FDX:=nil;
+  ATSUSetLayoutControls (FLayout, 1, @Tag, @Size, @Value);
+
+  ATSUDrawText(FLayout, kATSUFromTextBeginning, kATSUToTextEnd,
+    IntToFix(X)- FTextBefore + MX, IntToFix(Y) - FAscent + MY);
+end;
+
 { TCocoaContext }
 
 function TCocoaContext.CGContext:CGContextRef;
@@ -399,6 +680,9 @@ end;
 
 constructor TCocoaContext.Create;
 begin
+  FFont := TCocoaFont.CreateDefault;
+  FFont.AddRef;
+  FText := TASTUITextLayout.Create;
 end;
 
 destructor TCocoaContext.Destroy;
@@ -611,7 +895,7 @@ function TCocoaContext.GetTextExtentPoint(AStr: PChar; ACount: Integer;
 var
   LStr: String;
 begin
-  {Result := False;
+  Result := False;
   Size.cx := 0;
   Size.cy := 0;
 
@@ -623,7 +907,7 @@ begin
   fText.SetText(PChar(LStr), Length(LStr));
   Size := fText.getSize();
 
-  Result := True;}
+  Result := True;
 end;
 
 {------------------------------------------------------------------------------

lcl/interfaces/customdrawn/cocoaprivate.pas

@@ -416,6 +416,7 @@ begin
     UpdateControlLazImageAndCanvas(WindowHandle.Image,
       WindowHandle.Canvas, lWidth, lHeight, clfRGB24UpsideDown);
     DrawFormBackground(WindowHandle.Image, WindowHandle.Canvas);
+    WindowHandle.Canvas.NativeDC := PtrInt(Context);
 
     struct.hdc := HDC(WindowHandle.Canvas);
 

lcl/interfaces/customdrawn/customdrawnint.pas

@@ -121,6 +121,7 @@ type
     pool      : NSAutoreleasePool;
     NSApp     : NSApplication;
     delegate  : TCDAppDelegate;
+    ScreenBitmap: TCocoaBitmap;
     {$endif}
   public
     {$ifdef CD_X11}
@@ -151,7 +152,13 @@ type
     procedure BackendCreate;
     procedure BackendDestroy;
   public
+    // ScreenDC and Image for doing Canvas operations outside the Paint event
+    // and also for text drawing operations
     ScreenDC: TLazCanvas;
+    ScreenBitmapRawImage: TRawImage;
+    ScreenBitmapHeight: Integer;
+    ScreenBitmapWidth: Integer;
+
     constructor Create; override;
     destructor Destroy; override;
 

lcl/interfaces/customdrawn/customdrawnobject_cocoa.inc

@@ -103,6 +103,17 @@ procedure TCDWidgetSet.BackendCreate;
 begin
   {  Creates the AutoreleasePool }
   pool := NSAutoreleasePool(NSAutoreleasePool.alloc).init;
+
+  { Prepares the Native DC for the ScreenDC }
+
+  ScreenBitmapHeight := 100;
+  ScreenBitmapWidth := 100;
+  ScreenBitmapRawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(ScreenBitmapWidth, ScreenBitmapHeight);
+  ScreenBitmapRawImage.CreateData(True);
+  ScreenBitmap := TCocoaBitmap.Create(ScreenBitmapWidth, ScreenBitmapHeight,
+    32, 4, cbaDWord, cbtARGB, ScreenBitmapRawImage.Data);
+  ScreenDC.NativeDC := PtrInt(TCocoaContext.Create);
+  TCocoaContext(ScreenDC.NativeDC).ctx := NSGraphicsContext.graphicsContextWithBitmapImageRep(ScreenBitmap.imagerep);
 end;
 
 {------------------------------------------------------------------------------

lcl/interfaces/customdrawn/customdrawnwinapi.inc

@@ -6416,7 +6416,7 @@ begin
   else
     Result := False;
   end
-end;
+end;*)
 
 {------------------------------------------------------------------------------
   Function: TextOut
@@ -6428,29 +6428,12 @@ end;
   Returns:
 
  ------------------------------------------------------------------------------}
-function TQtWidgetSet.TextOut(DC: HDC; X,Y : Integer; Str : PChar; Count: Integer) : Boolean;
-var
-  WideStr: WideString;
+function TCDWidgetSet.TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean;
 begin
-  {$ifdef VerboseQtWinAPI}
-    WriteLn('[WinAPI TextOut]');
-  {$endif}
-
-  Result := False;
-
-  if not IsValidDC(DC) then Exit;
-
-  if Count >= 0 then
-    WideStr := GetUtf8String(Copy(Str, 1, Count))
-  else
-    WideStr := GetUtf8String(Str);
-
-  TQtDeviceContext(DC).drawText(X, Y, @WideStr);
-
-  Result := True;
+  Result:=ExtTextOut(DC, X, Y, 0, nil, Str, Count, nil);
 end;
 
-{------------------------------------------------------------------------------
+(*{------------------------------------------------------------------------------
   Method:  UpdateWindow
   Params:  Handle
   Returns:

lcl/interfaces/customdrawn/customdrawnwinapi_android.inc

@@ -6398,36 +6398,6 @@ begin
   end
 end;*)
 
-{------------------------------------------------------------------------------
-  Function: TextOut
-  Params: DC:
-          X:
-          Y:
-          Str:
-          Count:
-  Returns:
-
- ------------------------------------------------------------------------------}
-function TCDWidgetSet.TextOut(DC: HDC; X,Y : Integer; Str : PChar; Count: Integer) : Boolean;
-begin
-  {$ifdef VerboseQtWinAPI}
-    DebugLn('[WinAPI TextOut]');
-  {$endif}
-
-  Result := False;
-
-  if not IsValidDC(DC) then Exit;
-
-{  if Count >= 0 then
-    WideStr := GetUtf8String(Copy(Str, 1, Count))
-  else
-    WideStr := GetUtf8String(Str);
-
-  TQtDeviceContext(DC).drawText(X, Y, @WideStr);
-
-  Result := True;}
-end;
-
 (*{------------------------------------------------------------------------------
   Method:  UpdateWindow
   Params:  Handle

lcl/interfaces/customdrawn/customdrawnwinapi_cocoa.inc

@@ -365,6 +365,9 @@ function TCDWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint;
 var
   ctx : TCocoaContext;
 begin
+  {$ifdef VerboseCDText}
+    DebugLn(Format('[WinAPI ExtTextOut] DC=%x X=%d Y=%d Str=%s Count=%d', [DC, X, Y, StrPas(Str), Count]));
+  {$endif}
 {  ctx:=CheckDC(DC);
   Result:=Assigned(ctx);
   if not Assigned(ctx) then Exit;
@@ -918,16 +921,22 @@ end;*)
  ------------------------------------------------------------------------------}
 function TCDWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean;
 var
-  ctx : TCocoaContext;
+  ctx: TCocoaContext;
+  lazdc: TLazCanvas;
 begin
-  {$IFDEF VerboseCDWinAPI}
+  {$IFDEF VerboseCDText}
     DebugLn('[TCDWidgetSet.GetTextExtentPoint] DC: %x Str: %s Count: %d', [DC, Str, Count]);
   {$ENDIF}
-{  ctx:=CheckDC(DC);
-  Result:=Assigned(ctx);
-  if not Assigned(ctx) then Exit(False);
-  Result := ctx.GetTextExtentPoint(Str, Count, Size);}
-  {$IFDEF VerboseCDWinAPI}
+
+  if not IsValidDC(DC) then Exit;
+
+  lazdc := TLazCanvas(DC);
+  if lazdc.NativeDC = 0 then Exit;
+  ctx := TCocoaContext(lazdc.NativeDC);
+
+  Result := ctx.GetTextExtentPoint(Str, Count, Size);
+
+  {$IFDEF VerboseCDText}
     DebugLn('[TCDWidgetSet.GetTextExtentPoint] Size: %d,%d', [Size.cx, Size.cy]);
   {$ENDIF}
 end;
@@ -943,29 +952,29 @@ end;
  ------------------------------------------------------------------------------}
 function TCDWidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;
 var
-  ctx : TCocoaContext;
+  ctx: TCocoaContext;
+  lazdc: TLazCanvas;
 begin
   Result := False;
 
-  {$IFDEF VerboseCDWinAPI}
+  {$IFDEF VerboseCDText}
     DebugLn('TCDWidgetSet.GetTextMetrics DC: ' + DbgS(DC));
   {$ENDIF}
 
-{  ctx:=CheckDC(DC);
-  if not Assigned(ctx) then Exit(False);
-  Result := ctx.GetTextMetrics(TM);}
+  if not IsValidDC(DC) then Exit;
 
-  {$IFDEF VerboseCDWinAPI}
+  lazdc := TLazCanvas(DC);
+  if lazdc.NativeDC = 0 then Exit;
+  ctx := TCocoaContext(lazdc.NativeDC);
+
+  Result := ctx.GetTextMetrics(TM);
+
+  {$IFDEF VerboseCDText}
     DebugLn('TCDWidgetSet.GetTextMetrics Result: ' + DbgS(Result) +
       ' TextMetric: ' + DbgS(TM));
   {$ENDIF}
 end;
 
-function TCDWidgetSet.TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean;
-begin
-  //Result:=ExtTextOut(DC, X, Y, 0, nil, Str, Count, nil);
-end;
-
 (*function TCocoaWidgetSet.SaveDC(DC: HDC): Integer;
 var
   ctx : TCocoaContext;

lcl/interfaces/customdrawn/customdrawnwinapi_x11.inc

@@ -6359,38 +6359,6 @@ begin
   end
 end;*)
 
-{------------------------------------------------------------------------------
-  Function: TextOut
-  Params: DC:
-          X:
-          Y:
-          Str:
-          Count:
-  Returns:
-
- ------------------------------------------------------------------------------}
-function TCDWidgetSet.TextOut(DC: HDC; X,Y : Integer; Str : PChar; Count: Integer) : Boolean;
-//var
-//  WideStr: WideString;
-begin
-//  {$ifdef VerboseQtWinAPI}
-//    WriteLn('[WinAPI TextOut]');
-//  {$endif}
-
-  Result := False;
-{
-  if not IsValidDC(DC) then Exit;
-
-  if Count >= 0 then
-    WideStr := GetUtf8String(Copy(Str, 1, Count))
-  else
-    WideStr := GetUtf8String(Str);
-
-  TQtDeviceContext(DC).drawText(X, Y, @WideStr);
-
-  Result := True;}
-end;
-
 (*{------------------------------------------------------------------------------
   Method:  UpdateWindow
   Params:  Handle

lcl/lazcanvas.pas

@@ -83,6 +83,7 @@ type
     procedure DoLine (x1,y1,x2,y2:integer); override;
   public
     HasNoImage: Boolean;
+    NativeDC: PtrInt; // Utilized by LCL-CustomDrawn
     constructor create (AnImage : TFPCustomImage);
     destructor destroy; override;
     procedure SetLazClipRegion(ARegion: TLazRegion);