File Coverage

XS.xs
Criterion Covered Total %
statement 41 42 97.6
branch 9 12 75.0
condition n/a
subroutine n/a
pod n/a
total 50 54 92.5


line stmt bran cond sub pod time code
1             #include "EXTERN.h"
2             #include "perl.h"
3             #include "XSUB.h"
4              
5             #include "ppport.h"
6             #include "qtbase.h"
7              
8             MODULE = Algorithm::QuadTree::XS PACKAGE = Algorithm::QuadTree::XS
9              
10             PROTOTYPES: DISABLE
11              
12             void
13             _AQT_init(self)
14             SV *self
15             CODE:
16 5           QuadTreeRootNode *root = create_root();
17              
18 5           HV *params = (HV*) SvRV(self);
19              
20 5           node_add_level(root->node,
21             SvNV(get_hash_key(params, "XMIN", 4)),
22             SvNV(get_hash_key(params, "YMIN", 4)),
23             SvNV(get_hash_key(params, "XMAX", 4)),
24             SvNV(get_hash_key(params, "YMAX", 4)),
25 5           SvIV(get_hash_key(params, "DEPTH", 5))
26             );
27              
28 5           SV *root_sv = newSViv((uintptr_t) root);
29 5           SvREADONLY_on(root_sv);
30 5           hv_stores(params, "ROOT", root_sv);
31              
32             void
33             _AQT_deinit(self)
34             SV *self
35             CODE:
36 5           QuadTreeRootNode *root = get_root_from_perl(self);
37              
38 5           clear_tree(root);
39 5           destroy_node(root->node);
40 5           free(root->node);
41 5           SvREFCNT_dec((SV*) root->backref);
42              
43 5           free(root);
44              
45              
46             void
47             _AQT_addObject(self, object, x, y, x2_or_radius, ...)
48             SV *self
49             SV *object
50             double x
51             double y
52             double x2_or_radius
53             CODE:
54 55           QuadTreeRootNode *root = get_root_from_perl(self);
55              
56 55           Shape *param = create_shape();
57 55 100         if (items > 5) {
58 49           prepare_rectangle(param, x, y, x2_or_radius, SvNV(ST(5)));
59             }
60             else {
61 6           prepare_circle(param, x, y, x2_or_radius);
62             }
63              
64 55 50         if (fill_nodes(root->node, object, param)) {
65 55           adopt_object(root, object, param);
66             }
67             else {
68 0           destroy_shape(param);
69             }
70              
71             SV*
72             _AQT_findObjects(self, x, y, x2_or_radius, ...)
73             SV *self
74             double x
75             double y
76             double x2_or_radius
77             CODE:
78 74           QuadTreeRootNode *root = get_root_from_perl(self);
79              
80 74           HV *params = (HV*) SvRV(self);
81 74           SV *geometry_checks = get_hash_key(params, "CHECK", 5);
82 74           HV *ret_hash = newHV();
83              
84             Shape param;
85 74 100         if (items > 4) {
86 65           prepare_rectangle(¶m, x, y, x2_or_radius, SvNV(ST(4)));
87             }
88             else {
89 9           prepare_circle(¶m, x, y, x2_or_radius);
90             }
91              
92 74           find_nodes(root->node, ret_hash, ¶m, false);
93 74 50         if (geometry_checks != NULL && SvIV(geometry_checks) != 0)
    100          
94 6           filter_geometry(ret_hash, root->backref, ¶m);
95              
96 74           AV *ret = get_hash_values(ret_hash);
97              
98 74           SvREFCNT_dec((SV*) ret_hash);
99 74           RETVAL = newRV_noinc((SV*) ret);
100             OUTPUT:
101             RETVAL
102              
103             void
104             _AQT_delete(self, object)
105             SV *self
106             SV *object
107             CODE:
108 1           QuadTreeRootNode *root = get_root_from_perl(self);
109              
110 1 50         if (hv_exists_ent(root->backref, object, 0)) {
111 1           Shape* s = (Shape*) SvIV(HeVAL(hv_fetch_ent(root->backref, object, 0, 0)));
112 1           delete_nodes(root->node, object, s, false);
113 1           destroy_shape(s);
114 1           disown_object(root, object);
115             }
116              
117             void
118             _AQT_clear(self)
119             SV* self
120             CODE:
121 3           QuadTreeRootNode *root = get_root_from_perl(self);
122 3           clear_tree(root);
123