GtkGLArea/Glut.pm - metacpan.org

package Gtk::GLArea::Glut;

# Glut, as made possible by Perl/Gtk, with the cooperation of GtkGLArea. 
#
# The interface is intended to be identical to that used by Perl/OpenGL, and
# in fact Perl/OpenGL is required, to supply the fonts and teapots.

# Early Alpha version, plenty of stuff not supported yet

use OpenGL qw(:glutconstants
	glutSolidSphere
	glutWireSphere
	glutSolidCone
	glutWireCone
	glutSolidCube
	glutWireCube
	glutSolidTorus
	glutWireTorus
	glutSolidTeapot
	glutWireTeapot
);
use Gtk::GLArea::Constants;

require Exporter;
require Gtk;

@ISA = qw(Exporter);

@glut_func = qw(
	glutInitWindowSize
	glutInitWindowPosition
	glutInitDisplayMode
	glutInit
	glutCreateWindow
	glutCreateSubWindow
	glutMainLoop
	glutDisplayFunc
	glutReshapeFunc
	glutVisibilityFunc
	glutIdleFunc
	glutGet
	glutSwapBuffers
	glutPostRedisplay
	glutCreateMenu
	glutGetMenu
	glutSetMenu
	glutGetWindow
	glutSetWindow
	glutDestroyMenu
	glutAddMenuEntry
	glutAddSubMenu
	glutChangeToMenuEntry
	glutChangeToSubMenu
	glutRemoveMenuItem
	glutAttachMenu
	glutDetachMenu
	glutMenuStateFunc

	
	glutSolidSphere
	glutWireSphere
	glutSolidCone
	glutWireCone
	glutSolidCube
	glutWireCube
	glutSolidTorus
	glutWireTorus
	glutSolidTeapot
	glotWireTeapot
);

@EXPORT = qw();

@EXPORT_OK = (@glut_func, @OpenGL::glut_const);

%EXPORT_TAGS = ('all' => \@EXPORT_OK, 'functions' => \@glut_func, 'constants' => \@OpenGL::glut_const);

$id=0;

sub _NewWindowID {
	return ++$id;
}

$mid=0;

sub _NewMenuID {
	return ++$mid;
}


@window = ();
@menu = ();
$current = undef;
$currentgl = undef;
$currentmenu = undef;
$popupwindow = undef;
$idle = undef;
$idlecb = undef;

@initialSize = (300, 30);
@initialPos = (-1, -1);
$initialMode = ( GLUT_RGB | GLUT_SINGLE | GLUT_DEPTH );

sub glutInitWindowSize ($$) {
	@initialSize = @_;
}

sub glutInitWindowPosition ($$) {
	@initialPos= @_;
}

sub glutInitDisplayMode ($) {
	$initialMode = $_[0];
}

sub glutInit () {
	OpenGL::glutInit();
}

sub _draw {
	my($g) = $_[0];

	$currentgl->endgl if defined $currentgl;

	local($current,$currentgl) = ($g->{data}, $g);
	$currentgl->begingl;
	_invoke($current->{display});

}

sub _idle {

	return _invoke($idle);
}

sub _timer {

	return _invoke($_[0]);
}

sub _key {

}

sub _visible {
}


sub _invoke {
	my($s, @args) = @_;
	if (not defined $s) {
		return 0;
	}
	my(@a) = @$s;
	$s = shift @a;
	if (defined $s) {
		if (defined ref $s and ref $s ne "CODE") {
			my($method) = shift @args;
			$s->$method(@a, @args);
		} else {
			&{$s}(@a, @args);
		}
		return 1;
	} else {
		return 0;
	}
}

sub _button {
	my($g,$e) = @_;
	
	$currentgl->endgl if defined $currentgl;

	local($current,$currentgl) = ($g->{data}, $g);
	$currentgl->begingl;
	
	my($i) = $current->{menu}->[$e->{button}];
	
	return if not defined $i or not defined $menu[$i];
	
	$m = _generateMenu($menu[$i]);
	
	$popupwindow = $current;

	_invoke($current->{menustate}, 1);
	
	$m->popup(undef, undef, $e->{'button'}, $e->{'time'});
}	

sub _menu {
	my($widget,$menu,$value) = @_;

	$currentgl->endgl if defined $currentgl;
	
	$currentmenu = $menu;

	local($current,$currentgl) = ($popupwindow, $popupwindow->{glarea});
	$currentgl->begingl;
	
	&{$menu->{callback}->[0]}($value);
}

sub glutCreateWindow ($) {
	my($title) = @_;
	
	my($w) = (new Gtk::Window -toplevel);
	
	$w->set_title($title);
	$w->set_policy(1, 1, 0);
	#$w->set_usize(@initialSize) if @initialSize and $initialSize[0]>0 and $initialSize[1]>0;
	#$w->set_uposition(@initialPos) if @initialPos and $initialPos[0]>0 and $initialPos[1]>0;
	$w->set_default_size(100, 100);

	my($f) = new Gtk::Fixed;
	
	#show $f;
	
	$w->add($f);
	
	my($g) = new Gtk::DrawingArea; # _glut_init($initialMode);
	$g->set_events([-exposure_mask, -button_press_mask, -key_press_mask, -pointer_motion_mask, -pointer_motion_hint_mask]);

	use Data::Dumper;

	$f->set_usize(40,40); #@initialSize) if @initialSize and $initialSize[0]>0 and $initialSize[1]>0;
	
	$f->put($g, 0, 0);
	
	
	$w->signal_connect("configure_event" => sub {
		my($widget,$e) = @_;
		use Data::Dumper;
		print Dumper($e);
		if ($e->{width} > 0 and $e->{height} > 0) {
			$g->set_usize($e->{width}, $e->{height});
		}
	});

	$g->signal_connect("size_allocate" => sub {
		print "size_allocate: ", Dumper($_[1]);
		#$g->set_usize($_[1]->[2], $_[1]->[3]);
	});

#	$g->signal_connect("expose_event" => \&_draw);
	$g->signal_connect("visibility_notify_event" => \&_visible);
	$g->signal_connect("button_press_event" => \&_button);
	$g->signal_connect("key_press_event" => \&_key);

	$g->signal_connect("map" => sub { 
		if (!$g->{data}->{visible}) {
			_invoke($g->{visibility}, 1);
			$g->{data}->{visible} = 1;
		}
	});

	$g->signal_connect("unmap" => sub { 
		if ($g->{data}->{visible}) {
			_invoke($g->{visibility}, 0);
			$g->{data}->{visible} = 0;
		}
	});

	$g->{window} = $w;
	
	#show $g;
	
	show_all $w;

#	$g->can_focus(1);
#	$g->grab_focus();

	my($id) = _NewWindowID();
	
	$window[$id] = { "window" => $w, "parent" => undef, "id" => $id, "fixed" => $f, "glarea" => $g,
					"display" => undef, "toplevel" => 1 };

	$g->{data} = $window[$id];
	
	$current = $window[$id];
	
#	$g->begingl;
	
	return $id;
}

sub glutCreateSubWindow ($$$$$) {
	my($parentID, $x, $y, $w, $h) = @_;
	
	my($id) = _NewWindowID();
	
	my($f) = new Gtk::Fixed;
	$f->set_usize($w, $h);
	show $f;
	
	$window[$parentID]->{fixed}->put($f, $x, $y);
	

	my($g) = _glut_init($initialMode);
	$g->set_events([-exposure_mask, -button_press_mask, -key_press_mask, -pointer_motion_mask, -pointer_motion_hint_mask]);

#	$g->signal_connect("expose_event" => \&_draw);
	$g->signal_connect("visibility_notify_event" => \&_visible);
	$g->signal_connect("button_press_event" => \&_button);
	$g->signal_connect("key_press_event" => \&_key);
	
	
	$window[$id] = { "parent" => $window[$parentID], "id" => $id, "glarea" => $g, "window" => $window[$parentID]->{window}, "fixed" => $f,
					"toplevel" => 0, "visible" => 0};

	$g->signal_connect("map" => sub { 
		if (!$g->{data}->{visible}) {
			_invoke($g->{visibility}, 1);
			$g->{data}->{visible} = 1;
		}
	});

	$g->signal_connect("unmap" => sub { 
		if ($g->{data}->{visible}) {
			_invoke($g->{visibility}, 0);
			$g->{data}->{visible} = 0;
		}
	});
	
	push @{$window[$parentID]->{children}}, $id;

	$g->{data} = $window[$id];
	
	$g->set_usize($w, $h);
	
	show $g;

	$f->put($g, 0, 0);
	
	$current = $window[$id];
	
	$g->begingl;
	
	return $id;
}

