master d5f515e4a33 1/2: New image type canvas
Eli Zaretskii <[email protected]>
| Newsgroups | gmane.emacs.diffs |
|---|---|
| Message-ID | <[email protected]> |
branch: master commit d5f515e4a3350079330c2e80f3681d140d649c88 Author: Divya Ranjan <[email protected]> Commit: Eli Zaretskii <[email protected]> New image type canvas Canvas images support efficient updating and refreshing. An image specifier with ':type canvas' creates a canvas image. The canvas has an associated writable pixel buffer. After changing the ':data' vector or writing to the pixel buffer a call to 'canvas-refresh' redraws the canvas image. See bug#80281. Co-Authored-By: Divya Ranjan <[email protected]> Co-Authored-By: Daniel Mendler <[email protected]> Canvas changes: * doc/lispref/display.texi (Images): Add Canvas Images to menu. (Canvas Images): New node documenting canvas image objects, the `:data-width', `:data-height', `:data' and `:file' properties, and `canvas-refresh'. * doc/lispref/elisp.texi (Top): Reference new Canvas Images node. * doc/lispref/internals.texi (Writing Dynamic Modules): Add Module Canvas API to menu. (Module Canvas API): New node documenting `canvas_data' module function. * etc/NEWS: Announce the addition. * lisp/image.el (create-image): Add `:id' to image specification of canvas images. * src/dispextern.h (struct image): Add `refresh', `original_width' and `original_height' fields. (redraw_image_glyphs, canvas_data): New prototypes. * src/emacs-module.c (module_canvas_data): New function. (initialize_environment): Register `canvas_data' module function. * src/image.c (struct canvas): New struct for canvas. (canvas_prepare_for_display, canvas_free_unused): New forward declarations. (prepare_image_for_display): Call `canvas_prepare_for_display' when the canvas refresh counter has changed. Set image `original_width' and `original_height'. (filter_image_spec): Exclude `:data' from the image cache key for canvas images, so mutating the data vector in place does not create a new cache entry. (Fclear_image_cache): Call `canvas_free_unused'. (image_set_transform): Use CAIRO_FILTER_GOOD instead of CAIRO_FILTER_BEST for canvas images, for performance. Do not set image `original_width' and `original_height'. (canvas_image_p, canvas_free_unused, canvas_apply_data, canvas_get) (canvas_parse, canvas_load, canvas_prepare_for_display, canvas_data): New functions implementing canvas creation, resizing, and reloading of `:data' or `:file' content. (Fcanvas_refresh): New defun `canvas-refresh', with an optional RELOAD-DATA argument to reread `:data' or `:file'. (initialize_image_type, syms_of_image): Register the `canvas' image type and `canvas-refresh'. * src/module-env-32.h (canvas_data): New prototype. * src/nsimage.m (ns_image_reset): New function to recreate an NS pixmap to update the canvas. * src/nsterm.h: Add prototype for `ns_image_reset'. * src/xdisp.c (redraw_image_glyphs_window) (redraw_image_glyphs_window_tree, redraw_image_glyphs): New functions to redraw only the glyphs referencing a given canvas image spec, falling back to a full frame redraw if the frame is garbaged. * test/src/emacs-module-resources/mod-test.c (mod-test-canvas-read) (mod-test-canvas-write, mod-test-canvas-invalid): New helper functions. * test/src/emacs-module-tests.el (test-canvas-gen-file) (mod-test-canvas/valid, mod-test-canvas/invalid, mod-test-canvas/vector) (mod-test-canvas/vector-reload, mod-test-canvas/unibyte) (mod-test-canvas/file, mod-test-canvas/gc-stress): New tests. --- doc/lispref/display.texi | 108 ++++++ doc/lispref/elisp.texi | 1 + doc/lispref/internals.texi | 48 +++ etc/NEWS | 11 + lisp/image.el | 3 + src/dispextern.h | 22 +- src/emacs-module.c | 10 + src/image.c | 525 ++++++++++++++++++++++++++++- src/module-env-32.h | 9 + src/nsimage.m | 7 + src/nsterm.h | 1 + src/xdisp.c | 76 +++++ test/src/emacs-module-resources/mod-test.c | 115 +++++++ test/src/emacs-module-tests.el | 117 +++++++ 14 files changed, 1033 insertions(+), 20 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 80cbd0cb5f0..72bbf0ffdc1 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6026,6 +6026,7 @@ displayed (@pxref{Display Feature Testing}). * Defining Images:: Convenient ways to define an image for later use. * Showing Images:: Convenient ways to display an image once it is defined. * Multi-Frame Images:: Some images contain more than one frame. +* Canvas Images:: Easily modifiable image with a pixel buffer. * Image Cache:: Internal mechanisms of image display. @end menu @@ -7477,6 +7478,113 @@ This function returns the timer responsible for animating @var{image}, if there is one. @end defun +@node Canvas Images +@subsection Canvas Images +@cindex canvas image + +Canvas images can be updated and displayed efficiently with high frame +rates, for example by document viewers, visualization tools, dynamically +computed animations or games. Canvas images have an associated +writeable pixel buffer in ARGB32 format. For portability the format is +the same on all platforms. Unlike other image types supported in Emacs, +canvas images do not require creating a new Emacs Lisp object every time +they get updated. + +An image specifier with @code{:type canvas} creates a canvas, for instance +as follows: + +@lisp +(defvar my-canvas + '(image :type canvas + :id my-canvas + :data-width 800 + :data-height 600)) +@end lisp + +The image specification object uniquely (with respect to @code{eq}) +identifies a canvas image object. The properties @code{:data-width}, +@code{:data-height} and @code{:id} are mandatory. The width and height +must both be positive integers and the id must be a symbol. + +Canvases can be created by either providing ARGB32 data as a vector of +fixnums or as an unibyte string in @code{:data}. Path to a file +containing the ARGB32 data in @code{:file} can also be provided. +Furthermore @code{create-image} can create canvas images as follows, +where the data is initially loaded from a file, or from a vector: + +@lisp +(setq my-file-canvas (create-image "/path/to/file" + 'canvas nil + :data-width 800 + :data-height 600)) +(setq my-vec (make-vector (* 800 600) #xFFFF0000)) +(setq my-vec-canvas (create-image my-vec + 'canvas t + :data-width 800 + :data-height 600)) +@end lisp + +If the values for dimensions change (i.e., @code{:data-height} or +@code{:data-width}), then Emacs will automatically adjust the underlying +pixel buffer and resize the canvas. + +Other image properties like @code{:scale}, @code{:margin}, @code{:relief}, +@code{:transform-smoothing} and @code{:map} are supported. +@xref{Image Descriptors}, for further details on these properties. + +In order to display the canvas, specify it as the display property of a +string or overlay: + +@lisp +(insert (propertize "#" 'display my-canvas)) +(overlay-put some-overlay 'display my-canvas) +@end lisp + +Once a canvas image object has been created and displayed, it can be +``refreshed'' via @code{canvas-refresh}. + +@defun canvas-refresh image &optional reload-data +Refresh canvas @var{image} and update it on screen. If the optional +argument @var{reload-data} is non-nil, reload the @code{:data} or +@code{file} from the image specification before redrawing the canvas. +@end defun + +The following code refreshes the canvas by reloading the data or file: + +@lisp +;; Draw pixels +(aset my-vec <index> <color>) +;; Reload and refresh canvas images +(canvas-refresh my-vec-canvas 'reload-data) +@end lisp + +When refreshing the canvas in a loop, we must explicitly call @code{redisplay}: + +@example +(setq canvas (create-image (make-vector (* 100 100) 0) 'canvas t + :data-width 100 :data-height 100)) +(insert (propertize "#" 'display canvas)) +(dotimes (i (* 100 100)) + (aset (plist-get (cdr canvas) :data) i #xFF) + (canvas-refresh canvas 'reload-data) + (redisplay)) +@end example + +But, if we are refreshing the canvas via a timer or a command, @code{redisplay} +is implicitly called after the timer or command. The following example updates +the above canvas in a timer ~30 times per second: + +@example +(let ((i 0)) + (run-at-time nil 0.033 (lambda () + (when (< i (* 100 100)) + (aset (plist-get (cdr canvas) :data) i #xFF) + (incf i) + (canvas-refresh canvas 'reload-data))))) +@end example + +Canvas images can be manipulated and refreshed via dynamic modules. +@xref{Module Canvas API}, for further details. @node Image Cache @subsection Image Cache diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 2944b598178..45c110bb5a0 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1577,6 +1577,7 @@ Images * Showing Images:: Convenient ways to display an image once it is defined. * Multi-Frame Images:: Some images contain more than one frame. +* Canvas Images:: Easily modifiable image with a pixel buffer. * Image Cache:: Internal mechanisms of image display. Buttons diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 0cb3e0ccb1d..ef98afa36df 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1117,6 +1117,7 @@ option. @xref{Initial Options,,,emacs, The GNU Emacs Manual}. * Module Functions:: * Module Values:: * Module Misc:: +* Module Canvas API:: * Module Nonlocal:: @end menu @@ -2020,6 +2021,53 @@ done, close the file descriptor using @code{close}. @ref{Low-Level I/O,,,libc}. @end deftypefun +@node Module Canvas API +@subsection Using Canvas API With Modules + +Emacs supports creating image objects called ``canvas'' which have a +pixel buffer associated with them. These image objects can be accessed +and updated natively via dynamic modules. @xref{Canvas Images}, for what +they are. + +The following functions allow you to operate on canvas image objects +with dynamic modules: + +@anchor{canvas_data} +@deftypefn Function uint32_t *canvas_data (emacs_env *@var{env}, emacs_value @var{canvas}) +The function gives access to the pixel buffer of @var{canvas}. The +pixel buffer is in row-major order with a size @var{width} * @var{height}. +The pixel format is ARGB32 on all platforms. Return @code{NULL} in case +of error. +@end deftypefn + +Note that the pixel buffer is only valid as long as the canvas object is +alive and its dimensions have not been changed. If it has changed, Emacs +will create a new pixel buffer and automatically resize the canvas. + +Once we update the canvas pixel buffer via dynamic modules, we also have +to call @code{canvas-refresh} for Emacs to redisplay the canvas. This +can be done from the module via an Elisp funcall. + +@example +/* Access the pixel buffer */ +uint32_t *pixel = env->canvas_data (env, canvas); +/* Write to the pixel buffer */ +... +/* Redraw the canvas */ +env->funcall(env, env->intern(env, "canvas-refresh"), 2, + (emacs_value[])@{canvas, Qnil@}); +@end example + +Note that @code{canvas-refresh} has an optional boolean argument to +reload the @code{:data} vector or string from the canvas image +specification. When called from dynamic modules, the argument should +usually be @code{nil}. + +Thus, one can simply define a module function that takes as an argument +a canvas image object, following the specification as laid down in +@ref{Canvas Images}, and then use the above code to manipulate the pixel +buffer of the canvas and redraw it. + @node Module Nonlocal @subsection Nonlocal Exits in Modules @cindex nonlocal exits, in modules diff --git a/etc/NEWS b/etc/NEWS index c0656510677..61fac3b1cae 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -33,6 +33,8 @@ systems. * Changes in Emacs 32.1 ++++ + --- ** Emacs no longer kills child processes after EPIPE. Previously, Emacs would immediately kill a child process and set its @@ -311,6 +313,15 @@ older '(HIGH LOW USEC PSEC)' form. * Lisp Changes in Emacs 32.1 ++++ +** Support for canvas image objects. +Canvas images support efficient updating and refreshing. An image +specifier with ':type canvas' creates a canvas image. The canvas has an +associated writable pixel buffer. The dynamic module function 'canvas_data' +provides access to the pixel buffer. After changing the ':data' vector or +writing to the pixel buffer a call to 'canvas-refresh' redraws the canvas +image. + +++ ** 'ignore' is now also a place, acting as a "blackhole" like "/dev/null". E.g., '(push (new-elem) (pcase (foo) (0 var1) (1 var2) (_ (ignore))))'. diff --git a/lisp/image.el b/lisp/image.el index dbfbc266445..5f069292544 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -562,6 +562,9 @@ Images should not be larger than specified by `max-image-size'." (not (plist-get props :map))) (setq image (nconc image (list :map (image--compute-map image))))) + ;; Add unique canvas id if not already present + (when (and (eq type 'canvas) (not (plist-get props :id))) + (setq image (nconc image (list :id (gensym))))) image))) (defun image--default-smoothing (image) diff --git a/src/dispextern.h b/src/dispextern.h index 357504dd989..1c4318002db 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3233,10 +3233,6 @@ struct image # if !defined USE_CAIRO && defined HAVE_XRENDER /* Picture versions of pixmap and mask for compositing. */ Picture picture, mask_picture; - - /* We need to store the original image dimensions in case we have to - call XGetImage. */ - int original_width, original_height; # endif #endif /* HAVE_X_WINDOWS */ #ifdef HAVE_ANDROID @@ -3254,9 +3250,6 @@ struct image /* The affine transformation to apply to this image. */ double transform[3][3]; - /* The original width and height of the image. */ - int original_width, original_height; - /* Whether or not bilinear filtering should be used to "smooth" the image. */ bool use_bilinear_filtering; @@ -3296,7 +3289,17 @@ struct image valid, respectively. */ bool_bf background_valid : 1, background_transparent_valid : 1; - /* Width and height of the image. */ + /* Refresh counter reflecting the current version of the image. + Always larger than zero for images which may need refreshing. + Right now it is only used by canvas images. */ + uint32_t refresh; + + /* The original width and height of the image before transformations + like scaling or rotation. */ + int original_width, original_height; + + /* Width and height of the image. These values depend on + the :scale or :rotation image parameters. */ int width, height; /* The scale factor applied to the image. */ @@ -3627,6 +3630,7 @@ extern void get_font_ascent_descent (struct font *, int *, int *); #ifdef HAVE_WINDOW_SYSTEM +extern void redraw_image_glyphs (Lisp_Object); extern void gui_get_glyph_overhangs (struct glyph *, struct frame *, int *, int *); extern struct font *font_for_underline_metrics (struct glyph_string *); @@ -3716,6 +3720,8 @@ extern void update_redisplay_ticks (int, struct window *); /* Defined in image.c */ +extern uint32_t *canvas_data (Lisp_Object); + #ifdef HAVE_WINDOW_SYSTEM extern void clear_image_cache (struct frame *, Lisp_Object); diff --git a/src/emacs-module.c b/src/emacs-module.c index ce6c292dbb5..1adf0ad6e5b 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -962,6 +962,15 @@ module_vec_size (emacs_env *env, emacs_value vector) return ASIZE (lisp); } +static uint32_t * +module_canvas_data (emacs_env *env, emacs_value canvas) +{ + MODULE_FUNCTION_BEGIN (NULL); + uint32_t *data = canvas_data (value_to_lisp (canvas)); + MODULE_INTERNAL_CLEANUP (); + return data; +} + /* This function should return true if and only if maybe_quit would quit. */ static bool @@ -1612,6 +1621,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) env->open_channel = module_open_channel; env->make_interactive = module_make_interactive; env->make_unibyte_string = module_make_unibyte_string; + env->canvas_data = module_canvas_data; return env; } diff --git a/src/image.c b/src/image.c index 1086f474eec..5683e8ed229 100644 --- a/src/image.c +++ b/src/image.c @@ -110,6 +110,22 @@ static unsigned long image_alloc_image_color (struct frame *, struct image *, # define DONT_CREATE_TRANSFORMED_IMAGEMAGICK_IMAGE #endif +struct canvas +{ + /* Linked list of canvases, see `canvas_list'. */ + struct canvas *next; + /* Memory buffer in ARGB32 format. The same format on all platforms! */ + uint32_t *data; + /* Incremented if the canvas should be redrawn. The value is always + greater than 0. */ + uint32_t refresh; + /* Dimension of the canvas. */ + int width, height; +}; + +static void canvas_prepare_for_display (struct frame *f, struct image *img); +static void canvas_free_unused (void); + #ifdef HAVE_NTGUI /* We need (or want) w32.h only when we're _not_ compiling for Cygwin. */ @@ -221,6 +237,7 @@ static unsigned long *colors_in_color_table (int *n); #ifdef HAVE_NTGUI static HBITMAP w32_create_pixmap_from_bitmap_data (int, int, char *); +static void XPutPixel (XImage *, int, int, COLORREF); #endif @@ -1877,6 +1894,13 @@ prepare_image_for_display (struct frame *f, struct image *img) unblock_input (); } #endif + + /* Update image pixmap from canvas pixel buffer if refresh counter has + been updated. For canvases the refresh counter is always >= 1. */ + if (img->refresh + && EQ (image_spec_value (img->spec, QCtype, NULL), Qcanvas) + && img->refresh != ((struct canvas *) XFIXNUMPTR (img->lisp_data))->refresh) + canvas_prepare_for_display (f, img); } @@ -2260,6 +2284,8 @@ filter_image_spec (Lisp_Object spec) { Lisp_Object out = Qnil; + bool is_canvas = EQ (image_spec_value (spec, QCtype, NULL), Qcanvas); + /* Skip past the `image' element. */ if (CONSP (spec)) spec = XCDR (spec); @@ -2274,10 +2300,14 @@ filter_image_spec (Lisp_Object spec) spec = XCDR (spec); /* Some animation-related data doesn't affect display, but - breaks the image cache. Filter those out. */ - if (!(EQ (key, QCanimate_buffer) - || EQ (key, QCanimate_tardiness) - || EQ (key, QCanimate_position))) + breaks the image cache. Furthermore for canvases do not + check the data for equality, such that data can be changed + via mutation to refresh the canvas. Filter these keys out. + */ + if (!(is_canvas ? EQ (key, QCdata) : + (EQ (key, QCanimate_buffer) + || EQ (key, QCanimate_tardiness) + || EQ (key, QCanimate_position)))) { out = Fcons (value, out); out = Fcons (key, out); @@ -2468,6 +2498,8 @@ but the image is still displayed. */) /* Also clear the animation caches. */ image_prune_animation_caches (true); + canvas_free_unused (); + return Qnil; } @@ -3033,8 +3065,6 @@ image_set_transform (struct frame *f, struct image *img) { 0, 0, 1 }, }; - img->original_width = img->width; - img->original_height = img->height; img->use_bilinear_filtering = false; memcpy (&img->transform, identity, sizeof identity); @@ -3058,10 +3088,6 @@ image_set_transform (struct frame *f, struct image *img) # if !defined USE_CAIRO && defined HAVE_XRENDER if (!img->picture) return; - - /* Store the original dimensions as we'll overwrite them later. */ - img->original_width = img->width; - img->original_height = img->height; # endif /* Determine size. */ @@ -3364,8 +3390,16 @@ image_set_transform (struct frame *f, struct image *img) matrix[1][1], matrix[2][0], matrix[2][1]}; cairo_pattern_t *pattern = cairo_pattern_create_rgb (0, 0, 0); cairo_pattern_set_matrix (pattern, &cr_matrix); - cairo_pattern_set_filter (pattern, smoothing - ? CAIRO_FILTER_BEST : CAIRO_FILTER_NEAREST); + + /* Performance degrades with CAIRO_FILTER_BEST when using canvas, and possibly + we get HW acceleration from CAIRO_FILTER_GOOD */ + int cairo_filter; + if (EQ (image_spec_value (img->spec, QCtype, NULL), Qcanvas)) + cairo_filter = smoothing ? CAIRO_FILTER_GOOD : CAIRO_FILTER_NEAREST; + else + cairo_filter = smoothing ? CAIRO_FILTER_BEST : CAIRO_FILTER_NEAREST; + cairo_pattern_set_filter (pattern, cairo_filter); + /* Dummy solid color pattern just to record pattern matrix. */ img->cr_data = pattern; # elif defined (HAVE_XRENDER) @@ -3624,6 +3658,10 @@ lookup_image (struct frame *f, Lisp_Object spec, int face_id) } } + /* Store the original width and height before transforming the image. */ + img->original_width = img->width; + img->original_height = img->height; + /* Do image transformations and compute masks, unless we don't have the image yet. */ if (!EQ (builtin_lisp_symbol (img->type->type), Qpostscript)) @@ -5410,7 +5448,462 @@ xbm_load (struct frame *f, struct image *img) return success_p; } + +/*********************************************************************** + Canvas + ***********************************************************************/ + +/* Indices of image specification fields in canvas_format, below. */ + +enum canvas_keyword_index +{ + CANVAS_TYPE, + CANVAS_ID, + CANVAS_FILE, + CANVAS_DATA, + CANVAS_WIDTH, + CANVAS_HEIGHT, + CANVAS_ASCENT, + CANVAS_MARGIN, + CANVAS_RELIEF, + CANVAS_LAST +}; + +/* Vector of image_keyword structures describing the format + of valid user-defined image specifications. */ + +static const struct image_keyword canvas_format[CANVAS_LAST] = +{ + {":type", IMAGE_SYMBOL_VALUE, 1}, + {":id", IMAGE_SYMBOL_VALUE, 1}, + {":file", IMAGE_STRING_VALUE, 0}, + {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":data-width", IMAGE_POSITIVE_INTEGER_VALUE, 1}, + {":data-height", IMAGE_POSITIVE_INTEGER_VALUE, 1}, + {":ascent", IMAGE_ASCENT_VALUE, 0}, + {":margin", IMAGE_NON_NEGATIVE_INTEGER_VALUE_OR_PAIR, 0}, + {":relief", IMAGE_INTEGER_VALUE, 0}, +}; + +/* Weak hash map associating canvas image specs with the canvas objects. + + As long as a canvas image spec object is alive, the canvas object + backing it, will stay alive. As soon as the GC runs and frees + unreferenced canvas image specs, the specs are are also removed from + the weak canvas_map. Then canvas_free_unused will check the + canvas_map and free the backing canvas objects. */ + +static Lisp_Object canvas_map; + +/* Linked list of all canvas objects. */ + +static struct canvas* canvas_list = 0; + +/* Parse canvas specification OBJECT and return true if valid. */ + +static bool +canvas_parse (Lisp_Object object, struct image_keyword *fmt) +{ + memcpy (fmt, canvas_format, sizeof canvas_format); + + /* Check that only one of :data or :file is present. */ + if (!parse_image_spec (object, fmt, CANVAS_LAST, Qcanvas) + || fmt[CANVAS_FILE].count + fmt[CANVAS_DATA].count > 1) + return false; + + ptrdiff_t w = XFIXNAT (fmt[CANVAS_WIDTH].value); + ptrdiff_t h = XFIXNAT (fmt[CANVAS_HEIGHT].value); + + /* Check that w*h*4 does not overflow */ + return w <= INT_MAX / 4 / h; +} + +/* Return true if OBJECT is a valid canvas image specification. */ + +static bool +canvas_image_p (Lisp_Object object) +{ + struct image_keyword fmt[CANVAS_LAST]; + return canvas_parse (object, fmt); +} + +/* Clear canvas list. All canvases which are not referenced anymore in + the weak hash table canvas_map are freed. */ + +static void +canvas_free_unused (void) +{ + /* Mark all referenced canvases as used (negative width). */ + DOHASH (XHASH_TABLE (canvas_map), k, v) + ((struct canvas *)XFIXNUMPTR (v))->width *= -1; + + /* Free unreferenced canvases and remove them from the list. */ + struct canvas **p = &canvas_list; + while (*p) + { + struct canvas *c = *p; + if (c->width < 0) + { + p = &c->next; + c->width *= -1; + } + else + { + *p = c->next; + xfree (c->data); + xfree (c); + } + } +} + +/* Copy pixel data into canvas C from a parsed image keyword array FMT. + + :data must be an unibyte string of exactly 4*WIDTH*HEIGHT bytes, or a + vector of size WIDTH*HEIGHT in row-major order, where each element is + a 32 bit integer. :file names a binary file with size 4*WIDTH*HEIGHT + bytes. */ + +static void +canvas_apply_data (struct canvas *c, struct image_keyword *fmt) +{ + ptrdiff_t expected_size = (ptrdiff_t) c->width * c->height; + + Lisp_Object data = fmt[CANVAS_DATA].value; + Lisp_Object file = fmt[CANVAS_FILE].value; + + if (STRINGP (data)) /* Unibyte string data in ARGB32 format. */ + { + if (STRING_MULTIBYTE (data)) + { + image_error ("Canvas :data string must be unibyte"); + return; + } + + if (SBYTES (data) != 4 * expected_size) + { + image_error ("Canvas :data size mismatch"); + return; + } + + const uint32_t *buf = (const uint32_t *) SDATA (data); +#ifdef WORDS_BIGENDIAN + for (ptrdiff_t i = 0; i < expected_size; ++i) + c->data[i] = bswap_32 (buf[i]); +#else + for (ptrdiff_t i = 0; i < expected_size; ++i) + c->data[i] = buf[i]; +#endif + } + else if (VECTORP (data)) /* Vector of ARGB32 integers. */ + { + if (ASIZE (data) != expected_size) + { + image_error ("Canvas :data size mismatch"); + return; + } + + for (ptrdiff_t i = 0; i < expected_size; ++i) + { + Lisp_Object pixel = AREF (data, i); + if (!FIXNUMP (pixel)) + { + image_error ("Expected fixnum in the canvas :data vector"); + return; + } + c->data[i] = (uint32_t) XFIXNUM (pixel); + } + } + else if (STRINGP (file)) /* Binary file with ARGB32 data. */ + { + Lisp_Object found = image_find_image_file (file); + if (NILP (found)) + { + image_error ("Cannot find image :file to load for canvas %s", file); + return; + } + + Lisp_Object encoded = ENCODE_FILE (found); + int fd = emacs_open (SSDATA (encoded), O_RDONLY | O_BINARY, 0); + if (fd < 0) + { + image_error ("Cannot open image :file for canvas %s", file); + return; + } + + ptrdiff_t nbytes; + uint32_t *buf = (uint32_t *) slurp_file (fd, &nbytes); + emacs_close (fd); + if (!buf) + { + image_error ("Cannot read image :file for canvas %s", file); + return; + } + + if (nbytes != 4 * expected_size) + { + image_error ("Canvas :file size mismatch for %s", file); + xfree (buf); + return; + } + +#ifdef WORDS_BIGENDIAN + for (ptrdiff_t i = 0; i < expected_size; ++i) + c->data[i] = bswap_32 (buf[i]); +#else + for (ptrdiff_t i = 0; i < expected_size; ++i) + c->data[i] = buf[i]; +#endif + + xfree (buf); + } +} + +/* Get canvas object for IMAGE specification. Returns NULL on error. */ + +static struct canvas* +canvas_get (Lisp_Object image, struct image_keyword *fmt) +{ + if (!canvas_parse (image, fmt)) + { + image_error ("Not a canvas image specification"); + return NULL; + } + + Lisp_Object canvas_ptr = Fgethash (image, canvas_map, Qnil); + struct canvas* c = NILP (canvas_ptr) ? 0 : XFIXNUMPTR (canvas_ptr); + int width = XFIXNAT (fmt[CANVAS_WIDTH].value), + height = XFIXNAT (fmt[CANVAS_HEIGHT].value); + + if (!c) + { + /* Free old canvases now, when allocating a new one, to keep + memory usage low. */ + canvas_free_unused (); + + c = xzalloc (sizeof (struct canvas)); + c->refresh = 2; /* 2 in order to enforce first refresh. */ + c->width = width; + c->height = height; + c->data = xzalloc (4 * width * height); + + /* Register the canvas in the list and the map. */ + c->next = canvas_list; + canvas_list = c; + Fputhash (image, make_pointer_integer (c), canvas_map); + + /* Initialize pixel buffer from :data or :file if supplied. */ + canvas_apply_data (c, fmt); + } + else if (c->width != width || c->height != height) + { + /* Resize canvas. */ + c->width = width; + c->height = height; + c->data = xrealloc (c->data, 4 * width * height); + memset (c->data, 0, 4 * width * height); + + /* Initialize pixel buffer from :data or :file if supplied. */ + canvas_apply_data (c, fmt); + } + + return c; +} + +/* Create canvas IMG in frame F. Value is true if successful. */ + +static bool +canvas_load (struct frame *f, struct image *img) +{ + struct image_keyword fmt[CANVAS_LAST]; + struct canvas* c = canvas_get (img->spec, fmt); + + if (!c) + return false; + + img->lisp_data = make_pointer_integer (c); + img->refresh = 1; /* refresh is always > 0 for canvas images */ + img->width = c->width; + img->height = c->height; + img->background_valid = 1; + img->background_transparent_valid = 1; + + Emacs_Pix_Container ximg; + if (!image_create_x_image_and_pixmap (f, img, c->width, c->height, 0, &ximg, 0)) + return false; + + image_put_x_image (f, img, ximg, 0); + + return true; +} +/* Prepare image IMG from canvas for display. */ + +static void +canvas_prepare_for_display (struct frame *f, struct image *img) +{ + struct canvas *c = XFIXNUMPTR (img->lisp_data); + img->refresh = c->refresh; + uint32_t *src = c->data; + int width = c->width, height = c->height; + + /* If canvas has been resized in the meantime and the image is stale, + mark frame as garbaged and wait for redisplay. See also + uncache_image which handles stale images. */ + if (width != img->original_width || height != img->original_height) + { + SET_FRAME_GARBAGED (f); + return; + } + + block_input (); + +#ifdef USE_CAIRO + /* Cairo: Optimized canvas reloading. Reuse the existing Cairo surface. */ + cairo_surface_t* surface; + if (img->cr_data + /* prepare_image_for_display ensures that cr_data is a surface pattern */ + && cairo_pattern_get_type (img->cr_data) == CAIRO_PATTERN_TYPE_SURFACE + && !cairo_pattern_get_surface (img->cr_data, &surface)) + { + cairo_surface_flush (surface); + int stride = cairo_image_surface_get_stride (surface); + unsigned char *dst = cairo_image_surface_get_data (surface); + /* Alpha channel is preserved here. Potentially preserve it when + drawing the image in x_draw_image_glyph_string? */ + if (stride == 4 * width) /* Fast path */ + { + memcpy (dst, src, stride * height); + } + else + { + for (int y = 0; y < height; ++y) + memcpy (dst + (y * stride), src + (y * width), 4 * width); + } + cairo_surface_mark_dirty (surface); + } +#elif defined HAVE_X_WINDOWS + /* X11: Optimized canvas reloading. Reuse the existing pixmap. */ + int depth = FRAME_DISPLAY_INFO (f)->n_planes; + XImage *ximg = XCreateImage (FRAME_X_DISPLAY (f), FRAME_X_VISUAL (f), + depth, ZPixmap, 0, NULL, width, height, + depth > 16 ? 32 : depth > 8 ? 16 : 8, 0); + if (ximg) + { + ximg->data = xmalloc (ximg->bytes_per_line * height); + for (int y = 0; y < height; ++y) + { + for (int x = 0; x < width; ++x) + { + uint32_t c = src[y * width + x], + r = (c >> 16) & 255, + g = (c >> 8) & 255, + b = c & 255; + PUT_PIXEL (ximg, x, y, lookup_rgb_color (f, r << 8, g << 8, b << 8)); + } + } + gui_put_x_image (f, ximg, img->pixmap, width, height); + x_destroy_x_image (ximg); + } +#elif defined HAVE_ANDROID + /* Android: Optimized canvas reloading. Reuse the existing pixmap. */ + struct android_image *ximg = android_create_image (FRAME_DISPLAY_INFO (f)->n_planes, + ANDROID_Z_PIXMAP, NULL, width, height); + if (ximg) + { + ximg->data = xmalloc (ximg->bytes_per_line * height); + for (int y = 0; y < height; ++y) + for (int x = 0; x < width; ++x) + PUT_PIXEL (ximg, x, y, src[y * width + x] & 0x00FFFFFF); + gui_put_x_image (f, ximg, img->pixmap, width, height); + image_destroy_x_image (ximg); + } +#elif defined HAVE_NS + /* NS: Recreates and fills the pixmap. This is a workaround, ideally + we'd like to recache the NSImage instead. */ + img->pixmap = ns_image_reset(img->pixmap, width, height); + for (int y = 0; y < height; ++y) + for (int x = 0; x < width; ++x) + PUT_PIXEL (img->pixmap, x, y, src[y * width + x]); +#else + /* Platform independent canvas reloading. Less efficient, since it + recreates images and pixmaps. */ + FRAME_TERMINAL (f)->free_pixmap (f, img->pixmap); + img->pixmap = NO_PIXMAP; + Emacs_Pix_Container ximg; + if (image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0)) + { + for (int y = 0; y < height; ++y) + for (int x = 0; x < width; ++x) + { + uint32_t c = src[y * width + x], + r = (c >> 16) & 255, + g = (c >> 8) & 255, + b = c & 255; + PUT_PIXEL (ximg, x, y, lookup_rgb_color (f, r << 8, g << 8, b << 8)); + } + image_put_x_image (f, img, ximg, 0); + } +#endif + + unblock_input (); +} + +/* Access canvas buffer. Note that the pixel buffer + is valid only as long as its dimensions have not been changed.*/ + +uint32_t * +canvas_data (Lisp_Object image) +{ + struct image_keyword fmt[CANVAS_LAST]; + struct canvas* c = canvas_get (image, fmt); + + if (!c) + error ("Not a canvas"); + + return c->data; +} + +DEFUN ("canvas-refresh", Fcanvas_refresh, Scanvas_refresh, 1, 2, 0, + doc: /* Refresh canvas IMAGE and update it on screen. + +If RELOAD-DATA is non-nil, reload the :data or :file from the image +specification before redrawing the canvas. + +When `canvas-refresh' is called from a timer or a command, `redisplay' +will be called implicitly after the timer or command. `redisplay' must +be called explicitly after `canvas-refresh' only when the redraw should +happen from a loop. See Info node `(elisp) Canvas Images' for +examples. */) + (Lisp_Object image, Lisp_Object reload_data) +{ + struct image_keyword fmt[CANVAS_LAST]; + struct canvas* c = canvas_get (image, fmt); + + if (!c) + error ("Not a canvas"); + + /* Reload :data or :file from the image specification. */ + if (!NILP (reload_data)) + canvas_apply_data (c, fmt); + + /* Increment refresh counter; reset to one on overflow, since the + refresh counter must always be greater than zero. */ + if (++c->refresh == 0) + c->refresh = 1; + +#ifdef HAVE_WINDOW_SYSTEM + /* Redraw all image glyphs. */ + block_input (); + redraw_image_glyphs (image); + /* We do not call `redisplay' or `flush_frame' here. This means the + canvas images are not updated immediately on screen, since the + double buffer won't be flipped immediately. The next call to + `redisplay' will flip the double buffer. */ + unblock_input (); +#endif + + return Qnil; +} /*********************************************************************** @@ -12977,6 +13470,7 @@ static struct image_type const image_types[] = #endif { SYMBOL_INDEX (Qxbm), xbm_image_p, xbm_load, image_clear_image }, { SYMBOL_INDEX (Qpbm), pbm_image_p, pbm_load, image_clear_image }, + { SYMBOL_INDEX (Qcanvas), canvas_image_p, canvas_load, image_clear_image }, }; #if HAVE_NATIVE_IMAGE_API @@ -13127,6 +13621,13 @@ non-numeric, there is no explicit limit on the size of images. */); ); #endif + DEFSYM (Qcanvas, "canvas"); + add_image_type (Qcanvas); + + canvas_map = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_Key); + staticpro (&canvas_map); + defsubr (&Scanvas_refresh); + DEFSYM (Qpbm, "pbm"); add_image_type (Qpbm); diff --git a/src/module-env-32.h b/src/module-env-32.h index 8051066bf88..d078a7b7315 100644 --- a/src/module-env-32.h +++ b/src/module-env-32.h @@ -1,3 +1,12 @@ /* Add module environment functions newly added in Emacs 32 here. Before Emacs 32 is released, remove this comment and start module-env-33.h on master (see admin/release-branch.txt). */ + + /* Get pointer to the pixel buffer of CANVAS. The buffer is in row + major order and has the size width * height. The pixel format is + ARGB32 on all platforms. The pointer will be valid as long as + CANVAS is alive, and as long as its dimensions have not been + changed. Return NULL in case of error. */ + + uint32_t *(*canvas_data) (emacs_env *env, emacs_value canvas) + EMACS_ATTRIBUTE_NONNULL(1); diff --git a/src/nsimage.m b/src/nsimage.m index 426ce20eb05..f396d424ffe 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -256,6 +256,13 @@ ns_set_alpha (void *img, int x, int y, unsigned char a) [(EmacsImage *)img setAlphaAtX: x Y: y to: a]; } +void * +ns_image_reset (void *img, int width, int height) +{ + [(EmacsImage *)img release]; + return ns_image_for_XPM (width, height, 32); +} + size_t ns_image_size_in_bytes (void *img) { diff --git a/src/nsterm.h b/src/nsterm.h index b21dd519e4b..69f565d51f9 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1215,6 +1215,7 @@ extern void ns_image_set_smoothing (void *img, bool smooth); extern unsigned long ns_get_pixel (void *img, int x, int y); extern void ns_put_pixel (void *img, int x, int y, unsigned long argb); extern void ns_set_alpha (void *img, int x, int y, unsigned char a); +extern void *ns_image_reset (void *img, int width, int height); extern int ns_display_pixel_height (struct ns_display_info *); extern int ns_display_pixel_width (struct ns_display_info *); diff --git a/src/xdisp.c b/src/xdisp.c index 13956673be1..a049c65b21b 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -32850,6 +32850,82 @@ append_stretch_glyph (struct it *it, Lisp_Object object, IT_EXPAND_MATRIX_WIDTH (it, area); } +static void +redraw_image_glyphs_window (struct window *w, Lisp_Object spec) +{ + if (w->current_matrix == NULL) + return; + + struct frame* f = WINDOW_XFRAME (w); + + if (w->must_be_updated_p) + { + SET_FRAME_GARBAGED (f); + return; + } + + for (int area = LEFT_MARGIN_AREA; area < LAST_AREA; ++area) + { + for (int y = 0; y < w->current_matrix->nrows; ++y) + { + struct glyph_row *row = w->current_matrix->rows + y; + if (row->enabled_p) + { + int pos_x = area == TEXT_AREA ? row->x : 0; + for (int x = 0; x < row->used[area]; ++x) + { + struct glyph *glyph = row->glyphs[area] + x; + if (glyph->type == IMAGE_GLYPH) + { + struct image* img = + IMAGE_OPT_FROM_ID (f, glyph->u.img_id); + if (img && EQ (img->spec, spec)) + { + prepare_image_for_display (f, img); + draw_glyphs (w, pos_x, row, area, x, x + 1, + DRAW_NORMAL_TEXT, 0); + } + } + pos_x += glyph->pixel_width; + } + } + } + } +} + +static void +redraw_image_glyphs_window_tree (struct window *w, Lisp_Object spec) +{ + while (w) + { + if (WINDOWP (w->contents)) + redraw_image_glyphs_window_tree (XWINDOW (w->contents), spec); + else + redraw_image_glyphs_window (w, spec); + w = NILP (w->next) ? NULL : XWINDOW (w->next); + } +} + +/* redraw_image_glyphs: Redraw only the image glyphs. Image redrawing is similar to the + handling of Expose or GraphicsExpose events in xterm.c. + GraphicsExpose event + -> expose_frame -> expose_window_tree -> expose_window + -> expose_line -> expose_area -> draw_glyphs */ + +void +redraw_image_glyphs (Lisp_Object spec) +{ + Lisp_Object tail, frame; + FOR_EACH_FRAME (tail, frame) + { + /* When the frame is garbaged, wait for full redisplay. Only use + the fast path when the frame is in a consistent state. */ + struct frame* f = XFRAME (frame); + if (!FRAME_GARBAGED_P (f)) + redraw_image_glyphs_window_tree (XWINDOW (f->root_window), spec); + } +} + #endif /* HAVE_WINDOW_SYSTEM */ /* Produce a stretch glyph for iterator IT. IT->object is the value diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c index 3dabca1aa43..a06bb752e85 100644 --- a/test/src/emacs-module-resources/mod-test.c +++ b/test/src/emacs-module-resources/mod-test.c @@ -752,6 +752,118 @@ Fmod_test_make_string (emacs_env *env, ptrdiff_t nargs, return ret; } +/* djb2 hash over all the pixels */ + +static uint32_t +canvas_hash (uint32_t *buf, int width, int height) +{ + uint32_t hash = 5381; + + for (int i = 0; i < width * height; i++) + hash = hash * 33 ^ buf[i]; + + return hash; +} + +static emacs_value +Fmod_test_canvas_read (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, void *data) +{ + assert (nargs == 3); + uint32_t *buf = env->canvas_data (env, args[0]); + + if (!buf) + { + signal_error(env, "Not a valid canvas"); + return env->intern (env, "nil"); + } + + int width = (int) env->extract_integer (env, args[1]); + int height = (int) env->extract_integer (env, args[2]); + + /* Validate dimensions against the canvas image spec. */ + emacs_value Qimage_property = env->intern (env, "image-property"); + emacs_value Qdata_width = env->intern (env, ":data-width"); + emacs_value Qdata_height = env->intern (env, ":data-height"); + emacs_value iw_val = env->funcall (env, Qimage_property, 2, + (emacs_value[]){args[0], Qdata_width}); + emacs_value ih_val = env->funcall (env, Qimage_property, 2, + (emacs_value[]){args[0], Qdata_height}); + int iw = (int) env->extract_integer (env, iw_val); + int ih = (int) env->extract_integer (env, ih_val); + + if (width != iw || height != ih) + { + signal_error (env, "Canvas size mismatch"); + return env->intern (env, "nil"); + } + + uint32_t hash = canvas_hash (buf, width, height); + + return env->make_integer (env, (intmax_t) hash); +} + +static emacs_value +Fmod_test_canvas_write (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, void *data) +{ + assert (nargs == 3); + uint32_t *buf = env->canvas_data (env, args[0]); + + if (!buf) + { + signal_error(env, "Not a valid canvas"); + return env->intern (env, "nil"); + } + + int width = (int) env->extract_integer (env, args[1]); + int height = (int) env->extract_integer (env, args[2]); + + /* Validate dimensions against the canvas image spec. */ + emacs_value Qimage_property = env->intern (env, "image-property"); + emacs_value Qdata_width = env->intern (env, ":data-width"); + emacs_value Qdata_height = env->intern (env, ":data-height"); + emacs_value iw_val = env->funcall (env, Qimage_property, 2, + (emacs_value[]){args[0], Qdata_width}); + emacs_value ih_val = env->funcall (env, Qimage_property, 2, + (emacs_value[]){args[0], Qdata_height}); + int iw = (int) env->extract_integer (env, iw_val); + int ih = (int) env->extract_integer (env, ih_val); + + if (width != iw || height != ih) + { + signal_error (env, "Canvas size mismatch"); + return env->intern (env, "nil"); + } + + for (int i = 0; i < width * height; i++) + buf[i] = ~buf[i]; // invert the pixels + + emacs_value canvas_args[2] = {args[0], env->intern (env, "nil")}; + env->funcall (env, env->intern (env, "canvas-refresh"), 2, canvas_args); + + return env->intern (env, "t"); +} + +static emacs_value +Fmod_test_canvas_invalid (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, void *data) +{ + assert (nargs == 1); + uint32_t *buf = env->canvas_data (env, args[0]); + + if (env->non_local_exit_check (env) != emacs_funcall_exit_return) + env->non_local_exit_clear (env); /* Don't propagate the error to ERT */ + + if (buf) + { + signal_error (env, "Expected invalid canvas, but canvas_data returned non-NULL"); + return env->intern (env, "nil"); + } + + return env->intern (env, "t"); +} + /* Lisp utilities for easier readability (simple wrappers). */ /* Provide FEATURE to Emacs. */ @@ -853,6 +965,9 @@ emacs_module_init (struct emacs_runtime *ert) DEFUN ("mod-test-funcall", Fmod_test_funcall, 1, emacs_variadic_function, NULL, NULL); DEFUN ("mod-test-make-string", Fmod_test_make_string, 2, 2, NULL, NULL); + DEFUN ("mod-test-canvas-read", Fmod_test_canvas_read, 3, 3, NULL, NULL); + DEFUN ("mod-test-canvas-write", Fmod_test_canvas_write, 3, 3, NULL, NULL); + DEFUN ("mod-test-canvas-invalid", Fmod_test_canvas_invalid, 1, 1, NULL, NULL); #undef DEFUN diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index e678fba3873..5ee775d12f8 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -588,4 +588,121 @@ See Bug#36226." (should (string-equal first second)) (should-not (eq first second)))))) +;;; Canvas tests + +(defun test-canvas-gen-file (width height pixel) + (let* ((bytes (unibyte-string (logand pixel #xff) + (logand (ash pixel -8) #xff) + (logand (ash pixel -16) #xff) + (logand (ash pixel -24) #xff))) + (coding-system-for-write 'no-conversion)) + (with-temp-file "data/image/canvas-argb" + (set-buffer-multibyte nil) + (dotimes (_ (* width height)) + (insert bytes))) + t)) + +(ert-deftest mod-test-canvas/valid () + (let* ((width 128) (height 215) + (canvas `(image :type canvas :id test-canvas + :data-width ,width :data-height ,height)) + (hash-before (mod-test-canvas-read canvas width height))) + (should (integerp hash-before)) + (should (mod-test-canvas-write canvas width height)) + (let ((hash-after (mod-test-canvas-read canvas width height))) + (should (integerp hash-after)) + (should (not (eql hash-before hash-after)))))) + +(ert-deftest mod-test-canvas/invalid () + (should-error (mod-test-canvas-read nil nil nil)) + (should-error (mod-test-canvas-write nil nil nil)) + (should (mod-test-canvas-invalid nil)) + (should (mod-test-canvas-invalid '(image :type xbm :data ""))) + (should-error (mod-test-canvas-read '(image :type canvas) 256 527)) + (should-error (mod-test-canvas-write '(image :type canvas) 256 527))) + +(ert-deftest mod-test-canvas/vector () + (let* ((width 327) (height 98) + (canvas `(image :type canvas :id test-canvas + :data-width ,width :data-height ,height + :data ,(make-vector (* width height) #xFFFF0000))) + (hash-before (mod-test-canvas-read canvas width height))) + (should (integerp hash-before)) + (should (mod-test-canvas-write canvas width height)) + (should (not (eql (mod-test-canvas-read canvas width height) hash-before)))) + ;; Mismatched sizes: passing wrong width/height should error. + (let* ((width 327) (height 98) + (canvas `(image :type canvas :id test-canvas + :data-width ,width :data-height ,height + :data ,(make-vector (* width height) #xFFFF0000)))) + (should-error (mod-test-canvas-read canvas 501 72)) + (should-error (mod-test-canvas-write canvas 187 210)))) + +(ert-deftest mod-test-canvas/vector-reload () + (let* ((width 198) (height 720) + (test-vector (make-vector (* width height) #xFFFF0000)) + (canvas `(image :type canvas :id test-canvas + :data-width ,width :data-height ,height + :data ,test-vector)) + (hash-initial (mod-test-canvas-read canvas width height))) + (should (integerp hash-initial)) + (dotimes (i 50) + (aset test-vector i #xFFFFFFFF)) + (canvas-refresh canvas t) + (let ((hash-mutated (mod-test-canvas-read canvas width height))) + (should (integerp hash-mutated)) + (should (not (eql hash-initial hash-mutated)))))) + +(ert-deftest mod-test-canvas/unibyte () + (let* ((width 458) (height 278) + (pixel (unibyte-string #xFF #x80 #x40 #x80)) + (string-data (apply #'concat (make-list (* width height) pixel))) + (canvas `(image :type canvas :id test-canvas + :data-width ,width :data-height ,height + :data ,string-data)) + (hash-before (mod-test-canvas-read canvas width height))) + (should (integerp hash-before)) + (should (mod-test-canvas-write canvas width height)) + (should (not (eql (mod-test-canvas-read canvas width height) hash-before)))) + ;; Mismatched sizes: passing wrong width/height should error. + (let* ((width 458) (height 278) + (pixel (unibyte-string #xFF #x80 #x40 #x80)) + (string-data (apply #'concat (make-list (* width height) pixel))) + (canvas `(image :type canvas :id test-canvas + :data-width ,width :data-height ,height + :data ,string-data))) + (should-error (mod-test-canvas-read canvas 76 38)) + (should-error (mod-test-canvas-write canvas 378 453)))) + +(ert-deftest mod-test-canvas/file () + ;; Generate the canvas data file + (test-canvas-gen-file 128 98 #x80800000) + (let* ((width 128) (height 98) + (canvas (create-image "../data/image/canvas-argb" + 'canvas nil + :data-width width :data-height height)) + (hash-before (mod-test-canvas-read canvas width height))) + (should (integerp hash-before)) + (should (mod-test-canvas-write canvas width height)) + (should (not (eql (mod-test-canvas-read canvas width height) hash-before)))) + ;; Mismatched sizes: passing wrong width/height should error. + (let ((canvas (create-image "../data/image/canvas-argb" + 'canvas nil + :data-width 128 :data-height 98))) + (should-error (mod-test-canvas-read canvas 28 76)) + (should-error (mod-test-canvas-write canvas 398 712)))) + +(ert-deftest mod-test-canvas/gc-stress () + "Allocate canvases in batches with GC between batches. +Verifies that canvas pixel buffers are freed correctly and do not +cause use-after-free crashes or GC assertion failures." + (dotimes (_ 10) + (dotimes (x 20) + (let* ((canvas `(image :type canvas :id test-canvas + :data-width ,(+ x 10) + :data-height ,(+ x 20))) + (hash (mod-test-canvas-read canvas (+ x 10) (+ x 20)))) + (should (integerp hash)))) + (garbage-collect))) + ;;; emacs-module-tests.el ends here