1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125 | --
-- Check if an image is opaque (fully non-transparent).
--
-- Small-size demo for the GID (Generic Image Decoder) package.
-- For a larger example, look for to_bmp.adb .
--
with GID;
with Ada.Calendar;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces;
procedure Is_opaque is
procedure Blurb is
begin
Put_Line (Current_Error, "Is_opaque * check if an image is opaque (fully non-transparent)");
Put_Line (Current_Error, "GID (Generic Image Decoder) package version " &
GID.version & " dated " & GID.reference);
Put_Line (Current_Error, "URL: " & GID.web);
New_Line (Current_Error);
Put_Line (Current_Error, "Syntax:");
Put_Line (Current_Error, "is_opaque <image_1> [<image_2>...]");
New_Line (Current_Error);
end Blurb;
procedure Check_raw_image (
image : in out GID.Image_descriptor;
next_frame : out Ada.Calendar.Day_Duration;
opaque : out Boolean
)
is
use Interfaces;
subtype Primary_color_range is Unsigned_8;
--
procedure Set_X_Y (x, y : Natural) is
begin
null;
end Set_X_Y;
--
procedure Put_Pixel (
red, green, blue : Primary_color_range;
alpha : Primary_color_range
)
is
pragma Unreferenced (blue, green, red);
begin
opaque := opaque and alpha = Primary_color_range'Last;
end Put_Pixel;
stars : Natural := 0;
procedure Feedback (percents : Natural) is
so_far : constant Natural := percents / 5;
begin
for i in stars + 1 .. so_far loop
Put (Current_Error, '*');
end loop;
stars := so_far;
end Feedback;
procedure Load_image is
new GID.Load_image_contents (
Primary_color_range, Set_X_Y,
Put_Pixel, Feedback, GID.fast
);
begin
opaque := True;
Load_image (image, next_frame);
end Check_raw_image;
procedure Process (image_name : String) is
f : Ada.Streams.Stream_IO.File_Type;
i : GID.Image_descriptor;
up_name : constant String := To_Upper (image_name);
--
next_frame : Ada.Calendar.Day_Duration := 0.0;
opaque_frame : Boolean;
begin
--
-- Load the image in its original format
--
Open (f, In_File, image_name);
Put_Line (Current_Error, "Checking " & image_name & "...");
--
GID.Load_image_header (
i,
Stream (f).all,
try_tga =>
image_name'Length >= 4 and then
up_name (up_name'Last - 3 .. up_name'Last) = ".TGA"
);
if GID.Expect_transparency (i) then
Put_Line (Current_Error, ".........v.........v");
--
loop
Check_raw_image (i, next_frame, opaque_frame);
New_Line (Current_Error);
exit when next_frame = 0.0 or not opaque_frame;
end loop;
if opaque_frame then
Put_Line (Current_Error, " Opaque: all pixels of all frames are opaque.");
else
Put_Line (Current_Error, " Not opaque: at least one pixel of one frame is not opaque.");
end if;
else
Put_Line (Current_Error, " Opaque: no transparency information.");
end if;
Close (f);
end Process;
begin
if Argument_Count = 0 then
Blurb;
return;
end if;
for i in 1 .. Argument_Count loop
Process (Argument (i));
end loop;
end Is_opaque;
|