File Coverage

XS.xs
Criterion Covered Total %
statement 48 49 97.9
branch 6 8 75.0
condition n/a
subroutine n/a
pod n/a
total 54 57 94.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(obj)
14             SV *obj
15             CODE:
16 4           QuadTreeRootNode *root = create_root();
17              
18 4           HV *params = (HV*) SvRV(obj);
19              
20 4           node_add_level(root->node,
21             SvNV(get_hash_key(params, "XMIN")),
22             SvNV(get_hash_key(params, "YMIN")),
23             SvNV(get_hash_key(params, "XMAX")),
24             SvNV(get_hash_key(params, "YMAX")),
25 4           SvIV(get_hash_key(params, "DEPTH"))
26             );
27              
28 4           SV *root_sv = newSViv((uintptr_t) root);
29 4           SvREADONLY_on(root_sv);
30 4           hv_stores(params, "ROOT", root_sv);
31              
32             void
33             _AQT_deinit(self)
34             SV *self
35             CODE:
36 4           QuadTreeRootNode *root = get_root_from_perl(self);
37              
38 4           clear_tree(root);
39 4           destroy_node(root->node);
40 4           free(root->node);
41 4           destroy_array(root->objects);
42 4           SvREFCNT_dec((SV*) root->backref);
43              
44 4           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 53           QuadTreeRootNode *root = get_root_from_perl(self);
56              
57 53           Shape *param = create_shape();
58 53           param->x = x;
59 53           param->y = y;
60 53 100         if (items > 5) {
61 48           param->type = shape_rectangle;
62 48           param->x2 = x2_or_radius;
63 48           param->y2 = SvNV(ST(5));
64             }
65             else {
66 5           param->type = shape_circle;
67 5           param->radius_sq = x2_or_radius * x2_or_radius;
68             }
69              
70 53 50         if (fill_nodes(root->node, object, param)) {
71 53           adopt_object(root, object, param);
72             }
73             else {
74 0           destroy_shape(param);
75             }
76              
77             SV*
78             _AQT_findObjects(self, x, y, x2_or_radius, ...)
79             SV *self
80             double x
81             double y
82             double x2_or_radius
83             CODE:
84 64           QuadTreeRootNode *root = get_root_from_perl(self);
85              
86 64           HV *ret_hash = newHV();
87              
88             Shape param;
89 64           param.x = x;
90 64           param.y = y;
91 64 100         if (items > 4) {
92 61           param.type = shape_rectangle;
93 61           param.x2 = x2_or_radius;
94 61           param.y2 = SvNV(ST(4));
95             }
96             else {
97 3           param.type = shape_circle;
98 3           param.radius_sq = x2_or_radius * x2_or_radius;
99             }
100              
101 64           find_nodes(root->node, ret_hash, ¶m);
102 64           AV *ret = get_hash_values(ret_hash);
103              
104 64           SvREFCNT_dec((SV*) ret_hash);
105 64           RETVAL = newRV_noinc((SV*) ret);
106             OUTPUT:
107             RETVAL
108              
109             void
110             _AQT_delete(self, object)
111             SV *self
112             SV *object
113             CODE:
114 1           QuadTreeRootNode *root = get_root_from_perl(self);
115              
116 1 50         if (hv_exists_ent(root->backref, object, 0)) {
117 1           Shape* s = (Shape*) SvIV(HeVAL(hv_fetch_ent(root->backref, object, 0, 0)));
118 1           delete_nodes(root->node, object, s);
119 1           destroy_shape(s);
120 1           disown_object(root, object);
121             }
122              
123             void
124             _AQT_clear(self)
125             SV* self
126             CODE:
127 3           QuadTreeRootNode *root = get_root_from_perl(self);
128 3           clear_tree(root);
129