(*******************************************************************
 *
 *  TTRaster.Pas                                              v 1.2
 *
 *  The FreeType glyph rasterizer.
 *
 *  Copyright 1996 David Turner, Robert Wilhelm and Werner Lemberg
 *
 *  This file is part of the FreeType project, and may only be used
 *  modified and distributed under the terms of the FreeType project
 *  license, LICENSE.TXT. By continuing to use, modify or distribute
 *  this file you indicate that you have read the license and
 *  understand and accept it fully.
 *
 *  NOTES : This version supports the following :
 *
 *    - direct grayscaling
 *    - sub-banding
 *    - drop-out modes 4 and 5
 *    - second pass for complete drop-out control ( bitmap only )
 *    - variable precision
 *
 *   Re-entrancy is _not_ planned.
 *
 *   Changes between 1.1 and 1.2 :
 *
 *     - no more trace tables, now uses linked list to sort
 *       coordinates.
 *
 *     - reduced code size using function dispatch within a generic
 *       draw_sweep function.
 *
 *     - added variable precision for finer rendering at small ppems
 *
 *
 *   Note that its interface may change in the future.
 *
 ******************************************************************)

Unit TTRASTER;

interface

{$I TTCONFIG.INC}

uses
{$IFDEF VIRTUALPASCAL}
     Use32,
{$ENDIF}
     LazFreeType,
     TTTypes;

  function Render_Glyph( var glyph  : TT_Outline;
                         var target : TT_Raster_Map ) : TError;

  (* Render one glyph in the target bitmap (1-bit per pixel)       *)

  function Render_Gray_Glyph( var glyph   : TT_Outline;
                              var target  : TT_Raster_Map;
                              palette : PTT_Gray_Palette ) : TError;

  (* Render one gray-level glyph in the target pixmap              *)
  (* palette points to an array of 5 colors used for the rendering *)
  (* use nil to reuse the last palette. Default is VGA graylevels  *)

  function Render_Gray_Glyph_HQ( var glyph   : TT_Outline;
                              var target  : TT_Raster_Map ) : TError;

  function Render_Directly_Gray_Glyph( var glyph   : TT_Outline;
                              x,y,tx,ty: integer;
                              OnRender: TDirectRenderingFunction;
                              palette : PTT_Gray_Palette) : TError;

  function Render_Directly_Gray_Glyph_HQ( var glyph   : TT_Outline;
                              x,y,tx,ty: integer;
                              OnRender: TDirectRenderingFunction) : TError;


  procedure Set_High_Precision( High : boolean );
  (* Set rendering precision. Should be set to TRUE for small sizes only *)
  (* ( typically < 20 ppem )                                             *)

  procedure Set_Second_Pass( Pass : boolean );
  (* Set second pass flag *)

  function  TTRaster_Init : TError;
  procedure TTRaster_Done;

  function IncludeFullGrainMin(minValue: integer; Grain: integer): integer;
  function IncludeFullGrainMax(maxValue: integer; Grain: integer): integer;


implementation

uses
     TTError,
     TTProfile,
     SysUtils;

const
  Pixel_Bits = 6;        (* fractional bits of input coordinates  *)

const
  LMask : array[0..7] of Byte
        = ($FF,$7F,$3F,$1F,$0F,$07,$03,$01);

  RMask : array[0..7] of Byte
        = ($80,$C0,$E0,$F0,$F8,$FC,$FE,$FF);

  (* left and right fill bitmasks *)

type
  Function_Sweep_Init = procedure( var min, max : Int );

  Function_Sweep_Span = procedure( y     : Int;
                                   x1    : TT_F26dot6;
                                   x2    : TT_F26dot6;
                                   Left  : TProfile;
                                   Right : TProfile );

  Function_Sweep_Step = procedure;

  (* prototypes used for sweep function dispatch *)

{$IFNDEF CONST_PREC}

var
  Precision_Bits   : Int;       (* Fractional bits of Raster coordinates *)
  Precision        : Int;
  Precision_Half   : Int;
  Precision_Step   : Int;       (* Bezier subdivision minimal step       *)
  Precision_Shift  : Int;       (* Shift used to convert coordinates     *)
  Precision_Mask   : Longint;   (* integer truncatoin mask               *)
  Precision_Jitter : Int;

{$ELSE}

const
  Precision_Bits   = 6;
  Precision        = 1 shl Precision_Bits;
  Precision_Half   = Precision div 2;
  Precision_Step   = Precision_Half;
  Precision_Shift  = 0;
  Precision_Mask   = -Precision;
  Precision_Jitter = 2;

