From f6566b8e3820e9d5666d0c6886c4fea03ada6182 Mon Sep 17 00:00:00 2001 From: Daniel Ziltener Date: Thu, 3 Feb 2022 15:02:59 +0100 Subject: [PATCH] Another attempt to make it work --- examples/helloworld.scm | 17 ++++- qml.core.scm | 134 +++++++++++++++++++++++++++------------- qml.lowlevel.scm | 17 +++-- 3 files changed, 118 insertions(+), 50 deletions(-) diff --git a/examples/helloworld.scm b/examples/helloworld.scm index 9d33328..7b970fd 100644 --- a/examples/helloworld.scm +++ b/examples/helloworld.scm @@ -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) diff --git a/qml.core.scm b/qml.core.scm index bfacf2d..8db70ea 100644 --- a/qml.core.scm +++ b/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 @@ new-Properties + + delete-pointer + + + new-CallbackData + pointer + signal-emit + object-name + set-object-name + property + set-property + connect-lambda-static + connect-static + disconnect-static + disconnect-with-connection-static qvariant @@ -279,12 +297,66 @@ (when (= 0 (refcount callback-registry (ptr qbase))) (delete-pointer qbase))))) + (define-class ()) + + (define-class () + ((ptr accessor: ptr))) + (define-method (initialize-instance (qv )) + (set! (ptr qv) (dos_qvariant_create)) + (call-next-method)) + (define-method (qvariant (val )) + (make 'ptr (dos_qvariant_create_int val))) + (define-method (qvariant (val )) + (make 'ptr (dos_qvariant_create_bool val))) + (define-method (qvariant (val )) + (make 'ptr (dos_qvariant_create_string val))) + (define-method (qvariant (val )) + (make 'ptr (dos_qvariant_create_qobject (ptr val)))) + (define-method (qvariant (val )) + (make 'ptr (dos_qvariant_create_float val))) + (define-method (set (qv ) (val )) + (dos_qvariant_setInt (ptr qv) val)) + (define-method (set (qv ) (val )) + (dos_qvariant_setBool (ptr qv) val)) + (define-method (set (qv ) (val )) + (dos_qvariant_setFloat (ptr qv) val)) + (define-method (set (qv ) (val )) + (dos_qvariant_setString (ptr qv) val)) + (define-method (set (qv ) (val )) + (dos_qvariant_setQObject (ptr qv) (ptr val))) + (define-method (to (qv ) (target )) + (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 )) + (dos_qvariant_isnull (ptr qv))) + (define-method (assign (qv ) (other )) + (dos_qvariant_assign (ptr qv) (ptr other))) + (define-method (copy (qv )) + (make 'ptr (dos_qvariant_create_qvariant (ptr qv)))) + (define-method (delete-pointer (qv )) + (dos_qvariant_delete (ptr qv))) + (define-class () ((ptr accessor: ptr))) (define-method (delete-pointer (qmoc )) (dos_qmetaobject_connection_delete (slot-value qmoc 'ptr))) - (define-class ()) + (define-class () + ((obj accessor: obj))) + (define (new-CallbackData data) + (let ((object (object-evict data))) + (make 'obj object))) + (define-method (pointer (cbdata )) + (object->pointer (obj cbdata))) + (define-method (initialize-instance (cbdata )) + (call-next-method) + (set-finalizer! cbdata (lambda (x) + (object-release (slot-value cbdata 'obj))))) + (define-method (signal-emit (qo ) (name ) (paramcount ) (parameters )) (dos_qobject_signal_emit (ptr qo) name paramcount parameters)) (define-method (object-name (qo )) @@ -296,6 +368,19 @@ (define-method (set-property (qo ) (propertyName ) (value )) (dos_qobject_setProperty (slot-value qo 'ptr) propertyName (slot-value value 'ptr))) + (define-method (connect-lambda-static (sender ) (signal ) + (callback ) (callback-data ) + (connection-type )) + (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 ) (signal ) (receiver ) (slot ) (connection-type )) (make 'ptr @@ -303,6 +388,8 @@ (slot-value receiver 'ptr) slot (qt-connection-type connection-type)))) (define-method (disconnect-static (sender ) (signal ) (receiver ) (slot )) (dos_qobject_disconnect_static (slot-value sender 'ptr) signal (slot-value receiver 'ptr) slot)) + (define-method (disconnect-with-connection-static (qmoc )) + (dos_qobject_disconnect_with_connection_static (slot-value qmoc 'ptr))) (define-method (delete-pointer (qo )) (dos_qobject_delete (ptr qo))) @@ -347,47 +434,6 @@ (define-method (delete-pointer (pd )) (dos_propertydefinitions_delete (ptr pd))) - (define-class () - ((ptr accessor: ptr))) - (define-method (initialize-instance (qv )) - (set! (ptr qv) (dos_qvariant_create)) - (call-next-method)) - (define-method (qvariant (val )) - (make 'ptr (dos_qvariant_create_int val))) - (define-method (qvariant (val )) - (make 'ptr (dos_qvariant_create_bool val))) - (define-method (qvariant (val )) - (make 'ptr (dos_qvariant_create_string val))) - (define-method (qvariant (val )) - (make 'ptr (dos_qvariant_create_qobject (ptr val)))) - (define-method (qvariant (val )) - (make 'ptr (dos_qvariant_create_float val))) - (define-method (set (qv ) (val )) - (dos_qvariant_setInt (ptr qv) val)) - (define-method (set (qv ) (val )) - (dos_qvariant_setBool (ptr qv) val)) - (define-method (set (qv ) (val )) - (dos_qvariant_setFloat (ptr qv) val)) - (define-method (set (qv ) (val )) - (dos_qvariant_setString (ptr qv) val)) - (define-method (set (qv ) (val )) - (dos_qvariant_setQObject (ptr qv) (ptr val))) - (define-method (to (qv ) (target )) - (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 )) - (dos_qvariant_isnull (ptr qv))) - (define-method (assign (qv ) (other )) - (dos_qvariant_assign (ptr qv) (ptr other))) - (define-method (copy (qv )) - (make 'ptr (dos_qvariant_create_qvariant (ptr qv)))) - (define-method (delete-pointer (qv )) - (dos_qvariant_delete (ptr qv))) - (define-class ()) (define-method (base-url (context )) (dos_qqmlcontext_baseUrl (ptr context))) @@ -434,7 +480,7 @@ (define-class ()) (define-method (initialize-instance (qae )) - (set! (slot-value qae 'ptr) (dos_qqmlapplicationengine_create)) + (set! (ptr qae) (dos_qqmlapplicationengine_create)) (call-next-method)) (define-method (load (appengine ) (filePath )) (dos_qqmlapplicationengine_load (ptr appengine) filePath)) diff --git a/qml.lowlevel.scm b/qml.lowlevel.scm index 4a7605c..a65cb50 100644 --- a/qml.lowlevel.scm +++ b/qml.lowlevel.scm @@ -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