From 7e63c82d9a957d0c9cad68142191b5ec91114acc Mon Sep 17 00:00:00 2001 From: Daniel Ziltener Date: Tue, 1 Feb 2022 17:22:34 +0100 Subject: [PATCH] Update to DOtherSide 0.8.2 --- dotherside | 2 +- qml.core.scm | 72 +++++++++++++++++++--- qml.egg | 27 +++++---- qml.lowlevel.scm | 154 +++++++++++++++++++++++++++++++++++++++++------ 4 files changed, 218 insertions(+), 37 deletions(-) diff --git a/dotherside b/dotherside index f03ede8..7b7c0a9 160000 --- a/dotherside +++ b/dotherside @@ -1 +1 @@ -Subproject commit f03ede889d68f87f37693394bfdc98dd486dda4f +Subproject commit 7b7c0a91b558b13a968c57b9647bfc15ed962ead diff --git a/qml.core.scm b/qml.core.scm index c6ebcdd..9fe9f45 100644 --- a/qml.core.scm +++ b/qml.core.scm @@ -7,7 +7,7 @@ (import (chicken condition)) (import (qml lowlevel)) (import (scheme base)) - (import coops coops-primitive-objects coops-extras srfi-1 srfi-69) + (import coops coops-primitive-objects coops-extras coops-utils srfi-1 srfi-69) (export application-dir-path process-events process-events-timed @@ -54,6 +54,26 @@ add-ptrentry remove-ptrentry + + + + new-Parameter + + + new-Signal + + new-Signals + + + new-Slot + + new-Slots + + + new-Property + + new-Properties + signal-emit @@ -238,9 +258,9 @@ (define-method (add-ptrentry (qbase )) (hash-table-update! callback-registry (ptr qbase) (lambda (alist) - (let* ((refc (refcount alist)) - (alist (alist-delete refcount: alist))) - (alist-cons refcount: (+ 1 refc) alist))) + (let* ((refc (refcount alist)) + (alist (alist-delete refcount: alist))) + (alist-cons refcount: (+ 1 refc) alist))) (lambda () (alist-cons refcount: 1 '())))) (define-method (remove-ptrentry (qbase )) @@ -248,9 +268,9 @@ (hash-table-delete! callback-registry (ptr qbase)) (hash-table-update! callback-registry (ptr qbase) (lambda (alist) - (let* ((refc (refcount alist)) - (alist (alist-delete refcount: alist))) - (alist-cons refcount: (- refc 1) alist))) ))) + (let* ((refc (refcount alist)) + (alist (alist-delete refcount: alist))) + (alist-cons refcount: (- refc 1) alist))) ))) (define-method (initialize-instance (qbase )) (call-next-method) (add-ptrentry qbase) @@ -267,6 +287,44 @@ (define-method (delete-pointer-later (qo )) (dos_qobject_deleteLater (ptr qo))) + ;; Scheme Objects + (define-class () + ((obj accessor: obj))) + + (define-class ()) + (define-method (new-Parameter (para ) (name ) (meta-type )) + (make 'obj (dos_parameterdefinition_create name meta-type))) + + ;; - Signals + (define-class ()) + (define-method (new-Signal (sd ) (name ) (parameters >)) + (dos_signaldefinition_create name (length parameters) (map obj parameters))) + (define-class ()) + (define-method (new-Signals (sd ) (defs )) + (make 'ptr (dos_signaldefinitions_create (length defs) (map ptr defs)))) + (define-method (delete-pointer (sd )) + (dos_signaldefinitions_delete (ptr sd))) + + ;; - Slots + (define-class ()) + (define-method (new-Slot (sd ) (name ) (returnMetaType ) (parameters )) + (make 'obj (dos_slotdefinition_create name returnMetaType (length parameters) (map obj parameters)))) + (define-class ()) + (define-method (new-Slots (sd ) (defs )) + (make 'ptr (dos_slotdefinitions_create (length defs) (map obj defs)))) + (define-method (delete-pointer (sd )) + (dos_slotdefinitions_delete (ptr sd))) + + ;; - Properties + (define-class ()) + (define-method (new-Property (pd ) (name ) (propertyMetaType ) (readSlot ) (writeSlot ) (notifySignal )) + (make 'obj (dos_propertydefinition_create name propertyMetaType readSlot writeSlot notifySignal))) + (define-class ()) + (define-method (new-Properties (pd ) (defs )) + (make 'ptr (dos_propertydefinitions_create (length defs) (map obj defs)))) + (define-method (delete-pointer (pd )) + (dos_propertydefinitions_delete (ptr pd))) + (define-class () ((ptr accessor: ptr))) (define-method (initialize-instance (qv )) diff --git a/qml.egg b/qml.egg index faa17e6..ad56644 100644 --- a/qml.egg +++ b/qml.egg @@ -3,7 +3,8 @@ (synopsis "A Chicken wrapper for DOtherSide") (category ui) (license "LGPLv3") - (dependencies coops + (dependencies r7rs + coops coops-utils foreigners utf8 @@ -18,29 +19,31 @@ (components (c-object dotherside/lib/src/DosQAbstractItemModel (source "dotherside/lib/src/DosQAbstractItemModel.cpp") - (csc-options "-c++" "-Idotherside/lib/include" "-I/usr/include/qt5" "-C" "-fPIC")) + (csc-options "-c++" "-Idotherside/lib/include" "-Idotherside/lib/include/Qt" "-I/usr/include/qt5" "-C" "-fPIC")) (c-object dotherside/lib/src/DosQDeclarative (source "dotherside/lib/src/DosQDeclarative.cpp") - (csc-options "-c++" "-Idotherside/lib/include" "-I/usr/include/qt5" "-C" "-fPIC")) + (csc-options "-c++" "-Idotherside/lib/include" "-Idotherside/lib/include/Qt" "-I/usr/include/qt5" "-C" "-fPIC")) (c-object dotherside/lib/src/DosQMetaObject (source "dotherside/lib/src/DosQMetaObject.cpp") - (csc-options "-c++" "-Idotherside/lib/include" "-Idotherside/lib/include/Qt" - "-I/usr/include/qt5" "-C" "-fPIC")) + (csc-options "-c++" "-Idotherside/lib/include" "-Idotherside/lib/include/Qt" "-I/usr/include/qt5" "-C" "-fPIC")) (c-object dotherside/lib/src/DosQObject (source "dotherside/lib/src/DosQObject.cpp") - (csc-options "-c++" "-Idotherside/lib/include" "-I/usr/include/qt5" "-C" "-fPIC")) + (csc-options "-c++" "-Idotherside/lib/include" "-Idotherside/lib/include/Qt" "-I/usr/include/qt5" "-C" "-fPIC")) (c-object dotherside/lib/src/DosQObjectImpl (source "dotherside/lib/src/DosQObjectImpl.cpp") - (csc-options "-c++" "-Idotherside/lib/include" "-I/usr/include/qt5" "-C" "-fPIC")) + (csc-options "-c++" "-Idotherside/lib/include" "-Idotherside/lib/include/Qt" "-I/usr/include/qt5" "-C" "-fPIC")) (c-object dotherside/lib/src/DosQQuickImageProvider (source "dotherside/lib/src/DosQQuickImageProvider.cpp") - (csc-options "-c++" "-Idotherside/lib/include" "-I/usr/include/qt5" "-C" "-fPIC")) + (csc-options "-c++" "-Idotherside/lib/include" "-Idotherside/lib/include/Qt" "-I/usr/include/qt5" "-C" "-fPIC")) (c-object dotherside/lib/src/DOtherSide (source "dotherside/lib/src/DOtherSide.cpp") - (csc-options "-c++" "-Idotherside/lib/include" "-I/usr/include/qt5" "-C" "-fPIC")) + (csc-options "-c++" "-Idotherside/lib/include" "-Idotherside/lib/include/Qt" "-I/usr/include/qt5" "-C" "-fPIC")) (c-object dotherside/lib/src/DOtherSideTypesCpp (source "dotherside/lib/src/DOtherSideTypesCpp.cpp") - (csc-options "-c++" "-Idotherside/lib/include" "-I/usr/include/qt5" "-C" "-fPIC")) + (csc-options "-c++" "-Idotherside/lib/include" "-Idotherside/lib/include/Qt" "-I/usr/include/qt5" "-C" "-fPIC")) + (c-object dotherside/lib/src/DosLambdaInvoker + (source "dotherside/lib/src/DosLambdaInvoker.cpp") + (csc-options "-c++" "-Idotherside/lib/include" "-Idotherside/lib/include/Qt" "-I/usr/include/qt5" "-C" "-fPIC")) (extension qml.lowlevel (objects dotherside/lib/src/DosQAbstractItemModel dotherside/lib/src/DosQDeclarative @@ -49,9 +52,11 @@ dotherside/lib/src/DosQObjectImpl dotherside/lib/src/DosQQuickImageProvider dotherside/lib/src/DOtherSide - dotherside/lib/src/DOtherSideTypesCpp) + dotherside/lib/src/DOtherSideTypesCpp + dotherside/lib/src/DosLambdaInvoker) (csc-options "-X" "r7rs" "-R" "r7rs" "-sJ" "-c++" "-Idotherside/lib/include" + "-I/usr/include/qt5" "-L" "-lQt5Core" "-L" "-lQt5Widgets" "-L" "-lQt5Gui" diff --git a/qml.lowlevel.scm b/qml.lowlevel.scm index da4f293..88c9501 100644 --- a/qml.lowlevel.scm +++ b/qml.lowlevel.scm @@ -15,6 +15,17 @@ DosQtConnectionTypeBlockingConnection DosQtConnectionTypeUniqueConnection + dos_parameterdefinition_create + dos_parameterdefinition_name + dos_signaldefinition_create + dos_signaldefinitions_create + dos_signaldefinitions_delete + dos_slotdefinition_create + dos_slotdefinitions_create + dos_slotdefinitions_delete + dos_propertydefinition_create + dos_propertydefinitions_create + dos_propertydefinitions_delete dos_qcoreapplication_application_dir_path dos_qcoreapplication_process_events dos_qcoreapplication_process_events_timed @@ -116,6 +127,7 @@ (begin (foreign-declare "#include ") (foreign-declare "#include ") + ;; (foreign-declare "#include ") (define-foreign-type DosQVariant "DosQVariant") (define-foreign-type DosQModelIndex "DosQModelIndex") (define-foreign-type DosQAbstractListModel "DosQAbstractListModel") @@ -127,7 +139,13 @@ (define-foreign-type DosQHashIntQByteArray "DosQHashIntQByteArray") (define-foreign-type DosQUrl "DosQUrl") (define-foreign-type DosQMetaObject "DosQMetaObject") + (define-foreign-type DosQMetaObjectConnection "DosQMetaObjectConnection") + (define-foreign-type DosQMetaObjectInvokeMethodCallback (function void (c-pointer))) (define-foreign-type DosQObject "DosQObject") + (define-foreign-type DosQObjectConnectLambdaCallback (function void + (c-pointer + int + (c-pointer (c-pointer DosQVariant))))) (define-foreign-type DosQQuickImageProvider "DosQQuickImageProvider") (define-foreign-type DosPixmap "DosPixmap") (define-foreign-type DosQPointer "DosQPointer") @@ -234,11 +252,19 @@ ;; Functions ;; ParameterDefinition (define dos_parameterdefinition_create - (foreign-lambda* scheme-object ((c-string name) - (int metaType)) - "struct ParameterDefinition pd = {.name = name, .metaType = metaType};" - "C_word* ptr = C_alloc(1);" - "C_return(C_structure(&ptr,C_SIZEOF_STRUCTURE(3),pd));")) + (foreign-primitive scheme-object ((c-string name) + (int metaType)) + "char* pdname = (char*) calloc(1, strlen(name)+1);" + "strcpy(pdname,name);" + "struct ParameterDefinition pd = {.name = pdname, .metaType = metaType};" + "char pdc[sizeof(pd)];" + "memcpy(pdc, &pd, sizeof(pdc));" + "C_word* ptr = C_alloc(C_SIZEOF_STRING(sizeof(pdc)));" + "C_return(C_bytevector(&ptr,sizeof(pdc),pdc));")) + + (define dos_parameterdefinition_name + (foreign-lambda* c-string ((blob sobj)) + "C_return(((struct ParameterDefinition*)sobj)->name);")) ;; SignalDefinition (define dos_signaldefinition_create @@ -246,7 +272,7 @@ (int parametersCount) (pointer-vector parameters)) "struct SignalDefinition sd = {.name = name, .parametersCount = parametersCount, " - ".parameters = (ParameterDefinition*) parameters};" + ".parameters = (struct ParameterDefinition*) parameters};" "C_word* ptr = C_alloc(1);" "C_return(C_structure(&ptr,C_SIZEOF_STRUCTURE(4),sd));")) @@ -262,15 +288,67 @@ (foreign-lambda* void (((c-pointer SignalDefinitions) definitions)) "free(definitions);")) + ;; SlotDefinition + (define dos_slotdefinition_create + (foreign-lambda* scheme-object ((c-string name) + (int returnMetaType) + (int parametersCount) + (pointer-vector parameters)) + "struct SlotDefinition sd = {.name = name, .returnMetaType = returnMetaType, " + ".parametersCount = parametersCount, .parameters = (struct ParameterDefinition*) parameters};" + "C_word* ptr = C_alloc(1);" + "C_return(C_structure(&ptr,C_SIZEOF_STRUCTURE(5),sd));")) + + ;; SlotDefinitions + (define dos_slotdefinitions_create + (foreign-lambda* (c-pointer SlotDefinitions) ((int count) + (pointer-vector definitions)) + "struct SlotDefinitions sd = {.count = count, .definitions = (SlotDefinition*) definitions};" + "struct SlotDefinitions* sdptr = (struct SlotDefinitions*) malloc(sizeof(struct SlotDefinitions));" + "*sdptr = sd;" + "C_return(sdptr);")) + (define dos_slotdefinitions_delete + (foreign-lambda* void (((c-pointer SlotDefinitions) definitions)) + "free(definitions);")) + + ;; PropertyDefinition + (define dos_propertydefinition_create + (foreign-lambda* scheme-object ((c-string name) + (int propertyMetaType) + (c-string readSlot) + (c-string writeSlot) + (c-string notifySignal)) + "struct PropertyDefinition pd = {.name = name, .propertyMetaType = propertyMetaType, " + ".readSlot = readSlot, .writeSlot = writeSlot, .notifySignal = notifySignal};" + "C_word* ptr = C_alloc(1);" + "C_return(C_structure(&ptr,C_SIZEOF_STRUCTURE(6),pd));")) + + ;; PropertyDefinitions + (define dos_propertydefinitions_create + (foreign-lambda* (c-pointer PropertyDefinitions) ((int count) + (pointer-vector definitions)) + "struct PropertyDefinitions pd = {.count = count, .definitions = (PropertyDefinition*) definitions};" + "struct PropertyDefinitions* pdptr = (struct PropertyDefinitions*) malloc(sizeof(struct PropertyDefinitions));" + "*pdptr = pd;" + "C_return(pdptr);")) + (define dos_propertydefinitions_delete + (foreign-lambda* void (((c-pointer PropertyDefinitions) definitions)) + "free(definitions);")) + ;; QCoreApplication (define dos_qcoreapplication_application_dir_path (foreign-lambda c-string "dos_qcoreapplication_application_dir_path")) (define dos_qcoreapplication_process_events - (foreign-lambda void "dos_qcoreapplication_process_events" - DosQEventLoopProcessEventFlag)) + (foreign-safe-lambda* void ((DosQEventLoopProcessEventFlag flags)) + "dos_qcoreapplication_process_events(flags);" + ;;"qApp->sendPostedEvents();" + )) (define dos_qcoreapplication_process_events_timed - (foreign-lambda void "dos_qcoreapplication_process_events_timed" - DosQEventLoopProcessEventFlag int)) + (foreign-safe-lambda* void ((DosQEventLoopProcessEventFlag flags) + (int ms)) + "dos_qcoreapplication_process_events_timed(flags, ms);" + ;;"qApp->sendPostedEvents();" + )) ;; QGuiApplication (define dos_qguiapplication_create @@ -440,6 +518,12 @@ (define dos_qvariant_create_int (foreign-lambda* (c-pointer DosQVariant) ((int value)) "C_return(dos_qvariant_create_int(value));")) + (define dos_qvariant_create_longlong + (foreign-lambda* (c-pointer DosQVariant) ((long value)) + "C_return(dos_qvariant_create_longlong(value));")) + (define dos_qvariant_create_ulonglong + (foreign-lambda* (c-pointer DosQVariant) ((unsigned-long value)) + "C_return(dos_qvariant_create_ulonglong(value));")) (define dos_qvariant_create_bool (foreign-lambda* (c-pointer DosQVariant) ((bool value)) "C_return(dos_qvariant_create_bool(value));")) @@ -467,6 +551,14 @@ (foreign-lambda* void (((c-pointer DosQVariant) vptr) (int value)) "dos_qvariant_setInt(vptr, value);")) + (define dos_qvariant_setLongLong + (foreign-lambda* void (((c-pointer DosQVariant) vptr) + (long value)) + "dos_qvariant_setLongLong(vptr, value);")) + (define dos_qvariant_setULongLong + (foreign-lambda* void (((c-pointer DosQVariant) vptr) + (unsigned-long value)) + "dos_qvariant_setULongLong(vptr, value);")) (define dos_qvariant_setBool (foreign-lambda* void (((c-pointer DosQVariant) vptr) (bool value)) @@ -505,6 +597,12 @@ (define dos_qvariant_toInt (foreign-lambda* int (((c-pointer DosQVariant) vptr)) "C_return(dos_qvariant_toInt(vptr));")) + (define dos_qvariant_toLongLong + (foreign-lambda* long (((c-pointer DosQVariant) vptr)) + "C_return(dos_qvariant_toLongLong(vptr));")) + (define dos_qvariant_toULongLong + (foreign-lambda* unsigned-long (((c-pointer DosQVariant) vptr)) + "C_return(dos_qvariant_toULongLong(vptr));")) (define dos_qvariant_toBool (foreign-lambda* bool (((c-pointer DosQVariant) vptr)) "C_return(dos_qvariant_toBool(vptr));")) @@ -536,8 +634,8 @@ (foreign-lambda* void (((c-pointer DosQMetaObject) vptr)) "dos_qmetaobject_delete(vptr);")) (define dos_qmetaobject_invoke_method - (foreign-lambda* bool (((c-pointer DosQMetaObject) context) - ((function void ((c-pointer DosQObject) c-pointer)) callback) + (foreign-lambda* bool (((c-pointer DosQObject) context) + (DosQMetaObjectInvokeMethodCallback callback) (c-pointer data) (DosQtConnectionType connection_type)) "C_return(dos_qmetaobject_invoke_method(context, callback, data, connection_type));")) @@ -547,8 +645,8 @@ (foreign-lambda* (c-pointer DosQMetaObject) () "C_return(dos_qabstractlistmodel_qmetaobject());")) (define dos_qabstractlistmodel_create - (foreign-safe-lambda* - (c-pointer DosQAbstractListModel) (((c-pointer (function void ())) callbackObject) + (foreign-lambda* + (c-pointer DosQAbstractListModel) (((c-pointer void) callbackObject) ((c-pointer DosQMetaObject) metaObject) (DObjectCallback dObjectCallback) ((c-pointer DosQAbstractItemModelCallbacks) callbacks)) @@ -574,7 +672,7 @@ "C_return(dos_qabstracttablemodel_qmetaobject());")) (define dos_qabstracttablemodel_create (foreign-safe-lambda* - (c-pointer DosQAbstractTableModel) (((c-pointer (function void ())) callbackObject) + (c-pointer DosQAbstractTableModel) (((c-pointer void) callbackObject) ((c-pointer DosQMetaObject) metaObject) (DObjectCallback dObjectCallback) ((c-pointer DosQAbstractItemModelCallbacks) callbacks)) @@ -596,7 +694,7 @@ "C_return(dos_qabstractitemmodel_qmetaobject());")) (define dos_qabstractitemmodel_create (foreign-safe-lambda* - (c-pointer DosQAbstractItemModel) (((c-pointer (function void ())) callbackObject) + (c-pointer DosQAbstractItemModel) (((c-pointer void) callbackObject) ((c-pointer DosQMetaObject) metaObject) (DObjectCallback dObjectCallback) ((c-pointer DosQAbstractItemModelCallbacks) callbacks)) @@ -749,19 +847,39 @@ (foreign-lambda c-string "dos_signal_macro" c-string)) + (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 + (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 + )) (define dos_qobject_connect_static - (foreign-lambda void "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 + DosQtConnectionType ;; 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 + (define dos_qobject_disconnect_with_connection_static + (foreign-lambda void "dos_qobject_disconnect_with_connection_static" + (c-pointer DosQMetaObjectConnection))) ;; QModelIndex (define dos_qmodelindex_create