view release on metacpan or  search on metacpan

lib/App/Guiio.pm  view on Meta::CPAN

                 
		 .---------.  .---------.
                 | State 1 |  | State 2 |
                 '---------'  '---------'
                    ^   \         ^  \
                   /     \       /    \
                  /       \     /      \
                 /         \   /        \
                /           \ /          \
               /             v            v
            ******        ******        ******
            * T1 *        * T2 *        * T3 *
            ******        ******        ******
               ^             ^             /
                \             \           /
                 \             \         /
                  \             \       / stimuli
                   \             \     /
                    \             \   v
                     \         .---------.
                      '--------| State 3 |
                               '---------'
			       

=cut

sub new
{
my ($class, $width, $height) = @_ ;

my $drawing_area = Gtk2::DrawingArea->new;

my $self = 
	bless 
		{
		widget => $drawing_area,
		ELEMENT_TYPES => [],
		ELEMENTS => [],
		CONNECTIONS => [],
		CLIPBOARD => {},
		FONT_FAMILY => 'Monospace',
		FONT_SIZE => '10',
		TAB_AS_SPACES => '   ',
		OPAQUE_ELEMENTS => 1,
		DISPLAY_GRID => 1,
		
		PREVIOUS_X => -1, PREVIOUS_Y => -1,
		MOUSE_X => 0, MOUSE_Y => 0,
		DRAGGING => '',
		SELECTION_RECTANGLE =>{START_X => 0, START_Y => 0},
		
		ACTIONS => {},
		VALID_SELECT_ACTION => { map {$_, 1} qw(resize move)},
		
		COPY_OFFSET_X => 3,
		COPY_OFFSET_Y => 3,
		COLORS =>
			{
			background => [255, 255, 255],
			grid => [229, 235, 255],
			ruler_line => [85, 155, 225],
			selected_element_background => [180, 244, 255],
			element_background => [251, 251, 254],
			element_foreground => [0, 0, 0] ,
			selection_rectangle => [255, 0, 255],
			test => [0, 255, 255],
			
			group_colors =>
				[
				[[250, 221, 190], [250, 245, 239]],
				[[182, 250, 182], [241, 250, 241]],
				[[185, 219, 250], [244, 247, 250]],
				[[137, 250, 250], [235, 250, 250]],
				[[198, 229, 198], [239, 243, 239]],
				],
				
			connection => 'Chocolate',
			connection_point => [230, 198, 133],
			connector_point => 'DodgerBlue',
			extra_point => [230, 198, 133],
			},
		
		NEXT_GROUP_COLOR => 0, 
			
		WORK_DIRECTORY => '.guiio_work_dir',
		CREATE_BACKUP => 1,
		MODIFIED => 0,
		
		DO_STACK_POINTER => 0,
		DO_STACK => [] ,
		}, __PACKAGE__ ;

$drawing_area->can_focus(TRUE) ;

$drawing_area->signal_connect(configure_event => \&configure_event, $self);
$drawing_area->signal_connect(expose_event => \&expose_event, $self);
$drawing_area->signal_connect(motion_notify_event => \&motion_notify_event, $self);
$drawing_area->signal_connect(button_press_event => \&button_press_event, $self);
$drawing_area->signal_connect(button_release_event => \&button_release_event, $self);
$drawing_area->signal_connect(key_press_event => \&key_press_event, $self);

$drawing_area->set_events
		([qw/
		exposure-mask
		leave-notify-mask
		button-press-mask
		button-release-mask
		pointer-motion-mask
		key-press-mask
		key-release-mask
		/]);

$self->event_options_changed() ;

return($self) ;
}

#-----------------------------------------------------------------------------

sub event_options_changed
{
my ($self) = @_;

lib/App/Guiio.pm  view on Meta::CPAN

sub get_font
{
my ($self) = @_;

return($self->{FONT_FAMILY},  $self->{FONT_SIZE}) ;
}

#-----------------------------------------------------------------------------

sub update_display 
{
my ($self) = @_;
my $widget = $self->{widget} ;

$self->call_hook('CANONIZE_CONNECTIONS', $self->{CONNECTIONS}, $self->get_character_size()) ;

$widget->queue_draw_area(0, 0, $widget->allocation->width,$widget->allocation->height);
}

#-----------------------------------------------------------------------------

sub call_hook
{
my ($self, $hook_name,  @arguments) = @_;

$self->{HOOKS}{$hook_name}->(@arguments)  if (exists $self->{HOOKS}{$hook_name}) ;
}

#-----------------------------------------------------------------------------

sub configure_event 
{
my ($widget, $event, $self) = @_;

$self->{PIXMAP} = Gtk2::Gdk::Pixmap->new 
			(
			$widget->window,
			$widget->allocation->width, $widget->allocation->height,
			-1
			);

$self->{PIXMAP}->draw_rectangle
		(
		$widget->get_style->base_gc ($widget->state),
		TRUE, 0, 0, $widget->allocation->width,
		$widget->allocation->height
		);
		
return TRUE;
}

#-----------------------------------------------------------------------------

sub expose_event
{
my ($widget, $event, $self) = @_;

my $gc = Gtk2::Gdk::GC->new($self->{PIXMAP});

# draw background
$gc->set_foreground($self->get_color('background'));

$self->{PIXMAP}->draw_rectangle
		(
		$gc,	TRUE,
		0, 0,
		$widget->allocation->width, $widget->allocation->height
		);

my ($character_width, $character_height) = $self->get_character_size() ;
my ($widget_width, $widget_height) = $self->{PIXMAP}->get_size();

if($self->{DISPLAY_GRID})
	{
	$gc->set_foreground($self->get_color('grid'));

	for my $horizontal (0 .. ($widget_height/$character_height) + 1)
		{
		$self->{PIXMAP}->draw_line
					(
					$gc,
					0,  $horizontal * $character_height,
					$widget_width, $horizontal * $character_height
					);
		}

	for my $vertical(0 .. ($widget_width/$character_width) + 1)
		{
		$self->{PIXMAP}->draw_line
					(
					$gc,
					$vertical * $character_width, 0,
					$vertical * $character_width, $widget_height
					);
		}
	}
	
# draw elements
for my $element (@{$self->{ELEMENTS}})
	{
	my ($background_color, $foreground_color) =  $element->get_colors() ;
	
	if($self->is_element_selected($element))
		{
		if(exists $element->{GROUP} and defined $element->{GROUP}[-1])
			{
			$background_color = 
				$self->get_color
					(
					$self->{COLORS}{group_colors}[$element->{GROUP}[-1]{GROUP_COLOR}][0]
					) ;
			}
		else
			{
			$background_color = $self->get_color('selected_element_background');
			}
		}
	else
		{
		if(defined $background_color)
			{
			$background_color = $self->get_color($background_color) ;
			}
		else
			{
			if(exists $element->{GROUP} and defined $element->{GROUP}[-1])
				{
				$background_color = 
					$self->get_color
						(
						$self->{COLORS}{group_colors}[$element->{GROUP}[-1]{GROUP_COLOR}][1]
						) ;
				}
			else
				{
				$background_color = $self->get_color('element_background') ;
				}
			}
		}
			
	$foreground_color = 
		defined $foreground_color
			? $self->get_color($foreground_color)
			: $self->get_color('element_foreground') ;
			
	$gc->set_foreground($foreground_color);
	
	for my $mask_and_element_strip ($element->get_mask_and_element_stripes())
		{
		$gc->set_foreground($background_color);
			
		$self->{PIXMAP}->draw_rectangle
					(
					$gc,
					$self->{OPAQUE_ELEMENTS},
					($element->{X} + $mask_and_element_strip->{X_OFFSET}) * $character_width,
					($element->{Y} + $mask_and_element_strip->{Y_OFFSET}) * $character_height,
					$mask_and_element_strip->{WIDTH} * $character_width,
					$mask_and_element_strip->{HEIGHT} * $character_height,
					);
					
		$gc->set_foreground($foreground_color);
		
		my $layout = $widget->create_pango_layout($mask_and_element_strip->{TEXT}) ;
		
		my ($text_width, $text_height) = $layout->get_pixel_size;
		
		$self->{PIXMAP}->draw_layout
					(
					$gc,
					($element->{X} + $mask_and_element_strip->{X_OFFSET}) * $character_width,
					($element->{Y} + $mask_and_element_strip->{Y_OFFSET}) * $character_height,
					$layout
					);
		}
	}

# draw ruler lines
for my $line (@{$self->{RULER_LINES}})
	{
	my $color = Gtk2::Gdk::Color->new( map {$_ * 257} @{$line->{COLOR} }) ;
	$self->{widget}->get_colormap->alloc_color($color,TRUE,TRUE) ;
	
	$gc->set_foreground($color);
	
	if($line->{TYPE} eq 'VERTICAL')
		{
		$self->{PIXMAP}->draw_line
					(
					$gc,
					$line->{POSITION} * $character_width, 0,
					$line->{POSITION} * $character_width, $widget_height
					);
		}
	else
		{
		$self->{PIXMAP}->draw_line
					(
					$gc,
					0, $line->{POSITION} * $character_height,
					$widget_width, $line->{POSITION} * $character_height
					);
		}
	}

# draw connections
my (%connected_connections, %connected_connectors) ;

for my $connection (@{$self->{CONNECTIONS}})
	{