Chicken Scheme bindings to QML, leveraging the DOtherSide library
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 

461 lines
18 KiB

;; -*- geiser-scheme: chicken -*-
(import (r7rs))
(define-library (qml core)
(import (chicken gc))
(import (chicken string))
(import (chicken condition))
(import (qml lowlevel))
(import (scheme base))
(import coops coops-primitive-objects coops-extras srfi-1 srfi-69)
(export application-dir-path
process-events
process-events-timed
gui-application-create
gui-application-exec
gui-application-quit
gui-application-delete
qapplication-create
qapplication-exec
qapplication-quit
qapplication-delete
qquickstyle-set-style
qquickstyle-set-fallback-style
initialize-instance
set
to
is-null?
assign
copy
delete-pointer
delete-pointer-later
<Enum>
<QEventLoopProcessEventFlag>
qevent-loop-process-event-flag
<QtConnectionType>
qt-connection-type
<QQuickViewResizeMode>
qquick-view-resize-mode
<QItemDataRole>
qitem-data-role
<QtOrientation>
qt-orientation
<QMLBase>
add-ptrentry
remove-ptrentry
<QObject>
signal-emit
<QVariant>
qvariant
<QQmlContext>
base-url
set-property
<QUrl>
new-QUrl
to-string
valid?
<QPixmap>
new-QPixmap
load
load-from-data
fill
assign
<QQuickImageProvider>
new-QQuickImageProvider
<QQmlApplicationEngine>
load
load-url
load-data
add-import-path
context
add-image-provider
<QQuickView>
show
source
set-source-url
set-source
set-resize-mode
root-context
<QMetaObject>
new-QMetaObject
invoke-method
<QModelIndex>
row
column
valid?
data
parent
child
sibling
assign
<QAbstractItemModel>
new-QAbstractItemModel
set-data
flags
header-data
<QAbstractListModel>
new-QAbstractListModel
index
parent
column-count
<QAbstractTableModel>
new-QAbstractTableModel
index
parent
)
(begin
;; Enums
(define-class <Enum> ()
((val accessor: val)))
(define-class <QEventLoopProcessEventFlag> (<Enum>))
(define (qevent-loop-process-event-flag val)
(case val
((process-all-events:)
(make <QEventLoopProcessEventFlag> 'val DosQEventLoopProcessEventFlagProcessAllEvents))
((exclude-user-input-events:)
(make <QEventLoopProcessEventFlag> 'val DosQEventLoopProcessEventFlagExcludeUserInputEvents))
((process-exclude-socket-notifiers:)
(make <QEventLoopProcessEventFlag> 'val DosQEventLoopProcessEventFlagProcessExcludeSocketNotifiers))
((process-all-events-wait-for-more-events:)
(make <QEventLoopProcessEventFlag> 'val DosQEventLoopProcessEventFlagProcessAllEventsWaitForMoreEvents))))
(define-class <QtConnectionType> (<Enum>))
(define (qt-connection-type val)
(case val
((auto:)
(make <QtConnectionType> 'val DosQtConnectionTypeAutoConnection))
((direct:)
(make <QtConnectionType> 'val DosQtConnectionTypeDirectConnection))
((queued:)
(make <QtConnectionType> 'val DosQtConnectionTypeQueuedConnection))
((blocking:)
(make <QtConnectionType> 'val DosQtConnectionTypeBlockingConnection))
((unique:)
(make <QtConnectionType> 'val DosQtConnectionTypeUniqueConnection))))
(define-class <QQuickViewResizeMode> (<Enum>))
(define (qquick-view-resize-mode val)
(case val
((size-view-to-root-object:) (make <QQuickViewResizeMode> 'val #x0))
((size-root-object-to-view:) (make <QQuickViewResizeMode> 'val #x1))))
(define-class <QItemDataRole> (<Enum>))
(define (qitem-data-role val)
(case val
((display:) (make <QItemDataRole> 'val 0))
((decoration:) (make <QItemDataRole> 'val 1))
((edit:) (make <QItemDataRole> 'val 2))
((tool-tip:) (make <QItemDataRole> 'val 3))
((status-tip:) (make <QItemDataRole> 'val 4))
((whats-this:) (make <QItemDataRole> 'val 5))
((font:) (make <QItemDataRole> 'val 6))
((text-alignment:) (make <QItemDataRole> 'val 7))
((background:) (make <QItemDataRole> 'val 8))
((foreground:) (make <QItemDataRole> 'val 9))
((check-state:) (make <QItemDataRole> 'val 10))
((accessible-text:) (make <QItemDataRole> 'val 11))
((accessible-description:) (make <QItemDataRole> 'val 12))
((size-hint:) (make <QItemDataRole> 'val 13))
((initial-sort-order:) (make <QItemDataRole> 'val 14))))
(define-class <QtOrientation> (<Enum>))
(define (qt-orientation val)
(case val
((horizontal:) (make <QtOrientation> 'val #x01))
((vertical:) (make <QtOrientation> 'val #x02))))
;; Helpers
(define (application-dir-path)
(dos_qcoreapplication_application_dir_path))
(define-method (process-events (flag <QEventLoopProcessEventFlag>))
(dos_qcoreapplication_process_events (val flag)))
(define-method (process-events-timed (flag <QEventLoopProcessEventFlag>) (timed <integer>))
(dos_qcoreapplication_process_events_timed (val flag) timed))
(define (gui-application-create)
(dos_qguiapplication_create))
(define (gui-application-exec)
(dos_qguiapplication_exec))
(define (gui-application-quit)
(dos_qguiapplication_quit))
(define (gui-application-delete)
(dos_qguiapplication_delete))
(define (qapplication-create)
(dos_qapplication_create))
(define (qapplication-exec)
(dos_qapplication_exec))
(define (qapplication-quit)
(dos_qapplication_quit))
(define (qapplication-delete)
(dos_qapplication_delete))
(define (qquickstyle-set-style style)
(dos_qquickstyle_set_style style))
(define (qquickstyle-set-fallback-style style)
(dos_qquickstyle_set_fallback_style style))
;; Objects
(define callback-registry
(make-hash-table))
(define-method (refcount (alist <list>))
(cdr (find (lambda (a) (eq? refcount: (car a))) alist)))
(define-method (refcount (ht <hash-table>) (ptr <pointer>))
(if (hash-table-exists? callback-registry ptr)
(refcount (hash-table-ref ht ptr))
0))
(define-class <QMLBase> ()
((ptr accessor: ptr initform: #f)))
(define-method (delete-pointer (qbase <QMLBase>))
(abort (make-property-condition 'exn 'Message "Please implement the delete method for your subtype.")))
(define-method (add-ptrentry (qbase <QMLBase>))
(hash-table-update! callback-registry (ptr qbase)
(lambda (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 <QMLBase>))
(if (eq? 1 (refcount callback-registry (ptr qbase)))
(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))) )))
(define-method (initialize-instance (qbase <QMLBase>))
(call-next-method)
(add-ptrentry qbase)
(set-finalizer! qbase (lambda (obj)
(remove-ptrentry qbase)
(when (= 0 (refcount callback-registry (ptr qbase)))
(delete-pointer qbase)))))
(define-class <QObject> (<QMLBase>))
(define-method (signal-emit (qo <QObject>) (name <string>) (paramcount <integer>) (parameters <sequence>))
(dos_qobject_signal_emit (ptr qo) name paramcount parameters))
(define-method (delete-pointer (qo <QObject>))
(dos_qobject_delete (ptr qo)))
(define-method (delete-pointer-later (qo <QObject>))
(dos_qobject_deleteLater (ptr qo)))
(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-method (base-url (context <QQmlContext>))
(dos_qqmlcontext_baseUrl (ptr context)))
(define-method (set-property (context <QQmlContext>) (name <string>) (qvalue <QVariant>))
(dos_qqmlcontext_setcontextproperty (ptr context) name (ptr qvalue)))
(define-class <QUrl> (<QMLBase>))
(define (new-QUrl url)
(let ((qurl (make <QUrl> 'ptr (dos_qurl_create url 0))))
qurl))
(define-method (to-string (qurl <QUrl>))
(dos_qurl_to_string (ptr qurl)))
(define-method (valid? (qurl <QUrl>))
(dos_qurl_isValid (ptr qurl)))
(define-method (delete-pointer (qurl <QUrl>))
(dos_qurl_delete (ptr qurl)))
(define-class <QPixmap> (<QMLBase>))
(define-method (initialize-instance (qpx <QPixmap>))
(set! (slot-value qpx 'ptr) (dos_qpixmap_create))
(call-next-method))
(define (new-QPixmap width height)
(make <QPixmap> 'ptr (dos_qpixmap_create_width_and_height width height)))
(define-method (copy (qpix <QPixmap>))
(make <QPixmap> 'ptr (dos_qpixmap_create_qpixmap (ptr qpix))))
(define-method (load (qpix <QPixmap>) (filepath <string>) (format <string>))
(dos_qpixmap_load (ptr qpix) filepath format))
(define-method (load-from-data (qpix <QPixmap>) (data <string>) (len <integer>))
(dos_qpixmap_loadFromData (ptr qpix) data len))
(define-method (fill (qpix <QPixmap>) (r <char>) (g <char>) (b <char>) (a <char>))
(dos_qpixmap_fill (ptr qpix) r g b a))
(define-method (assign (qpix <QPixmap>) (other <QPixmap>))
(dos_qpixmap_assign (ptr qpix) (ptr other)))
(define-method (is-null? (qpix <QPixmap>))
(dos_qpixmap_isNull (ptr qpix)))
(define-method (delete-pointer (qpix <QPixmap>))
(dos_qpixmap_delete (ptr qpix)))
(define-class <QQuickImageProvider> (<QMLBase>))
(define-method (new-QQuickImageProvider callback)
(make <QQuickImageProvider> 'ptr (dos_qquickimageprovider_create callback)))
(define-method (delete-pointer (qip <QQuickImageProvider>))
(dos_qquickimageprovider_delete (ptr qip)))
(define-class <QQmlApplicationEngine> (<QObject>))
(define-method (initialize-instance (qae <QQmlApplicationEngine>))
(set! (slot-value qae 'ptr) (dos_qqmlapplicationengine_create))
(call-next-method))
(define-method (load (appengine <QQmlApplicationEngine>) (filePath <string>))
(dos_qqmlapplicationengine_load (ptr appengine) filePath))
(define-method (load-url (appengine <QQmlApplicationEngine>) (qurl <QUrl>))
(dos_qqmlapplicationengine_load_url (ptr appengine) (ptr qurl)))
(define-method (load-data (appengine <QQmlApplicationEngine>) (data <string>))
(dos_qqmlapplicationengine_load_data (ptr appengine) data))
(define-method (add-import-path (appengine <QQmlApplicationEngine>) (import-path <string>))
(dos_qqmlapplicationengine_add_import_path (ptr appengine) import-path))
(define-method (context (appengine <QQmlApplicationEngine>))
(make <QQmlContext> 'ptr (dos_qqmlapplicationengine_context (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>))
(dos_qqmlapplicationengine_delete (ptr appengine)))
(define-class <QQuickView> (<QObject>))
(define-method (initialize-instance (qqv <QQuickView>))
(set! (slot-value qqv 'ptr) (dos_qquickview_create))
(call-next-method))
(define-method (show (qqv <QQuickView>))
(dos_qquickview_show (ptr qqv)))
(define-method (source (qqv <QQuickView>))
(dos_qquickview_source (ptr qqv)))
(define-method (set-source-url (qqv <QQuickView>) (qurl <QUrl>))
(dos_qquickview_set_source_url (ptr qqv) (ptr qurl)))
(define-method (set-source (qqv <QQuickView>) (filename <string>))
(dos_qquickview_set_source (ptr qqv) filename))
(define-method (set-resize-mode (qqv <QQuickView>) (mode <QQuickViewResizeMode>))
(dos_qquickview_set_resize_mode (ptr qqv) (val mode)))
(define-method (root-context (qqv <QQuickView>))
(make <QQmlContext> 'ptr (dos_qquickview_rootContext (ptr qqv))))
(define-method (delete-pointer (qqv <QQuickView>))
(dos_qquickview_delete (ptr qqv)))
(define-class <QMetaObject> (<QMLBase>))
(define (new-QMetaObject superclass classname signal-definitions slot-definitions property-definitions)
(make <QMetaObject> 'ptr (dos_qmetaobject_create (ptr superclass) classname signal-definitions
slot-definitions property-definitions)))
(define-method (invoke-method (qmo <QMetaObject>) (callback <procedure>) (data <pointer>) (connection-type <QtConnectionType>))
(dos_qmetaobject_invoke_method (ptr qmo) callback data (val connection-type)))
(define-method (delete-pointer (qmo <QMetaObject>))
(dos_qmetaobject_delete (ptr qmo)))
(define (qmetaobject kind)
(case kind
((qobject:) (make <QMetaObject> 'ptr (dos_qobject_qmetaobject)))
((qabstractitemmodel:) (make <QMetaObject> 'ptr (dos_qabstractitemmodel_qmetaobject)))
((qabstracttablemodel:) (make <QMetaObject> 'ptr (dos_qabstracttablemodel_qmetaobject)))
((qabstractlistmodel:) (make <QMetaObject> 'ptr (dos_qabstractlistmodel_qmetaobject)))))
(define-class <QModelIndex> (<QMLBase>))
(define-method (initialize-instance (qmi <QModelIndex>))
(set! (ptr qmi) (dos_qmodelindex_create))
(call-next-method))
(define-method (copy (qmi <QModelIndex>))
(make <QModelIndex> 'ptr (dos_qmodelindex_create_qmodelindex (ptr qmi))))
(define-method (row (qmi <QModelIndex>))
(dos_qmodelindex_row (ptr qmi)))
(define-method (column (qmi <QModelIndex>))
(dos_qmodelindex_column (ptr qmi)))
(define-method (valid? (qmi <QModelIndex>))
(dos_qmodelindex_isValid (ptr qmi)))
(define-method (data (qmi <QModelIndex>) (role <QItemDataRole>))
(dos_qmodelindex_data (ptr qmi) (val role)))
(define-method (parent (qmi <QModelIndex>))
(make <QModelIndex> 'ptr (dos_qmodelindex_parent (ptr qmi))))
(define-method (child (qmi <QModelIndex>) (row <integer>) (column <integer>))
(make <QModelIndex> 'ptr (dos_qmodelindex_child (ptr qmi) row column)))
(define-method (sibling (qmi <QModelIndex>) (row <integer>) (column <integer>))
(make <QModelIndex> 'ptr (dos_qmodelindex_sibling (ptr qmi) row column)))
(define-method (assign (qmi <QModelIndex>) (other <QModelIndex>))
(dos_qmodelindex_assign (ptr qmi) (ptr other)))
(define-method (delete-pointer (qmi <QModelIndex>))
(dos_qmodelindex_delete (ptr qmi)))
(define-class <QAbstractItemModel> (<QObject>))
(define (new-QAbstractItemModel callback meta-object dcallback callbacks)
(dos_qabstractitemmodel_create callback (ptr meta-object) dcallback (ptr callbacks)))
(define-method (set-data (qaim <QAbstractItemModel>) (qmi <QModelIndex>) (qv <QVariant>) (role <QItemDataRole>))
(dos_qabstractitemmodel_setData (ptr qaim) (ptr qmi) (ptr qv) (val role)))
(define-method (flags (qaim <QAbstractItemModel>) (qmi <QModelIndex>))
(dos_qabstractitemmodel_flags (ptr qaim) (ptr qmi)))
(define-method (header-data (qaim <QAbstractItemModel>) (section <integer>) (orientation <QtOrientation>) (role <integer>))
(dos_qabstractitemmodel_headerData (ptr qaim) section (val orientation) role))
(define-class <QAbstractListModel> (<QObject>))
(define (new-QAbstractListModel callback qalm dcallback callbacks)
(dos_qabstractlistmodel_create callback (ptr qalm) dcallback (ptr callbacks)))
(define-method (index (qalm <QAbstractListModel>) (row <integer>) (column <integer>) (parent <QModelIndex>))
(dos_qabstractlistmodel_index (ptr qalm) row column (ptr parent)))
(define-method (parent (qalm <QAbstractListModel>) (child <QModelIndex>))
(dos_qabstractlistmodel_parent (ptr qalm) (ptr child)))
(define-method (column-count (qalm <QAbstractListModel>) (parent <QModelIndex>))
(dos_qabstractlistmodel_columnCount (ptr qalm) (ptr parent)))
(define-class <QAbstractTableModel> (<QAbstractItemModel>))
(define (new-QAbstractTableModel callback meta-object dcallback callbacks)
(dos_qabstracttablemodel_create callback (ptr meta-object) dcallback (ptr callbacks)))
(define-method (index (qatm <QAbstractTableModel>) (row <integer>) (column <integer>) (parent <QModelIndex>))
(dos_qabstracttablemodel_index (ptr qatm) row column (ptr parent)))
(define-method (parent (qatm <QAbstractTableModel>) (child <QModelIndex>))
(dos_qabstracttablemodel_parent (ptr qatm) (ptr child)))
)
)