/* Canvas support for GNU Emacs.
   Copyright (C) 2020 Free Software Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */

#include "canvas.h"
#include "coding.h"

#include <math.h>

Lisp_Object
make_canvas (int width, int height)
{
#ifndef USE_CAIRO
  error ("Canvases are not supported without cairo.")
#endif
  struct canvas *canvas = ALLOCATE_PSEUDOVECTOR
    (struct canvas, object, PVEC_CANVAS);
  canvas->width = width;
  canvas->height = height;
  canvas->object = Qnil;
  canvas->multiple_objects_seen = false;
  canvas->canvas = make_canvas_contents (width, height);
  canvas->changed_since_last_redisplay = true;

  Lisp_Object cnvs;
  XSETCANVAS (cnvs, canvas);
  return cnvs;
}

void
destroy_canvas_contents (canvas_contents_t contents)
{
#ifdef USE_CAIRO
  cairo_surface_destroy (contents);
#else
  error ("Not implemented");
#endif
}

canvas_contents_t
make_canvas_contents (int width, int height)
{
#ifdef USE_CAIRO
  cairo_surface_t *crs =
    cairo_image_surface_create (CAIRO_FORMAT_ARGB32, width, height);
  return crs;
#else
  error ("Not implemented");
#endif
}

void
canvas_end_redisplay (struct window *w,
		      struct glyph_matrix *matrix)
{
  int i;
  int area;

  struct canvas **unmark_canvases;
  ptrdiff_t unmark_size = 0;
  unmark_canvases = xmalloc (sizeof *unmark_canvases * unmark_size);

  for (i = 0; i < matrix->nrows; ++i)
    {
      struct glyph_row *row;
      row = MATRIX_ROW (matrix, i);
      if (row->enabled_p)
        for (area = LEFT_MARGIN_AREA; area < LAST_AREA; ++area)
          {
            struct glyph *glyph = row->glyphs[area];
            struct glyph *glyph_end = glyph + row->used[area];
            for (; glyph < glyph_end; ++glyph)
              if (glyph->type == CANVAS_GLYPH &&
		  glyph->u.canvas->changed_since_last_redisplay)
                {
		  ++unmark_size;
                  unmark_canvases
                    = xrealloc (unmark_canvases,
                                (sizeof *unmark_canvases * unmark_size));
		  unmark_canvases[unmark_size - 1] = glyph->u.canvas;
                  canvas_update_glyph
		    (w, i, row, area, row->glyphs[area] -
		     glyph, 1 + row->glyphs[area] - glyph,
		     glyph);
                }
          }
    }
  for (; unmark_size; unmark_size--)
    unmark_canvases[unmark_size - 1]->changed_since_last_redisplay = false;
  xfree (unmark_canvases);
}

DEFUN ("make-canvas", Fmake_canvas, Smake_canvas, 2, 2, 0,
       doc: /* Create a canvas, WIDTH pixels wide, and HEIGHT pixels tall. */)
  (Lisp_Object width, Lisp_Object height)
{
  check_integer_range (height, 0, INT_MAX);
  check_integer_range (width, 0, INT_MAX);

  return make_canvas (XFIXNUM (width), XFIXNUM (height));
}

