diff --git a/examples/X-extras/9999/9999.jpg b/examples/X-extras/9999/9999.jpg new file mode 100644 index 0000000..59c3b2b Binary files /dev/null and b/examples/X-extras/9999/9999.jpg differ diff --git a/examples/X-extras/9999/README.txt b/examples/X-extras/9999/README.txt new file mode 100644 index 0000000..6d1c5df --- /dev/null +++ b/examples/X-extras/9999/README.txt @@ -0,0 +1,3 @@ +simple canvas example: draw in JS, calculate in Lisp + +see also: https://en.wikipedia.org/wiki/Cistercian_numerals diff --git a/examples/X-extras/9999/lisp/main.lisp b/examples/X-extras/9999/lisp/main.lisp new file mode 100644 index 0000000..72211d7 --- /dev/null +++ b/examples/X-extras/9999/lisp/main.lisp @@ -0,0 +1,54 @@ +;;; +;;; 1 +;;; ------- +;;; 5 \ / | +;;; X | 2 +;;; 4 / \ | +;;; ------- +;;; 3 + +(in-package :eql-user) + +(use-package :qml) + +(defvar *number* 0) +(defvar *canvas* "canvas") + +(defun draw-line (x1 y1 x2 y2) + (js *canvas* "drawLine(~D, ~D, ~D, ~D)" + x1 y1 x2 y2)) + +(defun draw-number (number) + (setf *number* number) + (q! |requestPaint| *canvas*)) + +(defun paint () + (draw-line 0 -150 0 150) + (let ((dy -50) + (dig 1)) + (labels ((line (x1 y1 x2 y2) + (when (find dig '(2 4)) + (setf x1 (- x1) + x2 (- x2))) + (when (>= dig 3) + (setf y1 (- y1) + y2 (- y2) + dy 50)) + (draw-line (* 100 x1) (+ dy (* 100 y1)) + (* 100 x2) (+ dy (* 100 y2)))) + (draw (n) + (case n + (1 (line 0 -1 1 -1)) + (2 (line 0 0 1 0)) + (3 (line 0 -1 1 0)) + (4 (line 0 0 1 -1)) + (5 (draw 1) (draw 4)) + (6 (line 1 -1 1 0)) + (7 (draw 1) (draw 6)) + (8 (draw 2) (draw 6)) + (9 (draw 1) (draw 8))))) + (let ((num *number*)) + (x:while (plusp num) + (draw (mod num 10)) + (setf num (floor (/ num 10))) + (incf dig)))))) diff --git a/examples/X-extras/9999/lisp/qml-lisp.lisp b/examples/X-extras/9999/lisp/qml-lisp.lisp new file mode 100644 index 0000000..58c1e29 --- /dev/null +++ b/examples/X-extras/9999/lisp/qml-lisp.lisp @@ -0,0 +1,233 @@ +;;; +;;; * 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 :qml-lisp + (:use :common-lisp :eql) + (:nicknames :qml) + (:export + #:*quick-view* + #:*caller* + #:children + #:file-to-url + #:find-quick-item + #:ini-quick-view + #:js + #:js-arg + #:qml-call + #:qml-get + #:qml-set + #:qml-set-all + #:q! + #:q< + #:q> + #:q>* + #:paint + #:scale + #:reload + #:root-context + #:root-item)) + +(provide :qml-lisp) + +(in-package :qml-lisp) + +(defvar *quick-view* nil) +(defvar *caller* 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 + ;; 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 *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." + #+release + (qnew "QUrl(QString)" (x:cc "qrc:/" file)) ; see "Qt Resource System" + #-release + (|fromLocalFile.QUrl| file)) + +;;; 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)))) + +(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." + (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)))) + +(defun js-arg (object) + "To be used for arguments in function JS." + (with-output-to-string (*standard-output*) + (print-js-readably object))) + +;;; ini + +(defun ini-quick-view (file) + (setf *quick-view* (qnew "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()" (qapp) "quit()") + (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*)))) + diff --git a/examples/X-extras/9999/qml/main.qml b/examples/X-extras/9999/qml/main.qml new file mode 100644 index 0000000..53f0882 --- /dev/null +++ b/examples/X-extras/9999/qml/main.qml @@ -0,0 +1,49 @@ +import QtQuick 2.10 +import QtQuick.Controls 2.10 +import EQL5 1.0 + +Rectangle { + width: 220 + height: 320 + input.height + color: "lavender" + + Canvas { + id: canvas + objectName: "canvas" + width: 220 + height: 320 + + property var painter + + function drawLine(x1, y1, x2, y2) { + painter.moveTo(x1, y1) + painter.lineTo(x2, y2) + } + + onPaint: { + var ctx = getContext("2d") + painter = ctx + ctx.reset() + ctx.strokeStyle = "blue" + ctx.lineWidth = 10 + ctx.translate(110, 160) + + Lisp.call("eql-user:paint") + + ctx.stroke() + } + } + + TextField { + id: input + objectName: "input" + width: parent.width + anchors.bottom: parent.bottom + horizontalAlignment: Qt.AlignHCenter + maximumLength: 4 + text: "0000" + inputMask: "9999" + + onTextChanged: Lisp.call("eql-user:draw-number", Number(text)) + } +} diff --git a/examples/X-extras/9999/run.lisp b/examples/X-extras/9999/run.lisp new file mode 100644 index 0000000..52a39a2 --- /dev/null +++ b/examples/X-extras/9999/run.lisp @@ -0,0 +1,15 @@ +(in-package :eql-user) + +(si::trap-fpe t nil) + +(qrequire :quick) + +(load "lisp/qml-lisp") +(load "lisp/main") + +(use-package :qml) + +(progn + (ini-quick-view "qml/main.qml") + (|setPosition| *quick-view* '(50 50))) +