git @ Cat's Eye Technologies noit-o-mnain-worb / 85a26d4
Import of worb 1.1 revision 2011.1031 (Console::Virtual inclusion.) Cat's Eye Technologies 10 years ago
21 changed file(s) with 1396 addition(s) and 4 deletion(s). Raw diff Collapse all Expand all
99 CDIR=bin/tc/catseye/worb
1010 CLASSES=$(CDIR)/WorbState.class
1111
12 YOOBDIR?=../../../lab/yoob
12 YOOBDIR?=../yoob
1313 CLASSPATH?=bin$(PATHSEP)$(YOOBDIR)/bin
1414
1515 all: $(CLASSES)
00 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
1 <!-- encoding: UTF-8 -->
12 <html xmlns="http://www.w3.org/1999/xhtml" lang="en">
23 <head>
34 <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
89 font-weight: bold;
910 }
1011 </style>
12 <!-- begin html doc dynamic markup -->
13 <script type="text/javascript" src="/contrib/jquery-1.6.4.min.js"></script>
14 <script type="text/javascript" src="/scripts/documentation.js"></script>
15 <!-- end html doc dynamic markup -->
1116 </head>
1217 <body>
1318 <h1>noit o' mnain worb</h1>
1419
1520 <p>Language version 1.1. Distribution version 2010.0721.<br/>
16 Copyright &copy;2000-2010, Cat's Eye Technologies. All rights reserved.</p>
21 Copyright ©2000-2010, Cat's Eye Technologies. All rights reserved.</p>
1722
1823 <h2>What is <span class="language">noit o' mnain worb</span>?</h2>
1924
0 # ANSI16.pm - 16-colour-ANSI colour abstraction
1
2 # Copyright (c)2000-2007, Chris Pressey, Cat's Eye Technologies.
3 # All rights reserved.
4 #
5 # Redistribution and use in source and binary forms, with or without
6 # modification, are permitted provided that the following conditions
7 # are met:
8 #
9 # 1. Redistributions of source code must retain the above copyright
10 # notices, this list of conditions and the following disclaimer.
11 # 2. Redistributions in binary form must reproduce the above copyright
12 # notices, this list of conditions, and the following disclaimer in
13 # the documentation and/or other materials provided with the
14 # distribution.
15 # 3. Neither the names of the copyright holders nor the names of their
16 # contributors may be used to endorse or promote products derived
17 # from this software without specific prior written permission.
18 #
19 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
20 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
21 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
22 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
23 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
24 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
25 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
26 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
28 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
29 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
30 # POSSIBILITY OF SUCH DAMAGE.
31
32 %::colormap =
33 (
34 'black' => 0,
35 'red' => 1,
36 'green' => 2,
37 'brown' => 3,
38 'blue' => 4,
39 'purple' => 5,
40 'aqua' => 6,
41 'grey' => 7,
42 'pink' => 1,
43 'lime' => 2,
44 'yellow' => 3,
45 'sky' => 4,
46 'magenta' => 5,
47 'cyan' => 6,
48 'white' => 7,
49 );
50
51 %::intensitymap =
52 (
53 'black' => 0,
54 'red' => 0,
55 'blue' => 0,
56 'purple' => 0,
57 'green' => 0,
58 'brown' => 0,
59 'aqua' => 0,
60 'grey' => 0,
61 'pink' => 1,
62 'sky' => 1,
63 'magenta' => 1,
64 'lime' => 1,
65 'yellow' => 1,
66 'cyan' => 1,
67 'white' => 1,
68 );
69
70 sub color
71 {
72 my $fg = shift;
73 my $bg = shift;
74 die "Bad color" if not exists $::colormap{$fg} or not exists $::colormap{$bg};
75 print "\e[$::intensitymap{$fg};3$::colormap{$fg};4$::colormap{$bg}m";
76 }
77
78 1;
0 # Curses.pm - color abstraction for Curses
1
2 # Copyright (c)2000-2007, Chris Pressey, Cat's Eye Technologies.
3 # All rights reserved.
4 #
5 # Redistribution and use in source and binary forms, with or without
6 # modification, are permitted provided that the following conditions
7 # are met:
8 #
9 # 1. Redistributions of source code must retain the above copyright
10 # notices, this list of conditions and the following disclaimer.
11 # 2. Redistributions in binary form must reproduce the above copyright
12 # notices, this list of conditions, and the following disclaimer in
13 # the documentation and/or other materials provided with the
14 # distribution.
15 # 3. Neither the names of the copyright holders nor the names of their
16 # contributors may be used to endorse or promote products derived
17 # from this software without specific prior written permission.
18 #
19 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
20 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
21 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
22 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
23 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
24 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
25 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
26 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
28 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
29 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
30 # POSSIBILITY OF SUCH DAMAGE.
31
32 use Curses;
33
34 %::colormap =
35 (
36 'black' => 1,
37 'red' => 2,
38 'blue' => 3,
39 'purple' => 4,
40 'green' => 5,
41 'brown' => 6,
42 'aqua' => 7,
43 'grey' => 0,
44 'pink' => 18,
45 'sky' => 19,
46 'magenta' => 20,
47 'lime' => 21,
48 'yellow' => 22,
49 'cyan' => 23,
50 'white' => 24,
51 );
52
53 init_pair(1, COLOR_BLACK, COLOR_WHITE);
54 init_pair(2, COLOR_RED, COLOR_BLACK);
55 init_pair(3, COLOR_BLUE, COLOR_BLACK);
56 init_pair(4, COLOR_MAGENTA, COLOR_BLACK);
57 init_pair(5, COLOR_GREEN, COLOR_BLACK);
58 init_pair(6, COLOR_YELLOW, COLOR_BLACK);
59 init_pair(7, COLOR_CYAN, COLOR_BLACK);
60 init_pair(8, COLOR_WHITE, COLOR_BLACK);
61
62 $::old_color = 'grey';
63
64 sub color
65 {
66 my $fg = shift;
67 my $bg = shift;
68 attroff(A_BOLD) if $::colormap{$::old_color} > 10;
69 attroff(COLOR_PAIR($::colormap{$::old_color} % 16));
70 attron(A_BOLD) if $::colormap{$fg} > 10;
71 attron(COLOR_PAIR($::colormap{$fg} % 16));
72 $::old_color = $fg;
73 }
74
75 1;
0 # Mono.pm - monochrome (w/intensity bit) display abstraction
1
2 # Copyright (c)2000-2007, Chris Pressey, Cat's Eye Technologies.
3 # All rights reserved.
4 #
5 # Redistribution and use in source and binary forms, with or without
6 # modification, are permitted provided that the following conditions
7 # are met:
8 #
9 # 1. Redistributions of source code must retain the above copyright
10 # notices, this list of conditions and the following disclaimer.
11 # 2. Redistributions in binary form must reproduce the above copyright
12 # notices, this list of conditions, and the following disclaimer in
13 # the documentation and/or other materials provided with the
14 # distribution.
15 # 3. Neither the names of the copyright holders nor the names of their
16 # contributors may be used to endorse or promote products derived
17 # from this software without specific prior written permission.
18 #
19 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
20 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
21 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
22 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
23 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
24 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
25 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
26 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
28 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
29 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
30 # POSSIBILITY OF SUCH DAMAGE.
31
32 %::colormap =
33 (
34 'black' => 0,
35 'red' => 1,
36 'blue' => 1,
37 'purple' => 1,
38 'green' => 1,
39 'brown' => 1,
40 'aqua' => 1,
41 'grey' => 1,
42 'pink' => 2,
43 'sky' => 2,
44 'magenta' => 2,
45 'lime' => 2,
46 'yellow' => 2,
47 'cyan' => 2,
48 'white' => 2,
49 );
50
51 sub color
52 {
53 my $fg = shift;
54 my $bg = shift;
55 if ($::colormap{$bg} > 0)
56 {
57 ::inverse;
58 } elsif ($::colormap{$fg} > 1)
59 {
60 ::bold;
61 } else
62 {
63 ::normal;
64 }
65 }
66
67 1;
0 # Win32.pm - 16-colour Windows 32-bit Console colour abstraction
1
2 # Copyright (c)2000-2007, Chris Pressey, Cat's Eye Technologies.
3 # All rights reserved.
4 #
5 # Redistribution and use in source and binary forms, with or without
6 # modification, are permitted provided that the following conditions
7 # are met:
8 #
9 # 1. Redistributions of source code must retain the above copyright
10 # notices, this list of conditions and the following disclaimer.
11 # 2. Redistributions in binary form must reproduce the above copyright
12 # notices, this list of conditions, and the following disclaimer in
13 # the documentation and/or other materials provided with the
14 # distribution.
15 # 3. Neither the names of the copyright holders nor the names of their
16 # contributors may be used to endorse or promote products derived
17 # from this software without specific prior written permission.
18 #
19 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
20 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
21 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
22 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
23 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
24 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
25 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
26 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
28 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
29 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
30 # POSSIBILITY OF SUCH DAMAGE.
31
32 use Win32::Console;
33
34 %::bgcolormap =
35 (
36 'black' => $BG_BLACK,
37 'red' => $BG_RED,
38 'blue' => $BG_BLUE,
39 'purple' => $BG_MAGENTA,
40 'green' => $BG_GREEN,
41 'brown' => $BG_BROWN,
42 'aqua' => $BG_CYAN,
43 'grey' => $BG_GRAY,
44 'pink' => $BG_LIGHTRED,
45 'sky' => $BG_LIGHTBLUE,
46 'magenta' => $BG_LIGHTMAGENTA,
47 'lime' => $BG_LIGHTGREEN,
48 'yellow' => $BG_YELLOW,
49 'cyan' => $BG_LIGHTCYAN,
50 'white' => $BG_WHITE,
51 );
52
53 %::fgcolormap =
54 (
55 'black' => $FG_BLACK,
56 'red' => $FG_RED,
57 'blue' => $FG_BLUE,
58 'purple' => $FG_MAGENTA,
59 'green' => $FG_GREEN,
60 'brown' => $FG_BROWN,
61 'aqua' => $FG_CYAN,
62 'grey' => $FG_GRAY,
63 'pink' => $FG_LIGHTRED,
64 'sky' => $FG_LIGHTBLUE,
65 'magenta' => $FG_LIGHTMAGENTA,
66 'lime' => $FG_LIGHTGREEN,
67 'yellow' => $FG_YELLOW,
68 'cyan' => $FG_LIGHTCYAN,
69 'white' => $FG_WHITE,
70 );
71
72 sub color
73 {
74 my $fg = shift;
75 my $bg = shift;
76 die "Bad color $fg" if not exists $::fgcolormap{$fg};
77 die "Bad color $bg" if not exists $::bgcolormap{$bg};
78 $::STDOUT->Attr($::fgcolormap{$fg} | $::bgcolormap{$bg});
79 }
80
81 1;
0 # Console::Display::ANSI.pm - ANSI terminal display layer
1 # v2007.1122 Chris Pressey, Cat's Eye Technologies
2
3 # Copyright (c)2001-2007, Chris Pressey, Cat's Eye Technologies.
4 # All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 #
10 # 1. Redistributions of source code must retain the above copyright
11 # notices, this list of conditions and the following disclaimer.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 # notices, this list of conditions, and the following disclaimer in
14 # the documentation and/or other materials provided with the
15 # distribution.
16 # 3. Neither the names of the copyright holders nor the names of their
17 # contributors may be used to endorse or promote products derived
18 # from this software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
22 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 # POSSIBILITY OF SUCH DAMAGE.
32
33 # Superceded by _Console::Display::Tput, but included for
34 # backwards compatibility. Implements a subset of ANSI/vt100.
35
36 ### SUBS ###
37
38 sub display { my ($m) = join('',@_);
39 $m =~ s/\n/\r\cJ/g;
40 print $m; }
41 sub clrscr { print "\e[2J\e[1;1H"; }
42 sub clreol { print "\e[K"; }
43 sub gotoxy { my ($x, $y) = @_; print "\e[${y};${x}H"; }
44 sub bold { print "\e[1m"; }
45 sub inverse { print "\e[0;7m"; }
46 sub normal { print "\e[0m"; }
47 sub update_display { }
48
49 1;
50
51 ### END of ANSI.pm ###
0 # Console::Display::Curses.pm - display layer for Curses
1 # v2007.1122 Chris Pressey, Cat's Eye Technologies
2
3 # Copyright (c)2001-2007, Chris Pressey, Cat's Eye Technologies.
4 # All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 #
10 # 1. Redistributions of source code must retain the above copyright
11 # notices, this list of conditions and the following disclaimer.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 # notices, this list of conditions, and the following disclaimer in
14 # the documentation and/or other materials provided with the
15 # distribution.
16 # 3. Neither the names of the copyright holders nor the names of their
17 # contributors may be used to endorse or promote products derived
18 # from this software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
22 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 # POSSIBILITY OF SUCH DAMAGE.
32
33 use Curses;
34
35 ### SUBS ###
36
37 $curses_x = 1;
38 $curses_y = 1;
39
40 sub display { my ($m) = join('',@_);
41 addstr($curses_y-1, $curses_x-1, $m);
42 $curses_x += length($m); }
43 sub clrscr { $curses_x = 1; $curses_y = 1; move(0, 0); clear; refresh; }
44 sub clreol { move($curses_y-1, $curses_x-1); clrtoeol; }
45 sub gotoxy { ($curses_x, $curses_y) = @_; }
46 sub bold { attrset(A_BOLD); }
47 sub inverse { attrset(A_REVERSE); }
48 sub normal { attrset(A_NORMAL); }
49 sub update_display { move($curses_y-1,$curses_x-1); refresh; }
50
51 1;
52
53 ### END of Curses.pm ###
0 # Console::Display::Screen.pm - Term::Screen under Console::Virtual
1 # v2007.1122 Chris Pressey, Cat's Eye Technologies
2
3 # Copyright (c)2001-2007, Chris Pressey, Cat's Eye Technologies.
4 # All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 #
10 # 1. Redistributions of source code must retain the above copyright
11 # notices, this list of conditions and the following disclaimer.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 # notices, this list of conditions, and the following disclaimer in
14 # the documentation and/or other materials provided with the
15 # distribution.
16 # 3. Neither the names of the copyright holders nor the names of their
17 # contributors may be used to endorse or promote products derived
18 # from this software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
22 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 # POSSIBILITY OF SUCH DAMAGE.
32
33 ### SUBS ###
34
35 sub display { $screen->puts(join('', @_)); }
36 sub clrscr { $screen->clrscr(); }
37 sub clreol { $screen->clreol(); }
38 sub gotoxy { my ($x, $y) = @_; $screen->at($x, $y); }
39 sub bold { $screen->bold(); }
40 sub inverse { $screen->reverse(); }
41 sub normal { $screen->normal(); }
42 sub update_display { }
43
44 1;
45
46 ### END of Screen.pm ###
0 # Console::Display::Teletype.pm - emulate screen under true teletype
1 # v2007.1122 Chris Pressey, Cat's Eye Technologies
2
3 # Copyright (c)2001-2007, Chris Pressey, Cat's Eye Technologies.
4 # All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 #
10 # 1. Redistributions of source code must retain the above copyright
11 # notices, this list of conditions and the following disclaimer.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 # notices, this list of conditions, and the following disclaimer in
14 # the documentation and/or other materials provided with the
15 # distribution.
16 # 3. Neither the names of the copyright holders nor the names of their
17 # contributors may be used to endorse or promote products derived
18 # from this software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
22 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 # POSSIBILITY OF SUCH DAMAGE.
32
33 $buffer = [];
34 $cursor_x = 1;
35 $cursor_y = 1;
36
37 ### SUBS ###
38
39 sub display
40 {
41 my ($m) = join('',@_);
42 my $i = 0;
43 for($i=0;$i<$cursor_x-1;$i++)
44 {
45 $buffer->[$cursor_y-1][$i] = ' ' if
46 not defined $buffer->[$cursor_y-1][$i];
47 }
48 for($i=0;$i<length($m);$i++)
49 {
50 $buffer->[$cursor_y-1][$cursor_x-1+$i] = substr($m, $i, 1);
51 }
52 $cursor_x += length($m);
53 }
54 sub clrscr
55 {
56 my $i = 0;
57 for($i=0;$i<25;$i++) { $buffer->[$i] = [ ' ' ]; }
58 $cursor_x = 1;
59 $cursor_y = 1;
60 }
61 sub clreol
62 {
63 while($buffer->[$cursor_y-1][$cursor_x])
64 {
65 pop @{$buffer->[$cursor_y]};
66 }
67 }
68 sub gotoxy { ($cursor_x, $cursor_y) = @_; }
69 sub bold { }
70 sub inverse { }
71 sub normal { }
72 sub update_display
73 {
74 my $i; my $j;
75 print chr(12);
76 for($i = 0; $i < 25 and defined $buffer->[$i]; $i++)
77 {
78 for($j = 0; $j < 80 and defined $buffer->[$i][$j]; $j++)
79 {
80 print $buffer->[$i][$j];
81 }
82 print "\n";
83 }
84 }
85
86 1;
87
88 ### END of Teletype.pm ###
0 # Console::Display:Tput.pm - display layer for cached 'tput'
1 # v2007.1122 Chris Pressey, Cat's Eye Technologies
2
3 # Copyright (c)2001-2007, Chris Pressey, Cat's Eye Technologies.
4 # All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 #
10 # 1. Redistributions of source code must retain the above copyright
11 # notices, this list of conditions and the following disclaimer.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 # notices, this list of conditions, and the following disclaimer in
14 # the documentation and/or other materials provided with the
15 # distribution.
16 # 3. Neither the names of the copyright holders nor the names of their
17 # contributors may be used to endorse or promote products derived
18 # from this software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
22 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 # POSSIBILITY OF SUCH DAMAGE.
32
33 BEGIN
34 {
35 $clrscr = `tput cl`;
36 $clreol = `tput ce`;
37 $gotoxy = [];
38 $bold = `tput md`;
39 $inverse = `tput so`;
40 $normal = `tput me se`;
41 }
42
43 ### SUBS ###
44
45 sub display { my ($m) = join('',@_); print $m; }
46 sub clrscr { print $clrscr; }
47 sub clreol { print $clreol; }
48 sub gotoxy { my ($x, $y) = @_;
49 $gotoxy->[$x][$y] = `tput cm $x $y`
50 if not defined $gotoxy->[$x][$y];
51 print $gotoxy->[$x][$y];
52 }
53 sub bold { print $bold; }
54 sub inverse { print $inverse; }
55 sub normal { print $normal; }
56 sub update_display { }
57
58 1;
59
60 ### END of Tput.pm ###
0 # Console::Display::Win32.pm - layer for Win32 Console
1 # v2007.1122 Chris Pressey, Cat's Eye Technologies
2
3 # Copyright (c)2001-2007, Chris Pressey, Cat's Eye Technologies.
4 # All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 #
10 # 1. Redistributions of source code must retain the above copyright
11 # notices, this list of conditions and the following disclaimer.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 # notices, this list of conditions, and the following disclaimer in
14 # the documentation and/or other materials provided with the
15 # distribution.
16 # 3. Neither the names of the copyright holders nor the names of their
17 # contributors may be used to endorse or promote products derived
18 # from this software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
22 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 # POSSIBILITY OF SUCH DAMAGE.
32
33 BEGIN
34 {
35 use Win32::Console;
36 if (defined $setup{screen_height} or defined $setup{screen_width})
37 {
38 $STDOUT->Size($setup{screen_width}, $setup{screen_height});
39 }
40 }
41
42 ### SUBS ###
43
44 sub display { $STDOUT->Write(join('',@_)); }
45 sub clrscr { $STDOUT->Cls; }
46 sub clreol { my ($x, $y) = $STDOUT->Cursor;
47 my ($sx, $sy) = $STDOUT->Info;
48 $STDOUT->FillAttr($::FG_GRAY | $::BG_BLACK, $sx-$x, $x, $y);
49 $STDOUT->FillChar(" ", $sx-$x, $x, $y); }
50 sub gotoxy { my ($x, $y) = @_; $STDOUT->Cursor($x-1,$y-1); }
51 sub bold { $STDOUT->Attr($::FG_WHITE | $::BG_BLACK); }
52 sub inverse { $STDOUT->Attr($::FG_BLACK | $::BG_GRAY); }
53 sub normal { $STDOUT->Attr($::FG_GRAY | $::BG_BLACK); }
54 sub update_display { } # $STDOUT->Cursor(-1, -1, -1, 1); }
55
56 1;
57
58 ### END of Win32.pm ###
0 # Console::Input::Curses.pm - raw input layer for Curses
1 # v2007.1122 Chris Pressey, Cat's Eye Technologies
2
3 # Copyright (c)2001-2007, Chris Pressey, Cat's Eye Technologies.
4 # All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 #
10 # 1. Redistributions of source code must retain the above copyright
11 # notices, this list of conditions and the following disclaimer.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 # notices, this list of conditions, and the following disclaimer in
14 # the documentation and/or other materials provided with the
15 # distribution.
16 # 3. Neither the names of the copyright holders nor the names of their
17 # contributors may be used to endorse or promote products derived
18 # from this software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
22 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 # POSSIBILITY OF SUCH DAMAGE.
32
33 BEGIN
34 {
35 use Curses;
36
37 initscr;
38 if (has_colors)
39 {
40 start_color;
41 }
42 nonl;
43 intrflush(0);
44 keypad(1);
45 nodelay(1);
46 refresh;
47
48 cbreak; # optimistic
49 noecho; # optimistic
50 }
51
52 sub getkey
53 {
54 my $key = '';
55 refresh;
56 # cbreak; # pessimistic
57 # noecho; # pessimistic
58 sysread(STDIN, $key, 1);
59 # nocbreak; # pessimistic
60 # echo; # pessimistic
61 return $key;
62 }
63
64 END
65 {
66 nocbreak; # optimistic
67 echo; # optimistic
68 endwin;
69 }
70
71 1;
72
73 ### END of Curses.pm ###
0 # Console::Input::POSIX.pm - raw input layer for POSIX
1 # v2007.1122 Chris Pressey, Cat's Eye Technologies
2
3 # Copyright (c)2001-2007, Chris Pressey, Cat's Eye Technologies.
4 # All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 #
10 # 1. Redistributions of source code must retain the above copyright
11 # notices, this list of conditions and the following disclaimer.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 # notices, this list of conditions, and the following disclaimer in
14 # the documentation and/or other materials provided with the
15 # distribution.
16 # 3. Neither the names of the copyright holders nor the names of their
17 # contributors may be used to endorse or promote products derived
18 # from this software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
22 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 # POSSIBILITY OF SUCH DAMAGE.
32
33 # Snarfed rather shamelessly from the Perl FAQ on the subject:
34
35 BEGIN
36 {
37 use POSIX qw(:termios_h);
38
39 $fd_stdin = fileno(STDIN);
40
41 $term = POSIX::Termios->new();
42 $term->getattr($fd_stdin);
43 $oterm = $term->getlflag();
44
45 $echo = ECHO | ECHOK | ICANON;
46 $noecho = $oterm & ~$echo;
47
48 sub cbreak
49 {
50 $term->setlflag($noecho);
51 $term->setcc(VTIME, 1);
52 $term->setattr($fd_stdin, TCSANOW);
53 }
54
55 cbreak; # optimistic
56 }
57
58 sub cooked
59 {
60 $term->setlflag($oterm);
61 $term->setcc(VTIME, 0);
62 $term->setattr($fd_stdin, TCSANOW);
63 }
64
65 sub getkey
66 {
67 my $key = '';
68 # cbreak(); # pessimistic
69 sysread(STDIN, $key, 1);
70 # cooked(); # pessimistic
71 return $key;
72 }
73
74 END
75 {
76 cooked(); # optimistic
77 }
78
79 1;
80
81 ### END of POSIX.pm ###
0 # Console::Input::Screen.pm - raw input using Term::Screen
1 # v2007.1122 Chris Pressey, Cat's Eye Technologies
2
3 # Copyright (c)2001-2007, Chris Pressey, Cat's Eye Technologies.
4 # All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 #
10 # 1. Redistributions of source code must retain the above copyright
11 # notices, this list of conditions and the following disclaimer.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 # notices, this list of conditions, and the following disclaimer in
14 # the documentation and/or other materials provided with the
15 # distribution.
16 # 3. Neither the names of the copyright holders nor the names of their
17 # contributors may be used to endorse or promote products derived
18 # from this software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
22 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 # POSSIBILITY OF SUCH DAMAGE.
32
33 BEGIN
34 {
35 require Term::Screen;
36 $screen = Term::Screen->new();
37 }
38
39 sub getkey { $screen->getch(); }
40
41 1;
42
43 ### END of Screen.pm ###
0 # Console::Input::Teletype.pm - emulate screen on true teletype
1 # v2007.1122 Chris Pressey, Cat's Eye Technologies
2
3 # Copyright (c)2001-2007, Chris Pressey, Cat's Eye Technologies.
4 # All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 #
10 # 1. Redistributions of source code must retain the above copyright
11 # notices, this list of conditions and the following disclaimer.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 # notices, this list of conditions, and the following disclaimer in
14 # the documentation and/or other materials provided with the
15 # distribution.
16 # 3. Neither the names of the copyright holders nor the names of their
17 # contributors may be used to endorse or promote products derived
18 # from this software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
22 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 # POSSIBILITY OF SUCH DAMAGE.
32
33 # This is, of course, not really raw input. Using this,
34 # you'll have to manually press Return or Enter after each
35 # character is pressed.
36
37 sub getkey
38 {
39 my $key = '';
40 update_display();
41 sysread(STDIN, $key, 1);
42 return $key;
43 }
44
45 1;
46
47 ### END of Teletype.pm ###
0 # Console::Input::Win32.pm - input layer for Windows 95/98/NT console
1 # v2007.1122 Chris Pressey, Cat's Eye Technologies
2
3 # Copyright (c)2001-2007, Chris Pressey, Cat's Eye Technologies.
4 # All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 #
10 # 1. Redistributions of source code must retain the above copyright
11 # notices, this list of conditions and the following disclaimer.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 # notices, this list of conditions, and the following disclaimer in
14 # the documentation and/or other materials provided with the
15 # distribution.
16 # 3. Neither the names of the copyright holders nor the names of their
17 # contributors may be used to endorse or promote products derived
18 # from this software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
22 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 # POSSIBILITY OF SUCH DAMAGE.
32
33 BEGIN
34 {
35 use Win32::Console;
36
37 $STDOUT = new Win32::Console(STD_OUTPUT_HANDLE);
38 $STDERR = new Win32::Console(STD_ERROR_HANDLE);
39 $STDIN = new Win32::Console(STD_INPUT_HANDLE);
40 }
41
42 sub getkey
43 {
44 my $key = '';
45 my @event = ();
46 $STDOUT->Cursor(-1, -1, -1, 1);
47 for(;;)
48 {
49 @event = $STDIN->Input();
50 if ($event[0] == 1 and $event[1] and $event[5] != 0)
51 {
52 $key = chr($event[5]);
53 last;
54 }
55 }
56 $STDOUT->Cursor(-1, -1, -1, 0);
57 return $key;
58 }
59
60 END
61 {
62 $STDOUT->Cursor(-1, -1, -1, 1);
63 }
64
65 1;
66
67 ### END of Win32.pm ###
0 # Console::Virtual.pm - unbuffered-input/addressed-display layer
1 # v2007.1122 Chris Pressey, Cat's Eye Technologies
2
3 # Copyright (c)2003-2007, Chris Pressey, Cat's Eye Technologies.
4 # All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 #
10 # 1. Redistributions of source code must retain the above copyright
11 # notices, this list of conditions and the following disclaimer.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 # notices, this list of conditions, and the following disclaimer in
14 # the documentation and/or other materials provided with the
15 # distribution.
16 # 3. Neither the names of the copyright holders nor the names of their
17 # contributors may be used to endorse or promote products derived
18 # from this software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
22 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 # POSSIBILITY OF SUCH DAMAGE.
32
33 package Console::Virtual;
34 BEGIN
35 {
36 use 5;
37 use strict qw(subs);
38 use Exporter;
39 $VERSION = 2007.1122;
40 @ISA = qw(Exporter);
41 @EXPORT_OK = qw(&display &clrscr &clreol &gotoxy
42 &bold &inverse &normal
43 &update_display &getkey &color);
44 }
45
46 %setup = ();
47
48 BEGIN
49 {
50 my $c;
51 my $fc = 0; # found Curses.pm?
52 my $fs = 0; # found Term::Screen?
53 my $fp = 0; # found POSIX.pm?
54 my $ft = 0; # found $TERM and /etc/termcap?
55 foreach $c (@INC)
56 {
57 $fc = 1 if -r "$c/Curses.pm";
58 $fs = 1 if -r "$c/Term/Screen.pm";
59 $fp = 1 if -r "$c/POSIX.pm";
60 }
61 $ft = $ENV{TERM} && -r "/etc/termcap";
62 $| = 1;
63
64 # Determine raw input module to use.
65 # This can be pre-set by the calling code
66 # by modifying %Console::Virtual::setup.
67
68 if (defined $setup{input})
69 {
70 require "Console/Input/$setup{input}.pm";
71 }
72 elsif ($fc)
73 {
74 require Console::Input::Curses;
75 $setup{input} = 'Curses';
76 }
77 elsif ($^O eq 'MSWin32')
78 {
79 require Console::Input::Win32;
80 $setup{input} = 'Win32';
81 }
82 elsif ($fs)
83 {
84 require Console::Input::Screen;
85 $setup{input} = 'Screen';
86 }
87 elsif ($fp)
88 {
89 require Console::Input::POSIX;
90 $setup{input} = 'POSIX';
91 } else
92 {
93 warn "Warning! Raw input probably not available on this '$^O' system.\n";
94 require Console::Input::Teletype;
95 $setup{input} = 'Teletype';
96 }
97
98 # Determine screen-addressed output method to use.
99 # This can be pre-set by the calling code
100 # by modifying %Console::Virtual::setup.
101
102 if (defined $setup{display})
103 {
104 require "Console/Display/$setup{display}.pm";
105 }
106 elsif ($fc)
107 {
108 require Console::Display::Curses;
109 $setup{display} = 'Curses';
110 }
111 elsif ($^O eq 'MSWin32')
112 {
113 require Console::Display::Win32;
114 $setup{display} = 'Win32';
115 }
116 elsif ($fs)
117 {
118 require Console::Display::Screen;
119 $setup{display} = 'Screen';
120 }
121 elsif ($ft)
122 {
123 require Console::Display::Tput;
124 $setup{display} = 'Tput';
125 } else
126 {
127 warn "Addressable screen must be emulated on this '$^O' system";
128 require Console::Display::Teletype;
129 $setup{display} = 'Teletype';
130 }
131
132 # 2001.01.27 CAP
133 # Determine color module to use.
134 # This can be pre-set by the calling code
135 # by modifying %Console::Virtual::setup.
136
137 if (defined $setup{color})
138 {
139 require "Console/Color/$setup{color}.pm";
140 }
141 elsif ($fc)
142 {
143 require Console::Color::Curses;
144 $setup{color} = 'Curses';
145 }
146 elsif ($^O eq 'MSWin32')
147 {
148 require Console::Color::Win32;
149 $setup{color} = 'Win32';
150 }
151 elsif ($fs)
152 {
153 # require Console::Color::Screen; # TODO! needs to be written
154 require Console::Color::ANSI16; # not a very general solution
155 $setup{color} = 'ANSI16';
156 }
157 else
158 {
159 require Console::Color::Mono;
160 $setup{color} = 'Mono';
161 }
162 }
163
164 1;
165
166 ### END of Virtual.pm ###
0 Console::Virtual
1 ----------------
2
3 v2007.1122 Chris Pressey, Cat's Eye Technologies.
4 (c)2003-2007 Cat's Eye Technologies. All rights reserved.
5 (BSD-style license. See file Console/Virtual.pm for full license info.)
6
7 What is Console::Virtual?
8 -------------------------
9
10 Console::Virtual is a lightweight, abstract, function-based (as opposed to
11 object-oriented) Perl interface for accessing unbuffered keyboard input
12 and an addressable screen display. Together, these facilities are thought
13 of as a 'virtual console,' regardless of what underlying technologies
14 implement it.
15
16 Console::Virtual is intended to be only a simple redirection layer that
17 insulates the programmer from whatever screen-oriented mechanisms are
18 actually installed at the site. My experience has been that Curses is often
19 not installed, or installed incorrectly. It can be impractical to install,
20 for any number of reasons. While Term::Cap and Term::Screen are part of the
21 Perl 5.8.8 core libraries, they too on occasion are not installed correctly.
22 Further, they are insufficiently abstract, assuming that the user interacts
23 with what is essentially a terminal. Not all systems look at the world this
24 way -- Windows machines being an obvious example.
25
26 Because I was writing a console-based application which was to be highly
27 portable, I needed a layer which would automatically decide which unbuffered-
28 input and screen-addressing methods were appropriate for the site, and
29 provide a small, simple, abstract, portable interface to delegate to those
30 methods.
31
32 Synopsis
33 --------
34
35 To use Console::Virtual, you will either have to install it somewhere in
36 Perl's include path (you can do this by copying the Console directory and
37 all of its contents to e.g. /usr/local/lib/perl5/site_perl/5.005), or
38 alternately, give Perl a new include path which contains the Console
39 directory. As usual, there is more than one way to do this: you can
40 pass the -I flag to the perl executable, or you can add a line like
41 BEGIN { push @INC, $dir } to your script. If you want to just keep the
42 Console directory in the same directory as your script, you can add
43 BEGIN { use File::Basename; push @INC, dirname($0) } instead.
44
45 Then you can insert the following into your Perl script to use it:
46
47 use Console::Virtual 2007.1122
48 qw(getkey display gotoxy clrscr clreol
49 normal inverse bold color update_display);
50
51 Console::Virtual first tries to use Curses, if it's installed. If not, and
52 it detects that it's running on a Win32 system, it tries to use
53 Win32::Console. If not, it tries using Term::Screen if that's installed.
54 If not, it then checks to see if POSIX is available, that TERM is set in the
55 environment, and that /etc/termcap exists; if so, it uses POSIX raw input
56 and it shells the external command `tput`, buffering the result, for output.
57
58 Failing all of that, if Console::Virtual can't find anything that suits your
59 platform, it will produce a warning, carry on regardless, and assume that it
60 is running on a teletype. It will emulate an addressible screen on the
61 standard output stream the best way it knows how: the entire screen will be
62 re-printed whenever an update is requested. Also, the user will have to
63 tolerate line-buffered input, where a carriage return must be issued before
64 keystrokes will be responded to. If this saddens you, be thankful that
65 teletypes are rare these days. (There are some of us who are frankly more
66 saddened *by* the fact that teletypes are rare these days.)
67
68 A specific input or display methodology can be specified by setting
69 values in the %Console::Virtual::setup hash before using Console::Virtual.
70 You probably shouldn't do this if you want to retain portability; the intent
71 of it is to allow the end user to tailor their local copy of a script,
72 forcing it to pick some specific implementation, presumably in preference to
73 some other which would normally be preferred, but is (for whatever reason)
74 not desired. Note that when doing this, you can mix different regimens
75 for input, display, and color; however, unless you know what you're doing,
76 you probably shouldn't, as you're likely to get really weird results.
77 See the code for more details.
78
79 Any functions that you don't need to access can be left out of the qw()
80 list. In fact, the entire list can be omitted, in which case none of these
81 names will be imported into your namespace. In that case, you'll have to
82 fully qualify them (like Console::Virtual::gotoxy()) to use them.
83
84 Input Functions:
85
86 getkey() wait for keystroke; don't wait for ENTER or echo
87
88 Output Functions:
89
90 clrscr() clear the screen
91 clreol() clear to end of line
92 display(@list) display all strings in @list at screen cursor
93 gotoxy($x,$y) move the cursor to the 1-based (x,y) coordinate
94 bold() set display style to bold
95 inverse() set display style to inverted
96 normal() set display style back to normal
97 update_display() explicitly refresh the screen (Curses & Teletype need this)
98 color($f,$b) sets the colors of text about to be displayed
99
100 Acceptable arguments for $f and $b in color() are 'black', 'red', 'blue',
101 'purple', 'green', 'brown', 'aqua', 'grey', 'pink', 'sky' (blue), 'magenta',
102 'lime' (green), 'yellow', 'cyan', and 'white'. Of course, not all terminals
103 can display this many colors (or any color at all,) in which case color will
104 be crudely approximated.
105
106 Since the library is intended to be simple and abstract, that's all there is;
107 nothing fancy enough to be severely broken, no capability predicates to check,
108 no overkill object-oriented interface to follow.
109
110 Differences with Term::Screen
111 -----------------------------
112
113 Console::Virtual is designed to be a (portable) abstraction layer, whereas
114 Term::Screen is not. There are several 'holes' in the interfaces provided
115 by Term::Screen; that is, actions which are not prohibited as they probably
116 ought to be. In fact, last I checked, they are encouraged.
117
118 These actions are prohibited in Console::Virtual. Specifically, you should
119 not simply use 'print' to place text on the display device; you must instead
120 use display(). If you do not do this, the output of your program will look
121 funny (to say the least) when the end user is using Curses, or a teletype,
122 or some future output technology that Console::Virtual one day delegates to.
123 By the same token, you must occasionally use update_display() for the
124 benefit of Curses and other output regimens which require explicit refresh.
125 Calling update_display() must be done when the cursor is to be seen, by
126 the user, to move. It is also a good idea to do it in anticipation of a
127 long upcoming delay in the program (e.g. intense computation.)
128
129 History
130 -------
131
132 v2001.0123: Renamed this module to _Console::Virtual.
133 v2001.0124: fixed some namespace issues w.r.t. Win32.
134 v2001.0127: added Color subfunctionality.
135 v2003.0325: fixed up test.pl and readme.txt (no changes to code)
136 v2007.1122: renamed to Console::Virtual, prettied readme.txt.
137 Also updated language in BSD license (no "REGENTS".)
138
139 More Information
140 ----------------
141
142 The latest version of Console::Virtual can be found at:
143
144 http://catseye.webhop.net/projects/cons_virt/
145
146 Chris Pressey
147 November 22, 2007
148 Chicago, Illinois, USA
0 #!/usr/bin/perl -w
1 # test.pl - test program for Console::Virtual
2 # v2007.1122 Chris Pressey, Cat's Eye Technologies
3
4 # Copyright (c)2000-2007, Chris Pressey, Cat's Eye Technologies.
5 # All rights reserved.
6 #
7 # Redistribution and use in source and binary forms, with or without
8 # modification, are permitted provided that the following conditions
9 # are met:
10 #
11 # 1. Redistributions of source code must retain the above copyright
12 # notices, this list of conditions and the following disclaimer.
13 # 2. Redistributions in binary form must reproduce the above copyright
14 # notices, this list of conditions, and the following disclaimer in
15 # the documentation and/or other materials provided with the
16 # distribution.
17 # 3. Neither the names of the copyright holders nor the names of their
18 # contributors may be used to endorse or promote products derived
19 # from this software without specific prior written permission.
20 #
21 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
23 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25 # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32 # POSSIBILITY OF SUCH DAMAGE.
33
34 # This line allows us to have the Console directory in the same
35 # directory as the test script.
36
37 BEGIN { use File::Basename; push @INC, dirname($0); }
38
39 # uncomment any of these lines to test with other setups
40 # BEGIN { $Console::Virtual::setup{input} = 'Screen'; $Console::Virtual::setup{display} = 'Screen'; }
41 # BEGIN { $Console::Virtual::setup{input} = 'POSIX'; $Console::Virtual::setup{display} = 'Tput'; }
42 # BEGIN { $Console::Virtual::setup{input} = 'Teletype'; $Console::Virtual::setup{display} = 'Teletype'; }
43
44 use Console::Virtual 2001.0127 qw(getkey display gotoxy clrscr clreol
45 normal inverse bold update_display);
46
47 clrscr;
48 gotoxy(10,20);
49 display("Hello, world!");
50
51 gotoxy(20,10);
52 inverse();
53 display("Outta sight!");
54 normal();
55
56 # In this example, Console::Virtual's functions have been imported into
57 # package main.
58 # Because of this, code which relied on the old package 'vC' still works.
59
60 ::gotoxy(1,1);
61 ::bold();
62 ::display("Rock on!");
63 ::normal();
64
65 # So does explicitly referencing the 'Console::Virtual' package.
66 # In fact, if you leave out the qw() list on 'use Console::Virtual',
67 # you'll have to do it this way.
68
69 Console::Virtual::gotoxy(3,3);
70 Console::Virtual::update_display();
71
72 # getkey should automatically invoke update_display when appropriate.
73
74 display("Press a key: ");
75 $foo = getkey();
76 clrscr();
77 display("You pressed ", $foo, "!");
78 update_display;
79
80 ### END of test.pl ###
81
4848
4949 use strict qw(vars refs subs);
5050
51 # This allows us to keep Console::Virtual in same directory as script
52 BEGIN { use File::Basename; push @INC, dirname($0); }
51 # This allows us to keep Console::Virtual in a subrepo located in
52 # the lib dir of this project
53 BEGIN
54 {
55 use File::Spec::Functions;
56 use File::Basename;
57 push @INC, catdir(dirname($0), '..', 'lib', 'console-virtual');
58 }
5359
5460 # Uncomment these lines to use specific display/input/color drivers.
5561 # BEGIN { $Console::Virtual::setup{display} = 'ANSI'; }