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
|
separate (Bar_Codes)
package body Encode_MSI is
-- Adapted from Bar_Code_Drawing:
--
-- Drawing MSI bar codes (also called MSI Plessey and Modified Plessey)
--
-- Copyright (C) by PragmAda Software Engineering
--
-- Released under the terms of the 3-Clause BSD License.
-- See https://opensource.org/licenses/BSD-3-Clause
subtype Digit_Value is Integer range 0 .. 9;
subtype Digit is Character range '0' .. '9';
function D2N (D : Digit) return Natural is (Character'Pos (D) - Character'Pos ('0'));
function Luhn_Check_Digit (input : String) return Digit_Value is
-- Compute the extra digit x such that the Luhn checksum is 0.
sum : Natural := 0;
d, x : Natural;
reverse_index : Integer := input'Last;
begin
for i in input'Range loop
d := D2N (input (reverse_index));
reverse_index := reverse_index - 1;
if (i - input'First + 1) rem 2 = 1 then
d := 2 * d;
if d > 9 then
d := d - 9;
end if;
end if;
sum := sum + d;
end loop;
x := 9 * sum; -- We want (x + sum) to be congruent to 0, modulo 10.
return x rem 10;
end Luhn_Check_Digit;
Symbol_Width : constant := 12; -- Each digit has 4 bits of 3 bars
Start_Width : constant := 3; -- Start symbol is a 1 bit
Stop_Width : constant := 4; -- Stop symbol is 00; trailing white bars ignored
function Valid (text : String) return Boolean is
(for all C of text => C in Digit);
function Code_Modules_Width (text : String) return Positive is
(Symbol_Width * (text'Length + 1) + Start_Width + Stop_Width); -- +1 for Luhn check digit
procedure Draw (bc : in out Bar_Code; text : String) is
procedure Bar (offset, width : Natural) is
begin
Filled_Rectangle
(Bar_Code'Class (bc), -- Will use the concrete child method for displaying a rectangle
(left => offset,
bottom => 0,
width => width,
height => 1));
end Bar;
X : Natural := 0;
procedure Draw_Bit (Bit : in Natural) is
begin
Bar (X, (if Bit = 0 then 1 else 2));
X := X + 3;
end Draw_Bit;
subtype Nibble is String (1 .. 4);
type Nibble_Map is array (Digit_Value) of Nibble;
Map : constant Nibble_Map :=
(0 => "0000", 1 => "0001", 2 => "0010", 3 => "0011", 4 => "0100",
5 => "0101", 6 => "0110", 7 => "0111", 8 => "1000", 9 => "1001");
procedure Draw_Nibble (n : Nibble) is
begin
for bit of n loop
Draw_Bit (D2N (bit));
end loop;
end Draw_Nibble;
digit_bits : Nibble;
begin
if not Valid (text) then
raise Cannot_Encode with "Message must be all in decimal digits";
end if;
Draw_Bit (1); -- Start code
for I in text'Range loop
digit_bits := Map (D2N (text (I)));
Draw_Nibble (digit_bits);
end loop;
Draw_Nibble (Map (Luhn_Check_Digit (text)));
Draw_Bit (0); -- Stop code
Draw_Bit (0);
end Draw;
function Fitting (text : String) return Module_Box is
(0, 0, Code_Modules_Width (text), 1);
end Encode_MSI;
|
