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

Another attempt to make it work

This commit is contained in:
Daniel Ziltener 2022-02-03 15:02:59 +01:00
parent 47aaa4bbe3
commit f6566b8e38
3 changed files with 118 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
examples/helloworld.scm
View File

@ -1,4 +1,6 @@
(import (qml core) (import
(chicken foreign)
(qml core)
coops) coops)
(gui-application-create) (gui-application-create)
@ -6,6 +8,19 @@
(define loc (new-QUrl "examples/helloworld.qml")) (define loc (new-QUrl "examples/helloworld.qml"))
(load-url engine loc) (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 callback-data (new-CallbackData "Test"))
(define conn (connect-lambda-static engine "quit"
windowCloseCallback
callback-data
(qt-connection-type auto:)))
(do ((loop #t)) (do ((loop #t))
((not loop) #t) ((not loop) #t)
(process-events-timed (qevent-loop-process-event-flag process-all-events:) 50)) (process-events-timed (qevent-loop-process-event-flag process-all-events:) 50))
(type windowCloseCallback)
(type callback-data)

134
qml.core.scm
View File

@ -2,12 +2,15 @@
(import (r7rs)) (import (r7rs))
(define-library (qml core) (define-library (qml core)
(import (chicken base))
(import (chicken gc)) (import (chicken gc))
(import (chicken string)) (import (chicken string))
(import (chicken condition)) (import (chicken condition))
(import (chicken foreign))
(import (chicken memory))
(import (qml lowlevel)) (import (qml lowlevel))
(import (scheme base)) (import (scheme base))
(import coops coops-primitive-objects coops-extras coops-utils srfi-1 srfi-69) (import coops coops-primitive-objects coops-extras coops-utils srfi-1 srfi-69 object-evict)
(export application-dir-path (export application-dir-path
process-events process-events
process-events-timed process-events-timed
@ -74,8 +77,23 @@
<PropertyDefinitions> <PropertyDefinitions>
new-Properties new-Properties
<QMetaObjectConnection>
delete-pointer
<CallbackData>
new-CallbackData
pointer
<QObject> <QObject>
signal-emit signal-emit
object-name
set-object-name
property
set-property
connect-lambda-static
connect-static
disconnect-static
disconnect-with-connection-static
<QVariant> <QVariant>
qvariant qvariant
@ -279,12 +297,66 @@
(when (= 0 (refcount callback-registry (ptr qbase))) (when (= 0 (refcount callback-registry (ptr qbase)))
(delete-pointer qbase))))) (delete-pointer qbase)))))
(define-class <QObject> (<QMLBase>))
(define-class <QVariant> (<QMLBase>)
((ptr accessor: ptr)))
(define-method (initialize-instance (qv <QVariant>))
(set! (ptr qv) (dos_qvariant_create))
(call-next-method))
(define-method (qvariant (val <integer>))
(make <QVariant> 'ptr (dos_qvariant_create_int val)))
(define-method (qvariant (val <boolean>))
(make <QVariant> 'ptr (dos_qvariant_create_bool val)))
(define-method (qvariant (val <string>))
(make <QVariant> 'ptr (dos_qvariant_create_string val)))
(define-method (qvariant (val <QObject>))
(make <QVariant> 'ptr (dos_qvariant_create_qobject (ptr val))))
(define-method (qvariant (val <flonum>))
(make <QVariant> 'ptr (dos_qvariant_create_float val)))
(define-method (set (qv <QVariant>) (val <integer>))
(dos_qvariant_setInt (ptr qv) val))
(define-method (set (qv <QVariant>) (val <boolean>))
(dos_qvariant_setBool (ptr qv) val))
(define-method (set (qv <QVariant>) (val <flonum>))
(dos_qvariant_setFloat (ptr qv) val))
(define-method (set (qv <QVariant>) (val <string>))
(dos_qvariant_setString (ptr qv) val))
(define-method (set (qv <QVariant>) (val <QObject>))
(dos_qvariant_setQObject (ptr qv) (ptr val)))
(define-method (to (qv <QVariant>) (target <keyword>))
(case target
((integer:) (dos_qvariant_toInt (ptr qv)))
((boolean:) (dos_qvariant_toBool (ptr qv)))
((string:) (dos_qvariant_toString (ptr qv)))
((flonum:) (dos_qvariant_toFloat (ptr qv)))
((qobject:) (dos_qvariant_toQObject (ptr qv)))))
(define-method (is-null? (qv <QVariant>))
(dos_qvariant_isnull (ptr qv)))
(define-method (assign (qv <QVariant>) (other <QVariant>))
(dos_qvariant_assign (ptr qv) (ptr other)))
(define-method (copy (qv <QVariant>))
(make <QVariant> 'ptr (dos_qvariant_create_qvariant (ptr qv))))
(define-method (delete-pointer (qv <QVariant>))
(dos_qvariant_delete (ptr qv)))
(define-class <QMetaObjectConnection> (<QMLBase>) (define-class <QMetaObjectConnection> (<QMLBase>)
((ptr accessor: ptr))) ((ptr accessor: ptr)))
(define-method (delete-pointer (qmoc <QMetaObjectConnection>)) (define-method (delete-pointer (qmoc <QMetaObjectConnection>))
(dos_qmetaobject_connection_delete (slot-value qmoc 'ptr))) (dos_qmetaobject_connection_delete (slot-value qmoc 'ptr)))
(define-class <QObject> (<QMLBase>)) (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>)) (define-method (signal-emit (qo <QObject>) (name <string>) (paramcount <integer>) (parameters <sequence>))
(dos_qobject_signal_emit (ptr qo) name paramcount parameters)) (dos_qobject_signal_emit (ptr qo) name paramcount parameters))
(define-method (object-name (qo <QObject>)) (define-method (object-name (qo <QObject>))
@ -296,6 +368,19 @@
(define-method (set-property (qo <QObject>) (propertyName <string>) (value <QVariant>)) (define-method (set-property (qo <QObject>) (propertyName <string>) (value <QVariant>))
(dos_qobject_setProperty (slot-value qo 'ptr) propertyName (slot-value value 'ptr))) (dos_qobject_setProperty (slot-value qo 'ptr) propertyName (slot-value value 'ptr)))
(define-method (connect-lambda-static (sender <QObject>) (signal <string>)
(callback <procedure>) (callback-data <CallbackData>)
(connection-type <QtConnectionType>))
(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)))
(define-method (connect-static (sender <QObject>) (signal <string>) (define-method (connect-static (sender <QObject>) (signal <string>)
(receiver <QObject>) (slot <string>) (connection-type <QtConnectionType>)) (receiver <QObject>) (slot <string>) (connection-type <QtConnectionType>))
(make <QMetaObjectConnection> 'ptr (make <QMetaObjectConnection> 'ptr
@ -303,6 +388,8 @@
(slot-value receiver 'ptr) slot (qt-connection-type connection-type)))) (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-static (sender <QObject>) (signal <string>) (receiver <QObject>) (slot <string>))
(dos_qobject_disconnect_static (slot-value sender 'ptr) signal (slot-value receiver 'ptr) slot)) (dos_qobject_disconnect_static (slot-value sender 'ptr) signal (slot-value receiver 'ptr) slot))
(define-method (disconnect-with-connection-static (qmoc <QMetaObjectConnection>))
(dos_qobject_disconnect_with_connection_static (slot-value qmoc 'ptr)))
(define-method (delete-pointer (qo <QObject>)) (define-method (delete-pointer (qo <QObject>))
(dos_qobject_delete (ptr qo))) (dos_qobject_delete (ptr qo)))
@ -347,47 +434,6 @@
(define-method (delete-pointer (pd <PropertyDefinitions>)) (define-method (delete-pointer (pd <PropertyDefinitions>))
(dos_propertydefinitions_delete (ptr pd))) (dos_propertydefinitions_delete (ptr pd)))
(define-class <QVariant> (<QMLBase>)
((ptr accessor: ptr)))
(define-method (initialize-instance (qv <QVariant>))
(set! (ptr qv) (dos_qvariant_create))
(call-next-method))
(define-method (qvariant (val <integer>))
(make <QVariant> 'ptr (dos_qvariant_create_int val)))
(define-method (qvariant (val <boolean>))
(make <QVariant> 'ptr (dos_qvariant_create_bool val)))
(define-method (qvariant (val <string>))
(make <QVariant> 'ptr (dos_qvariant_create_string val)))
(define-method (qvariant (val <QObject>))
(make <QVariant> 'ptr (dos_qvariant_create_qobject (ptr val))))
(define-method (qvariant (val <flonum>))
(make <QVariant> 'ptr (dos_qvariant_create_float val)))
(define-method (set (qv <QVariant>) (val <integer>))
(dos_qvariant_setInt (ptr qv) val))
(define-method (set (qv <QVariant>) (val <boolean>))
(dos_qvariant_setBool (ptr qv) val))
(define-method (set (qv <QVariant>) (val <flonum>))
(dos_qvariant_setFloat (ptr qv) val))
(define-method (set (qv <QVariant>) (val <string>))
(dos_qvariant_setString (ptr qv) val))
(define-method (set (qv <QVariant>) (val <QObject>))
(dos_qvariant_setQObject (ptr qv) (ptr val)))
(define-method (to (qv <QVariant>) (target <keyword>))
(case target
((integer:) (dos_qvariant_toInt (ptr qv)))
((boolean:) (dos_qvariant_toBool (ptr qv)))
((string:) (dos_qvariant_toString (ptr qv)))
((flonum:) (dos_qvariant_toFloat (ptr qv)))
((qobject:) (dos_qvariant_toQObject (ptr qv)))))
(define-method (is-null? (qv <QVariant>))
(dos_qvariant_isnull (ptr qv)))
(define-method (assign (qv <QVariant>) (other <QVariant>))
(dos_qvariant_assign (ptr qv) (ptr other)))
(define-method (copy (qv <QVariant>))
(make <QVariant> 'ptr (dos_qvariant_create_qvariant (ptr qv))))
(define-method (delete-pointer (qv <QVariant>))
(dos_qvariant_delete (ptr qv)))
(define-class <QQmlContext> (<QObject>)) (define-class <QQmlContext> (<QObject>))
(define-method (base-url (context <QQmlContext>)) (define-method (base-url (context <QQmlContext>))
(dos_qqmlcontext_baseUrl (ptr context))) (dos_qqmlcontext_baseUrl (ptr context)))
@ -434,7 +480,7 @@
(define-class <QQmlApplicationEngine> (<QObject>)) (define-class <QQmlApplicationEngine> (<QObject>))
(define-method (initialize-instance (qae <QQmlApplicationEngine>)) (define-method (initialize-instance (qae <QQmlApplicationEngine>))
(set! (slot-value qae 'ptr) (dos_qqmlapplicationengine_create)) (set! (ptr qae) (dos_qqmlapplicationengine_create))
(call-next-method)) (call-next-method))
(define-method (load (appengine <QQmlApplicationEngine>) (filePath <string>)) (define-method (load (appengine <QQmlApplicationEngine>) (filePath <string>))
(dos_qqmlapplicationengine_load (ptr appengine) filePath)) (dos_qqmlapplicationengine_load (ptr appengine) filePath))

17
qml.lowlevel.scm
View File

@ -864,13 +864,20 @@
(foreign-lambda bool "dos_qobject_setProperty" (foreign-lambda bool "dos_qobject_setProperty"
(c-pointer DosQObject) c-string (c-pointer DosQVariant))) (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 (define dos_qobject_connect_lambda_static
(foreign-lambda (c-pointer DosQMetaObjectConnection) "dos_qobject_connect_lambda_static" (foreign-lambda (c-pointer DosQMetaObjectConnection) "dos_qobject_connect_lambda_static"
(c-pointer DosQObject) ;; sender (c-pointer DosQObject) ;; sender
c-string ;; signal c-string ;; signal
DosQObjectConnectLambdaCallback ;; callback (function void (c-pointer int pointer-vector)) ;; callback
c-pointer ;; callbackData c-pointer ;; callbackData
DosQtConnectionType)) ;; connection_type DosQtConnectionType)) ;; connection_type
(define dos_qobject_connect_lambda_with_context_static (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) "dos_qobject_connect_lambda_with_context_static"
(c-pointer DosQObject) ;; sender (c-pointer DosQObject) ;; sender