diff --git a/examples/helloworld.scm b/examples/helloworld.scm index 7b970fd..9b58e6c 100644 --- a/examples/helloworld.scm +++ b/examples/helloworld.scm @@ -1,26 +1,24 @@ (import - (chicken foreign) (qml core) - coops) + coops) (gui-application-create) (define engine (make )) -(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 (windowLoadCallback cbdata argv) void + (print cbdata) + (print "Loaded QML file: " (to (cadr argv) string:))) -(define callback-data (new-CallbackData "Test")) +(define callback-data "Test") -(define conn (connect-lambda-static engine "quit" - windowCloseCallback +(define conn (connect-lambda-static engine "objectCreated(QObject*,QUrl)" + windowLoadCallback callback-data (qt-connection-type auto:))) +(define loc (new-QUrl "examples/helloworld.qml")) +(load-url engine loc) + (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 8db70ea..ed9469d 100644 --- a/qml.core.scm +++ b/qml.core.scm @@ -80,10 +80,6 @@ delete-pointer - - new-CallbackData - pointer - signal-emit object-name @@ -301,9 +297,8 @@ (define-class () ((ptr accessor: ptr))) - (define-method (initialize-instance (qv )) - (set! (ptr qv) (dos_qvariant_create)) - (call-next-method)) + (define (new-QVariant) + (make 'ptr (dos_qvariant_create))) (define-method (qvariant (val )) (make 'ptr (dos_qvariant_create_int val))) (define-method (qvariant (val )) @@ -345,18 +340,6 @@ (define-method (delete-pointer (qmoc )) (dos_qmetaobject_connection_delete (slot-value qmoc 'ptr))) - (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 )) @@ -368,18 +351,31 @@ (define-method (set-property (qo ) (propertyName ) (value )) (dos_qobject_setProperty (slot-value qo 'ptr) propertyName (slot-value value 'ptr))) + ;; Signal connectors and helpers + (define lambda-static-callbacks (make-hash-table)) + + (define-external (connectLambdaStaticCallbackHelper (c-pointer cbdata) (int argc) ((c-pointer c-pointer) argv)) void + (let* ((callback-key (object-unevict (pointer->object cbdata))) + (callback-info (hash-table-ref lambda-static-callbacks callback-key)) + (callback-proc (alist-ref proc: callback-info)) + (callback-data (alist-ref data: callback-info)) + (signal-data (map (lambda (item) + (make 'ptr item)) + (c_array_convert argv argc)))) + (hash-table-delete! lambda-static-callbacks callback-key) + (object-release (pointer->object cbdata)) + (callback-proc callback-data signal-data))) + (define-method (connect-lambda-static (sender ) (signal ) - (callback ) (callback-data ) + (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))) + (let* ((callback-key (string-append (->string sender) "->" signal "->" (->string callback)))) + (hash-table-set! lambda-static-callbacks callback-key `((proc: . ,callback) + (data: . callback-data))) + (dos_qobject_connect_lambda_static (ptr sender) signal + (location connectLambdaStaticCallbackHelper) + (object->pointer (object-evict callback-key)) + (val connection-type)))) (define-method (connect-static (sender ) (signal ) (receiver ) (slot ) (connection-type )) diff --git a/qml.egg b/qml.egg index ad56644..8af8054 100644 --- a/qml.egg +++ b/qml.egg @@ -8,7 +8,8 @@ coops-utils foreigners utf8 - srfi-69) + srfi-69 + list-comprehensions) (foreign-dependencies Qt5Core Qt5Widgets Qt5Gui diff --git a/qml.lowlevel.scm b/qml.lowlevel.scm index a65cb50..ec0c600 100644 --- a/qml.lowlevel.scm +++ b/qml.lowlevel.scm @@ -3,8 +3,10 @@ (define-library (qml lowlevel) (import (scheme base)) + (import srfi-1) (import (chicken foreign)) (import foreigners) + (import list-comprehensions) (export DosQEventLoopProcessEventFlagProcessAllEvents DosQEventLoopProcessEventFlagExcludeUserInputEvents DosQEventLoopProcessEventFlagProcessExcludeSocketNotifiers @@ -18,6 +20,8 @@ dos_slot_macro dos_signal_macro + c_array_convert + dos_parameterdefinition_create dos_parameterdefinition_name dos_signaldefinition_create @@ -269,6 +273,19 @@ (foreign-lambda c-string "dos_signal_macro" c-string)) + ;; Helpers + (define c_array_get + (foreign-lambda* (c-pointer DosQVariant) (((c-pointer (c-pointer DosQVariant)) array) + (int index)) + "C_return(array[index]);")) + + (define (c_array_convert c-array num-items) + (reverse + (fold + (lambda (index array) + (cons (c_array_get c-array index) array)) + '() (range 0 num-items)))) + ;; Functions ;; ParameterDefinition (define dos_parameterdefinition_create @@ -398,7 +415,7 @@ (c-pointer DosQQmlApplicationEngine) c-string)) (define dos_qqmlapplicationengine_load_url - (foreign-lambda void "dos_qqmlapplicationengine_load_url" + (foreign-safe-lambda void "dos_qqmlapplicationengine_load_url" (c-pointer DosQQmlApplicationEngine) (c-pointer DosQUrl))) (define dos_qqmlapplicationengine_load_data @@ -864,43 +881,34 @@ (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 - (function void (c-pointer int pointer-vector)) ;; callback - c-pointer ;; callbackData - DosQtConnectionType)) ;; connection_type + (foreign-lambda* (c-pointer DosQMetaObjectConnection) (((c-pointer DosQObject) sender) + (c-string signal) + ((function void (c-pointer int (c-pointer (c-pointer DosQVariant)))) callback) + (c-pointer callbackData) + (DosQtConnectionType connection_type)) + "C_return(dos_qobject_connect_lambda_static(sender, dos_signal_macro(signal), callback, callbackData, 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 - c-string ;; signal - (c-pointer DosQObject) ;; context - DosQObjectConnectLambdaCallback ;; callback - c-pointer ;; callbackData - DosQtConnectionType ;; connection_type - )) + (foreign-lambda* (c-pointer DosQMetaObjectConnection) (((c-pointer DosQObject) sender) + (c-string signal) + ((c-pointer DosQObject) context) + ((function void (c-pointer int (c-pointer (c-pointer DosQVariant)))) callback) + (c-pointer callbackData) + (DosQtConnectionType connection_type)) + "C_return(dos_qobject_connect_lambda_with_context_static(sender, dos_signal_macro(signal), context, callback, callbackData, connection_type));")) (define dos_qobject_connect_static - (foreign-lambda (c-pointer DosQMetaObjectConnection) "dos_qobject_connect_static" - (c-pointer DosQObject) ;; sender - c-string ;; signal - (c-pointer DosQObject) ;; receiver - c-string ;; slot - DosQtConnectionType ;; connection_type - )) + (foreign-lambda* (c-pointer DosQMetaObjectConnection) (((c-pointer DosQObject) sender) + (c-string signal) + ((c-pointer DosQObject) receiver) + (c-string slot) + (DosQtConnectionType connection_type)) + "C_return(dos_qobject_connect_static(sender, dos_signal_macro(signal), receiver, dos_slot_macro(slot), connection_type));")) (define dos_qobject_disconnect_static - (foreign-lambda void "dos_qobject_disconnect_static" - (c-pointer DosQObject) ;; sender - c-string ;; signal - (c-pointer DosQObject) ;; receiver - c-string)) ;; slot + (foreign-lambda* void (((c-pointer DosQObject) sender) + (c-string signal) + ((c-pointer DosQObject) receiver) + (c-string slot)) + "dos_qobject_disconnect_static(sender, dos_signal_macro(signal), receiver, dos_slot_macro(slot));")) (define dos_qobject_disconnect_with_connection_static (foreign-lambda void "dos_qobject_disconnect_with_connection_static" (c-pointer DosQMetaObjectConnection)))