[education/rkward] rkward/rbackend: Add hooks for detecting changes to RK() devices
Thomas Friedrichsmeier
null at kde.org
Sun Aug 24 16:08:55 BST 2025
Git commit 47bc5518fd901a3ed523b557ec5e7433b4acec07 by Thomas Friedrichsmeier.
Committed on 24/08/2025 at 15:06.
Pushed by tfry into branch 'master'.
Add hooks for detecting changes to RK() devices
M +2 -0 rkward/rbackend/rkrbackend.cpp
M +13 -0 rkward/rbackend/rkwarddevice/rkgraphicsdevice_setup.cpp
M +62 -8 rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
M +50 -0 rkward/rbackend/rpackages/rkward/R/public_graphics.R
https://invent.kde.org/education/rkward/-/commit/47bc5518fd901a3ed523b557ec5e7433b4acec07
diff --git a/rkward/rbackend/rkrbackend.cpp b/rkward/rbackend/rkrbackend.cpp
index b99fdbe72..07bdfd948 100644
--- a/rkward/rbackend/rkrbackend.cpp
+++ b/rkward/rbackend/rkrbackend.cpp
@@ -978,6 +978,7 @@ SEXP doCaptureOutput(SEXP mode, SEXP capture_messages, SEXP capture_output, SEXP
}
SEXP RKStartGraphicsDevice(SEXP width, SEXP height, SEXP pointsize, SEXP family, SEXP bg, SEXP title, SEXP antialias);
+SEXP RKGraphicsModRevision(SEXP id);
SEXP RKD_AdjustSize(SEXP devnum, SEXP id);
void doPendingPriorityCommands();
@@ -1071,6 +1072,7 @@ bool RKRBackend::startR() {
{"rk.update.locale", (DL_FUNC)(void *)&doUpdateLocale, 0},
{"rk.capture.output", (DL_FUNC)(void *)&doCaptureOutput, 6},
{"rk.graphics.device", (DL_FUNC)(void *)&RKStartGraphicsDevice, 7},
+ {"rk.graphics.mod", (DL_FUNC)(void *)&RKGraphicsModRevision, 1},
{"rk.graphics.device.resize", (DL_FUNC)(void *)&RKD_AdjustSize, 2},
{nullptr, nullptr, 0}};
RFn::R_registerRoutines(RFn::R_getEmbeddingDllInfo(), nullptr, callMethods, nullptr, nullptr);
diff --git a/rkward/rbackend/rkwarddevice/rkgraphicsdevice_setup.cpp b/rkward/rbackend/rkwarddevice/rkgraphicsdevice_setup.cpp
index 4145aabcc..18b8418d6 100644
--- a/rkward/rbackend/rkwarddevice/rkgraphicsdevice_setup.cpp
+++ b/rkward/rbackend/rkwarddevice/rkgraphicsdevice_setup.cpp
@@ -31,6 +31,19 @@ struct RKGraphicsDeviceDesc {
QString default_family;
QString default_symbol_family;
pDevDesc rdevdesc;
+ int revision() {
+ if (_revision == _nextrevision) {
+ _nextrevision++;
+ }
+ return _revision;
+ }
+ void modified() {
+ _revision = _nextrevision;
+ }
+
+ private:
+ int _revision = 0;
+ int _nextrevision = 1;
};
#include "rkgraphicsdevice_stubs.cpp"
diff --git a/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp b/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
index 0b446f9c8..88efd8ce6 100644
--- a/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
+++ b/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
@@ -199,6 +199,47 @@ static void RKD_QueryResolution(double *dpix, double *dpiy) {
}
}
+SEXP makeInt(int val) {
+ SEXP ret;
+ RFn::Rf_protect(ret = RFn::Rf_allocVector(INTSXP, 1));
+ RFn::INTEGER(ret)[0] = val;
+ RFn::Rf_unprotect(1);
+ return ret;
+}
+
+SEXP makeString(const char *string) {
+ SEXP ret;
+ RFn::Rf_protect(ret = RFn::Rf_allocVector(STRSXP, 1));
+ RFn::SET_STRING_ELT(ret, 0, RFn::Rf_mkCharCE(string, CE_UTF8));
+ RFn::Rf_unprotect(1);
+ return ret;
+}
+
+static void callHookFun(const char *what, pDevDesc dev) {
+ static SEXP call_hook_fun = nullptr;
+ if (!call_hook_fun) {
+ SEXP rkn = makeString("rkward");
+ SEXP rkwardenv = RKRSupport::callSimpleFun(RFn::Rf_install("asNamespace"), rkn, ROb(R_GlobalEnv));
+ RK_ASSERT(RFn::Rf_isEnvironment(rkwardenv));
+ call_hook_fun = RFn::Rf_findFun(RFn::Rf_install(".RK.callHook"), rkwardenv);
+ }
+ RKRSupport::callSimpleFun2(call_hook_fun, makeString(what), makeInt(static_cast<RKGraphicsDeviceDesc *>(dev->deviceSpecific)->devnum), ROb(R_BaseEnv));
+}
+
+static void modified(pDevDesc dev) {
+ static_cast<RKGraphicsDeviceDesc *>(dev->deviceSpecific)->modified();
+}
+
+static void RKD_Activate(pDevDesc dev);
+SEXP RKGraphicsModRevision(SEXP _devnum) {
+ int devnum = RFn::Rf_asInteger(_devnum);
+ pGEDevDesc gdev = RFn::GEgetDevice(devnum);
+ if (!gdev) RFn::Rf_error("No such device %d", devnum);
+ pDevDesc dev = gdev->dev;
+ if (dev->activate != RKD_Activate) RFn::Rf_error("Not an RKWard device %d", devnum);
+ return makeInt(static_cast<RKGraphicsDeviceDesc *>(dev->deviceSpecific)->revision());
+}
+
static void RKD_Create(double width, double height, pDevDesc dev, const char *title, bool antialias, quint32 id) {
RK_TRACE(GRAPHICS_DEVICE);
{
@@ -212,6 +253,8 @@ static void RKD_Create(double width, double height, pDevDesc dev, const char *ti
quint32 dummy;
RKD_IN_STREAM >> dummy;
}
+
+ callHookFun("after.create", dev);
}
static void RKD_Size(double *left, double *right, double *bottom, double *top, pDevDesc dev) {
@@ -268,6 +311,8 @@ SEXP RKD_AdjustSize(SEXP _devnum, SEXP _id) {
dev->right = size.width();
dev->bottom = size.height();
+ // TODO: Do we want to block advancing revision, here?
+
RKD_SetSize(dev); // This adjusts the rendering area in the frontend
if (gdev->dirty) RFn::GEplayDisplayList(gdev);
return ROb(R_NilValue);
@@ -280,6 +325,7 @@ static void RKD_Circle(double x, double y, double r, R_GE_gcontext *gc, pDevDesc
RKD_OUT_STREAM << x << y << r;
WRITE_PEN();
WRITE_FILL();
+ modified(dev);
}
static void RKD_Line(double x1, double y1, double x2, double y2, R_GE_gcontext *gc, pDevDesc dev) {
@@ -289,6 +335,7 @@ static void RKD_Line(double x1, double y1, double x2, double y2, R_GE_gcontext *
RKD_OUT_STREAM << x1 << y1 << x2 << y2;
WRITE_PEN();
WRITE_LINE_ENDS();
+ modified(dev);
}
static void RKD_Polygon(int n, double *x, double *y, R_GE_gcontext *gc, pDevDesc dev) {
@@ -303,6 +350,7 @@ static void RKD_Polygon(int n, double *x, double *y, R_GE_gcontext *gc, pDevDesc
WRITE_PEN();
WRITE_LINE_ENDS();
WRITE_FILL();
+ modified(dev);
}
static void RKD_Polyline(int n, double *x, double *y, R_GE_gcontext *gc, pDevDesc dev) {
@@ -316,6 +364,7 @@ static void RKD_Polyline(int n, double *x, double *y, R_GE_gcontext *gc, pDevDes
}
WRITE_PEN();
WRITE_LINE_ENDS();
+ modified(dev);
}
static void RKD_Path(double *x, double *y, int npoly, int *nper, Rboolean winding, R_GE_gcontext *gc, pDevDesc dev) {
@@ -337,6 +386,7 @@ static void RKD_Path(double *x, double *y, int npoly, int *nper, Rboolean windin
WRITE_PEN();
WRITE_LINE_ENDS();
WRITE_FILL();
+ modified(dev);
}
static void RKD_Rect(double x0, double y0, double x1, double y1, R_GE_gcontext *gc, pDevDesc dev) {
@@ -347,6 +397,7 @@ static void RKD_Rect(double x0, double y0, double x1, double y1, R_GE_gcontext *
WRITE_PEN();
WRITE_LINE_ENDS();
WRITE_FILL();
+ modified(dev);
}
static void RKD_TextUTF8(double x, double y, const char *str, double rot, double hadj, R_GE_gcontext *gc, pDevDesc dev) {
@@ -356,6 +407,7 @@ static void RKD_TextUTF8(double x, double y, const char *str, double rot, double
RKD_OUT_STREAM << x << y << QString::fromUtf8(str) << rot << hadj; // NOTE: yes, even Symbols are sent as UTF-8, here.
WRITE_COL();
WRITE_FONT(dev);
+ modified(dev);
}
static double RKD_StrWidthUTF8(const char *str, R_GE_gcontext *gc, pDevDesc dev) {
@@ -376,9 +428,11 @@ static double RKD_StrWidthUTF8(const char *str, R_GE_gcontext *gc, pDevDesc dev)
static void RKD_NewPage(R_GE_gcontext *gc, pDevDesc dev) {
RK_TRACE(GRAPHICS_DEVICE);
+ callHookFun("before.blank", dev);
RKGraphicsDataStreamWriteGuard guard;
WRITE_HEADER(RKDNewPage, dev);
WRITE_FILL();
+ modified(dev);
}
static void RKD_MetricInfo(int c, R_GE_gcontext *gc, double *ascent, double *descent, double *width, pDevDesc dev) {
@@ -411,6 +465,7 @@ static void RKD_MetricInfo(int c, R_GE_gcontext *gc, double *ascent, double *des
static void RKD_Close(pDevDesc dev) {
RK_TRACE(GRAPHICS_DEVICE);
+ callHookFun("before.close", dev);
{
RKGraphicsDataStreamWriteGuard guard;
WRITE_HEADER(RKDClose, dev);
@@ -432,6 +487,7 @@ static void RKD_Clip(double left, double right, double top, double bottom, pDevD
RKGraphicsDataStreamWriteGuard guard;
WRITE_HEADER(RKDClip, dev);
RKD_OUT_STREAM << QRectF(left, top, right - left, bottom - top);
+ modified(dev);
}
static void RKD_Mode(int mode, pDevDesc dev) {
@@ -462,6 +518,7 @@ static void RKD_Raster(unsigned int *raster, int w, int h, double x, double y, d
}
}
RKD_OUT_STREAM << QRectF(x, y, width, height) << rot << (bool)interpolate;
+ modified(dev);
}
static SEXP RKD_Capture(pDevDesc dev) {
@@ -642,14 +699,6 @@ qint8 getGradientExtend(int Rextent) {
/* if (Rextent == R_GE_patternExtendNone) */ return GradientExtendNone;
}
-SEXP makeInt(int val) {
- SEXP ret;
- RFn::Rf_protect(ret = RFn::Rf_allocVector(INTSXP, 1));
- RFn::INTEGER(ret)[0] = val;
- RFn::Rf_unprotect(1);
- return ret;
-}
-
static void RK_tryCall(SEXP func) {
int error;
SEXP call = RFn::Rf_protect(RFn::Rf_lang1(func));
@@ -900,6 +949,7 @@ void RKD_UseGroup(SEXP ref, SEXP trans, pDevDesc dev) {
RKD_OUT_STREAM << (qint8)0;
}
}
+ modified(dev);
}
void RKD_ReleaseGroup(SEXP ref, pDevDesc dev) {
@@ -934,14 +984,17 @@ void doFillAndOrStroke(SEXP path, const pGEcontext gc, pDevDesc dev, bool fill,
void RKD_Stroke(SEXP path, const pGEcontext gc, pDevDesc dev) {
doFillAndOrStroke(path, gc, dev, false, 0, true);
+ modified(dev);
}
void RKD_Fill(SEXP path, int rule, const pGEcontext gc, pDevDesc dev) {
doFillAndOrStroke(path, gc, dev, true, rule, false);
+ modified(dev);
}
void RKD_FillStroke(SEXP path, int rule, const pGEcontext gc, pDevDesc dev) {
doFillAndOrStroke(path, gc, dev, true, rule, true);
+ modified(dev);
}
#endif
@@ -972,5 +1025,6 @@ void RKD_Glyph(int n, int *glyphs, double *x, double *y, SEXP font, double size,
RKD_IN_STREAM >> warning;
if (!warning.isEmpty()) RFn::Rf_warning("%s", qPrintable(warning));
}
+ modified(dev);
}
#endif
diff --git a/rkward/rbackend/rpackages/rkward/R/public_graphics.R b/rkward/rbackend/rpackages/rkward/R/public_graphics.R
index 31491787d..c04f8a8ab 100644
--- a/rkward/rbackend/rpackages/rkward/R/public_graphics.R
+++ b/rkward/rbackend/rpackages/rkward/R/public_graphics.R
@@ -146,6 +146,56 @@
invisible (ret) # Current always NULL
}
+
+# TODO: document
+RK.addHook <- function(after.create, before.close, before.blank) {
+ if (is.null(.rk.variables$.RKdevhooks$nextid)) .rk.variables$.RKdevhooks$nextid <- 0
+ id = .rk.variables$.RKdevhooks$nextid
+ .rk.variables$.RKdevhooks$nextid <- id + 1
+ appendHook <- function(at, what, id) {
+ stopifnot(is.function(what))
+ .rk.variables$.RKdevhooks[[at]] <- c(.rk.variables$.RKdevhooks[[at]], what)
+ names(.rk.variables$.RKdevhooks[[at]])[length(.rk.variables$.RKdevhooks[[at]])] <- id
+ }
+ if (!missing(after.create)) {
+ appendHook("after.create", after.create, id)
+ }
+ if (!missing(before.close)) {
+ appendHook("before.close", before.close, id)
+ }
+ if (!missing(before.blank)) {
+ appendHook("before.blank", before.blank, id)
+ }
+ invisible(id)
+}
+
+# TODO: document
+RK.removeHook <- function(handle) {
+ removeHook <- function(at, id) {
+ .rk.variables$.RKdevhooks[[at]] <- .rk.variables$.RKdevhooks[[at]][names(.rk.variables$.RKdevhooks[[at]]) != id]
+ }
+ removeHook("after.create", handle)
+ removeHook("before.close", handle)
+ removeHook("before.blank", handle)
+ invisible(NULL)
+}
+
+.RK.callHook <- function(hook, id) {
+ for (fun in .rk.variables$.RKdevhooks[[hook]]) {
+ try({fun(id)})
+ }
+}
+
+# TODO: document properly
+# TODO: ignore redraws?
+# For detecting changes in the graph shown in the given device, call this function twice.
+# The device has been modified, if the returned number has increased.
+# NOTE: The magnitude of the increase carries no meaning at all.
+# NOTE: Reset to 0 when the device is closed
+RK.revision <- function(device) {
+ .Call("rk.graphics.mod", as.integer(device), PACKAGE="(embedding)")
+}
+
#' Embed non-RKWard device windows
#'
#' \code{rk.embed.device} evaluates the given expression, and if this has created a window on the screen, tries to embed it as an RKWard window.
More information about the rkward-tracker
mailing list