sub glutDestroyWindow ($) {
	my($id) = @_;
	
	my($w) = $window[$id];
	
	$w->{window}->hide;
	
	if (defined $w->{parent}) {
		@{$w->{parent}->{children}} = grep {$_ != $id} @{$w->{parent}->{children}};
	}
	
	my(@children) = @{$w->{children}};
	
	foreach (@children) {
		glutDestroyWindow($_);
	}
	
	$window[$id] = undef;
}

sub glutGetWindow () {
	return $current->{id};
}

sub glutSetWindow ($) {
	my($id) = $_[0];
	
	$current = $window[$id];
	$currentgl = $current->{glarea};
}

sub glutShowWindow {
	$current->{window}->show;
}

sub glutHideWindow {
	$current->{window}->hide;
}

sub glutDisplayFunc (@) {

	$current->{display} = [@_];
}

sub glutReshapeFunc (@) {
	
	$current->{reshape} = [@_];
	
	if (@_ and defined $_[0]) {
		if (!defined $g->{reshapeID}) {
			$current->{reshapeID} = $current->{glarea}->signal_connect("configure_event" => sub {
				my($g) = $_[0];

				$currentgl->endgl if defined $currentgl;

				local($current,$currentgl) = ($g->{data}, $g);
				$currentgl->begingl;

				my($a) = $g->allocation;
				if (_invoke($current->{reshape}, $a->[2], $a->[3])) {
					glutPostRedisplay();
				}
			
			});
		}
	} else {
		if (defined $g->{reshapeID}) {
			$current->{glarea}->signal_disconnect($current->{reshapeID});
			delete $current->{reshapeID};
		}
	}

}

sub glutVisibilityFunc (@) {
	# This doesn't work as you'd expect, unfortunately.
	$current->{visible} = [@_];
}

sub glutKeyboardFunc (@) {
	$current->{keyboard} = [@_];
}

sub glutMenuStateFunc (@) {
	$current->{menustate} = [@_];
}

sub glutIdleFunc (@) {
	$idle = [@_];
	if (defined $idlecb) {
		Gtk->idle_remove($idlecb);
		$idlecb = undef;
	}
	if (@_) {
		$idlecb = Gtk->idle_add(\&_idle);
	}
}

sub glutTimerFunc ($@) {
	my($msec, @handler) = @_;
	Gtk->timeout_add($msec, \&_timer, \@handler);
}

sub glutMainLoop {
	Gtk->main();
}

sub glutGet ($) {
	my($x) = $_[0];
	
	if ($x == GLUT_WINDOW_WIDTH) {
		my($a) = $current->{glarea}->allocation;
		return $a->[2];
	}
	elsif ($x == GLUT_WINDOW_HEIGHT) {
		my($a) = $current->{glarea}->allocation;
		return $a->[3];
	}
	else {
		return OpenGL::glutGet($x);
	}
}

sub glutSwapBuffers () {
	$current->{glarea}->swapbuffers();
}

sub glutPostRedisplay () {
	$current->{glarea}->queue_draw();
}

sub glutCreateMenu (@) {
	my($m) = { "callback" => [@_], "id" => _NewMenuID() };
	$menu[$m->{id}] = $m;
	
	$currentmenu = $m;
	
	return $m->{id};
}

sub glutGetMenu () {
	return $currentmenu->{id};
}

sub glutSetMenu ($) {
	my($id) = @_;
	
	$currentmenu = $menu[$id];
}

sub glutDestroyMenu ($) {
	$menu[$id] = undef;
	
	if ($currentmenu->{id} == $id) {
		if (defined $currentmenu->{generated}) {
			$currentmenu->{generate}->destroy;
		}
		$currentmenu = undef;
	}
}

sub glutAddMenuEntry ($$) {
	my($label, $value) = @_;
	push @{$currentmenu->{entries}}, [1, $label, $value];
	
	$currentmenu->{regenerate}=1;
}

sub glutAddSubMenu ($$) {
	my($label, $submenu) = @_;
	push @{$currentmenu->{entries}}, [2, $label, $submenuid];

	$currentmenu->{regenerate}=1;
}

sub glutChangeToMenuEntry ($$$) {
	my($item, $label, $value) = @_;
	$currentmenu->{entries}->[$item] = [1, $label, $value];

	$currentmenu->{regenerate}=1;
}

sub glutChangeToSubMenu ($$$) {
	my($item, $label, $submenu) = @_;
	$currentmenu->{entries}->[$item] = [2, $label, $submenu];

	$currentmenu->{regenerate}=1;
}

sub glutRemoveMenuItem ($) {
	my($item) = @_;
	splice @{$currentmenu->{entries}}, $item, 1;

	$currentmenu->{regenerate}=1;
}

