mirror of
https://gitlab.com/eql/EQL5.git
synced 2025-12-06 10:31:19 -08:00
replace deprecated ECL C names; revisions; integrate QML into the library ('qml-lisp.lisp' is obsolete now);
This commit is contained in:
polos
parent
8d3bc5234f
commit
799cc1de36
25 changed files with 358 additions and 1854 deletions
|
|
@ -4,7 +4,6 @@
|
|||
|
||||
(qrequire :quick)
|
||||
|
||||
(load "lisp/qml-lisp")
|
||||
(load "lisp/main")
|
||||
|
||||
(use-package :qml)
|
||||
|
|
|
|||
|
|
@ -1,215 +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 :qml-lisp
|
||||
(:use :common-lisp :eql)
|
||||
(:nicknames :qml)
|
||||
(:export
|
||||
#:*quick-view*
|
||||
#:*caller*
|
||||
#:children
|
||||
#:find-quick-item
|
||||
#:js
|
||||
#:js-arg
|
||||
#:qml-call
|
||||
#:qml-get
|
||||
#:qml-set
|
||||
#:qml-set-all
|
||||
#:q!
|
||||
#:q<
|
||||
#:q>
|
||||
#:q>*
|
||||
#:qjs
|
||||
#: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
|
||||
;; 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*
|
||||
(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'."
|
||||
(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*)))
|
||||
|
||||
;;; call QML methods
|
||||
|
||||
(defun qml-call (item/name method-name &rest arguments)
|
||||
;; QFUN+ comes in handy here
|
||||
(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."
|
||||
(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."
|
||||
(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))
|
||||
(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."
|
||||
(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)))
|
||||
|
||||
(defun %qjs (item/name function-name &rest arguments)
|
||||
;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp'
|
||||
(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 |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))"
|
||||
`(%qjs ,item/name ,(symbol-name function-name) ,@arguments))
|
||||
|
||||
|
||||
|
|
@ -7,7 +7,6 @@
|
|||
|
||||
(qrequire :quick)
|
||||
|
||||
(require :qml-lisp "qml-lisp")
|
||||
(require :game-logic "game-logic")
|
||||
(require :properties "properties")
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,6 @@
|
|||
|
||||
(qrequire :quick)
|
||||
|
||||
(require :qml-lisp "qml-lisp")
|
||||
(require :properties "properties")
|
||||
|
||||
(use-package :qml)
|
||||
|
|
|
|||
|
|
@ -2,7 +2,6 @@
|
|||
|
||||
(qrequire :quick)
|
||||
|
||||
(require :qml-lisp "qml-lisp")
|
||||
(require :properties "properties")
|
||||
|
||||
(use-package :qml)
|
||||
|
|
|
|||
|
|
@ -1,215 +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 :qml-lisp
|
||||
(:use :common-lisp :eql)
|
||||
(:nicknames :qml)
|
||||
(:export
|
||||
#:*quick-view*
|
||||
#:*caller*
|
||||
#:children
|
||||
#:find-quick-item
|
||||
#:js
|
||||
#:js-arg
|
||||
#:qml-call
|
||||
#:qml-get
|
||||
#:qml-set
|
||||
#:qml-set-all
|
||||
#:q!
|
||||
#:q<
|
||||
#:q>
|
||||
#:q>*
|
||||
#:qjs
|
||||
#: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
|
||||
;; 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*
|
||||
(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'."
|
||||
(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*)))
|
||||
|
||||
;;; call QML methods
|
||||
|
||||
(defun qml-call (item/name method-name &rest arguments)
|
||||
;; QFUN+ comes in handy here
|
||||
(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."
|
||||
(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."
|
||||
(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))
|
||||
(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."
|
||||
(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)))
|
||||
|
||||
(defun %qjs (item/name function-name &rest arguments)
|
||||
;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp'
|
||||
(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 |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))"
|
||||
`(%qjs ,item/name ,(symbol-name function-name) ,@arguments))
|
||||
|
||||
|
||||
|
|
@ -5,7 +5,6 @@
|
|||
|
||||
(qrequire :quick)
|
||||
|
||||
(require :qml-lisp "qml-lisp")
|
||||
(require :clock "clock")
|
||||
(require :properties "properties")
|
||||
|
||||
|
|
|
|||
|
|
@ -1,215 +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 :qml-lisp
|
||||
(:use :common-lisp :eql)
|
||||
(:nicknames :qml)
|
||||
(:export
|
||||
#:*quick-view*
|
||||
#:*caller*
|
||||
#:children
|
||||
#:find-quick-item
|
||||
#:js
|
||||
#:js-arg
|
||||
#:qml-call
|
||||
#:qml-get
|
||||
#:qml-set
|
||||
#:qml-set-all
|
||||
#:q!
|
||||
#:q<
|
||||
#:q>
|
||||
#:q>*
|
||||
#:qjs
|
||||
#: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
|
||||
;; 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*
|
||||
(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'."
|
||||
(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*)))
|
||||
|
||||
;;; call QML methods
|
||||
|
||||
(defun qml-call (item/name method-name &rest arguments)
|
||||
;; QFUN+ comes in handy here
|
||||
(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."
|
||||
(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."
|
||||
(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))
|
||||
(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."
|
||||
(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)))
|
||||
|
||||
(defun %qjs (item/name function-name &rest arguments)
|
||||
;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp'
|
||||
(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 |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))"
|
||||
`(%qjs ,item/name ,(symbol-name function-name) ,@arguments))
|
||||
|
||||
|
||||
|
|
@ -2,7 +2,6 @@
|
|||
|
||||
(qrequire :quick)
|
||||
|
||||
(require :qml-lisp "qml-lisp")
|
||||
(require :properties "properties")
|
||||
(require :utils "utils")
|
||||
|
||||
|
|
|
|||
|
|
@ -1,215 +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 :qml-lisp
|
||||
(:use :common-lisp :eql)
|
||||
(:nicknames :qml)
|
||||
(:export
|
||||
#:*quick-view*
|
||||
#:*caller*
|
||||
#:children
|
||||
#:find-quick-item
|
||||
#:js
|
||||
#:js-arg
|
||||
#:qml-call
|
||||
#:qml-get
|
||||
#:qml-set
|
||||
#:qml-set-all
|
||||
#:q!
|
||||
#:q<
|
||||
#:q>
|
||||
#:q>*
|
||||
#:qjs
|
||||
#: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
|
||||
;; 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*
|
||||
(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'."
|
||||
(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*)))
|
||||
|
||||
;;; call QML methods
|
||||
|
||||
(defun qml-call (item/name method-name &rest arguments)
|
||||
;; QFUN+ comes in handy here
|
||||
(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."
|
||||
(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."
|
||||
(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))
|
||||
(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."
|
||||
(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)))
|
||||
|
||||
(defun %qjs (item/name function-name &rest arguments)
|
||||
;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp'
|
||||
(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 |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))"
|
||||
`(%qjs ,item/name ,(symbol-name function-name) ,@arguments))
|
||||
|
||||
|
||||
|
|
@ -4,7 +4,6 @@
|
|||
|
||||
(qrequire :quick)
|
||||
|
||||
(require :qml-lisp "qml-lisp")
|
||||
(require :properties "properties")
|
||||
|
||||
(use-package :qml)
|
||||
|
|
|
|||
|
|
@ -1,215 +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 :qml-lisp
|
||||
(:use :common-lisp :eql)
|
||||
(:nicknames :qml)
|
||||
(:export
|
||||
#:*quick-view*
|
||||
#:*caller*
|
||||
#:children
|
||||
#:find-quick-item
|
||||
#:js
|
||||
#:js-arg
|
||||
#:qml-call
|
||||
#:qml-get
|
||||
#:qml-set
|
||||
#:qml-set-all
|
||||
#:q!
|
||||
#:q<
|
||||
#:q>
|
||||
#:q>*
|
||||
#:qjs
|
||||
#: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
|
||||
;; 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*
|
||||
(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'."
|
||||
(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*)))
|
||||
|
||||
;;; call QML methods
|
||||
|
||||
(defun qml-call (item/name method-name &rest arguments)
|
||||
;; QFUN+ comes in handy here
|
||||
(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."
|
||||
(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."
|
||||
(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))
|
||||
(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."
|
||||
(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)))
|
||||
|
||||
(defun %qjs (item/name function-name &rest arguments)
|
||||
;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp'
|
||||
(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 |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))"
|
||||
`(%qjs ,item/name ,(symbol-name function-name) ,@arguments))
|
||||
|
||||
|
||||
|
|
@ -32,7 +32,8 @@ Item {
|
|||
console.log(Lisp.call("x:join", ["11", "55"], ":"))
|
||||
|
||||
// (4) nested list arguments
|
||||
// N.B: don't get fooled by the printed representation of the return value:
|
||||
// N.B: don't get fooled by the printed representation of the return value
|
||||
// (affects older Qt versions only):
|
||||
// it's a nested JS array internally (".length" will give 3)
|
||||
console.log(Lisp.call("list", [[1, 2, 3], ["a", "b", "c"], 4, 5], 6, [[7, 8], 9]))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,215 +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 :qml-lisp
|
||||
(:use :common-lisp :eql)
|
||||
(:nicknames :qml)
|
||||
(:export
|
||||
#:*quick-view*
|
||||
#:*caller*
|
||||
#:children
|
||||
#:find-quick-item
|
||||
#:js
|
||||
#:js-arg
|
||||
#:qml-call
|
||||
#:qml-get
|
||||
#:qml-set
|
||||
#:qml-set-all
|
||||
#:q!
|
||||
#:q<
|
||||
#:q>
|
||||
#:q>*
|
||||
#:qjs
|
||||
#: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
|
||||
;; 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*
|
||||
(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'."
|
||||
(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*)))
|
||||
|
||||
;;; call QML methods
|
||||
|
||||
(defun qml-call (item/name method-name &rest arguments)
|
||||
;; QFUN+ comes in handy here
|
||||
(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."
|
||||
(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."
|
||||
(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))
|
||||
(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."
|
||||
(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)))
|
||||
|
||||
(defun %qjs (item/name function-name &rest arguments)
|
||||
;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp'
|
||||
(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 |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))"
|
||||
`(%qjs ,item/name ,(symbol-name function-name) ,@arguments))
|
||||
|
||||
|
||||
|
|
@ -8,7 +8,6 @@
|
|||
|
||||
(require :sokoban "lisp/3rd-party/sokoban")
|
||||
(require :levels "lisp/3rd-party/my-levels")
|
||||
(require :qml-lisp "lisp/qml-lisp")
|
||||
(require :ui-vars "lisp/ui-vars.lisp")
|
||||
|
||||
(defpackage :qsoko
|
||||
|
|
|
|||
|
|
@ -1,215 +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 :qml-lisp
|
||||
(:use :common-lisp :eql)
|
||||
(:nicknames :qml)
|
||||
(:export
|
||||
#:*quick-view*
|
||||
#:*caller*
|
||||
#:children
|
||||
#:find-quick-item
|
||||
#:js
|
||||
#:js-arg
|
||||
#:qml-call
|
||||
#:qml-get
|
||||
#:qml-set
|
||||
#:qml-set-all
|
||||
#:q!
|
||||
#:q<
|
||||
#:q>
|
||||
#:q>*
|
||||
#:qjs
|
||||
#: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
|
||||
;; 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*
|
||||
(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'."
|
||||
(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*)))
|
||||
|
||||
;;; call QML methods
|
||||
|
||||
(defun qml-call (item/name method-name &rest arguments)
|
||||
;; QFUN+ comes in handy here
|
||||
(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."
|
||||
(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."
|
||||
(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))
|
||||
(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."
|
||||
(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)))
|
||||
|
||||
(defun %qjs (item/name function-name &rest arguments)
|
||||
;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp'
|
||||
(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 |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))"
|
||||
`(%qjs ,item/name ,(symbol-name function-name) ,@arguments))
|
||||
|
||||
|
||||
|
|
@ -5,7 +5,6 @@
|
|||
|
||||
(qrequire :quick)
|
||||
|
||||
(require :qml-lisp "qml-lisp")
|
||||
(require :properties "properties")
|
||||
|
||||
(defpackage :table-view
|
||||
|
|
|
|||
539
src/ecl_fun.cpp
539
src/ecl_fun.cpp
File diff suppressed because it is too large
Load diff
|
|
@ -22,28 +22,28 @@ QT_BEGIN_NAMESPACE
|
|||
static const int constant = qRegisterMetaType< type >(#type);
|
||||
|
||||
#define DEFUN(name, c_name, num_args) \
|
||||
ecl_def_c_function(c_string_to_object((char*)name), (cl_objectfn_fixed)c_name, num_args);
|
||||
ecl_def_c_function(ecl_read_from_cstring((char*)name), (cl_objectfn_fixed)c_name, num_args);
|
||||
|
||||
#define STRING(s) make_constant_base_string((char*)s)
|
||||
#define STRING(s) ecl_make_constant_base_string((char*)s, -1)
|
||||
|
||||
#define STRING_COPY(s) (s ? make_base_string_copy((char*)s) : Cnil)
|
||||
#define STRING_COPY(s) (s ? ecl_make_simple_base_string((char*)s, -1) : ECL_NIL)
|
||||
|
||||
#define PRINT(x) cl_print(1, x)
|
||||
|
||||
#define TERPRI() cl_terpri(0)
|
||||
|
||||
#define STATIC_SYMBOL(var, name) \
|
||||
static cl_object var = cl_intern(1, make_constant_base_string((char*)name));
|
||||
static cl_object var = cl_intern(1, ecl_make_constant_base_string((char*)name, -1));
|
||||
|
||||
#define STATIC_SYMBOL_PKG(var, name, pkg) \
|
||||
static cl_object var = cl_intern(2, \
|
||||
make_constant_base_string((char*)name), \
|
||||
cl_find_package(make_constant_base_string((char*)pkg)));
|
||||
ecl_make_constant_base_string((char*)name, -1), \
|
||||
cl_find_package(ecl_make_constant_base_string((char*)pkg, -1)));
|
||||
|
||||
#define LEN(x) fixint(cl_length(x))
|
||||
|
||||
#define LIST1(a1) \
|
||||
CONS(a1, Cnil)
|
||||
CONS(a1, ECL_NIL)
|
||||
#define LIST2(a1, a2) \
|
||||
CONS(a1, LIST1(a2))
|
||||
#define LIST3(a1, a2, a3) \
|
||||
|
|
@ -97,7 +97,7 @@ static cap_name* to##cap_name##Pointer(cl_object x) { \
|
|||
p = (cap_name*)o.pointer; } \
|
||||
return p; } \
|
||||
static cl_object from_##name(const cap_name& x) { \
|
||||
cl_object l_ret = Cnil; \
|
||||
cl_object l_ret = ECL_NIL; \
|
||||
if(EQL::return_value_p) { \
|
||||
l_ret = qt_object_from_name(#cap_name, new cap_name(x), 0, true); } \
|
||||
else { \
|
||||
|
|
@ -106,7 +106,7 @@ static cl_object from_##name(const cap_name& x) { \
|
|||
|
||||
#define FROM_QT_TYPE_ONLY(cap_name, name) \
|
||||
static cl_object from_##name(const cap_name& x) { \
|
||||
cl_object l_ret = Cnil; \
|
||||
cl_object l_ret = ECL_NIL; \
|
||||
if(EQL::return_value_p) { \
|
||||
l_ret = qt_object_from_name(#cap_name, new cap_name(x), 0, true); } \
|
||||
else { \
|
||||
|
|
@ -123,7 +123,7 @@ static cap_name to##cap_name(cl_object l_x) { \
|
|||
|
||||
#define TO_CL_TYPE(cap_name, name, x1, x2) \
|
||||
static cl_object from_##name(const cap_name& q) { \
|
||||
cl_object l_ret = LIST2(MAKE_FIXNUM(q.x1()), MAKE_FIXNUM(q.x2())); \
|
||||
cl_object l_ret = LIST2(ecl_make_fixnum(q.x1()), ecl_make_fixnum(q.x2())); \
|
||||
return l_ret; }
|
||||
|
||||
#define TO_CL_TYPEF(cap_name, name, x1, x2) \
|
||||
|
|
@ -134,7 +134,7 @@ static cap_name to##cap_name(cl_object l_x) { \
|
|||
|
||||
#define TO_CL_TYPE2(cap_name, name, x1, x2, x3, x4) \
|
||||
static cl_object from_##name(const cap_name& q) { \
|
||||
cl_object l_ret = LIST4(MAKE_FIXNUM(q.x1()), MAKE_FIXNUM(q.x2()), MAKE_FIXNUM(q.x3()), MAKE_FIXNUM(q.x4())); \
|
||||
cl_object l_ret = LIST4(ecl_make_fixnum(q.x1()), ecl_make_fixnum(q.x2()), ecl_make_fixnum(q.x3()), ecl_make_fixnum(q.x4())); \
|
||||
return l_ret; }
|
||||
|
||||
#define TO_CL_TYPEF2(cap_name, name, x1, x2, x3, x4) \
|
||||
|
|
@ -145,7 +145,7 @@ static cap_name to##cap_name(cl_object l_x) { \
|
|||
|
||||
#define TO_CL_LIST_PTR(cap_type, type) \
|
||||
static cl_object from_##type##list(const QList<cap_type*>& l) { \
|
||||
cl_object l_list = Cnil; \
|
||||
cl_object l_list = ECL_NIL; \
|
||||
Q_FOREACH(cap_type* x, l) { \
|
||||
l_list = CONS(qt_object_from_name(#cap_type, x), l_list); } \
|
||||
l_list = cl_nreverse(l_list); \
|
||||
|
|
@ -153,7 +153,7 @@ static cap_name to##cap_name(cl_object l_x) { \
|
|||
|
||||
#define TO_CL_LIST_VAL(cap_type, type) \
|
||||
static cl_object from_##type##list(const QList<cap_type>& l) { \
|
||||
cl_object l_list = Cnil; \
|
||||
cl_object l_list = ECL_NIL; \
|
||||
Q_FOREACH(cap_type x, l) { \
|
||||
l_list = CONS(from_##type(x), l_list); } \
|
||||
l_list = cl_nreverse(l_list); \
|
||||
|
|
@ -161,7 +161,7 @@ static cap_name to##cap_name(cl_object l_x) { \
|
|||
|
||||
#define TO_CL_LIST_VAL2(cap_type, fun) \
|
||||
static cl_object from_##type##list(const QList<cap_type*>& l) { \
|
||||
cl_object l_list = Cnil; \
|
||||
cl_object l_list = ECL_NIL; \
|
||||
Q_FOREACH(cap_type* x, l) { \
|
||||
l_list = CONS(fun(*x), l_list); } \
|
||||
l_list = cl_nreverse(l_list); \
|
||||
|
|
@ -172,7 +172,7 @@ static cap_name to##cap_name(cl_object l_x) { \
|
|||
QList<type*> l; \
|
||||
if(LISTP(l_list)) { \
|
||||
cl_object l_el = l_list; \
|
||||
while(l_el != Cnil) { \
|
||||
while(l_el != ECL_NIL) { \
|
||||
l << (type*)toQtObject(cl_car(l_el)).pointer; \
|
||||
l_el = cl_cdr(l_el); }} \
|
||||
return l; }
|
||||
|
|
@ -182,7 +182,7 @@ static cap_name to##cap_name(cl_object l_x) { \
|
|||
QList<type> l; \
|
||||
if(LISTP(l_list)) { \
|
||||
cl_object l_el = l_list; \
|
||||
while(l_el != Cnil) { \
|
||||
while(l_el != ECL_NIL) { \
|
||||
l << to##type(cl_car(l_el)); \
|
||||
l_el = cl_cdr(l_el); }} \
|
||||
return l; }
|
||||
|
|
@ -192,7 +192,7 @@ static cap_name to##cap_name(cl_object l_x) { \
|
|||
QList<type> l; \
|
||||
if(LISTP(l_list)) { \
|
||||
cl_object l_el = l_list; \
|
||||
while(l_el != Cnil) { \
|
||||
while(l_el != ECL_NIL) { \
|
||||
l << to##fun(cl_car(l_el)); \
|
||||
l_el = cl_cdr(l_el); }} \
|
||||
return l; }
|
||||
|
|
@ -200,17 +200,17 @@ static cap_name to##cap_name(cl_object l_x) { \
|
|||
#define TO_QT_VECTOR_VAL(type) \
|
||||
static QVector<type> to##type##Vector(cl_object l_v) { \
|
||||
QVector<type> v; \
|
||||
if(cl_simple_vector_p(l_v) == Ct) { \
|
||||
if(cl_simple_vector_p(l_v) == ECL_T) { \
|
||||
for(int i = 0; i < LEN(l_v); ++i) { \
|
||||
v.append(to##type(cl_svref(l_v, MAKE_FIXNUM(i)))); }} \
|
||||
v.append(to##type(cl_svref(l_v, ecl_make_fixnum(i)))); }} \
|
||||
return v; }
|
||||
|
||||
#define TO_QT_VECTOR_VAL2(type, fun) \
|
||||
static QVector<type> to##type##Vector(cl_object l_v) { \
|
||||
QVector<type> v; \
|
||||
if(cl_simple_vector_p(l_v) == Ct) { \
|
||||
if(cl_simple_vector_p(l_v) == ECL_T) { \
|
||||
for(int i = 0; i < LEN(l_v); ++i) { \
|
||||
v.append(to##fun(cl_svref(l_v, MAKE_FIXNUM(i)))); }} \
|
||||
v.append(to##fun(cl_svref(l_v, ecl_make_fixnum(i)))); }} \
|
||||
return v; }
|
||||
|
||||
#define TO_CL_VECTOR_VAL(cap_type, type) \
|
||||
|
|
@ -265,6 +265,8 @@ cl_object qload_ui (cl_object);
|
|||
cl_object qlocal8bit (cl_object);
|
||||
cl_object qlog2 (cl_object);
|
||||
cl_object qmeta_enums ();
|
||||
cl_object qml_get2 (cl_object, cl_object);
|
||||
cl_object qml_set2 (cl_object, cl_object, cl_object);
|
||||
cl_object qnew_instance2 (cl_object, cl_object);
|
||||
cl_object qobject_names2 (cl_object);
|
||||
cl_object qok ();
|
||||
|
|
@ -338,7 +340,7 @@ cl_object to_lisp_arg(const MetaArg&);
|
|||
|
||||
EQL_EXPORT QVariant callOverrideFun(void*, int, const void**, quint64);
|
||||
EQL_EXPORT cl_object qt_object_from_name(const QByteArray&, void*, uint = 0, bool = false);
|
||||
EQL_EXPORT QtObject toQtObject(cl_object, cl_object = Cnil, bool* = 0, bool = false);
|
||||
EQL_EXPORT QtObject toQtObject(cl_object, cl_object = ECL_NIL, bool* = 0, bool = false);
|
||||
|
||||
QT_END_NAMESPACE
|
||||
|
||||
|
|
|
|||
12
src/eql.cpp
12
src/eql.cpp
|
|
@ -9,7 +9,7 @@
|
|||
#include <QStringList>
|
||||
#include <QDebug>
|
||||
|
||||
const char EQL::version[] = "21.3.1"; // March 2021
|
||||
const char EQL::version[] = "21.3.2"; // March 2021
|
||||
|
||||
extern "C" void ini_EQL(cl_object);
|
||||
|
||||
|
|
@ -45,7 +45,7 @@ EQL::EQL() : QObject() {
|
|||
cl_boot(1, (char**)_argv_); }
|
||||
iniCLFunctions();
|
||||
LObjects::ini(this);
|
||||
read_VV(OBJNULL, ini_EQL); } // see "src/make.lisp"
|
||||
ecl_init_module(NULL, ini_EQL); } // see "src/make.lisp"
|
||||
|
||||
void EQL::ini(char** argv) {
|
||||
cl_booted = true;
|
||||
|
|
@ -88,7 +88,7 @@ void EQL::ignoreIOStreams() {
|
|||
eval("(eql::ignore-io-streams)"); }
|
||||
|
||||
void EQL::exec(const QStringList& args) {
|
||||
cl_object s_qtpl = cl_intern(1, make_constant_base_string("*QTPL*"));
|
||||
cl_object s_qtpl = cl_intern(1, ecl_make_constant_base_string("*QTPL*", -1));
|
||||
bool exec_with_simple_restart = false;
|
||||
QStringList arguments(args);
|
||||
eval("(in-package :eql-user)");
|
||||
|
|
@ -121,10 +121,10 @@ void EQL::exec(const QStringList& args) {
|
|||
arguments << swankFile; }
|
||||
exec_with_simple_restart = true; }
|
||||
// -qtpl
|
||||
else if(arguments.contains("-qtpl") || (cl_symbol_value(s_qtpl) == Ct)) {
|
||||
else if(arguments.contains("-qtpl") || (cl_symbol_value(s_qtpl) == ECL_T)) {
|
||||
arguments.removeAll("-qtpl");
|
||||
evalMode = DebugOnError;
|
||||
ecl_setq(ecl_process_env(), s_qtpl, Ct);
|
||||
ecl_setq(ecl_process_env(), s_qtpl, ECL_T);
|
||||
QApplication::setQuitOnLastWindowClosed(false);
|
||||
forms << "(when (directory (in-home \"lib/ecl-readline.fas*\"))"
|
||||
" (load (x:check-recompile (in-home \"lib/ecl-readline\"))))"
|
||||
|
|
@ -179,7 +179,7 @@ void EQL::exec(const QStringList& args) {
|
|||
|
||||
void EQL::exec(lisp_ini ini, const QByteArray& expression, const QByteArray& package) {
|
||||
// see my_app example
|
||||
read_VV(OBJNULL, ini);
|
||||
ecl_init_module(NULL, ini);
|
||||
eval(QString("(in-package :%1)").arg(QString(package)).toLatin1().constData());
|
||||
eval(expression.constData()); }
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
QT += widgets printsupport uitools
|
||||
QT += widgets printsupport uitools qml
|
||||
TEMPLATE = lib
|
||||
CONFIG += dll no_keywords release
|
||||
DEFINES += EQL_LIBRARY
|
||||
|
|
|
|||
|
|
@ -1,5 +1,7 @@
|
|||
;;; copyright (c) Polos Ruetz
|
||||
|
||||
(si::trap-fpe t nil) ; ignore floating point exceptions (they happen on Qt side)
|
||||
|
||||
(ffi:clines "#include <stdlib.h>")
|
||||
|
||||
(in-package :eql)
|
||||
|
|
|
|||
|
|
@ -116,5 +116,33 @@
|
|||
(defpackage :eql-user
|
||||
(:use :common-lisp :eql))
|
||||
|
||||
(defpackage :qml-lisp
|
||||
(:use :common-lisp :eql)
|
||||
(:nicknames :qml)
|
||||
(:export
|
||||
#:*quick-view*
|
||||
#:*root*
|
||||
#:*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>*
|
||||
#:qjs
|
||||
#:paint
|
||||
#:scale
|
||||
#:reload
|
||||
#:root-context
|
||||
#:root-item))
|
||||
|
||||
(pushnew :eql *features*)
|
||||
(pushnew :eql5 *features*)
|
||||
|
|
|
|||
|
|
@ -38,6 +38,7 @@
|
|||
|
||||
(defvar *quick-view* nil)
|
||||
(defvar *caller* nil)
|
||||
(defvar *root* nil)
|
||||
|
||||
(defun string-to-symbol (name)
|
||||
(let ((upper (string-upcase name))
|
||||
|
|
@ -135,10 +136,10 @@
|
|||
|
||||
(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))
|
||||
(if (probe-file file)
|
||||
(|fromLocalFile.QUrl| file)
|
||||
(qnew "QUrl(QString)"
|
||||
(x:cc (or *root* "qrc:/") file)))) ; see "Qt Resource System"
|
||||
|
||||
;;; call QML methods
|
||||
|
||||
|
|
@ -150,27 +151,14 @@
|
|||
|
||||
(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))))))
|
||||
(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* (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)
|
||||
(qrun* (prog1
|
||||
(eql::%qml-set (quick-item item/name) property-name value)
|
||||
(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."
|
||||
|
|
@ -201,24 +189,26 @@
|
|||
(qrun* (qlet ((qml-exp "QQmlExpression(QQmlContext*,QObject*,QString)"
|
||||
(root-context)
|
||||
(quick-item item/name)
|
||||
(apply 'format nil js-format-string arguments))
|
||||
(apply 'format nil js-format-string (mapcar 'js-arg arguments)))
|
||||
(variant (|evaluate| qml-exp)))
|
||||
(qvariant-value variant))))
|
||||
|
||||
(defun js-arg (object)
|
||||
"To be used for arguments in function JS."
|
||||
"Used for arguments in function JS."
|
||||
(if (stringp object)
|
||||
object
|
||||
(with-output-to-string (*standard-output*)
|
||||
(print-js-readably object)))
|
||||
(print-js-readably object))))
|
||||
|
||||
(defun %qjs (item/name function-name &rest arguments)
|
||||
;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp'
|
||||
(eql::qjs-call (quick-item item/name) function-name arguments))
|
||||
(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 |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))"
|
||||
(qjs |addItems| *model* (list (list \"Frank\" 42) (list \"Susan\" 40)))"
|
||||
`(%qjs ,item/name ,(symbol-name function-name) ,@arguments))
|
||||
|
||||
;;; ini
|
||||
|
|
@ -233,7 +223,7 @@
|
|||
(|setProfile| f |QSurfaceFormat.CoreProfile|)
|
||||
(|setVersion| f 4 4)
|
||||
(|setFormat| *quick-view* f))))
|
||||
(qconnect (|engine| *quick-view*) "quit()" (qapp) "quit()")
|
||||
(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*))
|
||||
|
|
@ -39,6 +39,10 @@
|
|||
(dolist (file *all-wrappers*)
|
||||
(compile-file (format nil "lisp/~A.lisp" file) :system-p t))
|
||||
|
||||
(progn
|
||||
(compile-file "lisp/qml" :system-p t)
|
||||
(setf *lisp-files* (append *lisp-files* (list "qml"))))
|
||||
|
||||
;; lib
|
||||
|
||||
(c:build-static-library "ini_eql5"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue