1 #!/usr/bin/perl -w
2 use strict;
3 use IO::Handle;
4 autoflush STDOUT 1;
5 autoflush STDERR 1;
6 use tmstub;
7 use Tk;
8 #use Tk::FontDialog;
9 my $title = 'piduino menu';
10 my $version = "v0.2 2012-07-29";
11
12 my $mw = new MainWindow();
13 # PAL resolution 656x512@16
14 $mw->overrideredirect(1);
15 my ($scr_w, $scr_h) = $mw->maxsize();
16 t "maxsize says: $scr_w x $scr_h";
17 #~ $mw->geometry("656x512+0+0");
18 $mw->geometry("680x540+0+0");
19 #~ $mw->FullScreen;
20 #~ $mw->geometry(($mw->maxsize())[0] .'x'.($mw->maxsize())[1] . "+0+0");
21 my $c = $mw->Canvas(-bg => "yellow", -width => 680, -height => 540)->pack;
22 # in theory we should be able to scroll infinitely but let's stick to something reasonable
23 #$c->configure(-scrollregion => [0,0, 600, 400]);
24 my $font = $mw->fontCreate('menufont', -family => 'Village', -size => 38, -weight=>'bold');
25
26 my $menu_w = 400;
27 my $menu_h = 100;
28
29 # it don't work!
30 #~ invisible_cursor();
31
32 # warp pointer tests...
33 $mw->after(100, sub {warp(20,20)});
34
35 sub warp {
36 my($x, $y) = @_;
37 t "warp pointer to $x $y";
38 $c->focus;
39 $mw->eventGenerate("<Motion>",
40 -when => 'head',
41 -x => $x, -y => $y, -warp => 1
42 );
43 }
44
45 # keybinding tests...
46 $mw->bind('<KeyPress>' => \&print_keysym);
47
48 sub print_keysym {
49 my($widget) = @_;
50 my $e = $widget->XEvent; # get event object
51 my($keysym_text, $keysym_decimal) = ($e->K, $e->N);
52 print "keysym=$keysym_text, numeric=$keysym_decimal\n";
53 }
54
55 # hide cursor
56 sub invisible_cursor {
57 my $bitmapfile = Tk->findINC('trans_cur.xbm');
58 my $maskfile = Tk->findINC('trans_cur.mask');
59 $mw->configure(-cursor => [ '@' . $bitmapfile, $maskfile, 'black', 'white' ] );
60 }
61
62 # handy font chooser
63 #~ $mw->Button(
64 #~ -font => $font,
65 #~ -text => "Font",
66 #~ -command => sub{choose_font()},
67 #~ )->pack();
68
69 # debug grid...
70 $c->createGrid(0, 0, 10, 10);
71 $c->createGrid(0, 0, 50, 50, -lines => 1, -dash => '-.');
72 $c->createGrid(0, 0, 100, 100, -width => 3, -lines => 1);
73
74 # TODO - load settings from file
75 menubox("Music", 0, 0);
76 menubox("Controls", 0, 1);
77 menubox("Vehicle", 0, 2);
78 menubox("System", 0, 3);
79 menubox("Settings", 0, 3);
80 # menubox("More...", 1, 0);
81
82 #~ music selection
83 #~ playlists
84 #~ artists by name
85 #~ albums
86 #~ directories
87
88 #~ controls
89 #~ volume
90 #~ bass
91 #~ treble
92 #~ balance
93 #~ system reboot
94 #~ system shutdown
95 #~ app quit
96 #~ app restart
97
98
99
100 sub menubox {
101 my($t, $mx, $my) = @_;
102 my $x1 = $mx * $menu_w;
103 my $y1 = $my * $menu_h;
104 my $x2 = $x1 + $menu_w;
105 my $y2 = $y1 + $menu_h;
106
107 $c->createRectangle($x1, $y1, $x2, $y2,
108 -fill => "blue",
109 -activefill => "green",
110 -outline => "green",
111 -activeoutline => "orange",
112 );
113 $c->createText($x1 + ($menu_w/2), $y1+ ($menu_h/2),
114 -text => "$t",
115 -font => $font,
116 -fill => "black",
117 );
118 }
119
120
121 =for docs
122
123 options:
124
125 * canvas width and height to cover the whole menu system
126 * sub-menus can't all be visible simultaneously so we'd have to hide them
127 * group items together
128
129 do top level menu first
130
131 menu level zero at 0,0
132 menu level one appears at 1*menu_w, selected item * menu_h
133
134
135
136 =cut
137
138
139
140
141 sub choose_font
142 {
143 # t $mw->GetDescriptiveFontName($font);
144
145 # my $f = $mw->FontDialog->Show(
146 #-initfont => $font,
147 #-nicefont => 1
148 # );
149 # return unless defined $f;
150 # $mw->RefontTree(-font => $f, -canvas => 1);
151 # my $d = $mw->GetDescriptiveFontName($f);
152 # t $d;
153 # $font = $f;
154
155 }
156
157
158 MainLoop();