ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-IRC3/samples/jsonclient
Revision: 1.1
Committed: Wed Dec 6 13:12:11 2006 UTC (19 years, 10 months ago) by elmex
Branch: MAIN
Log Message:
added the json irc sample application

File Contents

# User Rev Content
1 elmex 1.1 #!/usr/bin/perl
2     use strict;
3     use Curses;
4     use Term::ReadKey;
5     use JSONConnection;
6     #use Net::IRC3::Client::Connection;
7    
8     our $HEIGHT;
9     our $WIDTH;
10    
11     our $MAINWIN;
12     our $winbuffer = [];
13     our $stdiowatcher;
14     our $inputbuffer;
15     our $js;
16    
17     our $window_resize = 0;
18     $SIG{WINCH} = sub {
19     my ($wc, $hc, $wpx, $hpx) = GetTerminalSize ();
20     unshift @$winbuffer, "SIZE: $wc $hc $wpx $hpx";
21     resizeterm ($hc, $wc);
22     $MAINWIN->resize ($hc, $wc);
23     $MAINWIN->erase;
24     refresh ();
25     };
26    
27     sub color2attr {
28     my $c = $_[0];
29     my $attr;
30     if ($c <= 63) {
31     $attr = COLOR_PAIR($c);
32     } elsif ($c <= 127) {
33     $c -= 64;
34     $attr = COLOR_PAIR($c) | A_BOLD;
35     } elsif ($c <= 191) {
36     $c -= 128;
37     $attr = COLOR_PAIR($c) | A_UNDERLINE;
38     } else {
39     $c -= 192;
40     $attr = COLOR_PAIR($c) | A_UNDERLINE | A_BOLD;
41     }
42     $attr
43     }
44    
45     sub refresh {
46     my ($onlyinput) = @_;
47    
48     unless ($onlyinput) {
49     $MAINWIN->erase;
50     my (@outbuf) = @$winbuffer;
51     my $line = $LINES - 2;
52     while ($line >= 0) {
53     my $lx = shift @outbuf;
54    
55     if ((ref $lx) eq "ARRAY") {
56     my @lcont = @$lx;
57     my $li = 0;
58     while (@lcont) {
59     my ($color, $str) = (shift @lcont, shift @lcont);
60     my $sl = (length $str) > $COLS ? $COLS : length $str;
61     $MAINWIN->attron (color2attr($color));
62     $MAINWIN->addnstr ($line, $li, (substr $str, 0, $sl), $sl);
63     $li += $sl;
64     $MAINWIN->attroff (color2attr($color));
65     }
66     } else {
67     my $sl = length $lx > $COLS ? $COLS : length $lx;
68     $MAINWIN->addnstr ($line, 0, (substr $lx, 0, $sl), $sl);
69     }
70     $line--;
71     }
72     }
73     $MAINWIN->move ($LINES - 1, 0);
74     $MAINWIN->clrtoeol ();
75     $MAINWIN->addstr ($LINES - 1, 0, $inputbuffer);
76     $MAINWIN->move ($LINES - 1, 0);
77     $MAINWIN->refresh;
78     }
79    
80     sub printline {
81     unshift @$winbuffer, $_[0];
82     refresh ();
83     }
84    
85     sub handle_input {
86     my $c = $MAINWIN->getch;
87     if ($c == KEY_BACKSPACE) {
88     substr $inputbuffer, -1, 1, '';
89     } elsif ($c eq "\n") {
90     $js->send_data ({type => 'public', con => "localhost:6667", channel => '#blob', message => $inputbuffer });
91     $inputbuffer = "";
92     } else {
93     if ($c & 0xFF) {
94     printline ("SPECIAL[$c]");
95     } else {
96     $inputbuffer .= $c;
97     }
98     }
99     refresh ();
100     }
101    
102     sub init_curses {
103     my $win = $MAINWIN = Curses->new;
104     cbreak;
105     noecho;
106     clear;
107     $win->keypad (1);
108     if (has_colors ()) {
109     start_color ();
110     use_default_colors ();
111     my $colors = "";
112     my (@ansi_tab) = qw/0 4 2 6 1 5 3 7/;
113     for (my $i = 1; $i < $COLOR_PAIRS; $i++) {
114     # $colors .= "$i=". ($ansi_tab[$i & 7]).":".($ansi_tab[$i >> 3])."|";
115     init_pair ($i, $ansi_tab[$i & 7], $i <= 7 ? -1 : $ansi_tab[$i >> 3]);
116     }
117     # init_color (63, 0, 0);
118     # init_pair (63, 0, -1);
119     printline ("COLOR S $COLOR_PAIRS $colors");
120     }
121     $win->attron (A_NORMAL);
122    
123     # $stdscr->getmaxyx ($HEIGHT, $WIDTH);
124     # my ($y, $x);
125     # $win->getmaxyx ($y, $x);
126     # $win->clear;
127     # $win->move (0, 0);
128     # $win->clrtobot;
129     # $win->refresh;
130     # printline ("SIZE[$HEIGHT $WIDTH | $y $x]");
131    
132     $stdiowatcher = AnyEvent->io (fh => \*STDIN, poll => "r", cb => sub {
133     handle_input;
134     });
135     }
136    
137     my $c = AnyEvent->condvar;
138     my $d = 0;
139     my $wt;
140     sub timer {
141     $wt = AnyEvent->timer (after => 3, cb => sub {
142     printline ("TEST $d"); $d++;
143     timer ();
144     });
145     }
146    
147     timer ();
148    
149     $js =
150     JSONClientConnection->new (packet_cb => sub {
151     my ($js, $data) = @_;
152     require JSON::Syck;
153     printline (JSON::Syck::Dump ($data));
154     });
155    
156     $js->connect (localhost => 1236);
157    
158     init_curses ();
159     printline ("TEST!!!");
160    
161     {
162     my $l;
163     for (my $i = 0; $i <= 256; $i++) {
164     push @$l, $i, (sprintf "[%3d]", $i);
165     if (($i + 1) % 8 == 0) {
166     printline ($l);
167     $l = [];
168     }
169     }
170     printline ($l);
171     }
172     printline ("TESTE!!!");
173    
174     $c->wait;
175    
176     endwin;