Browse Subversion Repository
Contents of /branches/4-stable/tests/erase.pl
 Parent Directory
|  Revision Log
Revision 10677 -
( show annotations)
( download)
( as text)
Sat Apr 15 17:36:59 2023 UTC
(11 months, 3 weeks ago)
by zmatsuo
File MIME type: text/x-perl
File size: 2436 byte(s)
文字消去時、マウス選択領域を選択状態で描画(文字色反転表示)するようにした
- マウス選択領域の文字を消去したとき、選択状態を維持したまま描画
- 従来
- マウス選択領域にかかっていても無条件に背景色(背景画像)で描画
- 表示上選択領域がなくなるように見える
- 内部的には選択領域が存在している
- 変更したシーケンス
- EL (カーソル行の文字を消去)
- ECH (カーソル位置から Ps 文字を消す)
- ED 0 (カーソル位置から画面末尾までを消去する)
- ED 1 (画面先頭からカーソル位置までを消去する)
- 文字消去ではなくバッファの内容を描画するようにした(buffer.c)
- 空白(スペース)が書かれているバッファを描画 =消去
- マウス選択領域を考慮して描画される
- 使用しなくなった文字消去(背景描画)専用関数削除(vtdisp.c,h)
- 2cell文字(全角文字)を考慮して消去/描画するようにした
- 消去に関連するエスケープシーケンスをテストする test/erase.pl を追加
- turnk/r10639 と同等
ticket 47524
| 1 |
#!/usr/bin/perl |
| 2 |
|
| 3 |
# 消去系のエスケープシーケンスのテスト |
| 4 |
# テストの動作のポイント |
| 5 |
# - マウスで選択した領域が描画後も残ったままになる |
| 6 |
# - 2cell文字が半分残った状態にならない |
| 7 |
|
| 8 |
use utf8; |
| 9 |
use strict; |
| 10 |
use warnings; |
| 11 |
|
| 12 |
local $| = 1; |
| 13 |
binmode STDOUT, ':encoding(UTF-8)'; |
| 14 |
|
| 15 |
sub Wait() { |
| 16 |
print("[[hit return key]]"); |
| 17 |
my $s = <STDIN>; |
| 18 |
} |
| 19 |
|
| 20 |
sub Fill { |
| 21 |
my $ys = shift; |
| 22 |
my $ye = shift; |
| 23 |
|
| 24 |
#print "\x1b[2J"; |
| 25 |
print "\x1b[1;1H"; |
| 26 |
my $wide_count = 0; |
| 27 |
for (my $y = $ys; $y < $ye; $y++) { |
| 28 |
if (($y % 3) == 0) { |
| 29 |
for (my $x = 0; $x < 80; $x++) { |
| 30 |
printf("%d", $x %10); |
| 31 |
} |
| 32 |
} else { |
| 33 |
my $w = 40 - ($wide_count % 2); |
| 34 |
printf("-") if $w != 40; |
| 35 |
for (my $x = 0; $x < $w; $x++) { |
| 36 |
printf("%s", substr("□■", ($x) % 2, 1)); |
| 37 |
} |
| 38 |
printf("-") if $w != 40; |
| 39 |
$wide_count++; |
| 40 |
} |
| 41 |
} |
| 42 |
print "\x1b[10;1H"; |
| 43 |
} |
| 44 |
|
| 45 |
sub EL { |
| 46 |
my $ps = shift; |
| 47 |
Fill(0, 10); |
| 48 |
print "\x1b[1;40H\x1b[${ps}K"; |
| 49 |
print "\x1b[2;40H\x1b[${ps}K"; |
| 50 |
print "\x1b[3;40H\x1b[${ps}K"; |
| 51 |
print "\x1b[4;39H ^cursor pos "; |
| 52 |
print "\n"; |
| 53 |
Wait(); |
| 54 |
} |
| 55 |
|
| 56 |
sub ECH { |
| 57 |
Fill(0, 10); |
| 58 |
print "\x1b[1;40H\x1b[10X"; |
| 59 |
print "\x1b[2;40H\x1b[10X"; |
| 60 |
print "\x1b[3;40H\x1b[10X"; |
| 61 |
print "\x1b[4;40H\x1b[9X"; |
| 62 |
print "\x1b[5;40H\x1b[9X"; |
| 63 |
print "\x1b[6;40H\x1b[9X"; |
| 64 |
print "\x1b[7;39H ^cursor pos "; |
| 65 |
print "\n"; |
| 66 |
Wait(); |
| 67 |
} |
| 68 |
|
| 69 |
sub ED { |
| 70 |
my $ps = shift; |
| 71 |
for (my $y = 7; $y < 14; $y++) { |
| 72 |
Fill(0, 20); |
| 73 |
print "\x1b[1;1H\n"; |
| 74 |
print "\x1b[${y};40H\x1b[${ps}J"; |
| 75 |
print "\x1b[1;1H\n"; |
| 76 |
Wait(); |
| 77 |
} |
| 78 |
} |
| 79 |
|
| 80 |
my $arg = (@ARGV != 0) ? $ARGV[0] : ""; |
| 81 |
|
| 82 |
print "\x1b[0m"; |
| 83 |
print "ERASE test\n"; |
| 84 |
|
| 85 |
FINISH: |
| 86 |
|
| 87 |
for(;;) |
| 88 |
{ |
| 89 |
my $s; |
| 90 |
if (length($arg) != 0) { |
| 91 |
print "> $arg\n"; |
| 92 |
$s = $arg; |
| 93 |
$arg = ""; |
| 94 |
} else { |
| 95 |
print <<EOF; |
| 96 |
1 EL 0 |
| 97 |
2 EL 1 |
| 98 |
3 EL 2 |
| 99 |
4 ECH |
| 100 |
5 ED 0 |
| 101 |
6 ED 1 |
| 102 |
q quit |
| 103 |
EOF |
| 104 |
print "> "; |
| 105 |
$s = <STDIN>; |
| 106 |
} |
| 107 |
$s =~ s/[\n\r]//g; |
| 108 |
|
| 109 |
for(;;) { |
| 110 |
if (length($s) == 0) { |
| 111 |
last; |
| 112 |
#next FINISH; |
| 113 |
} |
| 114 |
my $c = substr($s, 0, 1); |
| 115 |
$s = substr($s, 1); |
| 116 |
|
| 117 |
if ($c eq 'q') { |
| 118 |
last FINISH; |
| 119 |
} elsif ($c eq '1') { |
| 120 |
EL(0); |
| 121 |
} elsif ($c eq '2') { |
| 122 |
EL(1); |
| 123 |
} elsif ($c eq '3') { |
| 124 |
EL(2); |
| 125 |
} elsif ($c eq '4') { |
| 126 |
ECH(2); |
| 127 |
} elsif ($c eq '5') { |
| 128 |
ED(0); |
| 129 |
} elsif ($c eq '6') { |
| 130 |
ED(1); |
| 131 |
} else { |
| 132 |
print "'$c' ?\n" |
| 133 |
} |
| 134 |
} |
| 135 |
} |
| 136 |
print "\x1b[2J"; |
| 137 |
print "\x1b[1;1H"; |
| 138 |
print "\x1b[0m"; |
| 139 |
print "finish\n"; |
| 
Tera Term
Parent Directory
Revision Log