freetype1/pascal/test/zonetv.pas

   1 {****************************************************************************}
   2 {*                                                                          *}
   3 {*  ZoneTV.PAS                                                              *}
   4 {*                                                                          *}
   5 {*  This unit implements a simple TrueType zone points viewer for the       *}
   6 {*  FREETYPE project debugger.                                              *}
   7 {*                                                                          *}
   8 {****************************************************************************}
   9
  10 Unit ZoneTV;
  11
  12 interface
  13
  14 uses Objects, Views, Drivers, FreeType, TTTypes, TTTables, TTObjs, TTDebug;
  15
  16 {$I DEBUGGER.INC}
  17
  18 type
  19
  20   { TZoneViewer }
  21
  22   { This TView is a simple point array viewer }
  23
  24   PZoneViewer = ^TZoneViewer;
  25   TZoneViewer = object( TListViewer )
  26
  27                   constructor Init( var Bounds : TRect;
  28                                     AZone      : PGlyph_Zone );
  29
  30                   procedure Draw; virtual;
  31                   procedure HandleEvent( var Event : TEvent  ); virtual;
  32
  33                 private
  34                   Zone : PGlyph_Zone; { Pointer to the zone being displayed }
  35                   Save : TGlyph_Zone; { A copy of the zone to highlight     }
  36                                       { changes                             }
  37                   procedure Copy_Zone;
  38
  39                 end;
  40
  41   { TCodeWindow }
  42
  43   PZoneWindow = ^TZoneWindow;
  44   TZoneWindow = object( TWindow )
  45                   ZoneView : PZoneViewer;
  46                   constructor Init( var Bounds : TRect;
  47                                     AZone      : PGlyph_Zone );
  48                 end;
  49
  50 implementation
  51
  52 { TZoneViewer }
  53
  54 constructor TZoneViewer.Init;
  55 var
  56   n : Int;
  57 begin
  58   inherited Init( Bounds, 1, nil, nil );
  59
  60   GrowMode  := gfGrowHiX or gfGrowHiY;
  61   DragMode  := dmDragGrow or dmLimitLoX or dmLimitLoY;
  62   Options   := Options or ofSelectable;
  63   EventMask := EventMask or evWave;
  64
  65   Zone := AZone;
  66
  67   GetMem( Save.org,   zone^.n_points*2*sizeof(Long) );
  68   GetMem( Save.cur,   zone^.n_points*2*sizeof(Long) );
  69   GetMem( Save.flags, zone^.n_points*sizeof(Byte) );
  70
  71   Save.n_points   := Zone^.n_points;
  72   Save.n_contours := Zone^.n_contours;
  73
  74   Copy_Zone;
  75
  76   SetRange( Save.n_points );
  77 end;
  78
  79
  80 procedure TZoneViewer.Copy_Zone;
  81 var
  82   n : Int;
  83 begin
  84   n := 2*zone^.n_points * sizeof(Long);
  85
  86   (* Note that we save also the original coordinates, as we're not sure *)
  87   (* that the debugger is debugged !                                    *)
  88
  89   move( Zone^.org^, Save.org^, n );
  90   move( Zone^.cur^, Save.cur^, n );
  91   move( Zone^.flags^, Save.flags^, zone^.n_points );
  92 end;
  93
  94
  95 procedure TZoneViewer.HandleEvent( var Event : TEvent );
  96 var
  97   Limits     : TRect;
  98   Mini, Maxi : Objects.TPoint;
  99 begin
 100
 101   inherited HandleEvent(Event);
 102
 103   Case Event.What of
 104
 105     evWave : case Event.Command of
 106
 107                cmNewExecution : Copy_Zone;
 108
 109                cmRefocus : DrawView;
 110
 111               end;
 112
 113     evCommand : case Event.Command of
 114
 115                  cmResize: begin
 116                              Owner^.GetExtent(Limits);
 117                              SizeLimits( Mini, Maxi );
 118                              DragView(Event, DragMode, Limits, Mini, Maxi );
 119                              ClearEvent(Event);
 120                            end;
 121                 end;
 122   end;
 123 end;
 124
 125
 126 procedure TZoneViewer.Draw;
 127 const
 128   Colors : array[0..3] of byte
 129          = ($30,$3F,$0B,$0E);
 130   Touchs : array[0..3] of Char
 131          = (' ','x','y','b');
 132   OnOff  : array[0..1] of Char
 133          = (' ',':');
 134 var
 135   I, J, Item : Int;
 136   B          : TDrawBuffer;
 137   S          : String;
 138   Indent     : Int;
 139   Ligne      : Int;
 140
 141   Changed : Boolean;
 142
 143   Back_Color,
 144   Color       : word;
 145
 146   On_BP : boolean;
 147   BP    : PBreakPoint;
 148
 149 begin
 150
 151   if HScrollBar <> nil then Indent := HScrollBar^.Value
 152                        else Indent := 0;
 153
 154   with Save do
 155   begin
 156
 157     for I := 0 to Self.Size.Y-1 do
 158     begin
 159
 160       MoveChar( B, ' ', Colors[0], Self.Size.X );
 161
 162       Item := TopItem + I;
 163
 164       if (Range > 0) and
 165        ( Focused = Item ) then Back_Color := 2
 166                           else Back_Color := 0;
 167
 168       if Item < n_points then
 169         begin
 170
 171           Color := Back_Color;
 172           if ( flags^[item] <> Zone^.flags^[item] ) then inc( Color );
 173
 174           S    := Hex16( Item ) + ':  ';
 175           S[1] := OnOff[Zone^.flags^[item] and 1];
 176           S[7] := Touchs[(Zone^.flags^[item] and TT_Flag_Touched_Both) shr 1];
 177
 178           MoveStr( B, S, Colors[Color] );
 179
 180           Color := Back_Color;
 181           if ( org^[item].x <> Zone^.org^[item].x ) then inc( Color );
 182
 183           MoveStr ( B[8], Hex32( Zone^.org^[item].x ), Colors[Color] );
 184           MoveChar( B[16], ',', Colors[0], 1 );
 185
 186           Color := Back_Color;
 187           if ( org^[item].y <> Zone^.org^[item].y ) then inc( Color );
 188
 189           MoveStr( B[17], Hex32( Zone^.org^[item].y ), Colors[Color] );
 190           MoveStr( B[25], ' : ', Colors[0] );
 191
 192           Color := Back_Color;
 193           if ( cur^[item].x <> Zone^.cur^[item].x ) then inc( Color );
 194
 195           MoveStr ( B[28], Hex32( Zone^.cur^[item].x ), Colors[Color] );
 196           MoveChar( B[36], ',', Colors[0], 1 );
 197
 198           Color := Back_Color;
 199           if ( cur^[item].y <> Zone^.cur^[item].y ) then inc( Color );
 200
 201           MoveStr( B[37], Hex32( Zone^.cur^[item].y ), Colors[Color] );
 202
 203         end;
 204
 205       WriteLine( 0, I, Self.Size.X, 1, B );
 206     end;
 207   end;
 208 end;
 209
 210 { TZoneWindow }
 211
 212 constructor TZoneWindow.Init;
 213 begin
 214   inherited Init( Bounds,'Zone',wnNoNumber );
 215   GetExtent( Bounds );
 216   Bounds.Grow(-1,-1);
 217   New( ZoneView, Init( Bounds, AZone ) );
 218   Insert( ZoneView );
 219 end;
 220
 221 end.
 222