Псевдографика. Рисование линий, рамок и таблиц в текстовой моде Опции

[Lapp]

Псевдографика - это рисование линий (только горизонтальных и вертикальных) в текстовой моде посредством специальных символов. Во времена DOS эта возможность выглядела крайне привлекательно. Символы псевдографики размещаются во второй половине кодов ASCII, причем в в некоторых национальных кодировках они конфликтуют с буквами национального алфавита, что нехорошо. В кодировке 866 (которая в основном и использовалась в DOS) с этим все в порядке, и есть возможность и рисовать рамочки и таблицы, и писать по-русски.

Основная особенность, которая делает всю эту кухню сложной для "ручного" применения - это сопряжение линий на поворотах и пересечениях (что делается подставлением на пересечение специального символа). Линии бывают одинарные и двойные - это добваляет шарму, но немало усложняет ситуацию. Код, в котором вручную набраны рамки (скажем, на титульном листе) выглядит крайне громоздко и непритязательно. А слегка подправить текст в рамке - занятие не для слабонервных.. )) В предствленном модуле эта задача решена - линии сопрягаются между собой автоматически.

Символы псевдографики в кодировке 866 простираются от 176 до 222 номера:

       0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16

 176:  ░  ▒  ▓  │  ┤  ╡  ╢  ╖  ╕  ╣  ║  ╗  ╝  ╜  ╛  ┐  └  

 192:  └  ┴  ┬  ├  ─  ┼  ╞  ╟  ╚  ╔  ╩  ╦  ╠  ═  ╬  ╧  ╨  

 208:  ╨  ╤  ╥  ╙  ╘  ╒  ╓  ╫  ╪  ┘  ┌  █  ▄  ▌  ▐  ▀  р  

Такую табличку вы всегда можете вывести простеньким двойным циклом, вроде такого:

var
  i,j: integer;

begin    
  Write('     ');
  for i:=0 to 16 do Write(i:3);
  WriteLn;
  WriteLn;
  for i:=11 to 13 do begin
    Write(i*16:4,':  ');
    for j:=0 to 16 do Write(Chr(i*16+j),'  ');
    WriteLn;
    WriteLn
  end
end.

При внимательном взгляде на этот набор символов вы обнаружите, что он обладает как некоторой полнотой, так и ограничениями. Например, во всей полноте представлены символы перехода с одинарной на двойную линию при поворотах. Но при этом совершенно отсутствуют переходы на прямых участках (даже на пересечениях - и это совершенно оправдано, если вникнуть.

Короче говоря, возможность рисовать талицы/рамочки в тексте была и есть, но если раньше она была весьма и весьма востребована (скажем, все менюшки в тексте делались с ее помощью), то сейчас про нее мало кто и помнит. Но время от времени все же всплывает.. Например, недавно проскочила тема про судоку, в которой автор пытался рисовать доску именно псевдографикой. Она и побудила меня полезть в архивы и вытащить на свет мой юнит аж 1993 г (!!)).. Его, конечно, пришлось несколько переделать (в оригинале использовался прямой доступ к видеопамяти) и урезать (многое было нужно только для меню), но основная функциональность сохранена.

Этот модуль использует CRT, и это его основной минус. CRT не предоставляет функциональности чтения видеопамяти, и приходится заводить промежуточный массив. Размер этого массива задан константами и может быть изменен при компиляции (у меня он задан с приличным запасом).

В модуле только четыре процедуры:
- рисование горизонтальной линии;
- рисование вертикальной линии;
- рисование прямоугольника;
- очистка промежуточного массива.

