Help language development. Donate to The Perl Foundation
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