DEFUN ("canvas-ellipse", Fcanvas_ellipse, Scanvas_ellipse, 5, 8, 0,
       doc: /* Draw a WIDTH wide and HEIGHT tall ellipse centred at X, Y in CANVAS.
The color of the ellipse will be COLOR (or the foreground color of COLOR is nil).
The ellipse will be hollow if HOLLOW is non-nil.
The opacity of the circle will be OPACITY, which should be a floating-point
number between 1 and 0. */)
  (Lisp_Object canvas, Lisp_Object x, Lisp_Object y,
   Lisp_Object width, Lisp_Object height, Lisp_Object color,
   Lisp_Object hollow, Lisp_Object opacity)
{
    if (NILP (opacity))
    opacity = make_float (1.0);
  CHECK_CANVAS (canvas);
  check_integer_range (x, 0, INT_MAX);
  check_integer_range (y, 0, INT_MAX);
  check_integer_range (width, 0, INT_MAX);
  check_integer_range (height, 0, INT_MAX);
  CHECK_NUMBER (opacity);
#ifdef USE_CAIRO
  if (NILP (color))
    color = Qunspecified;
  Lisp_Object color_values = call1 (Qcolor_values, color);
  if (!NILP (color_values))
    CHECK_LIST (color_values);
  double r, g, b;
  if (NILP (color_values))
    {
      Emacs_Color col;
      col.pixel = FRAME_FOREGROUND_PIXEL (XFRAME (selected_frame));
      FRAME_TERMINAL (XFRAME (selected_frame))->query_colors
	(XFRAME (selected_frame), &col, 1);
      r = col.red / 65535.0;
      g = col.green / 65535.0;
      b = col.blue / 65535.0;
    }
  else
    {
      Lisp_Object lr = Fnth (make_fixnum (0), color_values),
	lg = Fnth (make_fixnum (1), color_values),
	lb = Fnth (make_fixnum (2), color_values);

      check_integer_range (lr, 0, 65535);
      check_integer_range (lg, 0, 65535);
      check_integer_range (lb, 0, 65535);

      r = XFIXNUM (lr) / 65535.0;
      g = XFIXNUM (lg) / 65535.0;
      b = XFIXNUM (lb) / 65535.0;
    }
  struct canvas *cv = XCANVAS (canvas);
  cairo_t *cr = cairo_create (cv->canvas);
  cairo_set_source_rgba (cr, r, g, b, XFLOATINT (opacity));
  cairo_matrix_t save_matrix;
  cairo_get_matrix (cr, &save_matrix);
  cairo_translate (cr, XFIXNUM (x), XFIXNUM (y));
  cairo_scale (cr, 1, 1);
  cairo_new_path (cr);
  cairo_arc (cr, 0, 0,
             XFIXNUM (width) / 2.0, 0, 2 * M_PI);
  cairo_set_matrix (cr, &save_matrix);

  cairo_set_line_width (cr, canvas_stroke_width);
  if (!NILP (hollow))
    cairo_stroke (cr);
  else
    cairo_fill (cr);

  cairo_destroy (cr);
  MARK_CANVAS_CHANGED (cv);
#endif
  return Qnil;
}

DEFUN ("canvasp", Fcanvasp, Scanvasp, 1, 1, 0,
       doc: /* Return t if CANVAS is a canvas, else nil.  */)
  (Lisp_Object canvas)
{
  return CANVASP (canvas) ? Qt : Qnil;
}

DEFUN ("canvas-rectangle", Fcanvas_rectangle, Scanvas_rectangle, 5, 8, 0,
       doc: /* Draw a WIDTH wide and HEIGHT tall rectangle at X, Y in CANVAS.
The color of the rectangle will be COLOR (or the foreground color of COLOR is nil).
The rectangle will be hollow if HOLLOW is non-nil.
The opacity of the circle will be OPACITY, which should be a floating-point
number between 1 and 0. */)
  (Lisp_Object canvas, Lisp_Object x, Lisp_Object y,
   Lisp_Object width, Lisp_Object height, Lisp_Object color,
   Lisp_Object hollow, Lisp_Object opacity)
{
  if (NILP (opacity))
    opacity = make_float (1.0);
  CHECK_CANVAS (canvas);
  check_integer_range (x, 0, INT_MAX);
  check_integer_range (y, 0, INT_MAX);
  check_integer_range (width, 0, INT_MAX);
  check_integer_range (height, 0, INT_MAX);
  CHECK_NUMBER (opacity);
#ifdef USE_CAIRO
  if (NILP (color))
    color = Qunspecified;
  Lisp_Object color_values = call1 (Qcolor_values, color);
  if (!NILP (color_values))
    CHECK_LIST (color_values);
  double r, g, b;
  if (NILP (color_values))
    {
      Emacs_Color col;
      col.pixel = FRAME_FOREGROUND_PIXEL (XFRAME (selected_frame));
      FRAME_TERMINAL (XFRAME (selected_frame))->query_colors
	(XFRAME (selected_frame), &col, 1);
      r = col.red / 65535.0;
      g = col.green / 65535.0;
      b = col.blue / 65535.0;
    }
  else
    {
      Lisp_Object lr = Fnth (make_fixnum (0), color_values),
	lg = Fnth (make_fixnum (1), color_values),
	lb = Fnth (make_fixnum (2), color_values);

      check_integer_range (lr, 0, 65535);
      check_integer_range (lg, 0, 65535);
      check_integer_range (lb, 0, 65535);

      r = XFIXNUM (lr) / 65535.0;
      g = XFIXNUM (lg) / 65535.0;
      b = XFIXNUM (lb) / 65535.0;
    }
  struct canvas *cv = XCANVAS (canvas);
  cairo_t *cr = cairo_create (cv->canvas);
  cairo_set_source_rgba (cr, r, g, b, XFLOATINT (opacity));
  if (NILP (hollow))
    {
      cairo_rectangle (cr, XFIXNUM (x), XFIXNUM (y), XFIXNUM (width),
		       XFIXNUM (height));
      cairo_fill (cr);
    }
  else
    {
      cairo_rectangle (cr, XFIXNUM (x), XFIXNUM (y), XFIXNUM (width),
		       XFIXNUM (height));
      cairo_stroke (cr);
    }
  cairo_destroy (cr);
  MARK_CANVAS_CHANGED (cv);
  return Qnil;
#else
  error ("Not implemented");
#endif
}

DEFUN ("canvas-rounded-rectangle", Fcanvas_rounded_rectangle, Scanvas_rounded_rectangle, 6, MANY, 0,
       doc: /* Draw a WIDTH wide and HEIGHT tall rectangle at X, Y in CANVAS.
The color of the rectangle will be COLOR (or the foreground color of COLOR is nil).
The rectangle will be hollow if HOLLOW is non-nil.
The opacity of the circle will be OPACITY, which should be a floating-point
number between 1 and 0.
usage: (canvas-rounded-rectangle canvas x y width height radius &optional color hollow opacity)  */)
  (ptrdiff_t nargs, Lisp_Object *args)
{
  Lisp_Object canvas, x, y, width, height, radius, color, hollow, opacity;
  canvas = args[0];
  x = args[1];
  y = args[2];
  width = args[3];
  height = args[4];
  radius = args[5];
  color = Qnil;
  hollow = Qnil;
  opacity = Qnil;

  if (nargs > 6)
    color = args[6];
  if (nargs > 7)
    hollow = args[7];
  if (nargs > 8)
    opacity = args[8];
  if (nargs > 9)
    xsignal2 (Qwrong_number_of_arguments,
	      Qcanvas_rounded_rectangle,
	      make_fixnum (nargs));
  if (NILP (opacity))
    opacity = make_float (1.0);
  CHECK_CANVAS (canvas);
  check_integer_range (x, 0, INT_MAX);
  check_integer_range (y, 0, INT_MAX);
  check_integer_range (width, 0, INT_MAX);
  check_integer_range (height, 0, INT_MAX);
  CHECK_NUMBER (opacity);
#ifdef USE_CAIRO
  if (NILP (color))
    color = Qunspecified;
  Lisp_Object color_values = call1 (Qcolor_values, color);
  if (!NILP (color_values))
    CHECK_LIST (color_values);
  double r, g, b;
  if (NILP (color_values))
    {
      Emacs_Color col;
      col.pixel = FRAME_FOREGROUND_PIXEL (XFRAME (selected_frame));
      FRAME_TERMINAL (XFRAME (selected_frame))->query_colors
	(XFRAME (selected_frame), &col, 1);
      r = col.red / 65535.0;
      g = col.green / 65535.0;
      b = col.blue / 65535.0;
    }
  else
    {
      Lisp_Object lr = Fnth (make_fixnum (0), color_values),
	lg = Fnth (make_fixnum (1), color_values),
	lb = Fnth (make_fixnum (2), color_values);

      check_integer_range (lr, 0, 65535);
      check_integer_range (lg, 0, 65535);
      check_integer_range (lb, 0, 65535);

      r = XFIXNUM (lr) / 65535.0;
      g = XFIXNUM (lg) / 65535.0;
      b = XFIXNUM (lb) / 65535.0;
    }
  struct canvas *cv = XCANVAS (canvas);
  cairo_t *cr = cairo_create (cv->canvas);
  cairo_set_source_rgba (cr, r, g, b, XFLOATINT (opacity));
  {
#define radius XFLOATINT (radius)
    double degrees = M_PI / 180.0;
#define width XFIXNUM (width)
#define height XFIXNUM (height)
#define x XFIXNUM (x)
#define y XFIXNUM (y)
    cairo_new_sub_path (cr);
    cairo_arc (cr, x + width - radius, y + radius, radius, -90 * degrees, 0 * degrees);
    cairo_arc (cr, x + width - radius, y + height - radius, radius, 0 * degrees, 90 * degrees);
    cairo_arc (cr, x + radius, y + height - radius, radius, 90 * degrees, 180 * degrees);
    cairo_arc (cr, x + radius, y + radius, radius, 180 * degrees, 270 * degrees);
    cairo_close_path (cr);
#undef radius
#undef y
#undef x
#undef height
#undef width
  }
#undef radius
  cairo_set_line_width (cr, canvas_stroke_width);
  if (NILP (hollow))
    cairo_fill (cr);
  else
    cairo_stroke (cr);
  cairo_destroy (cr);
  MARK_CANVAS_CHANGED (cv);
  return Qnil;
#else
  error ("Not implemented");
#endif
}

DEFUN ("canvas-draw-string", Fcanvas_draw_string, Scanvas_draw_string, 4, 8, 0,
       doc: /* Draw the string STRING onto the canvas CANVAS at X, Y.
The opacity of the drawn text will be OPACITY, and the color of the drawn text will be COLOR.
The font-family used will be FAMILY, which can be a string or a list of
the font-family as a string, whether or not the the text should be italic,
and whether or not the text should be bold.
The size of the text will be SIZE, or the default text size if nil. */)
  (Lisp_Object canvas, Lisp_Object x, Lisp_Object y, Lisp_Object string,
   Lisp_Object color, Lisp_Object opacity, Lisp_Object family, Lisp_Object size)
{
  if (noninteractive)
    error ("`canvas-draw-string' cannot be called when running in batch mode.");
  if (NILP (opacity))
    opacity = make_float (1.0);
  if (NILP (size))
    size = make_fixnum (FRAME_TEXT_HEIGHT (XFRAME (selected_frame)));
  if (NILP (family))
    family = build_string ("monospace");
  CHECK_CANVAS (canvas);
  check_integer_range (x, 0, INT_MAX);
  check_integer_range (y, 0, INT_MAX);
  CHECK_NUMBER (opacity);
  if (!Flistp (family))
    CHECK_STRING (family);
  CHECK_STRING (string);
#ifdef USE_CAIRO
  if (NILP (color))
    color = Qunspecified;
  Lisp_Object color_values = call1 (Qcolor_values, color);
  if (!NILP (color_values))
    CHECK_LIST (color_values);
  double r, g, b;
  if (NILP (color_values))
    {
      Emacs_Color col;
      col.pixel = FRAME_FOREGROUND_PIXEL (XFRAME (selected_frame));
      FRAME_TERMINAL (XFRAME (selected_frame))->query_colors
	(XFRAME (selected_frame), &col, 1);
      r = col.red / 65535.0;
      g = col.green / 65535.0;
      b = col.blue / 65535.0;
    }
  else
    {
      Lisp_Object lr = Fnth (make_fixnum (0), color_values),
	lg = Fnth (make_fixnum (1), color_values),
	lb = Fnth (make_fixnum (2), color_values);

      check_integer_range (lr, 0, 65535);
      check_integer_range (lg, 0, 65535);
      check_integer_range (lb, 0, 65535);

      r = XFIXNUM (lr) / 65535.0;
      g = XFIXNUM (lg) / 65535.0;
      b = XFIXNUM (lb) / 65535.0;
    }
  struct canvas *c = XCANVAS (canvas);
  cairo_t *cr = cairo_create (c->canvas);
  cairo_font_slant_t slant_flags = CAIRO_FONT_SLANT_NORMAL;
  cairo_font_weight_t weight_flags = CAIRO_FONT_WEIGHT_NORMAL;
  const char *family_utf8;
  if (!NILP (Flistp (family)))
    {
      if (!NILP (CALLN (Flss, Flength (family), make_fixnum (2))))
	error ("Invalid font spec");
      else
	{
	  int length = XFIXNUM (Flength (family));
	  if (length > 3)
	    error ("Invalid font spec");
	  Lisp_Object italic, bold;
	  CHECK_STRING_CAR (family);
	  family_utf8 = SSDATA (ENCODE_UTF_8 (XCAR (family)));
	  if (length == 3)
	    bold = XCAR (XCDR (XCDR (family)));
	  else
	    bold = Qnil;
	  italic = XCAR (XCDR (family));
	  if (!NILP (italic))
	    slant_flags = CAIRO_FONT_SLANT_ITALIC;
	  if (!NILP (bold))
	    weight_flags = CAIRO_FONT_WEIGHT_BOLD;
	}
    }
  else
    {
      family_utf8 = SSDATA (ENCODE_UTF_8 (family));
    }
  cairo_set_source_rgba (cr, r, g, b, XFLOATINT (opacity));
  cairo_select_font_face (cr, family_utf8,
			  slant_flags,
			  weight_flags);
  cairo_set_font_size (cr, XFIXNUM (size));
  cairo_move_to (cr, XFIXNUM (x), XFIXNUM (y) + XFIXNUM (size));
  cairo_show_text (cr, SSDATA (ENCODE_UTF_8 (string)));
  cairo_destroy (cr);
  MARK_CANVAS_CHANGED (c);
  return Qnil;
#else
  return Qnil;
#endif
}

DEFUN ("canvas-measure-string", Fcanvas_measure_string, Scanvas_measure_string, 2, 4, 0,
       doc: /* Return a pair containing the width and height of STRING,
if drawn on CANVAS with the family FAMILY at SIZE.  */)
(Lisp_Object canvas, Lisp_Object string, Lisp_Object family, Lisp_Object size)
{
  if (noninteractive)
    error ("`canvas-draw-string' cannot be called when running in batch mode.");
  if (NILP (size))
    size = make_fixnum (FRAME_TEXT_HEIGHT (XFRAME (selected_frame)));
  if (NILP (family))
    family = build_string ("cairo:monospace");
  CHECK_CANVAS (canvas);

  if (!Flistp (family))
    CHECK_STRING (family);
  CHECK_STRING (string);
#ifdef USE_CAIRO
  struct canvas *c = XCANVAS (canvas);
  cairo_t *cr = cairo_create (c->canvas);
  cairo_font_slant_t slant_flags = CAIRO_FONT_SLANT_NORMAL;
  cairo_font_weight_t weight_flags = CAIRO_FONT_WEIGHT_NORMAL;
  const char *family_utf8;
  if (!NILP (Flistp (family)))
    {
      if (!NILP (CALLN (Flss, Flength (family), make_fixnum (2))))
	error ("Invalid font spec");
      else
	{
	  int length = XFIXNUM (Flength (family));
	  if (length > 3)
	    error ("Invalid font spec");
	  Lisp_Object italic, bold;
	  CHECK_STRING_CAR (family);
	  family_utf8 = SSDATA (ENCODE_UTF_8 (XCAR (family)));
	  if (length == 3)
	    bold = XCAR (XCDR (XCDR (family)));
	  else
	    bold = Qnil;
	  italic = XCAR (XCDR (family));
	  if (!NILP (italic))
	    slant_flags = CAIRO_FONT_SLANT_ITALIC;
	  if (!NILP (bold))
	    weight_flags = CAIRO_FONT_WEIGHT_BOLD;
	}
    }
  else
    {
      family_utf8 = SSDATA (ENCODE_UTF_8 (family));
    }
  cairo_select_font_face (cr, family_utf8,
			  slant_flags,
			  weight_flags);
  cairo_set_font_size (cr, XFIXNUM (size));
  cairo_text_extents_t extents;
  cairo_text_extents (cr, SSDATA (ENCODE_UTF_8 (string)), &extents);
  cairo_destroy (cr);
  return Fcons (make_fixnum (extents.width),
		make_fixnum (extents.height));
#else
  return Qnil;
#endif
}

