Skip to content

Commit 69d5841

Browse files
zertovitchzertovitch
committed
Added generation of UPC-A / EAN-13 bar codes
1 parent 60da1ab commit 69d5841

File tree

8 files changed

+241
-24
lines changed

8 files changed

+241
-24
lines changed

‎ada_bar_codes.txt

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -30,10 +30,11 @@ Contents
3030
- ada_bar_codes.gpr : project file for the AdaCore GNAT compiler
3131
- ada_bar_codes.prj : project file for the PTC ObjectAda compiler
3232
- ada_bar_codes.txt : this file
33-
- bar_codes.ads : package specification
34-
- bar_codes.adb : package body
35-
- bar_codes-encode* : private children packages (needed but not relevant for users)
36-
- bar_codes_media.ad* : a few simple implementations examples for the SVG, PDF, PBM formats
33+
- bar_codes.ads : Bar_Codes package specification
34+
- bar_codes.adb : Bar_Codes package body
35+
- bar_codes-encode* : separate sub-packages of Bar_Codes
36+
- bar_codes_media.ad* : a few simple implementations examples for
37+
the SVG, PDF, PBM and PNG formats
3738
- demo/bar_codes_demo.adb : demo procedure
3839
- test/bar_codes_test.adb : test procedure (produces lots of files!)
3940