Пояснения.. При пересечении или касании, а также близком расположении линии взаимодействуют между собой. Нужно хорошо понимать, как именно это происходит, чтобы добиться нужного результата. Нарисованная линия остается в промежуточном массиве до тех пор, пока он не будет очищен. Все линии, проведенные после нее (но до очистки буфера) и пересекающие или касающиеся ее будут по возможности сопряжены с ней. Простой пример показывает, что я имею в виду:

           ╔═════════════════════════════════════════════════════════╕
           ║                                                         │
           ║              ╔═══════════════╦════════╤════════╗        │
           ║              ║               ║        │        ║        │
           ║              ║               ║        │        ║        │
           ║              ║               ║        │        ║        │
           ║              ║               ║        │        ║        │
    ╒══════╬═══════════╗  ║               ║        │        ║        │
    │      ║           ║  ║               ║        │        ║        │
    │      ║           ║  ║               ║        │        ║        │
    │      ║  ┌────────╫──*┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬╫┬┬┬┬┬┬┬┬┼──────┬─╫───┐  ══╡
    │      ║  │        ║  ╙───────────┼┴┴┴╫┴┴┴┴┴┴┴┴┘      │ ║   │    │
    │      ║  │        ║              │   ║               │ ║   │    │
    │      ║  │        ║              │   ║               │ ║   │    │
    │      ║  │        ║              │   ║               │ ║   │    │
    │      ║  │        ║              │   ║               │ ║   │    │
    │      ║  └────────╫──────────────┼──╥╫───────────┬───┘ ║   │    │
    │      ║           ║              │  ║╣           │     ║   │    │
    │      *╤╤╤╤╤╤╤╤╤╤╤*══════════════╪══╬╬═══════════╪═════╬═══╪════╛
    └──────────────────╜              │  ║╣           │     ║   │
                                      │  ║*┬┬┬┬┬┬┬┬┬┬┬┼╥╥╥╥╥╢   │
                                      ╘══*────────────*═════════╛

Тут видны как желательные эффекты, так и нежелательные (звездочки, ко всему прочему, означают места, где сопряжение оказалось принципиально невозможным). Тут все линии взаимодействуют между собой, даже если это не нужно, нежелательно или вредно. Эта картинка была произведена с помощью следующего кода, использующего рассматриваемый юнит:

uses
  TxGraph;

const
  n= 8;

var
  i: integer;

begin
  for i:=1 to n do begin
    TxRectangle(
      Random(80)+1,Random(25)+1,Random(80)+1,Random(25)+1,
      Random(2)+1,Random(2)+1,Random(2)+1,Random(2)+1
    );
//    TxDump
  end
end.

В конце программы есть закомментированная строка, которая представляет собой вызов очистки буфера. Если мы раскомментируем ее, результирующая картинка будет выглядеть так:

           ╔═════════════════════════════════════════════════════════╕
           ║                                                         │
           ║              ╔═══════════════╔═════════════════╗        │
           ║              ║               ║        │        ║        │
           ║              ║               ║        │        ║        │
           ║              ║               ║        │        ║        │
           ║              ║               ║        │        ║        │
    ╒══════║═══════════╗  ║               ║        │        ║        │
    │      ║           ║  ║               ║        │        ║        │
    │      ║           ║  ║               ║        │        ║        │
    │      ║  ┌───────────────────────────────────────────┐─║───┐  ══│
    │      ║  │        ║  ╙───────────────║────────┘      │ ║   │    │
    │      ║  │        ║              │   ║               │ ║   │    │
    │      ║  │        ║              │   ║               │ ║   │    │
    │      ║  │        ║              │   ║               │ ║   │    │
    │      ║  │        ║              │   ║               │ ║   │    │
    │      ║  └───────────────────────────────────────────┘ ║   │    │
    │      ║           ║              │  ║║           │     ║   │    │
    │      ╚═════════════════════════════║║═══════════│═════║════════╛
    └──────────────────╜              │  ║║           │     ║   │
                                      │  ║╙─────────────────╜   │
                                      ╘══╙────────────┘═════════╛

Тут мы видим просто набор прямоугольников - некоторые "внизу", другие "поверх" них. Этот пример поясняет, зачем и как следует вызывать очистку буфера.

И последнее. Этот юнит, как я уже сказал, вряд ли представляет какую-либо практическую ценность. Но он может служить демонстрацией подхода к организации того, что кажется на первый взгляд неорганизуемым )).

{ рисование в текстовой моде символами псевдографики
  drawing with pseudo-graphic characters in text mode
  by Lapp
  forum.pascalnet.ru, FAQ
  v.1.0 }

unit TxGraph;

interface

procedure TxHorLine(x1,x2,y,w: integer);
procedure TxVerLine(y1,y2,x,w: integer);
procedure TxRectangle(x1,y1,x2,y2,wr,wu,wl,wd: integer);
procedure TxDump;

implementation

uses
  CRT;