DEFUN ("canvas-draw-image", Fcanvas_draw_image, Scanvas_draw_image, 4, 8,
       0, doc: /* Paint IMAGE_SPEC onto CANVAS, at X, Y.
If WIDTH or HEIGHT is set, and IMAGE is wider than WIDTH or taller than HEIGHT,
IMAGE_SPEC will be cropped to fit WIDTH and/or HEIGHT respectively.
FRAME should be a live frame.
The opacity of the drawn image will be OPACITY.  */)
  (Lisp_Object canvas, Lisp_Object image_spec,
   Lisp_Object x, Lisp_Object y,
   Lisp_Object width, Lisp_Object height,
   Lisp_Object frame, Lisp_Object opacity)
{
  if (valid_image_p (image_spec))
    {
      if (NILP (frame))
	frame = selected_frame;
      struct frame *f = decode_window_system_frame (frame);
      ptrdiff_t id = lookup_image (f, image_spec);
      struct image *img = IMAGE_FROM_ID (f, id);
      if (!img)
	return Qnil;
      if (img->load_failed_p)
	return Qnil;
      int iwidth = img->width + 2 * img->hmargin;
      int iheight = img->height + 2 * img->vmargin;
      CHECK_CANVAS (canvas);
      check_integer_range (x, 0, INT_MAX);
      check_integer_range (y, 0, INT_MAX);
      if (NILP (width))
	width = make_fixnum (iwidth);
      check_integer_range (width, 0, INT_MAX);
      if (NILP (height))
	height = make_fixnum (iheight);
      check_integer_range (height, 0, INT_MAX);
      if (NILP (width))
	width = make_fixnum (iwidth);
      if (NILP (opacity))
	opacity = make_fixnum (1);
      CHECK_NUMBER (opacity);
#ifdef USE_CAIRO
      cairo_surface_t *crs
        = cairo_image_surface_create_for_data ((unsigned char *)
                                                 img->pixmap->data,
                                               (img->pixmap->bits_per_pixel
                                                    == 32
                                                  ? CAIRO_FORMAT_RGB24
                                                  : CAIRO_FORMAT_A8),
                                               img->pixmap->width,
                                               img->pixmap->height,
                                               img->pixmap->bytes_per_line);
      struct canvas *cv = XCANVAS (canvas);
      cairo_t *cr = cairo_create (cv->canvas);
      cairo_save (cr);
      cairo_translate (cr, XFIXNUM (x), XFIXNUM (y));
      cairo_rectangle (cr, 0, 0,
		       XFIXNUM (width), XFIXNUM (height));
      cairo_clip (cr);
      cairo_set_source_surface (cr, crs, 0, 0);
      cairo_paint_with_alpha (cr, XFLOATINT (opacity));
      cairo_restore (cr);
      cairo_destroy (cr);
      cairo_surface_destroy (crs);
      MARK_CANVAS_CHANGED (cv);
#endif
    }
  else
    error ("Invalid image specification");
  return Qnil;
}

DEFUN ("canvas-arc", Fcanvas_arc, Scanvas_arc, 6, 8, 0,
       doc: /* Draw an arc on CANVAS starting from XC, YC,
with a radius of RADIUS and 2 angles angle1 and angle2.
Use the color COLOR with the alpha channel set to OPACITY, if specified. */)
  (Lisp_Object canvas, Lisp_Object x, Lisp_Object y, Lisp_Object radius,
   Lisp_Object angle1, Lisp_Object angle2, Lisp_Object color, Lisp_Object opacity)
{
  CHECK_CANVAS (canvas);
  check_integer_range (x, 0, INT_MAX);
  check_integer_range (y, 0, INT_MAX);
  CHECK_NUMBER (angle1);
  CHECK_NUMBER (angle2);
  CHECK_NUMBER (radius);

  if (NILP (opacity))
    opacity = make_fixnum (1.0);
  CHECK_NUMBER (opacity);

#ifdef USE_CAIRO
  if (NILP (color))
    color = Qunspecified;
  Lisp_Object color_values = call1 (Qcolor_values, color);
  if (!NILP (color_values))
    CHECK_LIST (color_values);
  double r, g, b;
  if (NILP (color_values))
    {
      Emacs_Color col;
      col.pixel = FRAME_FOREGROUND_PIXEL (XFRAME (selected_frame));
      FRAME_TERMINAL (XFRAME (selected_frame))
        ->query_colors (XFRAME (selected_frame), &col, 1);
      r = col.red / 65535.0;
      g = col.green / 65535.0;
      b = col.blue / 65535.0;
    }
  else
    {
      Lisp_Object lr = Fnth (make_fixnum (0), color_values),
                  lg = Fnth (make_fixnum (1), color_values),
                  lb = Fnth (make_fixnum (2), color_values);

      check_integer_range (lr, 0, 65535);
      check_integer_range (lg, 0, 65535);
      check_integer_range (lb, 0, 65535);

      r = XFIXNUM (lr) / 65535.0;
      g = XFIXNUM (lg) / 65535.0;
      b = XFIXNUM (lb) / 65535.0;
    }
  cairo_t *cr = cairo_create (XCANVAS (canvas)->canvas);
  cairo_set_source_rgba (cr, r, g, b, XFLOATINT (opacity));
  cairo_arc (cr, XFLOATINT (x), XFLOATINT (y), XFLOATINT (radius),
	     XFLOATINT (angle1), XFLOATINT (angle2));
  cairo_stroke (cr);
  cairo_destroy (cr);
  MARK_CANVAS_CHANGED (XCANVAS (canvas));
#else
#endif
  return Qnil;
}

