Help language development. Donate to The Perl Foundation

Gnome::Cairo cpan:MARTIMM last updated on 2022-02-20

t/Cairo.rakutest
use v6;
#use lib '../gnome-native/lib';
use Test;

use Gnome::Cairo::ImageSurface;
use Gnome::Cairo::Surface;
use Gnome::Cairo;
use Gnome::Cairo::Enums;
use Gnome::Cairo::Types;
use Gnome::Cairo::Matrix;
use Gnome::Cairo::FontOptions;
use Gnome::Cairo::ScaledFont;
use Gnome::Cairo::Pattern;

#use Gnome::N::X;
#Gnome::N::debug(:on);

#-------------------------------------------------------------------------------
my Gnome::Cairo $c;
my Gnome::Cairo::ImageSurface $surface;
my Int $width = 128;
my Int $height = 128;
#-------------------------------------------------------------------------------
subtest 'ISA test', {
  $surface .= new( :format(CAIRO_FORMAT_ARGB32), :$width, :$height);
  $c .= new(:$surface);
  isa-ok $c, Gnome::Cairo, '.new(:surface)';

  ok $c.is-valid, '.is-valid()';
  $c.clear-object;
  nok $c.is-valid, '.clear-object()';
}

#-------------------------------------------------------------------------------
# set environment variable 'raku-test-all' if rest must be tested too.
unless %*ENV<raku_test_all>:exists {
  done-testing;
  exit;
}

