mirror of
https://gitlab.com/eql/EQL5.git
synced 2026-02-04 14:52:18 -08:00
233 lines
9.2 KiB
Common Lisp
233 lines
9.2 KiB
Common Lisp
;;;
|
|
;;; * enables QML to call Lisp functions
|
|
;;; * allows to get/set any QML property from Lisp (needs 'objectName' to be set)
|
|
;;; * allows to call QML methods from Lisp (needs 'objectName' to be set)
|
|
;;; * allows to evaluate JS code from Lisp (needs 'objectName' to be set)
|
|
;;;
|
|
|
|
(in-package :qml-lisp)
|
|
|
|
(defvar *quick-view* nil)
|
|
(defvar *caller* nil)
|
|
(defvar *root* nil)
|
|
|
|
(defun string-to-symbol (name)
|
|
(let ((upper (string-upcase name))
|
|
(p (position #\: name)))
|
|
(if p
|
|
(find-symbol (subseq upper (1+ (position #\: name :from-end t)))
|
|
(subseq upper 0 p))
|
|
(find-symbol upper))))
|
|
|
|
;;; function calls from QML
|
|
|
|
(defun print-js-readably (object)
|
|
"Prints (nested) lists, vectors, T, NIL, floats in JS notation, which will be passed to JS 'eval()'."
|
|
(if (and (not (stringp object))
|
|
(vectorp object))
|
|
(print-js-readably (coerce object 'list))
|
|
(typecase object
|
|
(cons
|
|
(write-char #\[)
|
|
(do ((list object (rest list)))
|
|
((null list) (write-char #\]))
|
|
(print-js-readably (first list))
|
|
(when (rest list)
|
|
(write-char #\,))))
|
|
(float
|
|
;; JS can't read 'd0' 'l0'
|
|
(let ((str (princ-to-string object)))
|
|
(x:when-it (position-if (lambda (ch) (find ch "dl")) str)
|
|
(setf (char str x:it) #\e))
|
|
(princ str)))
|
|
(t
|
|
(cond ((eql 't object)
|
|
(princ "true"))
|
|
((eql 'nil object)
|
|
(princ "false"))
|
|
(t
|
|
(prin1 object)))))))
|
|
|
|
(defun print-to-js-string (object)
|
|
(with-output-to-string (*standard-output*)
|
|
(princ "#<>") ; mark for passing to JS "eval()"
|
|
(print-js-readably object)))
|
|
|
|
(defun qml-apply (caller function arguments)
|
|
"Every 'Lisp.call()' or 'Lisp.apply()' function call in QML will call this function. The variable *CALLER* will be bound to the calling QQuickItem, if passed with 'this' as first argument to 'Lisp.call()' / 'Lisp.apply()'."
|
|
(let* ((*caller* (if (qnull caller) *caller* (qt-object-? caller)))
|
|
(object (apply (string-to-symbol function)
|
|
arguments)))
|
|
(if (stringp object)
|
|
object
|
|
(print-to-js-string object))))
|
|
|
|
;;; utils
|
|
|
|
(defun root-item ()
|
|
(when *quick-view*
|
|
(qrun* (if (= (qt-object-id *quick-view*) (qid "QQmlApplicationEngine"))
|
|
(let ((object (first (|rootObjects| *quick-view*))))
|
|
(setf (qt-object-id object) (qid "QObject")) ; unknown to EQL, so resort to QObject
|
|
object)
|
|
(qt-object-? (|rootObject| *quick-view*))))))
|
|
|
|
(defun root-context ()
|
|
(when *quick-view*
|
|
(|rootContext| *quick-view*)))
|
|
|
|
(defun find-quick-item (object-name)
|
|
"Finds the first QQuickItem matching OBJECT-NAME."
|
|
(let ((root (root-item)))
|
|
(unless (qnull root)
|
|
(if (string= (|objectName| root) object-name)
|
|
(root-item)
|
|
(qt-object-? (qfind-child root object-name))))))
|
|
|
|
(defun quick-item (item/name)
|
|
(cond ((stringp item/name)
|
|
(find-quick-item item/name))
|
|
((qt-object-p item/name)
|
|
item/name)
|
|
((not item/name)
|
|
(root-item))))
|
|
|
|
(defun children (item/name)
|
|
"Like QML function 'children'."
|
|
(qrun* (mapcar 'qt-object-? (|childItems| (quick-item item/name)))))
|
|
|
|
(defun scale ()
|
|
"Returns the scale factor used on high dpi scaled devices (e.g. phones)."
|
|
(|effectiveDevicePixelRatio| *quick-view*))
|
|
|
|
(defun reload ()
|
|
"Force reloading of QML file after changes made to it."
|
|
(|clearComponentCache| (|engine| *quick-view*))
|
|
(|setSource| *quick-view* (|source| *quick-view*)))
|
|
|
|
(defun file-to-url (file)
|
|
"Convert FILE to a QUrl, distinguishing between development and release version."
|
|
(if (probe-file file)
|
|
(|fromLocalFile.QUrl| file)
|
|
(qnew "QUrl(QString)"
|
|
(x:cc (or *root* "qrc:/") file)))) ; see "Qt Resource System"
|
|
|
|
;;; call QML methods
|
|
|
|
(defun qml-call (item/name method-name &rest arguments)
|
|
;; QFUN+ comes in handy here
|
|
(qrun* (apply 'qfun+ (quick-item item/name) method-name arguments)))
|
|
|
|
;;; get/set QQmlProperty
|
|
|
|
(defun qml-get (item/name property-name)
|
|
"Gets QQmlProperty of either ITEM or first object matching NAME."
|
|
(qrun* (eql::%qml-get (quick-item item/name) property-name)))
|
|
|
|
(defun qml-set (item/name property-name value &optional update)
|
|
"Sets QQmlProperty of either ITEM, or first object matching NAME. Returns T on success. If UPDATE is not NIL and ITEM is a QQuickPaintedItem, |update| will be called on it."
|
|
(qrun* (prog1
|
|
(eql::%qml-set (quick-item item/name) property-name value)
|
|
(when (and update (= (qt-object-id item) (qid "QQuickPaintedItem")))
|
|
(|update| item)))))
|
|
|
|
(defun qml-set-all (name property-name value &optional update)
|
|
"Sets QQmlProperty of all objects matching NAME."
|
|
(assert (stringp name))
|
|
(qrun* (dolist (item (qfind-children (root-item) name))
|
|
(qml-set item property-name value update))))
|
|
|
|
(defmacro q! (method-name item/name &rest arguments)
|
|
"Convenience macro for QML-CALL. Use symbol instead of string name."
|
|
`(qml-call ,item/name ,(symbol-name method-name) ,@arguments))
|
|
|
|
(defmacro q> (property-name item/name value &optional update)
|
|
"Convenience macro for QML-SET. Use symbol instead of string name."
|
|
`(qml-set ,item/name ,(symbol-name property-name) ,value ,update))
|
|
|
|
(defmacro q< (property-name item/name)
|
|
"Convenience macro for QML-GET. Use symbol instead of string name."
|
|
`(qml-get ,item/name ,(symbol-name property-name)))
|
|
|
|
(defmacro q>* (property-name item/name value &optional update)
|
|
"Convenience macro for QML-SET-ALL. Use symbol instead of string name."
|
|
`(qml-set-all ,item/name ,(symbol-name property-name) ,value ,update))
|
|
|
|
;;; JS
|
|
|
|
(defun js (item/name js-format-string &rest arguments)
|
|
"Evaluates a JS string, with 'this' bound to either ITEM, or first object matching NAME. Arguments are passed through FORMAT. Use this function instead of the (faster) QJS if you need to evaluate generic JS code."
|
|
(qrun* (qlet ((qml-exp "QQmlExpression(QQmlContext*,QObject*,QString)"
|
|
(root-context)
|
|
(quick-item item/name)
|
|
(apply 'format nil js-format-string (mapcar 'js-arg arguments)))
|
|
(variant (|evaluate| qml-exp)))
|
|
(qvariant-value variant))))
|
|
|
|
(defun js-arg (object)
|
|
"Used for arguments in function JS."
|
|
(if (stringp object)
|
|
object
|
|
(with-output-to-string (*standard-output*)
|
|
(print-js-readably object))))
|
|
|
|
(defun %qjs (item/name function-name &rest arguments)
|
|
;; see 'ecl_fun.cpp::qjs_call()'
|
|
(qrun* (eql::qjs-call (quick-item item/name) function-name arguments)))
|
|
|
|
(defmacro qjs (function-name item/name &rest arguments)
|
|
"Fast and direct JS calls; max 10 arguments of type: T, NIL, INTEGER, FLOAT, STRING, (nested) LIST of mentioned types.
|
|
Examples:
|
|
(qjs |drawLine| *canvas* 0 0 100.0 100.0)
|
|
(qjs |addItems| *model* (list (list \"Frank\" 42) (list \"Susan\" 40)))"
|
|
`(%qjs ,item/name ,(symbol-name function-name) ,@arguments))
|
|
|
|
;;; ini
|
|
|
|
(defun ini-quick-view (file &optional widget)
|
|
(setf *quick-view* (qnew (if widget
|
|
"QQuickWidget" ; needed for 'PaintedItem'
|
|
"QQuickView")))
|
|
;; special settings for mobile, taken from Qt example
|
|
(let ((env (ext:getenv "QT_QUICK_CORE_PROFILE")))
|
|
(when (and (stringp env)
|
|
(not (zerop (parse-integer env :junk-allowed t))))
|
|
(let ((f (|format| *quick-view*)))
|
|
(|setProfile| f |QSurfaceFormat.CoreProfile|)
|
|
(|setVersion| f 4 4)
|
|
(|setFormat| *quick-view* f))))
|
|
(qconnect (|engine| *quick-view*) "quit()" 'qquit)
|
|
(qnew "QQmlFileSelector(QQmlEngine*,QObject*)" (|engine| *quick-view*) *quick-view*)
|
|
(|setSource| *quick-view* (file-to-url file))
|
|
(when (= |QQuickView.Error| (|status| *quick-view*))
|
|
;; display eventual QML errors
|
|
(qmsg (x:join (mapcar '|toString| (|errors| *quick-view*))
|
|
#.(make-string 2 :initial-element #\Newline))))
|
|
(|setResizeMode| *quick-view* |QQuickView.SizeRootObjectToView|)
|
|
(let ((platform (|platformName.QGuiApplication|)))
|
|
(if (find platform '("qnx" "eglfs") :test 'string=)
|
|
(|showFullScreen| *quick-view*)
|
|
(|show| *quick-view*))))
|
|
|
|
;;; for SailfishOS
|
|
|
|
(defun ini-sailfish (file/url &optional root quick-view (start-event-loop t))
|
|
"Pass either just the main QML file (during development), or all of: main QML url, root url, Sailfish QQuickView (in final app)."
|
|
(when (and root
|
|
(qt-object-p root)
|
|
(= (qid "QUrl") (qt-object-id root)))
|
|
(setf *root* (x:cc (|toString| root) "/")))
|
|
(setf *quick-view* (or quick-view (qnew "QQuickView")))
|
|
(qnew "QQmlFileSelector(QQmlEngine*,QObject*)" (|engine| *quick-view*) *quick-view*)
|
|
(|setSource| *quick-view* (if (stringp file/url)
|
|
(file-to-url file/url)
|
|
file/url))
|
|
(when (= |QQuickView.Error| (|status| *quick-view*))
|
|
;; display eventual QML errors (don't use QMSG, doesn't work on Sailfish)
|
|
(print (x:join (mapcar '|toString| (|errors| *quick-view*))
|
|
#.(make-string 2 :initial-element #\Newline))))
|
|
(|setResizeMode| *quick-view* |QQuickView.SizeRootObjectToView|)
|
|
(|show| *quick-view*)
|
|
(when (and quick-view start-event-loop)
|
|
(qexec)))
|
|
|