Comply to eql5-21.3.4 api
This commit is contained in:
Renaud Casenave-Péré
parent
fa79a7d0ff
commit
786d344823
6 changed files with 18 additions and 223 deletions
|
|
@ -11,19 +11,18 @@
|
|||
|
||||
LISP_FILES = make.lisp \
|
||||
lisp/dependencies.lisp \
|
||||
lisp/qml.lisp \
|
||||
lisp/app.lisp \
|
||||
lisp/app.asd
|
||||
|
||||
lisp.output = libapp.a
|
||||
lisp.commands = eql5 -platform minimal $$PWD/make.lisp
|
||||
lisp.input = LISP_FILES
|
||||
lisp.CONFIG = combine target_predeps
|
||||
|
||||
QMAKE_EXTRA_COMPILERS += lisp
|
||||
|
||||
# The name of your application
|
||||
TARGET = eql5-sfos
|
||||
PRE_TARGETDEPS += libapp.a
|
||||
|
||||
CONFIG += sailfishapp
|
||||
LIBS += -L. -lapp -lecl -leql5
|
||||
|
|
|
|||
|
|
@ -7,5 +7,4 @@
|
|||
(proclaim '(optimize (debug 3) (safety 3) (speed 0)))
|
||||
(funcall thunk))
|
||||
:depends-on ("alexandria")
|
||||
:components ((:file "qml")
|
||||
(:file "app")))
|
||||
:components ((:file "app")))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
(defpackage :app
|
||||
(:use :cl :eql :qml)
|
||||
(:use :cl :eql)
|
||||
(:export #:start-slynk
|
||||
#:stop-slynk
|
||||
#:start
|
||||
|
|
@ -27,26 +27,23 @@
|
|||
(defun start ()
|
||||
#+app-debug
|
||||
(start-slynk)
|
||||
(ini-quick-view (main-qml))
|
||||
(qconnect (qview) "statusChanged(QQuickView::Status)"
|
||||
(qconnect qml:*quick-view* "statusChanged(QQuickView::Status)"
|
||||
(lambda (status)
|
||||
(case status
|
||||
(#.|QQuickView.Ready|
|
||||
(qml-reloaded))
|
||||
(#.|QQuickView.Error|
|
||||
(qmsg (x:join (mapcar '|toString| (|errors| (qview)))
|
||||
#.(make-string 2 :initial-element #\Newline)))))))
|
||||
(qexec))
|
||||
(qml-reloaded))))))
|
||||
|
||||
(defun reload-qml (&optional (url "http://localhost:8000/"))
|
||||
"Reload QML file from an url, directly on the device."
|
||||
(qrun*
|
||||
(let ((src (|toString| (|source| (qview)))))
|
||||
(if (x:starts-with (concatenate 'string "file://" (path-to "")) src)
|
||||
(|setSource| (qview) (qnew "QUrl(QString)" (x:string-substitute url (concatenate 'string "file://" (path-to "")) src)))
|
||||
(reload))
|
||||
(|toString| (|source| (qview))))))
|
||||
(let ((src (|toString| (|source| qml:*quick-view*))))
|
||||
(if (x:starts-with (concatenate 'string "file://" qml:*root*) src)
|
||||
(|setSource| qml:*quick-view* (qnew "QUrl(QString)" (x:string-substitute url (concatenate 'string "file://" qml:*root*) src)))
|
||||
(qml:reload))
|
||||
(|toString| (|source| qml:*quick-view*)))))
|
||||
|
||||
(defun qml-reloaded ()
|
||||
;; re-ini
|
||||
)
|
||||
|
||||
(qlater #'start)
|
||||
|
|
|
|||
197
lisp/qml.lisp
197
lisp/qml.lisp
|
|
@ -1,197 +0,0 @@
|
|||
;;;
|
||||
;;; * 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)
|
||||
;;;
|
||||
|
||||
(defpackage :app/qml
|
||||
(:use :cl :eql)
|
||||
(:nicknames :qml)
|
||||
(:export
|
||||
#:*caller*
|
||||
#:children
|
||||
#:find-quick-item
|
||||
#:qview
|
||||
#:main-qml
|
||||
#:path-to
|
||||
#:ini-lib
|
||||
#:ini-quick-view
|
||||
#:js
|
||||
#:qml-call
|
||||
#:qml-get
|
||||
#:qml-set
|
||||
#:qml-set-all
|
||||
#:paint
|
||||
#:scale
|
||||
#:reload
|
||||
#:root-context
|
||||
#:root-item))
|
||||
(in-package :app/qml)
|
||||
|
||||
(defvar *caller* nil)
|
||||
|
||||
(let (quick-view path-to-main-qml qml-root)
|
||||
(defun ini-lib (view qml path)
|
||||
(setf quick-view view
|
||||
path-to-main-qml qml
|
||||
qml-root path))
|
||||
(defun qview () quick-view)
|
||||
(defun main-qml () path-to-main-qml)
|
||||
(defun path-to (res) (concatenate 'string qml-root "/" res)))
|
||||
|
||||
(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
|
||||
;; cut off Lisp specific notations
|
||||
(princ (string-right-trim "dl0" (princ-to-string object))))
|
||||
(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 (qview)
|
||||
(qrun* (if (= (qt-object-id (qview)) (qid "QQmlApplicationEngine"))
|
||||
(let ((object (first (|rootObjects| (qview)))))
|
||||
(setf (qt-object-id object) (qid "QObject")) ; unknown to EQL, so resort to QObject
|
||||
object)
|
||||
(qt-object-? (|rootObject| (qview)))))))
|
||||
|
||||
(defun root-context ()
|
||||
(when (qview)
|
||||
(|rootContext| (qview))))
|
||||
|
||||
(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| (qview)))
|
||||
|
||||
(defun reload ()
|
||||
"Force reloading of QML file after changes made to it."
|
||||
(|clearComponentCache| (|engine| (qview)))
|
||||
(|setSource| (qview) (|source| (qview))))
|
||||
|
||||
;;; 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* (qlet ((property "QQmlProperty(QObject*,QString)"
|
||||
(quick-item item/name)
|
||||
property-name))
|
||||
(if (|isValid| property)
|
||||
(qlet ((variant (|read| property)))
|
||||
(values (qvariant-value variant)
|
||||
t))
|
||||
(eql::%error-msg "QML-GET" (list 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* (let ((item (quick-item item/name)))
|
||||
(qlet ((property "QQmlProperty(QObject*,QString)" item property-name))
|
||||
(if (|isValid| property)
|
||||
(let ((type-name (|propertyTypeName| property)))
|
||||
(qlet ((variant (qvariant-from-value value (if (find #\: type-name) "int" type-name))))
|
||||
(prog1
|
||||
(|write| property variant)
|
||||
(when (and update (= (qt-object-id item) (qid "QQuickPaintedItem")))
|
||||
(|update| item)))))
|
||||
(eql::%error-msg "QML-SET" (list item/name property-name value)))))))
|
||||
|
||||
(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))))
|
||||
|
||||
;;; 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."
|
||||
(qrun* (qlet ((qml-exp "QQmlExpression(QQmlContext*,QObject*,QString)"
|
||||
(root-context)
|
||||
(quick-item item/name)
|
||||
(apply 'format nil js-format-string arguments))
|
||||
(variant (|evaluate| qml-exp)))
|
||||
(qvariant-value variant))))
|
||||
|
||||
;;; ini
|
||||
|
||||
(defun ini-quick-view (file)
|
||||
(when (qview)
|
||||
(qconnect (|engine| (qview)) "quit()" (qapp) "quit()")
|
||||
(qnew "QQmlFileSelector(QQmlEngine*,QObject*)" (|engine| (qview)) (qview))
|
||||
(|setSource| (qview) (|fromLocalFile.QUrl| file))
|
||||
(when (= |QQuickView.Error| (|status| (qview)))
|
||||
;; display eventual QML errors
|
||||
(qmsg (x:join (mapcar '|toString| (|errors| (qview)))
|
||||
#.(make-string 2 :initial-element #\Newline))))
|
||||
(let ((platform (|platformName.QGuiApplication|)))
|
||||
(if (string= platform "wayland")
|
||||
(|showFullScreen| (qview))
|
||||
(|show| (qview))))))
|
||||
|
|
@ -13,7 +13,7 @@
|
|||
:monolithic t
|
||||
:type :static-library
|
||||
:move-here "./"
|
||||
:init-name "init_lib_APP__ALL_SYSTEMS")
|
||||
:init-name "init_app")
|
||||
|
||||
(let ((lib-name "libapp.a"))
|
||||
(when (probe-file lib-name)
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@
|
|||
#include <QQuickView>
|
||||
#include <QTextCodec>
|
||||
|
||||
extern "C" void init_lib_APP__ALL_SYSTEMS (cl_object);
|
||||
extern "C" void init_app (cl_object);
|
||||
|
||||
int main(int argc, char *argv[])
|
||||
{
|
||||
|
|
@ -26,16 +26,13 @@ int main(int argc, char *argv[])
|
|||
|
||||
QScopedPointer<QGuiApplication> app (SailfishApp::application (argc, argv));
|
||||
QScopedPointer<QQuickView> view (SailfishApp::createView ());
|
||||
QUrl mainQml = SailfishApp::pathToMainQml ();
|
||||
QUrl resRoot = SailfishApp::pathTo ("");
|
||||
|
||||
QTextCodec* utf8 = QTextCodec::codecForName("UTF-8");
|
||||
QTextCodec::setCodecForLocale(utf8);
|
||||
|
||||
EQL eql;
|
||||
eql.exec (init_lib_APP__ALL_SYSTEMS);
|
||||
eql_fun ("app/qml:ini-lib", Q_ARG (QQuickView*, view.data ()),
|
||||
Q_ARG (const char*, mainQml.toLocalFile ().toLatin1 ().constData ()),
|
||||
Q_ARG (const char*, resRoot.toLocalFile ().toLatin1 ().constData ()));
|
||||
EQL::eval ("(app:start)");
|
||||
eql.exec (init_app);
|
||||
eql_fun ("qml:ini-sailfish", Q_ARG (QUrl, SailfishApp::pathToMainQml ()),
|
||||
Q_ARG (QUrl, SailfishApp::pathTo ("")),
|
||||
Q_ARG (QQuickView*, view.data ()), Q_ARG(bool, true));
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue