Hosted by
 |
with Pipes; use Pipes;
with PBM; use PBM;
with Real_Numbers; use Real_Numbers;
with Real_Strings; use Real_Strings;
with Integer_Strings; use Integer_Strings;
with Messages; use Messages;
with Lines; use Lines;
with Straights; use Straights;
with Outlines; use Outlines;
with Lists;
package body Read_PBM is
type End_Record is record
O : Outline;
X : Integer;
end record;
package End_Lists is new Lists(End_Record);
use End_Lists;
subtype End_List is End_Lists.List;
package Change_Lists is new Lists(Integer);
use Change_Lists;
subtype Change_List is Change_Lists.List;
procedure Find_Changes
(Bits : in Bit_Buffer;
Width : in Positive;
Result : in out Change_List)
is
Bit : Boolean;
Previous : Boolean;
begin
Previous := False;
for X in 1 .. Width loop
Bit := Read_Pixel(Bits);
if Bit /= Previous then
Change_Lists.Push(Result, X - 1);
Previous := Bit;
end if;
end loop;
if Previous then
Change_Lists.Push(Result, Width);
end if;
end Find_Changes;
function Create
(X, Y : in Integer)
return Line is
begin
return Create(((Real(X), Real(Y))));
end Create;
procedure Create_Outline
(White_To_Black : in Boolean;
Changes : in out Change_List;
Y : in Integer;
Ends : in out End_List)
is
X1, X2 : Integer;
New_Outline : Outline;
begin
X1 := Current(Changes);
Remove_Current(Changes);
X2 := Current(Changes);
Remove_Current(Changes);
if White_To_Black then
Line_Lists.Push(New_Outline, Create(X1, Y));
Line_Lists.Push(New_Outline, Create(X2, Y));
else
Line_Lists.Push(New_Outline, Create(X2, Y));
Line_Lists.Push(New_Outline, Create(X1, Y));
end if;
Insert_Before_Current(Ends, (O => New_Outline, X => X1));
Insert_Before_Current(Ends, (O => New_Outline, X => X2));
end Create_Outline;
procedure Replace_Outline
(Ends : in out End_List;
A, B : in Outline)
is
use type Outline;
Current : End_Lists.Item := First_Item(Ends);
E : End_Record := Item_Content(Current);
begin
E := Item_Content(Current);
while E.O /= A loop
Next_Item(Current);
E := Item_Content(Current);
end loop;
E.O := B;
Update_Item(Current, E);
end Replace_Outline;
procedure Close_Outline
(White_To_Black : in Boolean;
Y : in Integer;
Ends : in out End_List;
Result : in out Glyph)
is
use type Outline;
End1, End2 : End_Record;
O1, O2 : Outline;
begin
End1 := Current(Ends);
Remove_Current(Ends);
O1 := End1.O;
End2 := Current(Ends);
Remove_Current(Ends);
O2 := End2.O;
if White_To_Black then
Line_Lists.Unshift(O1, Create(End1.X, Y));
Line_Lists.Push (O2, Create(End2.X, Y));
else
Line_Lists.Push (O1, Create(End1.X, Y));
Line_Lists.Unshift(O2, Create(End2.X, Y));
end if;
if O1 = O2 then
Add_Outline(Result, O1);
else
if White_To_Black then
Line_Lists.Append(O2, O1);
Replace_Outline(Ends, O1, O2);
else
Line_Lists.Append(O1, O2);
Replace_Outline(Ends, O2, O1);
end if;
end if;
end Close_Outline;
procedure Append
(White_To_Black : in out Boolean;
Changes : in out Change_List;
Y : in Integer;
Ends : in out End_List)
is
X : Integer := Current(Changes);
E : End_Record;
O : Outline;
begin
Remove_Current(Changes);
if X /= Current(Ends).X then
if White_To_Black then
O := Current(Ends).O;
Line_Lists.Unshift(O, Create(Current(Ends).X, Y));
Line_Lists.Unshift(O, Create(X, Y));
else
O := Current(Ends).O;
Line_Lists.Push(O, Create(Current(Ends).X, Y));
Line_Lists.Push(O, Create(X, Y));
end if;
E := Current(Ends);
E.X := X;
Update_Current(Ends, E);
end if;
White_To_Black := not White_To_Black;
End_Lists.Next(Ends);
end Append;
procedure Read_Line
(Changes : in out Change_List;
Y : in Integer;
Ends : in out End_List;
Result : in out Glyph)
is
White_To_Black : Boolean := True;
procedure Debug is
begin
Debug2(To_String(End_Lists.Count(Ends)) & " ends");
End_Lists.Reset(Ends);
while End_Lists.Next(Ends) loop
Debug2(" " & To_String(Current(Ends).X));
end loop;
Debug2(", ");
Debug2(To_String(Change_Lists.Count(Changes)) & " changes");
Change_Lists.Reset(Changes);
while Change_Lists.Next(Changes) loop
Debug2(" " & To_String(Current(Changes)));
end loop;
Debug("");
end Debug;
begin
Reset(Ends);
Next(Ends);
Reset(Changes);
Next(Changes);
while not Empty(Ends)
and then not End_Of_List(Ends)
and then not Empty(Changes)
and then not End_Of_List(Changes)
loop
if not End_Of_List(Changes)
and then Next_Available(Changes)
and then Next_Content(Changes) < Current(Ends).X
then
Create_Outline(White_To_Black, Changes, Y, Ends);
elsif not End_Of_List(Ends)
and then Next_Available(Ends)
and then Next_Content(Ends).X < Current(Changes)
then
Close_Outline(White_To_Black, Y, Ends, Result);
else
Append(White_To_Black, Changes, Y, Ends);
end if;
end loop;
while not Empty(Changes)
and then not End_Of_List(Changes)
loop
Create_Outline(White_To_Black, Changes, Y, Ends);
end loop;
while not Empty(Ends)
and then not End_Of_List(Ends)
loop
Close_Outline(White_To_Black, Y, Ends, Result);
end loop;
end Read_Line;
function Read_Stream
(Stream : in Stream_Access)
return Glyph
is
Width : Positive;
Height : Positive;
Bits : PBM.Bit_Buffer;
Ends : End_List;
Changes : Change_List;
Result : Glyph;
begin
PBM.Read_Header(Stream, Width, Height);
Result := Create("");
Set_Bounds(Result, 0.0, 0.0, Real(Width), Real(Height));
Bits := Create((Width + 7) / 8);
for Y in reverse 1 .. Height loop
Read_Row(Stream, Bits);
Find_Changes(Bits, Width, Changes);
Read_Line(Changes, Y, Ends, Result);
end loop;
Clear(Bits);
Read_Line(Changes, 0, Ends, Result);
Deallocate(Bits);
return Result;
end Read_Stream;
function Read_Current_Input
return Glyph
is
Input : Stream_Access := Stream_Access(Pipes.Std_In);
begin
return Read_Stream(Input);
end Read_Current_Input;
function Read_File
(Filename : in String)
return Glyph
is
File : File_Type;
Result : Glyph;
begin
Open(File, In_File, Filename);
Result := Read_Stream(Stream(File));
Close(File);
return Result;
end Read_File;
end Read_PBM;
|