const
  mx= 300;
  my= 200;
  TxGrEl: array [
    0..2,       // r
    0..2,       // u
    0..2,       // l
    0..2        // d
  ] of char = (
    (           // r=0
      (                // u=0
        (' ','│','║'),        // l=0
        ('─','┐','╖'),        // l=1
        ('═','╕','╗')         // l=2
      ),
      (                // u=1
        ('│','│','*'),        // l=0
        ('┘','┤','*'),        // l=1
        ('╛','╡','*')         // l=2
      ),
      (                // u=2
        ('║','*','║'),        // l=0
        ('╜','*','╢'),        // l=1
        ('╝','*','╣')         // l=2
      )
    ),
    (           // r=1
      (                // u=0
        ('─','┌','╓'),        // l=0
        ('─','┬','╥'),        // l=1
        ('*','*','*')         // l=2
      ),
      (                // u=1
        ('└','├','*'),        // l=0
        ('┴','┼','*'),        // l=1
        ('*','*','*')         // l=2
      ),
      (                // u=2
        ('╙','*','╟'),        // l=0
        ('╨','*','╫'),        // l=1
        ('*','*','*')         // l=2
      )
    ),
    (           // r=2
      (                // u=0
        ('═','╒','╔'),        // l=0
        ('*','*','*'),        // l=1
        ('═','╤','╦')         // l=2
      ),
      (                // u=1
        ('╘','╞','*'),        // l=0
        ('*','*','*'),        // l=1
        ('╧','╪','*')         // l=2
      ),
      (                // u=2
        ('╚','*','╠'),        // l=0
        ('*','*','*'),        // l=1
        ('╩','*','╬')         // l=2
      )
    )
  );

var
  TxGrA: array [0..mx,0..my] of byte;

procedure Order(var a,b: integer);
begin
  if a<=b then exit;
  a:= a xor b;
  b:= a xor b;
  a:= a xor b
end;



procedure TxHorLine(x1,x2,y,w: integer);
var
  i: integer;
begin
  Order(x1,x2);
  for i:=x1 to x2 do TxGrA[i,y]:= w;
  for i:=x1 to x2 do begin
    GoToXY(i,y);
    Write(TxGrEl[TxGrA[i+1,y],TxGrA[i,y-1],TxGrA[i-1,y],TxGrA[i,y+1]])
  end
end;


procedure TxVerLine(y1,y2,x,w: integer);
var
  i: integer;
begin
  Order(y1,y2);
  for i:=y1 to y2 do TxGrA[x,i]:= w;
  for i:=y1 to y2 do begin
    GoToXY(x,i);
    Write(TxGrEl[TxGrA[x+1,i],TxGrA[x,i-1],TxGrA[x-1,i],TxGrA[x,i+1]])
  end
end;


procedure TxDump;
begin
  FillChar(TxGrA,SizeOf(TxGrA),0)
end;


procedure TxRectangle(x1,y1,x2,y2,wr,wu,wl,wd: integer);
begin
  Order(x1,x2);
  Order(y1,y2);
  TxVerLine(y1,y2,x2,wr);
  TxHorLine(x1,x2,y1,wu);
  TxVerLine(y1,y2,x1,wl);
  TxHorLine(x1,x2,y2,wd)
end;


begin
  TxDump
end.

[Lapp]

Вариант кода, доработанный IUnknown с целью убрать ложку дегтя (unit CRT). Он, по идее, должен быть системонезависимым (не проверялось пока) и при этом все же компилиться под TP/BP!! (дань традиции, видимо)).

код (Показать/Скрыть)

{ drawing with pseudo-graphic characters in text mode
  by Lapp, and IUnknown aka volvo877
  forum.pascalnet.ru, FAQ
  v.1.1 }

unit TxGraph;
interface
procedure TxHorLine(x1,x2,y,w: integer);
procedure TxVerLine(y1,y2,x,w: integer);
procedure TxRectangle(x1,y1,x2,y2,wr,wu,wl,wd: integer);
procedure TxDump;
implementation

{$ifdef fpc}
   uses video;
{$else}
   type
      VideoType =
      record
         ch : Char;
         attr : Byte;
      end;
   const
      ScreenWidth = 80;
      ScreenHeight = 25;
   var
      VideoBuf : array[1 .. ScreenHeight, 1 .. ScreenWidth] Of VideoType
      absolute $B800 : $0000;
{$endif}

