From 7ef338bda5547e08418fc7de82f47b1e144f6ee4 Mon Sep 17 00:00:00 2001 From: Daniel Ziltener Date: Fri, 4 Feb 2022 18:47:36 +0100 Subject: [PATCH] Even better signals --- examples/helloworld.qml | 46 ++++++++++++++------- examples/helloworld.scm | 20 +++++++--- qml.core.scm | 88 +++++++++++++++++++++++++++++------------ qml.egg | 2 +- qml.lowlevel.scm | 19 +++++++-- 5 files changed, 126 insertions(+), 49 deletions(-) diff --git a/examples/helloworld.qml b/examples/helloworld.qml index b162072..7c05791 100644 --- a/examples/helloworld.qml +++ b/examples/helloworld.qml @@ -1,21 +1,39 @@ import QtQuick 2.5 import QtQuick.Window 2.2 +import QtQuick.Layouts 1.15 +import QtQuick.Controls 2.15 Window { + id: window visible: true - width: 320 - height: 480 - Rectangle { - id: page - width: 320; height: 480 - color: "lightgray" - - Text { - id: helloText - text: "Hello world!" - y: 30 - anchors.horizontalCenter: page.horizontalCenter - font.pointSize: 24; font.bold: true - } + width: 800 + height: 600 + RowLayout { + id: rowlayout + anchors.fill: parent + spacing: 30 + Rectangle { + id: toprectangle + Layout.fillWidth: true + Layout.preferredHeight: 240 + color: "lightgray" + Text { + id: helloText + text: "Hello World!" + y: 30 + anchors.horizontalCenter: parent.horizontalCenter + font.pointSize: 24; font.bold: true + } + } + ColumnLayout { + spacing: 15 + Layout.fillWidth: true + Layout.fillHeight: true + TextField { + id: nameInputField + objectName: "nameInputField" + placeholderText: qsTr("Enter your name") + } + } } } diff --git a/examples/helloworld.scm b/examples/helloworld.scm index 9b58e6c..3e3077d 100644 --- a/examples/helloworld.scm +++ b/examples/helloworld.scm @@ -9,16 +9,26 @@ (print cbdata) (print "Loaded QML file: " (to (cadr argv) string:))) -(define callback-data "Test") +(define (textChangeCallback cbdata argv) void + (print cbdata)) -(define conn (connect-lambda-static engine "objectCreated(QObject*,QUrl)" - windowLoadCallback - callback-data - (qt-connection-type auto:))) +(define callback-data "Test") +(define textchange-cbdata "Text Edited") + +(define conn (connect engine "objectCreated(QObject*,QUrl)" + windowLoadCallback + callback-data + (qt-connection-type auto:))) (define loc (new-QUrl "examples/helloworld.qml")) (load-url engine loc) +(define nameInputField (find-child (root engine) "nameInputField")) +(define conn2 (connect nameInputField "textEdited()" + textChangeCallback + textchange-cbdata + (qt-connection-type auto:))) + (do ((loop #t)) ((not loop) #t) (process-events-timed (qevent-loop-process-event-flag process-all-events:) 50)) diff --git a/qml.core.scm b/qml.core.scm index ed9469d..bb683ae 100644 --- a/qml.core.scm +++ b/qml.core.scm @@ -11,6 +11,7 @@ (import (qml lowlevel)) (import (scheme base)) (import coops coops-primitive-objects coops-extras coops-utils srfi-1 srfi-69 object-evict) + @("This should appear as library doc.") (export application-dir-path process-events process-events-timed @@ -86,10 +87,9 @@ set-object-name property set-property - connect-lambda-static - connect-static - disconnect-static - disconnect-with-connection-static + find-child + connect + disconnect qvariant @@ -119,6 +119,7 @@ load-data add-import-path context + root add-image-provider @@ -161,13 +162,12 @@ parent ) (begin - ;; Enums (define-class () ((val accessor: val))) (define-class ()) - (define (qevent-loop-process-event-flag val) + (define (qevent-loop-process-event-flag val) @("Event flags") (case val ((process-all-events:) (make 'val DosQEventLoopProcessEventFlagProcessAllEvents)) @@ -335,11 +335,6 @@ (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-method (signal-emit (qo ) (name ) (paramcount ) (parameters )) (dos_qobject_signal_emit (ptr qo) name paramcount parameters)) (define-method (object-name (qo )) @@ -350,10 +345,19 @@ (dos_qobject_property (slot-value qo 'ptr) propertyName)) (define-method (set-property (qo ) (propertyName ) (value )) (dos_qobject_setProperty (slot-value qo 'ptr) propertyName (slot-value value 'ptr))) + (define-method (find-child (qo ) (child-name )) + (make 'ptr (qml_qobject_findChild (ptr qo) child-name))) ;; Signal connectors and helpers + ;; We keep a hash table with the actual callback data passed. That way we don't have to deal with (un-)evicting it. + ;; As actual callback data we pass the generated key. One single callback helper handles all the callbacks and + ;; looks up where to pass on the sent data using that hash table. (define lambda-static-callbacks (make-hash-table)) + (define-class () + ((ptr accessor: ptr) + (callback-key accessor: callback-key))) + (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)) @@ -362,31 +366,61 @@ (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 ) - (connection-type )) - (let* ((callback-key (string-append (->string sender) "->" signal "->" (->string callback)))) + ;; Connect with lambda, static + (define-method (connect (sender ) (signal ) + (callback ) (callback-data ) + (connection-type )) + (let* ((callback-key (string-append (->string sender) "->" signal "->" (->string callback))) + (intern-callback-data (object->pointer (object-evict callback-key)))) (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)))) + (data: . ,callback-data) + (intern-data-pointer: . ,intern-callback-data))) + (make + 'callback-key callback-key + 'ptr + (dos_qobject_connect_lambda_static (ptr sender) signal + (location connectLambdaStaticCallbackHelper) + intern-callback-data + (val connection-type))))) - (define-method (connect-static (sender ) (signal ) - (receiver ) (slot ) (connection-type )) + ;; Connect with lambda and context, static + (define-method (connect (sender ) (signal ) + (context ) (callback ) + (callback-data ) + (connection-type )) + (let* ((callback-key (string-append (->string sender) "->" signal "->" (->string callback))) + (intern-callback-data (object->pointer (object-evict callback-key)))) + (hash-table-set! lambda-static-callbacks callback-key `((proc: . ,callback) + (data: . ,callback-data) + (intern-data-pointer: . ,intern-callback-data))) + (make + 'callback-key callback-key + 'ptr + (dos_qobject_connect_lambda_with_context_static + (ptr sender) signal (ptr context) (location connectLambdaStaticCallbackHelper) + intern-callback-data + (val connection-type))))) + + ;; Connect static + (define-method (connect (sender ) (signal ) + (receiver ) (slot ) (connection-type )) (make 'ptr (dos_qobject_connect_static (slot-value sender 'ptr) signal (slot-value receiver 'ptr) slot (qt-connection-type connection-type)))) - (define-method (disconnect-static (sender ) (signal ) (receiver ) (slot )) + + (define-method (disconnect (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 )) + (define-method (disconnect (qmoc )) (dos_qobject_disconnect_with_connection_static (slot-value qmoc 'ptr))) + (define-method (delete-pointer (qmoc )) + ;; TODO: try-catch disconnect + (object-release (pointer->object (alist-ref intern-data-pointer: (hash-table-ref lambda-static-callbacks (callback-key qmoc))))) + (hash-table-delete! lambda-static-callbacks (callback-key qmoc)) + (dos_qmetaobject_connection_delete (slot-value qmoc 'ptr))) + (define-method (delete-pointer (qo )) (dos_qobject_delete (ptr qo))) (define-method (delete-pointer-later (qo )) @@ -488,6 +522,8 @@ (dos_qqmlapplicationengine_add_import_path (ptr appengine) import-path)) (define-method (context (appengine )) (make 'ptr (dos_qqmlapplicationengine_context (ptr appengine)))) + (define-method (root (appengine )) + (make 'ptr (qml_qqmlapplicationengine_root (ptr appengine)))) (define-method (add-image-provider (appengine ) (provider-id ) (provider )) (dos_qqmlapplicationengine_addImageProvider (ptr appengine) provider-id (ptr provider))) (define-method (delete-pointer (appengine )) diff --git a/qml.egg b/qml.egg index 8af8054..e196fc5 100644 --- a/qml.egg +++ b/qml.egg @@ -70,5 +70,5 @@ "-L" "-lQt5QuickTest" "-L" "-lOpenGL")) (extension qml.core - (csc-options "-X" "r7rs" "-R" "r7rs" "-sJ") + (csc-options "-X" "r7rs" "-R" "r7rs" "-X" "chalk" "-sJ") (component-dependencies qml.lowlevel)))) diff --git a/qml.lowlevel.scm b/qml.lowlevel.scm index ec0c600..869ddbe 100644 --- a/qml.lowlevel.scm +++ b/qml.lowlevel.scm @@ -53,6 +53,7 @@ dos_qobject_deleteLater dos_qobject_property dos_qobject_setProperty + qml_qobject_findChild dos_qobject_connect_lambda_static dos_qobject_connect_lambda_with_context_static dos_qobject_connect_static @@ -101,6 +102,7 @@ dos_qqmlapplicationengine_load_data dos_qqmlapplicationengine_add_import_path dos_qqmlapplicationengine_context + qml_qqmlapplicationengine_root dos_qqmlapplicationengine_addImageProvider dos_qqmlapplicationengine_delete dos_qquickview_create @@ -144,7 +146,11 @@ (begin (foreign-declare "#include ") (foreign-declare "#include ") - ;; (foreign-declare "#include ") + (foreign-declare "#include ") + (foreign-declare "#include ") + (foreign-declare "#include ") + (foreign-declare "#include ") + (foreign-declare "#include ") (define-foreign-type DosQVariant "DosQVariant") (define-foreign-type DosQModelIndex "DosQModelIndex") (define-foreign-type DosQAbstractListModel "DosQAbstractListModel") @@ -378,13 +384,13 @@ (define dos_qcoreapplication_process_events (foreign-safe-lambda* void ((DosQEventLoopProcessEventFlag flags)) "dos_qcoreapplication_process_events(flags);" - ;;"qApp->sendPostedEvents();" + "qApp->sendPostedEvents();" )) (define dos_qcoreapplication_process_events_timed (foreign-safe-lambda* void ((DosQEventLoopProcessEventFlag flags) (int ms)) "dos_qcoreapplication_process_events_timed(flags, ms);" - ;;"qApp->sendPostedEvents();" + "qApp->sendPostedEvents();" )) ;; QGuiApplication @@ -429,6 +435,9 @@ (define dos_qqmlapplicationengine_context (foreign-lambda (c-pointer DosQQmlContext) "dos_qqmlapplicationengine_context" (c-pointer DosQQmlApplicationEngine))) + (define qml_qqmlapplicationengine_root + (foreign-lambda* (c-pointer DosQObject) (((c-pointer DosQQmlApplicationEngine) engine)) + "C_return((QObject*)((QQmlApplicationEngine*)engine)->rootObjects().first());")) (define dos_qqmlapplicationengine_addImageProvider (foreign-lambda void "dos_qqmlapplicationengine_addImageProvider" (c-pointer DosQQmlApplicationEngine) @@ -880,6 +889,10 @@ (define dos_qobject_setProperty (foreign-lambda bool "dos_qobject_setProperty" (c-pointer DosQObject) c-string (c-pointer DosQVariant))) + (define qml_qobject_findChild + (foreign-lambda* (c-pointer DosQObject) (((c-pointer DosQObject) qobj) + (c-string name)) + "C_return((DosQObject*)((QObject*)qobj)->findChild(name));")) (define dos_qobject_connect_lambda_static (foreign-lambda* (c-pointer DosQMetaObjectConnection) (((c-pointer DosQObject) sender)