Working signals/slots and working example

examples/helloworld.scm

@@ -1,26 +1,24 @@
 (import
-  (chicken foreign)
   (qml core)
-		coops)
+  coops)
 
 (gui-application-create)
 (define engine (make <QQmlApplicationEngine>))
-(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
+(define (windowLoadCallback cbdata argv) void
-  (print (string-append "Got back " argc " arguments.")))
+  (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"
+(define conn (connect-lambda-static engine "objectCreated(QObject*,QUrl)"
-                                    windowCloseCallback
+                                    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)

qml.core.scm

@@ -80,10 +80,6 @@
       <QMetaObjectConnection>
       delete-pointer
 
-      <CallbackData>
-      new-CallbackData
-      pointer
-
 		  <QObject>
 		  signal-emit
       object-name
@@ -301,9 +297,8 @@
 
   (define-class <QVariant> (<QMLBase>)
     ((ptr accessor: ptr)))
-  (define-method (initialize-instance (qv <QVariant>))
+  (define (new-QVariant)
-    (set! (ptr qv) (dos_qvariant_create))
+    (make <QVariant> 'ptr (dos_qvariant_create)))
-    (call-next-method))
   (define-method (qvariant (val <integer>))
     (make <QVariant> 'ptr (dos_qvariant_create_int val)))
   (define-method (qvariant (val <boolean>))
@@ -345,18 +340,6 @@
   (define-method (delete-pointer (qmoc <QMetaObjectConnection>))
     (dos_qmetaobject_connection_delete (slot-value qmoc 'ptr)))
 
-  (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>))
@@ -368,18 +351,31 @@
   (define-method (set-property (qo <QObject>) (propertyName <string>) (value <QVariant>))
     (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 <QVariant> '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 <QObject>) (signal <string>)
-                                        (callback <procedure>) (callback-data <CallbackData>)
+                                        (callback <procedure>) (callback-data <primitive-object>)
                                         (connection-type <QtConnectionType>))
-    (print "Debug: Parameters passed to dos_qobject_connect_lambda_static(DosQObject *sender, const char *signal, DosQObjectConnectLambdaCallback callback, void* callbackData, DosQtConnectionType connectionType):")
+    (let* ((callback-key (string-append (->string sender) "->" signal "->" (->string callback))))
-    (print "DosQObject Pointer: " (ptr sender))
+      (hash-table-set! lambda-static-callbacks callback-key `((proc: . ,callback)
-    (print "Signal: " signal)
+                                                              (data: . callback-data)))
-    (print "Callback procedure: " callback)
+      (dos_qobject_connect_lambda_static (ptr sender) signal
-    (print "Callback data: " (pointer callback-data))
+                                         (location connectLambdaStaticCallbackHelper)
-    (print "Connection type integer: " (val connection-type))
+                                         (object->pointer (object-evict callback-key))
-    (dos_qobject_connect_lambda_static (ptr sender) signal
+                                         (val connection-type))))
-                                       callback (pointer callback-data)
-                                       (val connection-type)))
 
   (define-method (connect-static (sender <QObject>) (signal <string>)
                                  (receiver <QObject>) (slot <string>) (connection-type <QtConnectionType>))

qml.egg

@@ -8,7 +8,8 @@
 			   coops-utils
 			   foreigners
 			   utf8
-			   srfi-69)
+			   srfi-69
+               list-comprehensions)
  (foreign-dependencies Qt5Core
                        Qt5Widgets
                        Qt5Gui

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"
+      (foreign-lambda* (c-pointer DosQMetaObjectConnection) (((c-pointer DosQObject) sender)
-        (c-pointer DosQObject)                         ;; sender
+                                                             (c-string signal)
-        c-string                                       ;; signal
+                                                             ((function void (c-pointer int (c-pointer (c-pointer DosQVariant)))) callback)
-        (function void (c-pointer int pointer-vector)) ;; callback
+                                                             (c-pointer callbackData)
-        c-pointer                                      ;; callbackData
+                                                             (DosQtConnectionType connection_type))
-        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"
+      (foreign-lambda* (c-pointer DosQMetaObjectConnection) (((c-pointer DosQObject) sender)
-        (c-pointer DosQObject)                      ;; sender
+                                                             (c-string signal)
-        c-string                                    ;; signal
+                                                             ((c-pointer DosQObject) context)
-        (c-pointer DosQObject)                      ;; context
+                                                             ((function void (c-pointer int (c-pointer (c-pointer DosQVariant)))) callback)
-        DosQObjectConnectLambdaCallback             ;; callback
+                                                             (c-pointer callbackData)
-        c-pointer                                   ;; callbackData
+                                                             (DosQtConnectionType connection_type))
-        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"
+      (foreign-lambda* (c-pointer DosQMetaObjectConnection) (((c-pointer DosQObject) sender)
-        (c-pointer DosQObject) ;; sender
+                                                             (c-string signal)
-        c-string               ;; signal
+                                                             ((c-pointer DosQObject) receiver)
-        (c-pointer DosQObject) ;; receiver
+                                                             (c-string slot)
-        c-string               ;; slot
+                                                             (DosQtConnectionType connection_type))
-        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"
+      (foreign-lambda* void (((c-pointer DosQObject) sender)
-        (c-pointer DosQObject) ;; sender
+                             (c-string signal)
-        c-string               ;; signal
+                             ((c-pointer DosQObject) receiver)
-        (c-pointer DosQObject) ;; receiver
+                             (c-string slot))
-        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)))