sub _regenerateMenu {
	my($m) = $_[0];
	
	if ($m->{regenerate} or !$m->{generated}) {
		return 1;
	}

	foreach (@{$m->{entries}}) {
		if ($_->[0] == 2 and $menu[$_->[2]]) {
			if (_regenerateMenu($menu[$_->[2]])) {
				return 1;
			}
		}
	}
	
	return 0;
}

sub _generateMenu {
	my($m) = @_;
	
	if (!_regenerateMenu($m)) {
		return $m->{generated};
	}

	if ($m->{generated}) {
		$m->{generated}->popdown;
		#destroy $m->{generated};
		$m->{generated} = undef;
		# Let it get garbage collected
	}

	my($menu) = new Gtk::Menu;
	
	foreach (@{$m->{entries}}) {
		if ($_->[0] == 1) {
			my($i) = new Gtk::MenuItem $_->[1];
			$i->signal_connect("activate" => \&_menu, $m, $_->[2]);
			show $i;
			$menu->append($i);
		} elsif ($_->[0] == 2) {
			my($i) = new Gtk::MenuItem $_->[1];
			$i->set_submenu(_generateMenu($menu[$_->[2]]));
			show $i;
			$menu->append($i);
		}
	}

	$menu->signal_connect("deactivate" => sub { _invoke($current->{menustate}, 0); } );

	$m->{generated} = $menu;
	$m->{regenerate} = 0;
	
	return $menu;
}

sub glutAttachMenu ($) {
	my($button) = @_;
	
	$current->{menu}->[$button] = $currentmenu->{id};
}

sub glutDetachMenu ($) {
	my($button) = @_;
	
	$current->{menu}->[$button] = undef;
}

sub glutPushWindow () {
	
	$current->{window}->window->lower();
}


sub glutPopWindow () {
	
	$current->{window}->window->raise();
}

sub _glut_init {
	my($mode) = @_;
	my(@i);
	my($g);
	
	if (($mode & GLUT_INDEX) != GLUT_INDEX) {
	
		push @i, GDK_GL_RGBA, GDK_GL_RED_SIZE, 1, GDK_GL_GREEN_SIZE, 1, GDK_GL_BLUE_SIZE, 1;

		if (($mode & GLUT_ALPHA) == GLUT_ALPHA) {
			push @i, GDK_GL_ALPHA_SIZE, 1;
		}

		if (($mode & GLUT_DOUBLE) == GLUT_DOUBLE) {
			push @i, GDK_GL_DOUBLEBUFFER;
		}

		if (($mode & GLUT_STEREO) == GLUT_STEREO) {
			push @i, GDK_GL_STEREO;
		}

		if (($mode & GLUT_DEPTH) == GLUT_DEPTH) {
			push @i, GDK_GL_DEPTH_SIZE, 1;
		}

		if (($mode & GLUT_STENCIL) == GLUT_STENCIL) {
			push @i, GDK_GL_STENCIL_SIZE, 1;
		}

		if (($mode & GLUT_ACCUM) == GLUT_ACCUM) {
			push @i, GDK_GL_ACCUM_RED_SIZE, 1;
			push @i, GDK_GL_ACCUM_GREEN_SIZE, 1;
			push @i, GDK_GL_ACCUM_BLUE_SIZE, 1;

			if (($mode & GLUT_ALPHA) == GLUT_ALPHA) {
				push @i, GDK_GL_ACCUM_ALPHA_SIZE, 1;
			}
		}

		return new Gtk::GLArea @i;
	
	} else {
	
		push @i, GDK_GL_BUFFER_SIZE, 1;

		if (($mode & GLUT_DOUBLE) == GLUT_DOUBLE) {
			push @i, GDK_GL_DOUBLEBUFFER;
		}

		if (($mode & GLUT_STEREO) == GLUT_STEREO) {
			push @i, GDK_GL_STEREO;
		}

		if (($mode & GLUT_DEPTH) == GLUT_DEPTH) {
			push @i, GDK_GL_DEPTH_SIZE, 1;
		}

		if (($mode & GLUT_STENCIL) == GLUT_STENCIL) {
			push @i, GDK_GL_STENCIL_SIZE, 1;
		}
	
		foreach (16, 12, 8, 4, 2, 1, 0) {
			$i[1] = $_;
			
			$g = new Gtk::GLArea @i;
			
			return $g if defined $g;
		}
	}
	
	return undef;
}

1;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)