 |  | printers-pgm |  |
 |  | printe-pgm.ads |  |
 | printe-pgm.adb |
|  | printers | |
| | printers | |
| printers-pgm | ||
| printers-ps | ||
| printers-svg |
| | engine | |
|  | boxes/ | |
| collectors/ | ||
| output/ | ||
| printers/ | ||
| roemer.adb | ||
| test_engine.ad |
| | ada | |
| | bin/ | |
| engine/ | ||
| fonts/ | ||
| internal/ | ||
| text/ | ||
| util/ |
|  | Home | |
|  | Showcase | |
 | Snapshots | ||
 | Ada Source | ||
 | PHP Source | ||
 | Fonts |
|  | Sourceforge | |
|  | Summary | |
 | Downloads | ||
 | Browse CVS | ||
 | Donate | ||
 | Activity |
Hosted by
-- $Date: 2004/03/08 10:50:55 $
-- $Revision: 1.7 $
-- $Author: jcrocholl $
-- $Hash: dd2d969ef0868595feefe1f97944685c $
-- This file was automatically created with ado.php.
-- Manual changes will be lost when it is updated.
with Integer_Strings; use Integer_Strings;
package body Printers.PGM is
-- Constructor for instances.
function Create
(Filename : in String) -- The initial filename.
return PGM_Printer_Access -- The newly created pgm printer.
is
Result : PGM_Printer_Access := new PGM_Printer;
begin
To_String_Access(Filename, Result.Filename);
return Result;
end Create;
function Get_Format
(This : access PGM_Printer) -- The pgm printer object instance.
return String is -- Maximum of four characters.
begin
return "PGM";
end Get_Format;
procedure Set_Bounds
(This : access PGM_Printer; -- The pgm printer object instance.
Bounds : in Rectangle; -- The new bounding box.
Staff_Height : in Real) -- Output zoom factor.
is
type Parent_Access is access all Printer;
begin
Set_Bounds(Parent_Access(This), Bounds, Staff_Height);
This.Image := Bounds_To_Image(This.Bounds, Staff_Height);
Fill(This.Image, White);
Print_Staff_Lines(This);
end Set_Bounds;
procedure Print_Staff_Lines
(This : access PGM_Printer) -- The pgm printer object instance.
is
H : Natural;
H1, H2 : Natural;
Line_Y : Integer;
begin
H := Natural(This.Image.Staff_Height / 40.0);
if H > 0 then H := H - 1; end if;
H1 := H / 2;
H2 := H - H1;
for Index in -2 .. 2 loop
Line_Y := Integer(This.Image.Center.Y + This.Image.Staff_Height / 4.0 * Real(Index));
for Y in Line_Y - H1 .. Line_Y + H2 loop
if Y in This.Image.Pixels'Range(1) then
for X in This.Image.Pixels'Range(2) loop
This.Image.Pixels(Y, X) := 0;
end loop;
end if;
end loop;
end loop;
end Print_Staff_Lines;
procedure Print
(This : access PGM_Printer; -- The pgm printer object instance.
Add : access Glyph; -- Add this glyph.
Center : in Vector) is -- Center coordinates.
begin
Glyphs.Print(Add, This.Image, Center);
end Print;
procedure To_Pixels
(This : access PGM_Printer; -- The pgm printer object instance.
Box : in Rectangle; -- Convert this box.
Left : out Integer; -- Horizontal minimum.
Top : out Integer; -- Vertical minimum.
Right : out Integer; -- Horizontal maximum.
Bottom : out Integer) -- Vertical maximum.
is
Width, Height : Integer;
begin
Left := Integer(This.Image.Center.X + Box.Left * This.Image.Staff_Height / 400.0);
Top := Integer(This.Image.Center.Y + Box.Top * This.Image.Staff_Height / 400.0);
Width := Integer(Get_Width(Box) * This.Image.Staff_Height / 400.0);
Height := Integer(Get_Height(Box) * This.Image.Staff_Height / 400.0);
Right := Left + Width;
Bottom := Top + Height;
-- if Left < This.Image.Pixels'First(2) then Left := This.Image.Pixels'First(2); end if;
-- if Top < This.Image.Pixels'First(1) then Top := This.Image.Pixels'First(1); end if;
-- if Right > This.Image.Pixels'Last(2) then Right := This.Image.Pixels'Last(2); end if;
-- if Bottom > This.Image.Pixels'Last(1) then Bottom := This.Image.Pixels'Last(1); end if;
-- Debug("box: " &
-- To_String(Left) & " " & To_String(Top) & " " &
-- To_String(Right) & " " & To_String(Bottom));
end To_Pixels;
procedure Darken_Pixel
(This : access PGM_Printer; -- The pgm printer object instance.
Y, X : in Integer; -- Darken this pixel.
Color : in Gray_Pixel) -- Desired color.
is
use type Gray_Images.Gray_Pixel;
begin
if Y in This.Image.Pixels'Range(1)
and X in This.Image.Pixels'Range(2)
then
if This.Image.Pixels(Y, X) > Color then
This.Image.Pixels(Y, X) := Color;
end if;
end if;
end Darken_Pixel;
procedure Frame_Box
(This : access PGM_Printer; -- The pgm printer object instance.
Box : in Rectangle; -- Box coordinates.
Color : in Gray_Pixel) -- Use this color.
is
Left, Top, Right, Bottom : Integer;
begin
To_Pixels(This, Box, Left, Top, Right, Bottom);
for X in Left .. Right loop
Darken_Pixel(This, Top, X, Color);
Darken_Pixel(This, Bottom, X, Color);
end loop;
for Y in Top .. Bottom loop
Darken_Pixel(This, Y, Left, Color);
Darken_Pixel(This, Y, Right, Color);
end loop;
end Frame_Box;
procedure Fill_Box
(This : access PGM_Printer; -- The pgm printer object instance.
Box : in Rectangle; -- Box coordinates.
Color : in Gray_Pixel) -- Use this color.
is
Left, Top, Right, Bottom : Integer;
begin
To_Pixels(This, Box, Left, Top, Right, Bottom);
for X in Left .. Right loop
for Y in Top .. Bottom loop
Darken_Pixel(This, Y, X, Color);
end loop;
end loop;
end Fill_Box;
procedure Write
(This : access PGM_Printer) is -- The pgm printer object instance.
begin
Write(To_String(This.Filename), This.Image);
-- Minimum : Real := 12000.0;
-- Optimum : Real := 12000.0;
-- Bounds : Rectangle; -- Bounds of the result image.
-- Estimate_Width(This.Stave_Box, Minimum, Optimum);
-- Bounds := (0.0, -5000.0, Optimum, 5000.0);
-- Image := Bounds_To_Image(Bounds, Staff_Height);
-- Debug(To_String(Image.Width));
-- Debug(To_String(Image.Height));
-- Background(Image);
-- Render_Staff_Lines(This, Image);
end Write;
end Printers.PGM;