DEFUN ("canvas-filled-arc", Fcanvas_filled_arc, Scanvas_filled_arc, 6, 8, 0,
       doc: /* Draw a filled arc on CANVAS starting from XC, YC,
with a radius of RADIUS and 2 angles angle1 and angle2.
Use the color COLOR with the alpha channel set to OPACITY, if specified. */)
  (Lisp_Object canvas, Lisp_Object x, Lisp_Object y, Lisp_Object radius,
   Lisp_Object angle1, Lisp_Object angle2, Lisp_Object color, Lisp_Object opacity)
{
  CHECK_CANVAS (canvas);
  check_integer_range (x, 0, INT_MAX);
  check_integer_range (y, 0, INT_MAX);
  CHECK_NUMBER (angle1);
  CHECK_NUMBER (angle2);
  CHECK_NUMBER (radius);

  if (NILP (opacity))
    opacity = make_fixnum (1.0);
  CHECK_NUMBER (opacity);

#ifdef USE_CAIRO
  if (NILP (color))
    color = Qunspecified;
  Lisp_Object color_values = call1 (Qcolor_values, color);
  if (!NILP (color_values))
    CHECK_LIST (color_values);
  double r, g, b;
  if (NILP (color_values))
    {
      Emacs_Color col;
      col.pixel = FRAME_FOREGROUND_PIXEL (XFRAME (selected_frame));
      FRAME_TERMINAL (XFRAME (selected_frame))
        ->query_colors (XFRAME (selected_frame), &col, 1);
      r = col.red / 65535.0;
      g = col.green / 65535.0;
      b = col.blue / 65535.0;
    }
  else
    {
      Lisp_Object lr = Fnth (make_fixnum (0), color_values),
                  lg = Fnth (make_fixnum (1), color_values),
                  lb = Fnth (make_fixnum (2), color_values);

      check_integer_range (lr, 0, 65535);
      check_integer_range (lg, 0, 65535);
      check_integer_range (lb, 0, 65535);

      r = XFIXNUM (lr) / 65535.0;
      g = XFIXNUM (lg) / 65535.0;
      b = XFIXNUM (lb) / 65535.0;
    }
  cairo_t *cr = cairo_create (XCANVAS (canvas)->canvas);
  cairo_set_source_rgba (cr, r, g, b, XFLOATINT (opacity));
  cairo_arc (cr, XFLOATINT (x), XFLOATINT (y), XFLOATINT (radius),
	     XFLOATINT (angle1), XFLOATINT (angle2));
  cairo_fill (cr);
  cairo_destroy (cr);
  MARK_CANVAS_CHANGED (XCANVAS (canvas));
#else
#endif
  return Qnil;
}

DEFUN ("canvas-region", Fcanvas_region, Scanvas_region, 5, 5, 0,
       doc: /* Return a canvas containing a WIDTH wide and HEIGHT tall
subsection of CANVAS at X, Y */)
  (Lisp_Object canvas, Lisp_Object x,
   Lisp_Object y, Lisp_Object width, Lisp_Object height)
{
  CHECK_CANVAS (canvas);
  check_integer_range (x, 0, INT_MAX);
  check_integer_range (y, 0, INT_MAX);
  check_integer_range (width, 0, INT_MAX);
  check_integer_range (height, 0, INT_MAX);

#ifdef USE_CAIRO
  int ix = XFIXNUM (x),
    iy = XFIXNUM (y),
    iw = XFIXNUM (width),
    ih = XFIXNUM (height);
  cairo_surface_t *s = cairo_surface_create_for_rectangle
    (XCANVAS (canvas)->canvas, ix, iy, iw, ih);
  Lisp_Object newcvs = make_canvas (iw, ih);
  struct canvas *target = XCANVAS (newcvs);
  cairo_t *t = cairo_create (target->canvas);
  cairo_set_source_surface (t, s, 0, 0);
  cairo_paint (t);
  cairo_destroy (t);
  cairo_surface_destroy (s);
  return newcvs;
#else
  error ("Not implemented.")
#endif
}


