-
Notifications
You must be signed in to change notification settings - Fork 17
/
object_ml.cpp
134 lines (107 loc) · 3.69 KB
/
object_ml.cpp
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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
#include "lablqml.h"
#include "variant.h"
#include <caml/memory.h>
#include <caml/threads.h>
#include <caml/alloc.h>
#include <caml/callback.h>
#include <caml/custom.h>
#include <assert.h>
#include "object.h"
extern "C" void ocamlobject_callback (value *ocaml_function, QVariant v);
OCamlBinding::OCamlBinding(QObject *obj, const QString &name, value *func):
QObject(obj), ocaml_function(func), property(obj, name)
{
property.connectNotifySignal(this, SLOT(valueChanged()));
}
OCamlBinding::~OCamlBinding(){
if (ocaml_function != NULL) {
caml_acquire_runtime_system();
caml_remove_global_root(ocaml_function);
caml_release_runtime_system();
free(ocaml_function);
}
qDebug () << "destroyed object for " << property.name();
}
bool OCamlBinding::write(QVariant v) {
return property.write(v);
}
void OCamlBinding::valueChanged () {
if (ocaml_function != NULL) {
caml_acquire_runtime_system();
ocamlobject_callback (ocaml_function, property.read ());
caml_release_runtime_system();
}
}
OCamlObject::OCamlObject(QObject *parent):
QObject(parent)
{
caml_c_thread_register();
}
OCamlObject::~OCamlObject(){
caml_c_thread_unregister();
qDebug () << "object destroyed";
}
bool OCamlObject::write(QQmlProperty property, QVariant v) {
return property.write(v);
}
extern "C" {
void free_ocaml_binding_object(value v){
QMetaObject::invokeMethod (Ctype_of_val(OCamlBinding, v), "deleteLater", Qt::QueuedConnection);
}
static struct custom_operations ops = {
"lablqml.qml.property",
free_ocaml_binding_object,
custom_compare_default,
custom_hash_default,
custom_serialize_default,
custom_deserialize_default,
custom_compare_ext_default
};
value ocamlobject_binding(value create, value qt_object_val, value property_name_val, value func_val) {
CAMLparam4(create, qt_object_val, property_name_val, func_val);
CAMLlocal1(result_val);
QObject *o = Ctype_field(QObject, qt_object_val, 0);
Q_ASSERT(o != nullptr);
if (!Bool_val(create)) {
QVariant property_object = o->property(String_val(property_name_val));
if (!property_object.isValid())
caml_failwith("Property not found");
}else{
caml_failwith("Implicit creation not supported yet");
}
value *ocaml_function = (value*) malloc(sizeof(func_val));
*ocaml_function = func_val;
caml_register_global_root(ocaml_function);
OCamlBinding *binding = new OCamlBinding ((OCamlObject *)o, String_val(property_name_val), ocaml_function);
result_val = caml_alloc_custom(&ops, sizeof(OCamlBinding*), 0, 1);
Ctype_of_val(OCamlBinding, result_val) = binding;
CAMLreturn(result_val);
}
// Warning: synchronously reading into Qt from another thread can cause corruption
//value caml_qml_ocaml_object_value(value ocaml_object_val) {
// CAMLparam1(ocaml_object_val);
// CAMLlocal1(result_variant_val);
//
// OCamlObject *binding = Ctype_of_val(OCamlObject, ocaml_object_val);
// Q_ASSERT(binding != nullptr);
// QVariant ret = binding->read(); // Synchronous read..
//
// CAMLreturn(Val_QVariant(result_variant_val, ret));
//}
value ocamlobject_write(value binding_val, value value_val) {
CAMLparam2(binding_val, value_val);
auto *b = Ctype_of_val(OCamlBinding, binding_val);
Q_ASSERT(b != nullptr);
bool written = QMetaObject::invokeMethod
(b, "write", Qt::QueuedConnection,
Q_ARG(QVariant, QVariant_val(value_val)));
CAMLreturn(written? Val_true: Val_false);
}
void ocamlobject_callback (value *ocaml_function, QVariant v) {
CAMLparam0();
CAMLlocal1(variant_val);
caml_c_thread_register();
caml_callback(*ocaml_function, Val_QVariant(variant_val, v));
CAMLreturn0;
}
} // Extern C