1:- module(cairo, [cairo_image_surface_create/4,
    2                  cairo_image_surface_create_for_data/6,
    3                  cairo_surface_destroy/1, cairo_surface_flush/1,
    4                  cairo_image_surface_get_data/2, cairo_image_surface_get_width/2,
    5                  cairo_image_surface_get_height/2, cairo_image_surface_get_stride/2,
    6                  cairo_image_surface_get_format/2,
    7                  cairo_create/2, cairo_destroy/1,
    8                  cairo_set_source_rgba/5,
    9                  cairo_set_antialias/2, cairo_set_line_width/2,
   10                  cairo_set_line_cap/2, cairo_set_line_join/2,
   11                  cairo_new_path/1, cairo_new_sub_path/1, cairo_close_path/1,
   12                  cairo_move_to/3, cairo_line_to/3, cairo_rectangle/5,
   13                  cairo_arc/6, cairo_arc_negative/6, cairo_curve_to/7,
   14                  cairo_fill/1, cairo_fill_preserve/1,
   15                  cairo_stroke/1, cairo_stroke_preserve/1, cairo_paint/1,
   16                  cairo_format/2, cairo_antialias/2, cairo_line_cap/2,
   17                  cairo_line_join/2
   18                  ]).   19:- use_foreign_library(foreign(cairo)).   20
   21:- multifile error:has_type/2.   22error:has_type(cairo_surface_blob, X) :- blob(X, cairo_surface_blob).
   23error:has_type(cairo_context_blob, X) :- blob(X, cairo_context_blob).
   24error:has_type(cairo_format,     X) :- cairo_format(X, _).
   25error:has_type(cairo_antialias,  X) :- cairo_antialias(X, _).
   26error:has_type(cairo_line_cap,   X) :- cairo_line_cap(X, _).
   27error:has_type(cairo_line_join,  X) :- cairo_line_join(X, _).
   28
   29% Rich error messages listing the valid atoms for each enum.
   30:- multifile prolog:error_message//1.   31prolog:error_message(type_error(cairo_format, Culprit)) -->
   32   { findall(F, cairo_format(F, _), Fs) },
   33   [ 'cairo_format (one of ~q), found ~q'-[Fs, Culprit] ].
   34prolog:error_message(type_error(cairo_antialias, Culprit)) -->
   35   { findall(F, cairo_antialias(F, _), Fs) },
   36   [ 'cairo_antialias (one of ~q), found ~q'-[Fs, Culprit] ].
   37prolog:error_message(type_error(cairo_line_cap, Culprit)) -->
   38   { findall(F, cairo_line_cap(F, _), Fs) },
   39   [ 'cairo_line_cap (one of ~q), found ~q'-[Fs, Culprit] ].
   40prolog:error_message(type_error(cairo_line_join, Culprit)) -->
   41   { findall(F, cairo_line_join(F, _), Fs) },
   42   [ 'cairo_line_join (one of ~q), found ~q'-[Fs, Culprit] ].
   43
   44user:portray(Surface) :-
   45   blob(Surface, cairo_surface_blob), !,
   46   cairo_surface_blob_portray(current_output, Surface).
   47user:portray(Context) :-
   48   blob(Context, cairo_context_blob), !,
   49   cairo_context_blob_portray(current_output, Context).
   50
   51% --- enum tables ------------------------------------------------------------
   52% cairo_format_t: see cairo/cairo.h.  argb32 is the natural pairing with
   53% SDL_PIXELFORMAT_ARGB32 (native-endian 0xAARRGGBB).
   54cairo_format(invalid, -1).
   55cairo_format(argb32, 0).
   56cairo_format(rgb24, 1).
   57cairo_format(a8, 2).
   58cairo_format(a1, 3).
   59cairo_format(rgb16_565, 4).
   60cairo_format(rgb30, 5).
   61
   62% cairo_antialias_t
   63cairo_antialias(default, 0).
   64cairo_antialias(none, 1).
   65cairo_antialias(gray, 2).
   66cairo_antialias(subpixel, 3).
   67cairo_antialias(fast, 4).
   68cairo_antialias(good, 5).
   69cairo_antialias(best, 6).
   70
   71% cairo_line_cap_t
   72cairo_line_cap(butt, 0).
   73cairo_line_cap(round, 1).
   74cairo_line_cap(square, 2).
   75
   76% cairo_line_join_t
   77cairo_line_join(miter, 0).
   78cairo_line_join(round, 1).
   79cairo_line_join(bevel, 2).
   80
   81% --- image surfaces ---------------------------------------------------------
   82
   83cairo_image_surface_create(Surface, Format, Width, Height) :-
   84   must_be(var, Surface),
   85   must_be(cairo_format, Format),
   86   must_be(positive_integer, Width),
   87   must_be(positive_integer, Height),
   88   cairo_format(Format, IntFormat),
   89   cairo_image_surface_create_(Surface, IntFormat, Width, Height).
   90
   91% Creates a cairo image surface backed by external pixel data (e.g. an
   92% SDL locked texture).  The Pixels PtrBlob must stay alive while the
   93% surface is in use — the surface blob holds a parent ref to it.
   94cairo_image_surface_create_for_data(Surface, Pixels, Format, Width, Height, Stride) :-
   95   must_be(var, Surface),
   96   must_be(ptr_blob, Pixels),
   97   must_be(cairo_format, Format),
   98   must_be(positive_integer, Width),
   99   must_be(positive_integer, Height),
  100   must_be(integer, Stride),
  101   cairo_format(Format, IntFormat),
  102   cairo_image_surface_create_for_data_(Surface, Pixels, IntFormat, Width, Height, Stride).
  103
  104cairo_surface_destroy(Surface) :-
  105   must_be(cairo_surface_blob, Surface),
  106   cairo_surface_destroy_(Surface).
  107
  108cairo_surface_flush(Surface) :-
  109   must_be(cairo_surface_blob, Surface),
  110   cairo_surface_flush_(Surface).
  111
  112cairo_image_surface_get_data(Surface, Data) :-
  113   must_be(cairo_surface_blob, Surface),
  114   must_be(var, Data),
  115   cairo_image_surface_get_data_(Surface, Data).
  116
  117cairo_image_surface_get_width(Surface, Width) :-
  118   must_be(cairo_surface_blob, Surface),
  119   must_be(var, Width),
  120   cairo_image_surface_get_width_(Surface, Width).
  121
  122cairo_image_surface_get_height(Surface, Height) :-
  123   must_be(cairo_surface_blob, Surface),
  124   must_be(var, Height),
  125   cairo_image_surface_get_height_(Surface, Height).
  126
  127cairo_image_surface_get_stride(Surface, Stride) :-
  128   must_be(cairo_surface_blob, Surface),
  129   must_be(var, Stride),
  130   cairo_image_surface_get_stride_(Surface, Stride).
  131
  132cairo_image_surface_get_format(Surface, Format) :-
  133   must_be(cairo_surface_blob, Surface),
  134   must_be(var, Format),
  135   cairo_image_surface_get_format_(Surface, IntFormat),
  136   cairo_format(Format, IntFormat).
  137
  138% --- context ----------------------------------------------------------------
  139
  140cairo_create(Context, Surface) :-
  141   must_be(var, Context),
  142   must_be(cairo_surface_blob, Surface),
  143   cairo_create_(Context, Surface).
  144
  145cairo_destroy(Context) :-
  146   must_be(cairo_context_blob, Context),
  147   cairo_destroy_(Context).
  148
  149% --- source colour ----------------------------------------------------------
  150% Colour components are doubles in 0.0..1.0 (unlike SDL's 0..255 ints).
  151
  152cairo_set_source_rgba(Context, R, G, B, A) :-
  153   must_be(cairo_context_blob, Context),
  154   maplist(must_be(number), [R, G, B, A]),
  155   cairo_set_source_rgba_(Context, R, G, B, A).
  156
  157% --- graphics state ---------------------------------------------------------
  158
  159cairo_set_antialias(Context, Antialias) :-
  160   must_be(cairo_context_blob, Context),
  161   must_be(cairo_antialias, Antialias),
  162   cairo_antialias(Antialias, Int),
  163   cairo_set_antialias_(Context, Int).
  164
  165cairo_set_line_width(Context, Width) :-
  166   must_be(cairo_context_blob, Context),
  167   must_be(number, Width),
  168   cairo_set_line_width_(Context, Width).
  169
  170cairo_set_line_cap(Context, Cap) :-
  171   must_be(cairo_context_blob, Context),
  172   must_be(cairo_line_cap, Cap),
  173   cairo_line_cap(Cap, Int),
  174   cairo_set_line_cap_(Context, Int).
  175
  176cairo_set_line_join(Context, Join) :-
  177   must_be(cairo_context_blob, Context),
  178   must_be(cairo_line_join, Join),
  179   cairo_line_join(Join, Int),
  180   cairo_set_line_join_(Context, Int).
  181
  182% --- paths ------------------------------------------------------------------
  183
  184cairo_new_path(Context) :-
  185   must_be(cairo_context_blob, Context),
  186   cairo_new_path_(Context).
  187
  188cairo_new_sub_path(Context) :-
  189   must_be(cairo_context_blob, Context),
  190   cairo_new_sub_path_(Context).
  191
  192cairo_close_path(Context) :-
  193   must_be(cairo_context_blob, Context),
  194   cairo_close_path_(Context).
  195
  196cairo_move_to(Context, X, Y) :-
  197   must_be(cairo_context_blob, Context),
  198   maplist(must_be(number), [X, Y]),
  199   cairo_move_to_(Context, X, Y).
  200
  201cairo_line_to(Context, X, Y) :-
  202   must_be(cairo_context_blob, Context),
  203   maplist(must_be(number), [X, Y]),
  204   cairo_line_to_(Context, X, Y).
  205
  206cairo_rectangle(Context, X, Y, Width, Height) :-
  207   must_be(cairo_context_blob, Context),
  208   maplist(must_be(number), [X, Y, Width, Height]),
  209   cairo_rectangle_(Context, X, Y, Width, Height).
  210
  211cairo_arc(Context, Xc, Yc, Radius, Angle1, Angle2) :-
  212   must_be(cairo_context_blob, Context),
  213   maplist(must_be(number), [Xc, Yc, Radius, Angle1, Angle2]),
  214   cairo_arc_(Context, Xc, Yc, Radius, Angle1, Angle2).
  215
  216cairo_arc_negative(Context, Xc, Yc, Radius, Angle1, Angle2) :-
  217   must_be(cairo_context_blob, Context),
  218   maplist(must_be(number), [Xc, Yc, Radius, Angle1, Angle2]),
  219   cairo_arc_negative_(Context, Xc, Yc, Radius, Angle1, Angle2).
  220
  221cairo_curve_to(Context, X1, Y1, X2, Y2, X3, Y3) :-
  222   must_be(cairo_context_blob, Context),
  223   maplist(must_be(number), [X1, Y1, X2, Y2, X3, Y3]),
  224   cairo_curve_to_(Context, X1, Y1, X2, Y2, X3, Y3).
  225
  226% --- drawing ----------------------------------------------------------------
  227
  228cairo_fill(Context) :-
  229   must_be(cairo_context_blob, Context),
  230   cairo_fill_(Context).
  231
  232cairo_fill_preserve(Context) :-
  233   must_be(cairo_context_blob, Context),
  234   cairo_fill_preserve_(Context).
  235
  236cairo_stroke(Context) :-
  237   must_be(cairo_context_blob, Context),
  238   cairo_stroke_(Context).
  239
  240cairo_stroke_preserve(Context) :-
  241   must_be(cairo_context_blob, Context),
  242   cairo_stroke_preserve_(Context).
  243
  244cairo_paint(Context) :-
  245   must_be(cairo_context_blob, Context),
  246   cairo_paint_(Context)