perlfaq8.html

来自「perl教程」· HTML 代码 · 共 800 行 · 第 1/5 页

<pre>
    <span class="keyword">use</span> <span class="variable">Term::ANSIColor</span> <span class="string">qw(:constants)</span><span class="operator">;</span>
    <span class="keyword">print</span> <span class="variable">RED</span><span class="operator">,</span> <span class="string">"Stop!\n"</span><span class="operator">,</span> <span class="variable">RESET</span><span class="operator">;</span>
    <span class="keyword">print</span> <span class="variable">GREEN</span><span class="operator">,</span> <span class="string">"Go!\n"</span><span class="operator">,</span> <span class="variable">RESET</span><span class="operator">;</span>
</pre>
<p>
</p>
<h2><a name="how_do_i_read_just_one_key_without_waiting_for_a_return_key">How do I read just one key without waiting for a return key?</a></h2>
<p>Controlling input buffering is a remarkably system-dependent matter.
On many systems, you can just use the <strong>stty</strong> command as shown in
<a href="../../lib/Pod/perlfunc.html#getc">getc in the perlfunc manpage</a>, but as you see, that's already getting you into
portability snags.</p>
<pre>
    <span class="keyword">open</span><span class="operator">(</span><span class="variable">TTY</span><span class="operator">,</span> <span class="string">"+&lt;/dev/tty"</span><span class="operator">)</span> <span class="keyword">or</span> <span class="keyword">die</span> <span class="string">"no tty: $!"</span><span class="operator">;</span>
    <span class="keyword">system</span> <span class="string">"stty  cbreak &lt;/dev/tty &gt;/dev/tty 2&gt;&amp;1"</span><span class="operator">;</span>
    <span class="variable">$key</span> <span class="operator">=</span> <span class="keyword">getc</span><span class="operator">(</span><span class="variable">TTY</span><span class="operator">);</span>           <span class="comment"># perhaps this works</span>
    <span class="comment"># OR ELSE</span>
    <span class="keyword">sysread</span><span class="operator">(</span><span class="variable">TTY</span><span class="operator">,</span> <span class="variable">$key</span><span class="operator">,</span> <span class="number">1</span><span class="operator">);</span>      <span class="comment"># probably this does</span>
    <span class="keyword">system</span> <span class="string">"stty -cbreak &lt;/dev/tty &gt;/dev/tty 2&gt;&amp;1"</span><span class="operator">;</span>
</pre>
<p>The Term::ReadKey module from CPAN offers an easy-to-use interface that
should be more efficient than shelling out to <strong>stty</strong> for each key.
It even includes limited support for Windows.</p>
<pre>
    <span class="keyword">use</span> <span class="variable">Term::ReadKey</span><span class="operator">;</span>
    <span class="variable">ReadMode</span><span class="operator">(</span><span class="string">'cbreak'</span><span class="operator">);</span>
    <span class="variable">$key</span> <span class="operator">=</span> <span class="variable">ReadKey</span><span class="operator">(</span><span class="number">0</span><span class="operator">);</span>
    <span class="variable">ReadMode</span><span class="operator">(</span><span class="string">'normal'</span><span class="operator">);</span>
</pre>
<p>However, using the code requires that you have a working C compiler
and can use it to build and install a CPAN module.  Here's a solution
using the standard POSIX module, which is already on your systems
(assuming your system supports POSIX).</p>
<pre>
    <span class="keyword">use</span> <span class="variable">HotKey</span><span class="operator">;</span>
    <span class="variable">$key</span> <span class="operator">=</span> <span class="variable">readkey</span><span class="operator">();</span>
</pre>
<p>And here's the HotKey module, which hides the somewhat mystifying calls
to manipulate the POSIX termios structures.</p>
<pre>
    <span class="comment"># HotKey.pm</span>
    <span class="keyword">package</span> <span class="variable">HotKey</span><span class="operator">;</span>
</pre>
<pre>
    <span class="variable">@ISA</span> <span class="operator">=</span> <span class="string">qw(Exporter)</span><span class="operator">;</span>
    <span class="variable">@EXPORT</span> <span class="operator">=</span> <span class="string">qw(cbreak cooked readkey)</span><span class="operator">;</span>
</pre>
<pre>
    <span class="keyword">use</span> <span class="variable">strict</span><span class="operator">;</span>
    <span class="keyword">use</span> <span class="variable">POSIX</span> <span class="string">qw(:termios_h)</span><span class="operator">;</span>
    <span class="keyword">my</span> <span class="operator">(</span><span class="variable">$term</span><span class="operator">,</span> <span class="variable">$oterm</span><span class="operator">,</span> <span class="variable">$echo</span><span class="operator">,</span> <span class="variable">$noecho</span><span class="operator">,</span> <span class="variable">$fd_stdin</span><span class="operator">);</span>
