Gtk-Perl

 view release on metacpan or  search on metacpan

GtkGLArea/Glut.pm  view on Meta::CPAN

	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}) {



( run in 1.071 second using v1.01-cache-2.11-cpan-364913b4093 )