#-------------------------------------------------------------------------------
subtest 'Manipulations', {
  $surface .= new( :format(CAIRO_FORMAT_ARGB32), :$width, :$height);
  $c .= new(:$surface);
  is $c.status, CAIRO_STATUS_SUCCESS, '.cairo-status()';
  my Str $errtxt = $c.status-to-string($c.status);
  ok $errtxt.chars, '.status-to-string(): ' ~ $errtxt;

  $c.set-antialias(CAIRO_ANTIALIAS_GRAY);
  is $c.get-antialias, CAIRO_ANTIALIAS_GRAY,
   '.set-antialias() / .get-antialias()';

  $c.new-path;
  my Num() ( $x, $y);
  ( $x, $y) = $c.get-current-point;
  is-deeply ( $x, $y), ( 0e0, 0e0), '.new-path() / .get-current-point()';


  lives-ok {
    with $c {
      .save;
      .arc( 0, 0, 1, 0, 2 * π);
      .arc-negative( 0, 0, 1, 0, 2 * π);
      .clip;
      my cairo_rectangle_list_t $rl = .copy-clip-rectangle-list;
#      diag $rl.gist;
      is cairo_status_t($rl.status), CAIRO_STATUS_CLIP_NOT_REPRESENTABLE,
        '.copy-clip-rectangle-list() status';
      .clip-preserve;
      .stroke-preserve;
      .reset-clip;
      .copy-page;
      .restore;
    }
  }, '.save(), .arc(), .arc-negative(), .clip(), .restore, ' ~
     '.clip-preserve(), .stroke-preserve(), .reset-clip(), .copy-page(), ' ~
     '.copy-clip-rectangle-list()';


  # set the scale twice as large, then check to see what (10,10) device
  # coordinates should be in user space => half of it
  $c.move-to( 20, 20);
  is-deeply $c.get-current-point, ( 20e0, 20e0), '.move-to()';

  # scale sets starting point of path; at 20, 20 scaled by half -> ( 10, 10)
  $c.scale( 2, 2);
  my Num() ( $x-tart, $y-tart) = $c.get-current-point;
  is-deeply $c.get-current-point, ( 10e0, 10e0), '.scale()';

  ( $x, $y) = ( 10, 10);
  $c.device-to-user-distance( $x, $y);
  is-deeply ( $x, $y), ( 5e0, 5e0), '.device-to-user-distance()';

  # half it again
  $c.device-to-user( $x, $y);
  is-deeply ( $x, $y), ( 25e-1, 25e-1), '.device-to-user()';

  $c.line-to( 50, 50);
  is-deeply $c.get-current-point, ( 50e0, 50e0), '.line-to()';

  $c.close-path;
  is-deeply $c.get-current-point, ( $x-tart, $y-tart), '.close-path()';

  # user to device should double it with the current scale
  ( $x, $y) = ( 25, 25);
  $c.user-to-device( $x, $y);
  is-deeply ( $x, $y), ( 5e1, 5e1), '.user-to-device()';

  $c.user-to-device-distance( $x, $y);
  is-deeply ( $x, $y), ( 1e2, 1e2), '.user-to-device-distance()';

  is $c.get-fill-rule, CAIRO_FILL_RULE_WINDING, '.get-fill-rule()';

  is-deeply $c.get-dash, ( [], 0e0), '.get-dash()';
  is $c.get-dash-count, 0, '.get-dash-count()';
  $c.set-dash( [1.2, 2.3, '11', 3e1], 0.3);
  is-deeply $c.get-dash, ( [1.2e0, 2.3e0, 1.1e1, 3e1], 3e-1), '.set-dash()';

  lives-ok {
    my Gnome::Cairo::Matrix $matrix = $c.get-font-matrix;
    $matrix.invert;
    $c.set-font-matrix($matrix);
#    diag $matrix.get-native-object.gist;
  }, '.set-font-matrix() / .get-font-matrix()';

  my Gnome::Cairo::FontOptions $fo = $c.get-font-options;
  is $fo.get-antialias, CAIRO_ANTIALIAS_DEFAULT, '.get-font-options()';

  my Gnome::Cairo::Surface $s = $c.get-group-target;
  is $s.status, CAIRO_STATUS_SUCCESS, '.get-group-target()';

  $c.set-line-cap(CAIRO_LINE_CAP_ROUND);
  is $c.get-line-cap, CAIRO_LINE_CAP_ROUND,
    '.set-line-cap() / .get-line-cap()';

  $c.set-line-join(CAIRO_LINE_JOIN_ROUND);
  is $c.get-line-join, CAIRO_LINE_JOIN_ROUND,
    '.set-line-join() / .get-line-join()';

  $c.set-line-width(2.3);
  is $c.get-line-width, 23e-1, '.set-line-width() / .get-line-width()';

  # set wrong matrix, non invertable
  $surface .= new( :format(CAIRO_FORMAT_ARGB32), :$width, :$height);
  $c .= new(:$surface);
  my Gnome::Cairo::Matrix $m1 .= new(:init( 10e0, 10e0, 11e0, 11e0, 0e0, 0e0));
  $c.set-matrix($m1);
  is $c.status, CAIRO_STATUS_INVALID_MATRIX, 'matrix error';

  # set good matrix, invertable
  $surface .= new( :format(CAIRO_FORMAT_ARGB32), :$width, :$height);
  $c .= new(:$surface);
  $m1 .= new(:init( 1e0, 10e0, 11e0, 1e0, 0e0, 0e0));
  $c.set-matrix($m1);
  my Gnome::Cairo::Matrix $m2 = $c.get-matrix;
  with $m2._get-native-object {
    is-deeply
      (.xx, .yx, .xy, .yy, .x0, .y0),
      (1e0, 10e0, 11e0, 1e0, 0e0, 0e0),
      '.set-matrix() / .get-matrix()';
  }

  $c.set-miter-limit(2.5);
  ok $c.get-miter-limit > 0e0,
      '.set-miter-limit() / .get-miter-limit(): 2.5 -> ' ~ $c.get-miter-limit;

#TODO does not exist?
#  $c.set-opacity(0.8);
#  is $c.get-opacity, 0.8, '.set-opacity() / .get-opacity()';

  $c.set-operator(CAIRO_OPERATOR_OVER);
  is $c.get-operator, CAIRO_OPERATOR_OVER, '.set-operator() / .get-operator()';

#  my Gnome::Cairo::ScaledFont $sf = $c.get-scaled-font;
##`{{TODO}} is cairo_status_t($sf.status), 0, '.get-scaled-font()';

  $surface .= new( :format(CAIRO_FORMAT_ARGB32), :$width, :$height);
  $c .= new(:$surface);
  my Gnome::Cairo::Pattern $p1 .= new(:rgba( 1, 0.5, 0.5e0, 0.5));
  is $p1.get-color-stop-count[1], CAIRO_STATUS_PATTERN_TYPE_MISMATCH,
    '.get-color-stop-count(): no gradient';
#note "ps: $p1.status()";
  $c.set-source($p1);
#note "cs: $c.status()";
  my Gnome::Cairo::Pattern $p2 = $c.get-source;
  is $p2.status(), CAIRO_STATUS_SUCCESS, '.set-source() / .get-source()';

  $s = $c.get-target;
  is $s.status, CAIRO_STATUS_SUCCESS, '.get-target()';

  $c.set-source-surface( $surface, 10, 2);
  $p2 = $c.get-source;
  is $p2.status(), CAIRO_STATUS_SUCCESS, '.set-source-surface()';

  $c.set-tolerance(0.05);
  is $c.get-tolerance, 0.05, '.set-tolerance() / .get-tolerance()';

  nok $c.has-current-point, '.has-current-point()';

  $c.identity-matrix;
  $m2 = $c.get-matrix;
  with $m2._get-native-object {
    is-deeply
      (.xx, .yx, .xy, .yy, .x0, .y0),
      (1e0, 0e0, 0e0, 1e0, 0e0, 0e0),
      '.identity-matrix()';
  }

  ok $c.in-clip( 0, 0), '.in-clip()';
  nok $c.in-fill( 0, 0), '.in-fill()';
  nok $c.in-stroke( 0, 0), '.in-stroke()';

  $surface .= new( :format(CAIRO_FORMAT_ARGB32), :$width, :$height);
  with $c .= new(:$surface) {
    .move-to( 20, 20);
    .rel-line-to( 10, 0);
    .rel-line-to( 0, 10);
    .close-path;

    is-deeply .path-extents, ( 2e1, 2e1, 3e1, 3e1), '.path-extents()';
    is-deeply .clip-extents, ( 0e0, 0e0, 1.28e2, 1.28e2), '.clip-extents()';
    is-deeply .fill-extents, ( 2e1, 2e1, 3e1, 3e1), '.fill-extents()';
    lives-ok { .stroke-extents; }, '.stroke-extents()';

    .rectangle( 21, 21, 10, 11);
    is-deeply .path-extents, ( 2e1, 2e1, 3.1e1, 3.2e1), '.rectangle()';

    .rotate(0 * π);
    is-deeply .path-extents, ( 2e1, 2e1, 3.1e1, 3.2e1), '.rotate()';

    lives-ok {.push-group-with-content(CAIRO_CONTENT_COLOR_ALPHA);},
      '.push-group-with-content()';

    lives-ok {.rel-curve-to( 1, 2, 3, 4, 5, 6);},
      '.rel-curve-to()';
  }
}

#-------------------------------------------------------------------------------
done-testing;

=finish