{$ENDIF}

var
  Pool     : TRenderPool;(* Profiles buffer a.k.a. Render Pool *)

  Cible      : TT_Raster_Map; (* Description of target map *)

  BWidth     : integer;
  BCible     : PByte;   (* target bitmap buffer *)
  GCible     : PByte;   (* target pixmap buffer *)

  TraceBOfs   : Int;     (* current offset in target bitmap         *)
  TraceBIncr  : Int;     (* increment to next line in target bitmap *)
  TraceGOfs   : Int;     (* current offset in targer pixmap         *)
  TraceGIncr  : Int;     (* increment to next line in target pixmap *)

  gray_min_x : Int;     (* current min x during gray rendering *)
  gray_max_x : Int;     (* current max x during gray rendering *)

  (* Dispatch variables : *)

  Proc_Sweep_Init : Function_Sweep_Init;  (* Sweep initialisation *)
  Proc_Sweep_Span : Function_Sweep_Span;  (* Span drawing         *)
  Proc_Sweep_Drop : Function_Sweep_Span;  (* Drop out control     *)
  Proc_Sweep_Step : Function_Sweep_Step;  (* Sweep line step      *)
  Proc_Sweep_Direct: TDirectRenderingFunction; (* Direct rendering *)

  Points   : TT_Points;
  Flags    : PByte;           (* current flags array     *)
  Outs     : TT_PConStarts;   (* current endpoints array *)

  //nPoints,            (* current number of points   *)
  nContours : Int;    (* current number of contours *)

  DropOutControl : Byte;  (* current drop-out control mode *)

  Count_Table : array[0..255] of Word;
  (* Look-up table used to quickly count set bits in a gray 2x2 cell *)

  BitCountTable: packed array[0..255] of byte; //number of bits 'on' in a byte

  Grays : TT_Gray_Palette;
  (* gray palette used during gray-levels rendering *)
  (* 0 : background .. 4 : foreground               *)

  BGray_Data  : PByte;   { temporary bitmap for grayscale      }
  BGray_Incr  : integer; { increment for temp bitmap           }
  BGray_End   : integer; { ending offset of temporary bitmap   }
  BGray_Capacity: integer; { current capacity of temp bitmap   }

  Second_Pass : boolean;
  (* indicates wether an horizontal pass should be performed  *)
  (* to control drop-out accurately when calling Render_Glyph *)
  (* Note that there is no horizontal pass during gray render *)

  (* better set it off at ppem >= 18                          *)

{$IFNDEF CONST_PREC}

(****************************************************************************)
(*                                                                          *)
(* Function:    Set_High_Precision                                          *)
(*                                                                          *)
(* Description: Sets precision variables according to param flag            *)
(*                                                                          *)
(* Input:       High     set to True for high precision ( typically for     *)
(*                       ppem < 18 ), false otherwise.                      *)
(*                                                                          *)
(****************************************************************************)

procedure Set_High_Precision( High : boolean );
begin
  if High then
    begin
      Precision_Bits   := 10;
      Precision_Step   := 128;
      Precision_Jitter := 24;
    end
  else
    begin
      Precision_Bits   := 6;
      Precision_Step   := 32;
      Precision_Jitter := 2;
    end;

  Precision       := 1 shl Precision_Bits;
  Precision_Half  := Precision shr 1;
  Precision_Shift := Precision_Bits - Pixel_Bits;
  Precision_Mask  := -Precision;
  if Pool <> nil then Pool.SetPrecision(Precision,Precision_Step);
end;

{$ENDIF}

procedure Set_Second_Pass( Pass : boolean );
begin
  second_pass := pass;
end;




  (************************************************)
  (*                                              *)
  (*  Process next coordinate                     *)
  (*                                              *)
  (************************************************)

  procedure ProcessCoordinate( var List : TProfile );
  var
    current : TProfile;
  begin
    if List = nil then exit;

    current := list;
    repeat
      with current do
      begin
        X := Pool.Data[offset];
        inc( offset, flow );
        dec( height );
        current := nextInList;
      end;
    until current = nil;
  end;

  function IncludeFullGrainMin(minValue: integer; Grain: integer): integer;
  begin
    if minValue mod Grain <> 0 then
    begin
      if minValue > 0 then result := minValue - (minValue mod Grain)
        else result := minValue - (Grain - (-minValue) mod Grain);
    end else
      result := minValue;
  end;

  function IncludeFullGrainMax(maxValue: integer; Grain: integer): integer;
  begin
    if maxValue mod Grain <> Grain-1 then
    begin
      if maxValue > 0 then result := maxValue + (Grain-1 - (maxValue mod Grain))
      else result := maxValue + (((-maxValue) mod Grain) - 1);
    end
    else
      result := maxValue;
  end;