‎bar_codes-encode_code_128.adb

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -63,7 +63,7 @@ package body Encode_Code_128 is
6363
begin
6464
for i in text'Range loop
6565
if text (i) > ASCII.DEL then
66-
raise Cannot_Encode;
66+
raise Cannot_Encode with "Message must bit 7-bit ASCII";
6767
end if;
6868
end loop;
6969
for i in text'Range loop
@@ -268,10 +268,10 @@ package body Encode_Code_128 is
268268
height => 1));
269269
end Bar;
270270
begin
271-
-- For vector graphics only: we need to squeeze the full 2D code
271+
-- For vector graphics only: we need to squeeze the full displayed code
272272
-- into the bounding box. A "module" is the thinnest bar.
273273
bc.module_width := bc.bounding.width / Real (code'Length * symbol_width + stop_extra_width);
274-
bc.module_height := bc.bounding.height; -- This is an 1D code, any bar takes the full height
274+
bc.module_height := bc.bounding.height; -- This is a 1D code: any bar takes the full height
275275
--
276276
for i in code'Range loop
277277
x := (i - 1) * symbol_width;

‎bar_codes-encode_upca_ean13.adb

Lines changed: 168 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,168 @@
1+
separate (Bar_Codes)
2+
3+
package body Encode_UPCA_EAN13 is
4+
5+
-- Adapted from Bar_Code_Drawing:
6+
--
7+
-- Drawing UPC-A/EAN-13 bar codes
8+
--
9+
-- Copyright (C) by PragmAda Software Engineering
10+
--
11+
-- Released under the terms of the 3-Clause BSD License.
12+
-- See https://opensource.org/licenses/BSD-3-Clause
13+
14+
subtype Digit_Value is Integer range 0 .. 9;
15+
subtype Digit is Character range '0' .. '9';
16+
17+
function Valid (text : in String; kind : Code_UPCA_EAN13) return Boolean is
18+
((for all C of text => C in Digit)
19+
and
20+
((text'Length = 11 and kind = Code_UPCA)
21+
or
22+
(text'Length = 12 and kind = Code_EAN13)));
23+
24+
function Checksum (Text : in String) return Digit_Value is
25+
subtype S11 is String (1 .. 11);
26+
S : constant S11 := Text (Text'First + (if Text'Length = 11 then 0 else 1) .. Text'Last);
27+
Sum : Natural := 0;
28+
begin
29+
for I in S'Range loop
30+
Sum := Sum + (if I rem 2 = 0 then 1 else 3) * (Character'Pos (S (I)) - Character'Pos ('0'));
31+
end loop;
32+
33+
if Text'Length = 12 then
34+
Sum := Sum + Character'Pos (Text (Text'First)) - Character'Pos ('0');
35+
end if;
36+
37+
Sum := Sum rem 10;
38+
39+
return (if Sum > 0 then 10 - Sum else Sum);
40+
end Checksum;
41+
42+
function Checksum (Text : in String) return Digit is
43+
(Character'Val (Checksum (Text) + Character'Pos ('0')));
44+
45+
-- The extra digit of EAN-13 is encoded through the usage
46+
-- of two bar code sets for other digits.
47+
Code_Modules_Width : constant := 95;
48+
49+
procedure Draw (bc : in out Bar_Code; text : String; kind : Code_UPCA_EAN13) is
50+
S : constant String (1 .. text'Length) := text;
51+
52+
subtype Digit_Pattern is String (1 .. 7); -- Each digit takes 7 modules
53+
type Pattern_Map is array (Digit) of Digit_Pattern;
54+
55+
Set_A_Map : constant Pattern_Map := ('0' => "0001101", -- Bar patterns for alphabet A (left half)
56+
'1' => "0011001",
57+
'2' => "0010011",
58+
'3' => "0111101",
59+
'4' => "0100011",
60+
'5' => "0110001",
61+
'6' => "0101111",
62+
'7' => "0111011",
63+
'8' => "0110111",
64+
'9' => "0001011");
65+
Set_B_Map : constant Pattern_Map := ('0' => "0100111", -- Bar patterns for alphabet B (left half)
66+
'1' => "0110011",
67+
'2' => "0011011",
68+
'3' => "0100001",
69+
'4' => "0011101",
70+
'5' => "0111001",
71+
'6' => "0000101",
72+
'7' => "0010001",
73+
'8' => "0001001",
74+
'9' => "0010111");
75+
Set_C_Map : constant Pattern_Map := ('0' => "1110010", -- Bar patterns for alphabet B (right half)
76+
'1' => "1100110",
77+
'2' => "1101100",
78+
'3' => "1000010",
79+
'4' => "1011100",
80+
'5' => "1001110",
81+
'6' => "1010000",
82+
'7' => "1000100",
83+
'8' => "1001000",
84+
'9' => "1110100");
85+
End_Guard : constant String := "101";
86+
Middle_Guard : constant String := "01010";
87+
88+
type A_or_B is (A, B);
89+
type EAN_A_Pattern is array (1 .. 6) of A_or_B;
90+
type EAN_Pattern_Map is array (Digit) of EAN_A_Pattern;
91+
92+
EAN_A : constant EAN_Pattern_Map := ('0' => (A, A, A, A, A, A),
93+
'1' => (A, A, B, A, B, B),
94+
'2' => (A, A, B, B, A, B),
95+
'3' => (A, A, B, B, B, A),
96+
'4' => (A, B, A, A, B, B),
97+
'5' => (A, B, B, A, A, B),
98+
'6' => (A, B, B, B, A, A),
99+
'7' => (A, B, A, B, A, B),
100+
'8' => (A, B, A, B, B, A),
101+
'9' => (A, B, B, A, B, A));
102+
103+
procedure Bar (offset, width : Natural) is
104+
begin
105+
Filled_Rectangle
106+
(Bar_Code'Class (bc), -- Will use the concrete child method for displaying a rectangle
107+
(left => offset,
108+
bottom => 0,
109+
width => width,
110+
height => 1));
111+
end Bar;
112+
113+
X : Natural := 0;
114+
115+
procedure Draw (Pattern : in String) is
116+
begin
117+
for C of Pattern loop
118+
if C = '1' then
119+
Bar (X, 1);
120+
end if;
121+
X := X + 1;
122+
end loop;
123+
end Draw;
124+
125+
Offset : constant Natural := text'Length - 11;
126+
UPC : constant Boolean := text'Length = 11;
127+
128+
begin
129+
if not Valid (text, kind) then
130+
raise Cannot_Encode
131+
with
132+
(case kind is
133+
when Code_UPCA => "Message must be 11 decimal digits for UPC-A",
134+
when Code_EAN13 => "Message must be 12 decimal digits for EAN-13");
135+
end if;
136+
137+
-- For vector graphics only: we need to squeeze the full displayed code
138+
-- into the bounding box. A "module" is the thinnest bar.
139+
bc.module_width := bc.bounding.width / Real (Code_Modules_Width);
140+
bc.module_height := bc.bounding.height; -- This is a 1D code: any bar takes the full height
141+
142+
Draw (End_Guard);
143+
144+
Draw_Left : for I in 1 + Offset .. 6 + Offset loop
145+
Draw
146+
((if UPC then
147+
Set_A_Map (S (I))
148+
else
149+
(case EAN_A (S (1)) (I - Offset) is
150+
when A => Set_A_Map (S (I)),
151+
when B => Set_B_Map (S (I)))));
152+
end loop Draw_Left;
153+
154+
Draw (Middle_Guard);
155+
156+
Draw_Right : for I in 7 + Offset .. 11 + Offset loop
157+
Draw (Set_C_Map (S (I)));
158+
end loop Draw_Right;
159+
160+
Draw (Set_C_Map (Checksum (text)));
161+
Draw (End_Guard);
162+
163+
end Draw;
164+
165+
function Fitting return Module_Box is
166+
(0, 0, Code_Modules_Width, 1);
167+
168+
end Encode_UPCA_EAN13;

‎bar_codes.adb

Lines changed: 15 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,13 @@ package body Bar_Codes is
99

1010
package body Encode_Code_128 is separate;
1111

12+
package Encode_UPCA_EAN13 is
13+
procedure Draw (bc : in out Bar_Code; text : String; kind : Code_UPCA_EAN13);
14+
function Fitting return Module_Box;
15+
end Encode_UPCA_EAN13;
16+
17+
package body Encode_UPCA_EAN13 is separate;
18+
1219
package Encode_DM is
1320
procedure Draw (bc : in out Bar_Code; text : String; dm_kind : Code_DM);
1421
function Fitting (text : String; dm_kind : Code_DM) return Module_Box;
@@ -35,17 +42,19 @@ package body Bar_Codes is
3542
procedure Draw (bc : in out Bar_Code; kind : Kind_Of_Code; text : String) is
3643
begin
3744
case kind is
38-
when Code_128 => Encode_Code_128.Draw (bc, text);
39-
when Code_DM => Encode_DM.Draw (bc, text, kind);
40-
when Code_QR => Encode_QR.Draw (bc, text, kind);
45+
when Code_128 => Encode_Code_128.Draw (bc, text);
46+
when Code_UPCA_EAN13 => Encode_UPCA_EAN13.Draw (bc, text, kind);
47+
when Code_DM => Encode_DM.Draw (bc, text, kind);
48+
when Code_QR => Encode_QR.Draw (bc, text, kind);
4149
end case;
4250
end Draw;
4351

4452
function Fitting (kind : Kind_Of_Code; text : String) return Module_Box is
4553
(case kind is
46-
when Code_128 => Encode_Code_128.Fitting (text),
47-
when Code_DM => Encode_DM.Fitting (text, kind),
48-
when Code_QR => Encode_QR.Fitting (text, kind));
54+
when Code_128 => Encode_Code_128.Fitting (text),
55+
when Code_UPCA_EAN13 => Encode_UPCA_EAN13.Fitting,
56+
when Code_DM => Encode_DM.Fitting (text, kind),
57+
when Code_QR => Encode_QR.Fitting (text, kind));
4958

5059
function Get_Module_Width (bc : Bar_Code) return Real is (bc.module_width);
5160
function Get_Module_Height (bc : Bar_Code) return Real is (bc.module_height);

‎bar_codes.ads

Lines changed: 9 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,11 @@ package Bar_Codes is
4444
-- Standard: ISO/IEC 15417:2007.
4545
--
4646
(Code_128,
47+
--
48+
-- UPC-A / EAN-13 are 1D bar codes used on labels of retail products.
49+
--
50+
Code_UPCA,
51+
Code_EAN13,
4752
--
4853
-- Data Matrix is a 2D bar code popular for marking small items.
4954
-- Standard: ISO/IEC 16022:2006
@@ -61,13 +66,14 @@ package Bar_Codes is
6166

6267
-- Classify the bar codes by dimensions (1-dimensional or 2-dimensional):
6368
--
64-
subtype Code_1D is Kind_Of_Code range Kind_Of_Code'First .. Code_128;
69+
subtype Code_1D is Kind_Of_Code range Kind_Of_Code'First .. Code_EAN13;
6570
subtype Code_2D is Kind_Of_Code range Code_DM_Rectangular .. Kind_Of_Code'Last;
6671

6772
-- Classify the bar codes by family (Data Matrix, QR, ...):
6873
--
6974
subtype Code_DM is Kind_Of_Code range Code_DM_Rectangular .. Code_DM_Square;
7075
subtype Code_QR is Kind_Of_Code range Code_QR_Low .. Code_QR_High;
76+
subtype Code_UPCA_EAN13 is Kind_Of_Code range Code_UPCA .. Code_EAN13;
7177

7278
function Code_2D_Square (kind : Kind_Of_Code) return Boolean is (kind in Code_DM_Square | Code_QR);
7379

@@ -139,8 +145,8 @@ package Bar_Codes is
139145
----------------------------------------------------------------
140146

141147
title : constant String := "Ada Bar Codes";
142-
version : constant String := "004";
143-
reference : constant String := "31-Aug-2024";
148+
version : constant String := "005, preview 1";
149+
reference : constant String := "05-Sep-2024";
144150
web : constant String := "http://ada-bar-codes.sf.net/";
145151
-- Hopefully the latest version is at that URL ^
146152
--

‎clean.cmd

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,3 +3,4 @@ del *.dib
33
del *.bak
44
del *pdf.txt
55
del *.svg
6+
del test*.png

‎demo/bar_codes_demo.adb

Lines changed: 23 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -34,11 +34,11 @@ procedure Bar_Codes_Demo is
3434
Put_Line (svg, " PUBLIC '-//W3C//DTD SVG 1.1//EN'");
3535
Put_Line (svg, " 'http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd'>");
3636
end SVG_Header;
37-
--
37+
3838
prefix : constant String := "Hello from " & Bar_Codes.title;
3939
hello_short : constant String := prefix & "! How's life?";
4040
hello_long : constant String := prefix & " ( " & Bar_Codes.web & " ) ! My number is: 1234567890";
41-
--
41+
4242
procedure Demo_Code_128 is
4343
use Bar_Codes, Bar_Codes_Media;
4444
begin
@@ -59,7 +59,23 @@ procedure Bar_Codes_Demo is
5959
PNG_Bar_Code (Code_128, 2, 100, hello_short, SIO.Stream (png).all);
6060
SIO.Close (png);
6161
end Demo_Code_128;
62-
--
62+
63+
procedure Demo_Code_UPCA is
64+
use Bar_Codes, Bar_Codes_Media;
65+
begin
66+
SIO.Create (png, SIO.Out_File, "bar_code_upca.png");
67+
PNG_Bar_Code (Code_UPCA, 2, 100, "12345678901", SIO.Stream (png).all);
68+
SIO.Close (png);
69+
end Demo_Code_UPCA;
70+
71+
procedure Demo_Code_EAN13 is
72+
use Bar_Codes, Bar_Codes_Media;
73+
begin
74+
SIO.Create (png, SIO.Out_File, "bar_code_ean13.png");
75+
PNG_Bar_Code (Code_EAN13, 2, 100, "123456789012", SIO.Stream (png).all);
76+
SIO.Close (png);
77+
end Demo_Code_EAN13;
78+
6379
procedure Demo_QR is
6480
use Bar_Codes, Bar_Codes_Media;
6581
begin
@@ -80,7 +96,7 @@ procedure Bar_Codes_Demo is
8096
PNG_Bar_Code (Code_QR_High, 5, 5, hello_long, SIO.Stream (png).all);
8197
SIO.Close (png);
8298
end Demo_QR;
83-
--
99+
84100
procedure Demo_Data_Matrix is
85101
use Bar_Codes, Bar_Codes_Media;
86102
begin
@@ -97,9 +113,11 @@ procedure Bar_Codes_Demo is
97113
PNG_Bar_Code (Code_DM_Rectangular, 10, 10, hello_short, SIO.Stream (png).all);
98114
SIO.Close (png);
99115
end Demo_Data_Matrix;
100-
--
116+
101117
begin
102118
Demo_Code_128;
119+
Demo_Code_UPCA;
120+
Demo_Code_EAN13;
103121
Demo_QR;
104122
Demo_Data_Matrix;
105123
end Bar_Codes_Demo;

‎test/bar_codes_test.adb

Lines changed: 17 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ with Ada.Characters.Handling,
55
with Bar_Codes, Bar_Codes_Media;
66

77
procedure Bar_Codes_Test is
8-
--
8+
99
procedure Spit (kind : Bar_Codes.Kind_Of_Code; file_name_part, text : String) is
1010
use Bar_Codes, Bar_Codes_Media;
1111
use Ada.Characters.Handling, Ada.Streams.Stream_IO;
@@ -33,7 +33,7 @@ procedure Bar_Codes_Test is
3333
end if;
3434
Close (png);
3535
end Spit;
36-
--
36+
3737
procedure Test_128 is
3838
use Bar_Codes;
3939
use Ada.Numerics.Float_Random;
@@ -84,7 +84,19 @@ procedure Bar_Codes_Test is
8484
Spit (Code_128, "rnd digits" & iter'Image, rnd);
8585
end loop;
8686
end Test_128;
87-
--
87+
88+
procedure Test_EAN13 is
89+
begin
90+
for initial_digit in Character range '0' .. '9' loop
91+
Spit (Bar_Codes.Code_EAN13, (1 => initial_digit), initial_digit & "12345678901");
92+
end loop;
93+
end Test_EAN13;
94+
95+
procedure Test_UPCA is
96+
begin
97+
Spit (Bar_Codes.Code_UPCA, "", "12345678901");
98+
end Test_UPCA;
99+
88100
procedure Test_2D is
89101
blabla : constant String :=
90102
"The Corporate Bullshit Generator " &
@@ -127,5 +139,7 @@ procedure Bar_Codes_Test is
127139
end Test_2D;
128140
begin
129141
Test_128;
142+
Test_EAN13;
143+
Test_UPCA;
130144
Test_2D;
131145
end Bar_Codes_Test;

0 commit comments

Comments
 (0)