Another attempt to make it work
This commit is contained in:
parent
47aaa4bbe3
commit
f6566b8e38
|
|
@ -1,4 +1,6 @@
|
|||
(import (qml core)
|
||||
(import
|
||||
(chicken foreign)
|
||||
(qml core)
|
||||
coops)
|
||||
|
||||
(gui-application-create)
|
||||
|
|
@ -6,6 +8,19 @@
|
|||
(define loc (new-QUrl "examples/helloworld.qml"))
|
||||
(load-url engine loc)
|
||||
|
||||
(define-external (windowCloseCallback (c-pointer cbdata) (int argc) ((c-pointer c-pointer) argv)) void
|
||||
(print (string-append "Got back " argc " arguments.")))
|
||||
|
||||
(define callback-data (new-CallbackData "Test"))
|
||||
|
||||
(define conn (connect-lambda-static engine "quit"
|
||||
windowCloseCallback
|
||||
callback-data
|
||||
(qt-connection-type auto:)))
|
||||
|
||||
(do ((loop #t))
|
||||
((not loop) #t)
|
||||
(process-events-timed (qevent-loop-process-event-flag process-all-events:) 50))
|
||||
|
||||
(type windowCloseCallback)
|
||||
(type callback-data)
|
||||
|
|
|
|||
134
qml.core.scm
134
qml.core.scm
|
|
@ -2,12 +2,15 @@
|
|||
(import (r7rs))
|
||||
|
||||
(define-library (qml core)
|
||||
(import (chicken base))
|
||||
(import (chicken gc))
|
||||
(import (chicken string))
|
||||
(import (chicken condition))
|
||||
(import (chicken foreign))
|
||||
(import (chicken memory))
|
||||
(import (qml lowlevel))
|
||||
(import (scheme base))
|
||||
(import coops coops-primitive-objects coops-extras coops-utils srfi-1 srfi-69)
|
||||
(import coops coops-primitive-objects coops-extras coops-utils srfi-1 srfi-69 object-evict)
|
||||
(export application-dir-path
|
||||
process-events
|
||||
process-events-timed
|
||||
|
|
@ -74,8 +77,23 @@
|
|||
<PropertyDefinitions>
|
||||
new-Properties
|
||||
|
||||
<QMetaObjectConnection>
|
||||
delete-pointer
|
||||
|
||||
<CallbackData>
|
||||
new-CallbackData
|
||||
pointer
|
||||
|
||||
<QObject>
|
||||
signal-emit
|
||||
object-name
|
||||
set-object-name
|
||||
property
|
||||
set-property
|
||||
connect-lambda-static
|
||||
connect-static
|
||||
disconnect-static
|
||||
disconnect-with-connection-static
|
||||
|
||||
<QVariant>
|
||||
qvariant
|
||||
|
|
@ -279,12 +297,66 @@
|
|||
(when (= 0 (refcount callback-registry (ptr qbase)))
|
||||
(delete-pointer qbase)))))
|
||||
|
||||
(define-class <QObject> (<QMLBase>))
|
||||
|
||||
(define-class <QVariant> (<QMLBase>)
|
||||
((ptr accessor: ptr)))
|
||||
(define-method (initialize-instance (qv <QVariant>))
|
||||
(set! (ptr qv) (dos_qvariant_create))
|
||||
(call-next-method))
|
||||
(define-method (qvariant (val <integer>))
|
||||
(make <QVariant> 'ptr (dos_qvariant_create_int val)))
|
||||
(define-method (qvariant (val <boolean>))
|
||||
(make <QVariant> 'ptr (dos_qvariant_create_bool val)))
|
||||
(define-method (qvariant (val <string>))
|
||||
(make <QVariant> 'ptr (dos_qvariant_create_string val)))
|
||||
(define-method (qvariant (val <QObject>))
|
||||
(make <QVariant> 'ptr (dos_qvariant_create_qobject (ptr val))))
|
||||
(define-method (qvariant (val <flonum>))
|
||||
(make <QVariant> 'ptr (dos_qvariant_create_float val)))
|
||||
(define-method (set (qv <QVariant>) (val <integer>))
|
||||
(dos_qvariant_setInt (ptr qv) val))
|
||||
(define-method (set (qv <QVariant>) (val <boolean>))
|
||||
(dos_qvariant_setBool (ptr qv) val))
|
||||
(define-method (set (qv <QVariant>) (val <flonum>))
|
||||
(dos_qvariant_setFloat (ptr qv) val))
|
||||
(define-method (set (qv <QVariant>) (val <string>))
|
||||
(dos_qvariant_setString (ptr qv) val))
|
||||
(define-method (set (qv <QVariant>) (val <QObject>))
|
||||
(dos_qvariant_setQObject (ptr qv) (ptr val)))
|
||||
(define-method (to (qv <QVariant>) (target <keyword>))
|
||||
(case target
|
||||
((integer:) (dos_qvariant_toInt (ptr qv)))
|
||||
((boolean:) (dos_qvariant_toBool (ptr qv)))
|
||||
((string:) (dos_qvariant_toString (ptr qv)))
|
||||
((flonum:) (dos_qvariant_toFloat (ptr qv)))
|
||||
((qobject:) (dos_qvariant_toQObject (ptr qv)))))
|
||||
(define-method (is-null? (qv <QVariant>))
|
||||
(dos_qvariant_isnull (ptr qv)))
|
||||
(define-method (assign (qv <QVariant>) (other <QVariant>))
|
||||
(dos_qvariant_assign (ptr qv) (ptr other)))
|
||||
(define-method (copy (qv <QVariant>))
|
||||
(make <QVariant> 'ptr (dos_qvariant_create_qvariant (ptr qv))))
|
||||
(define-method (delete-pointer (qv <QVariant>))
|
||||
(dos_qvariant_delete (ptr qv)))
|
||||
|
||||
(define-class <QMetaObjectConnection> (<QMLBase>)
|
||||
((ptr accessor: ptr)))
|
||||
(define-method (delete-pointer (qmoc <QMetaObjectConnection>))
|
||||
(dos_qmetaobject_connection_delete (slot-value qmoc 'ptr)))
|
||||
|
||||
(define-class <QObject> (<QMLBase>))
|
||||
(define-class <CallbackData> ()
|
||||
((obj accessor: obj)))
|
||||
(define (new-CallbackData data)
|
||||
(let ((object (object-evict data)))
|
||||
(make <CallbackData> 'obj object)))
|
||||
(define-method (pointer (cbdata <CallbackData>))
|
||||
(object->pointer (obj cbdata)))
|
||||
(define-method (initialize-instance (cbdata <CallbackData>))
|
||||
(call-next-method)
|
||||
(set-finalizer! cbdata (lambda (x)
|
||||
(object-release (slot-value cbdata 'obj)))))
|
||||
|
||||
(define-method (signal-emit (qo <QObject>) (name <string>) (paramcount <integer>) (parameters <sequence>))
|
||||
(dos_qobject_signal_emit (ptr qo) name paramcount parameters))
|
||||
(define-method (object-name (qo <QObject>))
|
||||
|
|
@ -296,6 +368,19 @@
|
|||
(define-method (set-property (qo <QObject>) (propertyName <string>) (value <QVariant>))
|
||||
(dos_qobject_setProperty (slot-value qo 'ptr) propertyName (slot-value value 'ptr)))
|
||||
|
||||
(define-method (connect-lambda-static (sender <QObject>) (signal <string>)
|
||||
(callback <procedure>) (callback-data <CallbackData>)
|
||||
(connection-type <QtConnectionType>))
|
||||
(print "Debug: Parameters passed to dos_qobject_connect_lambda_static(DosQObject *sender, const char *signal, DosQObjectConnectLambdaCallback callback, void* callbackData, DosQtConnectionType connectionType):")
|
||||
(print "DosQObject Pointer: " (ptr sender))
|
||||
(print "Signal: " signal)
|
||||
(print "Callback procedure: " callback)
|
||||
(print "Callback data: " (pointer callback-data))
|
||||
(print "Connection type integer: " (val connection-type))
|
||||
(dos_qobject_connect_lambda_static (ptr sender) signal
|
||||
callback (pointer callback-data)
|
||||
(val connection-type)))
|
||||
|
||||
(define-method (connect-static (sender <QObject>) (signal <string>)
|
||||
(receiver <QObject>) (slot <string>) (connection-type <QtConnectionType>))
|
||||
(make <QMetaObjectConnection> 'ptr
|
||||
|
|
@ -303,6 +388,8 @@
|
|||
(slot-value receiver 'ptr) slot (qt-connection-type connection-type))))
|
||||
(define-method (disconnect-static (sender <QObject>) (signal <string>) (receiver <QObject>) (slot <string>))
|
||||
(dos_qobject_disconnect_static (slot-value sender 'ptr) signal (slot-value receiver 'ptr) slot))
|
||||
(define-method (disconnect-with-connection-static (qmoc <QMetaObjectConnection>))
|
||||
(dos_qobject_disconnect_with_connection_static (slot-value qmoc 'ptr)))
|
||||
|
||||
(define-method (delete-pointer (qo <QObject>))
|
||||
(dos_qobject_delete (ptr qo)))
|
||||
|
|
@ -347,47 +434,6 @@
|
|||
(define-method (delete-pointer (pd <PropertyDefinitions>))
|
||||
(dos_propertydefinitions_delete (ptr pd)))
|
||||
|
||||
(define-class <QVariant> (<QMLBase>)
|
||||
((ptr accessor: ptr)))
|
||||
(define-method (initialize-instance (qv <QVariant>))
|
||||
(set! (ptr qv) (dos_qvariant_create))
|
||||
(call-next-method))
|
||||
(define-method (qvariant (val <integer>))
|
||||
(make <QVariant> 'ptr (dos_qvariant_create_int val)))
|
||||
(define-method (qvariant (val <boolean>))
|
||||
(make <QVariant> 'ptr (dos_qvariant_create_bool val)))
|
||||
(define-method (qvariant (val <string>))
|
||||
(make <QVariant> 'ptr (dos_qvariant_create_string val)))
|
||||
(define-method (qvariant (val <QObject>))
|
||||
(make <QVariant> 'ptr (dos_qvariant_create_qobject (ptr val))))
|
||||
(define-method (qvariant (val <flonum>))
|
||||
(make <QVariant> 'ptr (dos_qvariant_create_float val)))
|
||||
(define-method (set (qv <QVariant>) (val <integer>))
|
||||
(dos_qvariant_setInt (ptr qv) val))
|
||||
(define-method (set (qv <QVariant>) (val <boolean>))
|
||||
(dos_qvariant_setBool (ptr qv) val))
|
||||
(define-method (set (qv <QVariant>) (val <flonum>))
|
||||
(dos_qvariant_setFloat (ptr qv) val))
|
||||
(define-method (set (qv <QVariant>) (val <string>))
|
||||
(dos_qvariant_setString (ptr qv) val))
|
||||
(define-method (set (qv <QVariant>) (val <QObject>))
|
||||
(dos_qvariant_setQObject (ptr qv) (ptr val)))
|
||||
(define-method (to (qv <QVariant>) (target <keyword>))
|
||||
(case target
|
||||
((integer:) (dos_qvariant_toInt (ptr qv)))
|
||||
((boolean:) (dos_qvariant_toBool (ptr qv)))
|
||||
((string:) (dos_qvariant_toString (ptr qv)))
|
||||
((flonum:) (dos_qvariant_toFloat (ptr qv)))
|
||||
((qobject:) (dos_qvariant_toQObject (ptr qv)))))
|
||||
(define-method (is-null? (qv <QVariant>))
|
||||
(dos_qvariant_isnull (ptr qv)))
|
||||
(define-method (assign (qv <QVariant>) (other <QVariant>))
|
||||
(dos_qvariant_assign (ptr qv) (ptr other)))
|
||||
(define-method (copy (qv <QVariant>))
|
||||
(make <QVariant> 'ptr (dos_qvariant_create_qvariant (ptr qv))))
|
||||
(define-method (delete-pointer (qv <QVariant>))
|
||||
(dos_qvariant_delete (ptr qv)))
|
||||
|
||||
(define-class <QQmlContext> (<QObject>))
|
||||
(define-method (base-url (context <QQmlContext>))
|
||||
(dos_qqmlcontext_baseUrl (ptr context)))
|
||||
|
|
@ -434,7 +480,7 @@
|
|||
|
||||
(define-class <QQmlApplicationEngine> (<QObject>))
|
||||
(define-method (initialize-instance (qae <QQmlApplicationEngine>))
|
||||
(set! (slot-value qae 'ptr) (dos_qqmlapplicationengine_create))
|
||||
(set! (ptr qae) (dos_qqmlapplicationengine_create))
|
||||
(call-next-method))
|
||||
(define-method (load (appengine <QQmlApplicationEngine>) (filePath <string>))
|
||||
(dos_qqmlapplicationengine_load (ptr appengine) filePath))
|
||||
|
|
|
|||
|
|
@ -864,13 +864,20 @@
|
|||
(foreign-lambda bool "dos_qobject_setProperty"
|
||||
(c-pointer DosQObject) c-string (c-pointer DosQVariant)))
|
||||
|
||||
;; (define dos_qobject_connect_lambda_static
|
||||
;; (foreign-lambda* (c-pointer DosQMetaObjectConnection) (((c-pointer DosQObject) sender)
|
||||
;; (c-string signal)
|
||||
;; ((function void (c-pointer int (c-pointer c-pointer))) callback)
|
||||
;; (c-pointer callbackData)
|
||||
;; (DosQtConnectionType connection_type))
|
||||
;; "C_return(dos_qobject_connect_lambda_static(sender, signal, callback, callbackData, connection_type));"))
|
||||
(define dos_qobject_connect_lambda_static
|
||||
(foreign-lambda (c-pointer DosQMetaObjectConnection) "dos_qobject_connect_lambda_static"
|
||||
(c-pointer DosQObject) ;; sender
|
||||
c-string ;; signal
|
||||
DosQObjectConnectLambdaCallback ;; callback
|
||||
c-pointer ;; callbackData
|
||||
DosQtConnectionType)) ;; connection_type
|
||||
(c-pointer DosQObject) ;; sender
|
||||
c-string ;; signal
|
||||
(function void (c-pointer int pointer-vector)) ;; callback
|
||||
c-pointer ;; callbackData
|
||||
DosQtConnectionType)) ;; connection_type
|
||||
(define dos_qobject_connect_lambda_with_context_static
|
||||
(foreign-lambda (c-pointer DosQMetaObjectConnection) "dos_qobject_connect_lambda_with_context_static"
|
||||
(c-pointer DosQObject) ;; sender
|
||||
|
|
|
|||
Loading…
Reference in New Issue