</pre>
<pre>
    <span class="variable">$fd_stdin</span> <span class="operator">=</span> <span class="keyword">fileno</span><span class="operator">(</span><span class="variable">STDIN</span><span class="operator">);</span>
    <span class="variable">$term</span>     <span class="operator">=</span> <span class="variable">POSIX::Termios</span><span class="operator">-&gt;</span><span class="variable">new</span><span class="operator">();</span>
    <span class="variable">$term</span><span class="operator">-&gt;</span><span class="variable">getattr</span><span class="operator">(</span><span class="variable">$fd_stdin</span><span class="operator">);</span>
    <span class="variable">$oterm</span>     <span class="operator">=</span> <span class="variable">$term</span><span class="operator">-&gt;</span><span class="variable">getlflag</span><span class="operator">();</span>
</pre>
<pre>
    <span class="variable">$echo</span>     <span class="operator">=</span> <span class="variable">ECHO</span> <span class="operator">|</span> <span class="variable">ECHOK</span> <span class="operator">|</span> <span class="variable">ICANON</span><span class="operator">;</span>
    <span class="variable">$noecho</span>   <span class="operator">=</span> <span class="variable">$oterm</span> <span class="operator">&amp;</span> <span class="operator">~</span><span class="variable">$echo</span><span class="operator">;</span>
</pre>
<pre>
    <span class="keyword">sub</span><span class="variable"> cbreak </span><span class="operator">{</span>
        <span class="variable">$term</span><span class="operator">-&gt;</span><span class="variable">setlflag</span><span class="operator">(</span><span class="variable">$noecho</span><span class="operator">);</span>  <span class="comment"># ok, so i don't want echo either</span>
        <span class="variable">$term</span><span class="operator">-&gt;</span><span class="variable">setcc</span><span class="operator">(</span><span class="variable">VTIME</span><span class="operator">,</span> <span class="number">1</span><span class="operator">);</span>
        <span class="variable">$term</span><span class="operator">-&gt;</span><span class="variable">setattr</span><span class="operator">(</span><span class="variable">$fd_stdin</span><span class="operator">,</span> <span class="variable">TCSANOW</span><span class="operator">);</span>
    <span class="operator">}</span>
</pre>
<pre>
    <span class="keyword">sub</span><span class="variable"> cooked </span><span class="operator">{</span>
        <span class="variable">$term</span><span class="operator">-&gt;</span><span class="variable">setlflag</span><span class="operator">(</span><span class="variable">$oterm</span><span class="operator">);</span>
        <span class="variable">$term</span><span class="operator">-&gt;</span><span class="variable">setcc</span><span class="operator">(</span><span class="variable">VTIME</span><span class="operator">,</span> <span class="number">0</span><span class="operator">);</span>
        <span class="variable">$term</span><span class="operator">-&gt;</span><span class="variable">setattr</span><span class="operator">(</span><span class="variable">$fd_stdin</span><span class="operator">,</span> <span class="variable">TCSANOW</span><span class="operator">);</span>
    <span class="operator">}</span>
</pre>
<pre>
    <span class="keyword">sub</span><span class="variable"> readkey </span><span class="operator">{</span>
        <span class="keyword">my</span> <span class="variable">$key</span> <span class="operator">=</span> <span class="string">''</span><span class="operator">;</span>
        <span class="variable">cbreak</span><span class="operator">();</span>
        <span class="keyword">sysread</span><span class="operator">(</span><span class="variable">STDIN</span><span class="operator">,</span> <span class="variable">$key</span><span class="operator">,</span> <span class="number">1</span><span class="operator">);</span>
        <span class="variable">cooked</span><span class="operator">();</span>
        <span class="keyword">return</span> <span class="variable">$key</span><span class="operator">;</span>
    <span class="operator">}</span>
</pre>
<pre>
    <span class="keyword">END</span> <span class="operator">{</span> <span class="variable">cooked</span><span class="operator">()</span> <span class="operator">}</span>
</pre>
<pre>
    <span class="number">1</span><span class="operator">;</span>
</pre>
<p>
</p>
<h2><a name="how_do_i_check_whether_input_is_ready_on_the_keyboard">How do I check whether input is ready on the keyboard?</a></h2>
<p>The easiest way to do this is to read a key in nonblocking mode with the
Term::ReadKey module from CPAN, passing it an argument of -1 to indicate
not to block:</p>
<pre>
    <span class="keyword">use</span> <span class="variable">Term::ReadKey</span><span class="operator">;</span>
</pre>
<pre>
    <span class="variable">ReadMode</span><span class="operator">(</span><span class="string">'cbreak'</span><span class="operator">);</span>
</pre>
<pre>
    <span class="keyword">if</span> <span class="operator">(</span><span class="keyword">defined</span> <span class="operator">(</span><span class="variable">$char</span> <span class="operator">=</span> <span class="variable">ReadKey</span><span class="operator">(-</span><span class="number">1</span><span class="operator">))</span> <span class="operator">)</span> <span class="operator">{</span>
        <span class="comment"># input was waiting and it was $char</span>
    <span class="operator">}</span> <span class="keyword">else</span> <span class="operator">{</span>
        <span class="comment"># no input was waiting</span>
    <span class="operator">}</span>
</pre>
<pre>
    <span class="variable">ReadMode</span><span class="operator">(</span><span class="string">'normal'</span><span class="operator">);</span>                  <span class="comment"># restore normal tty settings</span>
