a bunch of revisions

This commit is contained in:
pls.153 2022-01-29 09:37:19 +01:00
parent 1220bf06dc
commit 113386fdae
16 changed files with 109 additions and 112 deletions

View file

@ -1,6 +1,7 @@
QT += widgets
TEMPLATE = lib
CONFIG += plugin release
CONFIG += plugin release no_keywords
LIBS += -L/usr/local/lib -lecl
DESTDIR = ../
TARGET = cpp
OBJECTS_DIR = ./tmp/
@ -10,5 +11,14 @@ win32 {
include(../../src/windows.pri)
}
HEADERS += lib.h
SOURCES += lib.cpp
# 'marshal.*' and 'qt_ecl.*' only needed for calling Lisp
HEADERS += \
lib.h \
../../src/cpp/marshal.h \
../../src/cpp/qt_ech.h
SOURCES += \
lib.cpp \
../../src/cpp/marshal.cpp \
../../src/cpp/qt_ecl.cpp

View file

@ -1,4 +1,5 @@
#include "lib.h"
#include "../../src/cpp/ecl_fun.h" // for calling Lisp
#include <QApplication>
#include <QMessageBox>
#include <QtDebug>
@ -19,7 +20,10 @@ QObject* ini() {
return cpp;
}
// functiones defined Q_INVOKABLE
QVariant CPP::hello(const QVariant& arg) {
QString msg;
QDebug debug(&msg);
debug << arg;
@ -29,4 +33,9 @@ QVariant CPP::hello(const QVariant& arg) {
return arg;
}
QVariant CPP::callLisp(const QVariant& arg) {
return ecl_fun("cl:format", false, "~R", arg);
}
QT_END_NAMESPACE

View file

@ -20,6 +20,7 @@ public:
// max. 10 arguments of type QVariant
// return type must also be a QVariant
Q_INVOKABLE QVariant hello(const QVariant&);
Q_INVOKABLE QVariant callLisp(const QVariant&);
};
QT_END_NAMESPACE

View file

