1{
2                     -------------------------------------
3                     carbondebug.pp  -  graphic dump utils
4                     -------------------------------------
5
6 @created(Mon Jun 18th WET 2007)
7 @lastmod($Date$)
8 @author(Marc Weustink <marc@@lazarus.dommelstein.net>)
9
10 This unit contains utility functions to show the contents of graphics
11
12 *****************************************************************************
13  This file is part of the Lazarus Component Library (LCL)
14
15  See the file COPYING.modifiedLGPL.txt, included in this distribution,
16  for details about the license.
17 *****************************************************************************
18}
19
20unit CarbonDebug;
21
22{$mode objfpc}{$H+}
23
24interface
25
26uses
27  MacOSAll,
28  sysutils, CarbonUtils;
29
30procedure DbgDumpImage(AImage: CGImageRef; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1);
31procedure DbgDumpLayer(ALayer: CGLayerRef; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1);
32
33implementation
34
35type
36  TDbgDumpKind = (dkImage, dkLayer);
37
38  PDbgDumpInfo = ^TDbgDumpInfo;
39  TDbgDumpInfo = record
40    Width, Height: Integer;
41    OrgWidth, OrgHeight: Integer;
42    Control: ControlRef;
43    Text: String;
44    case Kind: TDbgDumpKind of
45      dkImage: (Image: CGImageRef);
46      dkLayer: (Layer: CGLayerRef);
47  end;
48
49function DbgWindowDraw(ANextHandler: EventHandlerCallRef;
50                  AEvent: EventRef;
51                  AInfo: PDbgDumpInfo): OSStatus; mwpascal;
52var
53  bounds, R: CGRect;
54  context: CGContextRef;
55  status: OSStatus;
56begin
57  Result := CallNextEventHandler(ANextHandler, AEvent);
58
59  HIViewGetBounds(AInfo^.Control, bounds{%H-});
60
61  status := GetEventParameter(AEvent, kEventParamCGContextRef, typeCGContextRef, nil, SizeOf(context), nil, @Context);
62  if status = 0 then ;
63
64  CGContextSetRGBFillColor(context, 0, 1, 0, 0.3);
65  CGContextFillRect(context, bounds);
66  CGContextScaleCTM(context, 1, -1);
67
68  R := CGRectMake(2, -15, AInfo^.Width, -AInfo^.Height);
69  case AInfo^.Kind of
70    dkImage: begin
71      if AInfo^.Image <> nil
72      then begin
73        if CGImageIsMask(AInfo^.Image) <> 0
74        then begin
75          CGContextSaveGState(context);
76          CGContextSetRGBFillColor(context, 0, 0, 0, 1);
77          CGContextClipToMask(context, R, AInfo^.Image);
78          CGContextFillRect(context, R);
79          CGContextRestoreGState(context);
80        end
81        else begin
82          CGContextDrawImage(Context, R, AInfo^.Image);
83        end;
84      end;
85    end;
86    dkLayer: begin
87      CGContextDrawLayerInRect(Context, R, AInfo^.Layer);
88    end;
89  end;
90
91  CGContextSelectFont(context, Pointer(PChar('Helvetica')), 10, kCGEncodingMacRoman);
92//  CGContextSetTextDrawingMode (context, kCGTextFillStroke);
93  CGContextSetTextDrawingMode (context, kCGTextFill);
94  CGContextSetRGBFillColor(context, 0, 0, 0, 1);
95  CGContextSetRGBStrokeColor(context, 0, 0, 0, 1);
96
97  CGContextShowTextAtPoint(context, 2, -12, Pointer(PChar(AInfo^.Text)), Length(AInfo^.Text));
98end;
99
100function DbgWindowClosed(ANextHandler: EventHandlerCallRef; AEvent: EventRef;
101  AInfo: PDbgDumpInfo): OSStatus; mwpascal;
102begin
103  Result := CallNextEventHandler(ANextHandler, AEvent);
104  case AInfo^.Kind of
105    dkImage: CGImageRelease(AInfo^.Image);
106    dkLayer: CGLayerRelease(AInfo^.Layer);
107  end;
108  Dispose(AInfo);
109end;
110
111
112procedure DbgCreateWindow(AInfo: PDbgDumpInfo; const ATitle: String);
113var
114  R: Rect;
115  w: WindowRef;
116  DbgWindowDrawUPP, DbgWindowClosedUPP: EventHandlerUPP;
117  Spec: EventTypeSpec;
118begin
119  R.Top := 50; R.Left := 0;
120  if AInfo^.Width < 50 then R.Right := 50 else R.Right := AInfo^.Width;
121  if AInfo^.Height < 25 then R.Bottom := 25 else R.Bottom := AInfo^.Height;
122  Inc(R.Bottom, R.Top + 15);
123  Inc(R.Right, R.Left + 2);
124
125  W := nil;
126  CreateNewWindow(
127    kUtilityWindowClass,
128    kWindowCompositingAttribute or
129    kWindowStandardDocumentAttributes or
130//    kWindowLiveResizeAttribute or
131    kWindowStandardHandlerAttribute or kWindowFrameworkScaledAttribute,
132    R, W
133  );
134  if W = nil then Exit;
135
136  case AInfo^.Kind of
137    dkImage: CGImageRetain(AInfo^.Image);
138    dkLayer: CGLayerRetain(AInfo^.Layer);
139  end;
140  AInfo^.Text := ATitle;
141
142  DbgWindowClosedUPP := NewEventHandlerUPP(EventHandlerProcPtr(@DbgWindowClosed));
143  Spec := MakeEventSpec(kEventClassWindow, kEventWindowClosed);
144  InstallWindowEventHandler(W, DbgWindowClosedUPP, 1, @Spec, AInfo, nil);
145
146  AInfo^.Control := nil;
147  GetRootControl(W, AInfo^.Control);
148
149  DbgWindowDrawUPP := NewEventHandlerUPP(EventHandlerProcPtr(@DbgWindowDraw));
150  Spec := MakeEventSpec(kEventClassControl, kEventControlDraw);
151  if AInfo^.Control <> nil
152  then InstallControlEventHandler(AInfo^.Control, DbgWindowDrawUPP, 1, @Spec, AInfo, nil);
153
154  ShowWindow(W);
155end;
156
157procedure DbgDumpImage(AImage: CGImageRef; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1);
158var
159  Info: PDbgDumpInfo;
160  h,w,bpp: Integer;
161begin
162  New(Info);
163
164  if (AImage = nil)
165  then begin
166    w := 0; h:= 0; bpp := 0;
167    if AWidth = -1 then AWidth := 0;
168    if AHeight = -1 then AHeight := 0;
169  end
170  else begin
171    w := CGImageGetWidth(AImage);
172    h := CGImageGetHeight(AImage);
173    bpp := CGImageGetBitsPerPixel(AImage);
174    if AWidth = -1 then AWidth := W;
175    if AHeight = -1 then AHeight := H;
176  end;
177
178  Info^.Kind := dkImage;
179  Info^.Image := AImage;
180  Info^.Width := AWidth;
181  Info^.Height := AHeight;
182  Info^.OrgWidth := w;
183  Info^.OrgHeight := h;
184
185  ATitle := ATitle + Format(' (Image: %p W:%d H:%d bpp:%d)', [AImage, w, h, bpp]);
186  DbgCreateWindow(Info, ATitle);
187end;
188
189procedure DbgDumpLayer(ALayer: CGLayerRef; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1);
190var
191  Info: PDbgDumpInfo;
192  S: CGSize;
193begin
194  New(Info);
195
196  if (ALayer = nil)
197  then begin
198    S.height := 0; s.width := 0;
199    if AWidth = -1 then AWidth := 0;
200    if AHeight = -1 then AHeight := 0;
201  end
202  else begin
203    S := CGLayerGetSize(ALayer);
204    if AWidth = -1 then AWidth := Round(S.width);
205    if AHeight = -1 then AHeight := Round(S.height);
206  end;
207
208  Info^.Kind := dkLayer;
209  Info^.Layer := ALayer;
210  Info^.Width := AWidth;
211  Info^.Height := AHeight;
212  Info^.OrgWidth := Round(S.width);
213  Info^.OrgHeight := Round(S.height);
214
215  ATitle := ATitle + Format(' (Layer: %p W:%f H:%f)', [ALayer, S.width, s.height]);
216  DbgCreateWindow(Info, ATitle);
217end;
218
219
220end.
221