Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Merge branch 'master' of github.com:sorear/niecza into serialize
  • Loading branch information
@sorear
sorear committed Oct 3, 2011
2 parents aaeae45 + 241a2d8 commit 68ddcb5
Show file tree
Hide file tree
Showing 9 changed files with 548 additions and 19 deletions.
2 changes: 1 addition & 1 deletion Makefile
View file
Expand Up @@ -73,7 +73,7 @@ p6eval: all
$(RUN_CLR) run/Niecza.exe -C CORE Test JSYNC

clean:
@rm -f obj/*.dll obj/*.exe obj/*.nam
@rm -f obj/*.dll obj/*.exe obj/*.nam obj/*.so
@rm -f run/Niecza.exe
@rm -f run/*.dll
@rm -f run/*.dll.so
Expand Down
164 changes: 164 additions & 0 deletions examples/gtk-tetris.pl
View file
@@ -0,0 +1,164 @@
# gtk-tetris.pl for Niecza Perl 6
# Docs: http://en.wikipedia.org/wiki/Tetris

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";
constant $GLIB = "glib-sharp, Version=2.12.0.0, Culture=neutral, PublicKeyToken=35e10195dab3c99f";

# Class names that occur more than once. Classes used only once appear inline.
constant Application = CLR::("Gtk.Application,$GTK");
constant GLibTimeout = CLR::("GLib.Timeout,$GLIB");

# Application data
constant matrixRows = 20; constant matrixColumns = 10;
my @tetrominoes = # cell coordinates relative to the "middle" cell
[ -1, 0, 0, 0, 1, 0, 2, 0 ], # I
[ -1, 0, 0, 0, 1, 0, 1, 1 ], # J
[ -1, 1, -1, 0, 0, 0, 1, 0 ], # L
[ -1, 1, -1, 0, 0, 0, 0, 1 ], # O
[ -1, 1, 0, 1, 0, 0, 1, 0 ], # S
[ -1, 0, 0, 0, 0, 1, 1, 0 ], # T
[ -1, 0, 0, 0, 0, 1, 1, 1 ]; # Z
my @colors = # Copied approximately from the PC version
[0, 0, 0 ], # 0: black background
[0.5.Num, 0, 0 ], # 1: I maroon
[1, 1, 1 ], # 2: J white
[0.9.Num, 0, 0.9.Num], # 3: L dark magenta
[0, 0, 0.6.Num], # 4: O dark blue
[0, 0.8.Num, 0 ], # 5: S green
[0.7.Num, 0.7.Num, 0 ], # 6: T brown
[0, 0.8.Num, 0.8.Num]; # 7: Z dark cyan
my @matrix;
for ^matrixRows -> $i { for ^matrixColumns -> $j { @matrix[$i][$j] = 0; } }
my $pieceX; my $pieceY; my $colorindex; my @piece; CreatePiece();
my $oldInterval = 300;
my $newInterval = 300;
my $scale; my $offsetX; my $offsetY;

# ---------------------------- Main program ----------------------------
Application.Init;
my $window = CLR::("Gtk.Window,$GTK").new("tetris");
$window.SetDefaultSize(300, 500);
my $drawingarea = CLR::("Gtk.DrawingArea,$GTK").new;
$window.Add($drawingarea);
$window.add_DeleteEvent(sub ($obj,$args){$obj;$args;Application.Quit;});
$drawingarea.CanFocus = True; # let arrow keys create KeyPressEvents
$drawingarea.add_ExposeEvent(&ExposeEvent);
$drawingarea.add_KeyPressEvent(&KeyPressEvent);
$window.ShowAll;
GLibTimeout.Add($newInterval, &TimeoutEvent);
Application.Run;

# --------------------------- Event handlers ---------------------------
sub TimeoutEvent()
{
$drawingarea.QueueDraw;
my $intervalSame = ($newInterval == $oldInterval);
unless $intervalSame { GLibTimeout.Add($newInterval, &TimeoutEvent); }
return $intervalSame; # True means continue calling this timeout handler
}

sub KeyPressEvent($sender, $eventargs) #OK not used
{
given $eventargs.Event.Key {
when 'Up' { if $colorindex != 4 { TryRotatePiece() } }
when 'Down' { while CanMovePiece(0,1) {++$pieceY;} }
when 'Left' { if CanMovePiece(-1,0) {--$pieceX;} }
when 'Right' { if CanMovePiece( 1,0) {++$pieceX;} }
}
return True; # means this keypress is now handled
}

sub ExposeEvent($sender, $eventargs) #OK not used
{
my $cc = CLR::("Gdk.CairoHelper,$GDK").Create($sender.GdkWindow); # Cairo Context
my $windowX=0; my $windowY=0; my $windowWidth=0; my $windowHeight=0; my $windowDepth=0;
$sender.GdkWindow.GetGeometry($windowX, $windowY, $windowWidth, $windowHeight, $windowDepth);
$scale = ((($windowWidth / matrixColumns) min ($windowHeight / matrixRows)) * 0.95).Int;
$offsetX = (($windowWidth - ($scale * matrixColumns))/2).Int;
$offsetY = (($windowHeight - ($scale * matrixRows ))/2).Int;
$cc.SetSourceRGB(0, 0, 0.4.Num); $cc.Paint; # Dark blue background
TryMovePieceDown(); # also clears full rows and makes new pieces
DrawMatrix($cc);
DrawPiece($cc);
$cc.dispose-hack; # Should be $cc.IDisposable.Dispose but currently
# CLR interop cannot call explicitly defined interface methods.
# Tracked as https://github.com/sorear/niecza/issues/56
}

# ------------------------- Helper subroutines -------------------------
sub CreatePiece()
{
my $piece = (rand * 7).Int % 7; # TODO: ^7.pick;
$colorindex = $piece + 1;
@piece = @( @tetrominoes[$piece] );
$pieceX = 4;
$pieceY = 0;
}

sub CanMovePiece($deltaX, $deltaY)
{
my $canMove = True;
# Would any cell of the piece go below the bottom of the well,
# or overlap existing cells lying there?
for @piece -> $x, $y {
if $x+$pieceX+$deltaX < 0 || $x+$pieceX+$deltaX >= matrixColumns ||
$y+$pieceY+$deltaY < 0 || $y+$pieceY+$deltaY >= matrixRows ||
@matrix[$y+$pieceY+$deltaY][$x+$pieceX+$deltaX] != 0
{
$canMove = False;
}
}
$canMove;
}

sub TryMovePieceDown()
{
if CanMovePiece(0, 1) {
++$pieceY;
}
else { # Copy this piece into the matrix and start with a new piece
for @piece -> $x, $y {
@matrix[$y+$pieceY][$x+$pieceX] = $colorindex;
}
# Look for full rows and remove them. TODO: keep score.
@matrix = grep { !all(@$_) }, @matrix;
unshift @matrix, [ 0 xx matrixColumns ] while @matrix < matrixRows;
CreatePiece();
}
}

sub TryRotatePiece()
{
my @p = @piece;
@piece .= map({ $^b, -$^a });
if ! CanMovePiece(0, 0) {
@piece = @p;
}
}

sub DrawMatrix($cc)
{
my $x=0; my $y=0;
for ^matrixRows -> $row {
for ^matrixColumns -> $column {
$cc.SetSourceRGB(|@colors[@matrix[$row][$column]]);
$cc.Rectangle($x+$offsetX,$y+$offsetY,$scale,$scale);
$cc.Fill;
$x += $scale;
}
$x = 0;
$y += $scale;
}
$cc.Stroke;
}

sub DrawPiece($cc)
{
$cc.SetSourceRGB(|@colors[$colorindex]);
for @piece -> $x, $y {
$cc.Rectangle(($pieceX+$x)*$scale+$offsetX,($pieceY+$y)*$scale+$offsetY,$scale,$scale);
$cc.Fill;
}
$cc.Stroke;
}
83 changes: 83 additions & 0 deletions examples/gtk-webbrowser.pl
View file
@@ -0,0 +1,83 @@
# gtk-webbrowser.pl - based on the Gtk C# example
# see Gnome Libraries, Gtk, HTML class at http://docs.go-mono.com/
# needs libgtkhtml3.16-cil on Debian or Ubuntu

# Names that occur multiple times. Names used only once appear inline.
constant $GTK = "gtk-sharp, Version=2.12.0.0, Culture=neutral, PublicKeyToken=35e10195dab3c99f";
constant $GTKHTML = "gtkhtml-sharp, Version=3.16.0.0, Culture=neutral, PublicKeyToken=35e10195dab3c99f";
constant $SYSTEM = "System, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089";
constant Application = CLR::("Gtk.Application,$GTK");

# ---------------------------- Main program ----------------------------
Application.Init;
my $currentUrl; my @historyUrl; my $name = "Niecza web browser";
my $label = CLR::("Gtk.Label,$GTK").new("Address:");
my $entry = CLR::("Gtk.Entry,$GTK").new;
$entry.add_Activated(&EntryActivated);
my $buttonGo = CLR::("Gtk.Button,$GTK").new("Go!");
$buttonGo.add_Clicked(&EntryActivated); # share $entry's handler
my $buttonBack = CLR::("Gtk.Button,$GTK").new("Back");
$buttonBack.add_Clicked(&BackClicked);
my $hbox = CLR::("Gtk.HBox,$GTK").new(False, 1);
$hbox.PackStart($label, False, False, 1);
$hbox.PackStart($entry, True, True, 1);
$hbox.PackStart($buttonGo, False, False, 1);
$hbox.PackStart($buttonBack, False, False, 1);
my $html = CLR::("Gtk.HTML,$GTKHTML").new;
$html.add_LinkClicked(&LinkClicked);
my $sw = CLR::("Gtk.ScrolledWindow,$GTK").new;
$sw.VscrollbarPolicy = CLR::("Gtk.PolicyType,$GTK").Always;
$sw.HscrollbarPolicy = CLR::("Gtk.PolicyType,$GTK").Always;
$sw.Add($html);
my $vbox = CLR::("Gtk.VBox,$GTK").new(False, 1);
$vbox.PackStart($hbox, False, False, 1);
$vbox.PackStart($sw, True, True, 1);
my $win = CLR::("Gtk.Window,$GTK").new($name);
$win.SetDefaultSize(800, 600);
$win.add_DeleteEvent(sub ($o,$a) { Application.Quit(); }); #OK not used
$win.Add($vbox);
$win.ShowAll;
Application.Run;

# --------------------------- Event handlers ---------------------------
sub EntryActivated($obj, $args) #OK not used
{
if $currentUrl { push @historyUrl, $currentUrl; }
$currentUrl = $entry.Text.subst(/^\s+/,"").subst(/\s+$/,""); # trim
LoadHtml($currentUrl);
}

sub LinkClicked($obj, $args) #OK not used
{
my $newUrl = $args.Url ~~ /^ 'http://' / # decide absolute or relative '
?? $args.Url
!! $currentUrl ~ $args.Url;
try {
LoadHtml($newUrl); # apparently throws numerous exceptions
CATCH { } # hide the evidence of the failure
push @historyUrl, $currentUrl;
$currentUrl = $newUrl;
}
}

sub BackClicked($obj, $args) #OK not used
{
if @historyUrl { LoadHtml($currentUrl = pop @historyUrl); }
}

# ------------------------- Helper subroutines -------------------------
sub LoadHtml($Url is copy)
{
unless $Url ~~ /^ [http|https] '://' / { $Url = 'http://' ~ $Url } # '
my $web_request = CLR::("System.Net.WebRequest,$SYSTEM").Create($Url);
my $web_response = $web_request.GetResponse;
my $stream = $web_response.GetResponseStream;
my $buffer = CLR::("System.Byte[]").new(8192);
my $html_stream = $html.Begin;
while (my $count = $stream.Read($buffer, 0, 8192)) != 0 {
$html_stream.Write($buffer, $count);
}
$html.End($html_stream, CLR::("Gtk.HTMLStreamStatus,$GTKHTML").Ok);
$entry.Text = $Url;
$win.Title = $html.Title ~ " - $name";
}
141 changes: 141 additions & 0 deletions examples/notepad.pl
View file
@@ -0,0 +1,141 @@
# notepad.pl for Niecza Perl 6
# needs libmono-winforms2.0-cil on Debian and Ubuntu

# CLR library dependencies - use either Mono or .NET
constant $DRAWING = "System.Drawing, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a";
constant $FORMS = "System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089";
constant Font = CLR::("System.Drawing.Font,$DRAWING");
constant MenuItem = CLR::("System.Windows.Forms.MenuItem,$FORMS");
constant Shortcut = CLR::("System.Windows.Forms.Shortcut,$FORMS");

# Application variables
my $filename;
my $modified = False;

# The TextBox does all the interactive text editing
my $textbox = CLR::("System.Windows.Forms.TextBox,$FORMS").new;
$textbox.Font = Font.new("Mono", 10);
$textbox.Dock = CLR::("System.Windows.Forms.DockStyle,$FORMS").Fill;
$textbox.Multiline = True;
$textbox.WordWrap = False;
$textbox.AcceptsTab = True;
if @*ARGS { # Allow passing a file name from the command line
$filename = @*ARGS[0];
$textbox.AppendText(slurp $filename); # TODO: replace with the following:
# $textbox.Text = slurp $filename;
# $textbox.Modified = False;
# $textbox.DeselectAll;
# TODO: but these leave all the text *selected* :P
}
$textbox.add_TextChanged(&TextChanged);
$textbox.ScrollBars = CLR::("System.Windows.Forms.ScrollBars,$FORMS").Both;

# Define Menu and MenuItems
my $menuFile = MenuItem.new("&File");
$menuFile.MenuItems.Add(MenuItem.new("&New", &New, Shortcut.CtrlN));
$menuFile.MenuItems.Add(MenuItem.new("&Open", &Open, Shortcut.CtrlO));
$menuFile.MenuItems.Add(MenuItem.new("&Save", &Save, Shortcut.CtrlS));
$menuFile.MenuItems.Add(MenuItem.new("Save&As", &SaveAs, Shortcut.CtrlA));
$menuFile.MenuItems.Add(MenuItem.new("E&xit", &Exit, Shortcut.CtrlQ));
my $menu = CLR::("System.Windows.Forms.MainMenu,$FORMS").new;
my $menuEdit = MenuItem.new("&Edit");
$menuEdit.MenuItems.Add(MenuItem.new("&Undo", &Undo, Shortcut.CtrlZ));
$menuEdit.MenuItems.Add(MenuItem.new("Cu&t", &Cut, Shortcut.CtrlX));
$menuEdit.MenuItems.Add(MenuItem.new("&Copy", &Copy, Shortcut.CtrlC));
$menuEdit.MenuItems.Add(MenuItem.new("&Paste", &Paste, Shortcut.CtrlV));
$menu.MenuItems.Add($menuFile);
$menu.MenuItems.Add($menuEdit);

# The form is the main application window
my $form = CLR::("System.Windows.Forms.Form,$FORMS").new;
$form.Size = CLR::("System.Drawing.Size,$DRAWING").new(600,400);
$form.Menu = $menu;
$form.Controls.Add($textbox);
setformtitle();
CLR::("System.Windows.Forms.Application,$FORMS").Run($form);

# Event handlers
sub New($sender, $eventargs) #OK not used
{
$textbox.Clear;
$filename = Nil;
$modified = False;
setformtitle();
}

sub Open($sender, $eventargs) #OK not used
{
my $dialogOpen = CLR::("System.Windows.Forms.OpenFileDialog,$FORMS").new;
$dialogOpen.Filter = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*";
$dialogOpen.FilterIndex = 1;
if ~ $dialogOpen.ShowDialog eq 'OK' {
$filename = $dialogOpen.FileName;
$textbox.Text = slurp $filename;
$modified = False;
setformtitle();
}
}

sub Save($sender, $eventargs) #OK not used
{
if defined $filename { spew $filename, $textbox.Text; $modified=False; setformtitle(); }
else { SaveAs($sender, $eventargs); }
}

sub SaveAs($sender, $eventargs) #OK not used
{
my $dialogSave = CLR::("System.Windows.Forms.SaveFileDialog,$FORMS").new;
$dialogSave.Filter = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*";
$dialogSave.FilterIndex = 1;
if ~ $dialogSave.ShowDialog eq 'OK' {
$filename = $dialogSave.FileName;
spew $filename, $textbox.Text;
$modified = False;
setformtitle();
}
}

sub Exit($sender, $eventargs) #OK not used
{
if $modified {
# TODO: Offer to save edited text
}
CLR::("System.Windows.Forms.Application,$FORMS").Exit;
}

sub Undo($sender, $eventargs) #OK not used
{
$textbox.Undo; $textbox.Refresh;
}

sub Cut($sender, $eventargs) #OK not used
{
if $textbox.SelectionLength > 0 {
$textbox.Cut;
}
}

sub Copy($sender, $eventargs) #OK not used
{
if $textbox.SelectionLength > 0 {
$textbox.Copy;
}
}

sub Paste($sender, $eventargs) #OK not used
{
$textbox.Paste;
}

sub TextChanged($sender, $eventargs) #OK not used
{
$modified = True;
setformtitle();
}

# helper subroutines
sub setformtitle()
{
my $name = $filename // 'untitled'; # /
$form.Text = ($modified ?? '*' !! '') ~ $name ~ ' - Niecza Notepad';
}

0 comments on commit 68ddcb5

Please sign in to comment.