@ -5,3 +5,6 @@
;; qrun* needed in Slime (not running on UI thread)
(qrun* (print (hello *cpp* '(1 "two" (1.25 #(50 -50 75))))))
(qrun* (print (call-lisp *cpp* 125)))

View file

@ -7,6 +7,12 @@
(defvar *canvas* "canvas")
(defvar *input* "input")
(defmacro with-path ((color &optional (line-width 14)) &body body)
`(progn
(qjs |begin| *canvas* ,color ,line-width)
,@body
(qjs |end| *canvas*)))
(defun draw-line (x1 y1 x2 y2)
(qjs |drawLine| *canvas*
x1 y1 x2 y2))
@ -16,33 +22,35 @@
(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))))))
(with-path ("black")
(draw-line 0 -150 0 150))
(with-path ("blue")
(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)))))))

View file

@ -13,20 +13,29 @@ Rectangle {
width: 220
height: 320
property var painter
property var ctx
// functions to be called from Lisp
function begin(color, width) {
ctx.beginPath()
ctx.strokeStyle = color
ctx.lineWidth = width
ctx.lineCap = "round"
}
function end() {
ctx.stroke()
}
function drawLine(x1, y1, x2, y2) {
painter.moveTo(x1, y1)
painter.lineTo(x2, y2)
ctx.moveTo(x1, y1)
ctx.lineTo(x2, y2)
}
onPaint: {
var ctx = getContext("2d")
painter = ctx
ctx = getContext("2d")
ctx.reset()
ctx.strokeStyle = "blue"
ctx.lineWidth = 10
ctx.lineCap = "round"
ctx.translate(110, 160)
Lisp.call("qml-user:paint")

View file

@ -26,6 +26,9 @@ Only tested with **Qt5.15** and latest **Qt6**. It's recommended to use the new
Qt online installer (see [doc/get-qt6](doc/get-qt6.md)), where you can choose
to install different Qt versions side by side, sharing the same Qt Creator.
The **mobile** part is currently only tested with **Qt5.15**, because the Qt6
port still lacks significant parts of mobile (as of Qt6.2).
TODO
----

View file

@ -348,7 +348,7 @@ cl_object qsingle_shot2(cl_object l_msec, cl_object l_fun) {
/// (qsingle-shot 1000 'one-second-later)
ecl_process_env()->nvalues = 1;
if (l_fun != ECL_NIL) {
new SingleShot(toInt(l_msec), l_fun); // see "delete this;" in "single_shot.h"
new SingleShot(toInt(l_msec), l_fun);
return l_msec;
}
error_msg("QSINGLE-SHOT", LIST2(l_msec, l_fun));

View file

@ -51,12 +51,12 @@ int main(int argc, char* argv[]) {
new QQmlFileSelector(view.engine(), &view);
QString qml("qml/main.qml");
QUrl url("qrc:///" + qml);
QUrl url("qrc:///" + qml); // (1) try resources first (final app)
bool set = false;
if (QFile::exists(url.fileName())) {
set = true;
} else {
url = QUrl::fromLocalFile(qml);
url = QUrl::fromLocalFile(qml); // (2) use local file (development)
if (QFile::exists(QDir::currentPath() + "/" + qml)) {
set = true;
}
@ -81,10 +81,11 @@ int main(int argc, char* argv[]) {
bool slime = false;
if (arguments.contains("-slime")
#if QT_VERSION < 0x060000
|| (arguments.indexOf(QRegularExpression::wildcardToRegularExpression("*start-swank*.lisp")) != -1)) {
|| (arguments.indexOf(QRegularExpression::wildcardToRegularExpression("*start-swank*.lisp")) != -1)
#else
|| (arguments.indexOf(QRegularExpression::fromWildcard(QString("*start-swank*.lisp"))) != -1)) {
|| (arguments.indexOf(QRegularExpression::fromWildcard(QString("*start-swank*.lisp"))) != -1)
#endif
) {
arguments.removeAll("-slime");
slime = true;
}

View file

@ -188,7 +188,7 @@ QObject* toQObjectPointer(cl_object l_obj) {
// *** Qt to Lisp
// *** Qt to Lisp ***
cl_object from_cstring(const QByteArray& s) {
cl_object l_s = ecl_alloc_simple_base_string(s.length());

View file

@ -56,7 +56,7 @@ static cl_object from_##name(const cap_name& q) { \
#define TO_QT_FLOAT_2(name) \
static name to##name(cl_object x) { \
if(LISTP(x)) { \
if (LISTP(x)) { \
return name(toReal(cl_first(x)), toReal(cl_second(x))); \
} \
return name(); \
@ -64,7 +64,7 @@ static name to##name(cl_object x) { \
#define TO_QT_FLOAT_4(name) \
static name to##name(cl_object x) { \
if(LISTP(x)) { \
if (LISTP(x)) { \
return name(toReal(cl_first(x)), toReal(cl_second(x)), toReal(cl_third(x)), toReal(cl_fourth(x))); \
} \
return name(); \

View file

@ -1,7 +1,6 @@
#include "qml.h"
#include "lqml.h"
#include "ecl_fun.h"
#include <QQuickView>
QT_BEGIN_NAMESPACE

View file

@ -36,29 +36,29 @@ QVariant ecl_fun(const QByteArray& pkgFun,
const QVariant& a9,
const QVariant& a10) {
void* symbol = lisp_functions.value(pkgFun);
if(!symbol) {
if (!symbol) {
int p = pkgFun.indexOf(':');
QByteArray pkg = (p == -1) ? "qml-user" : pkgFun.left(p);
QByteArray fun = pkgFun.mid(pkgFun.lastIndexOf(':') + 1);
cl_object l_sym = cl_find_symbol(2,
make_constant_base_string(fun.toUpper().constData()),
cl_find_package(make_constant_base_string(pkg.toUpper().constData())));
if(l_sym != Cnil) {
if (l_sym != Cnil) {
symbol = l_sym;
lisp_functions[pkgFun] = symbol;
}
}
cl_object l_args = Cnil;
if(!a1.isNull()) { PUSH_ARG(a1);
if(!a2.isNull()) { PUSH_ARG(a2);
if(!a3.isNull()) { PUSH_ARG(a3);
if(!a4.isNull()) { PUSH_ARG(a4);
if(!a5.isNull()) { PUSH_ARG(a5);
if(!a6.isNull()) { PUSH_ARG(a6);
if(!a7.isNull()) { PUSH_ARG(a7);
if(!a8.isNull()) { PUSH_ARG(a8);
if(!a9.isNull()) { PUSH_ARG(a9);
if(!a10.isNull()) { PUSH_ARG(a10); }
if (!a1.isNull()) { PUSH_ARG(a1);
if (!a2.isNull()) { PUSH_ARG(a2);
if (!a3.isNull()) { PUSH_ARG(a3);
if (!a4.isNull()) { PUSH_ARG(a4);
if (!a5.isNull()) { PUSH_ARG(a5);
if (!a6.isNull()) { PUSH_ARG(a6);
if (!a7.isNull()) { PUSH_ARG(a7);
if (!a8.isNull()) { PUSH_ARG(a8);
if (!a9.isNull()) { PUSH_ARG(a9);
if (!a10.isNull()) { PUSH_ARG(a10); }
}
}
}
@ -69,7 +69,7 @@ QVariant ecl_fun(const QByteArray& pkgFun,
}
}
l_args = cl_nreverse(l_args);
if(symbol) {
if (symbol) {
cl_object l_ret = lisp_apply((cl_object)symbol, l_args);
return toQVariant(l_ret);
}

View file

@ -142,6 +142,7 @@
`(qrun-on-ui-thread* ,@body))
(defun qfind-children (object &optional object-name class-name)
;; for internal use
(%qfind-children object object-name class-name))
(defun qload-c++ (library-name &optional unload)

View file

@ -8,7 +8,6 @@
#:children
#:define-qt-wrappers
#:find-quick-item
#:js
#:pixel-ratio
#:qapropos
#:qapropos*

View file

@ -2,11 +2,9 @@
(:use :common-lisp)
(:export
#:cc
#:check-recompile
#:bytes-to-string
#:d
#:do-string
#:do-with
#:empty-string
#:ensure-list
#:ends-with
@ -15,8 +13,6 @@
#:if-it
#:if-it*
#:join
#:let-it
#:path
#:split
#:starts-with
#:string-substitute
@ -39,11 +35,6 @@
`(let ((it* ,exp))
(if it* ,then ,else)))
(defmacro let-it (exp &body body)
`(let ((it ,exp))
,@body
it))
(defmacro when-it (exp &body body)
`(let ((it ,exp))
(when it ,@body)))
@ -74,15 +65,6 @@
,@body)
,str)))
(defmacro do-with (with &body body)
`(progn
,@(mapcar (lambda (line)
(append with (if (or (atom line)
(eql 'quote (first line)))
(list line)
line)))
body)))
(defun d (&rest args)
"A simple debug print."
(print (cons :debug args)))
@ -147,31 +129,3 @@
(defun string-to-bytes (s)
(map 'vector 'char-code s))
(defun path (name)
"Needed because ECL uses base strings (not Unicode) for pathnames internally."
#+(or darwin linux)
(funcall (intern "QUTF8" :eql) name)
#+win32
(if (< (funcall (intern "%WINDOWS-VERSION" :eql)) #xa0)
(funcall (intern "QLOCAL8BIT" :eql) name) ; Windows 7 and lower
name)) ; Windows 8 and higher
(defun check-recompile (file-name)
"Given a global file name without file ending, ensures re-compiling on every ECL/Qt5/EQL5 version change."
(labels ((ver-name ()
(format nil "~A.ver" file-name))
(version ()
(multiple-value-bind (eql5 qt5)
(funcall (find-symbol "QVERSION" :eql))
(format nil "EQL5 ~A (ECL ~A, Qt ~A)" eql5 (lisp-implementation-version) qt5)))
(write-version ()
(with-open-file (s (ver-name) :direction :output :if-exists :supersede)
(princ (version) s)))
(read-version ()
(x:when-it (probe-file (ver-name))
(with-open-file (s x:it :direction :input)
(read-line s)))))
(unless (equal (version) (read-version))
(compile-file file-name)
(write-version)))
file-name)