Hosted by
 |
with Ada.Text_IO; use Ada;
with Real_Vectors; use Real_Vectors;
with Gray_Images; use Gray_Images;
with Lines; use Lines;
with Glyphs; use Glyphs; use Glyphs.Outline_Lists;
with Outlines; use Outlines; use Outlines.Line_Lists;
with Intersections; use Intersections;
with Intersection_Heaps; use Intersection_Heaps;
package body Render_Glyphs is
type Heap_Array is array(Positive range <>) of Heap;
type Natural_Array is array(Positive range <>) of Natural;
function To_Pixel
(Y : in Real;
Zoom_Y : in Real;
Center_Y : in Positive;
Offset : in Real)
return Real is
begin
return Real(Center_Y) + Y * Zoom_Y + Offset;
end To_Pixel;
function To_Glyph
(Y : in Positive;
Zoom_Y : in Real;
Center_Y : in Positive;
Offset : in Real)
return Real is
begin
return (Real(Y - Center_Y) - Offset) / Zoom_Y;
end To_Glyph;
function Larger
(Y : in Real)
return Integer
is
Result : Integer := Integer(Y);
begin
if Real(Result) <= Y then Result := Result + 1; end if;
return Result;
end Larger;
function Larger_Or_Equal
(Y : in Real)
return Integer
is
Result : Integer := Integer(Y);
begin
if Real(Result) < Y then Result := Result + 1; end if;
return Result;
end Larger_Or_Equal;
function Smaller
(Y : in Real)
return Integer
is
Result : Integer := Integer(Y);
begin
if Real(Result) >= Y then Result := Result - 1; end if;
return Result;
end Smaller;
function Smaller_Or_Equal
(Y : in Real)
return Integer
is
Result : Integer := Integer(Y);
begin
if Real(Result) > Y then Result := Result - 1; end if;
return Result;
end Smaller_Or_Equal;
procedure Intersect
(This : in Glyph;
Zoom_X : in Real;
Zoom_Y : in Real;
Center_X : in Positive;
Center_Y : in Positive;
Offset : in Real;
Heaps : in out Heap_Array)
is
Outlines : Outline_List;
Current_Outline : Outline;
Current_Line : Line;
P1, P2 : Vector;
White_To_Black : Boolean;
Slope : Real;
Y1, Y2 : Integer;
Pixel_X : Real;
Real_X, Real_Y : Real;
begin
Outlines := Get_Outlines(This);
Reset(Outlines);
while Next(Outlines) loop
Current_Outline := Current(Outlines);
P2 := Last(Current_Outline).To;
Reset(Current_Outline);
while Next(Current_Outline) loop
Current_Line := Current(Current_Outline);
P1 := P2;
P2 := Current_Line.To;
if P1.Y /= P2.Y then
White_To_Black := P1.Y < P2.Y;
if White_To_Black then
Y1 := Larger(To_Pixel(P1.Y, Zoom_Y, Center_Y, Offset));
Y2 := Smaller_Or_Equal(To_Pixel(P2.Y, Zoom_Y, Center_Y, Offset));
else
Y1 := Larger(To_Pixel(P2.Y, Zoom_Y, Center_Y, Offset));
Y2 := Smaller_Or_Equal(To_Pixel(P1.Y, Zoom_Y, Center_Y, Offset));
end if;
if (P1.X = P2.X) then
Pixel_X := To_Pixel(P1.X, Zoom_X, Center_X, 0.0);
for Y in Y1 .. Y2 loop
Insert(Heaps(Y), (Pixel_X, White_To_Black));
end loop;
else
Slope := (P1.Y - P2.Y) / (P1.X - P2.X);
for Y in Y1 .. Y2 loop
Real_Y := To_Glyph(Y, Zoom_Y, Center_Y, Offset);
Real_X := Real(P1.X) + (Real_Y - P1.Y) / Slope;
Pixel_X := To_Pixel(Real_X, Zoom_X, Center_X, 0.0);
Insert(Heaps(Y), (Pixel_X, White_To_Black));
end loop;
end if;
end if;
end loop;
end loop;
end Intersect;
procedure Collect
(Anti_Alias : in Positive;
Heaps : in out Heap_Array;
Pixels : out Gray_Pixel_Array_2)
is
Black_Count : Integer;
Black_Start : Real;
Pixel_Black : Real;
use type Gray_Pixel;
Width : Positive := Pixels'Length(2);
Collected : Natural_Array(1 .. Width) := (others => 0);
procedure Fill_White
(L : in Real;
X : in out Positive) is
begin
if X <= Smaller_Or_Equal(L - 0.5) and X <= Pixels'Last(2) then
Collected(X) := Collected(X) +
Natural(255.0 * (1.0 - Pixel_Black));
Pixel_Black := 0.0;
X := X + 1;
end if;
while X <= Smaller_Or_Equal(L - 0.5) and X <= Pixels'Last(2) loop
Collected(X) := Collected(X) + 255;
X := X + 1;
end loop;
Black_Start := L;
end Fill_White;
procedure Fill_Black
(L : in Real;
X : in out Positive)
is
Black_Stop : Real;
begin
if L <= Real(X) + 0.5 then
Black_Stop := L;
Pixel_Black := Pixel_Black + Black_Stop - Black_Start;
else
Black_Stop := Real(X) + 0.5;
Pixel_Black := Pixel_Black + Black_Stop - Black_Start;
if X <= Smaller_Or_Equal(L - 0.5) and X <= Pixels'Last(2) then
Collected(X) := Collected(X) +
Natural(255.0 * (1.0 - Pixel_Black));
Pixel_Black := 0.0;
X := X + 1;
end if;
while X <= Smaller_Or_Equal(L - 0.5) and X <= Pixels'Last(2) loop
X := X + 1;
end loop;
Black_Start := Real(X) - 0.5;
Black_Stop := L;
Pixel_Black := Pixel_Black + Black_Stop - Black_Start;
end if;
end Fill_Black;
X : Positive;
Y : Positive;
I : Intersection;
begin
for Heaps_Y in Heaps'Range loop
Black_Count := 0;
Pixel_Black := 0.0;
X := Collected'First;
while Count(Heaps(Heaps_Y)) /= 0 loop
I := Extract(Heaps(Heaps_Y));
if I.White_To_Black then
Black_Count := Black_Count + 1;
if Black_Count = 1 then Fill_White(I.X, X); end if;
else
if Black_Count = 1 then Fill_Black(I.X, X); end if;
Black_Count := Black_Count - 1;
end if;
exit when X > Pixels'Last(2);
end loop;
if X <= Pixels'Last(2) then
Fill_White(Real(Pixels'Last(2) + 2), X);
end if;
if Heaps_Y mod Anti_Alias = 0 then
Y := Heaps_Y / Anti_Alias;
for X in Collected'Range loop
Pixels(Y, X) := Gray_Pixel(Collected(X) / Anti_Alias);
Collected(X) := 0;
end loop;
end if;
end loop;
end Collect;
function Render
(This : in Glyph;
Staff_Height : in Real;
Aspect_Ratio : in Real := 1.0;
Anti_Alias : in Positive := 1)
return Glyph_Image
is
Zoom_Y : Real := Staff_Height / 4.0;
Zoom_X : Real := Zoom_Y * Aspect_Ratio;
BL : Vector := Get_Bottom_Left(Get_Bounds(This));
TR : Vector := Get_Top_Right(Get_Bounds(This));
Center_X : Positive := 1 + Larger_Or_Equal(-Zoom_X * BL.X - 0.5);
Center_Y : Positive := 1 + Larger_Or_Equal(-Zoom_Y * BL.Y - 0.5);
Width : Positive := Center_X + Larger_Or_Equal(Zoom_X * TR.X - 0.5);
Height : Positive := Center_Y + Larger_Or_Equal(Zoom_Y * TR.Y - 0.5);
Heaps : Heap_Array(1 .. Height * Anti_Alias);
Result : Glyph_Image := new Glyph_Image_Record(Width, Height);
begin
Text_IO.Put(Positive'Image(Width));
Text_IO.Put(Positive'Image(Height));
Text_IO.Put(Positive'Image(Center_X));
Text_IO.Put(Positive'Image(Center_Y));
Text_IO.New_Line;
Result.Zoom := Staff_Height;
Result.Aspect_Ratio := Aspect_Ratio;
Intersect(This,
Zoom_X, Zoom_Y * Real(Anti_Alias),
Center_X, Center_Y * Anti_Alias,
-Real(Anti_Alias - 1) / 2.0,
Heaps);
Collect(Anti_Alias, Heaps, Result.Pixels);
return Result;
end Render;
end Render_Glyphs;
|