1 (*******************************************************************
2  *
3  *  TTRaster.Pas                                              v 1.2
4  *
5  *  The FreeType glyph rasterizer.
6  *
7  *  Copyright 1996 David Turner, Robert Wilhelm and Werner Lemberg
8  *
9  *  This file is part of the FreeType project, and may only be used
10  *  modified and distributed under the terms of the FreeType project
11  *  license, LICENSE.TXT. By continuing to use, modify or distribute
12  *  this file you indicate that you have read the license and
13  *  understand and accept it fully.
14  *
15  *  NOTES : This version supports the following :
16  *
17  *    - direct grayscaling
18  *    - sub-banding
19  *    - drop-out modes 4 and 5
20  *    - second pass for complete drop-out control ( bitmap only )
21  *    - variable precision
22  *
23  *   Re-entrancy is _not_ planned.
24  *
25  *   Changes between 1.1 and 1.2 :
26  *
27  *     - no more trace tables, now uses linked list to sort
28  *       coordinates.
29  *
30  *     - reduced code size using function dispatch within a generic
31  *       draw_sweep function.
32  *
33  *     - added variable precision for finer rendering at small ppems
34  *
35  *
36  *   Note that its interface may change in the future.
37  *
38  ******************************************************************)
39 
40 Unit TTRASTER;
41 
42 interface
43 
44 {$R-} // TODO: Fix out-of-bounds accesses.
45 {$I TTCONFIG.INC}
46 
47 uses
48 {$IFDEF VIRTUALPASCAL}
49      Use32,
50 {$ENDIF}
51      TTTypes,
52      TTProfile;
53 
54 {$IFDEF CONST_PREC}
55 
56 const
57   Precision_Bits   = 6;
58   Precision        = 1 shl Precision_Bits;
59   Precision_Half   = Precision div 2;
60   Precision_Step   = Precision_Half;
61   Precision_Shift  = 0;
62   Precision_Mask   = -Precision;
63   Precision_Jitter = 2;
64 
65 {$ENDIF}
66 
67 type
68   Function_Sweep_Init = procedure( var min, max : Int ) of object;
69 
70   Function_Sweep_Span = procedure( y     : Int;
71                                    x1    : TT_F26dot6;
72                                    x2    : TT_F26dot6;
73                                    Left  : TProfile;
74                                    Right : TProfile ) of object;
75 
76   Function_Sweep_Step = procedure of object;
77 
78   { TFreeTypeRasterizer }
79 
80   TFreeTypeRasterizer = class(TFreeTypeCustomRasterizer)
81   private
82     Precision_Bits   : Int;       (* Fractional bits of Raster coordinates *)
83     Precision        : Int;
84     Precision_Half   : Int;
85     Precision_Step   : Int;       (* Bezier subdivision minimal step       *)
86     Precision_Shift  : Int;       (* Shift used to convert coordinates     *)
87     Precision_Mask   : Longint;   (* integer truncatoin mask               *)
88     Precision_Jitter : Int;
89 
90     Pool     : TRenderPool;(* Profiles buffer a.k.a. Render Pool *)
91 
92     Cible      : TT_Raster_Map; (* Description of target map *)
93 
94     BWidth     : integer;
95     BCible     : PByte;   (* target bitmap buffer *)
96     GCible     : PByte;   (* target pixmap buffer *)
97 
98     TraceBOfs   : Int;     (* current offset in target bitmap         *)
99     TraceBIncr  : Int;     (* increment to next line in target bitmap *)
100     TraceGOfs   : Int;     (* current offset in targer pixmap         *)
101     TraceGIncr  : Int;     (* increment to next line in target pixmap *)
102 
103     gray_min_x : Int;     (* current min x during gray rendering *)
104     gray_max_x : Int;     (* current max x during gray rendering *)
105 
106     (* Dispatch variables : *)
107 
108     Proc_Sweep_Init : Function_Sweep_Init;  (* Sweep initialisation *)
109     Proc_Sweep_Span : Function_Sweep_Span;  (* Span drawing         *)
110     Proc_Sweep_Drop : Function_Sweep_Span;  (* Drop out control     *)
111     Proc_Sweep_Step : Function_Sweep_Step;  (* Sweep line step      *)
112     Proc_Sweep_Direct: TDirectRenderingFunction; (* Direct rendering *)
113 
114     Direct_X, Direct_Y, Direct_TX: integer;
115 
116     Points   : TT_Points;
117     Flags    : PByte;           (* current flags array     *)
118     Outs     : TT_PConStarts;   (* current endpoints array *)
119 
120     //nPoints,            (* current number of points   *)
121     nContours : Int;    (* current number of contours *)
122 
123     DropOutControl : Byte;  (* current drop-out control mode *)
124 
125     Grays : TT_Gray_Palette;
126     (* gray palette used during gray-levels rendering *)
127     (* 0 : background .. 4 : foreground               *)
128 
129     BGray_Data  : PByte;   { temporary bitmap for grayscale      }
130     BGray_Incr  : integer; { increment for temp bitmap           }
131     BGray_End   : integer; { ending offset of temporary bitmap   }
132     BGray_Capacity: integer; { current capacity of temp bitmap   }
133 
134     Second_Pass : boolean;
135     (* indicates wether an horizontal pass should be performed  *)
136     (* to control drop-out accurately when calling Render_Glyph *)
137     (* Note that there is no horizontal pass during gray render *)
138 
139     (* better set it off at ppem >= 18                          *)
140 
141     procedure BGray_NeedCapacity(c: integer);
Draw_Sweepnull142     function Draw_Sweep(MinY, MaxY: integer; PixelGrain: integer): boolean;
143     procedure Horizontal_Gray_Sweep_Drop(y: Int; x1, x2: TT_F26dot6; Left,
144       Right: TProfile);
145     procedure Horizontal_Gray_Sweep_Span(y: Int; x1, x2: TT_F26dot6; {%H-}Left,
146       {%H-}Right: TProfile);
147     procedure Horizontal_Sweep_Drop(y: Int; x1, x2: TT_F26dot6; Left,
148       Right: TProfile);
149     procedure Horizontal_Sweep_Init(var {%H-}min, {%H-}max: Int);
150     procedure Horizontal_Sweep_Span(y: Int; x1, x2: TT_F26dot6; {%H-}Left,
151       {%H-}Right: TProfile);
152     procedure Horizontal_Sweep_Step;
ProcessCoordinatenull153     function ProcessCoordinate(var List: TProfile): integer;
154     procedure Raster_Object_Init;
155     procedure Raster_Object_Done;
Render_Single_Passnull156     function Render_Single_Pass(vertical: Boolean; OutputMinY, OutputMaxY,
157       PixelGrain: integer): boolean;
158     {$IFNDEF CONST_PREC}procedure Set_High_Precision(High: boolean);
159     procedure Set_Second_Pass(Pass: boolean);
160     procedure Vertical_Gray_Sweep_Init(var min, {%H-}max: Int);
161     procedure Vertical_Gray_Sweep_Init_Direct(var min, max: Int);
162     procedure Vertical_Gray_Sweep_Init_Direct_HQ(var min, max: Int);
163     procedure Vertical_Gray_Sweep_Init_HQ(var min, {%H-}max: Int);
164     procedure Vertical_Gray_Sweep_Step;
165     procedure Vertical_Gray_Sweep_Step_Direct;
166     procedure Vertical_Gray_Sweep_Step_Direct_HQ;
167     procedure Vertical_Gray_Sweep_Step_HQ;
168     procedure Vertical_Sweep_Drop(y: Int; x1, x2: TT_F26dot6; Left,
169       Right: TProfile);
170     procedure Vertical_Sweep_Init(var min, {%H-}max: Int);
171     procedure Vertical_Sweep_Span({%H-}y: Int; x1, x2: TT_F26dot6; {%H-}Left,
172       {%H-}Right: TProfile);
173     procedure Vertical_Sweep_Step;
174 {$ENDIF}
175   public
Render_Glyphnull176     function Render_Glyph( var glyph  : TT_Outline;
177                            var target : TT_Raster_Map ) : TError; override;
178 
179     (* Render one glyph in the target bitmap (1-bit per pixel)       *)
180 
Render_Gray_Glyphnull181     function Render_Gray_Glyph( var glyph   : TT_Outline;
182                                 var target  : TT_Raster_Map;
183                                 palette : PTT_Gray_Palette ) : TError; override;
184 
185     (* Render one gray-level glyph in the target pixmap              *)
186     (* palette points to an array of 5 colors used for the rendering *)
187     (* use nil to reuse the last palette. Default is VGA graylevels  *)
188 
Render_Gray_Glyph_HQnull189     function Render_Gray_Glyph_HQ( var glyph   : TT_Outline;
190                                 var target  : TT_Raster_Map ) : TError; override;
191 
Render_Directly_Gray_Glyphnull192     function Render_Directly_Gray_Glyph( var glyph   : TT_Outline;
193                                 x,y,tx,ty: integer;
194                                 OnRender: TDirectRenderingFunction;
195                                 palette : PTT_Gray_Palette) : TError; override;
196 
Render_Directly_Gray_Glyph_HQnull197     function Render_Directly_Gray_Glyph_HQ( var glyph   : TT_Outline;
198                                 x,y,tx,ty: integer;
199                                 OnRender: TDirectRenderingFunction) : TError; override;
200 
201     procedure Set_Raster_Palette(const palette: TT_Gray_Palette); override;
202 
203     constructor Create;
204     destructor Destroy; override;
205   end;
206 
207   { These functions round up minimum and maximum value of an interval over
208     data which is organized by grains of constant size. For example, if
209     the size of the grain is 4, then minimum values can be 0, 4, 8, etc.
210     and maximum values can be 3, 7, 11, etc. }
IncludeFullGrainMinnull211   function IncludeFullGrainMin(minValue: integer; Grain: integer): integer;
IncludeFullGrainMaxnull212   function IncludeFullGrainMax(maxValue: integer; Grain: integer): integer;
213 
TTRaster_Initnull214   function TTRaster_Init: TError;
215   procedure TTRaster_Done;
216 
TTGetDefaultRasterizernull217   function TTGetDefaultRasterizer: TFreeTypeRasterizer;
218 
219 implementation
220 
221 uses
222      TTError,
223      SysUtils;
224 
225 const
226   Pixel_Bits = 6;        (* fractional bits of input coordinates  *)
227 
228 const
229   LMask : array[0..7] of Byte
230         = ($FF,$7F,$3F,$1F,$0F,$07,$03,$01);
231 
232   RMask : array[0..7] of Byte
233         = ($80,$C0,$E0,$F0,$F8,$FC,$FE,$FF);
234   (* left and right fill bitmasks *)
235 
236 var
237     Count_Table : array[0..255] of Word;
238     (* Look-up table used to quickly count set bits in a gray 2x2 cell *)
239 
240     BitCountTable: packed array[0..255] of byte; //number of bits 'on' in a byte
241 
IncludeFullGrainMinnull242 function IncludeFullGrainMin(minValue: integer; Grain: integer): integer;
243 begin
244   if minValue mod Grain <> 0 then
245   begin
246     if minValue > 0 then
247       result := minValue - (minValue mod Grain)
248     else
249       result := minValue - (Grain - (-minValue) mod Grain);
250   end else
251     result := minValue;
252 end;
253 
IncludeFullGrainMaxnull254 function IncludeFullGrainMax(maxValue: integer; Grain: integer): integer;
255 begin
256   if maxValue mod Grain <> Grain-1 then
257   begin
258     if maxValue > 0 then
259       result := maxValue + (Grain-1 - (maxValue mod Grain))
260     else
261       result := maxValue + (((-maxValue) mod Grain) - 1);
262   end
263   else
264     result := maxValue;
265 end;
266 
267 {$IFNDEF CONST_PREC}
268 
269 (****************************************************************************)
270 (*                                                                          *)
271 (* Function:    Set_High_Precision                                          *)
272 (*                                                                          *)
273 (* Description: Sets precision variables according to param flag            *)
274 (*                                                                          *)
275 (* Input:       High     set to True for high precision ( typically for     *)
276 (*                       ppem < 18 ), false otherwise.                      *)
277 (*                                                                          *)
278 (****************************************************************************)
279 
280 procedure TFreeTypeRasterizer.Set_High_Precision( High : boolean );
281 begin
282   if High then
283     begin
284       Precision_Bits   := 10;
285       Precision_Step   := 128;
286       Precision_Jitter := 24;
287     end
288   else
289     begin
290       Precision_Bits   := 6;
291       Precision_Step   := 32;
292       Precision_Jitter := 2;
293     end;
294 
295   Precision       := 1 shl Precision_Bits;
296   Precision_Half  := Precision shr 1;
297   Precision_Shift := Precision_Bits - Pixel_Bits;
298   Precision_Mask  := -Precision;
299   if Pool <> nil then Pool.SetPrecision(Precision,Precision_Step);
300 end;
301 
302 {$ENDIF}
303 
304 procedure TFreeTypeRasterizer.Set_Second_Pass( Pass : boolean );
305 begin
306   second_pass := pass;
307 end;
308 
309 
310   (************************************************)
311   (*                                              *)
312   (*  Process next coordinate                     *)
313   (*  Returns: count                              *)
314   (*                                              *)
315   (************************************************)
316 
TFreeTypeRasterizer.ProcessCoordinatenull317   function TFreeTypeRasterizer.ProcessCoordinate( var List : TProfile ): integer;
318   var
319     current : TProfile;
320   begin
321     result := 0;
322     if List = nil then exit;
323 
324     current := list;
325     repeat
326       with current do
327       begin
328         X := Pool.Data[offset];
329         inc( offset, flow );
330         dec( height );
331         current := nextInList;
332         inc(result);
333       end;
334     until current = nil;
335   end;
336 
337 (********************************************************************)
338 (*                                                                  *)
339 (*  Generic Sweep Drawing routine                                   *)
340 (*                                                                  *)
341 (*                                                                  *)
342 (*                                                                  *)
343 (********************************************************************)
344 
TFreeTypeRasterizer.Draw_Sweepnull345 function TFreeTypeRasterizer.Draw_Sweep(MinY,MaxY: integer; PixelGrain: integer) : boolean;
346 
347 label
348   Skip_To_Next;
349 
350 var
351   y      : Int;
352   P, Q   : TProfile;
353 
354   Top,
355   Bottom,
356   min_Y,
357   max_Y: Int;
358 
359   x1, x2, xs, e1, e2 : LongInt;
360 
361   Wait  : TProfile;
362 
363   Draw_Left  : TProfile;
364   Draw_Right : TProfile;
365 
366   Drop_Left  : TProfile;
367   Drop_Right : TProfile;
368 
369   P_Left,  Q_Left  : TProfile;
370   P_Right, Q_Right : TProfile;
371 
372   dropouts  : Int;
373   countLeft, countRight: integer;
374 
375 begin
376   if Pool.ProfileColl.fProfile = nil then
377   begin
378     result := true;
379     exit;
380   end;
381 
382   Draw_Sweep := False;
383 
384   (* Init the empty linked lists *)
385 
386   ProfileList_Init( Wait );
387 
388   ProfileList_Init( Draw_Left  );
389   ProfileList_Init( Draw_Right );
390 
391   ProfileList_Init( Drop_Left  );
392   ProfileList_Init( Drop_Right );
393 
394   (* First, compute min Y and max Y *)
395 
396   max_Y := MinY;
397   min_Y := MaxY;
398 
399   P     := Pool.ProfileColl.fProfile;
400   while P <> nil do
401    with P do
402     begin
403      Q := P.nextInColl;
404 
405      if p.Flow = TT_Flow_Down then
406      begin //flip coordinates
407        Dec(p.Start, p.Height-1);
408        Inc(p.Offset, p.Height-1);
409      end;
410 
411      Bottom := P.Start;
412      Top    := Bottom + P.Height-1;
413 
414      if min_Y > Bottom then min_Y := Bottom;
415      if max_Y < Top    then max_Y := Top;
416 
417      X := 0;
418      ProfileList_InsertFirstElement( Wait, P );
419 
420      P := Q;
421    end;
422 
423   min_y := IncludeFullGrainMin(min_y,PixelGrain);
424   max_y := IncludeFullGrainMax(max_y,PixelGrain);
425 
426   if min_Y < MinY then min_Y := MinY;
427   if max_Y > MaxY then max_Y := MaxY;
428 
429   ProfileList_SortByStart( Wait );
430 
431   (* Now inits the sweeps *)
432 
433   Proc_Sweep_Init( min_Y, max_Y );
434 
435   (* Let's go *)
436 
437   for y := min_Y to max_Y do
438   begin
439 
440     (* Look in the wait list for new activations *)
441 
442     while (Wait <> nil) and (Wait.Start <= y) do
443     begin
444       P := Wait;
445       ProfileList_Remove(Wait, Wait);
446 
447       if P.Height > 0 then
448         case P.Flow of
449           TT_Flow_Up   : ProfileList_InsertFirstElement( Draw_Left, P );
450           TT_Flow_Down : ProfileList_InsertFirstElement( Draw_Right, P );
451         else
452           raise Exception.Create('Unexpected flow');
453         end;
454     end;
455 
456     (* Get next coordinate *)
457     countLeft := ProcessCoordinate( Draw_Left );
458     countRight := ProcessCoordinate( Draw_Right );
459     dropouts  := 0;
460 
461     if countLeft = countRight then
462     begin
463       (* sort the drawing lists *)
464 
465       ProfileList_SortByX( Draw_Left );
466       ProfileList_SortByX( Draw_Right );
467 
468       (* Let's trace *)
469 
470       P_Left  := Draw_Left;
471       P_Right := Draw_Right;
472 
473       while ( P_Left <> nil ) and (P_Right <> nil) do
474       begin
475 
476         {$IFDEF ASSERT}
477         if P_Right = nil then
478           Halt(13);
479         {$ENDIF}
480 
481         Q_Left  := P_Left.nextInList;
482         Q_Right := P_Right.nextInList;
483 
484         {$IFDEF ASSERT}
485         if Q_Right = nil then
486           Halt(11);
487         {$ENDIF}
488 
489         x1 := P_Left.X;
490         x2 := P_Right.X;
491 
492         if x1 > x2 then
493           begin
494             xs := x1;
495             x1 := x2;
496             x2 := xs;
497           end;
498 
499         if ( x2-x1 <= Precision ) then
500           begin
501             e1 := ( x1+Precision-1 ) and Precision_Mask;
502             e2 := x2 and Precision_Mask;
503 
504             if (dropOutControl <> 0) and
505                ((e1 > e2) or (e2 = e1 + Precision)) then
506             begin
507               P_Left.x  := x1;
508               P_Right.x := x2;
509 
510               ProfileList_Remove( Draw_Left,  P_Left );
511               ProfileList_Remove( Draw_Right, P_Right );
512 
513               ProfileList_AppendToList( Drop_Left,  P_Left );
514               ProfileList_AppendToList( Drop_Right, P_Right );
515               inc( dropouts );
516 
517               goto Skip_To_Next;
518             end
519           end;
520 
521         Proc_Sweep_Span( y, x1, x2, P_Left, P_Right );
522 
523         (* We finalize the Profile if needed *)
524 
525         if P_Left.height = 0 then
526             ProfileList_Remove( Draw_Left,  P_Left  );
527 
528         if P_Right.height = 0 then
529             ProfileList_Remove( Draw_Right, P_Right );
530 
531     Skip_To_Next:
532 
533         P_Left  := Q_Left;
534         P_Right := Q_Right;
535       end;
536     end else
537     begin
538       P_Left  := Draw_Left;
539       while ( P_Left <> nil ) do
540       begin
541         Q_Left  := P_Left.nextInList;
542         {x1 := P_Left.X;
543         Proc_Sweep_Span( y, x1-Precision_Half, x1+Precision_Half, P_Left, P_Left );}
544         if P_Left.height = 0 then
545             ProfileList_Remove( Draw_Left,  P_Left  );
546         P_Left  := Q_Left;
547       end;
548 
549       P_Right := Draw_Right;
550       while ( P_Right <> nil ) do
551       begin
552         Q_Right  := P_Right.nextInList;
553         {x2 := P_Right.X;
554         Proc_Sweep_Span( y, x2-Precision_Half, x2+Precision_Half, P_Right, P_Right );}
555         if P_Right.height = 0 then
556             ProfileList_Remove( Draw_Right, P_Right );
557         P_Right  := Q_Right;
558       end;
559     end;
560 
561     {$IFDEF ASSERT}
562     if P_Right <> nil then
563       Halt(10);
564     {$ENDIF}
565 
566     (* Now perform the dropouts only _after_ the span drawing *)
567 
568     P_Left  := Drop_Left;
569     P_Right := Drop_Right;
570 
571     while ( dropouts > 0 ) do
572     begin
573 
574       Q_Left  := P_Left.nextInList;
575       Q_Right := P_Right.nextInList;
576 
577       ProfileList_Remove( Drop_Left, P_Left );
578       ProfileList_Remove( Drop_Right, P_Right );
579 
580       Proc_Sweep_Drop( y, P_Left.x, P_Right.x, P_Left, P_Right );
581 
582       if P_Left.height > 0 then
583         ProfileList_InsertFirstElement( Draw_Left, P_Left );
584 
585       if P_Right.height > 0 then
586         ProfileList_InsertFirstElement( Draw_Right, P_Right );
587 
588       P_Left  := Q_Left;
589       P_Right := Q_Right;
590 
591       dec( dropouts );
592     end;
593 
594     (* Step to next line *)
595 
596     Proc_Sweep_Step;
597 
598   end;
599 
600   Draw_Sweep := True;
601 
602 end;
603 
604 {$I ttraster_sweep.inc}
605 
606 (****************************************************************************)
607 (*                                                                          *)
608 (* Function:    Render_Single_Pass                                          *)
609 (*                                                                          *)
610 (* Description: Performs one sweep with sub-banding.                        *)
611 (*                                                                          *)
612 (* Returns:     True on success                                             *)
613 (*              False if any error was encountered during render.           *)
614 (*                                                                          *)
615 (****************************************************************************)
616 
Render_Single_Passnull617 function TFreeTypeRasterizer.Render_Single_Pass( vertical : Boolean; OutputMinY, OutputMaxY, PixelGrain: integer ) : boolean;
618 var
619   OutputY, OutputBandY, BandHeight: Integer;
620 begin
621   Render_Single_Pass := False;
622   OutputY := OutputMinY;
623   BandHeight := PixelGrain;
624   while OutputY+BandHeight < OutputMaxY do BandHeight := BandHeight shl 1;
625 
626   while OutputY <= OutputMaxY do
627     begin
628 
629       Error   := Err_Ras_None;
630       OutputBandY := OutputY+BandHeight-1;
631       if OutputBandY > OutputMaxY then OutputBandY := OutputMaxY;
632       Pool.SetBounds(OutputY*Precision,OutputBandY*Precision);
633       Pool.Clear;
634 
635       if Pool.Convert_Glyph( vertical, points, flags, outs, nContours ) then
636       begin
637         if Draw_Sweep(OutputY, OutputBandY, PixelGrain) then
638           OutputY := OutputBandY + 1
639         else
640         begin
641           Pool.Clear;
642           Pool.ReduceCapacity;
643           exit;
644         end;
645 
646       end else
647       begin
648         if Error <> Err_Ras_Overflow then exit;
649         Error := Err_Ras_None;
650 
651         BandHeight := BandHeight shr 1;
652         if BandHeight < PixelGrain then
653         begin
654           Error := Err_Ras_Invalid;
655           Pool.Clear;
656           Pool.ReduceCapacity;
657           exit;
658         end;
659       end;
660     end;
661 
662   Pool.Clear;
663   Pool.ReduceCapacity;
664   Render_Single_Pass := true;
665 end;
666 
667 (****************************************************************************)
668 (*                                                                          *)
669 (* Function:    Render_Glyph                                                *)
670 (*                                                                          *)
671 (* Description: Renders a glyph in a bitmap.      Sub-banding if needed     *)
672 (*                                                                          *)
673 (* Input:       AGlyph   Glyph record                                       *)
674 (*                                                                          *)
675 (* Returns:     True on success                                             *)
676 (*              False if any error was encountered during render.           *)
677 (*                                                                          *)
678 (****************************************************************************)
679 
Render_Glyphnull680 function TFreeTypeRasterizer.Render_Glyph( var glyph  : TT_Outline;
681                        var target : TT_Raster_Map ) : TError;
682 begin
683 
684  Render_Glyph := Failure;
685 
686  if Pool = nil then
687    begin
688      Error := Err_Ras_NotIni;
689      exit;
690    end;
691 
692  if glyph.conEnds^[glyph.n_contours-1] > glyph.n_points then
693    begin
694      Error := Err_Ras_Invalid_Contours;
695      exit;
696    end;
697 
698  Cible := target;
699 
700  Outs      := glyph.conEnds;
701  Flags     := PByte(glyph.flags);
702  //nPoints   := Glyph.n_points;
703  nContours := Glyph.n_contours;
704 
705  points := Glyph.points;
706 
707  Set_High_Precision( glyph.high_precision );
708  pool.SetScaleShift(precision_shift);
709  DropOutControl := glyph.dropout_mode;
710  second_pass    := glyph.second_pass;
711 
712  Error := Err_Ras_None;
713 
714  (* Vertical Sweep *)
715 
716 {$IFDEF FPC}
717  Proc_Sweep_Init := @Vertical_Sweep_Init;
718  Proc_Sweep_Span := @Vertical_Sweep_Span;
719  Proc_Sweep_Drop := @Vertical_Sweep_Drop;
720  Proc_Sweep_Step := @Vertical_Sweep_Step;
721 {$ELSE}
722  Proc_Sweep_Init := Vertical_Sweep_Init;
723  Proc_Sweep_Span := Vertical_Sweep_Span;
724  Proc_Sweep_Drop := Vertical_Sweep_Drop;
725  Proc_Sweep_Step := Vertical_Sweep_Step;
726 {$ENDIF}
727 
728  BWidth := Cible.width;
729  BCible := PByte( Cible.Buffer );
730 
731  if not Render_Single_Pass( False, 0,Cible.Rows-1, 1 ) then exit;
732 
733  (* Horizontal Sweep *)
734 
735  if Second_Pass then
736  begin
737 
738 {$IFDEF FPC}
739    Proc_Sweep_Init := @Horizontal_Sweep_Init;
740    Proc_Sweep_Span := @Horizontal_Sweep_Span;
741    Proc_Sweep_Drop := @Horizontal_Sweep_Drop;
742    Proc_Sweep_Step := @Horizontal_Sweep_Step;
743 {$ELSE}
744    Proc_Sweep_Init := Horizontal_Sweep_Init;
745    Proc_Sweep_Span := Horizontal_Sweep_Span;
746    Proc_Sweep_Drop := Horizontal_Sweep_Drop;
747    Proc_Sweep_Step := Horizontal_Sweep_Step;
748 {$ENDIF}
749 
750    BWidth := Cible.rows;
751    BCible := PByte( Cible.Buffer );
752 
753    if not Render_Single_Pass( True, 0, Cible.Width-1, 1 ) then exit;
754 
755  end;
756 
757  Render_Glyph := Success;
758 end;
759 
760 procedure TFreeTypeRasterizer.BGray_NeedCapacity(c: integer);
761 begin
762  if c > BGray_Capacity then
763  begin
764    if BGray_Data <> nil then freemem(BGray_Data);
765    BGray_Capacity := c*2;
766    getmem(BGray_Data, BGray_Capacity);
767  end;
768  fillchar(BGray_Data^, c, 0);
769 end;
770 
771 (****************************************************************************)
772 (*                                                                          *)
773 (* Function:    Render_Gray_Glyph                                           *)
774 (*                                                                          *)
775 (* Description: Renders a glyph with grayscaling. Sub-banding if needed     *)
776 (*                                                                          *)
777 (* Input:       AGlyph   Glyph record                                       *)
778 (*                                                                          *)
779 (* Returns:     True on success                                             *)
780 (*              False if any error was encountered during render.           *)
781 (*                                                                          *)
782 (****************************************************************************)
783 
TFreeTypeRasterizer.Render_Gray_Glyphnull784   function TFreeTypeRasterizer.Render_Gray_Glyph( var glyph   : TT_Outline;
785                               var target  : TT_Raster_Map;
786                               palette : PTT_Gray_Palette ) : TError;
787   const Zoom = 2;
788 begin
789 
790  Render_Gray_Glyph := Failure;
791 
792  cible := target;
793 
794  if palette <> nil then
795    move( palette^, Grays, sizeof(TT_Gray_Palette) );
796 
797  Outs      := Glyph.conEnds;
798  Flags     := PByte(glyph.flags);
799  //nPoints   := Glyph.n_points;
800  nContours := Glyph.n_contours;
801 
802  points := Glyph.points;
803 
804  Set_High_Precision( glyph.high_precision );
805  pool.SetScaleShift(precision_shift+1);
806  DropOutControl := glyph.dropout_mode;
807  second_pass    := glyph.high_precision;
808 
809  Error := Err_Ras_None;
810 
811  BGray_Incr := (Cible.Width*Zoom+7) shr 3;
812  BGray_End  := BGray_Incr*Zoom;
813  BGray_NeedCapacity(BGray_End);
814  BWidth := BGray_Incr shl 3;
815 
816  BCible := PByte( BGray_Data   );
817  GCible := PByte( Cible.Buffer );
818 
819 {$IFDEF FPC}
820  Proc_Sweep_Init := @Vertical_Gray_Sweep_Init;
821  Proc_Sweep_Span := @Vertical_Sweep_Span;
822  Proc_Sweep_Drop := @Vertical_Sweep_Drop;
823  Proc_Sweep_Step := @Vertical_Gray_Sweep_Step;
824 {$ELSE}
825  Proc_Sweep_Init := Vertical_Gray_Sweep_Init;
826  Proc_Sweep_Span := Vertical_Sweep_Span;
827  Proc_Sweep_Drop := Vertical_Sweep_Drop;
828  Proc_Sweep_Step := Vertical_Gray_Sweep_Step;
829 {$ENDIF}
830 
831  if not Render_Single_Pass( False, 0, Zoom*Cible.Rows - 1, Zoom ) then exit;
832 
833  (* Horizontal Sweep *)
834 
835  if Second_Pass then
836  begin
837 
838 {$IFDEF FPC}
839    Proc_Sweep_Init := @Horizontal_Sweep_Init;
840    Proc_Sweep_Span := @Horizontal_Gray_Sweep_Span;
841    Proc_Sweep_Drop := @Horizontal_Gray_Sweep_Drop;
842    Proc_Sweep_Step := @Horizontal_Sweep_Step;
843 {$ELSE}
844    Proc_Sweep_Init := Horizontal_Sweep_Init;
845    Proc_Sweep_Span := Horizontal_Gray_Sweep_Span;
846    Proc_Sweep_Drop := Horizontal_Gray_Sweep_Drop;
847    Proc_Sweep_Step := Horizontal_Sweep_Step;
848 {$ENDIF}
849 
850    BWidth := Cible.rows;
851    GCible := PByte( Cible.Buffer );
852 
853    if not Render_Single_Pass( True, 0,Cible.Width*Zoom-1, Zoom ) then exit;
854 
855  end;
856 
857  Render_Gray_Glyph := Success;
858  exit;
859 
860 end;
861 
Render_Gray_Glyph_HQnull862 function TFreeTypeRasterizer.Render_Gray_Glyph_HQ( var glyph   : TT_Outline;
863                             var target  : TT_Raster_Map ) : TError;
864 const Zoom = 8;
865 begin
866 
867   Render_Gray_Glyph_HQ := Failure;
868 
869   cible := target;
870 
871   Outs      := Glyph.conEnds;
872   Flags     := PByte(glyph.flags);
873   //nPoints   := Glyph.n_points;
874   nContours := Glyph.n_contours;
875 
876   points := Glyph.points;
877 
878   Set_High_Precision( false );
879   pool.SetScaleShift(precision_shift+3);
880   DropOutControl := glyph.dropout_mode;
881   second_pass    := false;
882 
883   Error := Err_Ras_None;
884 
885   BGray_Incr := (Cible.Width*Zoom+7) shr 3;
886   BGray_End  := BGray_Incr*Zoom;
887   BGray_NeedCapacity(BGray_End);
888   BWidth := BGray_Incr shl 3;
889 
890   BCible := PByte( BGray_Data   );
891   GCible := PByte( Cible.Buffer );
892 
893   {$IFDEF FPC}
894   Proc_Sweep_Init := @Vertical_Gray_Sweep_Init_HQ;
895   Proc_Sweep_Span := @Vertical_Sweep_Span;
896   Proc_Sweep_Drop := @Vertical_Sweep_Drop;
897   Proc_Sweep_Step := @Vertical_Gray_Sweep_Step_HQ;
898   {$ELSE}
899   Proc_Sweep_Init := Vertical_Gray_Sweep_Init_HQ;
900   Proc_Sweep_Span := Vertical_Sweep_Span;
901   Proc_Sweep_Drop := Vertical_Sweep_Drop;
902   Proc_Sweep_Step := Vertical_Gray_Sweep_Step_HQ;
903   {$ENDIF}
904 
905   if not Render_Single_Pass( False, 0, Zoom*Cible.Rows - 1, Zoom ) then exit;
906 
907   Render_Gray_Glyph_HQ := Success;
908   exit;
909 
910 end;
911 
912 {************************ direct rendering ********************}
913 
914 procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Init_Direct_HQ( var min, max : Int );
915 begin
916   Vertical_Gray_Sweep_Init_HQ ( min, max);
917   dec(Direct_Y, min div 8);
918   traceGOfs := 0;
919   TraceGIncr:= 0;
920 end;
921 
922 procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Step_Direct_HQ;
923 begin
924   Vertical_Gray_Sweep_Step_HQ;
925   If TraceBOfs = 0 then
926   begin
927     Proc_Sweep_Direct(Direct_X,Direct_Y,Direct_TX,pointer(GCible));
928     dec(Direct_Y);
929     fillchar(cible.Buffer^, cible.Cols, 0);
930   end;
931 end;
932 
933 procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Init_Direct( var min, max : Int );
934 begin
935   Vertical_Gray_Sweep_Init ( min, max);
936   dec(Direct_Y, min div 2);
937   traceGOfs := 0;
938   TraceGIncr:= 0;
939 end;
940 
941 procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Step_Direct;
942 begin
943   Vertical_Gray_Sweep_Step;
944   If TraceBOfs = 0 then
945   begin
946     Proc_Sweep_Direct(Direct_X,Direct_Y,Direct_TX,pointer(GCible));
947     dec(Direct_Y);
948     fillchar(cible.Buffer^, cible.Cols, 0);
949   end;
950 end;
951 
Render_Directly_Gray_Glyphnull952 function TFreeTypeRasterizer.Render_Directly_Gray_Glyph(var glyph: TT_Outline; x, y, tx,
953   ty: integer; OnRender: TDirectRenderingFunction; palette : PTT_Gray_Palette): TError;
954 const Zoom = 2;
955 begin
956 
957   Render_Directly_Gray_Glyph := Failure;
958 
959   if palette <> nil then
960     move( palette^, Grays, sizeof(TT_Gray_Palette) );
961 
962   Direct_X := x;
963   Direct_Y := y+ty-1;
964   Direct_TX := tx;
965 
966   cible.Width := tx;
967   cible.Rows := ty;
968   cible.Cols := (cible.Width+3) and not 3;
969   cible.Flow := TT_Flow_Down;
970   getmem(cible.Buffer, cible.Cols);
971   fillchar(cible.Buffer^, cible.Cols, 0);
972 
973   Outs      := Glyph.conEnds;
974   Flags     := PByte(glyph.flags);
975   //nPoints   := Glyph.n_points;
976   nContours := Glyph.n_contours;
977 
978   points := Glyph.points;
979 
980   Set_High_Precision( glyph.high_precision );
981   pool.SetScaleShift(precision_shift+1);
982   DropOutControl := glyph.dropout_mode;
983   second_pass    := false;
984 
985   Error := Err_Ras_None;
986 
987   BGray_Incr := (Cible.Width*Zoom+7) shr 3;
988   BGray_End  := BGray_Incr*Zoom;
989   BGray_NeedCapacity(BGray_End);
990   BWidth := BGray_Incr shl 3;
991 
992   BCible := PByte( BGray_Data   );
993   GCible := PByte( Cible.Buffer );
994 
995   {$IFDEF FPC}
996   Proc_Sweep_Init := @Vertical_Gray_Sweep_Init_Direct;
997   Proc_Sweep_Span := @Vertical_Sweep_Span;
998   Proc_Sweep_Drop := @Vertical_Sweep_Drop;
999   Proc_Sweep_Step := @Vertical_Gray_Sweep_Step_Direct;
1000   Proc_Sweep_Direct:= OnRender;
1001   {$ELSE}
1002   Proc_Sweep_Init := Vertical_Gray_Sweep_Init_Direct;
1003   Proc_Sweep_Span := Vertical_Sweep_Span;
1004   Proc_Sweep_Drop := Vertical_Sweep_Drop;
1005   Proc_Sweep_Step := Vertical_Gray_Sweep_Step_Direct;
1006   Proc_Sweep_Direct:= OnRender;
1007   {$ENDIF}
1008 
1009   if Render_Single_Pass( False, 0, Zoom*Cible.Rows - 1, Zoom ) then
1010     Render_Directly_Gray_Glyph := Success;
1011 
1012   freemem(cible.Buffer, cible.Cols);
1013 
1014 end;
1015 
Render_Directly_Gray_Glyph_HQnull1016 function TFreeTypeRasterizer.Render_Directly_Gray_Glyph_HQ( var glyph   : TT_Outline;
1017                             x,y,tx,ty: integer;
1018                             OnRender: TDirectRenderingFunction) : TError;
1019 const Zoom = 8;
1020 begin
1021 
1022   Render_Directly_Gray_Glyph_HQ := Failure;
1023 
1024   Direct_X := x;
1025   Direct_Y := y+ty-1;
1026   Direct_TX := tx;
1027 
1028   cible.Width := tx;
1029   cible.Rows := ty;
1030   cible.Cols := (cible.Width+3) and not 3;
1031   cible.Flow := TT_Flow_Down;
1032   getmem(cible.Buffer, cible.Cols);
1033   fillchar(cible.Buffer^, cible.Cols, 0);
1034 
1035   Outs      := Glyph.conEnds;
1036   Flags     := PByte(glyph.flags);
1037   //nPoints   := Glyph.n_points;
1038   nContours := Glyph.n_contours;
1039 
1040   points := Glyph.points;
1041 
1042   Set_High_Precision( false );
1043   pool.SetScaleShift(precision_shift+3);
1044   DropOutControl := glyph.dropout_mode;
1045   second_pass    := false;
1046 
1047   Error := Err_Ras_None;
1048 
1049   BGray_Incr := (Cible.Width*Zoom+7) shr 3;
1050   BGray_End  := BGray_Incr*Zoom;
1051   BGray_NeedCapacity(BGray_End);
1052   BWidth := BGray_Incr shl 3;
1053 
1054   BCible := PByte( BGray_Data   );
1055   GCible := PByte( Cible.Buffer );
1056 
1057   {$IFDEF FPC}
1058   Proc_Sweep_Init := @Vertical_Gray_Sweep_Init_Direct_HQ;
1059   Proc_Sweep_Span := @Vertical_Sweep_Span;
1060   Proc_Sweep_Drop := @Vertical_Sweep_Drop;
1061   Proc_Sweep_Step := @Vertical_Gray_Sweep_Step_Direct_HQ;
1062   Proc_Sweep_Direct:= OnRender;
1063   {$ELSE}
1064   Proc_Sweep_Init := Vertical_Gray_Sweep_Init_Direct_HQ;
1065   Proc_Sweep_Span := Vertical_Sweep_Span;
1066   Proc_Sweep_Drop := Vertical_Sweep_Drop;
1067   Proc_Sweep_Step := Vertical_Gray_Sweep_Step_Direct_HQ;
1068   Proc_Sweep_Direct:= OnRender;
1069   {$ENDIF}
1070 
1071   if Render_Single_Pass( False, 0, Zoom*Cible.Rows - 1, Zoom ) then
1072     Render_Directly_Gray_Glyph_HQ := Success;
1073 
1074   freemem(cible.Buffer, cible.Cols);
1075 
1076 end;
1077 
1078 procedure TFreeTypeRasterizer.Set_Raster_Palette(const palette: TT_Gray_Palette);
1079 begin
1080   move( palette, Grays, sizeof(TT_Gray_Palette) );
1081 end;
1082 
1083 constructor TFreeTypeRasterizer.Create;
1084 begin
1085   Raster_Object_Init;
1086 end;
1087 
1088 destructor TFreeTypeRasterizer.Destroy;
1089 begin
1090   Raster_Object_Done;
1091 end;
1092 
1093 
1094 
1095 (****************************************************************************)
1096 (*                                                                          *)
1097 (* Function:    Init_Rasterizer                                             *)
1098 (*                                                                          *)
1099 (* Description: Initializes the rasterizer.                                 *)
1100 (*                                                                          *)
1101 (* Input:       rasterBlock   target bitmap/pixmap description              *)
1102 (*              profBuffer    pointer to the render pool                    *)
1103 (*              profSize      size in bytes of the render pool              *)
1104 (*                                                                          *)
1105 (* Returns:     1 ( always, but we should check parameters )                *)
1106 (*                                                                          *)
1107 (****************************************************************************)
1108 
1109 procedure TFreeTypeRasterizer.Raster_Object_Init;
1110 const
1111   Default_Grays : array[0..4] of Byte
1112                 = ( 0, 23, 27, 29, 31 );
1113 var i: integer;
1114 begin
1115   Pool := nil;
1116   BGray_Data := nil;
1117   BGray_Capacity := 0;
1118 
1119   (* default Grays takes the gray levels of the standard VGA *)
1120   (* 256 colors mode                                                *)
1121 
1122   for i := 0 to high(Grays) do
1123     Grays[i] := Default_Grays[i];
1124 
1125   Set_High_Precision(False);
1126   Set_Second_Pass(False);
1127   Pool := TRenderPool.Create(Precision,Precision_Step);
1128 
1129   DropOutControl := 2;
1130   Error          := Err_Ras_None;
1131 end;
1132 
1133 procedure TFreeTypeRasterizer.Raster_Object_Done;
1134 begin
1135   Pool.Free;
1136   if BGray_Data <> nil then
1137     FreeMem( BGray_Data, BGray_Capacity );
1138 end;
1139 
1140 var
1141   DefaultRasterizer: TFreeTypeRasterizer;
1142 
TTRaster_Initnull1143 function TTRaster_Init: TError;
1144 var l,c,i,j: integer;
1145 begin
1146   { Initialisation of Count_Table }
1147 
1148   for i := 0 to 255 do
1149   begin
1150     l := 0;
1151     j := i;
1152     for c := 0 to 3 do
1153     begin
1154       l := l shl 4;
1155       if ( j and $80 <> 0 ) then inc(l);
1156       if ( j and $40 <> 0 ) then inc(l);
1157       j := (j shl 2) and $FF;
1158     end;
1159     Count_table[i] := l;
1160   end;
1161 
1162   for i := 0 to 255 do
1163   begin
1164     BitCountTable[i] := (i and 1) + (i shr 1 and 1) + (i shr 2 and 1) + (i shr 3 and 1) +
1165        (i shr 4 and 1) + (i shr 5 and 1) + (i shr 6 and 1) + (i shr 7 and 1);
1166   end;
1167 
1168   DefaultRasterizer := nil;
1169 
1170   result := Success;
1171 end;
1172 
1173 procedure TTRaster_Done;
1174 begin
1175   if DefaultRasterizer <> nil then
1176     DefaultRasterizer.Free;
1177 end;
1178 
TTGetDefaultRasterizernull1179 function TTGetDefaultRasterizer: TFreeTypeRasterizer;
1180 begin
1181   if DefaultRasterizer = nil then
1182     DefaultRasterizer := TFreeTypeRasterizer.Create;
1183   result := DefaultRasterizer;
1184 end;
1185 
1186 end.
1187