qml-old/qml.core.scm

;; -*- geiser-scheme: chicken -*-
(import (r7rs))

(define-library (qml core)
  (import (chicken base))
  (import (chicken gc))
  (import (chicken string))
  (import (chicken condition))
  (import (chicken foreign))
  (import (chicken memory))
  (import (qml lowlevel))
  (import (scheme base))
  (import coops coops-primitive-objects coops-extras coops-utils srfi-1 srfi-69 object-evict)
  @("A library to simplify usage of QML user interfaces from Chicken.")
  (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

		      <SchemeObject>

		      <ParameterDefinition>
		      new-Parameter

		      <SignalDefinition>
		      new-Signal
		      <SignalDefinitions>
		      new-Signals

		      <SlotDefinition>
		      new-Slot
		      <SlotDefinitions>
		      new-Slots

		      <PropertyDefinition>
		      new-Property
		      <PropertyDefinitions>
		      new-Properties

          <QMetaObjectConnection>
          delete-pointer

		      <QObject>
		      signal-emit
          object-name
          set-object-name
          property
          set-property
          find-child
          connect
          disconnect

		      <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
          root
		      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
    @(== "Enums")
    @(=== "Usage")
    @("When a method requires an enum value, it can be handed to it using the enum's procedure plus the enum value keyword. Example:")
    @(script "(qt-connection-type auto:)")

    (define-class <Enum> ()
      ((val accessor: val)))

    (define-class <QEventLoopProcessEventFlag> (<Enum>))
    (define (qevent-loop-process-event-flag val) @("QEventLoopProcessEventFlag flags. Available values: process-all-events:, exclude-user-input-events:, process-exclude-socket-notifiers:, and process-all-events-wait-for-more-events:.")
      (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) @("QConnectionType flags. Available values: auto:, direct:, queued:, blocking:, and unique:.")
      (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) @("QQuickViewResizeMode flags. Available values: side-view-to-root-object:, and size-root-object-to-view:.")
      (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) @("QItemDataRole flags. Available values: display:, decoration:, edit:, tool-tip:, status-tip:, whats-this:, font:, text-alignment:, background:, foreground:, check-state:, accessible-text:, accessible-description:, size-hint:, and initial-sort-order:.")
      (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) @("QOrientation flags. Available values: horizontal:, and vertical:.")
      (case val
        ((horizontal:) (make <QtOrientation> 'val #x01))
        ((vertical:) (make <QtOrientation> 'val #x02))))

    ;; Helpers
    @(== "Helpers")
    (define (application-dir-path) @((@to "the application dir path"))
      (dos_qcoreapplication_application_dir_path))
    (define-method (process-events (flag <QEventLoopProcessEventFlag>)) @("Runs the QML event processing once until all queued events are processed.")
      (dos_qcoreapplication_process_events (val flag)))
    (define-method (process-events-timed (flag <QEventLoopProcessEventFlag>) (timed <integer>)) @("Runs the QML event processing until all queued events are processed or the timeout has run out.")
      (dos_qcoreapplication_process_events_timed (val flag) timed))

    (define (gui-application-create) @("Initializes the QGuiApplication.")
      (dos_qguiapplication_create))
    (define (gui-application-exec) @("Executes the QGuiApplication. WARNING: This will block the Chicken process!")
      (dos_qguiapplication_exec))
    (define (gui-application-quit) @("Quits the QGuiApplication.")
      (dos_qguiapplication_quit))
    (define (gui-application-delete) @("Deletes the QGuiApplication.")
      (dos_qguiapplication_delete))

    (define (qapplication-create) @("Initializes the QApplication.")
      (dos_qapplication_create))
    (define (qapplication-exec) @("Executes the QApplication. WARNING: This will block the Chicken process!")
      (dos_qapplication_exec))
    (define (qapplication-quit) @("Quits the QApplication.")
      (dos_qapplication_quit))
    (define (qapplication-delete) @("Deletes the QApplication.")
      (dos_qapplication_delete))

    (define (qquickstyle-set-style style) @("Sets the QQuickStyle, see https://doc.qt.io/qt-5/qquickstyle.html#setStyle for details.")
      (dos_qquickstyle_set_style style))
    (define (qquickstyle-set-fallback-style style) @("Sets the fallback style with QQuickStyle, see https://doc.qt.io/qt-5/qquickstyle.html#setFallbackStyle for details.")
      (dos_qquickstyle_set_fallback_style style))

    ;; Objects
    @(== "Classes")
    (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))

    @(=== "<QMLBase>")
    @("A base class you can't directly use yourself, but it provides facilities like a refcounter to delete the companion pointer once it is not needed anymore.")
    (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>))

    @(=== "<QVariant>")
    @("This class is used to pass and return value types to and from Qt, and offers a decent range of possible types.")
    (define-class <QVariant> (<QMLBase>)
      ((ptr accessor: ptr)))
    (define (new-QVariant) @("Creates a blank QVariant with no content."
                             (@to "<QVariant>"))
      (make <QVariant> 'ptr (dos_qvariant_create)))
    (define-method (qvariant (val <integer>)) @("Creates a QVariant with an integer."
                                                (val "The integer to store")
                                                (@to "<QVariant>"))
      (make <QVariant> 'ptr (dos_qvariant_create_int val)))
    (define-method (qvariant (val <boolean>)) @("Creates a QVariant with a boolean."
                                                (val "The boolean to store")
                                                (@to "<QVariant>"))
      (make <QVariant> 'ptr (dos_qvariant_create_bool val)))
    (define-method (qvariant (val <string>)) @("Creates a QVariant with a string."
                                               (val "The string to store")
                                               (@to "<QVariant>"))
      (make <QVariant> 'ptr (dos_qvariant_create_string val)))
    (define-method (qvariant (val <QObject>)) @("Creates a QVariant with a QObject."
                                                (val "The QObject to store")
                                                (@to "<QVariant>"))
      (make <QVariant> 'ptr (dos_qvariant_create_qobject (ptr val))))
    (define-method (qvariant (val <flonum>)) @("Creates a QVariant with a float."
                                               (val "The float to store")
                                               (@to "<QVariant>"))
      (make <QVariant> 'ptr (dos_qvariant_create_float val)))
    (define-method (set (qv <QVariant>) (val <integer>)) @("Sets the QVariant value to the specified integer."
                                                           (qv "The QVariant to modify")
                                                           (val "The integer to store")
                                                           (@to "void"))
      (dos_qvariant_setInt (ptr qv) val))
    (define-method (set (qv <QVariant>) (val <boolean>)) @("Sets the QVariant value to the specified boolean."
                                                           (qv "The QVariant to modify")
                                                           (val "The booleant o store")
                                                           (@to "void"))
      (dos_qvariant_setBool (ptr qv) val))
    (define-method (set (qv <QVariant>) (val <flonum>)) @("Sets the QVariant value to the specified float."
                                                          (qv "The QVariant to modify")
                                                          (val "The float to store")
                                                          (@to "void"))
      (dos_qvariant_setFloat (ptr qv) val))
    (define-method (set (qv <QVariant>) (val <string>)) @("Sets the QVariant value to the specified string."
                                                          (qv "The QVariant to modify")
                                                          (val "The string to store")
                                                          (@to "void"))
      (dos_qvariant_setString (ptr qv) val))
    (define-method (set (qv <QVariant>) (val <QObject>)) @("Sets the QVariant value to the specified QObject."
                                                           (qv "The QVariant to modify")
                                                           (val "The QObject to store")
                                                           (@to "void"))
      (dos_qvariant_setQObject (ptr qv) (ptr val)))
    (define-method (to (qv <QVariant>) (target <keyword>)) @("Extracts the QVariant's value."
                                                             (qv "The QVariant to read")
                                                             (target "The target format; available are integer:, boolean:, string:, flonum:, and qobject:")
                                                             (@to "target format"))
      (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>)) @("Checks if the QVariant's value is null."
                                                (qv "The QVariant to check")
                                                (@to "boolean"))
      (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 dobject-callbacks (make-hash-table))

    (define-external (dObjectCallbackHelper (c-pointer self) (c-pointer slotName) (int argc) ((c-pointer c-pointer) argv)) void
      (let* ((qobject (hash-table-ref dobject-callbacks self))
             (args (c_array_convert argv argc)))
        ((alist-ref callback: dobject-callbacks) (alist-ref object: dobject-callbacks) (qvariant slotName)
         (map qvariant args))))

    (define (make-QObject qobject name qmetaobject signals slots props callback)
      @("Creates a new QObject."
        (qobject "An instance of <QObject> or #f")
        (qmetaobject "A QMetaObject or #f")
        (callback "A procedure of the form (function <QObject> self <QVariant> slotName <QVariant>-array argv)"))
      (let* ((qmeta (if qmetaobject (ptr qmetaobject) (dos_qobject_qmetaobject)))
             (qmeta (dos_qmetaobject_create (qml_qmetaobject_superClass)
                                            name signals slots props))
             (qobj (make <QObject> 'ptr (dos_qobject_create (if (instance-of? qobject <QObject>)
                                                                (ptr qobject) #f)
                                                            qmeta
                                                            callback))))
        (hash-table-set! dobject-callbacks (ptr qobj) `((object: . ,qobj)
                                                        (callback: . ,callback)))
        qobj))
    (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>))
      (dos_qobject_objectName (slot-value qo 'ptr)))
    (define-method (set-object-name (qo <QObject>) (name <string>))
      (dos_qobject_setObjectName (slot-value qo) name))
    (define-method (property (qo <QObject>) (propertyName <string>))
      (make <QVariant> 'ptr (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))
             (callback-proc (alist-ref proc: callback-info))
             (callback-data (alist-ref data: callback-info))
             (signal-data (map (lambda (item)
                                 (make <QVariant> 'ptr item))
                               (c_array_convert argv argc))))
        (callback-proc callback-data signal-data)))

    ;; 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)
                                                                (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)))))

    ;; 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 (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 (qmoc <QMetaObjectConnection>))
      (dos_qobject_disconnect_with_connection_static (slot-value qmoc 'ptr)))

    (define-method (delete-pointer (qmoc <QMetaObjectConnection>))
      (handle-exceptions exn #t
        (disconnect qmoc))
      (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>))
      (dos_qobject_deleteLater (ptr qo)))

    ;; Scheme Objects
    (define-class <SchemeObject> ()
      ((obj accessor: obj)))

    (define-class <ParameterDefinition> (<SchemeObject>))
    (define-method (new-Parameter (name <string>) (meta-type <integer>))
      (make <ParameterDefinition> 'obj (dos_parameterdefinition_create name meta-type)))

    ;; - Signals
    (define-class <SignalDefinition> (<SchemeObject>))
    (define-method (new-Signal (name <string>) #!rest parameters)
      (make <SignalDefinition>
        'obj (dos_signaldefinition_create name (length parameters)
                                          (cdr
                                           (foldl (lambda (coll elem)
                                                    (cons (+ (car coll) 1)
                                                          (pointer-vector-set! (cdr coll) (car coll)
                                                                               (object->pointer (object-evict (obj elem))))))
                                                  (cons 0 (make-pointer-vector (length parameters))) parameters)))))
    (define-class <SignalDefinitions> (<QMLBase>))
    (define-method (new-Signals (defs <list>))
      (make <SignalDefinitions>
        'ptr (dos_signaldefinitions_create (length defs)
                                           (foldl (lambda (coll elem)
                                                    (cons (+ (car coll) 1)
                                                          (pointer-vector-set! (cdr coll) (car coll) (ptr elem))))
                                                  (cons 0 (make-pointer-vector (length defs))) defs))))
    (define-method (delete-pointer (sd <SignalDefinitions>))
      (dos_signaldefinitions_delete (ptr sd)))

    ;; - Slots
    (define-class <SlotDefinition> (<SchemeObject>))
    (define-method (new-Slot (name <string>) (returnMetaType <integer>) #!rest parameters)
      (make <SlotDefinition> 'obj (dos_slotdefinition_create name returnMetaType (length parameters) (map obj parameters))))
    (define-class <SlotDefinitions> (<QMLBase>))
    (define-method (new-Slots (defs <list>))
      (make <SlotDefinitions> 'ptr (dos_slotdefinitions_create (length defs) (map obj defs))))
    (define-method (delete-pointer (sd <SlotDefinitions>))
      (dos_slotdefinitions_delete (ptr sd)))

    ;; - Properties
    (define-class <PropertyDefinition> (<SchemeObject>))
    (define-method (new-Property (name <string>) (propertyMetaType <integer>) (readSlot <string>) (writeSlot <string>) (notifySignal <string>))
      (make <PropertyDefinition> 'obj (dos_propertydefinition_create name propertyMetaType readSlot writeSlot notifySignal)))
    (define-class <PropertyDefinitions> (<QMLBase>))
    (define-method (new-Properties (defs <list>))
      (make <PropertyDefinitions> 'ptr (dos_propertydefinitions_create (length defs) (map obj defs))))
    (define-method (delete-pointer (pd <PropertyDefinitions>))
      (dos_propertydefinitions_delete (ptr pd)))

    (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-method (set-property (context <QQmlContext>) (name <string>) (qvalue <QObject>))
      (qml_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! (ptr qae) (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 (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>))
      (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)
      (make <QAbstractItemModel> 'ptr (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)))
    )
  )