Too many C pointer stuff and other things which are not directly convertible.
Took a very long time to find all porting 'bugs'.
But I ported quirc to PB
Save both parts in one file as quirc.pbi
Part 1
Code: Select all
;
; quirc -- QR-code recognition library
; Copyright (C) 2010-2012 Daniel Beer <dlbeer@gmail.com>
;
; https://github.com/dlbeer/quirc
;
; ported by infratec
;
; https://www.purebasic.fr/english/viewtopic.php?p=565075#p565075
;
; 2021-02-02 now it is a module to avoid naming conflicts
; 2021-02-01 optimimized DataSection for binary size of the executable
; 2021-01-31 modified ImageToGrayScaleBuffer() for images with alpha channel
; 2022-01-24 synchronized with the git version from 8 Oct 2021
;
;PurifierGranularity(1, 1, 1, 1)
DeclareModule Quirc
Declare.s QRCodeDecode(Image.i)
EndDeclareModule
Module Quirc
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
CompilerEndIf
; PB Help
Structure AsciiArrayStructure
v.a[0]
EndStructure
Structure UnicodeArrayStructure
v.u[0]
EndStructure
Structure IntegerArrayStructure
v.i[0]
EndStructure
Structure DoubleArrayStructure
v.d[0]
EndStructure
; quirc.h
; This enum describes the various decoder errors which may occur.
Enumeration
#QUIRC_SUCCESS = 0
#QUIRC_ERROR_INVALID_GRID_SIZE
#QUIRC_ERROR_INVALID_VERSION
#QUIRC_ERROR_FORMAT_ECC
#QUIRC_ERROR_DATA_ECC
#QUIRC_ERROR_UNKNOWN_DATA_TYPE
#QUIRC_ERROR_DATA_OVERFLOW
#QUIRC_ERROR_DATA_UNDERFLOW
EndEnumeration
; Limits on the maximum size of QR-codes And their content.
#QUIRC_MAX_VERSION = 40
#QUIRC_MAX_GRID_SIZE = (#QUIRC_MAX_VERSION * 4 + 17)
#QUIRC_MAX_BITMAP = (((#QUIRC_MAX_GRID_SIZE * #QUIRC_MAX_GRID_SIZE) + 7) / 8)
#QUIRC_MAX_PAYLOAD = 8896
; QR-code ECC types.
#QUIRC_ECC_LEVEL_M = 0
#QUIRC_ECC_LEVEL_L = 1
#QUIRC_ECC_LEVEL_H = 2
#QUIRC_ECC_LEVEL_Q = 3
; QR-code Data types.
#QUIRC_DATA_TYPE_NUMERIC = 1
#QUIRC_DATA_TYPE_ALPHA = 2
#QUIRC_DATA_TYPE_BYTE = 4
#QUIRC_DATA_TYPE_KANJI = 8
; Common character encodings
#QUIRC_ECI_ISO_8859_1 = 1
#QUIRC_ECI_IBM437 = 2
#QUIRC_ECI_ISO_8859_2 = 4
#QUIRC_ECI_ISO_8859_3 = 5
#QUIRC_ECI_ISO_8859_4 = 6
#QUIRC_ECI_ISO_8859_5 = 7
#QUIRC_ECI_ISO_8859_6 = 8
#QUIRC_ECI_ISO_8859_7 = 9
#QUIRC_ECI_ISO_8859_8 = 10
#QUIRC_ECI_ISO_8859_9 = 11
#QUIRC_ECI_WINDOWS_874 = 13
#QUIRC_ECI_ISO_8859_13 = 15
#QUIRC_ECI_ISO_8859_15 = 17
#QUIRC_ECI_SHIFT_JIS = 20
#QUIRC_ECI_UTF_8 = 26
; quirc_internal.h
#QUIRC_PIXEL_WHITE = 0
#QUIRC_PIXEL_BLACK = 1
#QUIRC_PIXEL_REGION = 2
CompilerIf Not Defined(QUIRC_MAX_REGIONS, #PB_Constant)
#QUIRC_MAX_REGIONS = 254
CompilerEndIf
#QUIRC_MAX_CAPSTONES = 32
#QUIRC_MAX_GRIDS = (#QUIRC_MAX_CAPSTONES * 2)
#QUIRC_PERSPECTIVE_PARAMS = 8
#UINT8_MAX = $FF
#UINT16_MAX = $FFFF
#INT_MAX = $7FFF
CompilerIf #QUIRC_MAX_REGIONS < #UINT8_MAX
#QUIRC_PIXEL_ALIAS_IMAGE = #True
Macro quirc_pixel_ptr
Ascii
EndMacro
Macro quirc_pixel_type
a
EndMacro
Macro quirc_pixel_array
AsciiArrayStructure
EndMacro
CompilerElseIf #QUIRC_MAX_REGIONS < #UINT16_MAX
#QUIRC_PIXEL_ALIAS_IMAGE = #False
Macro quirc_pixel_ptr
Unicode
EndMacro
Macro quirc_pixel_type
u
EndMacro
Macro quirc_pixel_array
UnicodeArrayStructure
EndMacro
CompilerElse
CompilerError "QUIRC_MAX_REGIONS > 65534 is not supported"
CompilerEndIf
Macro QUIRC_ASSERT(a)
If Bool(a) = #False
MessageRequester("Error", "ASSERT " + Str(#PB_Compiler_Line))
EndIf
EndMacro
Structure quirc_point
x.i
y.i
EndStructure
; PB Help
Structure quirc_pointArrayStructure
v.quirc_point[0]
EndStructure
; quirc.h
; This Structure is used To Return information about detected QR codes
; in the input image.
Structure quirc_code
; The four corners of the QR-code, from top left, clockwise
corners.quirc_point[4]
; The number of cells across in the QR-code. The cell bitmap
; is a bitmask giving the actual values of cells. If the cell
; at (x, y) is black, then the following bit is set:
;
; cell_bitmap(i >> 3) & (1 << (i & 7))
;
; where i = (y * size) + x.
size.i
cell_bitmap.a[#QUIRC_MAX_BITMAP]
EndStructure
; This Structure holds the decoded QR-code Data
Structure quirc_data
; Various parameters of the QR-code. These can mostly be
; ignored If you only care about the Data.
version.i
ecc_level.i
mask.i
; This field is the highest-valued Data type found in the QR
; code.
data_type.i
; Data payload. For the Kanji datatype, payload is encoded As
; Shift-JIS. For all other datatypes, payload is ASCII text.
payload.a[#QUIRC_MAX_PAYLOAD]
payload_len.i
; ECI assignment number
eci.l
EndStructure
; quirc_internal.h
Structure quirc_region
seed.quirc_point
count.i
capstone.i
EndStructure
Structure quirc_capstone
ring.i
stone.i
corners.quirc_point[4]
center.quirc_point
c.d[#QUIRC_PERSPECTIVE_PARAMS]
qr_grid.i
EndStructure
Structure quirc_grid
; Capstone indices
caps.i[3]
; Alignment pattern region And corner
align_region.i
align.quirc_point
; Timing pattern endpoints
tpep.quirc_point[3]
; Grid size And perspective transform
grid_size.i
c.d[#QUIRC_PERSPECTIVE_PARAMS]
EndStructure
Structure quirc_flood_fill_vars
y.i
right.i
left_up.i
left_down.i
EndStructure
Structure quirc
*image.Ascii
*pixels.quirc_pixel_array
w.i
h.i
num_regions.i
regions.quirc_region[#QUIRC_MAX_REGIONS]
num_capstones.i
capstones.quirc_capstone[#QUIRC_MAX_CAPSTONES]
num_grids.i
grids.quirc_grid[#QUIRC_MAX_GRIDS]
num_flood_fill_vars.i
*flood_fill_vars.quirc_flood_fill_vars
EndStructure
; QR-code version information database
#QUIRC_MAX_VERSION = 40
#QUIRC_MAX_ALIGNMENT = 7
Structure quirc_rs_params
bs.a ; Small block size
dw.a ; Small data words
ns.a ; Number of small blocks
EndStructure
Structure quirc_version_info
data_bytes.u
apat.a[#QUIRC_MAX_ALIGNMENT]
ecc.quirc_rs_params[4]
EndStructure
; version_db.c
DataSection
quirc_version_db_0:
Data.u 0
Data.a 0, 0, 0, 0, 0, 0, 0
Data.a 0, 0, 0
Data.a 0, 0, 0
Data.a 0, 0, 0
Data.a 0, 0, 0
quirc_version_db_1:
Data.u 26
Data.a 0, 0, 0, 0, 0, 0, 0
Data.a 26, 16, 1
Data.a 26, 19, 1
Data.a 26, 9, 1
Data.a 26, 13, 1
quirc_version_db_2:
Data.u 44
Data.a 6, 18, 0, 0, 0, 0, 0
Data.a 44, 28, 1
Data.a 44, 34, 1
Data.a 44, 16, 1
Data.a 44, 22, 1
quirc_version_db_3:
Data.u 70
Data.a 6, 22, 0, 0, 0, 0, 0
Data.a 70, 44, 1
Data.a 70, 55, 1
Data.a 35, 13, 2
Data.a 35, 17, 2
quirc_version_db_4:
Data.u 100
Data.a 6, 26, 0, 0, 0, 0, 0
Data.a 50, 32, 2
Data.a 100, 80, 1
Data.a 25, 9, 4
Data.a 50, 24, 2
quirc_version_db_5:
Data.u 134
Data.a 6, 30, 0, 0, 0, 0, 0
Data.a 67, 43, 2
Data.a 134, 108, 1
Data.a 33, 11, 2
Data.a 33, 15, 2
quirc_version_db_6:
Data.u 172
Data.a 6, 34, 0, 0, 0, 0, 0
Data.a 43, 27, 4
Data.a 86, 68, 2
Data.a 43, 15, 4
Data.a 43, 19, 4
quirc_version_db_7:
Data.u 196
Data.a 6, 22, 38, 0, 0, 0, 0
Data.a 49, 31, 4
Data.a 98, 78, 2
Data.a 39, 13, 4
Data.a 32, 14, 2
quirc_version_db_8:
Data.u 242
Data.a 6, 24, 42, 0, 0, 0, 0
Data.a 60, 38, 2
Data.a 121, 97, 2
Data.a 40, 14, 4
Data.a 40, 18, 4
quirc_version_db_9:
Data.u 292
Data.a 6, 22, 46, 0, 0, 0, 0
Data.a 58, 36, 3
Data.a 146, 116, 2
Data.a 36, 12, 4
Data.a 36, 16, 4
quirc_version_db_10:
Data.u 346
Data.a 6, 28, 50, 0, 0, 0, 0
Data.a 69, 43, 4
Data.a 86, 68, 2
Data.a 43, 15, 6
Data.a 43, 19, 6
quirc_version_db_11:
Data.u 404
Data.a 6, 30, 54, 0, 0, 0, 0
Data.a 80, 50, 1
Data.a 101, 81, 4
Data.a 36, 12, 3
Data.a 50, 22, 4
quirc_version_db_12:
Data.u 466
Data.a 6, 32, 58, 0, 0, 0, 0
Data.a 58, 36, 6
Data.a 116, 92, 2
Data.a 42, 14, 7
Data.a 46, 20, 4
quirc_version_db_13:
Data.u 532
Data.a 6, 34, 62, 0, 0, 0, 0
Data.a 59, 37, 8
Data.a 133, 107, 4
Data.a 33, 11, 12
Data.a 44, 20, 8
quirc_version_db_14:
Data.u 581
Data.a 6, 26, 46, 66, 0, 0, 0
Data.a 64, 40, 4
Data.a 145, 115, 3
Data.a 36, 12, 11
Data.a 36, 16, 11
quirc_version_db_15:
Data.u 655
Data.a 6, 26, 48, 70, 0, 0, 0
Data.a 65, 41, 5
Data.a 109, 87, 5
Data.a 36, 12, 11
Data.a 54, 24, 5
quirc_version_db_16:
Data.u 733
Data.a 6, 26, 50, 74, 0, 0, 0
Data.a 73, 45, 7
Data.a 122, 98, 5
Data.a 45, 15, 3
Data.a 43, 19, 15
quirc_version_db_17:
Data.u 815
Data.a 6, 30, 54, 78, 0, 0, 0
Data.a 74, 46, 10
Data.a 135, 107, 1
Data.a 42, 14, 2
Data.a 50, 22, 1
quirc_version_db_18:
Data.u 901
Data.a 6, 30, 56, 82, 0, 0, 0
Data.a 69, 43, 9
Data.a 150, 120, 5
Data.a 42, 14, 2
Data.a 50, 22, 17
quirc_version_db_19:
Data.u 991
Data.a 6, 30, 58, 86, 0, 0, 0
Data.a 70, 44, 3
Data.a 141, 113, 3
Data.a 39, 13, 9
Data.a 47, 21, 17
quirc_version_db_20:
Data.u 1085
Data.a 6, 34, 62, 90, 0, 0, 0
Data.a 67, 41, 3
Data.a 135, 107, 3
Data.a 43, 15, 15
Data.a 54, 24, 15
quirc_version_db_21:
Data.u 1156
Data.a 6, 28, 50, 72, 92, 0, 0
Data.a 68, 42, 17
Data.a 144, 116, 4
Data.a 46, 16, 19
Data.a 50, 22, 17
quirc_version_db_22:
Data.u 1258
Data.a 6, 26, 50, 74, 98, 0, 0
Data.a 74, 46, 17
Data.a 139, 111, 2
Data.a 37, 13, 34
Data.a 54, 24, 7
quirc_version_db_23:
Data.u 1364
Data.a 6, 30, 54, 78, 102, 0, 0
Data.a 75, 47, 4
Data.a 151, 121, 4
Data.a 45, 15, 16
Data.a 54, 24, 11
quirc_version_db_24:
Data.u 1474
Data.a 6, 28, 54, 80, 106, 0, 0
Data.a 73, 45, 6
Data.a 147, 117, 6
Data.a 46, 16, 30
Data.a 54, 24, 11
quirc_version_db_25:
Data.u 1588
Data.a 6, 32, 58, 84, 110, 0, 0
Data.a 75, 47, 8
Data.a 132, 106, 8
Data.a 45, 15, 22
Data.a 54, 24, 7
quirc_version_db_26:
Data.u 1706
Data.a 6, 30, 58, 86, 114, 0, 0
Data.a 74, 46, 19
Data.a 142, 114, 10
Data.a 46, 16, 33
Data.a 50, 22, 28
quirc_version_db_27:
Data.u 1828
Data.a 6, 34, 62, 90, 118, 0, 0
Data.a 73, 45, 22
Data.a 152, 122, 8
Data.a 45, 15, 12
Data.a 53, 23, 8
quirc_version_db_28:
Data.u 1921
Data.a 6, 26, 50, 74, 98, 122, 0
Data.a 73, 45, 3
Data.a 147, 117, 3
Data.a 45, 15, 11
Data.a 54, 24, 4
quirc_version_db_29:
Data.u 2051
Data.a 6, 30, 54, 78, 102, 126, 0
Data.a 73, 45, 21
Data.a 146, 116, 7
Data.a 45, 15, 19
Data.a 53, 23, 1
quirc_version_db_30:
Data.u 2185
Data.a 6, 26, 52, 78, 104, 130, 0
Data.a 75, 47, 19
Data.a 145, 115, 5
Data.a 45, 15, 23
Data.a 54, 24, 15
quirc_version_db_31:
Data.u 2323
Data.a 6, 30, 56, 82, 108, 134, 0
Data.a 74, 46, 2
Data.a 145, 115, 13
Data.a 45, 15, 23
Data.a 54, 24, 42
quirc_version_db_32:
Data.u 2465
Data.a 6, 34, 60, 86, 112, 138, 0
Data.a 74, 46, 10
Data.a 145, 115, 17
Data.a 45, 15, 19
Data.a 54, 24, 10
quirc_version_db_33:
Data.u 2611
Data.a 6, 30, 58, 86, 114, 142, 0
Data.a 74, 46, 14
Data.a 145, 115, 17
Data.a 45, 15, 11
Data.a 54, 24, 29
quirc_version_db_34:
Data.u 2761
Data.a 6, 34, 62, 90, 118, 146, 0
Data.a 74, 46, 14
Data.a 145, 115, 13
Data.a 46, 16, 59
Data.a 54, 24, 44
quirc_version_db_35:
Data.u 2876
Data.a 6, 30, 54, 78, 102, 126, 150
Data.a 75, 47, 12
Data.a 151, 121, 12
Data.a 45, 15, 22
Data.a 54, 24, 39
quirc_version_db_36:
Data.u 3034
Data.a 6, 24, 50, 76, 102, 128, 154
Data.a 75, 47, 6
Data.a 151, 121, 6
Data.a 45, 15, 2
Data.a 54, 24, 46
quirc_version_db_37:
Data.u 3196
Data.a 6, 28, 54, 80, 106, 132, 158
Data.a 74, 46, 29
Data.a 152, 122, 17
Data.a 45, 15, 24
Data.a 54, 24, 49
quirc_version_db_38:
Data.u 3362
Data.a 6, 32, 58, 84, 110, 136, 162
Data.a 74, 46, 13
Data.a 152, 122, 4
Data.a 45, 15, 42
Data.a 54, 24, 48
quirc_version_db_39:
Data.u 3532
Data.a 6, 26, 54, 82, 110, 138, 166
Data.a 75, 47, 40
Data.a 147, 117, 20
Data.a 45, 15, 10
Data.a 54, 24, 43
quirc_version_db_40:
Data.u 3706
Data.a 6, 30, 58, 86, 114, 142, 170
Data.a 75, 47, 18
Data.a 148, 118, 19
Data.a 45, 15, 20
Data.a 54, 24, 34
EndDataSection
; quirk.c
Procedure.s quirc_version()
ProcedureReturn "1.0"
EndProcedure
Procedure.i quirc_new()
ProcedureReturn AllocateMemory(SizeOf(quirc))
EndProcedure
Procedure quirc_destroy(*q.quirc)
FreeMemory(*q\image)
; q->pixels may alias q->image when their type representation is of the
; same size, so we need To be careful here To avoid a double free
If Not #QUIRC_PIXEL_ALIAS_IMAGE
FreeMemory(*q\pixels)
EndIf
FreeMemory(*q\flood_fill_vars)
FreeMemory(*q)
EndProcedure
Procedure.i quirc_resize(*q.quirc, w.i, h.i)
Protected.i num_vars, vars_byte_size, olddim, newdim, min
Protected *image.Ascii
Protected *pixels.quirc_pixel_ptr
Protected *vars.quirc_flood_fill_vars
; XXX: w And h should be size_t (Or at least unsigned) As negatives
; values would Not make much sense. The downside is that it would Break
; both the API And ABI. Thus, at the moment, let's just do a sanity
; check.
If w < 0 Or h < 0
ProcedureReturn -1
EndIf
; alloc a new buffer For q->image. We avoid realloc(3) because we want
; on failure To be leave `q` in a consistant, unmodified state.
*image = AllocateMemory(w * h)
If Not *image
ProcedureReturn -1
EndIf
; compute the "old" (i.e. currently allocated) And the "new"
; (i.e. requested) image dimensions
olddim = *q\w * *q\h
newdim = w * h
If olddim < newdim
min = olddim
Else
min = newdim
EndIf
; copy the Data into the new buffer, avoiding (a) To Read beyond the
; old buffer when the new size is greater And (b) To write beyond the
; new buffer when the new size is smaller, hence the min computation.
If *q\image
CopyMemory(*q\image, *image, min)
EndIf
; alloc a new buffer For q->pixels If needed
If Not #QUIRC_PIXEL_ALIAS_IMAGE
*pixels = AllocateMemory(newdim * SizeOf(quirc_pixel_ptr))
If Not *pixels
FreeMemory(*image)
ProcedureReturn -1
EndIf
EndIf
; alloc the work area For the flood filling logic.
;
; the size was chosen With the following assumptions And observations:
;
; - rings are the regions which requires the biggest work area.
; - they consumes the most when they are rotated by about 45 degree.
; in that Case, the necessary depth is about (2 * height_of_the_ring).
;- the maximum height of rings would be about 1/3 of the image height.
If h * 2 / 2 <> h
FreeMemory(*image)
If *pixels
FreeMemory(*pixels)
EndIf
ProcedureReturn -1
EndIf
num_vars = h * 2 / 3
If num_vars = 0
num_vars = 1
EndIf
vars_byte_size = SizeOf(quirc_flood_fill_vars) * num_vars
If vars_byte_size / SizeOf(quirc_flood_fill_vars) <> num_vars
FreeMemory(*image)
If *pixels
FreeMemory(*pixels)
EndIf
ProcedureReturn -1
EndIf
*vars = AllocateMemory(vars_byte_size)
If Not *vars
FreeMemory(*image)
If *pixels
FreeMemory(*pixels)
EndIf
ProcedureReturn -1
EndIf
; alloc succeeded, update `q` With the new size And buffers
*q\w = w
*q\h = h
If *q\image
FreeMemory(*q\image)
EndIf
*q\image = *image
If Not #QUIRC_PIXEL_ALIAS_IMAGE
If *q\pixels
FreeMemory(*q\pixels)
EndIf
*q\pixels = *pixels
EndIf
If *q\flood_fill_vars
FreeMemory(*q\flood_fill_vars)
EndIf
*q\flood_fill_vars = *vars
*q\num_flood_fill_vars = num_vars
ProcedureReturn 0
EndProcedure
Procedure.i quirc_count(*q.quirc)
ProcedureReturn *q\num_grids
EndProcedure
Procedure.s quirc_strerror(err.i)
Protected Error$
Select err
Case #QUIRC_SUCCESS : Error$ = "Success"
Case #QUIRC_ERROR_INVALID_GRID_SIZE : Error$ = "Invalid grid size"
Case #QUIRC_ERROR_INVALID_VERSION : Error$ = "Invalid version"
Case #QUIRC_ERROR_FORMAT_ECC : Error$ = "Format data ECC failure"
Case #QUIRC_ERROR_DATA_ECC : Error$ = "ECC failure"
Case #QUIRC_ERROR_UNKNOWN_DATA_TYPE : Error$ = "Unknown data type"
Case #QUIRC_ERROR_DATA_OVERFLOW : Error$ = "Data overflow"
Case #QUIRC_ERROR_DATA_UNDERFLOW : Error$ = "Data underflow"
Default : Error$ = "Unknown error"
EndSelect
ProcedureReturn Error$
EndProcedure
; identify.c
; Linear algebra routines
Procedure.i line_intersect(*p0.quirc_point, *p1.quirc_point, *q0.quirc_point, *q1.quirc_point, *r.quirc_point)
Protected.i a, b, c, d, e, f, det
; (a, b) is perpendicular To line p
a = -(*p1\y - *p0\y)
b = *p1\x - *p0\x
; (c, d) is perpendicular To line q
c = -(*q1\y - *q0\y)
d = *q1\x - *q0\x
; e And f are dot products of the respective vectors With p And q
e = a * *p1\x + b * *p1\y
f = c * *q1\x + d * *q1\y
; Now we need To solve:
; (a b) (rx) (e)
; (c d) (ry) = (f)
;
; We do this by inverting the matrix And applying it To (e, f):
; ( d -b) (e) (rx)
; 1/det (-c a) (f) = (ry)
;
det = (a * d) - (b * c)
If Not det
ProcedureReturn 0
EndIf
*r\x = (d * e - b * f) / det
*r\y = (-c * e + a * f) / det
ProcedureReturn 1
EndProcedure
Procedure perspective_setup(*c.DoubleArrayStructure, *rect.quirc_pointArrayStructure, w.d, h.d)
Protected.d x0, y0, x1, y1, x2, y2, x3, y3, wden, hden
x0 = *rect\v[0]\x
y0 = *rect\v[0]\y
x1 = *rect\v[1]\x
y1 = *rect\v[1]\y
x2 = *rect\v[2]\x
y2 = *rect\v[2]\y
x3 = *rect\v[3]\x
y3 = *rect\v[3]\y
wden = w * (x2*y3 - x3*y2 + (x3-x2)*y1 + x1*(y2-y3))
hden = h * (x2*y3 + x1*(y2-y3) - x3*y2 + (x3-x2)*y1)
*c\v[0] = (x1*(x2*y3-x3*y2) + x0*(-x2*y3+x3*y2+(x2-x3)*y1) + x1*(x3-x2)*y0) / wden
*c\v[1] = -(x0*(x2*y3+x1*(y2-y3)-x2*y1) - x1*x3*y2 + x2*x3*y1 + (x1*x3-x2*x3)*y0) / hden
*c\v[2] = x0
*c\v[3] = (y0*(x1*(y3-y2)-x2*y3+x3*y2) + y1*(x2*y3-x3*y2) + x0*y1*(y2-y3)) / wden
*c\v[4] = (x0*(y1*y3-y2*y3) + x1*y2*y3 - x2*y1*y3 + y0*(x3*y2-x1*y2+(x2-x3)*y1)) / hden
*c\v[5] = y0
*c\v[6] = (x1*(y3-y2) + x0*(y2-y3) + (x2-x3)*y1 + (x3-x2)*y0) / wden
*c\v[7] = (-x2*y3 + x1*y3 + x3*y2 + x0*(y1-y2) - x3*y1 + (x2-x1)*y0) / hden
EndProcedure
Procedure perspective_map(*c.DoubleArrayStructure, u.d, v.d, *ret.quirc_point)
Protected.d den, x, y
den = *c\v[6]*u + *c\v[7]*v + 1.0
x = (*c\v[0]*u + *c\v[1]*v + *c\v[2]) / den
y = (*c\v[3]*u + *c\v[4]*v + *c\v[5]) / den
*ret\x = Round(x, #PB_Round_Nearest)
*ret\y = Round(y, #PB_Round_Nearest)
EndProcedure
Procedure perspective_unmap(*c.DoubleArrayStructure, *in.quirc_point, *u.Double, *v.Double)
Protected.d x, y, den
x = *in\x
y = *in\y
den = -*c\v[0] * *c\v[7] * y + *c\v[1] * *c\v[6] * y + (*c\v[3] * *c\v[7] - *c\v[4] * *c\v[6])*x + *c\v[0] * *c\v[4] - *c\v[1] * *c\v[3]
*u\d = -(*c\v[1] * (y-*c\v[5]) - *c\v[2] * *c\v[7] * y + (*c\v[5] * *c\v[7] - *c\v[4]) * x + *c\v[2] * *c\v[4]) / den
*v\d = (*c\v[0] * (y-*c\v[5]) - *c\v[2] * *c\v[6] * y + (*c\v[5] * *c\v[6] - *c\v[3]) * x + *c\v[2] * *c\v[3]) / den
EndProcedure
; Span-based floodfill routine
Prototype span_func_t(*user_data, y.i, left.i, right.i)
Procedure flood_fill_line(*q.quirc, x.i, y.i, from.i, To_.i, func.span_func_t, *user_data, *leftp.Integer, *rightp.Integer)
Protected.i left, right, i
Protected *row.quirc_pixel_array
*row = *q\pixels + y * *q\w
QUIRC_ASSERT(*row\v[x] = from)
left = x
right = x
While left > 0 And *row\v[left - 1] = from
left - 1
Wend
While right < *q\w - 1 And *row\v[right + 1] = from
right + 1
Wend
; Fill the extent
For i = left To right
*row\v[i] = To_
Next i
; Return the processed range
*leftp\i = left
*rightp\i = right
If func
func(*user_data, y, left, right)
EndIf
EndProcedure
Procedure.i flood_fill_call_next(*q.quirc, *row.quirc_pixel_array, from.i, To_.i, func.span_func_t, *user_data, *vars.quirc_flood_fill_vars, direction.i)
Protected next_left.i
Protected *leftp.Integer
Protected *next_vars.quirc_flood_fill_vars
If direction < 0
*leftp = @*vars\left_up
Else
*leftp = @*vars\left_down
EndIf
While *leftp\i <= *vars\right
If *row\v[*leftp\i] = from
; Set up the Next context
*next_vars = *vars + SizeOf(quirc_flood_fill_vars) * 1
*next_vars\y = *vars\y + direction
; Fill the extent
flood_fill_line(*q, *leftp\i, *next_vars\y, from, To_, func, *user_data, @next_left, @*next_vars\right)
*next_vars\left_down = next_left
*next_vars\left_up = next_left
ProcedureReturn *next_vars
EndIf
*leftp\i + 1
Wend
ProcedureReturn #Null
EndProcedure
Procedure flood_fill_seed(*q.quirc, x0.i, y0.i, from.i, To_.i, func.span_func_t, *user_data)
Protected.i left, right, i, stack_size, next_left
Protected *row.quirc_pixel_array
Protected.quirc_flood_fill_vars *stack, *last_vars, *vars, *next_vars
*stack = *q\flood_fill_vars
stack_size = *q\num_flood_fill_vars
*last_vars = *stack + SizeOf(quirc_flood_fill_vars) * (stack_size - 1)
QUIRC_ASSERT(from <> To_)
QUIRC_ASSERT(*q\pixels\v[y0 * *q\w + x0] = from)
; Set up the first context
*next_vars = *stack
*next_vars\y = y0
; Fill the extent
flood_fill_line(*q, x0, *next_vars\y, from, To_, func, *user_data, @next_left, @*next_vars\right)
*next_vars\left_down = next_left
*next_vars\left_up = next_left
While #True
*vars = *next_vars
If *vars = *last_vars
; "Stack overflow".
; Just stop And Return.
; This can be caused by very complex shapes in
; the image, which is Not likely a part of
; a valid QR code anyway.
Break
EndIf
; Seed new flood-fills
If *vars\y > 0
*row = *q\pixels + (*vars\y - 1) * *q\w
*next_vars = flood_fill_call_next(*q, *row, from, To_, func, *user_data, *vars, -1)
If *next_vars <> #Null
Continue
EndIf
EndIf
If *vars\y < *q\h - 1
*row = *q\pixels + (*vars\y + 1) * *q\w
*next_vars = flood_fill_call_next(*q, *row, from, To_, func, *user_data, *vars, 1)
If *next_vars <> #Null
Continue
EndIf
EndIf
If *vars > *stack
; Restore the previous context
*next_vars = *vars - SizeOf(quirc_flood_fill_vars) * 1
Continue
EndIf
; We've done.
Break
Wend
EndProcedure
; Adaptive thresholding
Procedure.a otsu(*q.quirc)
Protected.i numPixels, length, value, sum, i, sumb, q1, threshold, q2
Protected.d max, m1, m2, m1m2, variance
Protected Dim histogram.i(#UINT8_MAX)
Protected *ptr.Ascii
numPixels = *q\w * *q\h
; Calculate histogram
*ptr = *q\image
length = numPixels
While length
value = *ptr\a
*ptr + 1
histogram(value) + 1
length - 1
Wend
; Calculate weighted sum of histogram values
For i = 0 To #UINT8_MAX
sum + (i * histogram(i))
Next i
; Compute threshold
For i = 0 To #UINT8_MAX
; Weighted background
q1 + histogram(i)
If q1 = 0
Continue
EndIf
; Weighted foreground
q2 = numPixels - q1
If q2 = 0
Break
EndIf
sumB + (i * histogram(i))
m1 = sumB / q1
m2 = (sum - sumB) / q2
m1m2 = m1 - m2
variance = m1m2 * m1m2 * q1 * q2
If variance >= max
threshold = i
max = variance
EndIf
Next i
ProcedureReturn threshold
EndProcedure
Procedure area_count(*user_data, y.i, left.i, right.i)
Protected *ptr.quirc_region
*ptr = *user_data
*ptr\count + (right - left + 1)
EndProcedure
Procedure.i region_code(*q.quirc, x.i, y.i)
Protected.i pixel, region
Protected *box.quirc_region
If x < 0 Or y < 0 Or x >= *q\w Or y >= *q\h
ProcedureReturn -1
EndIf
pixel = *q\pixels\v[y * *q\w + x]
If pixel >= #QUIRC_PIXEL_REGION
ProcedureReturn pixel
EndIf
If pixel = #QUIRC_PIXEL_WHITE
ProcedureReturn -1
EndIf
If *q\num_regions >= #QUIRC_MAX_REGIONS
ProcedureReturn -1
EndIf
region = *q\num_regions
*box = @*q\regions[*q\num_regions]
*q\num_regions + 1
FillMemory(*box, SizeOf(quirc_region), 0)
*box\seed\x = x
*box\seed\y = y
*box\capstone = -1
flood_fill_seed(*q, x, y, pixel, region, @area_count(), *box)
ProcedureReturn region
EndProcedure
Structure polygon_score_data
ref.quirc_point
scores.i[4]
corners.quirc_point[4]
EndStructure
Procedure find_one_corner(*user_data, y.i, left.i, right.i)
Protected.i dy, i, dx, d
Protected *psd.polygon_score_data
Protected Dim xs.i(1)
*psd = *user_data
xs(0) = Left
xs(1) = Right
dy = y - *psd\ref\y
For i = 0 To 1
dx = xs(i) - *psd\ref\x
d = dx * dx + dy * dy
If d > *psd\scores[0]
*psd\scores[0] = d
*psd\corners[0]\x = xs(i)
*psd\corners[0]\y = y
EndIf
Next i
EndProcedure
Procedure find_other_corners(*user_data, y.i, left.i, right.i)
Protected.i i, up, j
Protected *psd.polygon_score_data
Protected Dim xs.i(1)
Protected Dim scores.i(3)
*psd = *user_data
xs(0) = Left
xs(1) = Right
For i = 0 To 1
up = xs(i) * *psd\ref\x + y * *psd\ref\y
right = xs(i) * -*psd\ref\y + y * *psd\ref\x
scores(0) = up
scores(1) = right
scores(2) = -up
scores(3) = -right
For j = 0 To 3
If scores(j) > *psd\scores[j]
*psd\scores[j] = scores(j)
*psd\corners[j]\x = xs(i)
*psd\corners[j]\y = y
EndIf
Next j
Next i
EndProcedure
Procedure find_region_corners(*q.quirc, rcode.i, *ref.quirc_point, *corners.quirc_pointArrayStructure)
Protected.i i
Protected *region.quirc_region
Protected psd.polygon_score_data
*region = @*q\regions[rcode]
;psd\corners = *corners NOT possible in PB so I need to copy it now, and later back
CopyMemory(@*corners\v[0], @psd\corners[0], SizeOf(quirc_point) * 4)
CopyMemory(*ref, @psd\ref, SizeOf(quirc_point))
psd\scores[0] = -1
flood_fill_seed(*q, *region\seed\x, *region\seed\y, rcode, #QUIRC_PIXEL_BLACK, @find_one_corner(), @psd)
psd\ref\x = psd\corners[0]\x - psd\ref\x
psd\ref\y = psd\corners[0]\y - psd\ref\y
For i = 0 To 3
CopyMemory(@*region\seed, @psd\corners[i], SizeOf(quirc_point))
Next i
i = *region\seed\x * psd\ref\x + *region\seed\y * psd\ref\y
psd\scores[0] = i
psd\scores[2] = -i
i = *region\seed\x * -psd\ref\y + *region\seed\y * psd\ref\x
psd\scores[1] = i
psd\scores[3] = -i
flood_fill_seed(*q, *region\seed\x, *region\seed\y, #QUIRC_PIXEL_BLACK, rcode, @find_other_corners(), @psd)
; copy the corners back
CopyMemory(@psd\corners[0], @*corners\v[0], SizeOf(quirc_point) * 4)
EndProcedure
Procedure record_capstone(*q.quirc, ring.i, stone.i)
Protected.i cs_index
Protected.quirc_region *stone_reg, *ring_reg
Protected.quirc_capstone *capstone
*stone_reg = @*q\regions[stone]
*ring_reg = @*q\regions[ring]
If *q\num_capstones >= #QUIRC_MAX_CAPSTONES
ProcedureReturn
EndIf
cs_index = *q\num_capstones
*capstone = @*q\capstones[*q\num_capstones]
*q\num_capstones + 1
FillMemory(*capstone, SizeOf(quirc_capstone), 0)
*capstone\qr_grid = -1
*capstone\ring = ring
*capstone\stone = stone
*stone_reg\capstone = cs_index
*ring_reg\capstone = cs_index
; Find the corners of the ring
find_region_corners(*q, ring, @*stone_reg\seed, @*capstone\corners[0])
; Set up the perspective transform And find the center
perspective_setup(@*capstone\c[0], @*capstone\corners[0], 7.0, 7.0)
perspective_map(@*capstone\c[0], 3.5, 3.5, @*capstone\center)
EndProcedure
Procedure test_capstone(*q.quirc, x.i, y.i, *pb.IntegerArrayStructure)
Protected.i ring_right, stone, ring_left, ratio
Protected.quirc_region *stone_reg, *ring_reg
ring_right = region_code(*q, x - *pb\v[4], y)
stone = region_code(*q, x - *pb\v[4] - *pb\v[3] - *pb\v[2], y)
ring_left = region_code(*q, x - *pb\v[4] - *pb\v[3] - *pb\v[2] - *pb\v[1] - *pb\v[0], y)
If ring_left < 0 Or ring_right < 0 Or stone < 0
ProcedureReturn
EndIf
; Left And ring of ring should be connected
If ring_left <> ring_right
ProcedureReturn
EndIf
; Ring should be disconnected from stone
If ring_left = stone
ProcedureReturn
EndIf
*stone_reg = @*q\regions[stone]
*ring_reg = @*q\regions[ring_left]
; Already detected
If *stone_reg\capstone >= 0 Or *ring_reg\capstone >= 0
ProcedureReturn
EndIf
; Ratio should ideally be 37.5
ratio = *stone_reg\count * 100 / *ring_reg\count
If ratio < 10 Or ratio > 70
ProcedureReturn
EndIf
record_capstone(*q, ring_left, stone)
EndProcedure
Procedure finder_scan(*q.quirc, y.i)
Protected.i x, last_color, run_length, run_count, color, avg, err, i, ok
Protected *row.quirc_pixel_array
Protected *pb.IntegerArrayStructure
Protected Dim check.i(4)
*row = *q\pixels + y * *q\w
*pb = AllocateMemory(5 * SizeOf(Integer))
For x = 0 To *q\w - 1
If *row\v[x]
color = 1
Else
color = 0
EndIf
If x And color <> last_color
;memmove(pb, pb + 1, SizeOf(pb[0]) * 4)
MoveMemory(*pb + SizeOf(Integer), *pb, SizeOf(Integer) * 4)
*pb\v[4] = run_length
run_length = 0
run_count + 1
If Not color And run_count >= 5
check(0) = 1
check(1) = 1
check(2) = 3
check(3) = 1
check(4) = 1
ok = 1
avg = (*pb\v[0] + *pb\v[1] + *pb\v[3] + *pb\v[4]) / 4
err = avg * 3 / 4
For i = 0 To 4
If *pb\v[i] < check(i) * avg - err Or *pb\v[i] > check(i) * avg + err
ok = 0
EndIf
Next i
If ok
test_capstone(*q, x, y, *pb)
EndIf
EndIf
EndIf
run_length + 1
last_color = color
Next x
EndProcedure
Procedure find_alignment_pattern(*q.quirc, index.i)
Protected.i size_estimate, step_size, dir, i, code
Protected.d u, v
Protected.quirc_grid *qr
Protected.quirc_capstone *c0, *c2
Protected.quirc_point a, b, c
Protected.quirc_region *reg
Protected Dim dx_map.i(3)
Protected Dim dy_map.i(3)
*qr = *q\grids[index]
*c0 = *q\capstones[*qr\caps[0]]
*c2 = *q\capstones[*qr\caps[2]]
step_size = 1
; Grab our previous estimate of the alignment pattern corner
CopyMemory(*qr\align, @b, SizeOf(quirc_point))
; Guess another two corners of the alignment pattern so that we
; can estimate its size.
perspective_unmap(@*c0\c, @b, @u, @v)
perspective_map(@*c0\c, u, v + 1.0, @a)
perspective_unmap(@*c2\c, @b, @u, @v)
perspective_map(@*c2\c, u + 1.0, v, @c)
size_estimate = Abs((a\x - b\x) * -(c\y - b\y) + (a\y - b\y) * (c\x - b\x))
; Spiral outwards from the estimate point Until we find something
; roughly the right size. Don't look too far from the estimate
; point.
dx_map(0) = 1
dx_map(1) = 0
dx_map(2) = -1
dx_map(3) = 0
dy_map(0) = 0
dy_map(1) = -1
dy_map(2) = 0
dy_map(3) = 1
While step_size * step_size < size_estimate * 100
For i = 0 To step_size - 1
code = region_code(*q, b\x, b\y)
If code >= 0
*reg = @*q\regions[code]
If *reg\count >= size_estimate / 2 And *reg\count <= size_estimate * 2
*qr\align_region = code
ProcedureReturn
EndIf
EndIf
b\x + dx_map(dir)
b\y + dy_map(dir)
Next i
dir = (dir + 1) % 4
If Not dir & 1
step_size + 1
EndIf
Wend
EndProcedure
Procedure find_leftmost_to_line(*user_data, y.i, left.i, right.i)
Protected.i i, d
Protected *psd.polygon_score_data
Protected Dim xs.i(1)
*psd = *user_data
xs(0) = left
xs(1) = right
For i = 0 To 1
d = -*psd\ref\y * xs(i) + *psd\ref\x * y
If d < *psd\scores[0]
*psd\scores[0] = d
*psd\corners[0]\x = xs(i)
*psd\corners[0]\y = y
EndIf
Next i
EndProcedure
Procedure.d _length(*a.quirc_point, *b.quirc_point)
Protected.d x, y
x = Abs(*a\x - *b\x) + 1
y = Abs(*a\y - *b\y) + 1
ProcedureReturn Sqr(x * x + y * y)
EndProcedure
; Estimate grid size by determing distance between capstones
Procedure measure_grid_size(*q.quirc, index.i)
Protected *qr.quirc_grid
Protected.quirc_capstone *a, *b, *c
Protected.d ab, capstone_ab_size, ver_grid
Protected.d bc, capstone_bc_size, hor_grid
Protected.d grid_size_estimate
Protected.i ver
*qr = @*q\grids[index]
*a = @*q\capstones[*qr\caps[0]]
*b = @*q\capstones[*qr\caps[1]]
*c = @*q\capstones[*qr\caps[2]]
ab = _length(*b\corners[0], *a\corners[3])
capstone_ab_size = (_length(*b\corners[0], *b\corners[3]) + _length(*a\corners[0], *a\corners[3]))/2.0
ver_grid = 7.0 * ab / capstone_ab_size
bc = _length(*b\corners[0], *c\corners[1])
capstone_bc_size = (_length(*b\corners[0], *b\corners[1]) + _length(*c\corners[0], *c\corners[1]))/2.0
hor_grid = 7.0 * bc / capstone_bc_size
grid_size_estimate = (ver_grid + hor_grid) / 2.0
ver = Int((grid_size_estimate - 17.0 + 2.0) / 4.0)
*qr\grid_size = 4 * ver + 17
EndProcedure
; Read a cell from a grid using the currently set perspective
; transform. Returns +/- 1 For black/white, 0 For cells which are
; out of image bounds.
Procedure.i read_cell(*q.quirc, index.i, x.i, y.i)
Protected *qr.quirc_grid, p.quirc_point
*qr = @*q\grids[index]
perspective_map(@*qr\c, x + 0.5, y + 0.5, @p)
If p\y < 0 Or p\y >= *q\h Or p\x < 0 Or p\x >= *q\w
ProcedureReturn 0
EndIf
If *q\pixels\v[p\y * *q\w + p\x]
ProcedureReturn 1
Else
ProcedureReturn -1
EndIf
EndProcedure
Procedure.i fitness_cell(*q.quirc, index.i, x.i, y.i)
Protected.i score, u, v
Protected *qr.quirc_grid
Protected p.quirc_point
Protected Dim offsets.d(2)
*qr = @*q\grids[index]
offsets(0) = 0.3
offsets(1) = 0.5
offsets(2) = 0.7
For v = 0 To 2
For u = 0 To 2
perspective_map(@*qr\c, x + offsets(u), y + offsets(v), @p)
If p\y < 0 Or p\y >= *q\h Or p\x < 0 Or p\x >= *q\w
Continue
EndIf
If *q\pixels\v[p\y * *q\w + p\x]
score + 1
Else
score - 1
EndIf
Next u
Next v
ProcedureReturn score
EndProcedure
Procedure.i fitness_ring(*q.quirc, index.i, cx.i, cy.i, radius.i)
Protected.i i, score
For i = 0 To radius * 2 - 1
score + fitness_cell(*q, index, cx - radius + i, cy - radius)
score + fitness_cell(*q, index, cx - radius, cy + radius - i)
score + fitness_cell(*q, index, cx + radius, cy - radius + i)
score + fitness_cell(*q, index, cx + radius - i, cy + radius)
Next i
ProcedureReturn score
EndProcedure
Procedure.i fitness_apat(*q.quirc, index.i, cx.i, cy.i)
ProcedureReturn fitness_cell(*q, index, cx, cy) - fitness_ring(*q, index, cx, cy, 1) + fitness_ring(*q, index, cx, cy, 2)
EndProcedure
Procedure.i fitness_capstone(*q.quirc, index.i, x.i, y.i)
x + 3
y + 3
ProcedureReturn fitness_cell(*q, index, x, y) + fitness_ring(*q, index, x, y, 1) - fitness_ring(*q, index, x, y, 2) + fitness_ring(*q, index, x, y, 3)
EndProcedure
; Compute a fitness score For the currently configured perspective
; transform, using the features we expect To find by scanning the
; grid.
Procedure.i fitness_all(*q.quirc, index.i)
Protected.i version, score, i, j, ap_count, expect
Protected *qr.quirc_grid
Protected *info.quirc_version_info
*qr = @*q\grids[index]
version = (*qr\grid_size - 17) / 4
*info = ?quirc_version_db_0 + version * SizeOf(quirc_version_info)
; Check the timing pattern
For i = 0 To *qr\grid_size - 15
If i & 1
expect = 1
Else
expect = -1
EndIf
score + fitness_cell(*q, index, i + 7, 6) * expect
score + fitness_cell(*q, index, 6, i + 7) * expect
Next i
; Check capstones
score + fitness_capstone(*q, index, 0, 0)
score + fitness_capstone(*q, index, *qr\grid_size - 7, 0)
score + fitness_capstone(*q, index, 0, *qr\grid_size - 7)
If version < 0 Or version > #QUIRC_MAX_VERSION
ProcedureReturn score
EndIf
; Check alignment patterns
ap_count = 0
While (ap_count < #QUIRC_MAX_ALIGNMENT) And *info\apat[ap_count]
ap_count + 1
Wend
For i = 1 To ap_count - 2
score + fitness_apat(*q, index, 6, *info\apat[i])
score + fitness_apat(*q, index, *info\apat[i], 6)
Next i
For i = 1 To ap_count - 1
For j = 1 To ap_count - 1
score + fitness_apat(*q, index, *info\apat[i], *info\apat[j])
Next j
Next i
ProcedureReturn score
EndProcedure
Procedure jiggle_perspective(*q.quirc, index.i)
Protected.i pass, i, best, j, test
Protected.d old, step_, new
Protected *qr.quirc_grid
Protected Dim adjustments.d(7)
*qr = @*q\grids[index]
best = fitness_all(*q, index)
For i = 0 To 7
adjustments(i) = *qr\c[i] * 0.02
Next i
For pass = 0 To 4
For i = 0 To 15
j = i >> 1
old = *qr\c[j]
Step_ = adjustments(j)
If i & 1
new = old + Step_
Else
new = old - Step_
EndIf
*qr\c[j] = new
test = fitness_all(*q, index)
If test > best
best = test
Else
*qr\c[j] = old
EndIf
Next i
For i = 0 To 7
adjustments(i) * 0.5
Next i
Next pass
EndProcedure
; Once the capstones are in place And an alignment point has been
; chosen, we call this function To set up a grid-reading perspective
; transform.
Procedure setup_qr_perspective(*q.quirc, index.i)
Protected *qr.quirc_grid
Protected *rect.quirc_pointArrayStructure
*qr = @*q\grids[index]
*rect = AllocateMemory(SizeOf(quirc_point) * 4)
If *rect
; Set up the perspective Map For reading the grid
CopyMemory(@*q\capstones[*qr\caps[1]]\corners[0], @*rect\v[0], SizeOf(quirc_point))
CopyMemory(@*q\capstones[*qr\caps[2]]\corners[0], @*rect\v[1], SizeOf(quirc_point))
CopyMemory(@*qr\align, @*rect\v[2], SizeOf(quirc_point))
CopyMemory(@*q\capstones[*qr\caps[0]]\corners[0], @*rect\v[3], SizeOf(quirc_point))
perspective_setup(@*qr\c, *rect, *qr\grid_size - 7, *qr\grid_size - 7)
jiggle_perspective(*q, index)
FreeMemory(*rect)
EndIf
EndProcedure
; Rotate the capstone With so that corner 0 is the leftmost With respect
; To the given reference line.
Procedure rotate_capstone(*cap.quirc_capstone, *h0.quirc_point, *hd.quirc_point)
Protected.i j, best, best_score, score
Protected *p.quirc_point
Protected Dim copy.quirc_point(3)
best_score = #INT_MAX
For j = 0 To 3
*p = @*cap\corners[j]
score = (*p\x - *h0\x) * -*hd\y + (*p\y - *h0\y) * *hd\x
If Not j Or score < best_score
best = j
best_score = score
EndIf
Next j
; Rotate the capstone
For j = 0 To 3
CopyMemory(@*cap\corners[(j + best) % 4], @copy(j), SizeOf(quirc_point))
Next j
CopyMemory(@copy(), *cap\corners, SizeOf(*cap\corners))
perspective_setup(@*cap\c, @*cap\corners, 7.0, 7.0)
EndProcedure
Procedure record_qr_grid(*q.quirc, a.i, b.i, c.i)
Protected.i i, qr_index, swap_
Protected.quirc_point h0, hd
Protected *qr.quirc_grid
Protected *cap.quirc_capstone
Protected psd.polygon_score_data
Protected *reg.quirc_region
If *q\num_grids >= #QUIRC_MAX_GRIDS
ProcedureReturn
EndIf
; Construct the hypotenuse line from A To C. B should be To
; the left of this line.
CopyMemory(@*q\capstones[a]\center, @h0, SizeOf(h0))
hd\x = *q\capstones[c]\center\x - *q\capstones[a]\center\x
hd\y = *q\capstones[c]\center\y - *q\capstones[a]\center\y
; Make sure A-B-C is clockwise
If (*q\capstones[b]\center\x - h0\x) * -hd\y + (*q\capstones[b]\center\y - h0\y) * hd\x > 0
swap_ = a
a = c
c = swap_
hd\x = -hd\x
hd\y = -hd\y
EndIf
; Record the grid And its components
qr_index = *q\num_grids
*qr = @*q\grids[*q\num_grids]
*q\num_grids + 1
FillMemory(*qr, SizeOf(quirc_grid), 0)
*qr\caps[0] = a
*qr\caps[1] = b
*qr\caps[2] = c
*qr\align_region = -1
; Rotate each capstone so that corner 0 is top-left With respect
; To the grid.
For i = 0 To 2
*cap = @*q\capstones[*qr\caps[i]]
rotate_capstone(*cap, @h0, @hd)
*cap\qr_grid = qr_index
Next i
; Check the timing pattern by measuring grid size. This doesn't require a perspective
; transform.
measure_grid_size(*q, qr_index)
; Make an estimate based For the alignment pattern based on extending
; lines from capstones A And C.
If Not line_intersect(@*q\capstones[a]\corners[0], @*q\capstones[a]\corners[1], @*q\capstones[c]\corners[0], @*q\capstones[c]\corners[3], @*qr\align)
; We've been unable to complete setup for this grid. Undo what we've
; recorded And pretend it never happened.
For i = 0 To 2
*q\capstones[*qr\caps[i]]\qr_grid = -1
Next i
*q\num_grids - 1
ProcedureReturn
EndIf
; On V2+ grids, we should use the alignment pattern.
If *qr\grid_size > 21
; Try To find the actual location of the alignment pattern.
find_alignment_pattern(*q, qr_index)
; Find the point of the alignment pattern closest To the
; top-left of the QR grid.
If *qr\align_region >= 0
*reg = @*q\regions[*qr\align_region]
; Start from some point inside the alignment pattern
CopyMemory(@*reg\seed, @*qr\align, SizeOf(*qr\align))
CopyMemory(@hd, @psd\ref, SizeOf(psd\ref))
;psd\corners = @*qr\align
CopyMemory(@*qr\align, @psd\corners, SizeOf(quirc_point))
psd\scores[0] = -hd\y * *qr\align\x + hd\x * *qr\align\y
flood_fill_seed(*q, *reg\seed\x, *reg\seed\y, *qr\align_region, #QUIRC_PIXEL_BLACK, #Null, #Null)
flood_fill_seed(*q, *reg\seed\x, *reg\seed\y, #QUIRC_PIXEL_BLACK, *qr\align_region, @find_leftmost_to_line(), @psd)
EndIf
EndIf
setup_qr_perspective(*q, qr_index)
EndProcedure
Structure neighbour
index.i
distance.d
EndStructure
Structure neighbour_list
n.neighbour[#QUIRC_MAX_CAPSTONES]
count.i
EndStructure
Procedure test_neighbours(*q.quirc, i.i, *hlist.neighbour_list, *vlist.neighbour_list)
Protected.i j, k
Protected.d squareness
Protected.neighbour *hn, *vn
; Test each possible grouping
For j = 0 To *hlist\count - 1
*hn = @*hlist\n[j]
For k = 0 To *vlist\count - 1
*vn = @*vlist\n[k]
squareness = Abs(1.0 - *hn\distance / *vn\distance)
If squareness < 0.2
record_qr_grid(*q, *hn\index, i, *vn\index)
EndIf
Next k
Next j
EndProcedure
Procedure test_grouping(*q.quirc, i.i)
Protected.i j
Protected.d u, v
Protected.quirc_capstone *c1, *c2
Protected.neighbour_list hlist, vlist
Protected.neighbour *n
*c1 = @*q\capstones[i]
; Look For potential neighbours by examining the relative gradients
; from this capstone To others.
For j = 0 To *q\num_capstones - 1
*c2 = @*q\capstones[j]
If i = j
Continue
EndIf
perspective_unmap(@*c1\c, @*c2\center, @u, @v)
u = Abs(u - 3.5)
v = Abs(v - 3.5)
If u < 0.2 * v
*n = @hlist\n[hlist\count]
hlist\count + 1
*n\index = j
*n\distance = v
EndIf
If v < 0.2 * u
*n = @vlist\n[vlist\count]
vlist\count + 1
*n\index = j
*n\distance = u
EndIf
Next j
If Not (hlist\count And vlist\count)
ProcedureReturn
EndIf
test_neighbours(*q, i, @hlist, @vlist)
EndProcedure
Procedure pixels_setup(*q.quirc, threshold.a)
Protected.a value
Protected.i length
Protected *source.Ascii
Protected *dest.quirc_pixel_array
If #QUIRC_PIXEL_ALIAS_IMAGE
*q\pixels = *q\image
EndIf
*source = *q\image
*dest = *q\pixels
length = *q\w * *q\h
While length
value = *source\a
*source + 1
If value < threshold
*dest\v = #QUIRC_PIXEL_BLACK
Else
*dest\v = #QUIRC_PIXEL_WHITE
EndIf
*dest + SizeOf(quirc_pixel_ptr)
length - 1
Wend
EndProcedure
Procedure.i quirc_begin(*q.quirc, *w.Integer, *h.Integer)
*q\num_regions = #QUIRC_PIXEL_REGION
*q\num_capstones = 0
*q\num_grids = 0
If *w
*w\i = *q\w
EndIf
If *h
*h\i = *q\h
EndIf
ProcedureReturn *q\image
EndProcedure
Procedure quirc_end(*q.quirc)
Protected.a threshold
Protected.i i
threshold = otsu(*q)
pixels_setup(*q, threshold)
For i = 0 To *q\h - 1
finder_scan(*q, i)
Next i
For i = 0 To *q\num_capstones - 1
test_grouping(*q, i)
Next i
EndProcedure
Procedure quirc_extract(*q.quirc, index.i, *code.quirc_code)
Protected.i y, i, x
Protected *qr.quirc_grid
*qr = @*q\grids[index]
If index < 0 Or index > *q\num_grids
ProcedureReturn
EndIf
FillMemory(*code, SizeOf(*code), 0)
perspective_map(@*qr\c, 0.0, 0.0, @*code\corners[0])
perspective_map(@*qr\c, *qr\grid_size, 0.0, @*code\corners[1])
perspective_map(@*qr\c, *qr\grid_size, *qr\grid_size, @*code\corners[2])
perspective_map(@*qr\c, 0.0, *qr\grid_size, @*code\corners[3])
*code\size = *qr\grid_size
; Skip out early so As Not To overrun the buffer. quirc_decode
; will Return an error on interpreting the code.
If *code\size > #QUIRC_MAX_GRID_SIZE
ProcedureReturn
EndIf
For y = 0 To *qr\grid_size - 1
For x = 0 To *qr\grid_size - 1
If read_cell(*q, index, x, y) > 0
*code\cell_bitmap[i >> 3] | (1 << (i & 7))
EndIf
i + 1
Next x
Next y
EndProcedure