</pre>
<p>
</p>
<h2><a name="how_do_i_clear_the_screen">How do I clear the screen?</a></h2>
<p>If you only have do so infrequently, use <a href="../../lib/Pod/perlfunc.html#item_system"><code>system</code></a>:</p>
<pre>
    <span class="keyword">system</span><span class="operator">(</span><span class="string">"clear"</span><span class="operator">);</span>
</pre>
<p>If you have to do this a lot, save the clear string
so you can print it 100 times without calling a program
100 times:</p>
<pre>
    <span class="variable">$clear_string</span> <span class="operator">=</span> <span class="string">`clear`</span><span class="operator">;</span>
    <span class="keyword">print</span> <span class="variable">$clear_string</span><span class="operator">;</span>
</pre>
<p>If you're planning on doing other screen manipulations, like cursor
positions, etc, you might wish to use Term::Cap module:</p>
<pre>
    <span class="keyword">use</span> <span class="variable">Term::Cap</span><span class="operator">;</span>
    <span class="variable">$terminal</span> <span class="operator">=</span> <span class="variable">Term::Cap</span><span class="operator">-&gt;</span><span class="variable">Tgetent</span><span class="operator">(</span> <span class="operator">{</span><span class="string">OSPEED</span> <span class="operator">=&gt;</span> <span class="number">9600</span><span class="operator">}</span> <span class="operator">);</span>
    <span class="variable">$clear_string</span> <span class="operator">=</span> <span class="variable">$terminal</span><span class="operator">-&gt;</span><span class="variable">Tputs</span><span class="operator">(</span><span class="string">'cl'</span><span class="operator">);</span>
</pre>
<p>
</p>
<h2><a name="how_do_i_get_the_screen_size">How do I get the screen size?</a></h2>
<p>If you have Term::ReadKey module installed from CPAN,
you can use it to fetch the width and height in characters
and in pixels:</p>
<pre>
    <span class="keyword">use</span> <span class="variable">Term::ReadKey</span><span class="operator">;</span>
    <span class="operator">(</span><span class="variable">$wchar</span><span class="operator">,</span> <span class="variable">$hchar</span><span class="operator">,</span> <span class="variable">$wpixels</span><span class="operator">,</span> <span class="variable">$hpixels</span><span class="operator">)</span> <span class="operator">=</span> <span class="variable">GetTerminalSize</span><span class="operator">();</span>
</pre>
<p>This is more portable than the raw <a href="../../lib/Pod/perlfunc.html#item_ioctl"><code>ioctl</code></a>, but not as
illustrative:</p>
<pre>
    <span class="keyword">require</span> <span class="string">'sys/ioctl.ph'</span><span class="operator">;</span>
    <span class="keyword">die</span> <span class="string">"no TIOCGWINSZ "</span> <span class="keyword">unless</span> <span class="keyword">defined</span> <span class="operator">&amp;</span><span class="variable">TIOCGWINSZ</span><span class="operator">;</span>
    <span class="keyword">open</span><span class="operator">(</span><span class="variable">TTY</span><span class="operator">,</span> <span class="string">"+&lt;/dev/tty"</span><span class="operator">)</span>                     <span class="keyword">or</span> <span class="keyword">die</span> <span class="string">"No tty: $!"</span><span class="operator">;</span>
    <span class="keyword">unless</span> <span class="operator">(</span><span class="keyword">ioctl</span><span class="operator">(</span><span class="variable">TTY</span><span class="operator">,</span> <span class="operator">&amp;</span><span class="variable">TIOCGWINSZ</span><span class="operator">,</span> <span class="variable">$winsize</span><span class="operator">=</span><span class="string">''</span><span class="operator">))</span> <span class="operator">{</span>
        <span class="keyword">die</span> <span class="keyword">sprintf</span> <span class="string">"$0: ioctl TIOCGWINSZ (%08x: $!)\n"</span><span class="operator">,</span> <span class="operator">&amp;</span><span class="variable">TIOCGWINSZ</span><span class="operator">;</span>
    <span class="operator">}</span>
    <span class="operator">(</span><span class="variable">$row</span><span class="operator">,</span> <span class="variable">$col</span><span class="operator">,</span> <span class="variable">$xpixel</span><span class="operator">,</span> <span class="variable">$ypixel</span><span class="operator">)</span> <span class="operator">=</span> <span class="keyword">unpack</span><span class="operator">(</span><span class="string">'S4'</span><span class="operator">,</span> <span class="variable">$winsize</span><span class="operator">);</span>
    <span class="keyword">print</span> <span class="string">"(row,col) = ($row,$col)"</span><span class="operator">;</span>
    <span class="keyword">print</span> <span class="string">"  (xpixel,ypixel) = ($xpixel,$ypixel)"</span> <span class="keyword">if</span> <span class="variable">$xpixel</span> <span class="operator">||</span> <span class="variable">$ypixel</span><span class="operator">;</span>
    <span class="keyword">print</span> <span class="string">"\n"</span><span class="operator">;</span>
</pre>
<p>
</p>