File Coverage

XS.xs
Criterion Covered Total %
statement 42 43 97.6
branch 9 12 75.0
condition n/a
subroutine n/a
pod n/a
total 51 55 92.7


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           destroy_array(root->objects);
42 5           SvREFCNT_dec((SV*) root->backref);
43              
44 5           free(root);
45              
46              
47             void
48             _AQT_addObject(self, object, x, y, x2_or_radius, ...)
49             SV *self
50             SV *object
51             double x
52             double y
53             double x2_or_radius
54             CODE:
55 55           QuadTreeRootNode *root = get_root_from_perl(self);
56              
57 55           Shape *param = create_shape();
58 55 100         if (items > 5) {
59 49           prepare_rectangle(param, x, y, x2_or_radius, SvNV(ST(5)));
60             }
61             else {
62 6           prepare_circle(param, x, y, x2_or_radius);
63             }
64              
65 55 50         if (fill_nodes(root->node, object, param)) {
66 55           adopt_object(root, object, param);
67             }
68             else {
69 0           destroy_shape(param);
70             }
71              
72             SV*
73             _AQT_findObjects(self, x, y, x2_or_radius, ...)
74             SV *self
75             double x
76             double y
77             double x2_or_radius
78             CODE:
79 74           QuadTreeRootNode *root = get_root_from_perl(self);
80              
81 74           HV *params = (HV*) SvRV(self);
82 74           SV *geometry_checks = get_hash_key(params, "CHECK", 5);
83 74           HV *ret_hash = newHV();
84              
85             Shape param;
86 74 100         if (items > 4) {
87 65           prepare_rectangle(¶m, x, y, x2_or_radius, SvNV(ST(4)));
88             }
89             else {
90 9           prepare_circle(¶m, x, y, x2_or_radius);
91             }
92              
93 74           find_nodes(root->node, ret_hash, ¶m, false);
94 74 50         if (geometry_checks != NULL && SvIV(geometry_checks) != 0)
    100          
95 6           filter_geometry(ret_hash, root->backref, ¶m);
96              
97 74           AV *ret = get_hash_values(ret_hash);
98              
99 74           SvREFCNT_dec((SV*) ret_hash);
100 74           RETVAL = newRV_noinc((SV*) ret);
101             OUTPUT:
102             RETVAL
103              
104             void
105             _AQT_delete(self, object)
106             SV *self
107             SV *object
108             CODE:
109 1           QuadTreeRootNode *root = get_root_from_perl(self);
110              
111 1 50         if (hv_exists_ent(root->backref, object, 0)) {
112 1           Shape* s = (Shape*) SvIV(HeVAL(hv_fetch_ent(root->backref, object, 0, 0)));
113 1           delete_nodes(root->node, object, s, false);
114 1           destroy_shape(s);
115 1           disown_object(root, object);
116             }
117              
118             void
119             _AQT_clear(self)
120             SV* self
121             CODE:
122 3           QuadTreeRootNode *root = get_root_from_perl(self);
123 3           clear_tree(root);
124