Skip to content
This repository
tag: v21
Fetching contributors…

Cannot retrieve contributors at this time

file 75 lines (69 sloc) 3.525 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
# Main documentation: http://docs.go-mono.com, particularly
# Gnome (for Gdk and Gtk) and Mono (for Cairo) libraries.
# See also: The X-Windows Disaster at http://www.art.net/~hopkins/Don/unix-haters/handbook.html

constant $GTK = "gtk-sharp, Version=2.12.0.0, Culture=neutral, PublicKeyToken=35e10195dab3c99f";
constant $GDK = "gdk-sharp, Version=2.12.0.0, Culture=neutral, PublicKeyToken=35e10195dab3c99f";
# use 'gacutil -l' to look up similar module details

constant Application = CLR::("Gtk.Application,$GTK");
constant Window = CLR::("Gtk.Window,$GTK");
constant GdkCairoHelper = CLR::("Gdk.CairoHelper,$GDK");
constant GtkDrawingArea = CLR::("Gtk.DrawingArea,$GTK");

Application.Init;
my $window = Window.new("sierpinski");
my $windowSizeX = 640; my $windowSizeY = 560;
$window.Resize($windowSizeX, $windowSizeY); # TODO: resize at runtime NYI
my $drawingarea = GtkDrawingArea.new;
$drawingarea.add_ExposeEvent(&ExposeEvent);
$window.add_DeleteEvent(&DeleteEvent);
$window.Add($drawingarea);
$window.ShowAll;
Application.Run; # end of main program, it's all over when this returns

sub DeleteEvent($obj, $args) { #OK not used
    Application.Quit;
};

sub ExposeEvent($obj, $args)
{
    $args; # suppress "declared but not used" "Potential difficulties"
    my $cc = GdkCairoHelper.Create($obj.GdkWindow); # Cairo Context
    my $windowX=0; my $windowY=0; my $windowWidth=0; my $windowHeight=0; my $windowDepth=0;
    $obj.GdkWindow.GetGeometry($windowX, $windowY, $windowWidth, $windowHeight, $windowDepth);
    $cc.SetSourceRGB(0.6, 1, 0.6); $cc.Paint; # pale green background
    # Start the recursive drawing process
    my $x0=0; my $y0=0; my $x1=$windowWidth-1; my $y1=$windowHeight/2;
    my $x2=0; my $y2=$windowHeight-1;
    my $depth = Sierpinski($cc, $x0, $y0, $x1, $y1, $x2, $y2, True, 1);
    my $text = sprintf("%d x %d, %d levels", $windowWidth, $windowHeight, $depth);
    $cc.SetSourceRGB(0.6, 0.6, 1); # pale blue
    $cc.SetFontSize($windowWidth * 0.07);
    my $textWidth = $cc.TextExtents($text).Width;
    my $textHeight = $cc.TextExtents($text).Height;
    $cc.MoveTo($windowWidth*0.98 - $textWidth, $windowHeight*0.01 + $textHeight);
    $cc.ShowText($text);
    $cc.Target.Dispose;
    $cc.dispose-hack; # Should be $cc.Dispose but CLR interop cannot call that
    # Tracked as https://github.com/sorear/niecza/issues/56
};

sub Sierpinski($cc, $x0, $y0, $x1, $y1, $x2, $y2, $colorflag, $depth is copy)
{
    if $colorflag { $cc.SetSourceRGB(0.6, 0, 0.8); } # indigo
    else { $cc.SetSourceRGB( 1, 1, 0.8); } # pale yellow
    # First draw the entire main triangle in the one color
    $cc.MoveTo($x0, $y0); $cc.LineTo($x1, $y1);
    $cc.LineTo($x2, $y2); $cc.LineTo($x0, $y0);
    $cc.Fill;
    $cc.Stroke;
    if (($x1-$x0)>2) && (($y2-$y0)>2) { # Prepare to recurse
        ++$depth;
        # Calculate the midpoints of the 3 edges of the triangle
        # note - these .Int conversions make a very big speed difference
        my $x01=(($x0+$x1)/2).Int; my $y01=(($y0+$y1)/2).Int;
        my $x12=(($x1+$x2)/2).Int; my $y12=(($y1+$y2)/2).Int;
        my $x20=(($x2+$x0)/2).Int; my $y20=(($y2+$y0)/2).Int;
        # Recursively draw three smaller triangles in the other color
        Sierpinski($cc, $x0, $y0, $x01,$y01, $x20,$y20, !$colorflag, $depth);
        Sierpinski($cc, $x01,$y01, $x1, $y1, $x12,$y12, !$colorflag, $depth);
        $depth =
        Sierpinski($cc, $x20,$y20, $x12,$y12, $x2, $y2, !$colorflag, $depth);
    }
    $depth;
}
Something went wrong with that request. Please try again.