Chicken
/
qml-old
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Even better signals

This commit is contained in:
Daniel Ziltener 2022-02-04 18:47:36 +01:00
parent ba83e7880a
commit 7ef338bda5
5 changed files with 126 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
examples/helloworld.qml
View File

@ -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")
}
}
}
}

20
examples/helloworld.scm
View File

@ -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))

88
qml.core.scm
View File

@ -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>
qvariant
@ -119,6 +119,7 @@
load-data
add-import-path
context
root
add-image-provider
<QQuickView>
@ -161,13 +162,12 @@
parent
)
(begin
;; Enums
(define-class <Enum> ()
((val accessor: val)))
(define-class <QEventLoopProcessEventFlag> (<Enum>))
(define (qevent-loop-process-event-flag val)
(define (qevent-loop-process-event-flag val) @("Event flags")
(case val
((process-all-events:)
(make <QEventLoopProcessEventFlag> 'val DosQEventLoopProcessEventFlagProcessAllEvents))
@ -335,11 +335,6 @@
(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-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>))
@ -350,10 +345,19 @@
(dos_qobject_property (slot-value qo 'ptr) propertyName))
(define-method (set-property (qo <QObject>) (propertyName <string>) (value <QVariant>))
(dos_qobject_setProperty (slot-value qo 'ptr) propertyName (slot-value value 'ptr)))
(define-method (find-child (qo <QObject>) (child-name <string>))
(make <QObject> '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 <QMetaObjectConnection> (<QMLBase>)
((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 <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 <primitive-object>)
(connection-type <QtConnectionType>))
(let* ((callback-key (string-append (->string sender) "->" signal "->" (->string callback))))
;; Connect with lambda, static
(define-method (connect (sender <QObject>) (signal <string>)
(callback <procedure>) (callback-data <primitive-object>)
(connection-type <QtConnectionType>))
(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 <QMetaObjectConnection>
'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 <QObject>) (signal <string>)
(receiver <QObject>) (slot <string>) (connection-type <QtConnectionType>))
;; Connect with lambda and context, static
(define-method (connect (sender <QObject>) (signal <string>)
(context <QObject>) (callback <procedure>)
(callback-data <primitive-object>)
(connection-type <QtConnectionType>))
(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 <QMetaObjectConnection>
'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 <QObject>) (signal <string>)
(receiver <QObject>) (slot <string>) (connection-type <QtConnectionType>))
(make <QMetaObjectConnection> '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 <QObject>) (signal <string>) (receiver <QObject>) (slot <string>))
(define-method (disconnect (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>))
(define-method (disconnect (qmoc <QMetaObjectConnection>))
(dos_qobject_disconnect_with_connection_static (slot-value qmoc 'ptr)))
(define-method (delete-pointer (qmoc <QMetaObjectConnection>))
;; 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 <QObject>))
(dos_qobject_delete (ptr qo)))
(define-method (delete-pointer-later (qo <QObject>))
@ -488,6 +522,8 @@
(dos_qqmlapplicationengine_add_import_path (ptr appengine) import-path))
(define-method (context (appengine <QQmlApplicationEngine>))
(make <QQmlContext> 'ptr (dos_qqmlapplicationengine_context (ptr appengine))))
(define-method (root (appengine <QQmlApplicationEngine>))
(make <QObject> 'ptr (qml_qqmlapplicationengine_root (ptr appengine))))
(define-method (add-image-provider (appengine <QQmlApplicationEngine>) (provider-id <string>) (provider <QQuickImageProvider>))
(dos_qqmlapplicationengine_addImageProvider (ptr appengine) provider-id (ptr provider)))
(define-method (delete-pointer (appengine <QQmlApplicationEngine>))

2
qml.egg
View File

@ -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))))

19
qml.lowlevel.scm
View File

@ -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 <DOtherSide/DOtherSideTypes.h>")
(foreign-declare "#include <DOtherSide/DOtherSide.h>")
;; (foreign-declare "#include <QtWidgets/QApplication>")
(foreign-declare "#include <QtWidgets/QApplication>")
(foreign-declare "#include <QtCore/Qt>")
(foreign-declare "#include <QtCore/QString>")
(foreign-declare "#include <QtCore/QObject>")
(foreign-declare "#include <QtQml/QQmlApplicationEngine>")
(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<QObject*>(name));"))
(define dos_qobject_connect_lambda_static
(foreign-lambda* (c-pointer DosQMetaObjectConnection) (((c-pointer DosQObject) sender)