(********************************************************************)
(*                                                                  *)
(*  Generic Sweep Drawing routine                                   *)
(*                                                                  *)
(*                                                                  *)
(*                                                                  *)
(********************************************************************)

function Draw_Sweep(MinY,MaxY: integer; PixelGrain: integer) : boolean;

label
  Skip_To_Next;

var
  y      : Int;
  P, Q   : TProfile;

  Top,
  Bottom,
  min_Y,
  max_Y: Int;

  x1, x2, xs, e1, e2 : LongInt;

  Wait  : TProfile;

  Draw_Left  : TProfile;
  Draw_Right : TProfile;

  Drop_Left  : TProfile;
  Drop_Right : TProfile;

  P_Left,  Q_Left  : TProfile;
  P_Right, Q_Right : TProfile;

  dropouts  : Int;

begin
  if Pool.ProfileColl.fProfile = nil then
  begin
    result := true;
    exit;
  end;

  Draw_Sweep := False;

  (* Init the empty linked lists *)

  ProfileList_Init( Wait );

  ProfileList_Init( Draw_Left  );
  ProfileList_Init( Draw_Right );

  ProfileList_Init( Drop_Left  );
  ProfileList_Init( Drop_Right );

  (* First, compute min Y and max Y *)

  max_Y := MinY;
  min_Y := MaxY;

  P     := Pool.ProfileColl.fProfile;
  while P <> nil do
   with P do
    begin
     Q := P.nextInColl;

     if p.Flow = TT_Flow_Down then
     begin //flip coordinates
       Dec(p.Start, p.Height-1);
       Inc(p.Offset, p.Height-1);
     end;

     Bottom := P.Start;
     Top    := Bottom + P.Height-1;

     if min_Y > Bottom then min_Y := Bottom;
     if max_Y < Top    then max_Y := Top;

     X := 0;
     ProfileList_InsertFirstElement( Wait, P );

     P := Q;
   end;

  min_y := IncludeFullGrainMin(min_y,PixelGrain);
  max_y := IncludeFullGrainMax(max_y,PixelGrain);

  if min_Y < MinY then min_Y := MinY;
  if max_Y > MaxY then max_Y := MaxY;

  ProfileList_SortByStart( Wait );

  (* Now inits the sweeps *)

  Proc_Sweep_Init( min_Y, max_Y );

  (* Let's go *)

  for y := min_Y to max_Y do
  begin

    (* Look in the wait list for new activations *)

    while (Wait <> nil) and (Wait.Start <= y) do
    begin
      P := Wait;
      ProfileList_Remove(Wait, Wait);

      if P.Height > 0 then
        case P.Flow of
          TT_Flow_Up   : ProfileList_InsertFirstElement( Draw_Left, P );
          TT_Flow_Down : ProfileList_InsertFirstElement( Draw_Right, P );
        else
          raise Exception.Create('Unexpected flow');
        end;
    end;

    (* Get next coordinate *)
    ProcessCoordinate( Draw_Left );
    ProcessCoordinate( Draw_Right );
    dropouts  := 0;

    if ProfileList_Count(Draw_Left) = ProfileList_Count(Draw_Right) then
    begin
      (* sort the drawing lists *)

      ProfileList_SortByX( Draw_Left );
      ProfileList_SortByX( Draw_Right );

      (* Let's trace *)

      P_Left  := Draw_Left;
      P_Right := Draw_Right;

      while ( P_Left <> nil ) and (P_Right <> nil) do
      begin

        {$IFDEF ASSERT}
        if P_Right = nil then
          Halt(13);
        {$ENDIF}

        Q_Left  := P_Left.nextInList;
        Q_Right := P_Right.nextInList;

        {$IFDEF ASSERT}
        if Q_Right = nil then
          Halt(11);
        {$ENDIF}

        x1 := P_Left.X;
        x2 := P_Right.X;

        if x1 > x2 then
          begin
            xs := x1;
            x1 := x2;
            x2 := xs;
          end;

        if ( x2-x1 <= Precision ) then
          begin
            e1 := ( x1+Precision-1 ) and Precision_Mask;
            e2 := x2 and Precision_Mask;

            if (dropOutControl <> 0) and
               ((e1 > e2) or (e2 = e1 + Precision)) then
            begin
              P_Left.x  := x1;
              P_Right.x := x2;

              ProfileList_Remove( Draw_Left,  P_Left );
              ProfileList_Remove( Draw_Right, P_Right );

              ProfileList_AppendToList( Drop_Left,  P_Left );
              ProfileList_AppendToList( Drop_Right, P_Right );
              inc( dropouts );

              goto Skip_To_Next;
            end
          end;

        Proc_Sweep_Span( y, x1, x2, P_Left, P_Right );

        (* We finalize the Profile if needed *)

        if P_Left.height = 0 then
            ProfileList_Remove( Draw_Left,  P_Left  );

        if P_Right.height = 0 then
            ProfileList_Remove( Draw_Right, P_Right );

    Skip_To_Next:

        P_Left  := Q_Left;
        P_Right := Q_Right;
      end;
    end else
    begin
      P_Left  := Draw_Left;
      while ( P_Left <> nil ) do
      begin
        Q_Left  := P_Left.nextInList;
        {x1 := P_Left.X;
        Proc_Sweep_Span( y, x1-Precision_Half, x1+Precision_Half, P_Left, P_Left );}
        if P_Left.height = 0 then
            ProfileList_Remove( Draw_Left,  P_Left  );
        P_Left  := Q_Left;
      end;

      P_Right := Draw_Right;
      while ( P_Right <> nil ) do
      begin
        Q_Right  := P_Right.nextInList;
        {x2 := P_Right.X;
        Proc_Sweep_Span( y, x2-Precision_Half, x2+Precision_Half, P_Right, P_Right );}
        if P_Right.height = 0 then
            ProfileList_Remove( Draw_Right, P_Right );
        P_Right  := Q_Right;
      end;
    end;

    {$IFDEF ASSERT}
    if P_Right <> nil then
      Halt(10);
    {$ENDIF}

    (* Now perform the dropouts only _after_ the span drawing *)

    P_Left  := Drop_Left;
    P_Right := Drop_Right;

    while ( dropouts > 0 ) do
    begin

      Q_Left  := P_Left.nextInList;
      Q_Right := P_Right.nextInList;

      ProfileList_Remove( Drop_Left, P_Left );
      ProfileList_Remove( Drop_Right, P_Right );

      Proc_Sweep_Drop( y, P_Left.x, P_Right.x, P_Left, P_Right );

      if P_Left.height > 0 then
        ProfileList_InsertFirstElement( Draw_Left, P_Left );

      if P_Right.height > 0 then
        ProfileList_InsertFirstElement( Draw_Right, P_Right );

      P_Left  := Q_Left;
      P_Right := Q_Right;

      dec( dropouts );
    end;

    (* Step to next line *)

    Proc_Sweep_Step;

  end;

  Draw_Sweep := True;

end;

{$I ttraster_sweep.inc}

(****************************************************************************)
(*                                                                          *)
(* Function:    Render_Single_Pass                                          *)
(*                                                                          *)
(* Description: Performs one sweep with sub-banding.                        *)
(*                                                                          *)
(* Returns:     True on success                                             *)
(*              False if any error was encountered during render.           *)
(*                                                                          *)
(****************************************************************************)

function Render_Single_Pass( vertical : Boolean; OutputMinY, OutputMaxY, PixelGrain: integer ) : boolean;
var
  OutputY, OutputBandY, BandHeight: Integer;
begin
  Render_Single_Pass := False;
  OutputY := OutputMinY;
  BandHeight := PixelGrain;
  while OutputY+BandHeight < OutputMaxY do BandHeight := BandHeight shl 1;

  while OutputY <= OutputMaxY do
    begin

      Error   := Err_Ras_None;
      OutputBandY := OutputY+BandHeight-1;
      if OutputBandY > OutputMaxY then OutputBandY := OutputMaxY;
      Pool.SetBounds(OutputY*Precision,OutputBandY*Precision);
      Pool.Clear;

      if Pool.Convert_Glyph( vertical, points, flags, outs, nContours ) then
      begin
        if Draw_Sweep(OutputY, OutputBandY, PixelGrain) then
          OutputY := OutputBandY + 1
        else
        begin
          Pool.Clear;
          Pool.ReduceCapacity;
          exit;
        end;

      end else
      begin
        if Error <> Err_Ras_Overflow then exit;
        Error := Err_Ras_None;

        BandHeight := BandHeight shr 1;
        if BandHeight < PixelGrain then
        begin
          Error := Err_Ras_Invalid;
          Pool.Clear;
          Pool.ReduceCapacity;
          exit;
        end;
      end;
    end;

  Pool.Clear;
  Pool.ReduceCapacity;
  Render_Single_Pass := true;
end;

(****************************************************************************)
(*                                                                          *)
(* Function:    Render_Glyph                                                *)
(*                                                                          *)
(* Description: Renders a glyph in a bitmap.      Sub-banding if needed     *)
(*                                                                          *)
(* Input:       AGlyph   Glyph record                                       *)
(*                                                                          *)
(* Returns:     True on success                                             *)
(*              False if any error was encountered during render.           *)
(*                                                                          *)
(****************************************************************************)

function Render_Glyph( var glyph  : TT_Outline;
                       var target : TT_Raster_Map ) : TError;
begin

 Render_Glyph := Failure;

 if Pool = nil then
   begin
     Error := Err_Ras_NotIni;
     exit;
   end;

 if glyph.conEnds^[glyph.n_contours-1] > glyph.n_points then
   begin
     Error := Err_Ras_Invalid_Contours;
     exit;
   end;

 Cible := target;

 Outs      := glyph.conEnds;
 Flags     := PByte(glyph.flags);
 //nPoints   := Glyph.n_points;
 nContours := Glyph.n_contours;

 points := Glyph.points;

 Set_High_Precision( glyph.high_precision );
 pool.SetScaleShift(precision_shift);
 DropOutControl := glyph.dropout_mode;
 second_pass    := glyph.second_pass;

 Error := Err_Ras_None;

 (* Vertical Sweep *)

{$IFDEF FPC}
 Proc_Sweep_Init := @Vertical_Sweep_Init;
 Proc_Sweep_Span := @Vertical_Sweep_Span;
 Proc_Sweep_Drop := @Vertical_Sweep_Drop;
 Proc_Sweep_Step := @Vertical_Sweep_Step;
{$ELSE}
 Proc_Sweep_Init := Vertical_Sweep_Init;
 Proc_Sweep_Span := Vertical_Sweep_Span;
 Proc_Sweep_Drop := Vertical_Sweep_Drop;
 Proc_Sweep_Step := Vertical_Sweep_Step;
{$ENDIF}

 BWidth := Cible.width;
 BCible := PByte( Cible.Buffer );

 if not Render_Single_Pass( False, 0,Cible.Rows-1, 1 ) then exit;

 (* Horizontal Sweep *)

 if Second_Pass then
 begin

{$IFDEF FPC}
   Proc_Sweep_Init := @Horizontal_Sweep_Init;
   Proc_Sweep_Span := @Horizontal_Sweep_Span;
   Proc_Sweep_Drop := @Horizontal_Sweep_Drop;
   Proc_Sweep_Step := @Horizontal_Sweep_Step;
{$ELSE}
   Proc_Sweep_Init := Horizontal_Sweep_Init;
   Proc_Sweep_Span := Horizontal_Sweep_Span;
   Proc_Sweep_Drop := Horizontal_Sweep_Drop;
   Proc_Sweep_Step := Horizontal_Sweep_Step;
{$ENDIF}

   BWidth := Cible.rows;
   BCible := PByte( Cible.Buffer );

   if not Render_Single_Pass( True, 0, Cible.Width-1, 1 ) then exit;

 end;

 Render_Glyph := Success;
end;

procedure BGray_NeedCapacity(c: integer);
begin
 if c > BGray_Capacity then
 begin
   if BGray_Data <> nil then freemem(BGray_Data);
   BGray_Capacity := c*2;
   getmem(BGray_Data, BGray_Capacity);
 end;
 fillchar(BGray_Data^, c, 0);
end;

(****************************************************************************)
(*                                                                          *)
(* Function:    Render_Gray_Glyph                                           *)
(*                                                                          *)
(* Description: Renders a glyph with grayscaling. Sub-banding if needed     *)
(*                                                                          *)
(* Input:       AGlyph   Glyph record                                       *)
(*                                                                          *)
(* Returns:     True on success                                             *)
(*              False if any error was encountered during render.           *)
(*                                                                          *)
(****************************************************************************)

  function Render_Gray_Glyph( var glyph   : TT_Outline;
                              var target  : TT_Raster_Map;
                              palette : PTT_Gray_Palette ) : TError;
  const Zoom = 2;
begin

 Render_Gray_Glyph := Failure;

 cible := target;

 if palette <> nil then
   move( palette^, Grays, sizeof(TT_Gray_Palette) );

 Outs      := Glyph.conEnds;
 Flags     := PByte(glyph.flags);
 //nPoints   := Glyph.n_points;
 nContours := Glyph.n_contours;

 points := Glyph.points;

 Set_High_Precision( glyph.high_precision );
 pool.SetScaleShift(precision_shift+1);
 DropOutControl := glyph.dropout_mode;
 second_pass    := glyph.high_precision;

 Error := Err_Ras_None;

 BGray_Incr := (Cible.Width*Zoom+7) shr 3;
 BGray_End  := BGray_Incr*Zoom;
 BGray_NeedCapacity(BGray_End);
 BWidth := BGray_Incr shl 3;

 BCible := PByte( BGray_Data   );
 GCible := PByte( Cible.Buffer );

{$IFDEF FPC}
 Proc_Sweep_Init := @Vertical_Gray_Sweep_Init;
 Proc_Sweep_Span := @Vertical_Sweep_Span;
 Proc_Sweep_Drop := @Vertical_Sweep_Drop;
 Proc_Sweep_Step := @Vertical_Gray_Sweep_Step;
{$ELSE}
 Proc_Sweep_Init := Vertical_Gray_Sweep_Init;
 Proc_Sweep_Span := Vertical_Sweep_Span;
 Proc_Sweep_Drop := Vertical_Sweep_Drop;
 Proc_Sweep_Step := Vertical_Gray_Sweep_Step;
{$ENDIF}

 if not Render_Single_Pass( False, 0, Zoom*Cible.Rows - 1, Zoom ) then exit;

 (* Horizontal Sweep *)

 if Second_Pass then
 begin

{$IFDEF FPC}
   Proc_Sweep_Init := @Horizontal_Sweep_Init;
   Proc_Sweep_Span := @Horizontal_Gray_Sweep_Span;
   Proc_Sweep_Drop := @Horizontal_Gray_Sweep_Drop;
   Proc_Sweep_Step := @Horizontal_Sweep_Step;
{$ELSE}
   Proc_Sweep_Init := Horizontal_Sweep_Init;
   Proc_Sweep_Span := Horizontal_Gray_Sweep_Span;
   Proc_Sweep_Drop := Horizontal_Gray_Sweep_Drop;
   Proc_Sweep_Step := Horizontal_Sweep_Step;
{$ENDIF}

   BWidth := Cible.rows;
   GCible := PByte( Cible.Buffer );

   if not Render_Single_Pass( True, 0,Cible.Width*Zoom-1, Zoom ) then exit;

 end;

 Render_Gray_Glyph := Success;
 exit;

end;

function Render_Gray_Glyph_HQ( var glyph   : TT_Outline;
                            var target  : TT_Raster_Map ) : TError;
const Zoom = 8;
begin

  Render_Gray_Glyph_HQ := Failure;

  cible := target;

  Outs      := Glyph.conEnds;
  Flags     := PByte(glyph.flags);
  //nPoints   := Glyph.n_points;
  nContours := Glyph.n_contours;

  points := Glyph.points;

  Set_High_Precision( false );
  pool.SetScaleShift(precision_shift+3);
  DropOutControl := glyph.dropout_mode;
  second_pass    := false;

  Error := Err_Ras_None;

  BGray_Incr := (Cible.Width*Zoom+7) shr 3;
  BGray_End  := BGray_Incr*Zoom;
  BGray_NeedCapacity(BGray_End);
  BWidth := BGray_Incr shl 3;

  BCible := PByte( BGray_Data   );
  GCible := PByte( Cible.Buffer );

  {$IFDEF FPC}
  Proc_Sweep_Init := @Vertical_Gray_Sweep_Init_HQ;
  Proc_Sweep_Span := @Vertical_Sweep_Span;
  Proc_Sweep_Drop := @Vertical_Sweep_Drop;
  Proc_Sweep_Step := @Vertical_Gray_Sweep_Step_HQ;
  {$ELSE}
  Proc_Sweep_Init := Vertical_Gray_Sweep_Init_HQ;
  Proc_Sweep_Span := Vertical_Sweep_Span;
  Proc_Sweep_Drop := Vertical_Sweep_Drop;
  Proc_Sweep_Step := Vertical_Gray_Sweep_Step_HQ;
  {$ENDIF}

  if not Render_Single_Pass( False, 0, Zoom*Cible.Rows - 1, Zoom ) then exit;

  Render_Gray_Glyph_HQ := Success;
  exit;

end;

{************************ direct rendering ********************}

var
  Direct_X, Direct_Y, Direct_TX: integer;

procedure Vertical_Gray_Sweep_Init_Direct_HQ( var min, max : Int );
begin
  Vertical_Gray_Sweep_Init_HQ ( min, max);
  dec(Direct_Y, min div 8);
  traceGOfs := 0;
  TraceGIncr:= 0;
end;

procedure Vertical_Gray_Sweep_Step_Direct_HQ;
begin
  Vertical_Gray_Sweep_Step_HQ;
  If TraceBOfs = 0 then
  begin
    Proc_Sweep_Direct(Direct_X,Direct_Y,Direct_TX,pointer(GCible));
    dec(Direct_Y);
    fillchar(cible.Buffer^, cible.Cols, 0);
  end;
end;

procedure Vertical_Gray_Sweep_Init_Direct( var min, max : Int );
begin
  Vertical_Gray_Sweep_Init ( min, max);
  dec(Direct_Y, min div 2);
  traceGOfs := 0;
  TraceGIncr:= 0;
end;

procedure Vertical_Gray_Sweep_Step_Direct;
begin
  Vertical_Gray_Sweep_Step;
  If TraceBOfs = 0 then
  begin
    Proc_Sweep_Direct(Direct_X,Direct_Y,Direct_TX,pointer(GCible));
    dec(Direct_Y);
    fillchar(cible.Buffer^, cible.Cols, 0);
  end;
end;

function Render_Directly_Gray_Glyph(var glyph: TT_Outline; x, y, tx,
  ty: integer; OnRender: TDirectRenderingFunction; palette : PTT_Gray_Palette): TError;
const Zoom = 2;
begin

  Render_Directly_Gray_Glyph := Failure;

  if palette <> nil then
    move( palette^, Grays, sizeof(TT_Gray_Palette) );

  Direct_X := x;
  Direct_Y := y+ty-1;
  Direct_TX := tx;

  cible.Width := tx;
  cible.Rows := ty;
  cible.Cols := (cible.Width+3) and not 3;
  cible.Flow := TT_Flow_Down;
  getmem(cible.Buffer, cible.Cols);
  fillchar(cible.Buffer^, cible.Cols, 0);

  Outs      := Glyph.conEnds;
  Flags     := PByte(glyph.flags);
  //nPoints   := Glyph.n_points;
  nContours := Glyph.n_contours;

  points := Glyph.points;

  Set_High_Precision( glyph.high_precision );
  pool.SetScaleShift(precision_shift+1);
  DropOutControl := glyph.dropout_mode;
  second_pass    := false;

  Error := Err_Ras_None;

  BGray_Incr := (Cible.Width*Zoom+7) shr 3;
  BGray_End  := BGray_Incr*Zoom;
  BGray_NeedCapacity(BGray_End);
  BWidth := BGray_Incr shl 3;

  BCible := PByte( BGray_Data   );
  GCible := PByte( Cible.Buffer );

  {$IFDEF FPC}
  Proc_Sweep_Init := @Vertical_Gray_Sweep_Init_Direct;
  Proc_Sweep_Span := @Vertical_Sweep_Span;
  Proc_Sweep_Drop := @Vertical_Sweep_Drop;
  Proc_Sweep_Step := @Vertical_Gray_Sweep_Step_Direct;
  Proc_Sweep_Direct:= OnRender;
  {$ELSE}
  Proc_Sweep_Init := Vertical_Gray_Sweep_Init_Direct;
  Proc_Sweep_Span := Vertical_Sweep_Span;
  Proc_Sweep_Drop := Vertical_Sweep_Drop;
  Proc_Sweep_Step := Vertical_Gray_Sweep_Step_Direct;
  Proc_Sweep_Direct:= OnRender;
  {$ENDIF}

  if Render_Single_Pass( False, 0, Zoom*Cible.Rows - 1, Zoom ) then
    Render_Directly_Gray_Glyph := Success;

  freemem(cible.Buffer, cible.Cols);

end;

function Render_Directly_Gray_Glyph_HQ( var glyph   : TT_Outline;
                            x,y,tx,ty: integer;
                            OnRender: TDirectRenderingFunction) : TError;
const Zoom = 8;
begin

  Render_Directly_Gray_Glyph_HQ := Failure;

  Direct_X := x;
  Direct_Y := y+ty-1;
  Direct_TX := tx;

  cible.Width := tx;
  cible.Rows := ty;
  cible.Cols := (cible.Width+3) and not 3;
  cible.Flow := TT_Flow_Down;
  getmem(cible.Buffer, cible.Cols);
  fillchar(cible.Buffer^, cible.Cols, 0);

  Outs      := Glyph.conEnds;
  Flags     := PByte(glyph.flags);
  //nPoints   := Glyph.n_points;
  nContours := Glyph.n_contours;

  points := Glyph.points;

  Set_High_Precision( false );
  pool.SetScaleShift(precision_shift+3);
  DropOutControl := glyph.dropout_mode;
  second_pass    := false;

  Error := Err_Ras_None;

  BGray_Incr := (Cible.Width*Zoom+7) shr 3;
  BGray_End  := BGray_Incr*Zoom;
  BGray_NeedCapacity(BGray_End);
  BWidth := BGray_Incr shl 3;

  BCible := PByte( BGray_Data   );
  GCible := PByte( Cible.Buffer );

  {$IFDEF FPC}
  Proc_Sweep_Init := @Vertical_Gray_Sweep_Init_Direct_HQ;
  Proc_Sweep_Span := @Vertical_Sweep_Span;
  Proc_Sweep_Drop := @Vertical_Sweep_Drop;
  Proc_Sweep_Step := @Vertical_Gray_Sweep_Step_Direct_HQ;
  Proc_Sweep_Direct:= OnRender;
  {$ELSE}
  Proc_Sweep_Init := Vertical_Gray_Sweep_Init_Direct_HQ;
  Proc_Sweep_Span := Vertical_Sweep_Span;
  Proc_Sweep_Drop := Vertical_Sweep_Drop;
  Proc_Sweep_Step := Vertical_Gray_Sweep_Step_Direct_HQ;
  Proc_Sweep_Direct:= OnRender;
  {$ENDIF}

  if Render_Single_Pass( False, 0, Zoom*Cible.Rows - 1, Zoom ) then
    Render_Directly_Gray_Glyph_HQ := Success;

  freemem(cible.Buffer, cible.Cols);

end;



(****************************************************************************)
(*                                                                          *)
(* Function:    Init_Rasterizer                                             *)
(*                                                                          *)
(* Description: Initializes the rasterizer.                                 *)
(*                                                                          *)
(* Input:       rasterBlock   target bitmap/pixmap description              *)
(*              profBuffer    pointer to the render pool                    *)
(*              profSize      size in bytes of the render pool              *)
(*                                                                          *)
(* Returns:     1 ( always, but we should check parameters )                *)
(*                                                                          *)
(****************************************************************************)

function TTRaster_Init : TError;
var
  i, j, c, l : integer;
const
  Default_Grays : array[0..4] of Byte
                = ( 0, 23, 27, 29, 31 );
begin
  Pool := nil;
  BGray_Data := nil;
  BGray_Capacity := 0;

  { Initialisation of Count_Table }

  for i := 0 to 255 do
  begin
    l := 0;
    j := i;
    for c := 0 to 3 do
    begin
      l := l shl 4;
      if ( j and $80 <> 0 ) then inc(l);
      if ( j and $40 <> 0 ) then inc(l);
      j := (j shl 2) and $FF;
    end;
    Count_table[i] := l;
  end;

  for i := 0 to 255 do
  begin
    BitCountTable[i] := (i and 1) + (i shr 1 and 1) + (i shr 2 and 1) + (i shr 3 and 1) +
       (i shr 4 and 1) + (i shr 5 and 1) + (i shr 6 and 1) + (i shr 7 and 1);
  end;

  (* default Grays takes the gray levels of the standard VGA *)
  (* 256 colors mode                                                *)

  for i := 0 to high(Grays) do
    Grays[i] := Default_Grays[i];

  Set_High_Precision(False);
  Set_Second_Pass(False);
  Pool := TRenderPool.Create(Precision,Precision_Step);

  DropOutControl := 2;
  Error          := Err_Ras_None;

  TTRaster_Init := Success;
end;

procedure Cycle_DropOut;
begin
  case DropOutControl of

    0 : DropOutControl := 1;
    1 : DropOutControl := 2;
    2 : DropOutControl := 4;
    4 : DropOutControl := 5;
  else
    DropOutControl := 0;
  end;
end;

procedure TTRaster_Done;
begin
  Pool.Free;
  if BGray_Data <> nil then
    FreeMem( BGray_Data, BGray_Capacity );
end;


end.