1{    This flag is currently ignored by the Virtual Compiler }
2
3(***********************************************************************)
4(*                                                                     *)
5(*  Vertical Sweep Procedure Set :                                     *)
6(*                                                                     *)
7(*  These three routines are used during the vertical black/white      *)
8(*  sweep phase by the generic Draw_Sweep function.                    *)
9(*                                                                     *)
10(***********************************************************************)
11
12procedure TFreeTypeRasterizer.Vertical_Sweep_Init( var min, {%H-}max : Int );
13begin
14  case Cible.flow of
15
16    TT_Flow_Up : begin
17                   traceBOfs  := min * Cible.cols;
18                   traceBIncr := Cible.cols;
19                 end;
20  else
21    traceBOfs  := (Cible.rows - 1 - min)*Cible.cols;
22    traceBIncr := -Cible.cols;
23  end;
24
25  gray_min_x := 0;
26  gray_max_x := 0;
27end;
28
29
30
31procedure TFreeTypeRasterizer.Vertical_Sweep_Span( {%H-}y     : Int;
32                               x1,
33                               x2    : TT_F26dot6;
34                               {%H-}Left,
35                               {%H-}Right : TProfile );
36var
37  e1, e2  : Longint;
38  c1, c2  : Int;
39  f1, f2  : Int;
40  base    : PByte;
41begin
42  e1 := (( x1+Precision-1 ) and Precision_Mask) div Precision;
43
44  if ( x2-x1-Precision <= Precision_Jitter ) then
45    e2 := e1
46  else
47    e2 := ( x2 and Precision_Mask ) div Precision;
48
49  if (e2 >= 0) and (e1 < BWidth) then
50
51    begin
52      if e1 <  0      then e1 := 0;
53      if e2 >= BWidth then e2 := BWidth-1;
54
55      c1 := e1 shr 3;
56      c2 := e2 shr 3;
57
58      f1 := e1 and 7;
59      f2 := e2 and 7;
60
61      if gray_min_X > c1 then gray_min_X := c1;
62      if gray_max_X < c2 then gray_max_X := c2;
63
64      base := @BCible^[TraceBOfs + c1];
65
66      if c1 = c2 then
67        base^[0] := base^[0] or ( LMask[f1] and Rmask[f2] )
68      else
69       begin
70         base^[0] := base^[0] or LMask[f1];
71
72         if c2>c1+1 then
73           FillChar( base^[1], c2-c1-1, $FF );
74
75         base     := @base^[c2-c1];
76         base^[0] := base^[0] or RMask[f2];
77       end
78    end;
79end;
80
81
82procedure TFreeTypeRasterizer.Vertical_Sweep_Drop( y     : Int;
83                               x1,
84                               x2    : TT_F26dot6;
85                               Left,
86                               Right : TProfile );
87var
88  e1, e2  : Longint;
89  c1  : Int;
90  f1  : Int;
91
92  j : Int;
93begin
94
95  (* Drop-out control *)
96
97  e1 := ( x1+Precision-1 ) and Precision_Mask;
98  e2 := x2 and Precision_Mask;
99
100  (* We are guaranteed that x2-x1 <= Precision here *)
101
102  if e1 > e2 then
103   if e1 = e2 + Precision then
104
105    case DropOutControl of
106
107      (* Drop-out Control Rule #3 *)
108      1 : e1 := e2;
109
110      4 : begin
111            e1 := ((x1+x2+1) div 2 + Precision-1) and Precision_Mask;
112            e2 := e1;
113          end;
114
115      (* Drop-out Control Rule #4 *)
116
117      (* The spec is not very clear regarding rule #4. It       *)
118      (* presents a method that is way too costly to implement  *)
119      (* while the general idea seems to get rid of 'stubs'.    *)
120      (*                                                        *)
121      (* Here, we only get rid of stubs recognized when :       *)
122      (*                                                        *)
123      (*  upper stub :                                          *)
124      (*                                                        *)
125      (*   - P_Left and P_Right are in the same contour         *)
126      (*   - P_Right is the successor of P_Left in that contour *)
127      (*   - y is the top of P_Left and P_Right                 *)
128      (*                                                        *)
129      (*  lower stub :                                          *)
130      (*                                                        *)
131      (*   - P_Left and P_Right are in the same contour         *)
132      (*   - P_Left is the successor of P_Right in that contour *)
133      (*   - y is the bottom of P_Left                          *)
134      (*                                                        *)
135
136      2,5 : begin
137
138            if ( x2-x1 < Precision_Half ) then
139            begin
140              (* upper stub test *)
141
142              if ( Left.nextInContour = Right ) and
143                 ( Left.Height <= 0 )  then exit;
144
145              (* lower stub test *)
146
147              if ( Right.nextInContour = Left ) and
148                 ( Left.Start = y   ) then exit;
149            end;
150
151            (* Check that the rightmost pixel is not already set *)
152            e1 := e1 div Precision;
153
154            c1 := e1 shr 3;
155            f1 := e1 and 7;
156
157            if ( e1 >= 0 ) and ( e1 < BWidth )                and
158               ( BCible^[TraceBOfs+c1] and ($80 shr f1) <> 0 ) then
159              exit;
160
161            case DropOutControl of
162              2 : e1 := e2;
163              5 : e1 := ((x1+x2+1) div 2 + Precision-1) and Precision_Mask;
164            end;
165
166            e2 := e1;
167
168          end;
169    else
170      exit;  (* unsupported mode *)
171    end
172
173   else
174  else
175    e2 := e1;   (* when x1 = e1, x2 = e2, e2 = e1 + 64 *)
176
177  e1 := e1 div Precision;
178
179  if (e1 >= 0) and (e1 < BWidth ) then
180    begin
181      c1 := e1 shr 3;
182      f1 := e1 and 7;
183
184      if gray_min_X > c1 then gray_min_X := c1;
185      if gray_max_X < c1 then gray_max_X := c1;
186
187      j := TraceBOfs + c1;
188
189      BCible^[j] := BCible^[j] or ($80 shr f1);
190    end;
191end;
192
193
194
195procedure TFreeTypeRasterizer.Vertical_Sweep_Step;
196begin
197  inc( TraceBOfs, traceBIncr );
198end;
199
200
201(***********************************************************************)
202(*                                                                     *)
203(*  Horizontal Sweep Procedure Set :                                   *)
204(*                                                                     *)
205(*  These three routines are used during the horizontal black/white    *)
206(*  sweep phase by the generic Draw_Sweep function.                    *)
207(*                                                                     *)
208(***********************************************************************)
209
210procedure TFreeTypeRasterizer.Horizontal_Sweep_Init( var {%H-}min, {%H-}max : Int );
211begin
212  (* Nothing, really *)
213end;
214
215
216procedure TFreeTypeRasterizer.Horizontal_Sweep_Span( y     : Int;
217                                 x1,
218                                 x2    : TT_F26dot6;
219                                 {%H-}Left,
220                                 {%H-}Right : TProfile );
221var
222  e1, e2  : Longint;
223  c1  : Int;
224  f1  : Int;
225
226  j : Int;
227begin
228
229  if ( x2-x1 < Precision ) then
230  begin
231    e1 := ( x1+(Precision-1) ) and Precision_Mask;
232    e2 := x2 and Precision_Mask;
233
234    if e1 = e2 then
235    begin
236      c1 := y shr 3;
237      f1 := y and 7;
238
239      if (e1 >= 0) then
240      begin
241        e1 := e1 shr Precision_Bits;
242        if Cible.flow = TT_Flow_Up then
243          j := c1 + e1*Cible.cols
244        else
245          j := c1 + (Cible.rows-1-e1)*Cible.cols;
246        if e1 < Cible.Rows then
247          BCible^[j] := BCible^[j] or ($80 shr f1);
248      end;
249    end;
250  end;
251
252{$IFDEF RIEN}
253  e1 := ( x1+(Precision-1) ) and Precision_Mask;
254  e2 := x2 and Precision_Mask;
255
256  (* We are here guaranteed that x2-x1 > Precision *)
257
258   c1 := y shr 3;
259   f1 := y and 7;
260
261   if (e1 >= 0) then
262   begin
263     e1 := e1 shr Precision_Bits;
264     if Cible.flow = TT_Flow_Up then
265       j := c1 + e1*Cible.cols
266     else
267       j := c1 + (Cible.rows-1-e1)*Cible.cols;
268     if e1 < Cible.Rows then
269       BCible^[j] := BCible^[j] or ($80 shr f1);
270   end;
271
272   if (e2 >= 0) then
273   begin
274     e2 := e2 shr Precision_Bits;
275     if Cible.flow = TT_Flow_Up then
276       j := c1 + e1*Cible.cols
277     else
278       j := c1 + (Cible.rows-1-e2)*Cible.cols;
279     if (e2 <> e1) and (e2 < Cible.Rows) then
280       BCible^[j] := BCible^[j] or ($80 shr f1);
281   end;
282{$ENDIF}
283
284end;
285
286
287
288procedure TFreeTypeRasterizer.Horizontal_Sweep_Drop( y     : Int;
289                                 x1,
290                                 x2    : TT_F26dot6;
291                                 Left,
292                                 Right : TProfile );
293var
294  e1, e2  : Longint;
295  c1  : Int;
296  f1  : Int;
297
298  j : Int;
299begin
300
301  e1 := ( x1+(Precision-1) ) and Precision_Mask;
302  e2 := x2 and Precision_Mask;
303
304  (* During the horizontal sweep, we only take care of drop-outs *)
305
306  if e1 > e2 then
307   if e1 = e2 + Precision then
308
309    case DropOutControl of
310
311      0 : exit;
312
313      (* Drop-out Control Rule #3 *)
314      1 : e1 := e2;
315
316      4 : begin
317            e1 := ( (x1+x2) div 2 +Precision div 2 ) and Precision_Mask;
318            e2 := e1;
319          end;
320
321      (* Drop-out Control Rule #4 *)
322
323      (* The spec is not very clear regarding rule #4. It       *)
324      (* presents a method that is way too costly to implement  *)
325      (* while the general idea seems to get rid of 'stubs'.    *)
326      (*                                                        *)
327
328      2,5 : begin
329
330              (* rightmost stub test *)
331
332              if ( Left.nextInContour = Right ) and
333                 ( Left.Height <= 0 )  then exit;
334
335              (* leftmost stub test *)
336
337              if ( Right.nextInContour = Left ) and
338                 ( Left.Start = y   ) then exit;
339
340              (* Check that the upmost pixel is not already set *)
341
342              e1 := e1 div Precision;
343
344              c1 := y shr 3;
345              f1 := y and 7;
346
347              if Cible.flow = TT_Flow_Up then
348                j := c1 + e1*Cible.cols
349              else
350                j := c1 + (Cible.rows-1-e1)*Cible.cols;
351
352              if ( e1 >= 0 ) and ( e1 < Cible.Rows ) and
353                 ( BCible^[j] and ($80 shr f1) <> 0 ) then exit;
354
355              case DropOutControl of
356                2 : e1 := e2;
357                5 : e1 := ((x1+x2) div 2 + Precision_Half) and Precision_Mask;
358              end;
359
360              e2 := e1;
361            end;
362    else
363      exit;  (* Unsupported mode *)
364    end;
365
366   c1 := y shr 3;
367   f1 := y and 7;
368
369   if (e1 >= 0) then
370   begin
371     e1 := e1 shr Precision_Bits;
372     if Cible.flow = TT_Flow_Up then
373       j := c1 + e1*Cible.cols
374     else
375       j := c1 + (Cible.rows-1-e1)*Cible.cols;
376     if e1 < Cible.Rows then BCible^[j] := BCible^[j] or ($80 shr f1);
377   end;
378
379end;
380
381
382
383procedure TFreeTypeRasterizer.Horizontal_Sweep_Step;
384begin
385  (* Nothing, really *)
386end;
387
388(***********************************************************************)
389(*                                                                     *)
390(*  Vertical Gray Sweep Procedure Set :                                *)
391(*                                                                     *)
392(*  These two   routines are used during the vertical gray-levels      *)
393(*  sweep phase by the generic Draw_Sweep function.                    *)
394(*                                                                     *)
395(*                                                                     *)
396(*  NOTES :                                                            *)
397(*                                                                     *)
398(*  - The target pixmap's width *must* be a multiple of 4              *)
399(*                                                                     *)
400(*  - you have to use the function Vertical_Sweep_Span for             *)
401(*    the gray span call.                                              *)
402(*                                                                     *)
403(***********************************************************************)
404
405procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Init( var min, {%H-}max : Int );
406begin
407  case Cible.flow of
408
409    TT_Flow_Up : begin
410                   traceGOfs  := (min div 2)*Cible.cols;
411                   traceGIncr := Cible.cols;
412                 end;
413  else
414    traceGOfs  := (Cible.rows-1- (min div 2))*Cible.cols;
415    traceGIncr := -Cible.cols;
416  end;
417
418  TraceBOfs   :=  0;
419  TraceBIncr  :=  BGray_Incr;
420  gray_min_x :=  Cible.Cols;
421  gray_max_x := -Cible.Cols;
422end;
423
424procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Init_HQ( var min, {%H-}max : Int );
425begin
426  case Cible.flow of
427
428    TT_Flow_Up : begin
429                   traceGOfs  := (min div 8)*Cible.cols;
430                   traceGIncr := Cible.cols;
431                 end;
432    TT_Flow_Down: begin
433                  traceGOfs  := (Cible.rows-1- (min div 8))*Cible.cols;
434                  traceGIncr := -Cible.cols;
435                end;
436    else
437    begin
438      traceGOfs := 0;
439      traceGIncr := 0;
440    end;
441  end;
442
443  TraceBOfs   :=  0;
444  TraceBIncr  :=  BGray_Incr;
445  gray_min_x :=  Cible.Cols;
446  gray_max_x := -Cible.Cols;
447end;
448
449
450procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Step;
451var
452  j, c1, c2 : Int;
453begin
454  inc( TraceBOfs, TraceBIncr );
455
456  if TraceBOfs = BGray_End then
457  begin
458
459    if gray_max_X >= 0 then
460    begin
461
462      if gray_max_x > cible.cols-1 then gray_max_x := cible.cols-1;
463      if gray_min_x < 0            then gray_min_x := 0;
464
465      j := TraceGOfs + gray_min_x*4;
466
467      for c1 := gray_min_x to gray_max_x do
468      begin
469
470        c2 := Count_Table[ BCible^[c1           ] ] +
471              Count_Table[ BCible^[c1+BGray_Incr] ];
472
473        if c2 <> 0 then
474        begin
475          BCible^[c1           ] := 0;
476          BCible^[c1+BGray_Incr] := 0;
477
478          GCible^[j] := GCible^[j] or Grays[ (c2 and $F000) shr 12 ]; inc(j);
479          GCible^[j] := GCible^[j] or Grays[ (c2 and $0F00) shr  8 ]; inc(j);
480          GCible^[j] := GCible^[j] or Grays[ (c2 and $00F0) shr  4 ]; inc(j);
481          GCible^[j] := GCible^[j] or Grays[ (c2 and $000F)        ]; inc(j);
482        end
483        else
484          inc( j, 4 );
485
486      end;
487    end;
488
489    TraceBOfs   := 0;
490    inc( TraceGOfs, traceGIncr );
491
492    gray_min_x :=  Cible.Cols;
493    gray_max_x := -Cible.Cols;
494  end;
495end;
496
497procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Step_HQ;
498var
499  j, c1 : Int;
500  c2, c3: byte;
501begin
502  inc( TraceBOfs, TraceBIncr );
503
504  if TraceBOfs = BGray_End then
505  begin
506
507    if gray_max_X >= 0 then
508    begin
509
510      if gray_max_x > cible.cols-1 then gray_max_x := cible.cols-1;
511      if gray_min_x < 0            then gray_min_x := 0;
512
513      j := TraceGOfs + gray_min_x;
514
515      for c1 := gray_min_x to gray_max_x do
516      begin
517
518        c2 := BitCountTable[ BCible^[c1                ] ] +
519              BitCountTable[ BCible^[c1 + BGray_Incr   ] ] +
520              BitCountTable[ BCible^[c1 + BGray_Incr*2 ] ] +
521              BitCountTable[ BCible^[c1 + BGray_Incr*3 ] ] +
522              BitCountTable[ BCible^[c1 + BGray_Incr*4 ] ] +
523              BitCountTable[ BCible^[c1 + BGray_Incr*5 ] ] +
524              BitCountTable[ BCible^[c1 + BGray_Incr*6 ] ] +
525              BitCountTable[ BCible^[c1 + BGray_Incr*7 ] ];
526
527        if c2 <> 0 then
528        begin
529          BCible^[c1             ] := 0;
530          BCible^[c1+BGray_Incr  ] := 0;
531          BCible^[c1+BGray_Incr*2] := 0;
532          BCible^[c1+BGray_Incr*3] := 0;
533          BCible^[c1+BGray_Incr*4] := 0;
534          BCible^[c1+BGray_Incr*5] := 0;
535          BCible^[c1+BGray_Incr*6] := 0;
536          BCible^[c1+BGray_Incr*7] := 0;
537
538          if c2 >= 63 then GCible^[j] := $ff else
539          begin
540            c2 := c2 shl 2;
541            c3 := GCible^[j];
542            if c3 = 0 then GCible^[j] := c2 else
543             GCible^[j] := c2 + (c3*(not c2) shr 8);
544          end;
545        end;
546        inc( j );
547
548      end;
549    end;
550
551    TraceBOfs   := 0;
552    inc( TraceGOfs, traceGIncr );
553
554    gray_min_x :=  Cible.Cols;
555    gray_max_x := -Cible.Cols;
556  end;
557end;
558
559(***********************************************************************)
560(*                                                                     *)
561(*  Horizontal Gray Sweep Procedure Set :                              *)
562(*                                                                     *)
563(*  These three routines are used during the horizontal gray-levels    *)
564(*  sweep phase by the generic Draw_Sweep function.                    *)
565(*                                                                     *)
566(***********************************************************************)
567
568procedure TFreeTypeRasterizer.Horizontal_Gray_Sweep_Span( y     : Int;
569                                      x1,
570                                      x2    : TT_F26dot6;
571                                      {%H-}Left,
572                                      {%H-}Right : TProfile );
573var
574  e1, e2    : TT_F26Dot6;
575  j : Int;
576begin
577  exit;
578  y  := y div 2;
579
580  e1 := ( x1+(Precision-1) ) and Precision_Mask;
581  e2 := x2 and Precision_Mask;
582
583  if (e1 >= 0) then
584  begin
585    e1 := e1 shr (Precision_Bits+1);
586(*    if Cible.flow = TT_Flow_Up then *)
587      j := y + e1*Cible.cols;
588(*    else
589//      j := y + (Cible.rows-1-e1)*Cible.cols;  *)
590    if e1 < Cible.Rows then
591      if GCible^[j] = Grays[0] then
592        GCible^[j] := Grays[1];
593  end;
594
595  if (e2 >= 0) then
596  begin
597    e2 := e2 shr (Precision_Bits+1);
598(*    if Cible.flow = TT_Flow_Up then *)
599      j := y + e2*Cible.cols;
600(*    else
601//      j := y + (Cible.rows-1-e2)*Cible.cols; *)
602    if (e2 <> e1) and (e2 < Cible.Rows) then
603      if GCible^[j] = Grays[0] then
604        GCible^[j] := Grays[1];
605  end;
606
607end;
608
609
610procedure TFreeTypeRasterizer.Horizontal_Gray_Sweep_Drop( y     : Int;
611                                      x1,
612                                      x2    : TT_F26dot6;
613                                      Left,
614                                      Right : TProfile );
615var
616  e1, e2  : Longint;
617  color   : Byte;
618  j : Int;
619begin
620
621  e1 := ( x1+(Precision-1) ) and Precision_Mask;
622  e2 := x2 and Precision_Mask;
623
624  (* During the horizontal sweep, we only take care of drop-outs *)
625
626  if e1 > e2 then
627   if e1 = e2 + Precision then
628
629    case DropOutControl of
630
631      0 : exit;
632
633      (* Drop-out Control Rule #3 *)
634      1 : e1 := e2;
635
636      4 : begin
637            e1 := ( (x1+x2) div 2 +Precision div 2 ) and Precision_Mask;
638            e2 := e1;
639          end;
640
641      (* Drop-out Control Rule #4 *)
642
643      (* The spec is not very clear regarding rule #4. It       *)
644      (* presents a method that is way too costly to implement  *)
645      (* while the general idea seems to get rid of 'stubs'.    *)
646      (*                                                        *)
647
648      2,5 : begin
649
650              (* lowest stub test *)
651
652              if ( Left.nextInContour = Right ) and
653                 ( Left.Height <= 0 )  then exit;
654
655              (* upper stub test *)
656
657              if ( Right.nextInContour = Left ) and
658                 ( Left.Start = y    ) then exit;
659
660              case DropOutControl of
661                2 : e1 := e2;
662                5 : e1 := ((x1+x2) div 2 + Precision_Half) and Precision_Mask;
663              end;
664
665              e2 := e1;
666            end;
667    else
668      exit;  (* Unsupported mode *)
669    end;
670
671   if (e1 >= 0) then
672   begin
673     (* A small trick to make 'average' thin line appear in *)
674     (* medium gray..                                       *)
675
676     if ( x2-x1 >= Precision_Half ) then
677       color := Grays[2]
678     else color := Grays[1];
679
680     e1 := e1 shr (Precision_Bits+1);
681     if Cible.flow = TT_Flow_Up then
682       j := (y div 2) + e1*Cible.cols
683     else
684       j := (y div 2) + (Cible.rows-1-e1)*Cible.cols;
685     if e1 < Cible.Rows then
686       if GCible^[j] = Grays[0] then
687         GCible^[j] := color;
688   end;
689end;
690
691