const
  mx= 300;
  my= 200;
  TxGrEl: array [
    0..2,       {// r}
    0..2,       {// u}
    0..2,       {// l}
    0..2        {// d}
  ] of char = (
    (           {// r=0}
      (                {// u=0}
        (' ','│','║'),        {// l=0}
        ('─','┐','╖'),        {// l=1}
        ('═','╕','╗')         {// l=2}
      ),
      (                {// u=1}
        ('│','│','*'),        {// l=0}
        ('┘','┤','*'),        {// l=1}
        ('╛','╡','*')         {// l=2}
      ),
      (                {// u=2}
        ('║','*','║'),        {// l=0}
        ('╜','*','╢'),        {// l=1}
        ('╝','*','╣')         {// l=2}
      )
    ),
    (           {// r=1}
      (                {// u=0}
        ('─','┌','╓'),        {// l=0}
        ('─','┬','╥'),        {// l=1}
        ('*','*','*')         {// l=2}
      ),
      (                {// u=1}
        ('└','├','*'),        {// l=0}
        ('┴','┼','*'),        {// l=1}
        ('*','*','*')         {// l=2}
      ),
      (                {// u=2}
        ('╙','*','╟'),        {// l=0}
        ('╨','*','╫'),        {// l=1}
        ('*','*','*')         {// l=2}
      )
    ),
    (           {// r=2}
      (                {// u=0}
        ('═','╒','╔'),        {// l=0}
        ('*','*','*'),        {// l=1}
        ('═','╤','╦')         {// l=2}
      ),
      (                {// u=1}
        ('╘','╞','*'),        {// l=0}
        ('*','*','*'),        {// l=1}
        ('╧','╪','*')         {// l=2}
      ),
      (                {// u=2}
        ('╚','*','╠'),        {// l=0}
        ('*','*','*'),        {// l=1}
        ('╩','*','╬')         {// l=2}
      )
    )
  );
var
  TxGrA: array [0..mx,0..my] of byte;

procedure DrawChar(PosX, PosY : integer; Ch : Char);
begin
{$ifdef fpc}
  VideoBuf^[Pred(PosX) + Pred(PosY) * ScreenWidth] := $0700 + byte(Ch);
{$else}
  { Working with "Array ... absolute $B800:$0000;" }
  VideoBuf[PosY, PosX].Attr := 7;
  VideoBuf[PosY, PosX].Ch := Ch;
{$endif}
end;

procedure Order(var a,b: integer);
begin
  if a<=b then exit;
  a:= a xor b;
  b:= a xor b;
  a:= a xor b
end;
procedure TxHorLine(x1,x2,y,w: integer);
var
  i: integer;
begin
  Order(x1,x2);
  for i:=x1 to x2 do TxGrA[i,y]:= w;
  for i:=x1 to x2 do begin
    DrawChar(i, y, TxGrEl[TxGrA[i+1,y],TxGrA[i,y-1],TxGrA[i-1,y],TxGrA[i,y+1]]);
    {
    GoToXY(i,y);
    Write(TxGrEl[TxGrA[i+1,y],TxGrA[i,y-1],TxGrA[i-1,y],TxGrA[i,y+1]])
    }

  end
end;
procedure TxVerLine(y1,y2,x,w: integer);
var
  i: integer;
begin
  Order(y1,y2);
  for i:=y1 to y2 do TxGrA[x,i]:= w;
  for i:=y1 to y2 do begin
    DrawChar(x, i, TxGrEl[TxGrA[x+1,i],TxGrA[x,i-1],TxGrA[x-1,i],TxGrA[x,i+1]]);
    {
    GoToXY(x,i);
    Write(TxGrEl[TxGrA[x+1,i],TxGrA[x,i-1],TxGrA[x-1,i],TxGrA[x,i+1]])
    }
  end
end;
procedure TxDump;
begin
  FillChar(TxGrA,SizeOf(TxGrA),0);
  {$ifdef fpc}
  updatescreen(true);
  {$endif}
end;
procedure TxRectangle(x1,y1,x2,y2,wr,wu,wl,wd: integer);
begin
  Order(x1,x2);
  Order(y1,y2);
  TxVerLine(y1,y2,x2,wr);
  TxHorLine(x1,x2,y1,wu);
  TxVerLine(y1,y2,x1,wl);
  TxHorLine(x1,x2,y2,wd);
  {$ifdef fpc}
  updatescreen(true);
  {$endif}
end;

{$ifdef fpc}
initialization
   InitVideo;
finalization
   DoneVideo;
{$else}
begin
  TxDump
{$endif}
end.