DEFUN ("canvas-draw-canvas", Fcanvas_draw_canvas, Scanvas_draw_canvas, 4, 7,
       0, doc: /* Paint CANVAS2 onto CANVAS, at X, Y.
If WIDTH or HEIGHT is set, and IMAGE is wider than WIDTH or taller than HEIGHT,
IMAGE_SPEC will be cropped to fit WIDTH and/or HEIGHT respectively.
The opacity of the drawn image will be OPACITY.  */)
  (Lisp_Object canvas, Lisp_Object canvas2,
   Lisp_Object x, Lisp_Object y,
   Lisp_Object width, Lisp_Object height, Lisp_Object opacity)
{
  CHECK_CANVAS (canvas);
  CHECK_CANVAS (canvas2);
  int iwidth = XCANVAS (canvas2)->width;
  int iheight = XCANVAS (canvas2)->height;
  check_integer_range (x, 0, INT_MAX);
  check_integer_range (y, 0, INT_MAX);
  if (NILP (width))
    width = make_fixnum (iwidth);
  check_integer_range (width, 0, INT_MAX);
  if (NILP (height))
    height = make_fixnum (iheight);
  check_integer_range (height, 0, INT_MAX);
  if (NILP (width))
    width = make_fixnum (iwidth);
  if (NILP (opacity))
    opacity = make_fixnum (1);
  CHECK_NUMBER (opacity);

#ifdef USE_CAIRO
  cairo_surface_t *crs = XCANVAS (canvas2)->canvas;
  struct canvas *cv = XCANVAS (canvas);
  cairo_t *cr = cairo_create (cv->canvas);
  cairo_save (cr);
  cairo_translate (cr, XFIXNUM (x), XFIXNUM (y));
  cairo_rectangle (cr, 0, 0, XFIXNUM (width), XFIXNUM (height));
  cairo_clip (cr);
  cairo_set_source_surface (cr, crs, 0, 0);
  cairo_paint_with_alpha (cr, XFLOATINT (opacity));
  cairo_restore (cr);
  cairo_destroy (cr);
  MARK_CANVAS_CHANGED (cv);
#endif
  return Qnil;
}

DEFUN ("canvas-pixel-at", Fcanvas_pixel_at, Scanvas_pixel_at, 3, 3, 0,
       doc: /* Return the color of the pixel at X, Y inside CANVAS as an ARGB list. */)
  (Lisp_Object canvas, Lisp_Object x, Lisp_Object y)
{
#ifndef USE_CAIRO
  error ("Not implemented.");
#else
  CHECK_CANVAS (canvas);
  check_integer_range (x, 0, XCANVAS (canvas)->width);
  check_integer_range (y, 0, XCANVAS (canvas)->height);
  struct {
#ifdef WORDS_BIGENDIAN
    uint8_t a, r, g, b;
#else
    uint8_t b, g, r, a;
#endif
  } *argb32 =
    (void *) cairo_image_surface_get_data (XCANVAS (canvas)->canvas);
  typeof (*argb32) res = argb32 [XFIXNUM (y) * XCANVAS (canvas)->width +
				 XFIXNUM (x)];
  return CALLN (Flist, make_fixnum (res.a),
		make_fixnum (res.r),
		make_fixnum (res.g),
		make_fixnum (res.b));
#endif
}

DEFUN ("canvas-dimensions", Fcanvas_dimensions, Scanvas_dimensions, 1, 1, 0,
       doc: /* Return a cons pair containing the width and height of CANVAS. */)
  (Lisp_Object canvas)
{
  CHECK_CANVAS (canvas);
  return Fcons (make_fixnum (XCANVAS (canvas)->width),
		make_fixnum (XCANVAS (canvas)->height));
}

void
syms_of_canvas (void)
{
  defsubr (&Smake_canvas);
  defsubr (&Scanvas_rectangle);
  defsubr (&Scanvas_ellipse);
  defsubr (&Scanvas_rectangle);
  defsubr (&Scanvas_draw_string);
  defsubr (&Scanvas_draw_image);
  defsubr (&Scanvas_draw_canvas);
  defsubr (&Scanvas_measure_string);
  defsubr (&Scanvas_dimensions);
  defsubr (&Scanvas_region);
  defsubr (&Scanvas_pixel_at);
  defsubr (&Scanvas_arc);
  defsubr (&Scanvasp);
  defsubr (&Scanvas_filled_arc);
  defsubr (&Scanvas_rounded_rectangle);
  DEFSYM (Qcanvas_rounded_rectangle, "canvas-rounded-rectangle");
  DEFSYM (Qcanvasp, "canvasp");
  DEFSYM (Qcolor_values, "color-values");
  DEFVAR_INT ("canvas-stroke-width", canvas_stroke_width,
	      doc: /* The stroke width to be used in canvases. */);
  canvas_stroke_width = 4;
}