File Coverage

blib/lib/App/Asciio.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1              
2             package App::Asciio ;
3              
4             $|++ ;
5              
6 1     1   9499 use strict;
  1         6  
  1         41  
7 1     1   5 use warnings;
  1         3  
  1         32  
8              
9 1     1   415 use Data::TreeDumper ;
  0            
  0            
10             use Clone;
11             use List::Util qw(min max first) ;
12             use List::MoreUtils qw(any minmax first_value) ;
13              
14             use Glib ':constants';
15             use Gtk2 -init;
16             use Gtk2::Gdk::Keysyms ;
17             my %K = %Gtk2::Gdk::Keysyms ;
18             my %C = map{$K{$_} => $_} keys %K ;
19              
20              
21             use App::Asciio::Setup ;
22             use App::Asciio::Dialogs ;
23             use App::Asciio::Elements ;
24             use App::Asciio::Menues ;
25             use App::Asciio::Actions ;
26             use App::Asciio::Undo ;
27             use App::Asciio::Io ;
28             use App::Asciio::Ascii ;
29             use App::Asciio::Options ;
30              
31             #-----------------------------------------------------------------------------
32              
33             our $VERSION = '1.02' ;
34              
35             #-----------------------------------------------------------------------------
36              
37             =head1 NAME
38            
39             App::Asciio - Plain ASCII diagram
40            
41             | | | |
42             | | | | | |
43             | | | | | |
44             v | v | v |
45             v v v
46             _____ _____
47             /\ _ \ /\ __ \
48             \ \ \_\ \ ___ ___ _ _\ \ \ \ \
49             -----> \ \ __ \ / __\ / ___\/\ \/\ \ \ \ \ \ ----->
50             \ \ \ \ \/\__, \/\ \___' \ \ \ \ \ \_\ \
51             \ \_\ \_\/\____/\ \____/\ \_\ \_\ \_____\
52             \/_/\/_/\/___/ \/___/ \/_/\/_/\/_____/
53            
54             | | | |
55             | | | | | | |
56             v | | | v | |
57             | v | | |
58             v | | v
59             v v
60             (\_/)
61             (O.o) ASCII world domination is near!
62             (> <)
63            
64             =head1 SYNOPSIS
65            
66             $> perl asciio.pl
67            
68             =head1 DESCRIPTION
69            
70             This gtk2-perl application allows you to draw ASCII diagrams in a modern (but simple) graphical
71             application. The ASCII graphs can be saved as ASCII or in a format that allows you to modify them later.
72            
73             Thanks to all the Perl-QA hackathon 2008 in Oslo for pushing me to do an early release.
74            
75             Special thanks go to the Muppet and the gtk-perl group, Gábor Szabó for his help and advices.
76            
77             Adam Kennedy coined the cool name.
78            
79             Sometimes a diagram is worth a lot of text in a source code file. It has always been painfull to do
80             ASCII diagrams by hand.
81            
82             =head1 DOCUMENTATION
83            
84             =head2 Asciio user interface
85            
86            
87             .-----------------------------------------------------------------.
88             | Asciio |
89             |-----------------------------------------------------------------|
90             | ............................................................... |
91             | ..............-------------..------------..--------------...... |
92             | .............| stencils > || asciio > || box |..... |
93             | .............| Rulers > || computer > || text |..... |
94             | .............| File > || people > || wirl_arrow |..... |
95             grid---------->.......'-------------'| divers > || axis |..... |
96             | ............................'------------'| boxes > |..... |
97             | ......................^...................| rulers > |..... |
98             | ......................|...................'--------------'..... |
99             | ......................|........................................ |
100             | ......................|........................................ |
101             | ......................|........................................ |
102             | ......................|........................................ |
103             '-----------------------|-----------------------------------------'
104             |
105             |
106             context menu
107            
108            
109             =head2 context menu
110            
111             The context menu allows to access to B<asciio> commands. B<ASCII> is used to insert ASCII elements.
112            
113             =head2 keyboard shortcuts
114            
115             All the keyboad commands definitions can be found under I<asciio/setup/actions/>. Among the commands
116             implemented are:
117            
118             =over 2
119            
120             =item * select all
121            
122             =item * delete
123            
124             =item * undo
125            
126             =item * group/ungroup
127            
128             =item * open / save
129            
130             =item * local clipboard operations
131            
132             =back
133            
134             A window displaying the currently available commands is displayed if you press B<K>.
135            
136             =head2 elements
137            
138             There but a few elements implemented at the moment.
139            
140             =head3 wirl arrow
141            
142             An arrow that tries to do what you want. Try rotating the end clockwise then counter clockwise to see how it acts
143            
144             ^
145             |
146             | --------.
147             | |
148             '------- |
149             |
150             O-------------X / |
151             / |
152             / |
153             / v
154             /
155             /
156             v
157            
158             =head3 box and text
159            
160             Both are implemented within the same code. Try double clicking on a box to see what you can do with it.
161            
162             .----------.
163             | title |
164             .----------. |----------| ************
165             | | | body 1 | * *
166             '----------' | body 2 | ************
167             '----------'
168             anything in a box
169             (\_/) |
170             edit_me (O.o) <------------'
171             (> <)
172            
173             =head3 your own stencils
174            
175             Take a look at I<setup/stencils/computer> for a stencil example. Stencils lites in I<setup/setup.ini> will
176             be loaded when B<Asciio> starts.
177            
178             =head3 your own element type
179            
180             For simple elemnts, put your design in a box. that should cover 90% of anyone's needs. You can look in
181             I<lib/stripes> for element implementation examples.
182            
183             =head2 exporting to ASCII
184            
185             You can export to a file in ASCII format but using the B<.txt> extension.
186            
187             Exporting to the clipboard is done with B<ctl + e>.
188            
189             =head1 EXAMPLES
190            
191            
192             User code ^ ^ OS code
193             \ /
194             \ /
195             \ /
196             User code <----Mode----->OS code
197             / \
198             / \
199             / \
200             User code v v OS code
201            
202            
203            
204            
205             .---. .---. .---. .---. .---. .---.
206             OS API '---' '---' '---' '---' '---' '---'
207             | | | | | |
208             v v | v | v
209             .------------. | .-----------. | .-----.
210             | Filesystem | | | Scheduler | | | MMU |
211             '------------' | '-----------' | '-----'
212             | | | |
213             v | | v
214             .----. | | .---------.
215             | IO |<----' | | Network |
216             '----' | '---------'
217             | | |
218             v v v
219             .---------------------------------------.
220             | HAL |
221             '---------------------------------------'
222            
223            
224            
225            
226             .---------. .---------.
227             | State 1 | | State 2 |
228             '---------' '---------'
229             ^ \ ^ \
230             / \ / \
231             / \ / \
232             / \ / \
233             / \ / \
234             / v v
235             ****** ****** ******
236             * T1 * * T2 * * T3 *
237             ****** ****** ******
238             ^ ^ /
239             \ \ /
240             \ \ /
241             \ \ / stimuli
242             \ \ /
243             \ \ v
244             \ .---------.
245             '--------| State 3 |
246             '---------'
247            
248            
249             =cut
250              
251             sub new
252             {
253             my ($class, $width, $height) = @_ ;
254              
255             my $drawing_area = Gtk2::DrawingArea->new;
256              
257             my $self =
258             bless 
259             {
260             widget => $drawing_area,
261             ELEMENT_TYPES => [],
262             ELEMENTS => [],
263             CONNECTIONS => [],
264             CLIPBOARD => {},
265             FONT_FAMILY => 'Monospace',
266             FONT_SIZE => '10',
267             TAB_AS_SPACES => ' ',
268             OPAQUE_ELEMENTS => 1,
269             DISPLAY_GRID => 1,
270            
271             PREVIOUS_X => -1, PREVIOUS_Y => -1,
272             MOUSE_X => 0, MOUSE_Y => 0,
273             DRAGGING => '',
274             SELECTION_RECTANGLE =>{START_X => 0, START_Y => 0},
275            
276             ACTIONS => {},
277             VALID_SELECT_ACTION => { map {$_, 1} qw(resize move)},
278            
279             COPY_OFFSET_X => 3,
280             COPY_OFFSET_Y => 3,
281             COLORS =>
282             {
283             background => [255, 255, 255],
284             grid => [229, 235, 255],
285             ruler_line => [85, 155, 225],
286             selected_element_background => [180, 244, 255],
287             element_background => [251, 251, 254],
288             element_foreground => [0, 0, 0] ,
289             selection_rectangle => [255, 0, 255],
290             test => [0, 255, 255],
291            
292             group_colors =>
293             [
294             [[250, 221, 190], [250, 245, 239]],
295             [[182, 250, 182], [241, 250, 241]],
296             [[185, 219, 250], [244, 247, 250]],
297             [[137, 250, 250], [235, 250, 250]],
298             [[198, 229, 198], [239, 243, 239]],
299             ],
300            
301             connection => 'Chocolate',
302             connection_point => [230, 198, 133],
303             connector_point => 'DodgerBlue',
304             extra_point => [230, 198, 133],
305             },
306            
307             NEXT_GROUP_COLOR => 0,
308            
309             WORK_DIRECTORY => '.asciio_work_dir',
310             CREATE_BACKUP => 1,
311             MODIFIED => 0,
312            
313             DO_STACK_POINTER => 0,
314             DO_STACK => [] ,
315             }, __PACKAGE__ ;
316              
317             $drawing_area->can_focus(TRUE) ;
318              
319             $drawing_area->signal_connect(configure_event => \&configure_event, $self);
320             $drawing_area->signal_connect(expose_event => \&expose_event, $self);
321             $drawing_area->signal_connect(motion_notify_event => \&motion_notify_event, $self);
322             $drawing_area->signal_connect(button_press_event => \&button_press_event, $self);
323             $drawing_area->signal_connect(button_release_event => \&button_release_event, $self);
324             $drawing_area->signal_connect(key_press_event => \&key_press_event, $self);
325              
326             $drawing_area->set_events
327             ([qw/
328             exposure-mask
329             leave-notify-mask
330             button-press-mask
331             button-release-mask
332             pointer-motion-mask
333             key-press-mask
334             key-release-mask
335             /]);
336              
337             $self->event_options_changed() ;
338              
339             return($self) ;
340             }
341              
342             #-----------------------------------------------------------------------------
343              
344             sub event_options_changed
345             {
346             my ($self) = @_;
347              
348             my $number_of_group_colors = scalar(@{$self->{COLORS}{group_colors}}) ;
349             $self->{GROUP_COLORS} = [0 .. $number_of_group_colors - 1] ,
350              
351             $self->{CURRENT_ACTIONS} = $self->{ACTIONS} ;
352              
353             $self->set_font($self->{FONT_FAMILY}, $self->{FONT_SIZE});
354             }
355              
356             #-----------------------------------------------------------------------------
357              
358             sub destroy
359             {
360             my ($self) = @_;
361              
362             $self->{widget}->get_toplevel()->destroy() ;
363             }
364              
365             #-----------------------------------------------------------------------------
366              
367             sub set_title
368             {
369             my ($self, $title) = @_;
370              
371             if(defined $title)
372             {
373             $self->{widget}->get_toplevel()->set_title($title . ' - asciio') ;
374             $self->{TITLE} = $title ;
375             }
376             }
377              
378             sub get_title
379             {
380             my ($self) = @_;
381             $self->{TITLE} ;
382             }
383              
384             #-----------------------------------------------------------------------------
385              
386             sub set_font
387             {
388             my ($self, $font_family, $font_size) = @_;
389              
390             $self->{FONT_FAMILY} = $font_family || 'Monospace';
391             $self->{FONT_SIZE} = $font_size || 10 ;
392              
393             $self->{widget}->modify_font
394             (
395             Gtk2::Pango::FontDescription->from_string 
396             (
397             $self->{FONT_FAMILY} . ' ' . $self->{FONT_SIZE}
398             )
399             );
400             }
401              
402             sub get_font
403             {
404             my ($self) = @_;
405              
406             return($self->{FONT_FAMILY},  $self->{FONT_SIZE}) ;
407             }
408              
409             #-----------------------------------------------------------------------------
410              
411             sub update_display
412             {
413             my ($self) = @_;
414             my $widget = $self->{widget} ;
415              
416             $self->call_hook('CANONIZE_CONNECTIONS', $self->{CONNECTIONS}, $self->get_character_size()) ;
417              
418             $widget->queue_draw_area(0, 0, $widget->allocation->width,$widget->allocation->height);
419             }
420              
421             #-----------------------------------------------------------------------------
422              
423             sub call_hook
424             {
425             my ($self, $hook_name, @arguments) = @_;
426              
427             $self->{HOOKS}{$hook_name}->(@arguments)  if (exists $self->{HOOKS}{$hook_name}) ;
428             }
429              
430             #-----------------------------------------------------------------------------
431              
432             sub configure_event
433             {
434             my ($widget, $event, $self) = @_;
435              
436             $self->{PIXMAP} = Gtk2::Gdk::Pixmap->new
437             (
438             $widget->window,
439             $widget->allocation->width, $widget->allocation->height,
440             -1
441             );
442              
443             $self->{PIXMAP}->draw_rectangle
444             (
445             $widget->get_style->base_gc ($widget->state),
446             TRUE, 0, 0, $widget->allocation->width,
447             $widget->allocation->height
448             );
449            
450             return TRUE;
451             }
452              
453             #-----------------------------------------------------------------------------
454              
455             sub expose_event
456             {
457             my ($widget, $event, $self) = @_;
458              
459             my $gc = Gtk2::Gdk::GC->new($self->{PIXMAP});
460              
461             # draw background
462             $gc->set_foreground($self->get_color('background'));
463              
464             $self->{PIXMAP}->draw_rectangle
465             (
466             $gc, TRUE,
467             0, 0,
468             $widget->allocation->width, $widget->allocation->height
469             );
470              
471             my ($character_width, $character_height) = $self->get_character_size() ;
472             my ($widget_width, $widget_height) = $self->{PIXMAP}->get_size();
473              
474             if($self->{DISPLAY_GRID})
475             {
476             $gc->set_foreground($self->get_color('grid'));
477              
478             for my $horizontal (0 .. ($widget_height/$character_height) + 1)
479             {
480             $self->{PIXMAP}->draw_line
481             (
482             $gc,
483             0,  $horizontal * $character_height,
484             $widget_width, $horizontal * $character_height
485             );
486             }
487              
488             for my $vertical(0 .. ($widget_width/$character_width) + 1)
489             {
490             $self->{PIXMAP}->draw_line
491             (
492             $gc,
493             $vertical * $character_width, 0,
494             $vertical * $character_width, $widget_height
495             );
496             }
497             }
498            
499             # draw elements
500             for my $element (@{$self->{ELEMENTS}})
501             {
502             my ($background_color, $foreground_color) = $element->get_colors() ;
503            
504             if($self->is_element_selected($element))
505             {
506             if(exists $element->{GROUP} and defined $element->{GROUP}[-1])
507             {
508             $background_color =
509             $self->get_color
510             (
511             $self->{COLORS}{group_colors}[$element->{GROUP}[-1]{GROUP_COLOR}][0]
512             ) ;
513             }
514             else
515             {
516             $background_color = $self->get_color('selected_element_background');
517             }
518             }
519             else
520             {
521             if(defined $background_color)
522             {
523             $background_color = $self->get_color($background_color) ;
524             }
525             else
526             {
527             if(exists $element->{GROUP} and defined $element->{GROUP}[-1])
528             {
529             $background_color =
530             $self->get_color
531             (
532             $self->{COLORS}{group_colors}[$element->{GROUP}[-1]{GROUP_COLOR}][1]
533             ) ;
534             }
535             else
536             {
537             $background_color = $self->get_color('element_background') ;
538             }
539             }
540             }
541            
542             $foreground_color =
543             defined $foreground_color
544             ? $self->get_color($foreground_color)
545             : $self->get_color('element_foreground') ;
546            
547             $gc->set_foreground($foreground_color);
548            
549             for my $mask_and_element_strip ($element->get_mask_and_element_stripes())
550             {
551             $gc->set_foreground($background_color);
552            
553             $self->{PIXMAP}->draw_rectangle
554             (
555             $gc,
556             $self->{OPAQUE_ELEMENTS},
557             ($element->{X} + $mask_and_element_strip->{X_OFFSET}) * $character_width,
558             ($element->{Y} + $mask_and_element_strip->{Y_OFFSET}) * $character_height,
559             $mask_and_element_strip->{WIDTH} * $character_width,
560             $mask_and_element_strip->{HEIGHT} * $character_height,
561             );
562            
563             $gc->set_foreground($foreground_color);
564            
565             my $layout = $widget->create_pango_layout($mask_and_element_strip->{TEXT}) ;
566            
567             my ($text_width, $text_height) = $layout->get_pixel_size;
568            
569             $self->{PIXMAP}->draw_layout
570             (
571             $gc,
572             ($element->{X} + $mask_and_element_strip->{X_OFFSET}) * $character_width,
573             ($element->{Y} + $mask_and_element_strip->{Y_OFFSET}) * $character_height,
574             $layout
575             );
576             }
577             }
578              
579             # draw ruler lines
580             for my $line (@{$self->{RULER_LINES}})
581             {
582             my $color = Gtk2::Gdk::Color->new( map {$_ * 257} @{$line->{COLOR} }) ;
583             $self->{widget}->get_colormap->alloc_color($color,TRUE,TRUE) ;
584            
585             $gc->set_foreground($color);
586            
587             if($line->{TYPE} eq 'VERTICAL')
588             {
589             $self->{PIXMAP}->draw_line
590             (
591             $gc,
592             $line->{POSITION} * $character_width, 0,
593             $line->{POSITION} * $character_width, $widget_height
594             );
595             }
596             else
597             {
598             $self->{PIXMAP}->draw_line
599             (
600             $gc,
601             0, $line->{POSITION} * $character_height,
602             $widget_width, $line->{POSITION} * $character_height
603             );
604             }
605             }
606              
607             # draw connections
608             my (%connected_connections, %connected_connectors) ;
609              
610             for my $connection (@{$self->{CONNECTIONS}})
611             {
612             my $draw_connection ;
613             my $connector ;
614            
615             if($self->is_over_element($connection->{CONNECTED}, $self->{MOUSE_X}, $self->{MOUSE_Y}, 1))
616             {
617             $draw_connection++ ;
618            
619             $connector = $connection->{CONNECTED}->get_named_connection($connection->{CONNECTOR}{NAME}) ;
620             $connected_connectors{$connection->{CONNECTED}}{$connector->{X}}{$connector->{Y}}++ ;
621             }
622            
623             if($self->is_over_element($connection->{CONNECTEE}, $self->{MOUSE_X}, $self->{MOUSE_Y}, 1))
624             {
625             $draw_connection++ ;
626            
627             my $connectee_connection = $connection->{CONNECTEE}->get_named_connection($connection->{CONNECTION}{NAME}) ;
628            
629             if($connectee_connection)
630             {
631             $connected_connectors{$connection->{CONNECTEE}}{$connectee_connection->{X}}{$connectee_connection->{Y}}++ ;
632             }
633             }
634            
635             if($draw_connection)
636             {
637             $gc->set_foreground($self->get_color('connection'));
638            
639             $connector ||= $connection->{CONNECTED}->get_named_connection($connection->{CONNECTOR}{NAME}) ;
640            
641             $self->{PIXMAP}->draw_rectangle
642             (
643             $gc,
644             FALSE,
645             ($connector->{X} + $connection->{CONNECTED}{X}) * $character_width,
646             ($connector->{Y}  + $connection->{CONNECTED}{Y}) * $character_height,
647             $character_width, $character_height
648             );
649             }
650             }
651            
652             # draw connectors and connection points
653             for my $element (grep {$self->is_over_element($_, $self->{MOUSE_X}, $self->{MOUSE_Y}, 1)} @{$self->{ELEMENTS}})
654             {
655             $gc->set_foreground($self->get_color('connector_point'));
656             for my $connector ($element->get_connector_points())
657             {
658             next if exists $connected_connectors{$element}{$connector->{X}}{$connector->{Y}} ;
659            
660             $self->{PIXMAP}->draw_rectangle
661             (
662             $gc,
663             FALSE,
664             ($element->{X} + $connector->{X}) * $character_width,
665             ($connector->{Y} + $element->{Y}) * $character_height,
666             $character_width, $character_height
667             );
668             }
669            
670             $gc->set_foreground($self->get_color('connection_point'));
671             for my $connection_point ($element->get_connection_points())
672             {
673             next if exists $connected_connections{$element}{$connection_point->{X}}{$connection_point->{Y}} ;
674            
675             $self->{PIXMAP}->draw_rectangle # little box
676             (
677             $gc,
678             TRUE,
679             (($connection_point->{X} + $element->{X}) * $character_width) + ($character_width / 3),
680             (($connection_point->{Y} + $element->{Y}) * $character_height) + ($character_height / 3),
681             $character_width / 3 , $character_height / 3
682             );
683             }
684            
685             for my $extra_point ($element->get_extra_points())
686             {
687             if(exists $extra_point ->{COLOR})
688             {
689             $gc->set_foreground($self->get_color($extra_point ->{COLOR}));
690             }
691             else
692             {
693             $gc->set_foreground($self->get_color('extra_point'));
694             }
695            
696             $self->{PIXMAP}->draw_rectangle
697             (
698             $gc,
699             FALSE,
700             (($extra_point ->{X} + $element->{X}) * $character_width),
701             (($extra_point ->{Y} + $element->{Y}) * $character_height),
702             $character_width, $character_height
703             );
704             }
705             }
706              
707             # draw new connections
708             for my $new_connection (@{$self->{NEW_CONNECTIONS}})
709             {
710             $gc->set_foreground($self->get_color('red'));
711            
712             my $end_connection = $new_connection->{CONNECTED}->get_named_connection($new_connection->{CONNECTOR}{NAME}) ;
713            
714             $self->{PIXMAP}->draw_rectangle
715             (
716             $gc,
717             FALSE,
718             ($end_connection->{X} + $new_connection->{CONNECTED}{X}) * $character_width ,
719             ($end_connection->{Y} + $new_connection->{CONNECTED}{Y}) * $character_height ,
720             $character_width, $character_height
721             );
722             }
723              
724             delete $self->{NEW_CONNECTIONS} ;
725            
726             # draw selection rectangle
727             if(defined $self->{SELECTION_RECTANGLE}{END_X})
728             {
729             my $start_x = $self->{SELECTION_RECTANGLE}{START_X} * $character_width ;
730             my $start_y = $self->{SELECTION_RECTANGLE}{START_Y} * $character_height ;
731             my $width = ($self->{SELECTION_RECTANGLE}{END_X} - $self->{SELECTION_RECTANGLE}{START_X}) * $character_width ;
732             my $height = ($self->{SELECTION_RECTANGLE}{END_Y} - $self->{SELECTION_RECTANGLE}{START_Y}) * $character_height;
733            
734             if($width < 0)
735             {
736             $width *= -1 ;
737             $start_x -= $width ;
738             }
739            
740             if($height < 0)
741             {
742             $height *= -1 ;
743             $start_y -= $height ;
744             }
745            
746             $gc->set_foreground($self->get_color('selection_rectangle')) ;
747             $self->{PIXMAP}->draw_rectangle($gc, FALSE,$start_x, $start_y, $width, $height);
748            
749             delete $self->{SELECTION_RECTANGLE}{END_X} ;
750             }
751              
752             $widget->window->draw_drawable
753             (
754             $widget->style->fg_gc($widget->state),
755             $self->{PIXMAP},
756             $event->area->x, $event->area->y,
757             $event->area->x, $event->area->y,
758             $event->area->width, $event->area->height
759             );
760              
761             return TRUE;
762             }
763              
764             #-----------------------------------------------------------------------------
765              
766             sub button_release_event
767             {
768             my ($widget, $event, $self) = @_ ;
769              
770             my $modifiers = get_key_modifiers($event) ;
771              
772             if($self->exists_action("${modifiers}-button_release"))
773             {
774             $self->run_actions(["${modifiers}-button_release", $event]) ;
775             return TRUE ;
776             }
777              
778             if(defined $self->{MODIFIED_INDEX} && defined $self->{MODIFIED} && $self->{MODIFIED_INDEX} == $self->{MODIFIED})
779             {
780             $self->pop_undo_buffer(1) ; # no changes
781             }
782              
783             $self->update_display();
784             }
785              
786             #-----------------------------------------------------------------------------
787             sub button_press_event
788             {
789             #~ print "button_press_event\n" ;
790             my ($widget, $event, $self) = @_ ;
791              
792             $self->{DRAGGING} = '' ;
793             delete $self->{RESIZE_CONNECTOR_NAME} ;
794              
795             $self->create_undo_snapshot() ;
796             $self->{MODIFIED_INDEX} = $self->{MODIFIED} ;
797              
798             my $modifiers = get_key_modifiers($event) ;
799             my $button = ${event}->button() ;
800              
801             if($self->exists_action("${modifiers}-button_press-$button"))
802             {
803             $self->run_actions(["${modifiers}-button_press-$button", $event]) ;
804             return TRUE ;
805             }
806              
807             if($event->type eq '2button-press')
808             {
809             my($x, $y) = $self->closest_character($event->coords()) ;
810            
811             my @element_over = grep { $self->is_over_element($_, $x, $y) } reverse @{$self->{ELEMENTS}} ;
812            
813             if(@element_over)
814             {
815             my $selected_element = $element_over[0] ;
816             $self->edit_element($selected_element) ;
817             $self->update_display();
818             }
819            
820             return TRUE ;
821             }
822              
823             if($event->button == 1)
824             {
825             my $modifiers = get_key_modifiers($event) ;
826            
827             my ($x, $y) = $self->closest_character($event->coords()) ;
828             my ($first_element) = first_value {$self->is_over_element($_, $x, $y)} reverse @{$self->{ELEMENTS}} ;
829            
830             if ($modifiers eq 'C00')
831             {
832             if(defined $first_element)
833             {
834             $self->run_actions_by_name('Copy to clipboard', ['Insert from clipboard', 0, 0]) ;
835             }
836             }
837             else
838             {
839             if(defined $first_element)
840             {
841             if ($modifiers eq '00S')
842             {
843             $self->select_elements_flip($first_element) ;
844             }
845             else
846             {
847             unless($self->is_element_selected($first_element))
848             {
849             $self->select_elements(0, @{$self->{ELEMENTS}}) ;
850             $self->select_elements(1, $first_element) ;
851             }
852             }
853             }
854             else
855             {
856             $self->select_elements(0, @{$self->{ELEMENTS}}) if ($modifiers eq '000') ;
857             }
858             }
859            
860             $self->{SELECTION_RECTANGLE} = {START_X => $x , START_Y => $y} ;
861            
862             $self->update_display();
863             }
864            
865             if($event->button == 2)
866             {
867             my ($x, $y) = $self->closest_character($event->coords()) ;
868             $self->{SELECTION_RECTANGLE} = {START_X => $x , START_Y => $y} ;
869            
870             $self->update_display();
871             }
872               
873             if($event->button == 3)
874             {
875             $self->display_popup_menu($event) ;
876             }
877               
878             return TRUE;
879             }
880              
881             #-----------------------------------------------------------------------------
882              
883             sub motion_notify_event
884             {
885             my ($widget, $event, $self) = @_ ;
886              
887             my ($x, $y) = $self->closest_character($event->coords()) ;
888             my $modifiers = get_key_modifiers($event) ;
889              
890             if($self->exists_action("${modifiers}motion_notify"))
891             {
892             $self->run_actions(["${modifiers}-motion_notify", $event]) ;
893             return TRUE ;
894             }
895              
896             if($self->{PREVIOUS_X} != $x || $self->{PREVIOUS_Y} != $y)
897             {
898             ($self->{MOUSE_X}, $self->{MOUSE_Y}) = ($x, $y) ;
899             $self->update_display() ;
900             }
901            
902             if ($event->state >= "button1-mask")
903             {
904             if($self->{DRAGGING} ne '')
905             {
906             if      ($self->{DRAGGING} eq 'move') { $self->move_elements_event($x, $y) ; }
907             elsif ($self->{DRAGGING}eq 'resize') { $self->resize_element_event($x, $y) ; }
908             elsif ($self->{DRAGGING}eq 'select') { $self->select_element_event($x, $y) ; }
909             }
910             else
911             {
912             my @selected_elements = $self->get_selected_elements(1) ;
913             my ($first_element) = first_value {$self->is_over_element($_, $x, $y)} reverse @selected_elements ;
914            
915             if(@selected_elements > 1)
916             {
917             if(defined $first_element)
918             {
919             $self->{DRAGGING} = 'move' ;
920             }
921             else
922             {
923             $self->{DRAGGING} = 'select' ;
924             }
925             }
926             else
927             {
928             if(defined $first_element)
929             {
930             $self->{DRAGGING} = $first_element->get_selection_action
931             (
932             $x - $first_element->{X},
933             $y - $first_element->{Y},
934             );
935            
936             $self->{DRAGGING} ='' unless exists $self->{VALID_SELECT_ACTION}{$self->{DRAGGING}} ;
937             }
938             else
939             {
940             $self->{DRAGGING} = 'select' ;
941             }
942             }
943            
944             ($self->{PREVIOUS_X}, $self->{PREVIOUS_Y}) = ($x, $y) ;
945             }
946             }
947              
948             if ($event->state >= "button2-mask")
949             {
950             $self->select_element_event($x, $y, sub{ref $_[0] ne 'App::Asciio::stripes::section_wirl_arrow'}) ;
951             }
952            
953             return TRUE;
954             }
955              
956             #-----------------------------------------------------------------------------
957              
958             sub select_element_event
959             {
960             my ($self, $x, $y, $filter) = @_ ;
961              
962             my ($x_offset, $y_offset) = ($x - $self->{PREVIOUS_X}, $y - $self->{PREVIOUS_Y}) ;
963            
964             if($x_offset != 0 || $y_offset != 0)
965             {
966             $self->{SELECTION_RECTANGLE}{END_X} = $x ;
967             $self->{SELECTION_RECTANGLE}{END_Y} = $y ;
968            
969             $filter = sub {1} unless defined $filter ;
970            
971             $self->select_elements
972             (
973             1,
974             grep
975             { $filter->($_) }
976             grep # elements within selection rectangle
977             {
978             $self->element_completely_within_rectangle
979             (
980             $_,
981             $self->{SELECTION_RECTANGLE},
982             )
983             } @{$self->{ELEMENTS}}
984             )  ;
985            
986             $self->update_display();
987            
988             ($self->{PREVIOUS_X}, $self->{PREVIOUS_Y}) = ($x, $y) ;
989             }
990             }
991              
992             #-----------------------------------------------------------------------------
993              
994             sub move_elements_event
995             {
996             my ($self, $x, $y) = @_;
997              
998             my ($x_offset, $y_offset) = ($x - $self->{PREVIOUS_X}, $y - $self->{PREVIOUS_Y}) ;
999              
1000             if($x_offset != 0 || $y_offset != 0)
1001             {
1002             my @selected_elements = $self->get_selected_elements(1) ;
1003            
1004             $self->move_elements($x_offset, $y_offset, @selected_elements) ;
1005             $self->update_display();
1006            
1007             ($self->{PREVIOUS_X}, $self->{PREVIOUS_Y}) = ($x, $y) ;
1008             }
1009             }
1010              
1011             #-----------------------------------------------------------------------------
1012              
1013             sub resize_element_event
1014             {
1015             my ($self, $x, $y) = @_ ;
1016              
1017             my ($x_offset, $y_offset) = ($x - $self->{PREVIOUS_X}, $y - $self->{PREVIOUS_Y}) ;
1018              
1019             if($x_offset != 0 || $y_offset != 0)
1020             {
1021             my ($selected_element) = $self->get_selected_elements(1) ;
1022            
1023             $self->{RESIZE_CONNECTOR_NAME} =
1024             $self->resize_element
1025             (
1026             $self->{PREVIOUS_X} - $selected_element->{X}, $self->{PREVIOUS_Y} - $selected_element->{Y} ,
1027             $x - $selected_element->{X}, $y - $selected_element->{Y} ,
1028             $selected_element,
1029             $self->{RESIZE_CONNECTOR_NAME},
1030             ) ;
1031            
1032             $self->update_display();
1033              
1034             ($self->{PREVIOUS_X}, $self->{PREVIOUS_Y}) = ($x, $y) ;
1035             }
1036             }
1037            
1038             #-----------------------------------------------------------------------------
1039              
1040             sub key_press_event
1041             {
1042             my ($widget, $event, $self)= @_;
1043              
1044             #~ print DumpTree \@_, '', DISPLAY_PERL_ADDRESS => 1 ;
1045             #~ print "key_press_event: keyval is <" . $event->keyval() . ">\n" ;
1046              
1047             my $key = $C{$event->keyval()} ;
1048             my $modifiers = get_key_modifiers($event) ;
1049              
1050             $self->run_actions("$modifiers-$key") ;
1051              
1052             return FALSE;
1053             }
1054              
1055             =head1 DEPENDENCIES
1056            
1057             gnome libraries, gtk, gtk-perl, perl
1058            
1059             =head1 BUGS AND LIMITATIONS
1060            
1061             Undoubtedly many as I wrote this as a fun little project where I used no design nor 'methodic' whatsoever.
1062            
1063             =head1 AUTHOR
1064            
1065             Khemir Nadim ibn Hamouda
1066             CPAN ID: NKH
1067             mailto:nadim@khemir.net
1068            
1069             =head1 LICENSE AND COPYRIGHT
1070            
1071             This program is free software; you can redistribute
1072             it and/or modify it under the same terms as Perl itself.
1073            
1074             =head1 SUPPORTED OSes
1075            
1076             =head2 Gentoo
1077            
1078             I run gentoo, packages to install gtk-perl exist. Install Ascii with cpan.
1079            
1080             =head2 FreeBSD
1081            
1082             FreeBSD users can now install asciio either by package:
1083            
1084             $ pkg_add -r asciio
1085            
1086             or from source (out of the ports system) by:
1087            
1088             $ cd /usr/ports/graphics/asciio
1089             $ make install clean
1090            
1091             Thanks to Emanuel Haupt.
1092            
1093             =head2 Ubuntu and Debian
1094            
1095             Ports are on the way.
1096            
1097             =head2 Windows
1098            
1099             AsciiO is part of B<camelbox> and can be found here: L<http://code.google.com/p/camelbox/>. Install, run AsciiO from the 'bin' directory.
1100            
1101             .-------------------------------.
1102             / /|
1103             / camelbox for win32 / |
1104             / / |
1105             / / |
1106             .-------------------------------. |
1107             | ______\\_, | |
1108             | (_. _ o_ _/ | |
1109             | '-' \_. / | |
1110             | / / | |
1111             | / / .--. .--. | |
1112             | ( ( / '' \/ '' \ " | |
1113             | \ \_.' \ ) | |
1114             | || _ './ | |
1115             | |\ \ ___.'\ / | |
1116             | '-./ .' \ |/ | |
1117             | \| / )|\ | |
1118             | |/ // \\ | .
1119             | |\ __// \\__ | /
1120             | //\\ /__/ mrf\__| | /
1121             | .--_/ \_--. | /
1122             | /__/ \__\ |/
1123             '-------------------------------'
1124            
1125             B<camelbox> is a great distribution for windows. I hope it will merge with X-berry series of Perl distributions.
1126            
1127             =head1 Mac OsX
1128            
1129             This works too (and I have screenshots to prove it :). I don't own a mac and the mac user hasn't send me how to do it yet.
1130            
1131             =head1 other unices
1132            
1133             YMMV, install gtk-perl and AsciiO from cpan.
1134            
1135             =head1 SEE ALSO
1136            
1137             http://www.jave.de
1138             http://search.cpan.org/~osfameron/Text-JavE-0.0.2/JavE.pm
1139             http://ditaa.sourceforge.net/
1140             http://www.codeproject.com/KB/macros/codeplotter.aspx
1141             http://search.cpan.org/~jpierce/Text-FIGlet-1.06/FIGlet.pm
1142             http://www.fossildraw.com/?gclid=CLanxZXxoJECFRYYEAodnBS8Dg (doesn't always respond)
1143            
1144             http://www.ascii-art.de (used some entries as base for the network stencil)
1145             http://c2.com/cgi/wiki?UmlAsciiArt
1146             http://www.textfiles.com/art/
1147             http://www2.b3ta.com/_bunny/texbunny.gif
1148            
1149            
1150             *\o_ _o/*
1151             / * * \
1152             <\ *\o/* />
1153             )
1154             o/* / > *\o
1155             <\ />
1156             __o */\ /\* o__
1157             * /> <\ *
1158             /\* __o_ _o__ */\
1159             * / * * \ *
1160             <\ />
1161             *\o/*
1162             ejm97 __)__
1163            
1164             =cut
1165              
1166             #------------------------------------------------------------------------------------------------------
1167              
1168             "ASCII world domination!"  ;
1169              
1170